'' Alvarian Tales Engine
'' Danny Wilfong
'' yr 2000 to 2018
'' TO DO (Engine):
'' - ASTAR: Just one map which is the size of the current scene. Each soul pathfinding uses same map but calcs their own start/end
'' points on it. No need to check and recheck cell open/close for each soul. True, do need to update map because of moving objs,
'' but all souls pathfinding share same updated map. Only problem is if we want objs in different scene to pathfind on different map.
'' But that would be problematic in having so many calculations - the entire world - all the time. Only current scene objs can pathfind.
'' - Keyboard ability to only act after key is released. While certain key : refresh : wend works for now but a little hackish.
'' - Refine pathfinding:
'' - 2x2 grid is still fast! However it cannot get through the little cracks like arrow keys
'' - Follow-pathfinding needs work. Negative numbers bug, and resolution change bug.
'' - Pathfinding map is currently being passed around. Consider multiple maps and the cpu tax.
'' - With shared map, need to check that the map is set up for a particular object before drawing or checking its cells.
'' This would include in .draw_attr(), and inputs() where mouse is checking for can_walk.
'' - Waiting time for path-finding to be based on either Timer or cycles. (Currently Timer)
'' - Insertion Sort for Create_Soul_Sheet doesn't work.
'' - If compiling for 64-bit, Integers in anything saved to file need to become Longs, as Integer is either 32 or 64 depending on OS, but Long=32.
''
'' TO DO (Editor):
'' - Selection box does not consider obj scaling
'' - AUTOMATION
'' - Initial states for dest, opacity, rotation (if added), others if added, and any behaviors.
'' - Interface for initial states of automated objs.
''
'' TO DO (Scripting):
'' - Behaviors for NPCs. Animals, like a bunny, bird, squirrel. And people, being able to move about smoothly when scripted.
''
'' TO DO (Graphics):
'' - Rain reduces framerate by about 10-12 FPS with 500 drops. 100 drops reduces only a few FPS but is only a sprinkle. Oddly removing drop tail doesn't help. Find a quicker way?
'' - Switch over to FBImage (Nov 2017, loads and saves all kinds of formats.) More modern than old FBPNG
'' - The accidental grass glowing of the rendered GIF file is quite beautiful and should probably be incorporated in the game.
'' - Dying clothing by pixel color search & replace, layer, and re-bind to vRAM.
'' - Currently the RAM version of soul graphics is naked, or without layers. GET not used yet anyway, just u/v and data information, but
'' I might consider GETting the fully layered version if ever needed, or removing the GET to increase speed.
'' - Detect user resolution and adjust camera scale accordingly.
'' - Don't draw objects out of camera view needs to consider the obj scale as well.
'' - Consider VRAM storage of various possible object images...
'' 1: as first seen in the world, like a sword leaning against the wall
'' 2: displayed in your inventory
'' 3: more detailed view in inventory
'' 4: animation when being used
'' 5: when dropped back into the world
''
'' TO DO (GUI):
'' - See if possible to fix font letters pixel unevenness probably due to integer value when drawing scaled smaller.
'' - OptnBox setup needs to calculate width by counting each letter's width of the longest option
'' - Gui inventory and other windows fade in/out
'' - MsgBox Title and OK button, maybe scroll bar too
'' - OptnBox title set in its own space above box
'' - ConvoBox scroll bar for text lines greater than certain amount
'' - ConvoBox right-click response to see whole thing if doesn't fit on one line. It could use whole space for all responses temporarily.
''
'' TO DO (Sound & Music):
'' - Sounds for steps on sand, ground, floor types, and a wet version of each.
'' - Sounds for wading in water.
''
'' TO DO (Misc)
''
'' IDEAS (Engine)
'' - A new obj type, invisible, that serves as extra functionality to the scene it's in. Perhaps scene exits, time of day, and more.
'' - For images that work as no-walk-zones, a pixel color test is done to see if it's not transparent. Another test could be done
'' to detect for a certain color which would server to slide the character one way or another depending on color, and this color
'' could be painted around the edges of the zone where the character is nearly passing but getting stuck on an edge, so he slides.
'' - Save character stats for a sequel! Import and continue your character.
'' - Encrypt and decrypt game art to prevent access in the folder.
'' - Consider WaitCycles (similar to WaitTime)
''
'' IDEAS (EDITOR)
'' - Smaller scale when selecting images for scene.
''
'' IDEAS (GRAPHICS)
'' - Evening/ night effect can be done via dropping some r&g values of scene objs, also could blend in evening versions of scene.
'' - Possibility for Overlay light source: Using Paul Doe's code, pre-render blurry light circle over the background of the cave scene,
'' then upload and draw as usual. It could either be on the original texture or a new (smaller one.) Either way this means a rebinding
'' every cycle. It's likely that no other objects need to be pre-rendered. For making creatures around you get lighter, judge distance
'' between you and them and use .addlight on them. This will not be as slow as I thought, just an odd bit of coding.
'' - Particle objects that rotate around a point: simply adjust x,y in an oval and adjust z for height off ground, then speed of movement.
'' Uses: bright stars, flys, birds, even a rope connected to something
'' - Stretch scenes vertically for the effect of flying high up in the air. It looks awesome on the mountain scene.
'' - So as not to cover over the characters speaking to each other, we could pan the map up to the top of the dialog box until the
'' speaking characters are exposed.
'' - Add ZOOM effect. (Hardly need with the big pixel graphics.)
'' - If items can be dropped and visible on the map, be flexible. Allow the user to rotate and maybe even scale the object a little
'' so that he can place it in a way that looks good, such as storing treasures in his personal home.
'' - Scaling + fog effect for distances.
''
'' IDEAS (Gameplay)
'' - Standing right on top of a soul or friend causes them to step aside and look at you after a moment.
'' - Could do a over-time effect for rowing to shore. Show him in the distance perhaps with a smaller version of paddle boat, gently
'' scaling closer. Then fade out and the larger size fade in closer to shore, gently scaling and moving closer. Maybe three times, showing the
'' passing of time.
'' - Amazon-Queen style lookout pinnacle.
'' - Click yourself (or a menu option) for your character's current general thoughts.
'' - Vertical zones could have bases that you must line up with for your arrow to hit. For left-to-right, line up vertical zones
'' with their bases meeting each other, this way the arrow will stop at different places. Better yet, a poly zone. Test with
'' mouse drawing a point where the arrow should hit, see if you can create a 3d sort of appearance.
''
'' IDEAS (Sound & Music)
'' - Footsteps (perhaps optional if annoying.) Door open/close. Sounds for inventory interaction.
'' - Sounds tied to objects, and volume levels related to distances.
''
'' TIPS
'' - Using slices in Aseprite can help me start drawing boxes in GFXMapper by getting the coords and dimensions.
'' NOTES:
'' - Very interesting: Integer rounding at .5 is odds only, which means characters happen to face the way want them at angles.
'' EG: UR or 1.5 rounds to RT or 2, DR 2.5 rounds to RT or 2 as well. DL to L, UL to L.
'' - If .speedx of obj is less than .speedy the pixel dodging can fail on certain angles. x is I believe always more so no problem for now.
'' - Game should close without using END, since it doesn't run destructors or cleanly remove variables. For editor it's fine.
'' - May need to scale object w/h same way as polys in .set_scale, if they are ever used much. (turning flat into upright maybe)
'' - I believe FB and GL are different: RGB, BGR. I'm using something that's flipping them but I don't understand fully.
'' - Scaling characters only vertically may look a little better than also horizontally, in small increments only.
'' - Poly shapes must be drawn counter-clockwise to be effective. Clockwise is basically inside-out and is useless.
''
'' NEED LICENSES:
''
'' LICENSES FOUND:
'' FBSound D.J.Peters, no license, but he did state it can be used commercially for free.
'' FMOD - Free for indie developers, even commercially
'' FBImage (currently not used) appears to be Public Domain license (a part of SOIL which is PD)
'' FBPNG is licensed as free to distribute for commercial or non-commercial.
'' Relsoft's (Richard M Lope's) GL code was licensed "use and abuse" in his documentation.
#Define TRUE -1
#Define FALSE 0
#Define NULL 0
'' Resolution, screen, and camera setup.
'' Res is initial, screen is after we scale, camera is viewing window and camera position.
#Define res_w 1280 '' Resolution w,h | 16:9 or 1.777777777777778: 256x144 512x288 1024x576 1280x720 1600x900 1920x1080
#Define res_h 720
#Define scr_s 4 '' Screen scale
#Define scr_w res_w\scr_s '' Screen w,h
#Define scr_h res_h\scr_s
#Define cam_w 256 '' Viewing window w,h
#Define cam_h 144
#Define cam_x1 (scr_w-cam_w)\2 '' Viewing window upper left corner x,y
#Define cam_y1 (scr_h-cam_h)\2
#Define cam_x2 cam_x1+cam_w '' Viewing window lower right corner x,y
#Define cam_y2 cam_y1+cam_h
#Define cam_frame 255
#Define FULL_SCR 1 '' 1 = True, 0 = False
#Define default_font_scale .75 '' For use by DWGLGUI
#Define default_gui_scale .5 '' For use by DWGLGUI
#Define c_o oGrp(1).oID '' Current object
'Const PI = 3.14159265359
#include "vbcompat.bi" '' Only here for Format() function for Timer display
#include "windows.bi" '' Here for using timeBeginPeriod
#Include "win/mmsystem.bi" '' and timeEndPeriod
#Include Once "fbgfx.bi"
Using fb
#Define PNG_STATICZ 1 '' Use static library libfbpngS.a file rather than zlib1.dll.
#LibPath "D:\Prog\FB\_lib\fbpng_v3_2_q\build\prebuilt\windows"
#LibPath "D:\Prog\FB\_lib\FB-win32-zlib-1.2.7\lib\win32"
#LibPath "D:\Prog\FB\_lib\fbsound0.20\lib\win32"
#Include Once "D:\Prog\FB\_lib\fbpng_v3_2_q\inc\fbpng.bi"
#Include Once "D:\Prog\FB\_lib\fbpng_v3_2_q\inc\png_image.bi"
#Include Once "D:\Prog\FB\_lib\fbsound0.20\inc\fbsound.bi" '' FBSound, yeah baby!
#Include Once "dir.bi"
#Include Once "file.bi" '' Directory and file handling
#Include Once "tools.bi"
Using TOOLS
#Include Once "dwglgui.bi"
Using GUI
#Include Once "dwgl.bas"
Using GL
#Include Once "alvarian tales.bi"
Using _ENG
#Include Once "story.bi"
Using _STORY
'' Map and Objects
Dim Shared As ZString * 32 world, world_folder, scene '' World filename and folder, currently viewing scene name.
Dim Shared As Integer order(1 To maxSceneObjs) '' To hold current scene objects in sorted order
Dim Shared obj(1 To maxObjs+1) As _obj_ '' Objects (+1 for new object placeholder)
Dim Shared As Integer n_o, n_so '' No. of objs, no. of scene objs
Dim Shared As Integer Me '' For assigning obj that is PC
'' Map Editor
Dim Shared As _obj_group_ oGrp(1 To 50) '' Max objects that can be selected at once
Dim Shared As Integer cGrpObj, nGrpObjs '' Multi-object selection for editing
Dim Shared As Integer edit_mode, move_mode, c_dest_node '' Editing mode, moving an object, current destination node to edit
Dim Shared As Integer show_all_attr, show_vars '' Show attributes of engine
Dim Shared As Integer cam_x, cam_y, pan_x, pan_y, old_pan_x, old_pan_y '' Screen x/y or map panning
Dim Shared As _get_cordinates_ getcords '' Mouse creating box coordinates
Dim Shared As Integer sel_x1, sel_y1, sel_x2, sel_y2, get_sel_cords
Dim Shared As _grid_ grid
'' Game Interface and GUI
Dim Shared As Integer mx,my,mb,prvMB, mmx,mmy, mgx,mgy,grabbed, cursor '' Mouse states, mouse map x/y, mouse grab x/y, cursor id
Dim Shared As Integer show_classic_gui, c_tab, md_tab, c_inv
Dim Shared As optBox_ menu
Dim Shared As Integer game_c_obj, game_hl_obj, can_walk
Dim Shared As Integer index_frame
Dim Shared As Integer ico_bag
'' Battle System
Dim Shared As Integer battle_active, battle_count, battle_turn, battle_time
Dim Shared As Integer battling(1 To 10) '' List of those in fight, 1=pc, 2-10=npc object #
'' Scripting
ReDim Shared As ZString * 32 ListScripts()
#Define maxBehaviors 30
Dim Shared As ZString * 32 ListBehaviors(1 To maxBehaviors) => _
{"none","nogo-zone","walk-zone","trigger-zone","mouse-zone","ladder"}
'' Special Effects
Dim Shared As Integer weather_snow=FALSE, weather_rain=FALSE, do_fx_spell=FALSE
Dim Shared As _dialog_ Dlog
'' Sounds and Music
Dim Shared As Integer sfxBGM,sfxThunder1,sfxWetSteps
Dim Shared As Integer sfxWomanStep(1 To 6)
Dim Shared As Integer sfxWetStep(1 To 8)
Dim Shared As Integer sfxStepSand
Dim Shared As Integer sfxArrowDraw, sfxArrowRelease, sfxArrowHit1
Dim Shared As Integer sfxLightning1, sfxLightning2
'' AStar
ReDim Shared ASTARMAP() As _ASTAR_CELL_
Dim Shared AStarObj As _obj_ Ptr
Dim Shared As Integer ASTAR_CELL_W, ASTAR_CELL_H, ASTAR_MAP_CELLS_WIDE, ASTAR_MAP_CELLS_HIGH, ASTAR_MAP_CELL_COUNT
Dim Shared As Integer StartIndex, EndIndex
Dim Shared As _ASTAR_CELL_ Ptr StartCell, EndCell
#Define pathfind_interval 60 '' Pathfind cycles interval is currently shared by every soul. If needed later they can have their own countdown.
Dim Shared As Integer pathfind_countdown
'Dim Shared As Double LastPathFindTime, PathFindTimeInterval
'' General
Dim Shared As Integer LoopLayer,FPS
Dim Shared As Double BeginTime,MarkSecond
db_clear()
db_write("---- Log Begin ----")
GL.screen_init(res_w,res_h,scr_s,FULL_SCR)
ReDim Shared scene_set() As GL.gfxmap_set
ReDim Shared scene_spr() As GL.gfxmap_spr
GL.gfxmap_load("gfx\region_01.gma", scene_spr(), scene_set())
ReDim Shared gui_set() As GL.gfxmap_set
ReDim Shared gui_spr() As GL.gfxmap_spr
GL.gfxmap_load("gfx\gui\gui.gma", gui_spr(), gui_set())
'ReDim Shared thm_set() As GL.gfxmap_set
'ReDim Shared thm_spr() As GL.gfxmap_spr
'GL.gfxmap_load("gfx\thumbs.gma", thm_spr(), thm_set())
'ReDim Shared ico_set() As GL.gfxmap_set
'ReDim Shared ico_spr() As GL.gfxmap_spr
'GL.gfxmap_load("gfx\gui\icons.gma", ico_spr(), ico_set())
ReDim Shared font_set() As GL.gfxmap_set
ReDim Shared font_spr() As GL.gfxmap_spr
GL.gfxmap_load("gfx\gui\newfonts.gma", font_spr(), font_set())
ReDim Shared soul_set() As GL.gfxmap_set
ReDim Shared soul_spr() As GL.gfxmap_spr
'' Let's go!
_Initialize()
scr_NewGame()
BeginTime = Timer
Do
__continue()
Loop
_Quit
End
#Include Once "tools.bas"
#Include Once "dwglgui.bas"
#Include Once "story.bas"
#Include Once "astar.bas"
Namespace _ENG
Constructor _obj_
sID = "general"
fp = @scr_General()
visible = TRUE
scale = 1.0
'scale_h = 1.0
w = 32
h = 32
behavior = "none"
opacity = 255
For n As Integer = 1 To maxAnimFrames
an.f(n).opacity=255
Next
op.delay_at_max = 60
op.delay_at_min = 60
op.min=255
op.max=255
rotate = 0
rgb_r=255
rgb_g=255
rgb_b=255
End Constructor
Sub __continue(InputLimits As Integer = 0, LoopTime As Single = 0)
'Static As Integer d
Dim As Single EntryTime = Timer '' EntryTime and LoopTime are used to keep an inner loop running. This is
'' used only when we need main loop to "auto-run" for a set amount of time.
LoopLayer+= 1 '' LoopLayer tracks how many layers deep of the main loop we are. (Recursive.)
If LoopLayer > 1 Then db_write("Entered main cycle at layer: "+Str(LoopLayer))
Do
Me = obj_with_sID("arian") '' Be sure to stay pointing to the right object as the player character.
_Inputs(InputLimits)
scene_update()
__ProxyRefresh()
__ProxyFlip(cursor)
'' Beautiful scene-sliding example:
'If pan_x >= 0 AndAlso obj(Me).x > 200 Then d = -1
'pan_x+=d
'If pan_x < -50 Then d = 0
'If pan_x <=-50 AndAlso obj(me).x < 100 Then d=1
'If pan_x > 0 Then d = 0
'If obj(me).x > 305 Then d=-10
'If pan_x < -300 Then d = 0
Loop Until Timer - EntryTime >= LoopTime
LoopLayer -= 1
End Sub
Sub _Inputs(InputLimits As Integer = 0)
'' ________ Anytime Keyboard Inputs ________________
Dim As ZString * 3 ink=(LCase(Inkey))
If ink = Chr(27) Then : interface_menu_main()
ElseIf ink = "e" Then : edit_mode Xor = TRUE : cursor = Default
ElseIf ink = "v" Then : show_vars Xor = TRUE
ElseIf ink = "p" Then : c_o = Me
ElseIf ink = KB_F5 Then : weather_rain Xor = TRUE
ElseIf ink = KB_F6 Then : weather_snow Xor = TRUE
ElseIf ink = KB_F7 Then fx_lightning_strike(-pan_x+mx,-pan_y+my,,0)
EndIf
If edit_mode Then
_Inputs_EDIT_MODE(ink)
Exit Sub
EndIf
'' Stop here if game-inputs are disabled.
If InputLimits Then cursor = Cursors.Waiting : Exit Sub
'' ________ Game Keyboard Inputs ________________
With obj(Me)
If MultiKey(SC_LSHIFT) Then .speed_mod = .4 Else .speed_mod = 0
If .s.pa.go = FALSE AndAlso .de.go = FALSE Then
If MultiKey(SC_UP) And MultiKey(SC_LEFT) Then: .Move(-1,-1,drLF)
ElseIf MultiKey(SC_UP) And MultiKey(SC_RIGHT) Then: .Move( 1,-1,drRT)
ElseIf MultiKey(SC_DOWN) And MultiKey(SC_LEFT) Then: .Move(-1, 1,drLF)
ElseIf MultiKey(SC_DOWN) And MultiKey(SC_RIGHT) Then: .Move( 1, 1,drRT)
ElseIf MultiKey(SC_UP) Then: .Move( 0,-1,drUP)
ElseIf MultiKey(SC_DOWN) Then: .Move( 0, 1,drDN)
ElseIf MultiKey(SC_LEFT) Then: .Move(-1, 0,drLF)
ElseIf MultiKey(SC_RIGHT) Then: .Move( 1, 0,drRT)
ElseIf MultiKey(SC_W) And MultiKey(SC_A) Then: .Move(-1,-1,drLF)
ElseIf MultiKey(SC_W) And MultiKey(SC_D) Then: .Move( 1,-1,drRT)
ElseIf MultiKey(SC_S) And MultiKey(SC_A) Then: .Move(-1, 1,drLF)
ElseIf MultiKey(SC_S) And MultiKey(SC_D) Then: .Move( 1, 1,drRT)
ElseIf MultiKey(SC_W) Then: .Move( 0,-1,drUP)
ElseIf MultiKey(SC_S) Then: .Move( 0, 1,drDN)
ElseIf MultiKey(SC_A) Then: .Move(-1, 0,drLF)
ElseIf MultiKey(SC_D) Then: .Move( 1, 0,drRT)
Else
script_exec(Me,Keys.NoArrowKeys)
EndIf
EndIf
If MultiKey(SC_SPACE) Then
While MultiKey(SC_SPACE)
__ProxyFlip()
Wend
'' beginning to code attack for creatures in your range
.fp(@obj(Me),Keys.KB_SpaceBar)
Dim As Integer tx = Fix(obj(Me).x), ty = Fix(obj(Me).y)
For n As Integer = 1 To n_so
With obj(order(n))
Dim As Integer ox = Fix(.x), oy = Fix(.y)
If .kind = objKinds.Soul AndAlso @obj(order(n)) <> @obj(Me) Then
'' If any (o)bj is within (t)his (or me) obj range:
If Sqr( ((ox-(tx))*(ox-(tx)) ) + ((oy-(ty))*(oy-(ty)) ) ) <= obj(Me).s.range_melee.base Then
'.visible = FALSE
.x += 20
fbs_Play_Wave(sfxArrowHit1,1)
EndIf
EndIf
End With
Next
EndIf
End With
'' ________ Game Mouse Actions ________________
cursor = Cursors.Default
If mb = 0 Then
grabbed = FALSE
If prvMB=2 Then
'' ---- If mouse position in scene area:
If PointInBox(mx,my,0,0,scr_w,scr_h) Then
'' If walking is possible:
If can_walk Then
obj(c_o).s.pa.x = mmx
obj(c_o).s.pa.y = mmy
obj(c_o).s.pa.go = TRUE
obj(c_o).de.go = TRUE
obj(c_o).d(1).go = dNodes.Stop
'' For direct movement:
'obj(c_o).d(1).x = mmx
'obj(c_o).d(1).y = mmy
'' Although pathfind works every n amount of time, we want to pathfind right away:
'LastPathFindTime=Timer-PathFindTimeInterval
pathfind_countdown = 0
EndIf
EndIf
ElseIf prvMB = 1 Then
If menu.count then
menu.count = 0
script_exec(game_c_obj,Keys.MenuOption,0)
game_c_obj = 0
EndIf
ElseIf prvMB = 0 Then
EndIf
ElseIf mb = 1 Then
'' Make sure there's no menu already open:
If menu.count = 0 Then
'' Scene Region:
If PointInBox(mx,my,0,0,scr_w,scr_h) Then
If game_hl_obj AndAlso obj(game_hl_obj).hasMenu Then
game_c_obj = game_hl_obj
script_exec(game_c_obj,Keys.GetMenu,0)
menu.x = mx : menu.y = my
menu.corner_at_xy = 1
OptnBox_setup(menu)
EndIf
EndIf
EndIf
ElseIf mb = 2 Then
EndIf
'' If mouse hovering within game window: (Soon to exclude game bar on bottom.)
If PointInBox(mx,my,cam_x1,cam_y1,cam_x2,cam_y2) Then
game_hl_obj = 0
can_walk = TRUE
'Zones.noZoneJustObj, Zones.noZoneJustObjIgnoreTrans
For n As Integer = 1 To n_so
With obj(order(n))
If .b.en = TRUE AndAlso .b.tp = BaseIsBound AndAlso poly_xy_relationship(mmx,mmy,.b,.x,.y) = Located.Within Then can_walk = FALSE
'If .tr.en=TRUE And poly_xy_relationship(mmx,mmy,.tr,.x,.y) = Located.Within Then
If .mz.en= TRUE AndAlso .hasMenu AndAlso poly_xy_relationship(mmx,mmy,.mz,.x,.y) = Located.Within Then cursor = Cursors.Menu : game_hl_obj = n
'If .v.en =TRUE And poly_xy_relationship(mmx,mmy,.v,.x,.y) = Located.Within Then
If .behavior = "walk-zone" AndAlso ARGB_A(Point(mmx-.x,mmy-.y,scene_spr(.ii).p)) = 0 Then can_walk = FALSE
End With
Next
'If (AStarObj = @obj(Me) AndAlso ASTAR_CellCheck(mx\obj(Me).s.pa.sw,my\obj(Me).s.pa.sh)=TRUE) Then
' can_walk = FALSE
'ElseIf
'If can_walk AndAlso cursor = Cursors.Default Then cursor = Cursors.Walk
EndIf
End Sub
Sub _Inputs_EDIT_MODE(ink As ZString Ptr)
'' ________ Editor Keyboard Inputs ________________
If MultiKey(SC_CONTROL) And MultiKey(SC_UP) Then pan_y -= 1
If MultiKey(SC_CONTROL) And MultiKey(SC_RIGHT) Then pan_x += 1
If MultiKey(SC_CONTROL) And MultiKey(SC_DOWN) Then pan_y += 1
If MultiKey(SC_CONTROL) And MultiKey(SC_LEFT) Then pan_x -= 1
If MultiKey(SC_CONTROL) And MultiKey(SC_A) Then
Group_ReleaseAll(oGrp())
For n As Integer = 1 To n_so
If obj(order(n)).ii Then
nGrpObjs+=1
oGrp(nGrpObjs).oID = order(n)
If nGrpObjs = UBound(oGrp) Then Exit For
EndIf
Next
Group_Sort(oGrp())
WaitTime(.25)
ElseIf MultiKey(SC_CONTROL) And MultiKey(SC_S) Then
world_save("world.dat")
msgbox("Saved!")
EndIf
If getcords.getxy Then
Select Case *ink
Case KB_UP: my-=1 : SetMouse(mx,my) : interface_get_coords()
Case KB_RIGHT: mx+=1 : SetMouse(mx,my) : interface_get_coords()
Case KB_DOWN: my+=1 : SetMouse(mx,my) : interface_get_coords()
Case KB_LEFT: mx-=1 : SetMouse(mx,my) : interface_get_coords()
Case KB_ENTER: getcords.getxy = 0
Case "1","2","3","4": '' Select poly coord to work with.
getcords.getxy = Val(*ink)
With obj(c_o) '' Set mouse to coord position for alteration with arrow keys.
If getcords.getxy = 1 Then mx = pan_x+.x+.b.x1 : my = pan_y+.y+.b.y1 : SetMouse(mx,my)
If getcords.getxy = 2 Then mx = pan_x+.x+.b.x2 : my = pan_y+.y+.b.y2 : SetMouse(mx,my)
If getcords.getxy = 3 Then mx = pan_x+.x+.b.x3 : my = pan_y+.y+.b.y3 : SetMouse(mx,my)
If getcords.getxy = 4 Then mx = pan_x+.x+.b.x4 : my = pan_y+.y+.b.y4 : SetMouse(mx,my)
End With
End Select
ElseIf nGrpObjs Then
If MultiKey(SC_CONTROL) = FALSE Then '' This is necessary to stop a CTRL+LEFT Arrow = KB_DEL and deletes obj (strange)
Select Case *ink
Case "0","1","2","3","4": '' Select poly coord to work with.
obj(c_o).blend_mode = Val(*ink)
Case "5"
obj(c_o).addlight = 55
Case "6"
obj(c_o).addlight = 0
Case KB_UP: For n As Integer = 1 To nGrpObjs : obj(oGrp(n).oID).y -= 1 : Next
Case KB_RIGHT: For n As Integer = 1 To nGrpObjs : obj(oGrp(n).oID).x += 1 : Next
Case KB_DOWN: For n As Integer = 1 To nGrpObjs : obj(oGrp(n).oID).y += 1 : Next
Case KB_LEFT: For n As Integer = 1 To nGrpObjs : obj(oGrp(n).oID).x -= 1 : Next
Case KB_DEL: obj_delete(c_o,TRUE)
Case "r" : obj(c_o).rotate += 1
Case "q" : obj(c_o).set_scale(obj(c_o).scale-.02)
Case "w" : obj(c_o).set_scale(obj(c_o).scale+.02)
Case "s" : obj(c_o).scale = Val(guiInptBox("Set Scale",Str(obj(c_o).scale)))
Case Chr(13): interface_edit_obj() '' Adjust object attributes.
Case "-": obj(c_o).z -= 1 '' Lower object to ground, or order backward for flats.
Case "=": obj(c_o).z += 1 '' Raise object from ground, or order forward for flats.
Case "m":
move_mode Xor = TRUE '' Moving the object mode, on/off.
If move_mode Then
For n As Integer = 1 To nGrpObjs
With obj(oGrp(n).oID)
oGrp(n).OffsetMX = (.x + pan_x) - mx
oGrp(n).OffsetMY = (.y + pan_y) - my
End With
Next
EndIf
Case "d": '' Duplicate current object.
obj(newObjID) = obj(c_o)
c_o = newObjID
move_mode = TRUE
Case "z" : obj(c_o).z = obj(c_o).y - (mmy\grid.h)*grid.h '' Adjust z / distance from ground.
Case "l": If c_o Then obj(c_o).locked Xor = TRUE
End Select
Else
If MultiKey(SC_CONTROL) And MultiKey(SC_V) Then obj(c_o).visible Xor = TRUE : WaitTime(.25)
EndIf
EndIf
Select Case *ink
Case "[": FPS_LIMIT -= 1
Case "]": FPS_LIMIT += 1
Case ",": If nGrpObjs > 1 Then cGrpObj=IIf(cGrpObj>1,cGrpObj-1,0) Else Group_Select(oGrp(), c_o-1)
Case ".": If nGrpObjs > 1 Then cGrpObj=IIf(cGrpObj Case "g": grid.show Xor = TRUE
Case KB_TAB: grid.lock Xor = TRUE
Case "0": pan_x = 0 : pan_y = 0
Case "a": show_all_attr Xor = TRUE
End Select
'' ________ Editor Mouse Inputs ________________
If mb = 0 Then
If move_mode = TRUE Then
For n As Integer = 1 To nGrpObjs
obj(oGrp(n).oID).x = mmx+oGrp(n).OffsetMX
obj(oGrp(n).oID).y = mmy+oGrp(n).OffsetMY
If grid.lock Then
obj(oGrp(n).oID).x = (obj(oGrp(n).oID).x \ grid.w) * grid.w
obj(oGrp(n).oID).y = (obj(oGrp(n).oID).y \ grid.h) * grid.h
End If
Next
End If
If prvMB AndAlso get_sel_cords Then
If MultiKey(SC_LSHIFT) = FALSE Then Group_ReleaseAll(oGrp())
Dim As Integer Single_Click, found
For n As Integer = 1 To n_so Step 1
found = 0
With obj(order(n))
If .ii AndAlso .locked = FALSE Then
If sel_x2 = sel_x1 AndAlso sel_y2 = sel_y1 Then Single_Click = TRUE
If (Single_Click = TRUE _
And (.upright=TRUE And PointInBox(mmx,mmy, .x-.spr_ptr[.ii].ax, .y-.spr_ptr[.ii].ay, .x-.spr_ptr[.ii].ax+.w, .y-.spr_ptr[.ii].ay+.h)) _
Or (.upright=FALSE And PointInBox(mmx,mmy, .x, .y, .x+.w, .y+.h))) _
OrElse (Single_Click = FALSE _
And (.upright=TRUE And BoxInBox(.x+pan_x-.spr_ptr[.ii].ax, .y+pan_y-.spr_ptr[.ii].ay, .x+pan_x-.spr_ptr[.ii].ax+.w, .y+pan_y-.spr_ptr[.ii].ay+.h, sel_x1, sel_y1, sel_x2, sel_y2)) _
Or (.upright=FALSE And BoxInBox(.x+pan_x, .y+pan_y, .x+pan_x+.w, .y+pan_y+.h, sel_x1, sel_y1, sel_x2, sel_y2))) _
Then
If MultiKey(SC_LSHIFT) = TRUE Then
found = Group_Has(oGrp(),order(n))
If found Then
Group_Release(oGrp(),order(n))
'If Single_Click Then Exit For
Else
Group_Add(oGrp(),order(n))
If Single_Click Then Exit For
EndIf
Else
If Single_Click = FALSE Then Group_Add(oGrp(),order(n)) Else Group_Select(oGrp(),order(n))
EndIf
EndIf
EndIf
End With
Next
Group_Sort(oGrp())
get_sel_cords = 0
sel_x1 = 0 : sel_y1 = 0 : sel_x2 = 0 : sel_y2 = 0
ElseIf prvMB AndAlso move_mode = TRUE Then
move_mode = FALSE
ElseIf prvMB >= 3 AndAlso grabbed Then
grabbed = FALSE
EndIf
ElseIf mb = 1 Then
interface_get_coords() '' Check if we are getting coordinates.
If getcords.getxy=0 Then
If move_mode = TRUE Then
If c_o >= 1 AndAlso c_o <= maxObjs Then
move_mode = FALSE
WaitForNoMouseBtn()
ElseIf c_o = newObjID Then
If n_o >= maxObjs Then
MsgBox("Object limit reached.")
Else
move_mode = FALSE
n_o += 1
c_o = n_o
n_so += 1
order(n_so) = c_o
obj(c_o) = obj(newObjID)
obj(c_o).scene = scene
WaitForNoMouseBtn()
EndIf
EndIf
Else
If get_sel_cords <> 2 Then
sel_x1 = mx
sel_y1 = my
get_sel_cords = 2
EndIf
If get_sel_cords = 2 Then
sel_x2 = mx
sel_y2 = my
EndIf
End If
EndIf
ElseIf mb = 2 Then
If getcords.getxy Then
getcords.getxy = 0
'Dialog("OK",mx,my,TRUE)
WaitForNoMouseBtn()
Else
'' Create a new object starting with an image:
Group_ReleaseAll(oGrp())
move_mode=FALSE
'Clear(obj(newObjID),0,Len(_obj_)) '' constructor does this.
obj(newObjID).constructor
Dim As Integer ii = interface_choose_image(scene_spr(), scene_set())
If ii Then
c_o = newObjID
With obj(c_o)
.kind = objKinds.SceneObj
.ii = ii
.spr_ptr = @scene_spr(0)
.scene = scene
.w = scene_spr(ii).p->Width
.h = scene_spr(ii).p->Height
nGrpObjs = 1 : cGrpObj = 1
oGrp(1).oID = c_o
If .spr_ptr[.ii].ax = 0 AndAlso .spr_ptr[.ii].ay = 0 Then
oGrp(1).OffsetMX = -.w \ 2
oGrp(1).OffsetMY = -.h \ 2
Else
oGrp(1).OffsetMX = 0
oGrp(1).OffsetMY = 0
.upright = TRUE
EndIf
End With
move_mode = TRUE
End If
End If
ElseIf mb >= 3 Then
If grabbed = FALSE Then
old_pan_x = pan_x
old_pan_y = pan_y
mgx = mx
mgy = my
grabbed = TRUE
End If
If grid.lock Then
pan_x = ((old_pan_x + -(mgx - mx)) \ grid.w) * grid.w
pan_y = ((old_pan_y + -(mgy - my)) \ grid.h) * grid.h
Else
pan_x = (old_pan_x + -(mgx - mx))
pan_y = (old_pan_y + -(mgy - my))
EndIf
EndIf
End Sub
Sub Group_Add(Group() As _obj_group_, o As Integer)
nGrpObjs += 1
oGrp(nGrpObjs).oID = o
cGrpObj = nGrpObjs
'' Attempting insert-sort (not working)
'Dim As Integer ord
'For so As Integer = 1 To n_so
' If order(so) = o Then ord = so : Exit For
'Next
'If ord = 0 Then Exit Sub
'For so As Integer = 1 To n_so
' For go As Integer = 1 To nGrpObjs
' If Group(go).oID = order(so) Then
' If ord < so Then
' nGrpObjs += 1
' For n As Integer = nGrpObjs To go Step -1
' Swap Group(n-1), Group(n)
' Next
' Group(go).oID = o
' cGrpObj = go
' Exit For,For
' Else
' nGrpObjs += 1
' Group(nGrpObjs).oID = o
' cGrpObj = nGrpObjs
' Exit For,For
' EndIf
' EndIf
' Next
'Next
End Sub
Sub Group_Select(Group() As _obj_group_, o As Integer)
'' Selection reduced to a single obj:
For i As Integer = 2 To UBound(Group)
Clear(Group(i),0,Len(_obj_group_))
Next
If o <= n_o AndAlso o > 0 Then
nGrpObjs = 1 : cGrpObj = 1
Group(1).oID = o
Else
nGrpObjs = 0 : cGrpObj = 0
Group(1).oID = 0
EndIf
End Sub
Function Group_Has(Group() As _obj_group_, o As Integer) As Integer
'' Check if object is already present in the selection group:
For n As Integer = 1 To nGrpObjs
If Group(n).oID = o Then Return n
Next
Return FALSE
End Function
Sub Group_Release(Group() As _obj_group_, o As Integer)
'' Remove an obj from the selection:
Dim As Integer found = Group_Has(oGrp(),o)
If found Then
Clear(Group(found),0,Len(_obj_group_))
For n As Integer = found To nGrpObjs
Swap Group(n), Group(n+1)
Next
nGrpObjs-=1
If cGrpObj > nGrpObjs Then cGrpObj = nGrpObjs
EndIf
End Sub
Sub Group_ReleaseAll(Group() As _obj_group_)
'' Unselect all objects:
For i As Integer = 1 To UBound(Group)
Clear(Group(i),0,Len(_obj_group_))
Next
nGrpObjs = 0 : cGrpObj = 0
End Sub
Sub Group_Sort(Group() As _obj_group_)
'' Sort group of objects by order drawn to map (latest or topmost are first in order.)
'Dim As Integer keepChecking=TRUE
'While keepChecking = TRUE
' keepChecking = FALSE
' For n As Integer = 1 To UBound(Group)-1
' If Group(n).oID AndAlso obj(Group(n).oID).ord < obj(Group(n+1).oID).ord Then Swap Group(n), Group(n+1) : keepChecking = TRUE
' Next
'Wend
End Sub
Sub _Initialize()
GL.clear_screen()
GL.set_blend_mode(GL.E_BLEND_MODE.E_BLENDED)
glColor4ub(255,255,255,255)
Dim As Integer vsync_mode = 0'GL.vsync_on()
If vsync_mode = 0 Then
'GL.Print(5,5,1.0,"vsync could not be enabled. will use fps limiting.")
db_write("VSync was not enabled. Will use FPS limiting.")
FPS_LIMIT = 60
Else
'GL.Print(5,5,1.0,"vsync was enabled. ")
db_write("VSync enabled!")
FPS_LIMIT = 0
EndIf
Dim As Integer TextureSize,TextureUnits,MaxCTIU
glGetIntegerv(GL_MAX_TEXTURE_UNITS,@TextureUnits)
glGetIntegerv(GL_MAX_TEXTURE_SIZE ,@TextureSize)
glGetIntegerv(GL_MAX_COMBINED_TEXTURE_IMAGE_UNITS,@MaxCTIU)
db_write("Max texture size: "+Str(TextureSize))
db_write("Max texture units: "+Str(TextureUnits))
db_write("Max combined texture image units: "+Str(MaxCTIU))
show_all_attr = FALSE
grid.w = 8
grid.h = 8
grid.lock = FALSE
grid.show = FALSE
cursor=Cursors.Default
edit_mode = FALSE
show_classic_gui = FALSE
c_tab = 2
ASTAR_InitMap()
SetMouse scr_w\2,scr_h\2,0
_Init_MakeList_Scripts
'_Init_MakeList_Behaviors
_Init_LoadSFX()
'' Find index for specific GUI elements:
index_frame = spr_with_id(@gui_spr(0),"frame corner1")
If index_frame = 0 Then db_write("Could not find frame gui") :Beep: _Quit()
ico_bag = spr_with_id(@gui_spr(0),"icon bag")
db_write("obj_ size: "+Str(SizeOf(_obj_)))
db_write("Initialized")
text(0,0,"Initialized")
Flip
End Sub
Sub _Init_LoadSFX()
fbs_Set_PlugPath("D:\Prog\FB\_lib\fbsound0.20\lib\win32\") '' Must be set to lib plugins or Init will fail with no error msg.
If fbs_Init(44100,2,3) = FALSE Then
db_write("*** Error: fbs_Init() = " & fbs_Get_PlugError())
_Quit(,TRUE,TRUE)
EndIf
'Const nSFX = 16
'Const BarTotalLen = 100
'Const BarSingleLen = BarTotalLen\nSFX
'#Define ShowProgress GL.line(5,15, : Flip
GL.Print(5,25,"Loading sounds and music...")
Flip
'If fbs_Load_MP3File("SFX\quiet_place.MP3",@sfxBGM)=FALSE Then _Quit("error loading sfxBGM",TRUE,TRUE)
'If fbs_Load_WAVFile("D:\My Art\Music\resource\ambient\Nature\myRain1.wav",@sfxThunder1)=FALSE Then _Quit("error loading sfxThunder",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\rainthunder_v2.wav",@sfxThunder1)=FALSE Then _Quit("error loading sfxThunder",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\footstep_sand.wav",@sfxStepSand)=FALSE Then _Quit("error loading sfxStepSand",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\arrow_draw.wav",@sfxArrowDraw)=FALSE Then _Quit("error loading sfxArrowDraw",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\arrow_release_1.wav",@sfxArrowRelease)=FALSE Then _Quit("error loading sfxArrowRelease",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\arrow_hit_1.wav",@sfxArrowHit1)=FALSE Then _Quit("error loading sfxArrowRelease",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\lightning_1.wav",@sfxLightning1)=FALSE Then _Quit("error loading sfxLightning1",TRUE,TRUE)
If fbs_Load_WAVFile("SFX\lightning_2.wav",@sfxLightning2)=FALSE Then _Quit("error loading sfxLightning2",TRUE,TRUE)
For n As Integer = 1 To 6
'If fbs_Load_WAVFile("SFX\womanstep"+Trim(Str(n))+".wav",@sfxWomanStep(n))=FALSE Then _Quit("error loading sfxWomanStep",TRUE,TRUE)
'ShowProgress
Next
For n As Integer = 1 To 8
'If fbs_Load_WAVFile("SFX\wetstep"+Trim(Str(n))+".wav",@sfxWetStep(n))=FALSE Then _Quit("error loading sfxWetStep",TRUE,TRUE)
'ShowProgress
Next
db_write("Music and sounds loaded.")
'fbs_Play_Wave(sfxThunder1)
End Sub
Sub _Init_MakeList_Scripts()
Dim As Integer ff = FreeFile, id, scriptcount=0
Open ExePath+"\story.bas" For Input As #ff
Dim As String ln
Do
Line Input #ff, ln
If LCase(Left(ln,13)) = "function scr_" Then
ln = Right(ln,Len(ln)-13)
ln = Trim(Left(ln,InStr(ln,"(")-1))
'Print "Script added: "+ln
If LCase(ln) <> "default" Then
scriptcount += 1
ReDim Preserve As ZString * 32 ListScripts(1 To scriptcount)
ListScripts(scriptcount) = ln
EndIf
EndIf
Loop Until Eof(ff)
Close #ff
End Sub
Sub _Init_MakeList_Behaviors()
'' Currently replaced by manual entries at the Dim of ListBehaviors in main module. Not sure but probably the better way of doing it.
'Dim As Integer ff = FreeFile, id, behaviorcount=0
'Open ExePath+"\alvarian tales.bi" For Input As #ff
'Dim As String ln
'
'Do
' Line Input #ff, ln
' If LCase(ln) = "enum behaving" Then
' Do
' Line Input #ff, ln
' '' Get rid of any formatting or comments around the behavior list:
' ln = Trim(ln)
' If Left(ln,1) = Chr(9) Then ln = Right(ln,Len(ln)-1)
' If InStr(ln,"=") Then ln = Left(ln,InStr(ln,"=")-1) : ln = Trim(ln)
' If InStr(ln,Chr(9)) Then ln = Left(ln,InStr(ln,Chr(9))-1)
' If InStr(ln,"'") Then ln = Left(ln,InStr(ln,"'")-1) : ln = Trim(ln)
' If LCase(ln) = "end enum" Then Exit Do, Do
' db_write("Behavior added: "+ln)
' behaviorcount += 1
' ReDim Preserve As ZString * 32 ListBehaviors(1 To behaviorcount)
' ListBehaviors(behaviorcount) = ln
' Loop
' EndIf
'Loop Until Eof(ff)
'Close #ff
End Sub
Sub interface_get_coords()
'' Direct mouse coordinates to get object destination point:
If c_o Then
If getcords.getxy = 0 AndAlso c_dest_node > 0 Then
getcords.getxy = 1
getcords.grid_lock = TRUE
getcords.x = @obj(c_o).d(c_dest_node).x
getcords.y = @obj(c_o).d(c_dest_node).y
EndIf
'' Get coordinates for object zones and points:
If getcords.getxy = 1 Then
If getcords.grid_lock Then
getcords.p->x1 = (mx\grid.w)*grid.w - (obj(c_o).x + pan_x)
getcords.p->y1 = (my\grid.h)*grid.h - (obj(c_o).y + pan_y)
Else
getcords.p->x1 = mx - (obj(c_o).x + pan_x)
getcords.p->y1 = my - (obj(c_o).y + pan_y)
EndIf
'If getcords.is_box Then getcords.getxy = 2
ElseIf getcords.getxy = 2 Then
If getcords.grid_lock Then
getcords.p->x2 = (mx\grid.w)*grid.w - (obj(c_o).x + pan_x)
getcords.p->y2 = (my\grid.h)*grid.h - (obj(c_o).y + pan_y)
Else
getcords.p->x2 = mx - (obj(c_o).x + pan_x)
getcords.p->y2 = my - (obj(c_o).y + pan_y)
EndIf
ElseIf getcords.getxy = 3 Then
If getcords.grid_lock Then
getcords.p->x3 = (mx\grid.w)*grid.w - (obj(c_o).x + pan_x)
getcords.p->y3 = (my\grid.h)*grid.h - (obj(c_o).y + pan_y)
Else
getcords.p->x3 = mx - (obj(c_o).x + pan_x)
getcords.p->y3 = my - (obj(c_o).y + pan_y)
EndIf
ElseIf getcords.getxy = 4 Then
If getcords.grid_lock Then
getcords.p->x4 = (mx\grid.w)*grid.w - (obj(c_o).x + pan_x)
getcords.p->y4 = (my\grid.h)*grid.h - (obj(c_o).y + pan_y)
Else
getcords.p->x4 = mx - (obj(c_o).x + pan_x)
getcords.p->y4 = my - (obj(c_o).y + pan_y)
EndIf
EndIf
EndIf
End Sub
Sub Create_Soul_Sheet()
'' This will combine multiple .gma files together onto a new blank sheet, including the images and sprite data.
'' During the process it will layer the currently worn clothing on the characters.
'' The result will be a prepared texture for vRam and the combined sprite data for it.
'' Currently the image found in the soul's .gma file is used to define the dimensions needed on the soul sheet, and
'' that image is diced into RAM, but it is not put on the soul sheet, only the layers are. Obviously this could be
'' adjusted so that the final layered version of the sprites are kept in RAM instead.
#Define sheet_size 4096
db_write("Create Soul Sheet Begins...")
'' Destroying character graphics from ram and Vram, clearing data.
For n As Integer = 1 To UBound(soul_spr)
glDeleteTextures( 1, @soul_spr(n).p->textureID )
ImageDestroy(soul_spr(n).p)
Clear(soul_spr(n),0,Len(GL.gfxmap_spr))
Next
For n As Integer = 1 To UBound(soul_set)
Clear(soul_set(n),0,Len(GL.gfxmap_set))
Next
ReDim soul_set(1 To 1) As GL.gfxmap_set
ReDim soul_spr(1 To 1) As GL.gfxmap_spr
Dim As GL.IMAGE Ptr SoulSheet = ImageCreate(sheet_size,sheet_size,0)
Dim As GLuint textureID
Dim As Integer ff = FreeFile
Dim As String path = ExePath+"\gfx\soul\"
Dim As Integer no_of_sets, no_of_sprs, cur_spr
Dim As Integer reserved, set_w, set_h, set_s2x, set_spr_count
Dim As Integer sprites,spr_x,spr_y,spr_w,spr_h
Dim As ZString*24 set_image_filename
Type box_
As Integer x,y,w,h,o
End Type
ReDim box() As box_
Dim As Integer no_of_box, cur_box
'' Scan for soul objs:
For n As Integer = 1 To n_o
With obj(n)
If .kind = objKinds.Soul AndAlso Len(Trim(.s.filename)) Then
If Open(path+.s.filename For Binary Access Read As #ff) Then
db_write(" error " & Err & " when opening " & path & .s.filename)
Beep
EndIf
no_of_box+=1
ReDim Preserve box(1 To no_of_box) As box_
box(no_of_box).o = n
Get #ff,,no_of_sets
Get #ff,,no_of_sprs
ReDim Preserve soul_spr(1 To soul_set(1).count + no_of_sprs) As GL.gfxmap_spr
db_write(" Importing "& .s.filename)
If no_of_sprs = 0 Then _Quit()
Get #ff,,set_image_filename
Get #ff,,set_w '' Not used here because we get the width & height from the loaded png data below.
Get #ff,,set_h '' Better in case png size changes without .gma file updating the dimensions.
Get #ff,,set_s2x
Get #ff,,set_spr_count
For r As Integer = 1 To 10 : Get #ff,,reserved : Next
Dim As GL.IMAGE Ptr setImage = png_load(path+set_image_filename, PNG_TARGET_FBNEW)
If setImage = 0 Then Beep: db_write("Error loading "+path+set_image_filename): _Quit()
db_write(" Found "& set_spr_count &" sprs. Set W="& set_w &", H="& set_h)
box(no_of_box).w = setImage->Width
box(no_of_box).h = setImage->Height
'' Insertion Sort volume of sets largest to smallest:
cur_box = no_of_box
'For b As Integer = no_of_box To 2 Step-1 '' Not working
' If box(b-1).w*box(b-1).h < box(b).w*box(b).h Then
' Swap box(b),box(b-1)
' cur_box -= 1
' EndIf
'Next
For cur_spr As Integer = 1 To set_spr_count
soul_set(1).count += 1
Get #ff,,spr_x
Get #ff,,spr_y
Get #ff,,spr_w
Get #ff,,spr_h
With soul_set(1)
Get #ff,,soul_spr(.count).id
soul_spr(.count).id = Trim(obj(n).gID) & Trim(soul_spr(.count).id)
Get #ff,,soul_spr(.count).r
Get #ff,,soul_spr(.count).ax
Get #ff,,soul_spr(.count).ay
Get #ff,,soul_spr(.count).delay
Get #ff,,soul_spr(.count).transp
For r As Integer = 1 To 5 : Get #ff,,reserved : Next
soul_spr(.count).set = @soul_set(1)
'' Keep images in RAM: (currently naked or whatever image is found here:)
soul_spr(.count).p = ImageCreate(spr_w,spr_h)
Get setImage,(spr_x,spr_y)-(spr_x+(spr_w-1),spr_y+(spr_h-1)),soul_spr(.count).p
'' Tell GL how to map this image from the texture:
soul_spr(.count).p->u_offset = spr_x
soul_spr(.count).p->v_offset = spr_y
soul_spr(.count).p->texture_width = sheet_size
soul_spr(.count).p->texture_height = sheet_size
End With
Flip
Next
ImageDestroy setImage
'' Pack box onto sheet making good use of space:
Dim As Integer KeepScanning
For b1 As Integer = 2 To no_of_box
With box(b1)
KeepScanning = TRUE
While KeepScanning
KeepScanning = FALSE
For b2 As Integer = 1 To b1
If @box(b1) <> @box(b2) Then
If BoxesOverlap(.x,.y,.x+.w,.y+.h,box(b2).x,box(b2).y,box(b2).x+box(b2).w,box(b2).y+box(b2).h) Then
KeepScanning = TRUE
.x += 1
If .x+.w > sheet_size Then .x = 0 : .y += 1
Exit For
EndIf
EndIf
Next
Flip
Wend
End With
Next
'' Update current set sprites u/v with offset of box placement.
For cur_spr As Integer = soul_set(1).count-no_of_sprs+1 To soul_set(1).count
soul_spr(cur_spr).p->u_offset += box(cur_box).x
soul_spr(cur_spr).p->v_offset += box(cur_box).y
Next
'' Load and place image layers on sprite sheet:
For lyr As Integer = 1 To MaxGFXLayers
If Len(Trim(.s.gfxLayer(lyr).filename)) Then
Dim As UInteger Ptr newLayer = png_load(path+Trim(.s.gfxLayer(lyr).filename), PNG_TARGET_FBNEW)
If newLayer = 0 Then Beep: db_write(" Error loading "+path+Trim(.s.gfxLayer(lyr).filename)): _Quit()
Put SoulSheet,(box(cur_box).x,box(cur_box).y),newLayer,Alpha
ImageDestroy(newLayer)
EndIf
Next
EndIf
End With
Close #ff
Next
'For n As Integer = 1 To no_of_box
' db_write(box(n).x & "," & box(n).y & "," & box(n).w & "," & box(n).h & "," & box(n).o)
'Next
'' Upload finished char sheet to VRAM:
textureID = GL.load_image(SoulSheet)
db_write(" Uploaded sheet to VRAM")
'' Point all sprites to textureID:
For cur_spr As Integer = 1 To soul_set(1).count
soul_spr(cur_spr).p->textureID = textureID
Next
'' Update obj pointers to correct array because Redim changes address.
For n As Integer = 1 To n_o
With obj(n)
If .Kind = objKinds.Soul Then .spr_ptr = @soul_spr(0)
End With
Next
'' Export copy of finished sheet with u/v data overlay for review.
For c As Integer = 1 To soul_set(1).count
With soul_spr(c)
Line SoulSheet,(.p->u_offset,.p->v_offset)-Step(.p->Width,.p->Height),_White,b
End With
Next
'db_write("Saving completed soul sheet to file for examination purposes.")
'BSave(path+"packed.bmp",SoulSheet)
'png_save(path+"packed.png", SoulSheet)
ImageDestroy(SoulSheet)
db_write("---- Completed: Soul Sheet ----")
End Sub
Sub scene_new(new_name As ZString Ptr)
'' To-do: Check if any objs in world have new scene name already.
scene = *new_name
scene_gather_objs() '' As the scene is new, this will only clear current scene.
Group_ReleaseAll(oGrp())
End Sub
Sub scene_view(scene_name As ZString Ptr)
'' To-do: Check to be sure scene name exists.
scene = *scene_name
scene_gather_objs()
Group_ReleaseAll(oGrp())
End Sub
Sub scene_rename(rename As ZString Ptr)
'' To-do: Make sure new name does not exist.
'' Change scene name of current scene objs to user entered name.
scene=*rename
End Sub
Sub scene_delete(scene_name As ZString Ptr)
'' To-do: Rename all world objs with current scene name to ""
'' This might not be needed.
scene = ""
scene_gather_objs()
Group_ReleaseAll(oGrp())
End Sub
Sub world_save(filename As String)
'' Reset all objs via their NewGame script:
For n As Integer = 1 To n_o
If obj(n).coded = FALSE Then obj(n).fp(@obj(n),Keys.NewGame) '' Or possibly Init(), determine which makes sense.
Next
'' Save all objects to file:
Kill ExePath & "\world\"+filename
Dim As Integer ff = FreeFile
If Open(ExePath & "\world\"+filename For Random As #ff Len=SizeOf(_obj_)) <> 0 Then
Close #ff
db_write("Error saving map: "+filename) : Beep
Else
For n As Integer = 1 To n_o
If obj(n).coded = FALSE Then
Put #ff,,obj(n)
End If
Next
Close #ff
EndIf
End Sub
Sub world_load(filename As String, ImportMode As Integer = FALSE)
'For n As Integer = n_o To 1 Step -1
' obj_delete(n)
'Next
'' Load objects from world file:
Dim As Integer ff = FreeFile
If Open(ExePath & "\world\"+filename For Random As #ff Len=SizeOf(_obj_)) <> 0 Then
Close #ff
db_write("Error loading world: "+filename) : Beep
Else
While Not Eof(ff)
n_o+=1
Get #ff,,obj(n_o)
If ImportMode = TRUE Then
Else
With obj(n_o)
obj_linkScript(n_o,.sID) '' Repoint to script function
.fp(@obj(n_o),Keys.LoadFromFile)
If .kind = objKinds.SceneObj Then
.spr_ptr = @scene_spr(0) '' Repoint to graphics array
If .ii Then .w = .spr_ptr[.ii].p->Width : .h = .spr_ptr[.ii].p->Height
EndIf
End With
EndIf
Wend
Close #ff
EndIf
db_write("Loaded world: "+filename)
scene_gather_objs()
End Sub
Sub scene_gather_objs()
'' Gather objects belonging to current scene.
'' Is not done every cycle, only when scene is changed or objs are added to / removed from.
'' Sorting is done with gathered objs only, every cycle.
'' Clear current scene:
For n As Integer = 1 To maxSceneObjs
order(n) = 0
Next
n_so = 0
For n As Integer = 1 To n_o
If LCase(Trim(obj(n).scene)) = LCase(Trim(scene)) Then
n_so += 1
If n_so <= MaxSceneObjs Then order(n_so) = n Else n_so = MaxSceneObjs : Beep : db_write("Attempted to pass max scene objs.")
EndIf
Next
End Sub
Sub scene_sort()
'' Sort scene objects to be drawn in the right order.
'' After sorting, order() contains objects from first drawn to last drawn.
Dim As Integer keepChecking=TRUE
While keepChecking=TRUE
keepChecking=FALSE
For n As Integer = 1 To n_so-1
If obj(order(n)).upright AndAlso obj(order(n+1)).upright _
AndAlso obj(order(n)).y > obj(order(n+1)).y _
Then'' If y position is greater than next ordered object, swap.
Swap order(n), order(n+1) : keepChecking = TRUE
ElseIf obj(order(n)).upright = FALSE AndAlso obj(order(n+1)).upright = FALSE _
AndAlso obj(order(n)).z > obj(order(n+1)).z _
Then'' Flat layering by .z :
Swap order(n), order(n+1) : keepChecking = TRUE
ElseIf obj(order(n)).upright = TRUE AndAlso obj(order(n+1)).upright = FALSE _
Then'' Uprights are always later than flats:
Swap order(n), order(n+1) : keepChecking = TRUE
EndIf
Next
Wend
End Sub
Sub scene_update()
scene_sort()
'' Make a run through all scene objs to see if any affect AStar map.
'' This must be done first (not included in following loop) before souls can calculate pathfinds.
If pathfind_countdown = 0 Then
ASTAR_CellClearAll()
scene_update_astarmap()
EndIf
For o As Integer = 1 To n_so
With obj(order(o))
.Anim_Update
If Len(.behavior) Then .Behave()
If pathfind_countdown = 0 Then .find_path()
If .kind = objKinds.Soul AndAlso .s.pa.typ AndAlso .s.pa.go Then .go_path()
If .de.go Then
If .go_dest() = RTRN.HitNoGo Then
.fp(@obj(order(o)),Keys.StoppedMoving)
.de.go = FALSE
EndIf
EndIf
End With
Next
If pathfind_countdown = 0 Then pathfind_countdown = pathfind_interval
pathfind_countdown -= 1
End Sub
Sub scene_update_astarmap()
For o As Integer = 1 To n_so
With obj(order(o))
'' Check if the obj is a sort that affects the AStar Map cells:
If .behavior="nogo-zone" OrElse .behavior="walk-zone" OrElse (.b.en AndAlso .b.tp = BaseIsBound) Then
Dim As Integer cellx,celly
'' Make a run through each AStar map cell:
For x As Integer = 0 To ASTAR_MAP_CELLS_WIDE -1
For y As Integer = 0 To ASTAR_MAP_CELLS_HIGH -1
'' Find cell point on the screen:
cellx = x*ASTAR_CELL_W+ASTAR_CELL_W\2+cam_x+cam_x1
celly = y*ASTAR_CELL_H+ASTAR_CELL_H\2+cam_y+cam_y1+40
'' If obj is acting as a nogo map:
If .behavior="nogo-zone" Then
If PointInBox(cellx,celly,.x,.y,.x+.w-1,.y+.h-1) _
AndAlso RGBA_A(Point(cellx-.x,celly-.y,scene_spr(.ii).p)) <> 0 _
Then
ASTAR_CellSetSolid(x,y,TRUE)
'If (x = cex And y = cey) Or (x = csx And y = csy) Then Return -1
EndIf
'' If obj is acting as a walk-zone:
ElseIf .behavior = "walk-zone" Then
' If (RGBA_A(Point(cellx-.x,celly-.y,scene_spr(.ii).p)) = 0) _
' Or (RGBA_R(Point(cellx-.x,celly-.y,scene_spr(.ii).p)) = 0 _
' And RGBA_G(Point(cellx-.x,celly-.y,scene_spr(.ii).p)) = 0 _
' And RGBA_B(Point(cellx-.x,celly-.y,scene_spr(.ii).p)) = 0) _
' Then
' ASTAR_CellSetSolid(x,y,TRUE)
' If (x = cex And y = cey) Or (x = csx And y = csy) Then Return -1
' EndIf
'' If obj has a bounded base zone:
'ElseIf .b.en AndAlso .b.tp = BaseIsBound AndAlso @This <> @obj(n) And n <> 1 Then
' If poly_xy_relationship(cellx,celly,.b,.x,.y) = Located.Within _
' Then
' ASTAR_CellSetSolid(x,y,TRUE)
' If (x = cex And y = cey) Or (x = csx And y = csy) Then Return -1
' EndIf
EndIf
Next
Next
EndIf
End With
Next
End Sub
Sub scene_focus(o As Integer, x As Integer = -9999, y As Integer = -9999)
If x = -9999 Then x = res_w\2
If y = -9999 Then y = res_h\2
pan_x = -obj(o).x + x
pan_y = -obj(o).y + y
If grid.Lock Then
pan_x = (pan_x \ grid.w) * grid.w
pan_y = (pan_y \ grid.h) * grid.h
EndIf
End Sub
Function scene_objKind_count(kind As Integer = objKinds.SceneObj) As Integer
Dim As Integer o
For n As Integer = 1 To n_so
If obj(order(n)).kind = kind Then o += 1
Next
Return o
End Function
Sub fx_lightning_strike(x As Integer, y As Integer, z As Integer=0, ambient_intensity As Integer=0) '' A lightning strike!
Randomize Timer
Dim As Integer version = Int(Rnd*2)+1
If version = 1 Then fbs_Play_Wave(sfxLightning1,1,CSng(Rnd*.4)+.8)
If version = 2 Then fbs_Play_Wave(sfxLightning2,1,CSng(Rnd*.4)+.8)
Dim As Integer l(1 To 3)
For n As Integer = 1 To 3
l(n) = obj_create_scene("lightning"&Str(n))
With obj(l(n))
.scene = scene
.x = x : .y = y - n : .z = z '' Adjust -n to layer lightning correctly.
.opacity = 255
.oID = "lightning"&Str(n)
End With
Next
scene_gather_objs()
Dim As Integer lightlevel
For c As Integer = 1 To 16
Randomize
lightlevel = Int(Rnd*56)+200
For o As Integer = 1 To n_so '' Make scene flicker darker, with a tinge more blueness
'obj(order(o)).rgb_r = lightlevel - 20
'obj(order(o)).rgb_g = lightlevel - 10
'obj(order(o)).rgb_b = lightlevel
obj(order(o)).addlight = Int(Rnd*56)+ambient_intensity '' more ambient_intensity (0-200) looks awesome in dark scenes.
Next
For n As Integer = 1 To 3
Dim As Integer opac
With obj(l(n))
.rgb_r = 255 - Int(Rnd*50) '' Give a little variation in colors
.rgb_g = 255 - Int(Rnd*50)
.rgb_b = 255 - Int(Rnd*50)
opac = Int(Rnd*256)
If n = 3 Then opac -= 160 '' Less brightness on the aux bolts.
If opac < 0 Then opac = 0
.opacity = opac
.addlight = opac
If n = 2 Then .addlight = 0 '' This image does not look good with additive.
Dim As Integer glow = Int(Rnd * 1)
If glow Then .blend_mode = E_GLOW Else .blend_mode = E_BLENDED
If c >= 15 Then .blend_mode = E_GLOW
.visible = c Mod 2
End With
Next
__continue(TRUE)
Next
For n As Integer = 3 To 1 Step -1
obj_delete(l(n))
Next
For o As Integer = 1 To n_so
obj(order(o)).rgb_r = 255
obj(order(o)).rgb_g = 255
obj(order(o)).rgb_b = 255
obj(order(o)).addlight = 0
Next
End Sub
Sub fx_spell(px As Integer,py As Integer)
/'
Static As Integer al=255, r, r2, lx
Static As Single n=1
With obj(Me)
Dim As Integer pcx = pan_x+.x+.bx, pcy = pan_y+.y+6
End With
Line Scrn2,(0,0)-(639,479),RGBa(255,255,255,0),bf
r += 2
r2 += 1
Circle Scrn2,(pcx,pcy),r2-5,RGBa(255,255,255,20),,,n
Circle Scrn2,(pcx,pcy),r2-4,RGBa(255,255,255,50),,,n
Circle Scrn2,(pcx,pcy),r2-3,RGBa(255,255,255,100),,,n
Circle Scrn2,(pcx,pcy),r2-2,RGBa(255,255,255,150),,,n
Circle Scrn2,(pcx,pcy),r2-1,RGBa(255,255,255,200),,,n
Circle Scrn2,(pcx,pcy),r2, RGBa(255,255,255,255),,,n
Circle Scrn2,(pcx,pcy),r2+1,RGBa(255,255,255,200),,,n
Circle Scrn2,(pcx,pcy),r2+2,RGBa(255,255,255,150),,,n
Circle Scrn2,(pcx,pcy),r2+3,RGBa(255,255,255,100),,,n
Circle Scrn2,(pcx,pcy),r2+4,RGBa(255,255,255,50),,,n
Circle Scrn2,(pcx,pcy),r2+5,RGBa(255,255,255,20),,,n
Circle Scrn2,(px,py),r-5,RGBa(255,0,0,20),,,n
Circle Scrn2,(px,py),r-4,RGBa(255,0,0,50),,,n
Circle Scrn2,(px,py),r-3,RGBa(255,0,0,100),,,n
Circle Scrn2,(px,py),r-2,RGBa(255,0,0,150),,,n
Circle Scrn2,(px,py),r-1,RGBa(255,0,0,200),,,n
Circle Scrn2,(px,py),r, RGBa(255,0,0,255),,,n
Circle Scrn2,(px,py),r+1,RGBa(255,0,0,200),,,n
Circle Scrn2,(px,py),r+2,RGBa(255,0,0,150),,,n
Circle Scrn2,(px,py),r+3,RGBa(255,0,0,100),,,n
Circle Scrn2,(px,py),r+4,RGBa(255,0,0,50),,,n
Circle Scrn2,(px,py),r+5,RGBa(255,0,0,20),,,n
Randomize Timer
For n As Integer = 1 To 20
lx = Int(Rnd * r*2)
Line scrn2,(px-r+lx-2,0)-(px,py),RGBa(100+lx,100+lx,100+lx,20)
Line scrn2,(px-r+lx-1,0)-(px,py),RGBa(100+lx,100+lx,100+lx,50)
Line scrn2,(px-r+lx,0)-(px,py), RGBa(100+lx,100+lx,100+lx,80)
Line scrn2,(px-r+lx+1,0)-(px,py),RGBa(100+lx,100+lx,100+lx,50)
Line scrn2,(px-r+lx+2,0)-(px,py),RGBa(100+lx,100+lx,100+lx,20)
Next
al-=1
n-=.07
'scr_alpha = 61
Put Scrn,(0,0),scrn2,Alpha
If r > 30 Then
r = 0
r2 = 0
n = 1
do_fx_spell = FALSE
End If
'/
End Sub
Sub fx_rain(andStorm As Integer = FALSE)
Randomize
#Define drops 500
Type rainxy_
As Single x,y
As Single s '' size
As UInteger c '' color rgba
As Integer travel '' travel distance
As Single speed_x
As Single speed_y
End Type
Static As rainxy_ rd(1 To drops)
Static As Integer init, cycle
Static As Double lastLightningTime,LightningTimeInterval
'' Initialize rain:
If init = FALSE Then
fbs_Play_Wave(sfxThunder1,-1)
LightningTimeInterval=5
For n As Integer = 1 To drops
With rd(n)
.x = Int(Rnd * (cam_w+cam_x1))
.y = Int(Rnd * (cam_h+cam_y1))
.s = Rnd*3 + 1
.c = RGBA(140,150,200+Int(Rnd*55),86+Int(Rnd*170))
.travel = Int(Rnd*cam_h*.66)
.speed_x = .6
.speed_y = Rnd*2+3
End With
Next
init = TRUE
EndIf
'' Move and draw rain drops:
For d As Integer = 1 To drops
With rd(d)
.y += .speed_y
.x += .speed_x
Randomize
If .y > cam_y1+cam_h\3 + .travel Then
.y = cam_y1
.x = cam_x1 + Int(Rnd * (cam_w))
End If
For n As Integer = 1 To 4
Dim As Integer opac = RGBA_A(.c)-n*50
If opac < 0 Then opac = 0
glPointSize( .s )
GL.pixel(.x-n*.1,.y-n,RGBA(RGBA_R(.c),RGBA_G(.c),RGBA_B(.c),opac))
Next
End With
Next
glPointSize( SCR_S )
If andStorm Then
If Timer - lastLightningTime > LightningTimeInterval Then
cycle += 1
If cycle <= 16 Then
Randomize
Dim As Integer lightlevel = Int(Rnd*56)+20
For o As Integer = 1 To n_so
obj(order(o)).addlight = lightlevel
Next
Else
cycle=0
lastLightningTime = Timer
LightningTimeInterval=Int(Rnd*20)+5
For o As Integer = 1 To n_so
obj(order(o)).addlight = 0
Next
EndIf
EndIf
EndIf
End Sub
Sub fx_snow()
/'
#Define drops 500
Type rain_
As Single x,y
End Type
Static As rain_ rd(1 To drops)
Static As Integer init, fxopacity=80
If init = FALSE Then
Randomize Timer
For n As Integer = 1 To drops
With rd(n)
.x = Int(Rnd * (res_w+200))-200
.y = Int(Rnd * (res_h-1))
End With
Next
init = TRUE
End If
'Line Scrn2,(0,0)-(res_w-1,res_h-1),_Transp, BF
Randomize Timer
For n As Integer = 1 To drops
With rd(n)
.y += Int(Rnd*4)+2
.x += 1
If .y > Int(Rnd*res_h)+res_h\2 Then
.y = 0
.x = Int(Rnd * (res_w+100))-100
End If
Line Scrn,(.x,.y)-Step(1,2),RGB(255,255,255)
Line Scrn,(.x+1,.y)-Step(1,2),RGB(255,255,255)
End With
Next
'Put Scrn,(0,0),scrn2,Alpha,scr_alpha
'/
End Sub
Function _obj_.LoadedFromFile() As Integer
'' Reset variables that are not important, such as timers. This may more logically be done during save.
With This
'.op.lastSwitchTime = 0
End With
End Function
Sub _obj_.face(direction As Integer)
With This
.facing = direction
End With
End Sub
Sub _obj_.Anim_Set(anim As ZString Ptr, program As Integer = Looping, Delay_Mod As Integer = 0)
'' Check if animation needs changing, format id for new animation, load it.
With This
If Trim(*anim) <> Trim(.anim) Or .facing <> .wasfacing Then
.anim = *anim
Dim As ZString*32 anim_id
If .facing Then
Dim As Integer direction = .facing
If .facing = 2 AndAlso .autoflip Then direction = 2 : .flip = GL.E_FLIP_MODE.E_NONE '' Remove flip horizontally
If .facing = 4 AndAlso .autoflip Then direction = 2 : .flip = GL.E_FLIP_MODE.E_H '' Direction 4 is direction 2 because it will draw flipped.
If .only_LR = TRUE Then direction = 1
anim_id = "("+Trim(.anim)+")"+Trim(Str(direction))+"*"
Else
anim_id = "("+Trim(.anim)+")*"
EndIf
'' Clear current anim data:
'' Load animation frames by using its id. ex: "(walk)2*"
Dim As ZString*32 spr_id
Dim As Integer frame
Do
frame += 1
If frame > maxAnimFrames Then Exit Do
spr_id = Trim(.gID) & Trim(anim_id) & frame
.an.f(frame).ii = spr_with_id(.spr_ptr, spr_id, FALSE)
If .an.f(frame).ii Then
.an.f(frame).id = .spr_ptr[.an.f(frame).ii].id
.an.f(frame).delay = .spr_ptr[.an.f(frame).ii].delay + Delay_Mod
.an.f(frame).opacity = 255-.spr_ptr[.an.f(frame).ii].transp
Else
If frame = 1 Then db_write("Could not find sprite with id: "&spr_id)
Exit Do '' No more frames for this animation, so quit looking.
EndIf
Loop
.an.enabled = TRUE
.an.total_frames = frame-1
.an.program = program
.an.played = 0
.an.countdown = .an.f(1).delay
.an.frame = 1
.wasfacing = .facing
EndIf
End With
End Sub
Sub _obj_.Anim_Set(imgs() As GL.gfxmap_spr, program As Integer, prefix As ZString Ptr = 0, cmd As ZString Ptr)
'' Example: .Anim_Set(.spr_ptr,Looping,"Arian","pre:talk 2*1,6 op:100 snd:step1 2*4,6 2*3,6 3*1,6 pre:stand 2*1,10"
'' Commands: pre: = id prefix which continues for subsequent frames until changed
'' #*#,# = direction * frame , delay time
'' op = opacity for frame, otherwise 255
'' snd = sound for frame, otherwise none
End Sub
Sub _obj_.Anim_Update()
Randomize
'' Update opacity program:
If op.min < op.max Then
If op.step = 0 Then op.step = 1
If op.countdown < 1 Then
If op.program = Randomized Then
opacity = Int(Rnd*op.max-op.min)+op.min
op.countdown = op.delay_step
Else'' Loop with reverse:
If opacity > op.min AndAlso opacity < op.max Then
op.countdown = op.delay_step
opacity += op.step
EndIf
If opacity >= op.max Then
opacity = op.max
If Sgn(op.step) = 1 Then op.step = -op.step '' Use Sgn to prevent possibly waiting twice at max.
If op.disable_step Then
op.disable_step = FALSE
op.countdown = op.delay_step
opacity += op.step
Else
op.disable_step = TRUE
op.countdown = op.delay_at_min
EndIf
ElseIf opacity <= op.min Then
opacity = op.min
If Sgn(op.step) = -1 Then op.step = -op.step '' Use Sgn to prevent possibly waiting twice at min.
If op.disable_step Then
op.disable_step = FALSE
op.countdown = op.delay_step
opacity += op.step
Else
op.disable_step = TRUE
op.countdown = op.delay_at_max
EndIf
EndIf
EndIf
EndIf
If op.delay_flux Then
Dim r As Integer = Int(Rnd * 3)-1
op.countdown += r
EndIf
op.countdown -= 1
EndIf
If an.enabled = FALSE Then Exit Sub
If an.frame = 0 Then an.frame = 1
If an.played < an.program OrElse an.program = Looping Then
If an.countdown <= 0 Then
an.frame += 1
fp(@This,Keys.AnimNewFrame)
If an.frame > an.total_frames Then
an.played += 1
If an.program <> Looping And an.played = an.program Then
an.frame = an.total_frames
fp(@This,Keys.AnimFinishedPlayCount)
Exit Sub
Else
an.frame = 1
'fp(@This,Keys.AnimFinishedOneLoop)
EndIf
EndIf
an.countdown = an.f(an.frame).delay
Else
If an.delay_flux Then
Dim r As Integer = Int(Rnd * 3)-1
an.countdown += r
EndIf
an.countdown -= 1
EndIf
EndIf
End Sub
Function _obj_.Behave() As Integer
'' Do the object behaviors:
Randomize Timer
With This
'' Visibility based on edit mode:
'If .behavior = "nogo-zone" AndAlso show_all_attr = FALSE Then .visible = FALSE
End With
Return 0
End Function
Sub _obj_.Set_Scale(scale As Single, include_polys As Integer = TRUE)
#Macro reset_poly#
p->x1 /= .scale : p->y1 /= .scale
p->x2 /= .scale : p->y2 /= .scale
p->x3 /= .scale : p->y3 /= .scale
p->x4 /= .scale : p->y4 /= .scale
#EndMacro
#Macro scale_poly#
p->x1 *= .scale : p->y1 *= .scale
p->x2 *= .scale : p->y2 *= .scale
p->x3 *= .scale : p->y3 *= .scale
p->x4 *= .scale : p->y4 *= .scale
#EndMacro
dim as _poly_ ptr p
With This
If include_polys Then
p = @.b : reset_poly#
p = @.tr : reset_poly#
p = @.v : reset_poly#
p = @.mz : reset_poly#
EndIf
.scale = scale
p = @.b : scale_poly#
p = @.tr : scale_poly#
p = @.v : scale_poly#
p = @.mz : scale_poly#
End With
End Sub
Sub _obj_.Draw_Self()
With This
If .an.enabled AndAlso .an.frame Then .ii = .an.f(.an.frame).ii
'' Don't draw objects not visible:
If .visible = FALSE Then Exit Sub
If .ii Then
'' Don't draw objects out of view:
If (pan_x+.x+.w-.spr_ptr[.ii].ax>=cam_x1 _
And pan_y+.y+.h-.spr_ptr[.ii].ay>=cam_y1 _
And pan_x+.x-.spr_ptr[.ii].ax And pan_y+.y-.spr_ptr[.ii].ay Exit Sub
EndIf
'' Maintain object size with animation frame size:
'.w = spr_ptr[.ii].p->Width
'.h = spr_ptr[.ii].p->Height
'' Draw shadow:
'glColor4ub(255,255,255,60)
'Dim As Single scalemod = ((Abs(-4+ Abs(8*Frac(.an.frame/8)-5))+1)/4)*.scale+scrscale
'GL.ellipse_filled
'If .facing = drUP Or .facing = drDN Then
' GL.sprite_scale_wh(pan_x+.x-(shadow_spr(.s.shadow).p->Width *(.scale)\2), _
' pan_y+.y-(shadow_spr(.s.shadow).p->Height*(.scale+scalemod)\2), _
' .scale, .scale+scalemod, shadow_spr(.s.shadow).p )
'ElseIf .facing = drRT Or .facing = drLF Or .facing = drUR Or .facing = drUL Or .facing = drDR Or .facing = drDL Then
' GL.sprite_scale_wh(pan_x+.x-(shadow_spr(.s.shadow).p->Width *(.scale+scalemod)\2), _
' pan_y+.y-(shadow_spr(.s.shadow).p->Height*(.scale)\2), _
' .scale+scalemod, .scale, shadow_spr(.s.shadow).p )
'EndIf
Dim As Single at_x, at_y
If .upright OrElse (.spr_ptr[.ii].ax <> 0 And .spr_ptr[.ii].ay <> 0) Then
'' Flip adjustment .ax as well if drawing sprite flipped:
Dim As Integer ax
If .flip = GL.E_FLIP_MODE.E_H Then : ax = .spr_ptr[.ii].p->Width*.scale - .spr_ptr[.ii].ax*.scale
Else : ax = .spr_ptr[.ii].ax*(.scale)
EndIf
at_x = pan_x+.x-ax-.z
at_y = pan_y+.y-(.spr_ptr[.ii].ay*(.scale))-.z
'at_x = pan_x+.x-.w\2+(.spr_ptr[.ii].ax*(.scale))
'at_y = pan_y+.y-.h\2+(.spr_ptr[.ii].ay*(.scale))-.z
'If .kind = objKinds.Soul AndAlso .s.shadow Then GL.ellipse_filled(pan_x+.x,pan_y+.y,9,3,0,RGBA(0,0,0,60)) '' Temporary shadow (too high res and no animation)
'GL.set_blend_mode(GL.E_GLOW)
'For r As Integer = 1 To 32
'GL.circle_2d_filled(obj(1).x,obj(1).y-12,r,RGBA(2,2,2,1))
' GL.line_glow(obj(1).x,obj(1).y-8,obj(1).x,obj(1).y-26,32,RGB(0,0,255))
'Next
'GL.set_blend_mode(GL.E_BLENDED)
ElseIf .upright=FALSE Then
at_x = pan_x+Fix(.x)
at_y = pan_y+Fix(.y)
EndIf
If .blend_mode Then GL.set_blend_mode(.blend_mode) Else GL.set_blend_mode(GL.E_BLENDED)
If .an.enabled AndAlso .opacity = 255 Then
glColor4ub(.rgb_r,.rgb_g,.rgb_b,.an.f(.an.frame).opacity)
Else
glColor4ub(.rgb_r,.rgb_g,.rgb_b,.opacity)
EndIf
GL.sprite_multi(at_x,at_y,.scale+.scale_mod_w,.scale+.scale_mod_h,.flip,.spr_ptr[.ii].p)
If .addlight Then
glBlendFunc(GL_ONE, GL_ONE)
glColor4ub(.addlight,.addlight,.addlight,255)
GL.sprite_multi(at_x,at_y,.scale+.scale_mod_w,.scale+.scale_mod_h,.flip,.spr_ptr[.ii].p)
EndIf
Else
text(cam_x1,cam_y1,"obj "+Str(obj_FindIndex(@This))+" has no frame.",_Red,3)
EndIf
'Static As Integer c
'c += 1
'If c > 2 Then GL.set_blend_mode(GL.E_BLENDED) : c =0
GL.set_blend_mode(GL.E_BLENDED)
glColor4ub(255,255,255,255)
End With
End Sub
Sub _obj_.Draw_attr()
With This
If .b.en Then .draw_poly(.b,_Red,_Red)
If .upright Then
GL.pixel(pan_x+Fix(.x),pan_y+Fix(.y),_Orange)
'GL.line(pan_x+.x-8,pan_y+.y,pan_x+.x+8,pan_y+.y,_Orange)
'GL.line(pan_x+.x,pan_y+.y,pan_x+.x,pan_y+.y-.z,_Yellow)
'GL.line(pan_x+.x,pan_y+.y+4,pan_x+.x,pan_y+.y-4,_Orange)
EndIf
If .tr.en Then .draw_poly(.tr,_Green,_Yellow)
If .mz.en Then .draw_poly(.mz,_Pink,RGBA(255,100,255,255))
If .v.en Then .draw_poly(.v,_Orange,_Orange)
If .de.node Then
GL.line(pan_x+.x,pan_y+.y,pan_x+.d(.de.node).x,pan_y+.d(.de.node).y,_Orange)
GL.circle_2d(pan_x+.d(.de.node).x,pan_y+.d(.de.node).y,ASTAR_CELL_W\2,_Orange)
EndIf
If .kind = objKinds.Soul Then
If .s.pa.typ = PathfindType.FollowObject Then
'' Draw following grid:
Dim As Integer x1,y1,x2,y2
For y As Integer = 0 To ASTAR_MAP_CELLS_HIGH-1
For x As Integer = 0 To ASTAR_MAP_CELLS_WIDE-1
x1 = pan_x + ((Fix((.x)/ASTAR_CELL_W)+x-ASTAR_MAP_CELLS_WIDE\2)*ASTAR_CELL_W )
y1 = pan_y + ((Fix((.y)/.s.pa.sh)+y-ASTAR_MAP_CELLS_HIGH\2)*.s.pa.sh )
x2 = x1+ASTAR_CELL_W-1
y2 = y1+.s.pa.sh-1
GL.box(x1,y1,x2,y2,DW_RGBA(55,55,55,255)) '' Open cell
If ASTARMAP((ASTAR_MAP_CELLS_WIDE*(y))+(x)).IsSolid Then GL.box(pan_x+x1,pan_y+y1,pan_x+x2,pan_y+y2,RGBA(255,0,0,100)) '' Closed cell
'text(Scrn,x1,y1-y*.s.pa.sh-10,Str(x),,IIf(x And 1,RGB(0,100,180),_White),,,Fonts.Four)
Next
' text(Scrn,x1-x*.s.pa.sw,y1,Str(y),,IIf(y And 1,RGB(0,100,180),_White),,,Fonts.Four)
Next
'' Draw the path:
For n As Integer = 1 To .s.pa.count
Dim As Integer x,y
x = pan_x+((Fix((.x)/ASTAR_CELL_W)+.s.p(n).x-ASTAR_MAP_CELLS_WIDE\2)*ASTAR_CELL_W )
y = pan_y+((Fix((.y)/ASTAR_CELL_H)+.s.p(n).y-ASTAR_MAP_CELLS_HIGH\2)*ASTAR_CELL_H )
'Line Scrn,(x,y)-(x+.s.pa.sw-1,y+.s.pa.sh-1),_Yellow,b '' Path cell
'GL.box(x,y,x+ASTAR_CELL_W-1,y+ASTAR_CELL_H-1,_Yellow)
GL.Pixel(x,y,_Yellow)
Next
ElseIf .s.pa.typ = PathfindType.StaticToScreen Then
'' Draw the path:
For n As Integer = 1 To .s.pa.count
Dim As Integer x,y
x = .s.p(n).x * ASTAR_CELL_W
y = .s.p(n).y * ASTAR_CELL_H
'Line Scrn,(x,y)-(x+.s.pa.sw-1,y+.s.pa.sh-1),_Yellow,b '' Path cell
'GL.box(cam_x1+x, cam_y1+40+y, cam_x1+x+.s.pa.sw-1, cam_y1+40+y+.s.pa.sh-1, RGBA(255,255,0,100))
GL.pixel(cam_x1+x, cam_y1+40+y, RGBA(255,255,0,100))
Next
'Line Scrn,(pan_x+.x+.bx,pan_y+.y+.by)-(pan_x+.s.pa.x,pan_y+.s.pa.y),_Yellow '' Line to end x/y
GL.line(pan_x+.x,pan_y+.y,pan_x+.s.pa.x,pan_y+.s.pa.y,RGBA(255,0,100,180))
EndIf
'Circle Scrn,(pan_x+.x+.bx,pan_y+.y+.by),.s.senserad,RGB(255,0,155)
'GL.circle_2d(pan_x+Fix(.x),pan_y+Fix(.y),.s.range,RGBA(0,0,255,55))
EndIf
If .locked Then
If .ii AndAlso (.upright Or (.spr_ptr[.ii].ax <> 0 And .spr_ptr[.ii].ay <> 0)) Then
GL.box( pan_x+.x-.spr_ptr[.ii].ax*.scale, _
pan_y+.y-.spr_ptr[.ii].ay*.scale-.z, _
pan_x+.x-.spr_ptr[.ii].ax*.scale + .w*.scale, _
pan_y+.y-.spr_ptr[.ii].ay*.scale + .h*.scale, _Red)
ElseIf .ii Then
GL.box(pan_x+.x,pan_y+.y,pan_x+.x+.w*.scale,pan_y+.y+.h*.scale,_Red)
End If
EndIf
End With
End Sub
Sub _obj_.Draw_Poly(p As _poly_, lclr As UInteger = _Blue, jclr As UInteger = _Green)
'' Draw poly zone, line color, joint color
'' Removed scale as poly values are now adjusted when obj is scaled
With This
GL.quad(pan_x+.x+p.x1,pan_y+.y+p.y1, _
pan_x+.x+p.x2,pan_y+.y+p.y2, _
pan_x+.x+p.x3,pan_y+.y+p.y3, _
pan_x+.x+p.x4,pan_y+.y+p.y4, lclr)
'GL.quad(pan_x+.x +p->x1,pan_y+.y +p->y1, _
' pan_x+.x +p->x2,pan_y+.y +p->y2, _
' pan_x+.x +p->x3,pan_y+.y +p->y3, _
' pan_x+.x +p->x4,pan_y+.y +p->y4, lclr)
'GL.quad(pan_x+.x +p->x1*.scale,pan_y+.y +p->y1*.scale, _
' pan_x+.x +p->x2*.scale,pan_y+.y +p->y2*.scale, _
' pan_x+.x +p->x3*.scale,pan_y+.y +p->y3*.scale, _
' pan_x+.x +p->x4*.scale,pan_y+.y +p->y4*.scale, lclr)
'GL.circle_2d(pan_x+.x +p->x1*.scale,pan_y+.y +p->y1*.scale,3,jclr)
'GL.circle_2d(pan_x+.x +p->x2*.scale,pan_y+.y +p->y2*.scale,3,jclr)
'GL.circle_2d(pan_x+.x +p->x3*.scale,pan_y+.y +p->y3*.scale,3,jclr)
'GL.circle_2d(pan_x+.x +p->x4*.scale,pan_y+.y +p->y4*.scale,3,jclr)
End With
End Sub
Function _obj_.at_dest() As Integer
With This
If Fix(.x) = .d(.de.node).x AndAlso Fix(.y) = .d(.de.node).y Then Return TRUE
End With
Return FALSE
End Function
Function _obj_.Go_Dest() As Integer
With This
If .de.node = 0 Then .de.node = 1
If .de.cycle = 0 Then .de.cycle = 1
'' Check if object has reached destination and calculate next destination.
If (Fix(.x) = .d(.de.node).x) AndAlso (Fix(.y) = .d(.de.node).y) Then
If .de.countdown = 0 Then
.fp(@This,Keys.ReachedDest) '' Script executed after delay in case it's wanted. Set delay at that node to 0 if not wanted.
Select Case .d(.de.node).go
Case dNodes.Stop : .de.go = FALSE : Return 0
Case dNodes.Reverse : .de.cycle = -.de.cycle : .de.node += .de.cycle
Case dNodes.Random : Randomize : .de.node = Int(Rnd * 10) + 1
Case dNodes.First : .de.node = 1
Case Else : .de.node += .de.cycle
End Select
If .de.node > 10 Then .de.node = 10
If .de.node < 1 Then .de.node = 1
.de.countdown = .d(.de.node).delay
Else
.de.countdown -= 1
If .d(.de.node).face Then .facing = .d(.de.node).face
.fp(@This,Keys.WaitingAtNode)
End If
Else
Dim As Integer hx = Sgn(.d(.de.node).x-(.x)) '' Heading positive/negative direction x/y
Dim As Integer hy = Sgn(.d(.de.node).y-(.y))
Dim As Integer dx = Abs(.d(.de.node).x-(.x)) '' Distance from destination x/y
Dim As Integer dy = Abs(.d(.de.node).y-(.y))
Dim As Single rx = IIf(dx Dim As Single ry = IIf(dy
.Face_xy(.d(.de.node).x,.d(.de.node).y)
.sx = Abs(rx) : .sy = Abs(ry) '' Set moving speed x/y to rx/ry
Function = .Move((hx),(hy)) '' Move in the direction of heading x/y
End If
End With
End Function
Function _obj_.Go_Path() As Integer
With This
If .s.pa.count > 1 Then
'' If object has reached the cell, proceed to next cell. (This keeps object moving along path between fresh path finds.)
If Fix(.x)=.d(1).x And Fix(.y)=.d(1).y Then .s.pa.count-=1
'' Constantly point destination to cell center. (May be better than calculating only when cell is reached if camera is moving around.)
'.d(1).x = (.s.p(.s.pa.count).x)*ASTAR_CELL_W+ASTAR_CELL_W\2+cam_x+cam_x1
'.d(1).y = (.s.p(.s.pa.count).y)*ASTAR_CELL_H+ASTAR_CELL_H\2+cam_y+cam_y1+40
.d(1).x = (.s.p(.s.pa.count).x)+cam_x+cam_x1
.d(1).y = (.s.p(.s.pa.count).y)+cam_y+cam_y1+40
ElseIf .s.pa.count <= 1 Then
'' Set destination to exact pixel within ending cell:
.d(1).x = .s.pa.x
.d(1).y = .s.pa.y
.s.pa.go = FALSE
EndIf
End With
Return 0
End Function
Function _obj_.Find_Path() As Integer
'Dim As Integer path_obj = obj_with_sID(this.sID)
'db_write("object #"&Str(path_obj)&" -> find_path()")
With This
'' Set starting and ending cells x/y based on pathfind type:
Dim As Integer csx,csy,cex,cey
If .s.pa.typ = PathfindType.FollowObject Then
'csx = (ASTAR_MAP_CELLS_WIDE\2)
'csy = (ASTAR_MAP_CELLS_HIGH\2)
'cex = csx + Fix(.s.pa.x/.s.pa.sw)-Fix((.x)/.s.pa.sw)
'cey = csy + Fix(.s.pa.y/.s.pa.sh)-Fix((.y)/.s.pa.sh)
ElseIf .s.pa.typ = PathfindType.StaticToScreen Then
csx = (.x-cam_x-cam_x1)'\ASTAR_CELL_W
csy = (.y-cam_y-cam_y1-40)'\ASTAR_CELL_H
cex = (.s.pa.x-cam_x-cam_x1)'\ASTAR_CELL_W
cey = (.s.pa.y-cam_y-cam_y1-40)'\ASTAR_CELL_H
EndIf
If csx < 0 Then csx = 0
If csy < 0 Then csy = 0
If csx > ASTAR_MAP_CELLS_WIDE-1 Then csx = ASTAR_MAP_CELLS_WIDE-1
If csy > ASTAR_MAP_CELLS_HIGH-1 Then csy = ASTAR_MAP_CELLS_HIGH-1
If cex < 0 Then cex = 0
If cey < 0 Then cey = 0
If cex > ASTAR_MAP_CELLS_WIDE-1 Then cex = ASTAR_MAP_CELLS_WIDE-1
If cey > ASTAR_MAP_CELLS_HIGH-1 Then cey = ASTAR_MAP_CELLS_HIGH-1
'db_write("...calculated cell start: "&Str(csx)&","&Str(csy)&" and end: "&Str(cex)&","&Str(cey))
ASTAR_CellSetStart(csx,csy)
ASTAR_CellSetEnd(cex,cey)
ASTAR_Compute()
'' Give computed path to the obj.
.s.pa.count = 0
dim c as _ASTAR_CELL_ ptr = EndCell
while( c->parent )
.s.pa.count += 1
If .s.pa.count > MaxObjPathFindCells Then .s.pa.count-=1 : Exit While
.s.p(.s.pa.count).x = c->x
.s.p(.s.pa.count).y = c->y
c = c->parent
Wend
End With
'db_write("...finished find_path()")
End Function
Function _obj_.WalkTo(x As Integer, y As Integer, relative_ As Integer = TRUE, wait_for_reach As Integer = TRUE) As Integer
With This
.s.pa.x = x
.s.pa.y = y
If relative_ Then
.s.pa.x += .x
.s.pa.y += .y
EndIf
.s.pa.go = TRUE
.de.go = TRUE
.d(1).go = dNodes.Stop
'' Although pathfind works every n amount of time, we want to pathfind right away:
'LastPathFindTime=Timer-PathFindTimeInterval
pathfind_countdown = 0
If wait_for_reach Then
While .de.go
__continue(FALSE)
Wend
EndIf
End With
Return 0
End Function
Function _obj_.Cycle_X() As Integer
Dim As Integer Cycled
With This
.cyclex += .sx
If .cyclex >= 1 Then
Cycled = TRUE
.cyclex -= Fix(.cyclex)
EndIf
End With
Return Cycled
End Function
Function _obj_.Cycle_Y() As Integer
Dim As Integer Cycled
With This
.cycley += .sy
If .cycley >= 1 Then
Cycled = TRUE
.cycley -= Fix(.cycley)
EndIf
End With
Return Cycled
End Function
Function _obj_.Move(ax As Single, ay As Single, f As Integer = 0) As Integer
If f Then this.facing = f Else this.face_xy(this.x+ax,this.y+ay)
Dim As Integer ScrReturn=fp(@This,Keys.Move)
If ScrReturn Then
'this.x -= x
'this.y -= y
Return 0'ScrReturn
EndIf
Dim As Integer check(1 To 3) '' Check center pixel first, then ones next to it.
check(1) = 0
check(2) = -1
check(3) = 1
Dim As Integer d
If ay Then d = (Sgn(ay) + 2)
If ax Then d = (-Sgn(ax) + 3)
If d=0 Then Return 0
Dim As Integer tx = Fix(this.x + ax) , ty = Fix(this.y + ay) '' tx,ty meaning test x,y for point or pixel checking
Dim As Integer Result, CheckBothCycles
For n As Integer = 1 To n_so
With obj(order(n))
If @obj(order(n)) <> @This Then
Dim As Integer ox = Fix(.x), oy = Fix(.y)
If .tr.en Then
'' Is THIS object within any other object's trigger zone?
If poly_xy_relationship(tx,ty,.tr) = Located.Within Then .fp(@obj(n),Keys.Entered_My_Trig,@This)
ElseIf This.tr.en Then
'' Is any other object within THIS object's trigger zone?
If poly_xy_relationship(ox,oy,This.tr) = Located.Within Then This.fp(@This,Keys.Entered_My_Trig,@obj(n))
EndIf
''' These collisions are skipped if pathfinding:
If this.s.pa.go = FALSE Then
'' Is THIS object walking into a bounded base zone?
If .b.en=TRUE And .b.tp = BaseIsBound Then '' Counter-clockwise base polys only.
If poly_xy_relationship(tx,ty,.b) = Located.Within Then
Result = HitNoGo
'Exit For
EndIf
EndIf
'' Is THIS object walking into a nogo-map object?
If .behavior = "nogo-zone" Then
If PointInBox(tx,ty,ox,oy,ox+.w-1,oy+.h-1) Then
Result = HitNoGo
For r As Integer = 1 To 3
Dim As Integer rx = check(r)*(d And 1)
Dim As Integer ry = check(r)*(d-1 And 1)
If RGBA_A(Point(tx+rx-ox,ty+ry-oy,scene_spr(.ii).p)) = 0 Then
If check(r) Then
checkBothCycles = TRUE
ax += rx
ay += ry
Else
ax += rx
ay += ry
EndIf
Result = 0
Exit For
EndIf
Next
If Result = HitNoGo Then Exit For
End If
EndIf
EndIf
'' Is THIS object walking off the valid area of a walk-zone object?
If .behavior = "walk-zone" Then
If PointInBox(tx,ty,ox,oy,ox+.w-1,oy+.h-1) Then
Dim As UInteger clr = Point(tx-ox,ty-oy,scene_spr(.ii).p)
Dim As UByte c_r = RGBA_R(clr), c_g = RGBA_G(clr), c_b = RGBA_B(clr), c_a = RGBA_A(clr)
If (c_a=0) OrElse (c_r=0 And c_g=0 And c_b=0) Then
Result = HitNoGo
Exit For
ElseIf c_a > 0 And (c_r > 0 Or c_g > 0 Or c_b > 0) Then
'' walk-zone special features:
This.scale = (c_r/100) * .5'.75
Dim As Single speedmod = (Abs(-4+ Abs(8*Frac(this.an.frame/8)-4))+1)/4
this.sy = c_g/100 - (speedmod*1.2 +(1.2*(-.scale)))
this.sx = c_b/80 - (speedmod*1.2 +(1.2*(-.scale)))
EndIf
EndIf
EndIf
If .kind = objKinds.Soul And .s.sensing.base Then
'' Is THIS object within any other object's sense radius?
If Sqr( ((tx-(ox))*(tx-(ox)) ) + ((ty-(oy))*(ty-(oy)) ) ) <= .s.sensing.base Then .fp(@obj(n),Keys.Entered_My_SenseRad,@This)
ElseIf This.kind = objKinds.Soul And This.s.sensing.base Then
'' Is any other object within THIS object's sense radius?
If Sqr( ((ox-(tx))*(ox-(tx)) ) + ((oy-(ty))*(oy-(ty)) ) ) <= This.s.sensing.base Then This.fp(@This,Keys.Entered_My_SenseRad,@obj(n))
EndIf
End If
End With
Next
If Result=HitNoGo Then
Return Result
Else
If checkBothCycles Then
If this.Cycle_X() AndAlso this.Cycle_Y() Then
This.x += ax
this.y += ay
EndIf
Else
If this.Cycle_X() Then This.x += ax
If this.Cycle_Y() Then this.y += ay
EndIf
EndIf
This.fp(@This,Keys.Moved)
Return 0
End Function
Sub _obj_.Face_obj(o As _obj_ Ptr)
this.face_xy(o->x,o->y)
End Sub
Function _obj_.Face_xy(x As Integer, y As Integer) As Integer
If FacingDirections = 4 Then
'' 4-Direction Method:
Dim As Integer xdist, ydist, greater
xdist = x - (this.x)
ydist = y - (this.y)
If Abs(xdist) > Abs(ydist) - 20 Then greater = xdist Else greater = ydist
If greater = xdist Then
If xdist < 0 Then this.facing = 4
If xdist > 0 Then this.facing = 2
Else
If ydist < 0 Then this.facing = 1
If ydist > 0 Then this.facing = 3
EndIf
ElseIf FacingDirections = 8 Then
'' 8-Directional Method:
Dim As Integer dy = y-(this.y), dx = x-(this.x)
Dim As Integer angle = Atan2(dy,dx)* 180/PI + 180
Dim As Integer step8
'' Old
'If angle >= 71 And angle <= 110 Then step8 = 1
'If angle >= 111 And angle <= 170 Then step8 = 2
'If angle >= 171 And angle <= 190 Then step8 = 3
'If angle >= 191 And angle <= 250 Then step8 = 4
'If angle >= 251 And angle <= 290 Then step8 = 5
'If angle >= 291 And angle <= 350 Then step8 = 6
'If (angle >= 0 And angle <= 10) Or (angle >= 351 And angle <= 360) Then step8 = 7
'If angle >= 11 And angle <= 70 Then step8 = 8
'' New
step8 = angle \ 45 -1
If step8 > 8 Then step8 = step8 - 8
If step8 < 1 Then step8 = step8 + 8
This.facing = step8
EndIf
Return 0
End Function
Function obj_linkScript(o as integer, sID As ZString Ptr, key As Keys = 0) As Integer
if o = createObj then
n_o += 1
o = n_o
EndIf
With obj(o)
.sID = *sID
Select case Trim(*sID)
Case "arian": .fp = @scr_Arian
Case "aya": .fp = @scr_Aya
Case "bunny1": .fp = @scr_Bunny1
Case "bunny2": .fp = @scr_Bunny2
Case "spider": .fp = @scr_Spider
Case "crab": .fp = @scr_Crab
'Case "arrow": .fp = @scr_Arrow
'Case "worm": .fp = @scr_Worm
'Case "door": .fp = @scr_Door
'Case "enterhouse1": .fp = @scr_EnterHouse1
'Case "city": .fp = @scr_City
Case "alvarian river": .fp = @scr_Item_AlvarianRiver
Case Else
.fp = @scr_General
Return o
End Select
If key Then .fp(@obj(o),key)
End With
Return o
End Function
Function obj_create_scene(gID As ZString Ptr, anim As ZString Ptr = 0, upright As Integer = TRUE, fp As Any Ptr = 0, key As Keys = 0) As Integer
n_o += 1
With obj(n_o)
If fp Then .fp = fp
.coded = TRUE
.kind = objKinds.sceneObj
.upright = upright
.spr_ptr = @scene_spr(0)
.gID = *gID
.ii = spr_with_id(.spr_ptr,.gID,TRUE)
If Len(Trim(*anim)) Then .anim_set(*anim)
If .ii Then
.w = .spr_ptr[.ii].p->Width
.h = .spr_ptr[.ii].p->Height
ElseIf .an.total_frames Then
.w = .spr_ptr[.an.f(1).ii].p->Width
.h = .spr_ptr[.an.f(1).ii].p->Height
EndIf
If key Then .fp(@obj(n_o),key)
End With
Return n_o
End Function
Sub obj_create_soul(fp As Any Ptr, key As Keys = 0)
n_o += 1
With obj(n_o)
If fp Then .fp = fp
.coded = TRUE
.kind = objKinds.Soul
.upright = TRUE
.spr_ptr = @soul_spr(0)
.autoflip = TRUE
.fp(@obj(n_o),Keys.Init)
If key Then .fp(@obj(n_o),key)
End With
End Sub
Sub obj_delete(o As Integer, onlyIfSceneObj As Integer = FALSE)
If o < 1 Or o > maxObjs Then Exit Sub
If onlyIfSceneObj Then
If obj(o).kind <> objKinds.SceneObj And obj(o).kind <> objKinds.SceneObjItem Then Exit Sub
EndIf
Dim As Integer n
For n = o To maxObjs - 1
obj(n) = obj(n + 1)
Next
obj(maxObjs).constructor '' Clears obj.
n_o -= 1
If c_o > n_o Then c_o = n_o
scene_gather_objs()
End Sub
Function obj_FindIndex(o As _obj_ Ptr) As Integer
For n As Integer = 1 To n_o
If o = @obj(n) Then Return n
Next
End Function
Function obj_with_oID(id As ZString Ptr, curSceneOnly As Integer = FALSE) As Integer
If curSceneOnly Then
For n As Integer = 1 To n_so
If LCase(Trim(obj(order(n)).oID)) = LCase(Trim(*id)) Then Return order(n)
Next
Else
For n As Integer = 1 To n_o
If LCase(Trim(obj(n).oID)) = LCase(Trim(*id)) Then Return n
Next
EndIf
Return 0
End Function
Function obj_with_sID(id As ZString Ptr, curSceneOnly As Integer = FALSE) As Integer
If curSceneOnly Then
For n As Integer = 1 To n_so
If LCase(Trim(obj(order(n)).sID)) = LCase(Trim(*id)) Then Return order(n)
Next
Else
For n As Integer = 1 To n_o
If LCase(Trim(obj(n).sID)) = LCase(Trim(*id)) Then Return n
Next
EndIf
Return 0
End Function
Function obj_with_soulname(nam As ZString Ptr) As Integer
For n As Integer = 1 To n_o
If obj(n).kind = objKinds.Soul AndAlso Trim(LCase(obj(n).s.nam)) = Trim(LCase(*nam)) Then Return n
Next
Return 0
End Function
'Function obj_rtrn_if_xy_within_zone(zone As Integer, x As Integer, y As Integer, Group() As _obj_group_, ByRef cGroupObj As Integer, ByRef nGroupObjs As Integer) As Integer
' '' Scan to see if x,y falls within any object's specified zone.
' '' This could include returning the x,y position that x,y falls within the zone, if needed.
' Group_Erase(Group())
' cGroupObj = 0 : nGroupObjs = 0
'
' Dim As Integer addObj
'
' '' Check if a point is within any object's zone of specified type.
' For n As Integer = 1 To n_o
'
' addObj = 0
'
' With obj(n)
' Select Case zone
' 'Case Zones.noZoneJustObj, Zones.noZoneJustObjIgnoreTrans
' Case Zones.zBase: If .b.en=TRUE And .XYRelationshipToMyZone(x,y,.b) = Located.Within Then addObj=n
' Case Zones.zTrig: If .tr.en=TRUE And .XYRelationshipToMyZone(x,y,.tr) = Located.Within Then addObj=n
' Case Zones.zMouse:If .mz.en=TRUE And .XYRelationshipToMyZone(x,y,.mz) = Located.Within Then addObj=n
' Case Zones.zVert: If .v.en =TRUE And .XYRelationshipToMyZone(x,y,.v) = Located.Within Then addObj=n
' End Select
'
' If addObj Then
' '' Needs work:
' 'If oGrpHas(addObj) = FALSE Then
' nGroupObjs += 1
' Group(nGroupObjs).oID = addObj
' If nGroupObjs = UBound(Group) Then Exit For
' 'EndIf
' EndIf
' End With
'
' Next
'
' Group_Sort(Group())
' If nGroupObjs Then cGroupObj = 1 : Return Group(cGroupObj).oID
'
' Return FALSE
'
'End Function
'function obj_
Function interface_choose_image(spr() As GL.gfxmap_spr, set() As GL.gfxmap_set) As Integer
Dim As Integer hl
Static As Integer dpan_x, dpan_y, x,y, w, h, c_set
If c_set = 0 Then c_set = 1
Dim As Double prevTime=Timer
Do
GetMouse(mx,my,,mb)
If Timer - prevTime >= .02 Then
prevTime = Timer
Dim As ZString * 2 ink=(LCase(Inkey))
If Len(ink) Then
If ink="-" Then c_set -= 1
If ink="=" Then c_set += 1
EndIf
If c_set < 1 Then c_set = 1
If c_set > UBound(scene_set) Then c_set = UBound(scene_set)
If MultiKey(SC_DOWN) Then dpan_y -= 8
If MultiKey(SC_UP) Then dpan_y += 8
If MultiKey(SC_RIGHT) Then dpan_x -= 8
If MultiKey(SC_LEFT) Then dpan_x += 8
If mx > res_w-1 Then SetMouse res_w-1, my
If my > res_h-1 Then SetMouse mx, res_h-1
If mx = res_w-1 Then dpan_x -= 8
If mx = 0 Then dpan_x += 8
If my = res_h-1 Then dpan_y -= 8
If my = 0 Then dpan_y += 8
'If dpan_y < -(scene_set(c_set).h)+res_h Then dpan_y = -(scene_set(c_set).h)+res_h
'If dpan_x < -(scene_set(c_set).w)+res_w Then dpan_x = -(scene_set(c_set).w)+res_w
If dpan_y > 0 Then dpan_y = 0
If dpan_x > 0 Then dpan_x = 0
'' Draw images from current set:
hl = 0
GL.box_filled(0,0,scr_w-1,scr_h-1,_Black)
Dim As Single interface_scale = .25
'glLineWidth( interface_scale )
For n As Integer = 1 To UBound(scene_spr)
With spr(n)
If .set = @set(c_set) Then
'If spr(n).set->s2x Then
' x = .p->u_offset*2
' y = .p->v_offset*2
' w = .p->Width*2
' h = .p->Height*2
'Else
x = .p->u_offset * interface_scale
y = .p->v_offset * interface_scale
w = .p->Width * interface_scale
h = .p->Height * interface_scale
'EndIf
GL.sprite_scale(dpan_x+x,dpan_y+y,interface_scale,spr(n).p)
If PointInBox(mx,my, dpan_x+x, dpan_y+y, dpan_x+x+w-1, dpan_y+y+h-1) Then
GL.box(dpan_x+x, dpan_y+y, dpan_x+x+w-1, dpan_y+y+h-1,RGBA(255,255,255,55))
glBlendFunc(GL_ONE, GL_ONE)
glColor4ub(100,100,100,255)
GL.sprite_scale(dpan_x+x,dpan_y+y,interface_scale,spr(n).p)
hl = n
End If
If hl Then text(0,470,"Set: " + Str(c_set) + ", Image: " + Str(hl))
End If
End With
GL.set_blend_mode(GL.E_BLENDED)
glColor4ub(255,255,255,255)
Next
GL.sprite(mx,my,gui_spr(cursor).p)
Flip
End If
Loop Until mb <> 2
Function = hl
'glLineWidth( SCR_S )
End Function
Sub interface_edit_obj()
Dim As Integer optn
Do
Dim As optBox_ optBox
With optBox
.x = cam_x1 + cam_w \ 2
.y = cam_y1 + cam_h \ 2
.expand = FALSE
.title = "OBJECT #"&Str(c_o)
.optn(1) = "Body Zones" : .optn(2) = "Trigger Zone" : .optn(3) = "Mouse Zone"
.optn(4) = "Animation" : .optn(5) = "Behavior" : .optn(6) = "Opacity" : .optn(7) = "Close"
optn = OptnBox(optBox)
End With
'' Base Y / Zone
If optn = 1 Then
Do
Dim As optBox_ optBox
With optBox
.x = cam_x1 + cam_w \ 2
.y = cam_y1 + cam_h \ 2
.expand = FALSE
.title = "BODY ZONES"
.optn(1) = ""
.optn(2) = "Get Base Zone"
.optn(3) = "Get Vertical Zone"
.optn(4) = "Type: "+strIf(obj(c_o).upright,"Upright","Flat")
.optn(5) = "BaseIsBound: "+strIf(obj(c_o).b.tp=BaseIsBound,"TRUE","FALSE")
.optn(6) = "Remove Base Zone"
.optn(7) = "Remove Vertical Zone"
.optn(9) = "<< Back"
End With
optn = OptnBox(optBox)
If optn = 1 Then
Dim As optBox_ optBox
With optBox
.x = cam_x1 + cam_w \ 2
.y = cam_y1 + cam_h \ 2
.expand = FALSE
.title = "MISC"
.optn(1) = "Fluctuate Anim Delay"
.optn(2) = ""
.optn(3) = ""
.optn(4) = ""
.optn(5) = ""
.optn(6) = ""
.optn(7) = ""
.optn(9) = "<< Back"
End With
optn = OptnBox(optBox)
ElseIf optn = 2 Then
obj(c_o).b.en = TRUE
obj(c_o).upright = TRUE
getcords.getxy = 1
getcords.is_box = TRUE
getcords.grid_lock = FALSE
getcords.p = @obj(c_o).b
Exit Sub
ElseIf optn = 3 Then
obj(c_o).v.en = TRUE
getcords.getxy = 1
getcords.is_box = TRUE
getcords.grid_lock = FALSE
getcords.p = @obj(c_o).v
Exit Sub
ElseIf optn = 4 Then
If obj(c_o).upright Then
obj(c_o).upright = FALSE
obj(c_o).x-=obj(c_o).w\2
'obj(c_o).y-=-obj(c_o).an.yOff
'obj(c_o).an.yOff = 0
Else
obj(c_o).upright = TRUE
obj(c_o).x+=obj(c_o).w\2
obj(c_o).y+=obj(c_o).h-1
'obj(c_o).an.yOff = -(obj(c_o).h-1)
EndIf
ElseIf optn = 5 Then
obj(c_o).b.tp = IIf(obj(c_o).b.tp=BaseIsBound,BaseIsOpen,BaseIsBound)
ElseIf optn = 6 Then
obj(c_o).b.en = FALSE
ElseIf optn = 7 Then
obj(c_o).v.en = FALSE
ElseIf optn = 9 Then
Exit Do
EndIf
Loop
'' Trigger Zone
ElseIf optn = 2 Then
Do
Dim As optBox_ optBox
With optBox
.x = cam_x1 + cam_w \ 2
.y = cam_y1 + cam_h \ 2
.expand = FALSE
.title = "TRIGGER ZONE"
.optn(1) = "Get Trigger Zone"
.optn(2) = "Enabled: "+strIf(obj(c_o).tr.en=TRUE,"TRUE","FALSE")
.optn(3) = "Type : "
If obj(c_o).tr.tp = 0 Then .optn(3)+="Once Only"
If obj(c_o).tr.tp = 1 Then .optn(3)+="Once Per Entry"
If obj(c_o).tr.tp = 2 Then .optn(3)+="Always"
.optn(5) = "<< Back"
End With
optn = OptnBox(optBox)
If optn = 1 Then
obj(c_o).tr.en = TRUE
getcords.getxy = 1
getcords.is_box = TRUE
getcords.grid_lock = TRUE
getcords.p = @obj(c_o).tr
Exit Sub
ElseIf optn = 2 Then
obj(c_o).tr.en = IIf(obj(c_o).tr.en=TRUE,FALSE,TRUE)
ElseIf optn = 3 Then
obj(c_o).tr.tp += 1
If obj(c_o).tr.tp > 2 Then obj(c_o).tr.tp = 0
ElseIf optn = 5 Then
Exit Do
End If
Loop
'' Mouse Zone
ElseIf optn = 3 Then
Do
Dim As optBox_ optBox
With optBox
.x = cam_x1 + cam_w \ 2
.y = cam_y1 + cam_h \ 2
.expand = FALSE
.title = "MOUSE ZONE"
.optn(1) = "Edit Mouse Zone"
.optn(2) = "Enabled: " + strIf(obj(c_o).mz.en=TRUE,"TRUE","FALSE")
.optn(4) = "<< Back"
End With
optn = OptnBox(optBox)
If optn = 1 Then
obj(c_o).mz.en = TRUE
getcords.getxy = 1
getcords.is_box = TRUE
getcords.grid_lock = TRUE
getcords.p = @obj(c_o).mz
Exit Sub
ElseIf optn = 2 Then
obj(c_o).mz.en = IIf(obj(c_o).mz.en=TRUE,FALSE,TRUE)
ElseIf optn = 4 Then
Exit Do
End If
Loop
'' Animation settings
ElseIf optn = 4 Then
interface_edit_obj_animation()
'' Set object behavior
ElseIf optn = 5 Then
interface_edit_obj_behavior()
'' Set opacity
ElseIf optn = 6 Then
interface_edit_obj_opacity()
ElseIf optn = 7 Then
Exit Do
End If
Loop
End Sub
Sub interface_edit_obj_opacity()
c_gui = gui_available()
If c_gui = 0 Then Exit Sub
With guiSet(c_gui)
.load_objs("frmObjOpacity.dat")
.init_objs()
Dim As Integer par = .obj_with_id("form")
.move_par("form",scr_w\2-.o(par).w\2, scr_h-.o(par).h)
End With
With obj(c_o)
#Define o_txt Val(guiSet(c_gui).o(guiSet(c_gui).cobj).txt)
Dim As Integer v
Do
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtProg")).txt = Str(.op.program)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("inbMin")).txt = Str(.op.min)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("inbMax")).txt = Str(.op.max)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtMinDelay")).txt = Str(.op.delay_at_min)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtMaxDelay")).txt = Str(.op.delay_at_max)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtStepDelay")).txt = Str(.op.delay_step)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtStep")).txt = Str(.op.step)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("inbOpacity")).txt = Str(.opacity)
Dim As ZString*3 ink = InKey
guiSet(c_gui).events(mx,my,mb,prvmb,ink)
If Len(ink) Then
If guiSet(c_gui).cobj Then
Select Case Trim(guiSet(c_gui).o(guiSet(c_gui).cobj).id)
Case "inbMin": .op.min = o_txt
Case "inbMax": .op.max = o_txt
Case "inbOpacity": .opacity = o_txt
End Select
EndIf
EndIf
If mb = 0 AndAlso prvMb=1 AndAlso guiSet(c_gui).cobj Then
Select Case Trim(guiSet(c_gui).o(guiSet(c_gui).cobj).id)
Case "btnProgDown"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.program >= -5+v Then .op.program -= v
Case "btnProgUp"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.program <= 255-v Then .op.program += v
Case "chkEnabled"
'.op.enabled = guiSet(c_gui).o(guiSet(c_gui).obj_with_id("chkEnabled")).chk.vlu
Case "btnMinLess"
If MultiKey(SC_LSHIFT) Then v=20 Else v=1
If .op.min >= v Then .op.min -= v
Case "btnMinMore"
If MultiKey(SC_LSHIFT) Then v=20 Else v=1
If .op.min <= 255-v AndAlso .op.min < .op.max Then .op.min += v
Case "btnMaxLess"
If MultiKey(SC_LSHIFT) Then v=10 Else v=1
If .op.max >= v AndAlso .op.max > .op.min Then .op.max -= v
Case "btnMaxMore"
If MultiKey(SC_LSHIFT) Then v=10 Else v=1
If .op.max <= 255-v Then .op.max += v
Case "btnMinDelayLess"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.delay_at_min >= v Then .op.delay_at_min -= v
Case "btnMinDelayMore"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.delay_at_min <= 60-v Then .op.delay_at_min += v
Case "btnMaxDelayLess"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.delay_at_max >= v Then .op.delay_at_max -= v
Case "btnMaxDelayMore"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.delay_at_max <= 60-v Then .op.delay_at_max += v
Case "btnStepLess"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.step >= -64+v Then .op.step -= v
Case "btnStepMore"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.step <= 64-v Then .op.step += v
Case "btnStepDelayLess"
If .op.delay_step > 0 Then .op.delay_step -= 1
Case "btnStepDelayMore"
If .op.delay_step < 960 Then .op.delay_step += 1 '' 960 cycles is about 16 seconds at 60 FPS
Case "btnOpLess"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.step >= -64+v Then .opacity -= v
Case "btnOpMore"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .op.step <= 64-v Then .opacity += v
Case "btnOK"
Exit Do
End Select
End If
If MultiKey(SC_Escape) Then Exit Do
__ProxyRefresh()
guiSet(c_gui).sort_objs()
guiSet(c_gui).draw_objs()
__ProxyFlip()
Loop
End With
guiSet(c_gui).closeGUI()
End Sub
Sub interface_edit_obj_animation()
c_gui = gui_available()
If c_gui = 0 Then Exit Sub
With guiSet(c_gui)
.load_objs("frmObjAnim.dat")
.init_objs()
Dim As Integer par = .obj_with_id("form")
.move_par("form",scr_w\2-.o(par).w\2, scr_h-.o(par).h)
End With
With obj(c_o)
'' Set up default new animation if there isn't one:
.an.enabled = TRUE
If .an.total_frames = 0 Then .an.total_frames = 1
If .an.frame = 0 Then
.an.frame = 1 '' Set to first frame and
.an.f(.an.frame).ii = .ii '' use object current image as default first frame image.
.an.enabled = TRUE
EndIf
Dim As Integer v
Do
'' Maintain values on form:
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtDelay")).txt = Str(.an.f(.an.frame).delay)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtOpacity")).txt = Str(.an.f(.an.frame).opacity)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("txtProgram")).txt = Str(.an.program)
guiSet(c_gui).o(guiSet(c_gui).obj_with_id("chkEnabled")).chk.vlu = .an.enabled
Dim As ZString*3 ink = Inkey
guiSet(c_gui).events(mx,my,mb,prvmb,ink)
If mb = 0 AndAlso prvMb=1 AndAlso guiSet(c_gui).cobj Then
Select Case Trim(guiSet(c_gui).o(guiSet(c_gui).cobj).id)
Case "btnFramePrev"
If .an.frame > 1 Then .an.frame -= 1
Case "btnFrameNext"
If .an.frame < .an.total_frames Then .an.frame += 1
Case "btnFrameAdd"
If .an.total_frames < maxAnimFrames Then
.an.total_frames += 1 : .an.frame = .an.total_frames
.an.f(.an.frame).delay = .an.f(.an.frame-1).delay
.an.f(.an.frame).opacity = .an.f(.an.frame-1).opacity
EndIf
Case "btnFrameRem"
If .an.total_frames > 0 Then .an.total_frames -= 1 : .an.frame = .an.total_frames
Case "btnDelayLess"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .an.f(.an.frame).delay >= v Then .an.f(.an.frame).delay -= v
Case "btnDelayMore"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .an.f(.an.frame).delay <= 255-v Then .an.f(.an.frame).delay += v
Case "btnOpacityLess"
If MultiKey(SC_LSHIFT) Then v=10 Else v=5
If .an.f(.an.frame).opacity >= v Then .an.f(.an.frame).opacity -= v
Case "btnOpacityMore"
If MultiKey(SC_LSHIFT) Then v=10 Else v=5
If .an.f(.an.frame).opacity <= 255-v Then .an.f(.an.frame).opacity += v
Case "btnProgDown"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .an.program >= -5+v Then .an.program -= v
Case "btnProgUp"
If MultiKey(SC_LSHIFT) Then v=5 Else v=1
If .an.program <= 255-v Then .an.program += v
Case "chkEnabled"
.an.enabled = guiSet(c_gui).o(guiSet(c_gui).obj_with_id("chkEnabled")).chk.vlu
Case "btnOK"
Exit Do
End Select
ElseIf mb = 2 Then
Dim As Integer ii = interface_choose_image(scene_spr(), scene_set())
.an.f(.an.frame).ii = ii
End If
If MultiKey(SC_Escape) Then Exit Do
__ProxyRefresh()
'' Draw current frame image in the box:
'GL.box_filled(0,0,scr_w-1,scr_h-1,RGBA(40,40,40,200))
'If .an.f(.an.frame).ii Then
' glColor4ub(255,255,255,.opacity)
' GL.sprite(scr_w\2-scene_spr(.an.f(.an.frame).ii).p->Width\2,scr_h\2-scene_spr(.an.f(.an.frame).ii).p->height\2,scene_spr(.an.f(.an.frame).ii).p)
'Else
' text(scr_w\2-32,92,"No Frame",_Red)
'EndIf
guiSet(c_gui).sort_objs()
guiSet(c_gui).draw_objs()
__ProxyFlip()
Loop
End With
guiSet(c_gui).closeGUI()
End Sub
Sub interface_edit_obj_behavior()
c_gui = gui_available()
If c_gui = 0 Then Exit Sub
With guiSet(c_gui)
.load_objs("frmObjBehav.dat")
.init_objs()
Dim As Integer par = .obj_with_id("frmBehav")
.move_par("frmBehav",scr_w\2-.o(par).w\2, scr_h\2-.o(par).h\2)
Dim As Integer lstBehav = .obj_with_id("lstBehav")
For n As Integer = 1 To UBound(ListBehaviors)
If Len(ListBehaviors(n)) Then
.o(lstBehav).lst.c += 1
.o(lstBehav).lst.txt(n) = ListBehaviors(n)
If .o(lstBehav).lst.txt(n) = obj(c_o).behavior Then .o(lstBehav).lst.s = n
EndIf
Next
Dim As Integer lstSID = .obj_with_id("lstSID")
.o(lstSID).lst.c = UBound(ListScripts)
.o(lstSID).lst.txt(1) = "Default"
For n As Integer = 1 To UBound(ListScripts)
.o(lstSID).lst.txt(n+1) = ListScripts(n)
If LCase(obj(c_o).sID) = LCase(.o(lstSID).lst.txt(n)) Then .o(lstSID).lst.s = n
Next
Do
Dim As ZString * 3 ink = InKey
.events(mx,my,mb,prvmb,ink)
If mb = 0 AndAlso prvMb = 1 AndAlso .cobj Then
Select Case Trim(.o(.cobj).id)
Case "btnOK"
obj(c_o).sID = RTrim(.o(.obj_with_id("lstSID")).lst.txt(.o(.obj_with_id("lstSID")).lst.s))
obj(c_o).oID = RTrim(.o(.obj_with_id("inbID")).txt)
obj(c_o).behavior = .o(lstBehav).lst.txt(.o(lstBehav).lst.s)
obj_linkScript(c_o,obj(c_o).sID,Keys.Init)
Exit Do
End Select
End If
If MultiKey(SC_Escape) Then Exit Do
__ProxyRefresh()
.sort_objs()
.draw_objs()
__ProxyFlip()
Loop
End With
guiSet(c_gui).closeGUI()
End Sub
Sub interface_edit_obj_dnode()
End Sub
Sub interface_menu_main()
Dim As Integer optn
Dim As String userinput
Dim As optBox_ optBox
With optBox
.corner_at_xy = 1
.font = 3
If Len(scene) Then .title = Trim(scene) Else .title = "[untitled scene]"
.optn(1) = "New Scene"
.optn(2) = "Switch Scene"
.optn(3) = "Rename Scene"
.optn(4) = "Delete Scene"
.optn(6) = "Load World"
.optn(7) = "Save World As..."
.optn(9) = "Return To Editor"
.optn(10) = "Quit"
End With
optn = OptnBox(optBox)
If optn = 1 Then
userinput = guiInptBox("Enter new scene name:")
scene_new(userinput)
ElseIf optn = 2 Then
'' To-do: Display a list of scenes by checking world objs scene names.
userinput = guiInptBox("Enter scene name you want to view:")
scene_view(userinput)
ElseIf optn = 3 And Len(Trim(scene)) Then
userinput = guiInptBox("Enter new name for current scene:")
scene_rename(userinput)
ElseIf optn = 4 Then
scene_delete(userinput)
ElseIf optn = 6 Then
userinput = guiInptBox("Enter world filename to load:")
'If doesExist("maps\"+filename) = TRUE Then
world_load(userinput)
'End If
ElseIf optn = 7 Then
userinput = guiInptBox("Enter world filename to save:")
If Len(Trim(userinput)) AndAlso doesExist("world\"+userinput) = TRUE Then
Dim As Integer optn = optnBox("Overwrite "+userinput+"?","Yes","Cancel")
If optn = 1 Then
world_save(userinput)
End If
ElseIf Len(Trim(userinput)) Then
world_save(userinput)
Else
MsgBox("Aborted.")
End If
MsgBox("Done!")
ElseIf optn = 10 Then
_Quit
End
End If
End Sub
Function interface_list_effects(i As Integer, ifx() As _item_effects_list_) As Integer
Return 0
End Function
Function inv_add(o As Integer, into As Integer) As Integer
'' Add (o) object to (into) object's inventory. Return slot no. if successful.
If into > n_o Or into <= 0 Then Return 0
obj(o).it.within = into
'If into = Me Then obj(o).global = TRUE
For n As Integer = 13 To 200
If obj_in_inv_slot(into,n) = FALSE Then
With obj(o)
.it.placed = n
End With
Exit For
End If
Next
Return obj(o).it.placed
End Function
Function inv_drop(o As Integer) As Integer
If o < 1 Or o > n_o Then Return 0
With obj(o)
.kind = objKinds.SceneObjItem
.x = obj(Me).x
.y = obj(Me).y
.it.within = 0
.it.placed = 0
End With
End Function
Function inv_extract(o As Integer, s As Integer, into As Integer = 1, qty As Integer = 1) As Integer
Dim As Integer i = obj_in_inv_slot(o,s), s2
s2 = inv_match(o,s,into)
If s2 Then
obj(obj_in_inv_slot(into,s2)).it.qty += qty
Else
Dim As _obj_ newobj
newobj = obj(i)
'inv_add(obj_add(newobj),into)
End If
If obj(i).it.qty > 1 Then
obj(i).it.qty -= qty
Else
obj_delete(i)
End If
Return 0
End Function
Function inv_extract2(o As Integer, into As Integer = 1, qty As Integer = 1) As Integer
'' Extract object (o) into object (into).
Dim As Integer s2 = inv_match2(o,into)
If s2 Then
obj(obj_in_inv_slot(into,s2)).it.qty += qty
Else
Dim As _obj_ newobj
newobj = obj(o)
'inv_add(obj_add(newobj),into)
End If
If obj(o).it.qty > 1 Then
obj(o).it.qty -= qty
Else
obj_delete(o)
End If
Return 0
End Function
Function inv_hole_remove(o As Integer) As Integer
'' Remove any hole that was created after an inventory object position change.
Dim As Integer slots_used = inv_count(o)
For n As Integer = 13 To slots_used
If obj_in_inv_slot(o,n) = FALSE Then
For nn As Integer = n+1 To slots_used
obj(obj_in_inv_slot(o,nn)).it.placed -= 1
Next
Return TRUE
End If
Next
End Function
Function inv_hole_create(o As Integer, s As Integer, shift As Integer) As Integer
'' Create a hole for inv_add to drop an object into.
Dim As Integer slots_used = inv_count(o)
If obj_in_inv_slot(o,s) Then
For nn As Integer = slots_used To s+shift Step -1
obj(obj_in_inv_slot(o,nn)).it.placed += 1
Next
Return TRUE
End If
End Function
Function inv_move(o As Integer, s1 As Integer, s2 As Integer) As Integer
'' Move object's inventory slot-position (s1) to position (s2)
If s1 = s2 Then Return s2
Dim As Integer tmp_o = obj_in_inv_slot(o,s1), used_slots=inv_count(o)
If s2 > used_slots+1 Then s2 = used_slots+1
If s1 > 12 And s2 > 12 Then
If s1 < s2 Then inv_hole_create(o,s2,1)
If s1 > s2 Then inv_hole_create(o,s2,0)
inv_add(tmp_o,o)
inv_hole_remove(o)
ElseIf s1 > 12 And s2 <= 12 Then
obj(tmp_o).it.placed = s2
inv_hole_remove(o)
ElseIf s1 <= 12 And s2 > 12 Then
inv_hole_create(o,s2,0)
inv_add(tmp_o,o)
ElseIf s1 <= 12 And s2 <= 12 Then
obj(tmp_o).it.placed = s2
End If
Return s2
End Function
Function inv_count(o As Integer) As Integer
'' Take a count of all inventory slots used (except equiped slots) in an object (o).
Dim As Integer last_p
For n As Integer = 1 To n_o
With obj(n)
If .it.within = o And .it.placed > 12 Then
If .it.placed > last_p Then last_p = .it.placed
End If
End With
Next
Return last_p
End Function
Function inv_match(o1 As Integer, s1 As Integer, o2 As Integer, s2 As Integer = 0) As Integer
Dim As Integer itm1, itm2, match, o2c
#Macro Compare()
If obj(itm1).it.titl = obj(itm2).it.titl Then
match= TRUE
Else
match= FALSE
End If
#EndMacro
itm1 = obj_in_inv_slot(o1,s1)
If s2 = 0 Then
o2c = inv_count(o2)
For s2 = 1 To o2c
itm2 = obj_in_inv_slot(o2,s2)
Compare()
If match = TRUE Then Exit For
Next
Else
itm2 = obj_in_inv_slot(o2,s2)
Compare()
End If
If match = TRUE Then match = s2
Return match
End Function
Function inv_match2(itm1 As Integer, inv As Integer) As Integer
Dim As Integer itm2, match, inv_cnt, s2
#Macro Compare()
If obj(itm1).it.titl = obj(itm2).it.titl Then
match= TRUE
Else
match= FALSE
End If
#EndMacro
inv_cnt = inv_count(inv)
For s2 = 1 To inv_cnt
itm2 = obj_in_inv_slot(inv,s2)
Compare()
If match = TRUE Then Exit For
Next
If match = TRUE Then match = s2
Return match
End Function
Function obj_in_inv_slot(o As Integer, s As Integer) As Integer
'' Return object no. (if any) in object (o)'s slot no. (s).
For n As Integer = 1 To n_o
If obj(n).kind = objKinds.Item And obj(n).it.within = o Then
If obj(n).it.placed = s Then
Return n
End If
End If
Next
Return 0
End Function
Sub _Quit(msg As String = "", doBeep As Integer = FALSE, doEnd As Integer = TRUE)
'On Error GoTo err_
If doBeep Then Beep
db_write("(QUIT)")
If Len(Trim(msg)) Then db_write(" "+msg)
For n As Integer = 1 To UBound(scene_spr)
glDeleteTextures( 1, @scene_spr(n).p->textureID )
ImageDestroy(scene_spr(n).p)
Next
db_write(" Destroyed all scene graphics")
'' Erase image data for characters in RAM and VRAM:
For n As Integer = 1 To UBound(soul_spr)
glDeleteTextures( 1, @soul_spr(n).p->textureID )
ImageDestroy(soul_spr(n).p)
Next
db_write(" Destroyed all char graphics")
For n As Integer = 1 To UBound(gui_spr)
glDeleteTextures( 1, @gui_spr(n).p->textureID )
ImageDestroy(gui_spr(n).p)
Next
For n As Integer = 1 To UBound(font_spr)
glDeleteTextures( 1, @font_spr(n).p->textureID )
ImageDestroy(font_spr(n).p)
Next
db_write(" Destroyed all gui graphics")
GL.destroy()
'ChDir("savegame\temp")
'Dim filename As String = Dir( "*", &h20 )
'Do
' If filename <> "." And filename <> ".." Then
' ''xKill(filename) ''< killed my whole project on accident
' filename = Dir( )
' End If
'Loop While Len( filename ) > 0
If doEnd Then End
'Exit Sub
'err_:
' db_write("Quit error: "+Str(Err))
' Beep
' End
End Sub
Function Dialog(txt As ZString Ptr, x As Integer = -1, y As Integer = -1, w As Integer = 624, font As Integer = 3, fadeOut As Integer = FALSE, waitForEnter As Integer = FALSE, delay_time As Double = 5, c As UInteger = _White) As Integer
With Dlog
'' Get the font's char width and height as the optBox charsp and linesp:
.font = font
'If .fonts2x Then
' .charsp = fonts2x_spr(.font*96-95).p->Width
' .linesp = fonts2x_spr(.font*96-95).p->Height
'Else
.charsp = font_spr(.font*96-95).p->Width
.linesp = font_spr(.font*96-95).p->Height
'EndIf
.en = TRUE
.txt = *txt
If x = -1 Then
If Len(Trim(*txt)) * .charsp > RES_W-400 Then
x = 200
Else
x = RES_W\2 - (Len(Trim(*txt))\2) * .charsp
EndIf
EndIf
If y = -1 Then y = RES_H\5
.x = x
.y = y
.w = w
.waitForEnter = waitForEnter
.fadeOut = fadeOut
.delay_time = delay_time
.start_time = Timer
.a = 0
.c = c
End With
Return 0
End Function
Function Dialog_Show(Dlog As _dialog_) As Integer
If Dlog.en = TRUE Then
With Dlog
.c = RGBA(RGBA_R(.c),RGBA_G(.c),RGBA_B(.c),255-(-.a*10))
text(.x,.y,.txt,.c,624,3)
If .fadeOut Then
.a -= 1
.y -= 1
If .a < -25 Then .en = FALSE
Else
If Timer - .start_time >= .delay_time Then .en = FALSE
EndIf
End With
EndIf
Return 0
End Function
Function Battle_Init(npcGroup As Integer) As Integer
battle_count = 1
battling(1) = 1
obj(Me).s.mp.base = obj(Me).s.mp.high
obj(Me).s.ap.base = obj(Me).s.ap.high
For n As Integer = 1 To n_o
If obj(n).kind = objKinds.Soul And obj(n).s.group = npcGroup Then
obj(n).s.ap.base = obj(n).s.ap.high
obj(n).s.mp.base = obj(n).s.mp.high
battle_count += 1
battling(battle_count) = n
End If
Next
For n As Integer = 1 To battle_count
'ScriptExec(battling(n),keyBattleInit,0)
Next
battle_turn = 1
Return 0
End Function
Function Battle_EndTurn() As Integer
With obj(battling(battle_turn))
If .kind = objKinds.Soul Then
.s.mp.base = .s.mp.high
.s.ap.base = .s.ap.high
End If
End With
'ScriptExec(battling(battle_turn),keyBattleMyTurnOver,0)
battle_turn += 1
If battle_turn > battle_count Then battle_turn = 1
'ScriptExec(battling(battle_turn),keyBattleMyTurn,0)
Return 0
End Function
Function Battle_CheckNPCPresent(npc As Integer) As Integer
For n As Integer = 2 To 10
If battling(n) = npc Then Return TRUE
Next
Return 0
End Function
Sub script_exec(oMe As Integer, key As Keys, oYou As Integer = 0)
obj(oMe).fp(@obj(oMe),key,IIf(oYou,@obj(oYou),0))
End Sub
Sub script_exec(oMe As _obj_ Ptr, key As Keys, oYou As _obj_ Ptr = 0)
oMe->fp(oMe,key,oYou)
End Sub
Function script_with_id(ID As ZString Ptr) As Integer
For n As Integer = 1 To UBound(ListScripts)
If LCase(Trim(ListScripts(n))) = LCase(Trim(*ID)) Then Return n
Next
Return 0
End Function
Sub __ProxyRefresh()
'' Quick way out in case of development problems:
If MultiKey(SC_F12) Then _Quit("Executed Fast Quit")
'' ___________________________ Draw Scene _____________________________________________________________________________________________________________________
GL.box_filled(0,0,scr_w-1,scr_h-1,DW_RGBA(40,40,40,255))
'Static As Single lightfade = .1
'Static As Single lightlevel
'lightlevel += lightfade
'If lightlevel > 30 Then lightfade = -.1
'If lightlevel < 0 Then lightlevel = 0 : lightfade = .1
'For o As Integer = 1 To n_so
' obj(order(o)).rgb_r = 180 '' Evening effect
' obj(order(o)).rgb_g = 180
' obj(order(o)).rgb_b = 255
' obj(order(o)).addlight = Int(lightlevel)
'Next
For n As Integer = 1 To n_so
obj(order(n)).Draw_Self
Next
'For o As Integer = 1 To n_so
' obj(order(o)).rgb_r = 255
' obj(order(o)).rgb_g = 255
' obj(order(o)).rgb_b = 255
' obj(order(o)).addlight = 0
'Next
If c_o = newObjID Then obj(c_o).Draw_Self
If weather_rain Then fx_rain(TRUE)
If weather_snow Then fx_snow()
'If do_fx_spell Then fx_spell(clickx,clicky)
If grid.show Then
'For gx As Integer = cam_x1 To cam_x2 Step grid.w
' For gy As Integer = cam_y1 To cam_y2 Step grid.h
' GL.pixel(gx,gy,RGBA(0,0,0,100))
' Next
'Next
'' AStar Map:
For y As Integer = 0 To ASTAR_MAP_CELLS_HIGH-1
For x As Integer = 0 To ASTAR_MAP_CELLS_WIDE-1
'GL.box(x*ASTAR_CELL_W,y*ASTAR_CELL_H,x*ASTAR_CELL_W+ASTAR_CELL_W-1,y*ASTAR_CELL_H+ASTAR_CELL_H-1,DW_RGBA(55,55,55,55)) '' Open cell
If ASTAR_CellCheck(x,y) = TRUE Then
'GL.pixel(cam_x1+x*ASTAR_CELL_W, cam_y1+40+y*ASTAR_CELL_H, RGBA(255,0,0,100)) '' Closed cell
GL.box_filled(cam_x1+x*ASTAR_CELL_W, cam_y1+40+y*ASTAR_CELL_H, cam_x1+(x*ASTAR_CELL_W)+ASTAR_CELL_W-1, cam_y1+40+(y*ASTAR_CELL_H)+ASTAR_CELL_H-1, RGBA(255,0,0,100)) '' Closed cell
Else
'GL.pixel(cam_x1+x*ASTAR_CELL_W, cam_y1+40+y*ASTAR_CELL_H, DW_RGBA(255,255,255,50)) '' Open cell
'If x = ASTAR_MAP_CELLS_WIDE-1 Then GL.pixel(cam_x1+x*ASTAR_CELL_W+ASTAR_CELL_W, cam_y1+40+y*ASTAR_CELL_H, DW_RGBA(55,55,55,55)) '' Open cell
'GL.box_filled(cam_x1+x*ASTAR_CELL_W, cam_y1+40+y*ASTAR_CELL_H, cam_x1+(x*ASTAR_CELL_W)+ASTAR_CELL_W-1, cam_y1+40+(y*ASTAR_CELL_H)+ASTAR_CELL_H-1, RGBA(255,255,255,50)) '' Open cell
EndIf
Next
'If y = ASTAR_MAP_CELLS_HIGH-1 Then GL.pixel(cam_x1+x*.s.pa.sw, cam_y1+40+y*.s.pa.sh+.s.pa.sh, DW_RGBA(55,55,55,55)) '' Open cell
Next
End If
Randomize Timer
' GL.set_blend_mode(GL.E_GLOW)
' 'Static r As Integer
'' Dim r As Integer
'' r = Int(Rnd*50)+1
' 'If r > 255 Then r = 255
' 'If r < 1 Then r = 1
' 'GL.box_filled(cam_x1,cam_y1,cam_x1+cam_w-1,cam_x1+cam_h-1,RGBA(r,r,r\2,10))
' For r As Integer = 1 To 64
' 'glcolor4ub(1,1,1,1)
' GL.circle_2d_filled(obj(1).x,obj(1).y-12,r,RGBA(1,1,1,1))
' 'GL.line_glow(mx-1,my,mx+1,my,r,RGBA(r,r,r,5))
'
' Next
' GL.set_blend_mode(GL.E_BLENDED)
'glcolor4ub(255,255,255,255)
'' Object Menu:
If menu.count Then
With menu
.c_opt = 0
guiWin(.x,.y,.w,.h,.clrInside,.border,.clrBorder,FALSE)
text(.x+.charsp\2+.border,.y+.linesp\2+.border,.title,_White,.font,,.charsp,.linesp)
For n As Integer = 1 To UBound(.optn)
If Len(.optn(n)) Then
text(.x+.charsp\2+.border,.y+.linesp\2+.border+(n*.linesp),.optn(n),_White,.font,,.charsp,.linesp)
If PointInBox(mx,my,.x+.charsp\2+.border,.y+.linesp\2+.border+(n*.linesp),Len(.optn(n))*.charsp,.linesp,TRUE) Then
text(.x,.y+.linesp\2+.border+(n*.linesp),">",_Green,3,,16,20)
.c_opt = n
End If
End If
Next
End With
EndIf
'' _____________________ Draw GUI ___________________________________________________________________________________________________________________________
'GL.sprite(0,SCR_H-47,gui_spr(UBound(gui_spr)).p)
'GL.line(0,SCR_H-48,SCR_W-1,SCR_H-48,RGBA(0,0,0,75)) '' Blending line between scene and GUI
'GUI.text(30,180,"Danny | HP: 25 | AP: 3",,6)
'GL.sprite_scale (mx,my+10,.6, gui_spr(spr_with_id(gui_spr(),"sword")).p)
If MultiKey(SC_F2) Then 'show_classic_gui = FALSE Then
GL.sprite_scale(cam_x1, cam_y1, 1.0, gui_spr(28).p)
GUI.text(cam_x1+39,cam_y1+6*1,"Arian Carthwood",,8,30,-1,7,.75)
GUI.text(cam_x1+39,cam_y1+6*2,"Health:",,8,30,-1,7,.75)
GUI.text(cam_x1+39,cam_y1+6*3,"Strength: 12",,8,30,-1,7,.75)
GUI.text(cam_x1+39,cam_y1+6*4,"Archery: Proficient",,8,30,-1,7,.75)
GUI.text(cam_x1+39,cam_y1+6*5,"Swords: Beginner",,8,30,-1,7,.75)
GUI.text(cam_x1+39,cam_y1+6*6,"Hunger: Satisfied",,8,30,-1,7,.75)
GUI.text(cam_x1+39,cam_y1+6*7,"Thirst: Satisfied",,8,30,-1,7,.75)
GL.sprite_scale(cam_x1+6,cam_y1+54, .75,gui_spr(spr_with_id(gui_spr(),"sword")).p)
GL.sprite_scale(cam_x1+6,cam_y1+74, .75,gui_spr(spr_with_id(gui_spr(),"bottle")).p)
/'
'GL.sprite_scale(cam_x1,cam_y1+146,.5,gui_spr(GL.gfxmap_spr_with_id(gui_spr(),"inven2")).p)
Dim As Integer x=0, y=0, w=256, h=144, i=index_frame
Dim As Single s = .75
GL.box_filled(cam_x1+x, cam_y1+y, cam_x1+x+w, cam_y1+y+h,RGB(202,146,117))
GL.sprite_scale_wh (cam_x1+x+3 , cam_y1+y , w-3, s, gui_spr(i+4).p)
GL.sprite_scale_wh (cam_x1+x+w-5, cam_y1+y+3 , s, h-3, gui_spr(i+5).p)
GL.sprite_scale_wh (cam_x1+x+3 , cam_y1+y+h-5, w-3, s, gui_spr(i+6).p)
GL.sprite_scale_wh (cam_x1+x , cam_y1+y+3 , s, h-3, gui_spr(i+7).p)
GL.sprite_scale (cam_x1+x , cam_y1+y , s, gui_spr(i).p)
GL.sprite_scale (cam_x1+x+w-5, cam_y1+y , s, gui_spr(i+1).p)
GL.sprite_scale (cam_x1+x , cam_y1+y+h-5, s, gui_spr(i+2).p)
GL.sprite_scale (cam_x1+x+w-5, cam_y1+y+h-5, s, gui_spr(i+3).p)
For lx As Integer = 32 To w Step 32
'GL.line(cam_x1+x+lx-1,cam_y1+y+4,cam_x1+x+lx-1,cam_y1+y+4+h-3,RGB(190,136,103))
Next
For ly As Integer = 32 To h Step 32
'GL.line(cam_x1+x+4,cam_y1+y+3+ly,cam_x1+x+w,cam_y1+y+3+ly,RGB(190,136,103))
Next
GL.sprite_scale(cam_x1,cam_y1, s,gui_spr(spr_with_id(gui_spr(),"icon bag")).p)
'GL.sprite_scale(cam_x1+x+6,cam_y1+y+6, s,gui_spr(spr_with_id(gui_spr(),"sword")).p)
'GL.sprite_scale(cam_x1+x+6,cam_y1+y+35, s,gui_spr(spr_with_id(gui_spr(),"campgear")).p)
GL.sprite_scale(cam_x1+x+6,cam_y1+y+6, s,gui_spr(spr_with_id(gui_spr(),"thn sword")).p)
GL.sprite_scale(cam_x1+x+38,cam_y1+y+6, s,gui_spr(spr_with_id(gui_spr(),"thn bread")).p)
GL.sprite_scale(cam_x1+x+70,cam_y1+y+6, s,gui_spr(spr_with_id(gui_spr(),"thn bottle")).p)
'/
GUI.text(cam_x1+123,cam_y1+6,"Testing the descriptions of each item, and listing their attributes. Testing the descriptions of each item, and listing their attributes. Testing the descriptions of each item, and listing their. ",,8,40,-1,7,.75)
'GUI.text(cam_x1+124,cam_y1+78,"Stats:",,6,26,5,8,.75)
'GUI.text(cam_x1+124,cam_y1+88,"+16 damage",,6,26,5,8,.75)
Else
'GL.sprite_scale(cam_x1+247,cam_y1,.5,gui_spr(ico_bag).p)
''' Separater Line:
'GL.line(0,511,1023,511,RGBA(0,0,0,80))
''' Tab buttons:
'For n As Integer = 1 To 8
' If md_tab = n Or c_tab = n Then
' guiBox(0,512+n*32-32,31,512+n*32-1,RGB(63,33,29),2,TRUE)
' Else
' guiBox(0,512+n*32-32,31,512+n*32-1,RGB(63,33,29),2)
' EndIf
'Next
'GL.sprite(0,512,ico_spr(60).p)
'GL.sprite(0,512+32,ico_spr(57).p)
'GL.sprite(0,512+64,ico_spr(58).p)
'GL.sprite(0,512+96,ico_spr(59).p)
'
'If c_tab = 1 Then
'ElseIf c_tab = 2 Then
' '' Item Desc Window:
' guiBox(304,512,1023,767,RGB(43,33,29),2)
'
' '' Inven Grid Move Up/Down Btns
' guiBox(288,512,288+15,512+127,RGB(63,33,29),2)
' guiBox(288,512+128,288+15,512+255,RGB(63,33,29),2)
' GL.sprite_rotate(299,512+64,0,font_spr(63).p)
' GL.sprite_rotate(293,512+192,180,font_spr(63).p)
'
' '' Inven Grid
' Dim As Integer slot=12
' For y As Integer = 1 To 4
' For x As Integer = 1 To 4
' slot += 1
' If c_inv = slot Then
' guiBox(32+x*64-64,512+y*64-64,32+x*64-1,512+y*64-1,RGB(55,42,42),2,TRUE)
' Else: guiBox(32+x*64-64,512+y*64-64,32+x*64-1,512+y*64-1,RGB(35,22,22),2,TRUE)
' EndIf
' Dim As Integer objInSlot = obj_in_inv_slot(1,slot)
' If objInSlot Then
' If obj(objInSlot).it.thumb Then GL.sprite(32+x*64-64,512+y*64-64,thm_spr(obj(objInSlot).it.thumb).p)
' EndIf
' Next
' Next
' If c_inv Then
' Dim As Integer c_inv_obj = obj_in_inv_slot(1,c_inv)
' If c_inv_obj Then
' text(310,518,obj(c_inv_obj).it.titl,3)
' text(310,540,obj(c_inv_obj).it.desc,RGB(200,200,200),3)
' EndIf
' EndIf
'
'EndIf
EndIf
Dialog_Show(Dlog)
If cam_frame > 1 Then
'' Draw camera frame:
GL.box_filled(0,0,scr_w-1,cam_y1-1,DW_RGBA(0,0,0,cam_frame)) '' Top
GL.box_filled(0,cam_y2,scr_w-1,scr_h-1,DW_RGBA(0,0,0,cam_frame)) '' Bottom
GL.box_filled(0,cam_y1,cam_x1-1,cam_y2-1,DW_RGBA(0,0,0,cam_frame)) '' Left
GL.box_filled(scr_w-1,cam_y1,cam_x2,cam_y2-1,DW_RGBA(0,0,0,cam_frame)) '' Right
'GL.box (cam_x1,cam_y1,cam_x2,cam_y2,DW_RGBA(130,130,130,255)) '' Window View Outline
EndIf
'' _____________________ Draw Object Attributes _______________________________________________________________________________________________________________
'' Draw a box around selected object(s):
For n As Integer = 1 To nGrpObjs
Dim As UInteger clr
If n = cGrpObj Then clr = RGBA(255,255,0,100) Else clr = RGBA(255,110,0,100)
With obj(oGrp(n).oID)
If .ii AndAlso (.upright Or (.spr_ptr[.ii].ax <> 0 And .spr_ptr[.ii].ay <> 0)) Then
GL.box( pan_x+.x-.spr_ptr[.ii].ax*.scale, _
pan_y+.y-.spr_ptr[.ii].ay*.scale-.z, _
pan_x+.x-.spr_ptr[.ii].ax*.scale + .w*.scale, _
pan_y+.y-.spr_ptr[.ii].ay*.scale + .h*.scale, clr)
ElseIf .ii Then
GL.box(pan_x+.x,pan_y+.y,pan_x+.x+.w*.scale,pan_y+.y+.h*.scale,clr)
End If
End With
Next
If show_all_attr Then
For n As Integer = 1 To n_so
obj(order(n)).Draw_Attr
Next
Else
For n As Integer = 1 To nGrpObjs
obj(oGrp(n).oID).Draw_Attr
Next
End If
GL.box(sel_x1,sel_y1,sel_x2,sel_y2,_Green)
'' _____________________ Draw Variables ________________________________________________________________________________________________________________________
#Define efs 0.5 '' Editor Font Scale
If show_vars Then
'' Print map information:
etext(0,0,"<"+Str(n_o)+"> total objs | "&Str(n_so)&" current scene objs",RGB(200,255,200),,efs)
'' Print selected object information:
If c_o Then
With obj(c_o)
#Define def_ANIM "ANIM:"& .anim &" "& .an.frame &"/"& .an.total_frames &" countdown: "& .an.countdown
etext(0,5,"c_o: "& c_o &" XYZ "& .x &","& .y &","& .x &","& .y &","& .z &" scale:"& .scale &" scene:"& .scene,,,efs)
'etext(0,25,"OPAC: "+Str(.opacity)+" step: "+Str(.op.step)+" countdown: "+Str(.op.countdown),,,efs)
If .kind = objKinds.Soul Then
etext(0,10,.sID+" facing:"& .facing &" "& def_ANIM,,,efs)
etext(0,15,"PATH go: "& strIf(.s.pa.go,"TRUE ","FALSE") &" x,y:"& .s.pa.x &","& .s.pa.y &" ("& (.s.pa.x-cam_x1+pan_x)\.s.pa.sw &","& (.s.pa.y-cam_y1-40+pan_y)\.s.pa.sh &") count: "& .s.pa.count,,,efs)
etext(0,20,"DEST go: "& strIf(.de.go,"TRUE ","FALSE") &" x,y:"& .d(.de.node).x &","& .d(.de.node).y &" node:"& .de.node &" countdown: "& .de.countdown &"/"& .d(.de.node).delay,,,efs)
etext(0,25,"SpeedX,Y: "& .sx &", "& .sy &" CycleX,Y: "& .cyclex &","& .cycley,,,efs)
Else
etext(0,10,def_ANIM,,,efs)
EndIf
End With
EndIf
'' Print object groups info:
etext(scr_w-50,4,"["+Str(nGrpObjs)+"] nGrpObjs ["+Str(cGrpObj)+"] cGrpObj",,,efs)
If nGrpObjs Then
etext(scr_w-40,12,"Selected:",,,efs)
For y As Integer = 1 To nGrpObjs
Dim As UInteger clr = _White
If y = cGrpObj Then clr = RGBA(100,255,0,255)
etext(scr_w-40,12+y*4,"#"+Str(y)+": "+Str(oGrp(y).oID),clr,,efs)
Next
EndIf
'' Print other info: format
etext(scr_w-90,scr_h-5, "TIMER "+ Format (Timer,"#.0") + " FPS "+Str(FPS)+"/"& FPS_LIMIT,,,efs)
etext(0,scr_h-5, "M-XY : "+Str(mx)+","+Str(my) + " CAMXY : " +Str(mx-cam_x1) + "," +Str(my-cam_y1) + " MB: " + Str(mb) + " Grabbed: " +Str(grabbed),,,efs)
etext(0,scr_h-10, "MM-XY: "+Str(-pan_x+mx) + ","+Str(-pan_y+my),,,efs)
etext(0,scr_h-15, "pan x,y "+Str(pan_x) & ","+Str(pan_y),,,efs)
EndIf
If edit_mode Then etext(scr_w-40,scr_h-16,"EDIT MODE",_Red,,efs)
/'
If battle_active Then
Line Scrn,(0,460)-(639,479),RGB(30,30,30),bf
Draw String Scrn,(5,462),"MP:"
Line Scrn,(30,462)-(30+obj(Me).s.mp,470),RGB(0,255,0),bf
Draw String Scrn,(5,472),"Turn: "+Str(battle_turn)
If battle_turn > 1 Then
Line Scrn,(200,462)-(200+obj(battling(battle_turn)).s.mp,470),rgb(255,0,0),bf
Draw String Scrn,(200,462),"AP:"+Str(obj(battling(battle_turn)).s.ap)
endif
End If
'/
End Sub
Sub __ProxyFlip(cursor As Integer = 1)
prvMB = mb
GetMouse(mx,my,,mb)
cam_x = -pan_x
cam_y = -pan_y
If edit_mode Then
If mx > scr_w-1 Then mx = scr_w-1: SetMouse(mx,my)
If my > scr_h-1 Then my = scr_h-1: SetMouse(mx,my)
Else
If mx < cam_x1 Then mx = cam_x1: SetMouse(mx,my)
If my < cam_y1 Then my = cam_y1: SetMouse(mx,my)
If mx > cam_x2-1 Then mx = cam_x2-1: SetMouse(mx,my)
If my > cam_y2-1 Then my = cam_y2-1: SetMouse(mx,my)
EndIf
mmx = -pan_x+mx : mmy = -pan_y+my '' Map Mouse X/Y
If cursor Then GL.sprite_scale(mx,my,1.0,gui_spr(cursor).p)
Flip
If FPS_LIMIT Then FPS = GL.fps_limit(FPS_LIMIT)
End Sub
End Namespace
|
writing