NewsForumsCodeLogsGallerySpecsSearch

Code archives/Miscellaneous/2d Map Builder

This code has been declared by its author to be Public Domain code.

Download source code

2d Map Builder by Matthew Smith2011
This tool takes an image and based on settings (ie. tile size) chops it up to build a 2d map file and tile image file for scrolling/arcade games from it.

It's a good tool to grab images if you are doing a remake!

Notes:
The tool takes a .png image and creates a .bmp (Blitz can't natively write .pngs) tile map, a basic data file and a Monkey code file. All files will be dumped to a subfolder called Map.

v2.0 changes
Updated to properly pad tiles when scaling. You can now create a 'Config.ini' file to adjust some of the features. Include any of the following depending on your requirements:
ScaleTiles=True|False
TileWidth=32
TileHeight=32
TilePadding=0|1
MapPadding=True|False

Tile padding will create the required border (1 = 1 pixel) around each tile.
Map padding will create an 'empty' one cell border around the map

This tool is really for my own use, but a good place to store it for later, plus someone may get some use from it! 
;------------------------------------------------------------------------------------------------------------------------------------------
; MapBuilder
; v2.0 
; Matthew Smith 2001, 2011, 2013
;------------------------------------------------------------------------------------------------------------------------------------------

AppTitle "Map Builder v2.0 - Matthew Smith"
Graphics 640, 480, 16, 2

Global MapName$
MapName$=Input$("Enter filename of level gfx: ")
If (MapName = "") Then End

Dim TileMap(1, 1)					;Map Information
Global MapSizeX
Global MapSizeY

;Adjust these items depending on game
Global ScaleTiles = True
Global TileWidth = 32				;Tile Sizes
Global TileHeight = 32
Global TilePadding = 1				;Padding added to tile
Global MapPadding = False			;Padding added to map (1 cell border)

Global gfxMap
Global gfxTileStore
Global gfxTileCompareStore

Dim ColorTiles(1, 1)
Const CompareAtOnce = 250
Global TilesMax = 0					;Number of Tiles Created 

;Read Ini File
ReadIniFile()

;Build
SetGfxMapInfo()
CreateBlankTile()
BuildMap()

;Finalise
FreeImage gfxTileStore
FreeImage gfxTileCompareStore
FreeImage gfxMap
EndGraphics
End
				
Function SetGfxMapInfo()
	;Load image
	gfxMap = LoadImage(MapName + ".png")
		
	;Get size of map (tiles)
	MapSizeX = Int(ImageWidth(gfxMap) / TileWidth)
	MapSizeY = Int(ImageHeight(gfxMap) / TileHeight)
	
	;Set map size
	ClearMap(MapSizeX, MapSizeY)	
	
	;Set tile image store
	FreeImage gfxTileStore
	gfxTileStore = CreateImage(TileWidth, TileHeight, 512)
		
	;Set comparison tile image store
	FreeImage gfxTileCompareStore
	gfxTileCompareStore = CreateImage(TileWidth * (CompareAtOnce + 1), TileHeight)
	
	;Set counter	
	TilesMax = 0

End Function

Function ClearMap(sizeX, sizeY)
	Local x, y
	
	;Resize
	Dim TileMap(sizeX, sizeY)
	
	;Process
	For x = 0 To sizeX
		For y = 0 To sizeY
			TileMap(x, y) = -1
		Next
	Next
	
End Function

Function CreateBlankTile()
	;Prepare
	SetBuffer(BackBuffer())
	ClsColor(0, 0, 0)
	Cls
		
	;Copy blank tile and set value in map
	DrawBlockRect(gfxMap, 0, 0, TileWidth, TileHeight, TileWidth, TileHeight)
	TileMap(0, 0) = 0
	
	;Inc counter
	TilesMax = TilesMax + 1

End Function

Function CreateTile(BX, BY)
	;Prepare 
	SetBuffer(ImageBuffer(gfxTileStore, TilesMax))
	
	;Copy tile and set value in map
	DrawBlockRect(gfxMap,  0, 0, (BX * TileWidth), (BY * TileHeight), TileWidth, TileHeight)
	TileMap(BX, BY) = TilesMax
	
	;Inc counter
	TilesMax = TilesMax + 1
		
	;Finalise
	SetBuffer(BackBuffer())
	
End Function

Function PrepareMapComparison(BX, BY, TC)
	Local counter
	Local compare
	Local index
	
	;Set buffer
	SetBuffer(ImageBuffer(gfxTileCompareStore))
	
	;Clear comparison image
	Color 0, 0, 0
	Cls

	;Get map tile
	DrawBlockRect(gfxMap, 0, 0, (BX * TileWidth), (BY * TileHeight), TileWidth, TileHeight)
		
	;Get total tiles to compare
	compare = TC + CompareAtOnce
	If (TC + CompareAtOnce > TilesMax) Then compare = TilesMax
	
	;Get stored tile(s) to compare
	counter = 1
	For index = TC To compare - 1
		DrawBlock(gfxTileStore, TileWidth * counter, 0, index)
		counter = counter + 1
		
	Next
	
	;Copy into Backbuffer
	SetBuffer(BackBuffer())
	Cls
		
	;Draw	
	DrawBlock(gfxTileCompareStore, 0, 16)
	
End Function

Function DisplayMap()
	Local x, y
	
	;Process
	For y = 0 To MapSizeY - 1
		For x = 0 To MapSizeX - 1
			If (TileMap(x, y) <> -1) Then
				DrawBlock(gfxTileStore, x * TileWidth, 100 + (y * TileHeight), TileMap(x, y))
				
			End If
			
		Next
		
	Next
	
	;Draw
	DrawBlock gfxMap, 260, 100
	
End Function

Function BuildMap()
	Local BX, BY, TC, TB, TileCount
	Local counter# = 0
	Local matchIndex = -1
	Local totalTiles# = (MapSizeX * MapSizeY)
	
	; Work Thru Loaded Map
	For BY = 0 To MapSizeY - 1
		For BX = 0 To MapSizeX - 1
			;Trap ESC key
			If KeyDown(1) Then Return
			
			;Prepare
			TC = 0
			
			;Process
			For TC = 0 To TilesMax - 1 Step CompareAtOnce
				;Prepare comparision
				PrepareMapComparison(BX, BY, TC)
				
				;Update display summary
				Color 255, 255, 255
				Text 0, 0, "X" + Right$("000" + (BX + 1), 3) + " Y" + Right$("000" + (BY + 1), 3) + " (" + MapSizeX + "x" + MapSizeY + ") "  + Right$("   " + Int((counter / totalTiles) * 100), 3) + "%"
				Text 320, 0, "Found:" + Right$("0000" + TilesMax, 4)
				;Text 296, 0, "TF" + Right$("00000" + TilesMax, 5) + "/" + Right$("00000" + Int(counter), 5)
				Flip
				
				;Validate if exists				
				matchIndex = CompareTiles(TC)
				If (matchIndex <> -1) Then
					;Store result
					TileMap(BX, BY) = matchIndex
					Exit
								
				End If

			Next
			
			;No match found?, if so create new tile
			If (matchIndex = -1) Then CreateTile(BX, BY)
			
			;Increment counter
			counter = counter + 1
			
		Next
	Next
	
	;Save Map and Tiles
	SaveTiles()
	SaveTileMapData()
	SaveTileMapMonkey()
	
	;Set finalised message
	Color 255, 255, 255
	Text(0, 120, "Process complete! Press any key to exit...")
	Flip
	
	;Wait
	WaitKey
	
End Function

;Returns the index of the matching tile if found
Function CompareTiles(TC)
	Local x, y, index
	Local compare
	Local counter
	Local ct
	Dim ColorTiles(3, CompareAtOnce)
	
	;Prepare
	SetBuffer(ImageBuffer(gfxTileCompareStore))
	
	;Set number of tiles to compare
	compare = TC + CompareAtOnce
	If (TC + CompareAtOnce > TilesMax) Then compare = TilesMax
	
	;Search for existing tile match
	For y = 0 To TileHeight - 1
		For x = 0 To TileWidth - 1
			;Get image
			GetColor x, y
			ColorTiles(1, 0) = ColorRed() 
			ColorTiles(2, 0) = ColorGreen()
			ColorTiles(3, 0) = ColorBlue()
			
			;Process
			counter = 1
			For ct = TC To compare - 1
				If (ColorTiles(0, counter) <> -1) Then
					;Get tile store image
					GetColor x + (TileWidth * counter), y
					ColorTiles(1, counter) = ColorRed()
					ColorTiles(2, counter) = ColorGreen()
					ColorTiles(3, counter) = ColorBlue()
					
					;Validate
					If (ColorTiles(1, 0) <> ColorTiles(1, counter) Or ColorTiles(2, 0) <> ColorTiles(2, counter) Or ColorTiles(3, 0) <> ColorTiles(3, counter)) Then
						ColorTiles(0, counter) = -1
						
					End If
					
				End If
				
				;Increment
				counter = counter + 1
							
			Next
		Next
	Next
	
	;Validate
	counter = 1
	For index = TC To compare - 1
		;Match?, if so return tile index
		If (ColorTiles(0, counter) <> -1) Then Return index
		
		;Increment
		counter = counter + 1 
		
	Next
	
	;Not found
	Return -1
			
End Function

Function SaveTiles()
	Local BT
	Local TX, TY
	Local BX, BY 
	Local TC
	Local gfxTileFinalStore
	
	Local finalImageWidth = 320
	Local finalTileWidth = TileWidth
	Local finalTileHeight = TileHeight
	
	;Scale
	If (ScaleTiles) Then
		;finalImageWidth = finalImageWidth * 2
		finalTileWidth = finalTileWidth * 2
		finalTileHeight = finalTileHeight * 2
		
	End If
	
	;Create store
	FreeImage gfxTileFinalStore
	TX = finalImageWidth / TileWidth
	TY = Int((TilesMax - 1) / TX) + 1
	gfxTileFinalStore = CreateImage(TX * (finalTileWidth + (TilePadding * 2)), TY * (finalTileHeight + (TilePadding * 2)))
	
	;Set buffer	
	SetBuffer(ImageBuffer(gfxTileFinalStore))
	Color 0, 0, 0
	Cls
	
	;Output tiles to store
	TC = 0
	For BY = 0 To TY - 1
		For BX = 0 To TX - 1
			If TC <= TilesMax - 1
				;Grab image
				SetBuffer(ImageBuffer(gfxTileStore,TC))
				Local gfxTile = CreateImage(TileWidth, TileHeight)
				GrabImage(gfxTile,0,0)
				
				;Scale?
				If (ScaleTiles) Then gfxTile = ScaleImageFast(gfxTile, 2.0, 2.0)
				
				;Store
				SetBuffer(ImageBuffer(gfxTileFinalStore))
				DrawBlock(gfxTile, BX * (finalTileWidth + (TilePadding * 2)) + TilePadding, (BY * (finalTileHeight + (TilePadding * 2)) + TilePadding))
				
			End If
			TC = TC + 1
		Next
	Next
	
	;Save tiles to file
	CreateFolder("map")
	SaveImage(gfxTileFinalStore, "map\" + MapName + ".bmp")
	
	;Finalise
	SetBuffer(BackBuffer())
	FreeImage gfxTileFinalStore
	
End Function

Function SaveTileMapData()
	Local fileName$ = "map\" + MapName + ".tiles.map"
	Local x, y
	
	;Create file
	CreateFolder("map")
	Local file = WriteFile(fileName)

	;Pad map?
	Local msX = MapSizeX
	Local msY = MapSizeY
	If (MapPadding) Then msX = msX + 2
	If (MapPadding) Then msY = msY + 2
	
	;Scale tiles sizes?
	Local tsX = TileWidth
	Local tsY = TileHeight
	If (ScaleTiles) Then tsX = (tsX * 2)
	If (ScaleTiles) Then tsY = (tsY * 2)
		
	;Output map summary
	WriteString(file, MapName + ".png")			;Tile filename
	WriteInt(file, TilesMax)					;Total tiles
	WriteInt(file, msX) 						;Map Size
	WriteInt(file, msY) 
	WriteInt(file, tsX) 						;Tile Size
	WriteInt(file, tsY)

	;Output padding - top row?
	If (MapPadding) Then WritePaddingRowData(file)
	
	;Output map
	For y = 0 To MapSizeY - 1
		;Padding
		If (MapPadding) Then WriteInt(file, 0)
		
		For x = 0 To MapSizeX - 1
			WriteInt(file, TileMap(x, y))
		Next
		
		;Padding
		If (MapPadding) Then WriteInt(file, 0)
	Next

	;Output padding - bottom row?
	If (MapPadding) Then WritePaddingRowData(file)
	
	;Close
	CloseFile(file)
	
End Function

Function SaveTileMapMonkey()
	Local fileName$ = "map\" + MapName + ".tiles.monkey.txt"
	Local x, y
	
	;Create file
	CreateFolder("map")
	Local file = WriteFile(fileName)
		
	;Pad map?
	Local msX = MapSizeX
	Local msY = MapSizeY
	If (MapPadding) Then msX = msX + 2
	If (MapPadding) Then msY = msY + 2
	
	;Scale tiles sizes?
	Local tsX = TileWidth
	Local tsY = TileHeight
	If (ScaleTiles) Then tsX = (tsX * 2)
	If (ScaleTiles) Then tsY = (tsY * 2)
	
	;Output map summary
	WriteLine(file, "'#Region " + Chr(34) + " MapData " + Chr(34))
	WriteLine(file, "	'Map summary")
	WriteLine(file, "	'Map dump file: " + MapName + ".png")
	WriteLine(file, "	Field TilesMax:Int=" + TilesMax)
	WriteLine(file, "	Field MapSizeX:Int=" + msX)
	WriteLine(file, "	Field MapSizeY:Int=" + msY)
	WriteLine(file, "	Field TileWidth:Int=" + tsX)
	WriteLine(file, "	Field TileHeight:Int=" + tsY) 
	WriteLine(file, "")
	WriteLine(file, "	'Map Data")
	WriteLine(file, "	Field TileMap:=[")
	
	;Output padding - top row?
	If (MapPadding) Then WritePaddingRowMonkey(file)
		
	;Output Map
	For y = 0 To MapSizeY - 1
		Local mapRow$ = ""
		
		;Padding?
		If (MapPadding) Then mapRow = "0"
		
		;Build row data
		For x = 0 To MapSizeX - 1
			If (Len(mapRow) > 0) Then mapRow = mapRow + ","
			mapRow = mapRow + Str(TileMap(x, y))
		Next 
		
		;Padding?
		If (MapPadding) Then mapRow = mapRow + ",0"
		
		;Append to end of row?
		Select MapPadding
			Case True
				mapRow = mapRow + ","
			Case False
				If (y < MapSizeY - 1) Then mapRow = mapRow + ","
				If (y = MapSizeY - 1) Then mapRow = mapRow + "]"
		End Select
		
		;Finalise
		mapRow = "	" + mapRow
		
		;Write row
		WriteLine(file, mapRow)
		
	Next	
	
	;Output padding - botton row?
	If (MapPadding > 0) Then WritePaddingRowMonkey(file, True)

	;Finalise
	WriteLine(file, "")
	WriteLine(file, "'#End Region")
	
	;Close	
	CloseFile(file) 

End Function

Function WritePaddingRowData(file)
	Local x
	
	;Get width
	Local width = MapSizeX
	If (MapPadding) Then width = width + 2 
	
	;Write
	For x = 0 To width - 1
		WriteInt(file, 0)
	Next
	
End Function

Function WritePaddingRowMonkey(file, isLast=False)
	Local paddingRow$ = ""
	Local x
	
	;Get width
	Local width = MapSizeX
	If (MapPadding) Then width = width + 2 
	
	;Build row data
	For x = 0 To width - 1
		If (Len(paddingRow) > 0) Then paddingRow = paddingRow + ","
		paddingRow = paddingRow + "0" 
	Next
	
	;Append to end of row?
	If (Not isLast) Then paddingRow = paddingRow + ","
	If (isLast) Then paddingRow = paddingRow + "]"

	;Finalise
	paddingRow = "	" + paddingRow

	;Write row
	WriteLine(file, paddingRow)
	
End Function

Function CreateFolder(path$)
	Local folder$ = SystemProperty("appdir") + path
	CreateDir(folder)
	
End Function


;sswift - Scales the image without blurring
Function ScaleImageFast(SrcImage, ScaleX#, ScaleY#)
	Local SrcWidth,  SrcHeight
	Local DestWidth, DestHeight
	Local ScratchImage, DestImage
	Local SrcBuffer, ScratchBuffer, DestBuffer
	Local X1, Y1, X2, Y2

	;Get the width and height of the source image. 	
	SrcWidth  = ImageWidth(SrcImage)
	SrcHeight = ImageHeight(SrcImage)

	;Calculate the width and height of the dest image.
	DestWidth  = Floor(SrcWidth  * ScaleX#)
	DestHeight = Floor(SrcHeight * ScaleY#)

	;If the image does not need to be scaled, just copy the image and exit the function.
	If (SrcWidth = DestWidth) And (SrcHeight = DestHeight) Then Return CopyImage(SrcImage)

	;Create a scratch image that is as tall as the source image, and as wide as the destination image.
	ScratchImage = CreateImage(DestWidth, SrcHeight)
				
	;Create the destination image.
	DestImage = CreateImage(DestWidth, DestHeight) 

	;Get pointers to the image buffers.
	SrcBuffer     = ImageBuffer(SrcImage)
	ScratchBuffer = ImageBuffer(ScratchImage)
	DestBuffer    = ImageBuffer(DestImage)

	;Duplicate columns from source image to scratch image.
	For X2 = 0 To DestWidth-1
		X1 = Floor(X2 / ScaleX#)
		CopyRect X1, 0, 1, SrcHeight, X2, 0, SrcBuffer, ScratchBuffer
	Next
			
	;Duplicate rows from scratch image to destination image.
	For Y2 = 0 To DestHeight-1
		Y1 = Floor(Y2 / ScaleY#)
		CopyRect 0, Y1, DestWidth, 1, 0, Y2, ScratchBuffer, DestBuffer
	Next
						
	;Free the scratch image.
	FreeImage ScratchImage					
						
	;Return the new image.
	Return DestImage
					
End Function

Function ReadIniFile()
	Local fileName$="Config.ini"
	Local stream = ReadFile(fileName)
	Local l$,flag$,value$
	
	;Validate
	If (Not stream) Then Return
	
	;Scan
	While Not Eof(stream)
		l = ReadLine(stream)
		flag = Upper(GetIniFlag(l))
		value = GetIniValue(l)
		
		;Validate
		Select Upper(value)
			Case "TRUE"
				value = 1
			Case "FALSE"
				value = 0
			Default
				;DO nothing
		End Select
				
		;Assign
		Select flag
			Case "SCALETILES"
				ScaleTiles = value
			Case "TILEWIDTH"
				TileWidth = value
			Case "TILEHEIGHT"
				TileHeight = value
			Case "TILEPADDING"
				TilePadding = value
			Case "MAPPADDING"
				MapPadding = value
			Default
				;DO nothing
		End Select
		
	Wend
	
	;Finalise
	CloseFile(stream)
	
End Function

Function GetIniFlag$(l$)
	Local pos = Instr(l,"=")
	If (pos = 0) Then Return l
	Return Mid(l,1,pos-1)
End Function

Function GetIniValue$(l$)
	Local pos = Instr(l,"=")
	If (pos = 0) Then Return ""
	Return Mid(l,pos + 1,Len(l) - pos)
End Function

Comments

None.

Code Archives Forum