Phew done & Ready for Stress testing... :)
Changes:
% Editor: uses larger Palette & Tile Window (at 1024x768)
% Msgbar: black background
Editor.bb
; blitz3d version
; Last Modified by Grisu 11/09/04
; keys
; arrow keys move around map
; pgup/pgdown scroll through tiles
; return - pick up tile
; numpad4 - place a ground of 4 squares starting with the selected tile ie 12
; 34
; Space - Promote background tile to a over block tile
Include "inc\scancodes.bb"
Include "inc\soundcontrol.bb"
Include "inc\consts.bb"
Include "inc\gui.bb"
Include "inc\map.bb"
Include "inc\editor include.bb"
Include "inc\util.bb"
Include "inc\editor-room.bb"
Include "inc\editor-undo.bb"
; pick up variables (could be better!)
Global pick
Global pickx
Global picky
Global pickxs
Global pickys
Dim pickme(100,100,8)
; END OF - pick up variables (could be better!)
; set up graphics
Graphics 1024,768,32,0
SetBuffer BackBuffer()
loadGraphics() ; both version use this.
;had trouble when moving these to gui (symbFont did not exist for some reason)
Global font = LoadFont("Arial.ttf",15)
Global symbFont = LoadFont("Symbol.ttf",15)
InitGUI()
; check to load a level from the command line
If Len(CommandLine())
load(CommandLine())
Else
createRandomMap()
EndIf
Global LastInput = MilliSecs()
Global sc_x=0
Global sc_y=0
Global scrolldelay = 0
Global mousescroll=False
Const setscrolldelay = 2
Global activelayer = 1
Global activetile = 0
Global tileoffset = 0
Global xpos
Global ypos
Global current_tool=1 ; 1=tile tool, 2=room tool
Global coll_tool=1
visible(LayerCollision)=0
visible(LayerHits)=0
refreshRoomList()
quickLoadRoom("maps\rooms\default.room")
statusMsg("Ready...")
main()
End
;---------------------------------------------
Function main()
Repeat
; very first thing we do is a clear screen!
Cls
; now work out where the mouse is : over the map or tileset / palette
MouseOverMap = False
MouseOverTileset = False
If (MouseX()<860 And MouseY()<570) Then
MouseOverMap=True
ElseIf (MouseY()>610 And MouseY()<768) And (MouseX()>32 And MouseX()<1024) Then
MouseOverTileset = True
End If
; deal with the common GUI elements (the RHS of the screen)
handleGUICommon()
; next deal with the main editing area of the screen
Select current_tool
Case 3
Color 255,255,255
Text 50,50,"An integrated tile editor here would be neat..."
Case 6
Color 255,255,255
Text 50,50,"Define objectives here, with ID numbers"
Text 50,65,"Need to define what constitutes completion for each"
Text 50,80,"Each objective can have a script assigned to run on completion, which might use new commands like:"
Text 50,95,"startlevel(basement), givelevel(nebraska), giveitem(medal),giveobjective(12,mandatory)"
Text 50,110,"Assign at least one objective as mandatory to each player"
Text 50,125,"Additional optional objectives can also be assigned to each"
Text 50,140,"Note that not all objectives need to be assigned at the start"
Text 50,155,"some can be gained by completing other objectives, some by object scripts"
Case 7
Color 255,255,255
Text 50,50,"Define level settings here, such as:"
Text 50,65,"tilesets to use, object file to use"
Text 50,80,"info to show on level select screen (image, name, text, map location xy)"
Text 50,95,"background music to play"
Text 50,110,"movie / image / text to show on starting level"
Default
handleMap(MouseOverMap)
End Select
; ******************************** TOOL SPECIFIC GUI
If current_tool=1 Then ; TILE TOOL
; map stuff
If MouseOverMap Then
; tile highlighter
Color 0,255,0
Rect (xpos-Floor(sc_x/32))*32,(ypos-Floor(sc_y/32))*32,32,32,False
Select activeLayer
Case LayerCollision,LayerHits
handleMapCollision()
Case LayerBase,LayerDetail,LayerBlock,LayerObject,LayerTop
handleMapTile()
End Select
EndIf
; tile tool GUI
handlePalette(activelayer,MouseOverTileset)
ElseIf current_tool=3 Then ; TILE EDITOR
; TODO: Tile Editor!
ElseIf current_tool=2 Then ; ROOM TOOL
handleRoom()
handlePalette(LayerBase,MouseOverTileset)
ElseIf current_tool=4 Then ; FILE MENU
handleFileMenu()
ElseIf current_tool=5 Then ; EXIT MENU
If Button(880,745,140,"Confirm?",False,False,KEY_NONE,"Click to exit the editor") Then Exit
ElseIf current_tool=6 Then ; Objectives editor
; TODO: Level objectives editor
ElseIf current_tool=7 Then ; Level Settings editor
; TODO: Level settings editor
EndIf
;******************** SCREEN UPDATE
drawStatusBar()
DrawToolTip()
;******************** Pick up temp bit needs gui-ing up!
If KeyHit(15)
If pick = 0
pickx = xpos
picky = ypos
pick = 1
Else
pickxs = xpos - pickx
pickys = ypos - picky
For lllayer = 0 To 6
For xxx=0 To pickxs
For yyy=0 To pickys
If visible(lllayer) Then pickme(xxx,yyy,lllayer) = map(xxx+pickx,yyy+picky,lllayer)
Next
Next
Next
pick = 0
EndIf
EndIf
If KeyHit(16)
For lllayer = 0 To 6
For xxx=0 To pickxs
For yyy=0 To pickys
If pickme(xxx,yyy,lllayer)>0 Then map(xpos+xxx,ypos+yyy,lllayer) = pickme(xxx,yyy,lllayer)
Next
Next
Next
EndIf
If pick = 1
xx1=(pickx - Floor(sc_x/32)) *32
yy1=(picky - Floor(sc_y/32)) *32
xx2=(xpos - Floor(sc_x/32)) *32
yy2=(ypos - Floor(sc_y/32)) *32
Color MilliSecs() Mod 512 / 2,0,0
Rect xx1,yy1,(xx2-xx1)+32,(yy2-yy1)+32,False
EndIf
;******************** END OF - Pick up temp bit needs gui-ing up!
DrawImage cursor,MouseX()-1,MouseY()-1
Flip
Forever
End Function
Function handleGUICommon()
Local Startx=880
Local Starty=375, Starty1=640
;*************************** core GUI elements
; layers / visibility
For n=0 To NumLayers
If current_tool=1 And activelayer=n Then act=True Else act=False
If Button(Startx,Starty+n*20,100,layername(n),act,False,n+2,"Edit this map layer") Then
activelayer=n
If activeLayer = LayerObject Then tileoffset = 0
If activelayer = LayerHits Then coll_tool=4
If activelayer = LayerCollision Then coll_tool=1
current_tool=1
EndIf
If Button(Startx+110,Starty+n*20,30,"Vis",visible(n),False,KEY_NONE,"Show / Hide this layer on the map")
visible(n)=(visible(n)+1) Mod 2
Repeat:Until MouseDown(1)=False
EndIf
Next
; other drawing tools
If Button(Startx,Starty1,140,"Room Tool",current_tool=2,False,KEY_NONE,"Create and draw rooms") Then current_tool=2
If Button(Startx,Starty1+20,140,"Tile Editor",current_tool=3,False,KEY_NONE,"Edit tiles") Then current_tool=3
If Button(Startx,Starty1+40,140,"Objectives",current_tool=6,False,KEY_NONE,"Define level objectives") Then current_tool=6
If Button(Startx,Starty1+60,140,"Level Settings",current_tool=7,False,KEY_NONE,"Define level settings") Then current_tool=7
If Button(Startx,Starty1+80,68,"File Menu",current_tool=4,False,KEY_NONE,"Load, save or create a new level") Then current_tool=4
If Button(Startx+73,Starty1+80,68,"Exit",current_tool=5,False,KEY_NONE,"Exit the editor") Then current_tool=5
ry=GraphicsHeight()-140
If First undoTile<>Null ;Undo tools
If Button(Startx+73,Starty1-50,68,"Undo",False,False,KEY_NONE,"Undo all changes up to last reset")
doUndo():Delay 200
ElseIf Button(Startx,Starty1-50,68,"Reset",False,False,KEY_NONE,"Reset undo history")
clearUndo():Delay 200
EndIf
EndIf
End Function
Function handleMap(mouseover)
;********************* MAP
; draw the selected layers of the map
For n=1 To NumLayers
If visible(n)=1 Then drawmap(sc_x,sc_y,n,True);drawmap_inEditor(sc_x,sc_y,n)
Next
If visible(LayerCollision)=1 Then drawmap(sc_x,sc_y,LayerCollision,True) ; needs to be drawn last!
; find mouse location on map
If mouseover Then
xpos = Floor(MouseX()/32)+Floor(sc_x/32)
ypos = Floor(MouseY()/32)+Floor(sc_y/32)
Button(2,560,28,xpos)
Button(2,580,28,ypos)
Else
xpos = -1
ypos = -1
EndIf
;******************* INPUT HANDLING
; map movement code (arrow keys and mouse near edge)
key_left=False:key_right=False:key_up=False:key_down=False
If mouseover Then
If MouseX()<5 Then key_left=True
If MouseX()>830 Then key_right=True
If MouseY()<5 Then key_up=True
If MouseY()>550 Then key_down=True
If key_left Or key_right Or key_up Or key_down Then
If Not mousescroll Then mousescroll=True:scrolldelay=setscrolldelay
Else
mousescroll=False
End If
EndIf
If KeyDown(KEY_ARROW_RIGHT) Then key_right=True
If KeyDown(KEY_ARROW_LEFT) Then key_left=True
If KeyDown(KEY_ARROW_UP) Then key_up=True
If KeyDown(KEY_ARROW_DOWN) Then key_down=True
; slow down the map scrolling a bit
If scrolldelay < 0
If key_right And sc_x<7552 Then sc_x=sc_x+32 : scrolldelay = setscrolldelay
If key_left And sc_x>0 Then sc_x=sc_x-32 : scrolldelay = setscrolldelay
If key_up And sc_y>0 Then sc_y=sc_y-32 : scrolldelay = setscrolldelay
If key_down And sc_y<7552 Then sc_y=sc_y+32 : scrolldelay = setscrolldelay
Else
scrolldelay = scrolldelay - 1
EndIf
End Function
Function handleMapCollision()
If MouseDown(1) Then
Select coll_tool
Case 1; static
undoTile(xpos,ypos,map(xpos,ypos,LayerHits),map(xpos,ypos,LayerCollision))
;if left control is held
If KeyDown(KEY_CTRL_LEFT) Then
map(xpos,ypos,LayerCollision)=czVisStatic
Else
map(xpos,ypos,LayerCollision)=czStatic
EndIf
map(xpos,ypos,LayerHits)=-1
Case 2; dynamic
undoTile(xpos,ypos,map(xpos,ypos,LayerHits),map(xpos,ypos,LayerCollision))
;if left control is held
If KeyDown(KEY_CTRL_LEFT) Then
map(xpos,ypos,LayerCollision)=czVisDynamic
Else
map(xpos,ypos,LayerCollision)=czDynamic
EndIf
map(xpos,ypos,LayerHits)= lhDefaultHits ;see consts.bb for lhDefaultHits
Case 3; vis blocker
undoTile(xpos,ypos,map(xpos,ypos,LayerHits),map(xpos,ypos,LayerCollision))
If map(xpos,ypos,LayerCollision)=czDynamic Then
map(xpos,ypos,LayerCollision)=czVisDynamic
ElseIf map(xpos,ypos,LayerCollision)=czStatic
map(xpos,ypos,LayerCollision)=czVisStatic
EndIf
Case 4; hitpoint tool
undoTile(xpos,ypos,map(xpos,ypos,LayerHits),map(xpos,ypos,LayerCollision))
If map(xpos,ypos,LayerCollision)=czDynamic Or map(xpos,ypos,LayerCollision)=czVisDynamic Then
;if left control is held
If KeyDown(KEY_CTRL_LEFT) Then IncVal = 5 Else IncVal = 1
map(xpos,ypos,LayerHits) = map(xpos,ypos,LayerHits) + IncVal
;limit the maximum value for a dynamic collisions hit points to 99
If map(xpos,ypos,LayerHits) > lhMaxHits Then map(xpos,ypos,LayerHits) = 99
Delay 100 ; not too quick now!
EndIf
End Select
ElseIf MouseDown(2) Then
undoTile(xpos,ypos,map(xpos,ypos,LayerHits),map(xpos,ypos,LayerCollision))
Select coll_tool
Case 1,2
map(xpos,ypos,LayerCollision)=0
map(xpos,ypos,LayerHits) = 0
Case 3
If map(xpos,ypos,LayerCollision)=czVisDynamic Then
map(xpos,ypos,LayerCollision)=czDynamic
ElseIf map(xpos,ypos,LayerCollision)=czVisStatic
map(xpos,ypos,LayerCollision)=czStatic
EndIf
Case 4; hitpoint tool
undoTile(xpos,ypos,map(xpos,ypos,LayerHits),map(xpos,ypos,LayerCollision))
If map(xpos,ypos,LayerCollision)=czDynamic Or map(xpos,ypos,LayerCollision)=czVisDynamic Then
;if left control is held
If KeyDown(KEY_CTRL_LEFT) Then IncVal = -5 Else IncVal = -1
map(xpos,ypos,LayerHits) = map(xpos,ypos,LayerHits) + IncVal
;limit the minimum value for a dynamic collisions hit points to 1
If map(xpos,ypos,LayerHits) < 1 Then map(xpos,ypos,LayerHits) = 1
Delay 100 ; not too quick now!
EndIf
End Select
EndIf
End Function
Function handleMapTile()
; Left mouse button handler
If MouseDown(1) Then
If activelayer=LayerObject Then
If activetile<numDefaultObjects
map(xpos,ypos,activelayer)=activetile+1
If activetile = 37 ; give a barrel 5 hit points
map(xpos,ypos,LayerHits) = 5
map(xpos,ypos,LayerCollision)=czDynamic
EndIf
EndIf
Else
undoTile(xpos,ypos,map(xpos,ypos,activeLayer),map(xpos,ypos,LayerCollision))
map(xpos,ypos,activelayer)=activetile+1
End If
End If
;Right Mouse Button Layer Handler
If MouseDown(2) Then
Select ActiveLayer
Case LayerBase
undoTile(xpos,ypos,map(xpos,ypos,ActiveLayer),map(xpos,ypos,LayerCollision))
map(xpos,ypos,activelayer) = 0
Case LayerObject,LayerBlock,LayerDetail,LayerTop
undoTile(xpos,ypos,map(xpos,ypos,ActiveLayer),map(xpos,ypos,LayerCollision))
map(xpos,ypos,ActiveLayer) = 0
End Select
EndIf
; NB: removed promotion of base tile to top tile (SPACE) as they now have different tilesets!
If KeyDown(KEY_ENTER) Then activetile = map(xpos,ypos,activelayer)-1 ; pick up tile (RETURN)
If KeyDown(KEY_NUMPAD_4) ; place 4 concurrent tiles in a square (NUMPAD4!)
; TODO: Undo in here
map(xpos,ypos,activelayer)=activetile+1
map(xpos+1,ypos,activelayer)=activetile+2
map(xpos,ypos+1,activelayer)=activetile+3
map(xpos+1,ypos+1,activelayer)=activetile+4
EndIf
End Function
Function handlePalette(layer,mouseover)
Local StartX=400
mz = MouseZSpeed()
;select the tileset to show in the palette
Select layer
Case LayerBase, LayerBlock
tileset=btiles : maxtile=bmaxtile
Case LayerObject
tileset=objects : maxtile=NumDefaultObjects
Case LayerDetail,LayerTop
tileset=dtiles : maxtile=dmaxtile
Case LayerCollision,LayerHits
If Button(Startx+40,610,100,"Static",coll_tool=1,False,KEY_S,"Set tiles to be indestructible walls, vis blocking with Left Control") Then coll_tool=1
If Button(Startx+150,610,100,"Dynamic",coll_tool=2,False,KEY_D,"Set tiles to be destructible walls, vis blocking with Left Control") Then coll_tool=2
If Button(Startx+260,610,100,"Vis-Blocker",coll_tool=3,False,KEY_V,"Set tiles to be barriers to vis checking") Then coll_tool=3
If Button(Startx+370,610,100,"Hit Points",coll_tool=4,False,KEY_H,"Set tiles to be barriers to vis checking, faster with Left Control") Then coll_tool=4
Return
Default
Return ; no point hanging around - there's no relevant palette!
End Select
; active tile
Button(835,590,28,activetile+1,False,False,KEY_NONE,"The ID of the currently selected tile")
Color 255,255,255:Text 1,1, "Grisu's Xtra LARGE Editor";: "+MouseX()+":"+MouseY()
;draw the palette itself
For n=0 To 129
tileno = n + tileoffset
If layer=LayerObject Then
If tileno<maxtile Then
DrawBlock tileset,((n-(Floor(n/26)*26))*32)+32,610+(Floor(n/26)*32),Abs(objectdef(n+tileoffset+1)\image)
ElseIf tileno=maxtile Then
DrawBlock tileset,((n-(Floor(n/26)*26))*32)+32,610+(Floor(n/26)*32),39 ; 39 is the SPECIAL tile
End If
Else
If tileno<maxtile Then DrawBlock tileset,((n-(Floor(n/26)*26))*32)+32,610+(Floor(n/26)*32),n+tileoffset
End If
If tileno = activetile Then Color 0,255,0:Rect ((n-(Floor(n/26)*26))*32)+32,610+(Floor(n/26)*32),32,32,False
Next
; move around the palette
tup=0
;I know it looks like there is nothing in the quotes in the line below, but trust me, there is
If (Button (0,610,32,"",False,True,KEY_PAGE_UP,"Scroll up the tileset",False)=True Or (mz = 1 And MouseOver)) And tileoffset > 0 And scrolldelay<0 Then tup=-1
If (Button (0,630,32,"¯",False,True,KEY_PAGE_DOWN,"Scroll down the tileset",False)=True Or (mz = -1 And MouseOver)) And scrolldelay<0 Then tup=1
If KeyDown(KEY_NUMPAD_0) And scrolldelay<0 Then activetile = activetile +1:scrolldelay=10
If KeyDown(KEY_CTRL_RIGHT) And scrolldelay<0 Then activetile = activetile -1:scrolldelay=10
If tup<>0 Then tileoffset=tileoffset + (tup*26):scrolldelay=15
; handle mouse being over the palette
If mouseover Then
If MouseDown(1) Then
checktile = (Floor((MouseX()-32)/32))+(Floor((MouseY()-610)/32)*26)+tileoffset
If (checktile < maxtile) And (checktile >-1) Then activetile = checktile
;If currentRoom<>Null And scrolldelay<0 Then UpdateRoomBlock() <-removed in changing how room tiles are selected
ElseIf MouseDown(2)
If Layer=layerObject And (First objdef<>Null)
checktile = (Floor((MouseX()-32)/32))+(Floor((MouseY()-610)/32)*26)+tileoffset
If (checktile < maxtile) And (checktile >-1) Then activetile2 = checktile
If (activetile2+1) =< numDefaultObjects
For n=1 To CountString(objectdef(activetile2+1)\trigger,"|")
trigger$=parse(objectdef(activetile2+1)\trigger,"|",n)
newdef$ = InputBox("New Script for trigger: '"+trigger+"'. ESC or RETURN to end",20,20,500,300,True,objectdef(activetile2+1)\script[n])
If Len(newDef) > 0 Then objectdef(activetile2+1)\script[n] = newdef$
Next
EndIf
EndIf
Else
; move your mouse over it
If Layer=layerObject And (First objdef<>Null)
checktile = 1+(Floor((MouseX()-32)/32))+(Floor((MouseY()-610)/32)*26)+tileoffset
If (checktile <= maxtile) And (checktile >0) Then
If objectdef(checktile)<>Null
w=400
count=CountString(objectdef(checktile)\trigger,"|")
h=80+(20*(count+1))
Color 60,60,60:Rect 12,13,w,h,1:Rect 13,13+h,StringWidth("MB2 to edit")+5,FontHeight(),1
Color 255,255,255 : Rect 10,10,w,h,1 : Rect 10,10+h,StringWidth("MB2 to edit")+5,FontHeight(),1
Color 0,0,0 : Rect 10,10,w,h,0 : Rect 10,10+h,StringWidth("MB2 to edit")+5,FontHeight(),0
Text 20,20,"Object: "+objectdef(checktile)\name
Text 20,40,"Image: "+objectdef(checktile)\image
Text 20,60,"Trigger: "+objectdef(checktile)\trigger
For n=1 To CountString(objectdef(checktile)\trigger,"|")
Text 20,80+(n*20),objectdef(checktile)\script[n]
Next
Text 12,10+h,"MB2 to edit"
End If
ElseIf checktile=maxtile+1 Then
w=400
h=100
Color 60,60,60:Rect 12,13,w,h,1
Color 255,255,255 : Rect 10,10,w,h,1
Color 0,0,0 : Rect 10,10,w,h,0
Text 20,20,"Special Object: Not implemented yet!"
EndIf
EndIf
EndIf
EndIf
End Function
Function handleRoom()
;draw mini room
rx=GraphicsWidth()-150
ry=GraphicsHeight()-240
drawRoom(rx,ry)
; new room
If Button(GraphicsWidth()-50,ry,48,"New",False)
createBlankRoom():Delay 200 ; stop fast re-clicking
; load room
ElseIf Button(GraphicsWidth()-50,ry+20,48,"Load",False)
; load the listbox containing possible rooms.
num=ListDlg(rx-200,ry-230,180,330,room_list)
If num<>-1
which$=SL_Strings(room_list,num)
If Instr(which,".room")<>0
quickLoadRoom(which)
EndIf
EndIf
Delay 200
; save room
ElseIf Button(GraphicsWidth()-50,ry+40,48,"Save",False)
saveRoom():Delay 200
EndIf
; draw room
If xpos>-1 Then
If MouseDown(1)
If create_a_room_sx=-1 And create_a_room_sy=-1
;DebugLog "setting up room..."
create_a_room_sx=xpos
create_a_room_sy=ypos
EndIf
Else
If create_a_room_sx<>-1 And create_a_room_sy<>-1
;DebugLog "Creating room..."
; ready to finish.
createRoomHere(create_a_room_sx,create_a_room_sy,xpos,ypos)
create_a_room_sx=-1
create_a_room_sy=-1
EndIf
EndIf
Else
create_a_room_sx=-1
create_a_room_sy=-1
End If
; draw other GUI elements
If create_a_room_sx=-1 And create_a_room_sy=-1
statusMsg("Use LMB on map to start top left corner of a room, and drag and release to size",0)
; tile highlighter
Color 0,55,0
x=(xpos-Floor(sc_x/32))*32:y=(ypos-Floor(sc_y/32))*32
Line x,y,x+32,y
Line x,y,x,y+32
Else
Button(2,510,28,create_a_room_sx)
Button(2,530,28,create_a_room_sy)
Button(2,550,28,Int(Abs(create_a_room_sx-xpos)+1))
Button(2,570,28,Int(Abs(create_a_room_sy-ypos)+1))
; tile highlighter
Color 0,255,0
x=(xpos-Floor(sc_x/32))*32:y=(ypos-Floor(sc_y/32))*32
Line x+32,y,x+32,y+32
Line x,y+32,x+32,y+32
Line create_a_room_sx*32-sc_x, create_a_room_sy*32-sc_y, 32+create_a_room_sx*32-sc_x, create_a_room_sy*32-sc_y
Line create_a_room_sx*32-sc_x, create_a_room_sy*32-sc_y, create_a_room_sx*32-sc_x, 32+create_a_room_sy*32-sc_y
EndIf
End Function
Function handleFileMenu()
Local Startx=720, Starty=640, Startx2=260, Starty2=290
; FILE TOOLS
If Button(Startx,Starty,140,"New",False,False,KEY_F8,"Create a new map") Then createRandomMap()
If Button(Startx,Starty+20,140,"Save",False,False,KEY_F1,"Save the current map") Then
FileName$ = InputBox("Enter filename to save (without .map extension)",Startx2+200,Starty2+300,400,40,True,"maps")
If Len(FileName) <1 Then Return
If FileType(FileName) = 2 Then Return
If Instr(filename,".map") Then Replace(filename,".map","")
save(filename)
;Save last file name
fileout = WriteFile("prefs.txt")
WriteString fileout,FileName$
CloseFile(fileout)
End If
If Button(Startx,Starty+40,140,"Load",False,False,KEY_F4,"Load an existing map") Then
FileName$ = InputBox("Enter filename to load (without .map extension)",Startx2+200,Starty2+300,400,40,True,"maps")
If Instr(filename,".map") Then Replace(filename,".map","") ; just in case
load(filename) ; call common load.
moveToStartPosition()
DebugLog "Loaded: " + FileName$
statusMsg("Loaded: " + FileName$)
End If
If Button(Startx,Starty+60,140,"Load Last",False,False,KEY_F5,"Load the last edited map") Then
FileIn = ReadFile("prefs.txt")
FileName$ = ReadString(FileIn)
CloseFile(FileIn)
If Len(FileName$) > 0 Then Load(FileName$): moveToStartPosition()
End If
End Function
Function moveToStartPosition()
; find a start position and move the screen there
For i=0 To 254
For j=0 To 254
tile=map(i,j,LayerObject)
If tile>0
For k=0 To 5
script$=Lower(objectdef(tile)\script[k])
If Instr(script,"positionplayer")
; we've found it...
sc_x=((i-10)*32)
sc_y=((j-10)*32)
Return
EndIf
Next
EndIf
Next
Next
End Function
Map.bb
; map.bb
; Last Modified by Grisu 11/09/04
; recently moved from editor include.bb
Global dmaxtile = 0 ;set in loadGraphics below
Global dmaxobject = 0
Global bmaxtile = 0 ;set in loadGraphics below
Global bmaxobject = 0
Global dtiles,btiles,objects,cursor,tiles_small
Global maxobject
Global NumDefaultObjects,NumLevelObjects
Global use_overlay_layer=True
Function loadGraphics$()
; load tiles
img=LoadImage("gfx/base.png")
bmaxtile=(ImageWidth(img)/32)*ImageHeight(img)/32
FreeImage img
btiles = LoadAnimImage("gfx/base.png",32,32,0,bmaxtile)
img=LoadImage("gfx/detail.png")
dmaxtile=(ImageWidth(img)/32)*ImageHeight(img)/32
FreeImage img
dtiles = LoadAnimImage("gfx/detail.png",32,32,0,dmaxtile)
MaskImage dtiles,255,0,255
; load objects
img=LoadImage("gfx/objects.png")
maxobject=(ImageWidth(img)/32)*ImageHeight(img)/32
FreeImage img
objects = LoadAnimImage("gfx/objects.png",32,32,0,maxobject)
MaskImage objects,255,0,255
; load small tiles
;tiles_small = LoadAnimImage("gfx/tiles_small.png",16,16,0,maxtile)
;MaskImage tiles_small,255,0,255
cursor = LoadImage("gfx/cursor.png")
MaskImage cursor,255,0,255
font=LoadFont("tahoma.ttf",10):SetFont(font)
End Function
; load the map in
; load the map in
Function Load(filename$)
If FileType(FileName$+".map") = 1
filein = ReadFile(FileName$+".map")
For layer = 0 To NumLayers
;If layer<>LayerDetail
For x=0 To 255
For y=0 To 255
map(x,y,layer)= ReadInt(filein)
Next
Next
;EndIf
Next
CloseFile filein
Else
DebugLog "Filename does not exist: " + FileName$+".map"
EndIf
NumDefaultObjects=LoadObjectFile("maps\default")
NumLevelObjects=LoadObjectFile(FileName$,MAX_DEFAULT_OBJECTS)
End Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;
; FUNCTION LoadObjectFile ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function LoadObjectFile(FileName$,startid=1)
;load the object file
filename=Replace(filename,".map","")
If startid=1 Then Delete Each objdef
If FileType(FileName$+".obj") = 1
filein = ReadFile(FileName$+".obj")
num=parse(ReadLine(filein),"=",1)
ReadLine(filein) ; blank space
If num>0 Then
;Dim objectdef.objdef(startid+num)
If startid+num>MAX_OBJECTS Then num=MAX_OBJECTS-startid:DebugLog "Tried too load too many objects! Trimmed object list to "+MAX_OBJECTS
For i=startid To startid+num
objectdef(i)=New objdef
objectdef(i)\image=Trim(parse(ReadLine(filein),"=",1))
objectdef(i)\trigger=Trim(parse(ReadLine(filein),"=",1))
;add a separator to the start to make searching simpler
If Left(objectdef(i)\trigger,1)<>"|" Then objectdef(i)\trigger="|"+objectdef(i)\trigger
objectdef(i)\name=Trim(parse(ReadLine(filein),"=",1))
For n=1 To CountString(objectdef(i)\trigger,"|")
objectdef(i)\script[n]=ReadLine(filein)
Next
ReadLine(filein); blank space
Next
End If
DebugLog num+" objects loaded from "+FileName+".obj"
CloseFile filein
Else
DebugLog "Filename does not exist: " + FileName$+".obj"
EndIf
Return num
End Function
Function Save(filename$)
fileout = WriteFile(FileName+".map")
For layer = 0 To NumLayers
For x=0 To 255
For y=0 To 255
WriteInt(fileout,map(x,y,layer))
Next
Next
Next
CloseFile fileout
saveObjectFile("maps\default",1,NumDefaultObjects)
SaveObjectFile(filename$,MAX_DEFAULT_OBJECTS,NumLevelObjects)
End Function
Function SaveObjectFile(filename$,startid,num)
; save the object definition file
fileout = WriteFile(FileName+".obj")
WriteLine fileout,"total objects = "+num ; number of objects
WriteLine fileout, "" ; blank line
For i=startid To startid+num-1
WriteLine fileout, "image = "+objectdef(i)\image
WriteLine fileout, "trigger = "+Mid(objectdef(i)\trigger,2) ; chop off the first | for saving
WriteLine fileout, "description = "+objectdef(i)\name
For n=1 To CountString(objectdef(i)\trigger,"|")
WriteLine fileout,objectdef(i)\script[n]
Next
WriteLine fileout,"" ; blank line
Next
CloseFile fileout
End Function
; Get tile gets the tile under x,y (pixels) world co-ordinates
Function gettile(x,y,layer)
; sort out the block location based on pixel co-ord
x = Floor(x/32)
y = Floor(y/32)
; the following four lines should be unnecessary!
If x < 0 Then Return
If y < 0 Then Return
If x > 255 Then Return
If y > 255 Then Return
Return map(x,y,layer)
End Function
Function puttile(x,y,layer,newtile)
x = Floor(x/32)
y = Floor(y/32)
; the following four lines should be unnecessary!
If x < 0 Then Return
If y < 0 Then Return
If x > 255 Then Return
If y > 255 Then Return
map(x,y,layer)=newtile
End Function
Function opendoor(x,y,vis=True)
id%=map(x,y,LayerObject)
If id=0
RuntimeError("Function Map->OpenDoor("+x+","+y+","+vis+")"+Chr(13)+"has tried to access a tile with nothing in it.")
EndIf
map(x,y,LayerObject)=0 ; set to 0
map(x,y,LayerCollision)=0
If map(x,y-1,LayerObject)=id Then opendoor(x,y-1,False)
If map(x,y+1,LayerObject)=id Then opendoor(x,y+1,False)
If map(x+1,y,LayerObject)=id Then opendoor(x+1,y,False)
If map(x-1,y,LayerObject)=id Then opendoor(x-1,y,False)
; check the vis from this newly opened door!
If vis Then CheckVis(x,y)
End Function
Function drawmap(xpos,ypos,layer,ineditor=False)
; This function draws the map
; NB: for all "if ___ then Draw ___" lines, multiply the expression by map(x+xoff,y+yoff,LAYER_VISIBLE)
; determine sizes
blocksize=32
min_x=-1
min_y=-1
If ineditor Then
max_x=26
max_y=17
Else
max_x=20
max_y=16
EndIf
; sort out the block location based on pixel co-ord
xoff = Floor(xpos/blocksize)
yoff = Floor(ypos/blocksize)
; find the pixel offset
xpxoff = (xoff * blocksize) - xpos
ypxoff = (yoff * blocksize) - ypos
; limit tile drawing are to map size
If xoff<=0 Then min_x=-xoff
If yoff<=0 Then min_y=-yoff
If xoff>255-max_x Then max_x=255-xoff
If yoff>255-max_y Then max_y=255-yoff
; draw base layer
; uses draw block so you don't need a cls and is quicker.
If layer = LayerBase
For x = min_x To max_x
For y = min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
If map(x+xoff,y+yoff,layer)>0 Then
If map(x+xoff,y+yoff,LAYER_VISIBLE)>0 Or ineditor Then DrawBlock btiles,(x*blocksize)+xpxoff,(y*blocksize)+ypxoff,map(x+xoff,y+yoff,layer)-1
EndIf
; EndIf
Next
Next
EndIf
If layer = LayerObject
For x = min_x To max_x
For y = min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
tile=map(x+xoff,y+yoff,layer)
If tile>0 Then
If ineditor Then
img=Abs(objectdef(tile)\image)
Else
If map(x+xoff,y+yoff,LAYER_VISIBLE)>0 Then img=objectdef(tile)\image Else img=-1
End If
If img>=0 Then DrawImage objects,(x*blocksize)+xpxoff,(y*blocksize)+ypxoff,img
EndIf
; EndIf
Next
Next
EndIf
; draw other layers
If layer = LayerTop And use_overlay_layer
For x = min_x To max_x
For y = min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
If map(x+xoff,y+yoff,layer)>0 Then
If map(x+xoff,y+yoff,LAYER_VISIBLE)>0 Or ineditor Then DrawImage dtiles,(x*blocksize)+xpxoff,(y*blocksize)+ypxoff,map(x+xoff,y+yoff,layer)-1
End If
; EndIf
Next
Next
EndIf
; layer 4, block overlay no transparancy
If layer = LayerBlock
For x = min_x To max_x
For y = min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
If map(x+xoff,y+yoff,layer)>0 Then
If map(x+xoff,y+yoff,LAYER_VISIBLE)>0 Or ineditor Then DrawBlock btiles,(x*blocksize)+xpxoff,(y*blocksize)+ypxoff,map(x+xoff,y+yoff,layer)-1
End If
; EndIf
Next
Next
EndIf
; detail overlay
If layer = LayerDetail
For x = min_x To max_x
For y = min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
If map(x+xoff,y+yoff,layer)>0
If map(x+xoff,y+yoff,LAYER_VISIBLE)>0 Or ineditor Then DrawImage dtiles,(x*blocksize)+xpxoff,(y*blocksize)+ypxoff,map(x+xoff,y+yoff,layer)-1
EndIf
; EndIf
Next
Next
EndIf
If layer = LayerHits And ineditor
Color 255,255,255
For x = min_x To max_x
For y = min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
If map(x+xoff,y+yoff,layer)=-1 Then Text (x*32)+8,(y*32)+8,map(x+xoff,y+yoff,layer),True
If map(x+xoff,y+yoff,layer)>0 Then Text (x*32)+8,(y*32)+8,map(x+xoff,y+yoff,layer),True
; End If
Next
Next
EndIf
If layer=LayerCollision And ineditor
For x=min_x To max_x
For y=min_y To max_y
; If x+xoff>=0 And y+yoff>=0 And x+xoff<=255 And y+yoff<=255
Select map(x+xoff,y+yoff,LayerCollision )
Case czStatic
Color 255,0,0
Rect (x*32)+7,(y*32)+7,18,18,False
Case czDynamic
Color 0,255,0
Rect (x*32)+7,(y*32)+7,18,18,False
Case czVisStatic
Color 255,255,255
Rect (x*32)+8,(y*32)+8,16,16,False
Color 255,0,0
Rect (x*32)+7,(y*32)+7,18,18,False
Case czVisDynamic
Color 255,255,255
Rect (x*32)+8,(y*32)+8,16,16,False
Color 0,255,0
Rect (x*32)+7,(y*32)+7,18,18,False
Default
;do nothing
End Select
; End If
Next
Next
End If
End Function
; list of tiles to check for visibility
Type vis_list
Field x,y
End Type
Function CheckVis(x,y)
; This function determine the map vis for a player
; add the start tile to the list
v.vis_list=New vis_list
v\x=x
v\y=y
; and start checking by looping through all tiles in the list that need checking
Repeat
; go through all 8 nearby squares
For i=1 To 8
Select i
Case 1:x=v\x-1:y=v\y-1
Case 2:x=v\x-1:y=v\y
Case 3:x=v\x-1:y=v\y+1
Case 4:x=v\x:y=v\y-1
Case 5:x=v\x:y=v\y+1
Case 6:x=v\x+1:y=v\y-1
Case 7:x=v\x+1:y=v\y
Case 8:x=v\x+1:y=v\y+1
End Select
; if it's on the map, we check it
If x>=0 And x<=255 And y>=0 And y<=255 Then
; if it's never been checked before (vis=0), check it. otherwise, don't bother
If map(x,y,LAYER_VISIBLE)=0 Then
; set it to visible (including all solid blocks at the boundary of vis are themselves visible)
map(x,y,LAYER_VISIBLE)=1
; and provided it's not a vis stop, add it to the list of tiles to process
If map(x,y,0)<czVisStatic Then
nv.vis_list=New vis_list
nv\x=x
nv\y=y
End If
End If
End If
Next
; set current tile to visible
map(v\x,v\y,LAYER_VISIBLE)=1
; eliminate this one from the list to check and move on to the next one
Delete v
v=First vis_list
Until v=Null
End Function
Function ClearVis()
;set initial visibility for all tiles to none at all
;we'll set initial player vis when we create the player
For x=0 To 255
For y=0 To 255
map(x,y,LAYER_VISIBLE)=0
Next
Next
End Function
Gui.bb
;Global font = LoadFont("Arial.ttf",15)
;Global symbFont = LoadFont("Symbol.ttf",15)
Include "inc\stringlist.bb"
Dim CharWidths(1)
Const KeyRepeat% = 100
Const CaratSymbol$ = "¦"
Type TRGB
Field ColRed%
Field ColGreen%
Field ColBlue%
End Type
Global myRGB.TRGB = New TRGB
Type TCarat
;X and Y in characters not pixels
Field X%
Field Y%
Field PX%
Field PY%
Field Symbol$ = "¦"
End Type
Type TKeyState
Field Scancode%
Field Ascii%
Field Shift
Field Ctrl
End Type
Type TLine
Field LineNum%
Field Txt$
Field Owner$
End Type
;;;;;;;;;;;;;;;;;;;;
; FUNCTION InitGUI ;
;;;;;;;;;;;;;;;;;;;;
Function InitGUI()
SetFont font
;INPUT BOX SETUP
;Get the character widths
Dim charwidths(512)
charwidths(32) = 4
For c = 33 To 512
charwidths(c) = StringWidth(Chr$(c))
Next
End Function
;;;;;;;;;;;;;;;;;;;
; FUNCTION Button ;
;;;;;;;;;;;;;;;;;;;
Function Button(x,y,width,name$,active=False, symbol=False, ShortCutKey=KEY_NONE,tip$="", ShowShortCut = True, OffCol%=$A0A0A0, OverCol%=$C8C8C8, TextCol%=$000000)
;VARS
Local result = False
;MAIN
If (ShortCutKey > KEY_NONE) Then
If ShowShortCut Then name = name + " ("+ KeyNames(ShortCutKey) +")"
tip$ = tip$ + " ("+ KeyNames(ShortCutKey) +")"
EndIf
If RectsOverlap(MouseX(),MouseY(),1,1,x,y,width,16) Then
myRGB = GetRGB(OverCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
tooltip(MouseX(),MouseY(),tip$)
Else
myRGB = GetRGB(OffCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
EndIf
Rect x,y,width,16
myRGB = GetRGB(TextCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
If Symbol Then SetFont symbFont
Text x+width/2,y+7,name,True,True
If Symbol Then SetFont Font
If active Then Color 255,0,0:Rect x,y,width,16,False
If RectsOverlap(MouseX(),MouseY(),1,1,x,y,width,16) And MouseDown(1) Then result = True
If ShortCutKey > KEY_NONE Then
If KeyDown(ShortCutKey) Then Result = True
EndIf
Return Result
End Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; FUNCTION InputBox ;
; Parameters: ;
; msg$ : any message to display above the input box ;
; x,y : top left coords ;
; width, height: outer width and height of inputbox ;
; rtnSubmit : if the return key is pressed, then ;
; automatically submit the text ;
; If this is false, then an OK button is ;
; displayed at the bottom of the box ;
; DefaultText : automatically inserts this into the ;
; input box, the carat will be positioned at the end ;
; of this text. ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function InputBox$(Msg$,x,y,width,height,rtnSubmit=True, DefaultText$="", BGCol%=$FFFFFF, TextCol%=$000000, BorderCol%=$A0A0A0)
SetFont Font
;;;;;;
;vars;
;;;;;;
Local leave = False
Local InnerWidth = Width - 6
Local InnerHeight = Height - 40
Local InnerX = 6
Local InnerY = 20
Local retString$ = ""
Local fntWidth = FontWidth()/4
Local fntHeight = FontHeight()
Local EditWin = CreateImage(width, height)
Local BGImage = CreateImage(GraphicsWidth(), GraphicsHeight())
Local Delimiters$ = "|() "+Chr$(13)
Local FoundDelim = False
Local TopLine = 0
Local Carat.TCarat = New TCarat
Carat\X = 0
Carat\Y = 0
Local SelStart% = 0
Local SelEnd% = 0
Local CaratPos% = 0
Local ScrollPos = 0
Local ScrollWidth = 12
;;;;;;
;main;
;;;;;;
CopyRect 0,0,GraphicsWidth()-1, GraphicsHeight()-1, 0,0, GraphicsBuffer(), ImageBuffer(BGImage)
If rtnSubmit Then InnerHeight = Height - 6
FlushKeys()
CaratPos = Len(DefaultText)
retString = retString+DefaultText
Repeat
;quit the function without returning any text if escape is pressed
If KeyHit(1) Then
leave = True
retString$ = ""
EndIf
;;;;;;;;;;;;;;;;;;;;;
;get character input;
;;;;;;;;;;;;;;;;;;;;;
get = GetKey()
If Get = 13 Then
If rtnSubmit Then
leave = True ;if return is pressed and rtnSubmit is True then leave
Else
LeftSide$ = Left$(retString$,CaratPos)
RightSide$ = Right$(retString$, Len(RetString)-CaratPos)
retString$ = LeftSide$ + Chr(get) + RightSide$
CaratPos = CaratPos + 1
EndIf
ElseIf KeyDown(14); backspace
If MilliSecs()-LastInput > KeyRepeat Then
If Len(retString$) > 0 Then
LeftSide$ = Left$(retString$,CaratPos)
RightSide$ = Right$(retString$, Len(RetString)-CaratPos)
retString$ = Left$(LeftSide$, Len(LeftSide$) -1) + RightSide$
EndIf
LastInput = MilliSecs()
CaratPos = CaratPos - 1
If CaratPos < 0 Then CaratPos = 0
EndIf
ElseIf KeyDown(203) ;Left Cursor
If MilliSecs()-LastInput > KeyRepeat Then
If KeyDown(157) ; CTRL ; Allow CTRL+Left to jump the carat pos to the next delimiter to the left of the cursor
For i = CaratPos To 1 Step -1
d = 1
While (d < Len(Delimiters$)+1) And (Not FoundDelim )
If Mid(retString$, i,1) = Mid(Delimiters$, d,1) Then
CaratPos = i-1
FoundDelim = True
EndIf
d = d + 1
Wend
If FoundDelim Then Exit
Next
If Not FoundDelim Then CaratPos = CaratPos - 1
If CaratPos < 0 Then CaratPos = 0
FoundDelim = False
Else
CaratPos = CaratPos - 1
If CaratPos < 0 Then CaratPos = 0
EndIf
LastInput = MilliSecs()
EndIf
ElseIf KeyDown(205) ; RIGHT CURSOR
If MilliSecs()-LastInput > KeyRepeat Then
If KeyDown(157) ;CTRL ; Allow CTRL+RIGHT to jump the carat pos to the next delimiter to the right of the cursor
For i = CaratPos+1 To Len(retString$)
d = 1
While (d < Len(Delimiters$)+1) And (Not FoundDelim )
If Mid(retString$, i,1) = Mid(Delimiters$, d,1) Then
CaratPos = i
FoundDelim = True
EndIf
d = d + 1
Wend
If FoundDelim Then Exit
Next
If Not FoundDelim Then CaratPos = CaratPos + 1
If CaratPos > Len(retString$) Then CaratPos = Len(retString$)
FoundDelim = False
Else
CaratPos = CaratPos + 1
If CaratPos > Len(retString$) Then CaratPos = Len(retString$)
EndIf
LastInput = MilliSecs()
EndIf
ElseIf KeyDown(207) ; end
CaratPos = Len(retString$)
ElseIf KeyDown(199) ; home
CaratPos = 0
ElseIf (get > 31) ;is a letter, number or symbol
LeftSide$ = Left$(retString$,CaratPos)
RightSide$ = Right$(retString$, Len(RetString)-CaratPos)
retString$ = LeftSide$ + Chr(get) + RightSide$
CaratPos = CaratPos + 1
EndIf
;Draw the edit window
oldbuffer = GraphicsBuffer()
SetBuffer ImageBuffer(EditWin)
myRGB = GetRGB(BorderCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
Rect 0,0,width,height
myRGB = GetRGB(BGCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
Rect 2, 17, InnerWidth , InnerHeight
myRGB = GetRGB(TextCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
Text width/2,8,msg,True,True
Viewport 2, 17, InnerWidth ,InnerHeight
;Draw Edit Content
Local WCount% = 0
Local LineCount% = 0
Local CharCount% = 0
Local tempString$ = ""
;Local tempString2$ = ""
Local StringLength% = Len(retString$)
Local CurrentChar$ = ""
Local LineLength% = 0
While CharCount < StringLength
Repeat
CharCount = CharCount + 1
Currentchar$ = Mid$(retString$, CharCount,1)
If Charcount = CaratPos+1 Then tempString$ = tempString$ + CaratSymbol$
tempString$ = tempString$ + CurrentChar$
charWidth = CharWidths(Asc(CurrentChar))
WCount = WCount + charWidth
Until (WCount > InnerWidth - 8) Or (CharCount = StringLength) Or (Asc(CurrentChar) = 13)
If Right$(tempString,1) = Chr(13) Then
tempString$ = Left(TempString$,Len(TempString$)-1)
EndIf
myRGB = GetRGB(TextCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
If (CaratPos = StringLength) And (CaratPos = CharCount) Then tempString = tempString + CaratSymbol
Text InnerX,InnerY + (LineCount * fntHeight),tempString$,False,False
LineCount = LineCount + 1
tempString$ = ""
WCount = 0
Wend
SetBuffer OldBuffer
DrawBlock BGImage,0,0
DrawBlock EditWin,x,y
Viewport 0,0,GraphicsWidth(), GraphicsHeight()
If Not rtnSubmit Then
If Button(x+(Width/2)-95,y+Height-20,80,"OK",False,False,KEY_INSERT,False,BorderCol,BGCol,TextCol) Then leave = True
If Button(x+(Width/2)+5,y+Height-20,100,"Cancel",False,False,KEY_ESCAPE,False,BorderCol,BGCol,TextCol) Then
retString = ""
leave = True
EndIf
EndIf
DrawImage cursor,MouseX()-1,MouseY()-1
Flip
Until leave = True
FlushKeys()
FlushMouse()
FreeImage EditWin
FreeImage BGImage
Return retString$
End Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; FUNCTION GetRGB ;
; converts an int to R/G/B colour ;
; returns a type of TRGB ;
; example Usage: ;
; myRGB.TRGB = New TRGB ;
; myRGB = GetRGB($FF55FF) ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function GetRGB.TRGB(InColour%)
Local tempRGB.TRGB = New TRGB
tempRGB\ColRed = InColour% Shr 16 And 255 Shl 0
tempRGB\ColGreen = InColour% Shr 8 And 255 Shl 0
tempRGB\ColBlue = InColour% Shr 0 And 255 Shl 0
Return tempRGB
End Function
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; FUNCTION ListBox ;
; returns the index of the selected item ;
; parameters: ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Function ListDlg%(X%, Y%, Width%, Height%, Items.TStringList, BGCol%=$FFFFFF, TextCol%=$000000, BorderCol%=$A0A0A0)
; myRGB = GetRGB(TextCol)
; Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
SetFont Font
;;;;;;
;VARS;
;;;;;;
Local BorderWidth% = 2
Local InnerX% = X + BorderWidth
Local InnerY% = Y + BorderWidth
Local InnerWidth% = Width - (BorderWidth * 2)
Local InnerHeight% = Height - (BorderWidth * 2)
Local ListWin = CreateImage(Width, Height)
Local BGImage = CreateImage(GraphicsWidth(), GraphicsHeight())
Local Selected% = -1
Local ScrollOffset% = 0
Local ScrollBarWidth = 12
Local leave = False
Local Result = -1
Local FirstMouseHit = 0
Local SecondMouseHit = 0
;;;;;;
;MAIN;
;;;;;;
CopyRect 0,0,GraphicsWidth()-1, GraphicsHeight()-1, 0,0, GraphicsBuffer(), ImageBuffer(BGImage)
If SL_GetCount(items) < 1 Then Return -1
While Not Leave
;check keyboard input
If KeyHit(1) Then
Result = -1
Leave = True
EndIf
;28 Or 156 = Return Or Enter
If KeyHit(28) Or KeyHit(156) Then
Result=Selected
Leave = True
EndIf
;up arrow
If KeyHit(200) Then
selected = selected -1
If selected < 0 Then selected = 0
EndIf
;down arrow
If KeyHit(208) Then
selected = selected + 1
If selected > SL_GetCount(Items)-1 Then Selected = SL_Getcount(Items)-1
EndIf
;check mouse input
mx = MouseX()
my = MouseY()
If (mx > InnerX+2) And (mx < InnerX + (InnerWidth-ScrollWidth-4)) Then
If (my > InnerY+2) And (my < (InnerY + (InnerHeight-2)) ) Then
If MouseDown(1) Then
Selected = ( ( (my - InnerY) - ScrollOffset) / FontHeight())
If Selected < 0 Then selected = 0
If selected > SL_GetCount(Items)-1 Then selected = SL_Getcount(Items)-1
EndIf
;maybe do a tooltip here if the item the mouse
;is over is longer than the width of the list
EndIf
EndIf
;draw listbox
If SL_GetCount(items) * FontHeight() > InnerHeight Then
ScrollBarWidth = 16
Else
ScrollBarWidth = 0
EndIf
InnerWidth = ((Width - (BorderWidth * 2)) - ScrollBarWidth ) + 4
oldbuffer = GraphicsBuffer()
SetBuffer ImageBuffer(ListWin)
;draw Border
myRGB = GetRGB(BorderCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
Rect 0, 0, Width, Height, True
;Draw background
myRGB = GetRGB(BGCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
Rect BorderWidth, BorderWidth, InnerWidth - (BorderWidth*2), InnerHeight - (BorderWidth), True
;clip to inner rectangle
Viewport BorderWidth + 2, BorderWidth + 2, InnerWidth-8, InnerHeight-8
;draw the text
For i% = 0 To SL_GetCount(items)-1
If i = selected Then
;draw a rect over the selected area
myRGB = GetRGB(TextCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
;for some reason, changing the following colour to black (0,0,0), draws as transparent
;Color 10,10,10
Rect BorderWidth + 2, (i * FontHeight())+ ScrollOffset, InnerWidth%, FontHeight(), True
myRGB = GetRGB(BGCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
Else
myRGB = GetRGB(TextCol)
Color myRGB\ColRed, myRGB\ColGreen, myRGB\ColBlue
EndIf
Text BorderWidth+2, (i * FontHeight())+ ScrollOffset, SL_Strings(items, i), False, False
Next
Viewport 0,0,Width,Height
SetBuffer oldbuffer
DrawBlock BGImage,0,0
DrawBlock Listwin, x,y
mz = MouseZSpeed()
If Button (X + Width - ScrollBarWidth, y + BorderWidth, 12, "", False, True) Or mz = 1 Then
;scroll up
ScrollOffset = ScrollOffset + FontHeight()
If ScrollOffset > 0 Then ScrollOffset = 0
EndIf
If Button (x + Width - ScrollBarWidth, (y + Height - FontHeight()) - BorderWidth, 12, "¯", False, True) Or mz = -1 Then
;scroll down
ScrollOffset = ScrollOffset - FontHeight()
If ScrollOffset < -( (SL_GetCount(Items)-1) * FontHeight()) Then ScrollOffset = -( (SL_GetCount(Items)-1) * FontHeight())
EndIf
If selected > -1 Then s$ = SL_Strings(items, selected)
If StringWidth(s$)>InnerWidth-4 Then
tooltip(InnerX+2,InnerY + (Selected * FontHeight())+ScrollOffset,s$)
EndIf
DrawToolTip()
DrawImage cursor,MouseX()-1,MouseY()-1
Flip
Wend
FreeImage ListWin
FreeImage BGImage
Return result
End Function
;;;;;;;;;;;;;;;;;;;;
; FUNCTION ToolTip ;
;;;;;;;;;;;;;;;;;;;;
Global tt_txt$,tt_currtxt$,tt_x,tt_y,tt_w,tt_h,tt_starttime%
Const tt_waittime%=500
Function ToolTip(x,y,txt$)
tt_txt$=txt$
tt_w=StringWidth(txt$)+4
tt_h=FontHeight()+4
If x+tt_w+4>GraphicsWidth() Then tt_x=GraphicsWidth()-tt_w Else tt_x=x
If y+tt_h+4>GraphicsHeight() Then tt_y=GraphicsHeight()-tt_h Else tt_y=y
End Function
Function DrawToolTip()
If tt_txt$<>"" Then
If tt_txt$ = tt_currtxt$ Then
; only actually draw it if we've exceed the wait time
If tt_starttime+tt_waittime<MilliSecs() Then
Color 255,255,225
Rect tt_x,tt_y,tt_w,tt_h,True
Color 0,0,0
Rect tt_x,tt_y,tt_w,tt_h,False
Text tt_x+2,tt_y+2,tt_txt$
End If
Else
; if it's a new tooltip, reset the timer
tt_starttime=MilliSecs()
End If
End If
tt_currtxt$=tt_txt$
tt_txt$=""
End Function
;;;;;;;;;;;;;;;;;;;
; Status Messages ;
;;;;;;;;;;;;;;;;;;;
Type statusMsg
Field msg$,life
End Type
Function statusMsg(mr$,lifetime=100)
If lifetime=0 Then Delete Each statusMsg
m.statusMsg=New statusMsg
m\msg=mr
m\life=lifetime
End Function
Function drawStatusBar()
o.statusMsg=First statusMsg
If o <> Null
Color 0,0,0
Rect 3,GraphicsHeight()-14,(Len(o\msg)*7),14,1
EndIf
If o = Null
Color 0,0,0
Rect 3,GraphicsHeight()-14,(12*7),14,1
Color 255,255,255
txt$=txt+"Undo Level: "+countUndos()
Else
; draw the status message here...
Color 255,255,255
txt$=o\msg
o\life=o\life-1
If o\life < 0 Then Delete o
EndIf
Text 3,GraphicsHeight()-14,txt
End Function