I needed to tweak a 16x16 block of 32x32 pixel tile images I was using in a test game program so I started writing this tile image editor.
I also wrote a tile map editor although I found a program, TILED, that seems a better solution if/when I have time to figure out how to use it. At least when you write your own program there is no learning curve involved in learning how to use it. I found TILED accepts my array of tile images.
In the program below the GET button saves the current tile image. The PUT button will then copy the saved image to any other tile selected. A crude copy/paste.
Code: Select all
screenres 1040,580,32 '24/32 bit image only
color rgb(0,0,0),rgb(254,254,254) 'white paper, black ink
cls
dim shared as integer wtile,htile,SIZE
wtile = 32 'width of tile
htile = 32 'height of tile
SIZE = 12 'size of pixel in drawing area
const BLOCKX = 522 'top/left position of tile block on screen
const BLOCKY = 5
const POSX = 5 'top/left position of grid on screen
const POSY = 5
'position of block of palette colors on screen
dim shared as integer paletteX,paletteY,paletteW,paletteH
dim shared as uinteger sColor 'current color selected to edit current tile image
paletteX = 3
paletteY = 400
paletteW = 8*16
paletteH = 8*16
dim shared as integer mx,my,ox,oy,mb 'mouse variables
dim shared as integer frameX,frameY 'coordinates of current tile in array
frameX = 0
frameY = 0'default start
dim shared as integer mode 'drawing mode
mode = 0 'free hand draw mode
dim shared as integer action 'action to take
action = -1 'no actions
'TOGGLE BUTTONS
dim shared as integer hMirror 'toggle horizontal mirror mode
hMirror = -1
dim shared as integer gridFlag
gridFlag = 1 'turn on grid over tile block
'--- bitmap images used ----
dim shared as any ptr tile1(16,16) '16x16 tile block
'create an array of tile images
for j as integer = 0 to 15
for i as integer = 0 to 15
tile1(i,j) = imageCreate(wtile,htile,rgb(254,254,254))
next i
next j
dim shared as any ptr buffer 'save current tile image for use by undo button
dim shared as any ptr getPutBuffer 'save current tile image for use by put button
buffer = imageCreate(wtile,htile,rgb(254,254,254)) 'used for UNDO
getPutBuffer = imageCreate(wtile,htile,rgb(254,254,254)) 'gets current tile, copies to current tile
dim shared as any ptr tileBlock 'image block of all 32x32 tile images in a 16x16 array
tileBlock = imagecreate(16*32,16*32)
'----------------------------
Dim shared As Uinteger palette1(8,8)
'color palette
for j as integer = 0 to 7
for i as integer = 0 to 7
read palette1(i,j)
next i
next j
dim shared as integer sPtr
sub update()
screenlock()
cls
'copy pixel values from tile to edit tile display
line (POSX-2,POSY-2)-(POSX+SIZE*wtile+2,POSY+SIZE*htile+2),rgb(10,10,10),b 'border grid display
for j as integer = 0 to htile-1
for i as integer = 0 to wtile-1
line (i*SIZE+POSX,j*SIZE+POSY)-(i*SIZE+SIZE+POSX,j*SIZE+SIZE+POSY),point(i,j,tile1(frameX,frameY)),bf
if gridFlag = 1 then
line (i*SIZE+POSX,j*SIZE+POSY)-(i*SIZE+SIZE+POSX,j*SIZE+SIZE+POSY),rgb(128,128,128),b
end if
next i
next j
'draw palette colors
for j as integer = 0 to 7
for i as integer = 0 to 7
line (i*16+paletteX,j*16+paletteY)-(i*16+16+paletteX,j*16+16+paletteY),palette1(i,j),bf
line (i*16+paletteX,j*16+paletteY)-(i*16+16+paletteX,j*16+16+paletteY),rgb(10,10,10),b
next i
next j
'draw buttons
for i as integer = 0 to 17
if i=mode then
line (408,i*16+100)-(470,i*16+115),rgb(255,255,0),bf
line (408,i*16+100)-(470,i*16+115),rgb(1,1,1),b
else
line (408,i*16+100)-(470,i*16+115),rgb(1,1,1),b
end if
next i
draw string (410,104)," DRAW"
draw string (410,120)," RECT"
draw string (410,136)," CIRC"
draw string (410,152)," LINE"
draw string (410,168)," PAINT"
draw string (410,184)," CLEAR"
draw string (410,200)," SAVE"
draw string (410,216)," LOAD"
draw string (410,232)," GET"
draw string (410,248)," PUT"
draw string (410,264)," VFLIP"
draw string (410,280)," HFLIP"
draw string (410,296)," HMIR"
draw string (410,328)," UNDO"
draw string (410,344)," GRID"
draw string (410,376)," EXIT"
'draw tile block
for j as integer = 0 to 15
for i as integer = 0 to 15
put (i*wtile+BLOCKX,j*32+BLOCKY),tile1(i,j),pset
line (i*32+BLOCKX,j*32+BLOCKY)-(i*32+32+BLOCKX,j*32+32+BLOCKY),rgb(127,127,127),b
next i
next j
'border current selected tile in block display
line (frameX*32+BLOCKX-2,frameY*32+BLOCKY-2)-(frameX*32+32+BLOCKX+2,frameY*32+32+BLOCKY+2),rgb(255,0,0),b
line (frameX*32+BLOCKX-1,frameY*32+BLOCKY-1)-(frameX*32+32+BLOCKX+1,frameY*32+32+BLOCKY+1),rgb(255,0,0),b
'draw selected color block
line (408,400)-(440,432),sColor,bf 'selected color
line (408,400)-(440,432),rgb(10,10,10),b 'border it
draw string (400,440),"&H"+str(hex(sColor))
'draw saved tile image for undo
put (400,5),buffer,pset
'draw save tile image from get to use to put elsewhere
put (440,5),getPutBuffer,pset
screenunlock()
sleep 1
end sub
sub SaveTileBlock()
for j as integer = 0 to 15
for i as integer = 0 to 15
put tileBlock,(i*32,j*32),tile1(i,j),pset
next i
next j
bsave "tileBlock.bmp",tileBlock
end sub
sub loadTileBlock()
bload "tileBlock.bmp",tileBlock
for j as integer = 0 to 15
for i as integer = 0 to 15
put tile1(i,j),(0,0),tileBlock,(i*32,j*32)-(i*32+31,j*32+31),pset
next i
next j
end sub
sub drawPen()
put buffer,(0,0),tile1(frameX,frameY),pset 'save current image into buffer
pset tile1(frameX,frameY),( (mx-POSX)\SIZE, (my-POSY)\SIZE ),sColor
if hMirror = 1 then
pset tile1(frameX,frameY),( wtile-(mx-POSX)\SIZE, (my-POSY)\SIZE ),sColor
end if
update()
while mb=1
getmouse mx,my,,mb
if mx<>ox and my<>oy then
'draw into tile image
line tile1(frameX,frameY),( (ox-POSX)\SIZE, (oy-POSY)\SIZE )-( (mx-POSX)\SIZE, (my-POSY)\SIZE ),sColor 'copy to tile
if hMirror = 1 then
line tile1(frameX,frameY),( wtile-(ox-POSX)\SIZE, (oy-POSY)\SIZE )-( wtile-(mx-POSX)\SIZE, (my-POSY)\SIZE ),sColor
end if
ox = mx
oy = my
update() 'copy tile pixel values to grid, display result
end if
sleep 1 'seems to stop the jitter
wend
end sub
sub Oval(s as any ptr,x1 as integer, y1 as integer, x2 as integer, y2 as integer,c as uinteger)
dim as double ratio,r,cHeight,cWidth
if x2<x1 then swap x2,x1
if y2<y1 then swap y2,y1
cHeight = abs(y2-y1)
cWidth = abs(x2-x1)
ratio = cHeight/cWidth
if cWidth>cHeight then
r = cWidth/2
else
r = cHeight/2
end if
CIRCLE s,(x1+cWidth\2+1,y1+cHeight\2+1), r, sColor, , , ratio
end sub
sub drawCircle()
dim as integer sx,sy
put buffer,(0,0),tile1(frameX,frameY),pset 'save current image into buffer
sx = mx 'top left corner
sy = my
while mb=1
getmouse mx,my,,mb
if mx<>ox and my<>oy then
put tile1(frameX,frameY),(0,0),buffer,pset 'restore image
Oval (tile1(frameX,frameY), (sx-POSX)\SIZE, (sy-POSY)\SIZE, (mx-POSX)\SIZE, (my-POSY)\SIZE,sColor) 'copy to tile
update() 'copy tile pixel values to grid, display result
ox = mx
oy = my
end if
sleep 1 'seems to stop the jitter
wend
end sub
sub drawLine()
put buffer,(0,0),tile1(frameX,frameY),pset 'save current image into buffer
while mb=1
getmouse mx,my,,mb
if mx<>ox and my<>oy then
put tile1(frameX,frameY),(0,0),buffer,pset 'restore image
line tile1(frameX,frameY),( (ox-POSX)\SIZE, (oy-POSY)\SIZE )-( (mx-POSX)\SIZE, (my-POSY)\SIZE ),sColor 'copy to tile
update() 'copy tile pixel values to grid, display result
end if
sleep 1 'seems to stop the jitter
wend
end sub
sub drawRectangle()
put buffer,(0,0),tile1(frameX,frameY),pset 'save current image into buffer
while mb=1
getmouse mx,my,,mb
if mx<>ox and my<>oy then
put tile1(frameX,frameY),(0,0),buffer,pset 'restore image
line tile1(frameX,frameY),( (ox-POSX)\SIZE, (oy-POSY)\SIZE )-( (mx-POSX)\SIZE, (my-POSY)\SIZE ),sColor,b 'copy to tile
update() 'copy tile pixel values to grid, display result
end if
sleep 1 'seems to stop the jitter
wend
end sub
sub fillShape(x as integer, y as integer, oldcolour as uinteger, newcolour as uinteger)
put buffer,(0,0),tile1(frameX,frameY),pset 'save current image into buffer
dim as integer stkx(1000),stky(1000)
if point(x,y,tile1(frameX,frameY))=newcolour then exit sub
sPtr = 0
stkx(sPtr)=x
stky(sPtr)=y
sPtr=sPtr+1
while sPtr<>0
sPtr = sPtr-1
x = stkx(sPtr)
y = stky(sPtr)
if point(x,y,tile1(frameX,frameY))=oldcolour then
'move to left
while point(x,y,tile1(frameX,frameY))=oldcolour
x = x - 1
wend
x = x + 1
if point(x,y-1,tile1(frameX,frameY))=oldcolour then
stkx(sPtr)=x
stky(sPtr)=y-1
sPtr=sPtr+1
end if
if point(x,y+1,tile1(frameX,frameY))=oldcolour then
stkx(sPtr)=x
stky(sPtr)=y+1
sPtr=sPtr+1
end if
'draw to the right
while point(x,y,tile1(frameX,frameY))=oldcolour
pset tile1(frameX,frameY),(x,y),newcolour
if point(x,y-1,tile1(frameX,frameY))=oldcolour and point(x+1,y-1,tile1(frameX,frameY))<>oldcolour then
stkx(sPtr)=x
stky(sPtr)=y-1
sPtr=sPtr+1
end if
if point(x,y-1,tile1(frameX,frameY))=oldcolour and point(x-1,y-1,tile1(frameX,frameY))<>oldcolour then
stkx(sPtr)=x
stky(sPtr)=y-1
sPtr=sPtr+1
end if
if point(x,y+1,tile1(frameX,frameY))=oldcolour and point(x+1,y+1,tile1(frameX,frameY))<>oldcolour then
stkx(sPtr)=x
stky(sPtr)=y+1
sPtr=sPtr+1
end if
if point(x,y+1,tile1(frameX,frameY))=oldcolour and point(x-1,y+1,tile1(frameX,frameY))<>oldcolour then
stkx(sPtr)=x
stky(sPtr)=y+1
sPtr=sPtr+1
end if
x = x + 1
wend
end if
wend
end sub
'MAIN PROGRAM
update()
getmouse mx,my,,mb
ox = mx
oy = my
dim as string key
dim as integer exitFlag
exitFlag = 0
do
getmouse mx,my,,mb
if mb = 1 and mx>408 and mx<470 and my>100 and my<387 then 'over buttons
action = (my-100)\16
if action < 5 then
mode = action
while mb=1
getmouse mx,my,,mb
wend
end if
end if
if action = 5 then 'clear tile
line tile1(frameX,frameY),(0,0)-(wtile,htile),rgb(254,254,254),bf
update()
end if
if action = 6 then 'save tileBlock.bmp
locate 1,1
print "SAVING TILE BLOCK BITMAP ..."
SavetileBlock()
end if
if action = 7 then 'load tileBlock.bmp
locate 1,1
print "LOADING TILE BLOCK BITMAP ..."
LoadtileBlock()
end if
if action = 8 then 'save current tile image
put getPutBuffer,(0,0),tile1(frameX,frameY),(0,0)-(31,31),pset 'put image
while mb=1
getmouse mx,my,,mb
wend
end if
if action = 9 then 'put saved image into current tile image
put tile1(frameX,frameY),(0,0),getPutBuffer,pset 'get image 'put image
while mb=1
getmouse mx,my,,mb
wend
end if
dim as uinteger v1,v2
if action = 10 then 'flip vertically
for j as integer = 0 to htile\2-1
for i as integer = 0 to wtile-1
v1 = point(i,j,tile1(frameX,frameY))
v2 = point(i,31-j,tile1(frameX,frameY))
pset tile1(frameX,frameY),(i,j),v2
pset tile1(frameX,frameY),(i,31-j),v1
next i
next j
while mb=1
getmouse mx,my,,mb
wend
end if
if action = 11 then 'flip horizontally
for i as integer = 0 to wtile\2-1
for j as integer = 0 to htile-1
v1 = point(i,j,tile1(frameX,frameY))
v2 = point((wtile-1)-i,j,tile1(frameX,frameY))
pset tile1(frameX,frameY),(i,j),v2
pset tile1(frameX,frameY),((wtile-1)-i,j),v1
next j
next i
while mb=1
getmouse mx,my,,mb
wend
end if
if action = 12 then
hMirror = - hMirror 'toggle mirror mode
while mb=1
getmouse mx,my,,mb
wend
end if
if action = 14 then
put tile1(frameX,frameY),(0,0),buffer,pset 'restore image
while mb=1
getmouse mx,my,,mb
wend
end if
if action = 15 then 'toggle grid on/off
gridFlag = -gridFlag
while mb=1
getmouse mx,my,,mb
wend
end if
if action = 17 then
exitFlag = 1
end if
action = -1 'turn off actions
'wait for mouse select button down event
getmouse mx,my,,mb
if mx<>ox and my<>oy then
ox = mx
oy = my
end if
'over drawing area and mb=1?
if mb = 1 and mx>POSX and mx<POSX+wtile*SIZE+SIZE-1 and my>POSY and my<POSY+htile*SIZE+SIZE-1 then
if mode = 0 then
drawPen()
end if
if mode = 1 then
drawRectangle()
end if
if mode = 2 then
drawCircle()
end if
if mode = 3 then
drawLine()
end if
if mode = 4 then
fillShape( (mx-POSX)\SIZE, (my-POSY)\SIZE, point( (mx-POSX)\SIZE, (my-POSY)\SIZE, tile1(frameX,frameY)), sColor)
end if
while mb=1
getmouse mx,my,,mb
wend
end if
'down over tile block display?
if mb = 1 and mx>BLOCKX and mx<BLOCKX+wtile*16-1 and my>BLOCKY and my<BLOCKY+htile*16-1 then
frameX = (mx - BLOCKX)\32
frameY = (my - BLOCKY)\32
while mb=1
getmouse mx,my,,mb
wend
end if
'over palette area?
if mb = 1 and mx>paletteX and mx<paletteX+paletteW and my>paletteY and my<paletteY+paletteH then
sColor = point(mx,my)
end if
update()
sleep 1
loop until exitFlag = 1 or multikey(&H01)
cls
dim as string response
input "DO YOU WANT TO SAVE EDITS y/n";response
if response = "y" then
SaveTileBlock()
end if
'clean up memory used for images
imagedestroy(tileBlock)
imagedestroy(getPutBuffer)
imagedestroy(buffer)
'destroy an array of tile images
for j as integer = 0 to 15
for i as integer = 0 to 15
imagedestroy (tile1(i,j))
next i
next j
'palette colours
DATA &HFFFF8080,&HFFFFFF80,&HFF80FF80,&HFF00FF80,&HFF80FFFF,&HFF0080FF,&HFFFF80C0,&HFFFF80FF
DATA &HFFFF0000,&HFFFFFF00,&HFF80FF00,&HFF00FF40,&HFF00FFFF,&HFF0080C0,&HFF8080C0,&HFFFF00FF
DATA &HFF804040,&HFFFF8040,&HFF00FF00,&HFF008080,&HFF004080,&HFF8080FF,&HFF800040,&HFFFF0080
DATA &HFF800000,&HFFFF8000,&HFF008000,&HFF008040,&HFF0000FF,&HFF0000A0,&HFF800080,&HFF8000FF
DATA &HFF400000,&HFF804000,&HFF004000,&HFF004040,&HFF000080,&HFF000040,&HFF400040,&HFF400080
DATA &HFF000000,&HFF808000,&HFF808040,&HFF808080,&HFF408080,&HFFC0C0C0,&HFF400040,&HFFFEFEFE
DATA &HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000
DATA &HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000,&HFF000000