And now for tonights update. I'm happy now that the editor is tidy enough, both in code and GUI. Note that I've substantially changed collisions / hitpoint set up, hopefully to be a lot easier when building levels for real. More tooltips added too, and now they only appear if you hover for >1/2 second.
So if anyone else does want to do some work on the editor (tile pixel editing tool anyone?), please feel free. I do intend to work on levels settings and objectives next, but that will be fairly self contained now!
editor.bb
and gui.bb
So if anyone else does want to do some work on the editor (tile pixel editing tool anyone?), please feel free. I do intend to work on levels settings and objectives next, but that will be fairly self contained now!
editor.bb
; blitz3d version ; 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\sounds.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" ; set up graphics Graphics 800,600,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()<640 And MouseY()<480) Then MouseOverMap=True ElseIf (MouseY()>490 And MouseY()<586) And (MouseX()>32 And MouseX()<768) 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(650,240,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() DrawImage cursor,MouseX()-1,MouseY()-1 Flip Forever End Function Function handleGUICommon() ;*************************** 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(650,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(760,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(650,140,140,"Room Tool",current_tool=2,False,KEY_NONE,"Create and draw rooms") Then current_tool=2 If Button(650,160,140,"Tile Editor",current_tool=3,False,KEY_NONE,"Edit tiles") Then current_tool=3 If Button(650,180,140,"Objectives",current_tool=6,False,KEY_NONE,"Define level objectives") Then current_tool=6 If Button(650,200,140,"Level Settings",current_tool=7,False,KEY_NONE,"Define level settings") Then current_tool=7 If Button(650,220,68,"File Menu",current_tool=4,False,KEY_NONE,"Load, save or create a new level") Then current_tool=4 If Button(723,220,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(650,ry,68,"Undo",False,False,KEY_NONE,"Undo all changes up to last reset") doUndo():Delay 200 ElseIf Button(723,ry,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_inEditor(sc_x,sc_y,n) Next If visible(0)=1 Then drawcollision(sc_x,sc_y) ; 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,510,28,xpos) Button(2,530,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()>635 Then key_right=True If MouseY()<5 Then key_up=True If MouseY()>475 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<numObjects 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 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) mz = MouseZSpeed() ;select the tileset to show in the palette Select layer Case LayerBase, LayerBlock tileset=btiles : maxtile=bmaxtile Case LayerObject tileset=objects : maxtile=maxobject Case LayerDetail,LayerTop tileset=dtiles : maxtile=dmaxtile Case LayerCollision,LayerHits If Button(40,510,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(150,510,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(260,510,100,"Vis-Blocker",coll_tool=3,False,KEY_V,"Set tiles to be barriers to vis checking") Then coll_tool=3 If Button(370,510,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(770,510,28,activetile,False,False,KEY_NONE,"The ID of the currently selected tile") ;draw the palette itself For n=0 To 68 tileno = n + tileoffset If tileno<maxtile Then DrawBlock tileset,((n-(Floor(n/23)*23))*32)+32,490+(Floor(n/23)*32),n+tileoffset If tileno = activetile Then Color 0,255,0:Rect ((n-(Floor(n/23)*23))*32)+32,490+(Floor(n/23)*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,490,32,"",False,True,KEY_PAGE_UP,"Scroll up the tileset",False)=True Or (mz = 1 And MouseOverTileset)) And tileoffset > 0 And scrolldelay<0 Then tup=-1 If (Button (768,490,32,"¯",False,True,KEY_PAGE_DOWN,"Scroll down the tileset",False)=True Or (mz = -1 And MouseOverTileset)) 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*23):scrolldelay=15 ; handle mouse being over the palette If mouseover Then If MouseDown(1) Then checktile = (Floor((MouseX()-32)/32))+(Floor((MouseY()-490)/32)*23)+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()-490)/32)*23)+tileoffset If (checktile < maxtile) And (checktile >-1) Then activetile2 = checktile If (activetile2+1) =< numObjects 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 = (Floor((MouseX()-32)/32))+(Floor((MouseY()-490)/32)*23)+tileoffset If (checktile < maxtile) And (checktile >-1) Then activetile2 = checktile If (activetile2+1) =< numObjects If objectdef(activetile2+1)<>Null w=400 count=CountString(objectdef(activetile2+1)\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(activetile2+1)\name Text 20,40,"Image: "+objectdef(activetile2+1)\image Text 20,60,"Trigger: "+objectdef(activetile2+1)\trigger For n=1 To CountString(objectdef(activetile2+1)\trigger,"|") Text 20,80+(n*20),objectdef(activetile2+1)\script[n] Next Text 12,10+h,"MB2 to edit" EndIf 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,255,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() ; FILE TOOLS ry=240 If Button(650,ry,140,"New",False,False,KEY_F8,"Create a new map") Then createRandomMap() If Button(650,ry+20,140,"Save",False,False,KEY_F1,"Save the current map") Then FileName$ = InputBox("Enter filename to save (without .map extension)",200,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(650,ry+40,140,"Load",False,False,KEY_F4,"Load an existing map") Then FileName$ = InputBox("Enter filename to load (without .map extension)",200,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(650,ry+60,140,"Load Last",False,False,KEY_F5,"Load the last edited map") Then LoadLast():moveToStartPosition() 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
and 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 Color 255,255,255 If o = Null txt$=txt+"Undo Level: "+countUndos() Else ; draw the status message here... txt$=o\msg o\life=o\life-1 If o\life < 0 Then Delete o EndIf Text 3,GraphicsHeight()-14,txt End Function