'' 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
|