Tile image editor

User projects written in or related to FreeBASIC.
Post Reply
BasicCoder2
Posts: 3950
Joined: Jan 01, 2009 7:03
Location: Australia

Tile image editor

Post by BasicCoder2 »

Never sure if to post source code as my projects are never user friendly or complete being just for personal use. I just add stuff as I need it. As much as I love programming there is no money in it so the time spent on it is only when I get some spare me time to endulge in this time consuming interest.

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
Post Reply