I wrote this last year, but had to stop once the b+ demo timed out, though I found it laying about, so...feel free to finish it/upload updates, it's of no use to me anymore.
(If this all seems vaguely familar, i released it last year over at bc)
;Mapla V0.1 - Open Source. ; ;(c)Antony Wells 2003 ;----------------------- ;--- [ Includes ] --- Include "mapLaEngine.bb" ;--- [ Globals/Consts/defaults ] --- Const verInfo$ = "Maptrix Alpha 1 (c)Antony Wells 2003" AppTitle verInfo ;- Default Main Window props Global initialX = 20 Global initialY = 20 Global initialWidth = ClientWidth( Desktop())-40 Global initialHeight = 140 Global hWnd,hWndP,hMenu,hToolTab Global hLastX,hLastY,hLogo Global mapCanvas Global toolTab[50],hToolTabs =4 ;-menu Global hAbout,hHelpMenu ;- Edit Tab globals Global eBrush,eLine ;- Tile Tab globals Global tNew,tLoad ;- Default Map Proprietys ; Initial defaults only. Const defaultMapWidth = 64,defaultMapHeight = 64 Const defaultMapDepth = 4 Const defaultMapName$ ="Untitled" Const defaultTileWidth = 64,defaultTileHeight =64 ;- Sytstem globals/consts Global prefs.prefs ;- Menu globals/consts Const hLoadMap =1,hSaveMap =2,hNewMap=3,hPrefs =4,hQuit =5 ;- Gadget ID globals - Global gNewMap,gLoadMap,gSaveMap,gNewTileView ;--- [ Custom Types ] ---- Type mapShell Field hWnd,flags Field hCanvas,lW,lH ;I'm not using events for this part..Why? no need. Field width,height,depth Field viewXTile,viewYTile,viewZTile Field viewXOffset,viewYOffset Field tileWidth,tileHeight End Type Type prefs ;Map Window Prefs Field freeWindows ; Are windows restricted to parent win? Field stickyWindows ;Are windows sticky(Move with parent) End Type Type tileWin ;Container for Tile Windows. Field hWnd,hCanvas Field hTree,hNode,tileSet.tileSet Field xO#,yO#,tX#,tY# Field hTNode[1000],count Field hTTs.tileSet[1000] End Type ;--- [Main Loop] initApp() Repeat event = WaitEvent() Select event Case $103 Select EventData() Case 27 safeQuit End Select Case $401 ;Gadget 'manipulated..(cooor.*Wolf whistles*) updateGadgets() Case $801 , $802 updateWindow() Case $1001 Select EventData() Case hNewMap newMap() Case hLoadMap fileIn$ =RequestFile("Load Map",".mla") Case hSaveMap fileOut$ =RequestFile("Save Map",".mla",True) Case hQuit safeQuit Case hAbout dispAbout() Default Notify "Sorry, not yet implented!" End Select Case $803 Select EventSource() Case hWnd safeQuit() End Select Default ;Since we don't know what happened, update window! updateWindow() End Select Forever End ;---- [ Functions ] Function initApp() hWnd =CreateWindow( verInfo,initalX,initialY,initialWidth,initialHeight,0,13) hLastX = initialX hLastY = initialY prefs = New prefs hLogo =LoadImage("logo.jpg") ;- Default Prefs - This is place-holder, file will obviously be used. prefs\stickyWindows = True ;--Create 'Quick' Gads gNewMap =CreateButton("New",5,20,35,20,hWnd) gLoadMap =CreateButton("Load",40,20,35,20,hWnd) gLoadMap =CreateButton("Save",75,20,35,20,hWnd) gNewTileView =CreateButton("New Tile View",15,45,75,20,hWnd) ;--Create 'Tool' Tabs hTooltab=CreateTabber(128,0,initialWidth-150,initialHeight-70,hWnd) AddGadgetItem hToolTab,"Edit" AddGadgetItem hToolTab,"Tile Sets" AddGadgetItem hToolTab,"Groups" AddGadgetItem hToolTab,"Special Fx" toolTab[1] = CreatePanel( 4,4,initialWidth-72,initialHeight-58,hToolTab,%1) toolTab[2] = CreatePanel( 4,4,initialWidth-72,initialHeight-58,hToolTab,%1) toolTab[3] = CreatePanel( 4,4,initialWidth-72,initialHeight-58,hToolTab,%1) toolTab[4] = CreatePanel( 4,4,initialWidth-72,initialHeight-58,hToolTab,%1) eBrush =CreateButton("Brush",5,5,30,20,toolTab[1]) eLine =CreateButton("Line",40,5,30,20,toolTab[1]) tNew =CreateButton("New",5,5,30,20,toolTab[2]) tLoad =CreateButton("Load",40,5,35,20,toolTab[2]) showTab(1) ;--Create menus hMenu=WindowMenu(hWnd) hFileMenu =CreateMenu("File",hMenu,hMenu) CreateMenu "New Map",hNewMap,hFileMenu CreateMenu "Load Map",hLoadMap,hFileMenu CreateMenu "Save Map",hSaveMap,hFileMenu CreateMenu "",0,hFileMenu CreateMenu "Preferences",hPrefs,hFileMenu CreateMenu "Quit (SAVE FIRST!)",hQuit,hFileMenu hHelpMenu =CreateMenu("Help",hMenu,hMenu) CreateMenu "About",hAbout,hHelpMenu UpdateWindowMenu hWnd ;-Final initilization code createTileSet() End Function Function updateWindow() Local map.mapShell,hWndX,hWndY Local gadX,gadY,move hWndX = GadgetX( hWnd) hWndY = GadgetY( hWnd) hWndW = GadgetWidth( hWnd) hWndH = GadgetHeight( hWnd) hMoveX = hWndX - hLastX hMoveY = hWndY - hLastY hLastX = hWndX hLastY = hWndY For map = Each mapShell move =False gadX = GadgetX( map\hWnd) gadY = GadgetY( map\hWnd) gadW = GadgetWidth( map\hWnd) gadH = GadgetHeight( map\hWnd) If prefs\freeWindows =False And prefs\stickyWindows = 955 If gadX<(hWndX+30) gadX =hWndX+30:move=True If gadY<(hWndY+30) gadY =hWndY+30:move=True If (gadX+gadW)>(hWndX+hWndW) gadX =( hWndX+hWndW-gadW):move=True If (gadY+gadH)>(hWndY+hWndH) gadY =( hWndY+hWndH-gadH):move=True If gadW>hWndW-20 gadW=hWndW-20:resize=True If gadH>hWndH-20 gadH=hWndH-20:resize=True If move Or resize SetGadgetShape map\hWnd,gadX,gadY,gadW,gadH EndIf EndIf If prefs\stickyWindows SetGadgetShape map\hWnd,gadX+hMoveX,gadY+hMoveY,gadW,gadH EndIf If gadW<>map\lW Or gadH<>map\lH SetGadgetShape map\hCanvas,0,0,gadW,gadH EndIf Next End Function ;---- [ Map Related functions ] ;Map engine is seperate... Function newMap() ;Brings up the new Map window... Local nWin,cW,cH Local nWidth,nHeight,nDepth Local nCreate,nCancel cW=ClientWidth(Desktop()) cH=ClientHeight(Desktop()) hWin =CreateWindow("New Map",(cW/2)-100,(cH/2)-50,225,130,0,17) nCreate =CreateButton("Create",87,75,60,20,hWin) nCancel =CreateButton("Cancel",153,75,60,20,hWin) hPan =CreatePanel(5,22,205,45,hWin,%1) nWidth =CreateTextField(5,5,50,20,hPan) nHeight =CreateTextField(70,5,50,20,hPan) nDepth =CreateTextField(145,5,50,20,hPan) SetGadgetText nWidth,defaultMapWidth SetGadgetText nHeight,defaultMapHeight SetGadgetText nDepth,defaultMapDepth CreateLabel("Width",5,5,40,15,hWin) CreateLabel("Height",70,5,40,15,hWin) CreateLabel("Depth",145,5,40,15,hWin) Repeat Select WaitEvent() Case $401 Select EventSource() Case nCreate createMapShell( "",TextFieldText(nWidth),TextFieldText(nHeight),TextFieldText(nDepth)) FreeGadget hWin Return Case nCancel FreeGadget hWin Return Case hToolTab updateGadgets() End Select End Select Forever End Function Function createMapShell.mapShell(mapName$, width = defaultMapWidth,height = defaultMapHeight,depth = defaultMapDepth,flags=0,newWindow = True) Local out.mapShell out = New mapShell If newWindow out\hWnd = CreateWindow( MapName$+" ("+width+","+height+","+depth+")",hLastX+20,hLastY+20,320,200,hWndP,27) out\hCanvas = CreateCanvas(0,0,320,200,out\hWnd) out\lW =320 out\lh =200 End If Return out End Function ;--- [ GUI related functions ] Function updateGadgets() Local file$,ext Select EventSource() Case hToolTab showTab( SelectedGadgetItem(hToolTab)+1) Case gNewMap newMap() Case tLoad file =RequestFile( "Load tile set","mts,bmp,jpg") Select fileExt( file) Case "bmp","jpg","png" tX =GadgetWidth(Desktop())/2-100 tY =GadgetHeight(Desktop())/2-100 tWnd =CreateWindow("Tile Dimensions",tX,tY,200,140,0,1) tPan =CreatePanel(18,5,160,50,tWnd,%1) tWidth =CreateTextField( 5,5,60,20,tPan) tHeight =CreateTextField( 85,5,60,20,tPan) CreateLabel ("Width",26,26,30,20,tPan) CreateLabel ("Height",96,26,30,20,tPan) tOK =CreateButton("OK",5,80,40,30,tWnd) tCancel =CreateButton("Cancel",150,80,40,30,tWnd) Repeat Select WaitEvent() Case $401 Select EventSource() Case tOK loadTileset(file,TextFieldText(tWidth),TextFieldText(tHeight)) FreeGadget tWnd Return Case tCancel FreeGadget tWnd Return End Select End Select Forever Case "mts" End Select Case gNewTileView newTileWindow() Default eV=EventSource() For tWin.tileWin =Each tileWin If eV = tWin\hTree gI = SelectedTreeViewNode( eV) If tWin\count>0 For j=0 To tWin\count-1 If gI = tWin\htNode[j] setTileWinCurrent( tWin,j) Return EndIf Next EndIf EndIf Next End Select End Function Function setTileWinCurrent( in.tileWin,index) in\tileSet = in\hTTs[index] If in\tileSet =Null Notify "setTileWinCurrent was passed an illegal index <"+index+">",True SetStatusText( in\hWnd,"TileSet:"+in\tileSet\title+" Tiles:"+in\tileSet\count) redrawTileWindows() End Function Function showTab(tab) ShowGadget toolTab[tab] For j=1 To hToolTabs If Not j=tab HideGadget toolTab[j] Next End Function Function newTileWindow() Local tWin.tileWin tWin =New tileWin tWin\hWnd =CreateWindow("Tile Selection",GadgetX( hWnd),GadgetY( hWnd)+GadgetHeight( hWnd)+20,GadgetWidth( hWnd)/1.2,300,hWnd,29) tWin\hTree =CreateTreeView( 0,0,GadgetWidth( hWnd)/5,220,tWin\hWnd) tWin\hNode =AddTreeViewNode("Tile Sets",TreeViewRoot(tWin\hTree)) tWin\hCanvas =CreateCanvas(GadgetWidth( hWnd)/5+10,0,GadgetWidth( tWin\hWnd)/1.4,220,tWin\hWnd) updateTileWindows() End Function Function updateTileWindows() ;Make sure the Trees are up to date, rebuilding if required. Local tS.tileset,tW.tileWin If isChanged() For tW =Each TileWin If tW\count>0 For j=0 To tW\count-1 FreeTreeViewNode tW\hTNode[j] Next tW\count =0 EndIf Next For ts =Each tileSet For tW =Each tileWin tW\hTNode[tW\count]=AddTreeViewNode( ts\title+" ("+ts\count+")",tW\hNode) tw\hTTs[tW\count] =ts tW\count =tW\count+1 Next Next EndIf redrawTileWindows() End Function Function redrawTileWindows( ) Local tWin.tileWin Local tSet.tileSet Local tile.tile,dX#,dY# For tWin =Each tileWin SetBuffer CanvasBuffer(tWin\hCanvas) Color 0,0,0 Cls If Not tWin\tileSet = Null tSet =tWin\tileSet If tSet\count>0 dX=2 dY=2 Color 128,128,128 For j=0 To tSet\count-1 tile =getSetTile( tSet,j) Rect dX-2,dY-2,tileWidth( tile)+2,tileHeight( tile)+2,0 DrawImage tileImg( tile),dX,dY dX=dX+tileWidth( tile)+2 If dX>GadgetWidth( tWin\hCanvas) dX=0 dY=dY+tileHeight( tile)+2 If dY>GadgetHeight( tWin\hCanvas) Exit EndIf Next Else Color 128,128,128 Text GadgetWidth( tWin\hCanvas)/2,GadgetHeight( tWin\hCanvas)/2,"Tile set is empty",True,True EndIf Else Color 128,128,128 Text GadgetWidth( tWin\hCanvas)/2,GadgetHeight( tWin\hCanvas)/2,"Not viewing a Tile set",True,True EndIf FlipCanvas tWin\hCanvas Next End Function ;--- [ System related functions ] Function safeQuit(askSave =True) If askSave Select Proceed( "Save changes first?") Case True Case 0 End End Select EndIf End Function Function dispAbout() x=GadgetWidth( Desktop()) /2-200 y=GadgetHeight( Desktop())/2-200 tWnd =CreateWindow( verInfo,x,y,400,300) tCan =CreateCanvas( 0,0,400,400,tWnd) SetBuffer CanvasBuffer( tCan) DrawImage hLogo,0,0 FlipCanvas tCan,1 CreateLabel(verInfo,50,200,200,200,tWnd) tOK =CreateButton( "Right...",50,250,60,20,tWnd) snd =PlayMusic("about.wav") tW = 400 Local l#[100] Local s#[100] For j=0 To 99 s[j] = Rnd(0.01,0.1) Next Repeat:Cls For j=0 To 99 dY = l[j]*15 l[j] =l[j]+s[j] If l[j]>25 l[j]=25 ;If l(j)>25 l[j]=25 cv =l[j]*16 If cv>255 cv=255 If cv<0 cv=0 Color 0,cv,0 ;Rect j*15-15,dy,6,6 For dy =dy To 120 Step -15 If dy<300 And dy>50 cv = dy*0.8 If cv>255 cv=255 If cv<0 cv=0 Color 0,cv,0 Text j*15-15,dy,Chr$(Rnd(255)) EndIf Next Next DrawImage hLogo,50,20 Color 0,255,0 Line 1,126,320,126 Line 1,146,250,146 Line 1,166,190,166 Color 255,255,255 Text 1,120,verInfo Text 1,140,"What is the Maptrix?" Text 1,160,"The future." Color 128,128,128 Rect 5,200,150,30 Color 180,180,180 Text 10,220,"Disconnect" FlipCanvas tCan Until KeyDown(1) End End Function
;MapLa - Map Engine ; ;(c)Free. ; ; ;Wrote By Antony Wells. ;--- ;-- [ Consts and Globals ] Const mMax_Width =1000,mMax_Height =1000,mMax_Depth=5 Const mMax_TilePerSet =1000 ;- Type row Field y.block[mMax_Height] End Type Type block Field z.lay[mMax_Depth] End Type Type lay Field tile.tile End Type Type tile Field img.act Field width,height End Type Type act ;Act = simple frame-based anim system Field img,frames ;0frames = single non-animated image. Field frame,mode End Type Type tileSet Field tile.tile[mMax_TilePerSet] Field count,title$ End Type Const aRepeat =1,aPingPong =2,aReverse =3,aOnce =4 Type info Field tileSets,tiles Field changed End Type Type map Field x.row[mMax_Width] Field width,height,depth End Type Type cam ;These are used to generate views. They are very flexible. Field map.map Field x,y,z ;z=0 full-view Field xO#,yO# End Type Global info.info =New info ;--- [ Sys functions ] -Mostly to aid map engine. I will write a 'game' edition of this lib soon... Function resetChanged() info\changed =False End Function Function isChanged() Return info\changed End Function ;--- [ Map Functions ] Internal funcs are wrote for speed. They rarely use 'each-other' unless needed. Function createMap.map( width,height,depth,populate=True) Local out.map Local x,y,z out =New map out\width =width out\height =height out\depth =depth If populate For x=0 To width-1 out\x[x] =New row For y=0 To height-1 out\x[x]\y[y] =New block For z=0 To depth-1 out\x[x]\y[y]\z[z] =New lay Next Next Next EndIf Return out End Function Function setTile( in.map,x,y,z,tile.tile,createLay=True) ;CreateLay only creates a lay if needed. If createLay If in\x[x]\y[y]\z[z] = Null in\x[x]\y[y]\z[z] =New lay EndIf in\x[x]\y[y]\z[z]\tile = tile End Function ;--- [ Tile functions ] Function loadTile.tile( file$,width=0,height=0,frames=0) Local out.tile out =New tile info\tiles =info\tiles+1 info\changed =True out\img = createAct( file,width,height,frames) If Not frames out\width =ImageWidth(out\img\img) out\height =ImageHeight(out\img\img) Else out\width =width out\height =height EndIf End Function Function loadTileSet.tileSet( file$,width=0,height=0) ; either mapLa tilesets or from a bitmap. Local out.tileSet Local img,x,y,tmp If width=0 Or height =0 Notify "Illegal dimensions":Return If fileExt( file)=".mts" out =New tileSet Else If width =0 Or height=0 Return out =New tileSet img =LoadImage( file) If Not img Delete out:Return Repeat tmp =CreateImage(width,height) CopyRect x,y,width,height,0,0,ImageBuffer(img),ImageBuffer(tmp) x=x+width If x>ImageWidth(img)-width x=0:y=y+height out\tile[out\count] =New tile out\tile[out\count]\img =New act out\tile[out\count]\img\img =tmp out\tile[out\count]\width =width out\tile[out\count]\height =height out\count =out\count+1 info\tiles=info\tiles+1 Until y>ImageHeight(img) EndIf out\title = file info\tileSets =info\tileSets+1 info\changed =True Return out End Function Function tileSetCount( in.tileSet) Return in\count End Function Function getSetTile.tile(in.tileSet,index) Return in\tile[index] End Function Function tileWidth( in.tile,frame=0) Return in\width End Function Function tileHeight( in.tile,frame=0) Return in\height End Function Function tileBuffer( in.tile,frame=0) If frame =0 Return ImageBuffer( in\img\img) Else EndIf End Function Function tileImg( in.tile,frame=0) If frame =0 Return in\img\img Else EndIf End Function Function createTileSet.tileSet( title$=" default") Local out.tileSet out =New tileSet out\title =title info\tileSets =info\tileSets+1 info\changed =True Return out End Function ;--- [ Act functions ] Function createAct.act( file$,width=0,height=0,frames=0) Local out.act If Not file$="" If frames>0 out\img =LoadAnimImage(file,width,height,0,frames) Else out\img =LoadImage(file) EndIf EndIf Return out End Function Function setActMode( in.act,mode =aRepeat) in\mode =mode End Function ;--- [ Camera functions ] Function createCam.cam( x,y,z=0) Local out.cam out =New cam out\x =x out\y =y out\z =z Return out End Function ;-- [ Render functions ] Function renderCam( in.cam) End Function ;-- [ Helper functions ] Function fileExt$( file$) del =Instr( file,".") If del Return Lower(Mid( file,del+1)) End Function
(If this all seems vaguely familar, i released it last year over at bc)