pixler/pixler.bas

type statetype
    tool as long
    fcolor as long
    bcolor as long
    offsetX as single
    offsetY as single
    zoom as single
    brushsize as integer
    startX as integer
    startY as integer
    isDrawing as integer
end type

type layertype
    ihandle as long
    blendmode as long
    filter as long
    kind as long
end type

redim shared layers(2) as layertype
dim shared state as statetype


dim shared mouseclicked as integer
dim shared mousedown as integer
dim shared rmouseclicked as integer
dim shared rmousedown as integer

$resize:on
screen _newimage(750,480,32)
_delay 0.1
temp&=_resize
redim shared pal(0) as _unsigned long
dim as integer ch1,ch2,ch3,bt
loadpalette "endesga16",pal()
layers(0).ihandle=_newimage(640,350,32)
layers(1).ihandle=_newimage(640,350,32)
layers(2).ihandle=_newimage(640,350,32)
_dest layers(0).ihandle
line (0,0)-(_width-1,_height-1),_rgb32(255),bf
_dest 0
state.tool = 1
state.fcolor = 1
state.bcolor = 2
state.zoom = 1.0
state.offsetX = 70 + 20 ' To the right of the toolbox
state.offsetY = 20
state. brushsize = 1
dim lastMX, lastMY
dim diffX as integer
dim diffY as integer
dim oldWidth as integer
dim oldHeight as integer
dim keyin as string

oldWidth=_width
oldHeight=_height
do
    if CheckResize(_source) = -1 THEN
        diffX = _width - oldWidth
        diffY = _height - oldHeight
        state.offsetX = state.offsetX + (diffX / 2)
        state.offsetY = state.offsetY + (diffY / 2)
        oldWidth = _width
        oldHeight = _height
    end if
    
    cls
    line (0,0)-(_width-1,_height-1),backgroundcolor1,bf
    
    'Mouse Handling
    while _mouseinput:mw=mw+_mousewheel:wend
    mouseclicked = 0
    rmouseclicked = 0
    if mousedown = -1 and _mousebutton(1) = 0 then mouseclicked = -1
    if rmousedown = -1 and _mousebutton(2) = 0 then rmouseclicked = -1
    mousedown = _mousebutton(1)
    rmousedown = _mousebutton(2)
    
    ' Panning (Middle Mouse)
    if _mousebutton(3) then
        state.offsetX = state.offsetX + (_mousex - lastMX)
        state.offsetY = state.offsetY + (_mousey - lastMY)
    end if
    lastMX = _mousex: lastMY = _mousey
    
    ' Zooming
    if mw <> 0 then
        state.zoom = state.zoom + (mw * 0.1)
        if state.zoom < 0.1 then state.zoom = 0.1
        mw=0
    end if

    ' Keyboarding
    keyin=inkey$
    select case keyin
    case "+"
        state.brushsize=state.brushsize+1
    case "-"
        if state.brushsize>1 then state.brushsize=state.brushsize-1
    end select
    _dest 0    
    canvas 'draw canvas first so it doesn't over
    toolbox
    colorpicker
    
    _limit 30
    _display
loop

sub toolbox
    dim i, x, y
    dim btnSize : btnSize = 32
    dim spacing : spacing = 1
    
    for i = 0 to 19
        ' Force integer math to keep columns locked at 2
        ' x will only ever be 0 or 33
        x = (i mod 2) * (btnSize + spacing)
        
        ' y will only increase every 2 buttons
        ' Use Int() if your language doesn't support the \ operator
        y = Int(i / 2) * (btnSize + spacing)
        
        if imagebutton(x, y, btnSize, btnSize, icon(i)) then
            state.tool = i + 1
        end if
    next
end sub

sub colorpicker
    dim img as long
    img=_newimage(16,16,32)
    for i=0 to ubound(pal)
        _dest img
        cls ,pal(i)
        line (0,0)-(_width-1,height-1),pal(i),bf
        _dest 0
        select case imagebutton(i*16,_height-17,16,16,img)
            case -1
                state.fcolor=pal(i)
            case -2
                state.bcolor=pal(i)
        end select 
    next i
    _freeimage img
end sub

sub canvas
    dim boxX1 as integer: boxX1 = 70
    dim boxWidth as integer: boxWidth = _width - 1 - boxX1
    dim boxHeight as integer: boxHeight = _height - 20
    
    ' Workspace background
    line (boxX1, 0)-(_width - 1, boxHeight), _rgb32(32), bf

    ' Render Layers (0 = background,1 = drawlayer, 2=reference  3 = Preview)
    dim i as integer
    for i = 0 to ubound(layers)
        dim w as integer: w = _width(layers(i).ihandle) * state.zoom
        dim h as integer: h = _height(layers(i).ihandle) * state.zoom
        _putimage (state.offsetX, state.offsetY)-(state.offsetX + w, state.offsetY + h), layers(i).ihandle
    next

' Translate Mouse to Canvas Space
    dim canX as integer: canX = (_mousex - state.offsetX) / state.zoom
    dim canY as integer: canY = (_mousey - state.offsetY) / state.zoom
    
    ' Color Selection: Left Click = Foreground, Right Click = Background
    dim drawCol as _unsigned long
    if mousedown or mouseclicked then drawCol = state.fcolor else drawCol = state.bcolor
    
    ' Interaction Boundary Check
    if _mousex > boxX1 then
        ' On Initial Click: Set the anchor point for shapes
        if (mousedown or rmousedown) and state.isDrawing = 0 then
            state.startX = canX
            state.startY = canY
            state.isDrawing = -1
        end if
    
        if state.isDrawing then
            ' preview layer handles the "rubber-banding" of shapes
            _dest layers(2).ihandle
            cls , 0 
    
            select case state.tool
                case 1 ' Pencil (Direct to Canvas)
                    _dest layers(1).ihandle
                    thickline state.startX, state.startY, canX, canY, drawCol
                    state.startX = canX: state.startY = canY
    
                case 2 ' Straight Line
                    thickline state.startX, state.startY, canX, canY, drawCol
    
                case 3 ' Thick Circle (Outline)
                    dim r as single: r = sqr((canX - state.startX)^2 + (canY - state.startY)^2)
                    r=abs(r)+1
                    thickcircle state.startX, state.startY, r, drawCol
    
                case 4 ' Filled Circle
                    dim r_fill as single: r_fill = sqr((canX - state.startX)^2 + (canY - state.startY)^2)
                    filledcircle state.startX, state.startY, r_fill, drawCol
    
                case 5 ' Rectangle Outline (using thickline)
                    thickline state.startX, state.startY, canX, state.startY, drawCol
                    thickline canX, state.startY, canX, canY, drawCol
                    thickline canX, canY, state.startX, canY, drawCol
                    thickline state.startX, canY, state.startX, state.startY, drawCol
    
                case 6 ' Filled Rectangle
                    line (state.startX, state.startY)-(canX, canY), drawCol, bf
    
                case 7
    
                case 8 ' Polygon Outline (using thickline)
                    ' Simple preview of a line; complex polygons usually require 
                    ' a point-collection state machine.
                    thickline state.startX, state.startY, canX, canY, drawCol
    
            end select
    
            ' Release Logic: Commit preview to permanent layer
            if _mousebutton(1) = 0 and _mousebutton(2) = 0 then
                _dest layers(1).ihandle
                _putimage , layers(2).ihandle 
                _dest layers(2).ihandle
                cls , 0 
                state.isDrawing = 0
            end if
            _dest 0
        end if
    end if
end sub

function icon (index as long)
    static init as integer
    static icons() as long
    if not init then
        redim icons(19) as long ' Room for 20 icons
        
        ' Define your specific tool icons here
        icons(0) = _newimage(32, 32, 32): _dest icons(0): line (5, 27)-(27, 5): _dest 0
        icons(1) = _newimage(32, 32, 32): _dest icons(1): circle (15, 15), 13: _dest 0
        icons(2) = _newimage(32, 32, 32): _dest icons(2): line (5, 5)-(27, 27), , b: _dest 0
        
        ' Fill the remaining slots with blank 32x32 images
        dim j as integer
        for j = 3 to 19
            if icons(j) = 0 then icons(j) = _newimage(32, 32, 32)
        next
        
        init = -1
    end if

    ' Bounds checking to prevent returning 0 or crashing
    if index >= 0 and index <= 19 then
        icon = icons(index)
    else
        icon = icons(0)
    end if
end function

'$include: 'include/ui.bm'
'$include: 'include/imgout.bm'
'$include: 'include/palette.bm'
'$include: 'include/tools.bm'

function adduiicon(imagehandle as long)
    dim unknown as long
    adduiicon=__internaluiicon(unknown,imagehandle,1)
end function

function adduiiconfromfile(filename as string)
    dim unknown as long
    adduiiconfromfile=__internaluiicon(unknown,_loadimage(filename),1)
end function

function uiicon(index)
    dim unknown as long
    uiicon=internaluiicon(index,unknown,2)
end function

function __internaluiicon&(index as long,imagehandle as long,mode as integer)
    static init as integer
    static icons() as long
    if not init or mode=3 then
        if mode<3 then 
            redim icons(3) as long
        else
            _freeimage icons(0)
            _freeimage icons(1)
            _freeimage icons(2)
            _freeimage icons(3)
        end if
        icons(0)=_newimage(23,23,32) 'Up arrow'
        _dest icons(0)
        color textcolor
        
        icons(1)=_newimage(23,23,32) 'Down arrow'
        _dest icons(1)
        color textcolor
        
        icons(2)=_newimage(23,23,32) 'Left arrow'
        _dest icons(2)
        color textcolor
        
        icons(3)=_newimage(23,23,32) 'Right arrow'
        _dest icons(3)               
        color textcolor
        
        _dest 0
        init=-1
    end if
    
    select case mode
        case 1
            redim _preserve icons(ubound(icons)+1)
            icons(ubound(icons))=imagehandle
            __internaluiicon=ubound(icons)
        case 2
            __internaluiicon=icons(index)
    end select
end function


FUNCTION CheckResize (CurrentScreen AS _UNSIGNED LONG) 'pulled straight out of the wiki'
    DIM TempScreen AS _UNSIGNED LONG
    CheckResize = 0
    IF _RESIZE THEN
        TempScreen = _COPYIMAGE(CurrentScreen, 32)
        SCREEN TempScreen
        _FREEIMAGE CurrentScreen
        CurrentScreen = _NEWIMAGE(_RESIZEWIDTH, _RESIZEHEIGHT, 32)
        SCREEN CurrentScreen
        _PUTIMAGE (0, 0), TempScreen, CurrentScreen
        _DISPLAY
        _FREEIMAGE TempScreen
        CheckResize = -1
    END IF

END FUNCTION