pixler/pixler.bas

1047 lines
30 KiB
QBasic
Raw Normal View History

2026-04-29 09:28:35 +02:00
type statetype
tool as long
fcolor as long
bcolor as long
offsetx as long
offsety as long
2026-04-30 10:09:05 +02:00
zoom as single
2026-04-30 13:16:00 +02:00
brushsize as integer
startx as long
starty as long
isdrawing as integer
2026-04-29 09:28:35 +02:00
end type
type layertype
ihandle as long
blendmode as long
filter as long
2026-04-29 12:36:31 +02:00
kind as long
2026-04-29 09:28:35 +02:00
end type
2026-05-01 00:30:34 +02:00
redim shared layers(3) as layertype
2026-04-29 09:28:35 +02:00
dim shared state as statetype
2026-05-06 13:28:56 +02:00
redim shared commands(0) as string
dim shared showtoolbox as _byte:showtoolbox=-1
dim shared showcolorpicker as _byte:showcolorpicker=-1
dim shared showcommands as _byte:showcommands=0
2026-04-29 09:28:35 +02:00
dim shared mouseclicked as integer
dim shared mousedown as integer
2026-04-29 12:36:31 +02:00
dim shared rmouseclicked as integer
dim shared rmousedown as integer
2026-04-30 10:09:05 +02:00
2026-04-29 12:36:31 +02:00
$resize:on
2026-04-30 08:23:26 +02:00
screen _newimage(750,480,32)
2026-04-29 12:36:31 +02:00
_delay 0.1
temp&=_resize
redim shared pal(0) as _unsigned long
loadpalette"custodian-8",pal()
2026-05-04 12:14:29 +02:00
layers(0).ihandle=_newimage(320,320,32)
layers(1).ihandle=_newimage(320,320,32)
layers(2).ihandle=_newimage(320,320,32)
layers(3).ihandle=_newimage(320,320,32)
2026-05-01 00:30:34 +02:00
2026-04-29 21:17:20 +02:00
_dest layers(0).ihandle
addcommand"canvas ("+tst(_width)+","+tst(_height)+")"
for y=0 to _height-16 step 16
for x=0 to _width-16 step 16
if ((x+y)/16 and 1)=0 then
line (x,y)-(x+16,y+16),_rgb32(127),bf
2026-05-11 11:39:10 +02:00
else
line (x,y)-(x+16,y+16),_rgb32(192),bf
2026-05-11 11:39:10 +02:00
end if
next
next
2026-04-29 21:17:20 +02:00
_dest 0
state.tool=1
state.zoom=1.0
state.offsetx=70+20
state.offsety=20
state. brushsize=1
2026-05-11 10:03:44 +02:00
state.fcolor=closestcolor(_rgb32(0,0,0),pal())
state.bcolor=closestcolor(_rgb32(255,255,255),pal())
addcommand"fcolor ("+hex$(state.fcolor)+")"
addcommand"bcolor ("+hex$(state.bcolor)+")"
2026-05-11 10:03:44 +02:00
dim lastmx,lastmy
2026-04-30 13:16:00 +02:00
dim keyin as string
dim mouseworldy as integer
dim mouseworldx as integer
dim diffx as integer
dim diffy as integer
dim oldwidth as integer
dim oldheight as integer
oldwidth=_width
oldheight=_height
2026-04-29 09:28:35 +02:00
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
2026-04-30 10:09:05 +02:00
end if
2026-05-04 13:49:56 +02:00
2026-05-19 10:34:20 +02:00
canvas
2026-05-11 10:03:44 +02:00
if showtoolbox then toolbox
if showcolorpicker then colorpicker
if showcommands then commandlist
2026-04-30 13:16:00 +02:00
'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)
2026-05-04 13:49:56 +02:00
2026-04-30 10:09:05 +02:00
' Panning (Middle Mouse)
if _mousebutton(3) then
state.offsetx=int(state.offsetx+(_mousex-lastmx))
state.offsety=int(state.offsety+(_mousey-lastmy))
2026-04-30 10:09:05 +02:00
end if
lastmx=_mousex:lastmy=_mousey
2026-05-04 11:24:14 +02:00
2026-04-30 10:09:05 +02:00
' Zooming
if mw<>0 then
2026-05-19 12:23:01 +02:00
' 1. Capture current world position
mouseworldx=(_mousex-state.offsetx)/state.zoom
mouseworldy=(_mousey-state.offsety)/state.zoom
2026-05-19 12:23:01 +02:00
' 2. Calculate the new zoom level (Snap to whole numbers)
if mw>0 then
state.zoom=state.zoom+1
2026-05-19 12:23:01 +02:00
else
state.zoom=state.zoom-1
2026-05-19 12:23:01 +02:00
end if
2026-05-04 13:49:56 +02:00
2026-05-19 12:23:01 +02:00
' 3. Constrain zoom (Min 1, Max 20)
if state.zoom<1 then state.zoom=1
if state.zoom>20 then state.zoom=20
2026-05-04 13:49:56 +02:00
2026-05-19 12:23:01 +02:00
' 4. Adjust offsets
state.offsetx=_mousex-(mouseworldx*state.zoom)
state.offsety=_mousey-(mouseworldy*state.zoom)
2026-05-04 13:49:56 +02:00
mw=0
2026-05-19 12:23:01 +02:00
end if
2026-04-30 13:16:00 +02:00
' Keyboarding
keyin=inkey$
select case keyin
2026-05-19 12:23:01 +02:00
case "+"
state.brushsize=state.brushsize+1
addcommand"brushsize ("+tst(state.brushsize)+")"
2026-05-19 12:23:01 +02:00
case "-"
if state.brushsize>1 then state.brushsize=state.brushsize-1
addcommand"brushsize ("+tst(state.brushsize)+")"
2026-05-19 12:23:01 +02:00
case chr$(19) ' ctrl+s
'TODO: save logic
case chr$(27) ' esc
2026-05-19 12:23:01 +02:00
menu
case "h"
state.zoom=1.0
state.offsetx=(_width/2)-(_width(layers(0).ihandle)/2)
state.offsety=(_height/2)-(_height(layers(0).ihandle)/2)
2026-05-19 12:23:01 +02:00
case "t"
showtoolbox=not showtoolbox
case "c"
showcolorpicker=not showcolorpicker
case "l"
showcommands=not showcommands
2026-05-04 13:49:56 +02:00
end select
2026-05-01 00:30:34 +02:00
2026-04-29 09:28:35 +02:00
_limit 30
_display
2026-05-11 10:03:44 +02:00
line (0,0)-(_width-1,_height-1),backgroundcolor1,bf
2026-04-29 09:28:35 +02:00
loop
2026-05-06 13:28:56 +02:00
sub commandlist
dim i as long
dim listwidth as integer:listwidth=250
dim x as integer:x=_width-listwidth
2026-05-06 13:28:56 +02:00
' Draw background for the list
line (x,0)-(_width-1,_height-1),backgroundcolor1,bf
2026-05-11 10:03:44 +02:00
line (x,0)-(x,_height-1),backgroundcolor2
2026-05-06 13:28:56 +02:00
_printmode _keepbackground
2026-05-11 10:03:44 +02:00
dim y as integer
for i=ubound(commands)-1 to 0 step -1
y=(ubound(commands)-i)*16
if y<_height-20 then
'_printstring (x + 5, y + 5), left$(commands(i), 31)
if link(x+5,y+5,left$(commands(i),31)) then
commands(i)=textinput(x+5,y+5,248,23,commands(i))
end if
2026-05-06 13:28:56 +02:00
end if
next i
if button(x,_height-25,60,23,"redraw") then redraw
end sub
sub redraw
redim numarr(0) as long
2026-05-18 14:05:35 +02:00
dim i as integer
dim j as integer
dim x as long
dim y as long
2026-05-12 11:47:31 +02:00
_dest layers(1).ihandle
_source layers(1).ihandle
cls,_rgb32(255)
2026-05-12 11:47:31 +02:00
_clearcolor _rgb32(255)
for i=lbound(commands) to ubound(commands)
2026-05-12 11:47:31 +02:00
getnums commands(i),numarr()
_dest layers(1).ihandle
_source layers(1).ihandle
select case lcase$(_trim$(left$(commands(i),instr(commands(i),"(")-1)))
2026-05-19 12:23:01 +02:00
case "canvas"
for j=0 to 3
if layers(j).ihandle<>0 then _freeimage layers(j).ihandle
layers(j).ihandle=_newimage(numarr(0),numarr(1),32)
2026-05-19 12:23:01 +02:00
next j
_dest layers(0).ihandle
for y=0 to _height-16 step 16
for x=0 to _width-16 step 16
if ((x+y)/16 and 1)=0 then
line (x,y)-(x+16,y+16),_rgb32(127),bf
2026-05-19 12:23:01 +02:00
else
line (x,y)-(x+16,y+16),_rgb32(192),bf
2026-05-19 12:23:01 +02:00
end if
next
2026-05-18 14:05:35 +02:00
next
2026-05-19 12:23:01 +02:00
case "fcolor"
state.fcolor=numarr(0)
case "bcolor"
state.bcolor=numarr(0)
case "brushsize"
state.brushsize=numarr(0)
case "pixel"
thickpixel numarr(0),numarr(1),numarr(2)
case "line"
thickline numarr(0),numarr(1),numarr(2),numarr(3),numarr(4)
case "box"
thickbox numarr(0),numarr(1),numarr(2),numarr(3),numarr(4)
case "fbox"
filledbox numarr(0),numarr(1),numarr(2),numarr(3),numarr(4)
case "circle"
thickcircle numarr(0),numarr(1),numarr(2),numarr(3)
case "fcircle"
filledcircle numarr(0),numarr(1),numarr(2),numarr(3)
case "polygon"
polygon numarr(),state.fcolor
case "fpolygon"
filledpolygon numarr(),state.fcolor
2026-05-19 12:23:01 +02:00
case "floodfill"
floodfill numarr(0),numarr(1),numarr(2)
case "boundaryfill"
boundaryfill numarr(0),numarr(1),numarr(2),numarr(3)
2026-05-21 09:22:52 +02:00
case "gradient"
ditheredgradient numarr(0),numarr(1),numarr(2),numarr(3),state.fcolor,state.bcolor
2026-05-19 12:23:01 +02:00
case ""
' blank line do nothing
case else
'debug info
print"'"+lcase$(_trim$(left$(commands(i),instr(commands(i),"(")-1)))+"'"
end select
next i
2026-05-12 11:47:31 +02:00
_dest 0
_source 0
2026-05-06 13:28:56 +02:00
end sub
sub getnums (inputstr$,numarray() as long)
2026-05-12 11:47:31 +02:00
' 1. Extract inner content
spos=instr(inputstr$,"(")
epos=instr(inputstr$,")")
if spos=0 or epos<=spos then exit sub
2026-05-19 12:23:01 +02:00
content$=mid$(inputstr$,spos+1,epos-spos-1)
idx=-1 ' Start at -1 so the first increment hits 0
2026-05-12 11:47:31 +02:00
' 2. Parse segments
2026-05-19 12:23:01 +02:00
do
cpos=instr(content$,",")
if cpos>0 then
part$=ltrim$(rtrim$(left$(content$,cpos-1)))
content$=mid$(content$,cpos+1)
2026-05-19 12:23:01 +02:00
else
part$=ltrim$(rtrim$(content$))
content$=""
2026-05-19 12:23:01 +02:00
end if
2026-05-12 11:47:31 +02:00
if len(part$)>0 then
idx=idx+1
redim _preserve numarray(idx) as long
2026-05-19 12:23:01 +02:00
2026-05-12 11:47:31 +02:00
' Determine if part is Hex (contains A-F)
ishex=0
for i=1 to len(part$)
c$=ucase$(mid$(part$,i,1))
if c$>="A"and c$<="F"then
ishex=1
2026-05-19 12:23:01 +02:00
exit for
end if
next i
if ishex then
numarray(idx)=val("&H"+part$)
2026-05-19 12:23:01 +02:00
else
numarray(idx)=val(part$)
2026-05-19 12:23:01 +02:00
end if
end if
loop while len(content$)>0
2026-05-19 12:23:01 +02:00
end sub
2026-05-12 11:47:31 +02:00
2026-04-29 09:28:35 +02:00
sub toolbox
dim i,x,y
dim btnsize:btnsize=32
dim spacing:spacing=1
2026-05-04 13:49:56 +02:00
for i=0 to 19
2026-04-30 10:09:05 +02:00
' Force integer math to keep columns locked at 2
' x will only ever be 0 or 33
x=(i mod 2)*(btnsize+spacing)
2026-05-04 13:49:56 +02:00
2026-04-30 10:09:05 +02:00
' y will only increase every 2 buttons
' Use Int() if your language doesn't support the \ operator
y=int(i/2)*(btnsize+spacing)
2026-05-04 13:49:56 +02:00
if imagebutton(x,y,btnsize,btnsize,icon(i)) then
state.tool=i+1
2026-04-30 10:09:05 +02:00
end if
next
2026-05-11 10:03:44 +02:00
'colorindicator
y=y+btnsize+16
2026-05-11 10:03:44 +02:00
line (16,y+16)-(64,y+64),state.bcolor,bf
line (16,y+16)-(64,y+64),highlightcolor,b
line (0,y)-(48,y+48),state.fcolor,bf
line (0,y)-(48,y+48),highlightcolor,b
if clickregion(0,y,48,48) then
2026-05-11 12:41:20 +02:00
palettemanager state.fcolor
elseif clickregion(16,y+16,48,48) then
2026-05-11 12:41:20 +02:00
palettemanager state.bcolor
end if
end sub
2026-04-29 09:28:35 +02:00
sub colorpicker
2026-05-20 11:30:31 +02:00
static img as long
if img=0 then img=_newimage(16,16,32)
2026-04-29 12:36:31 +02:00
for i=0 to ubound(pal)
_dest img
cls,pal(i)
2026-04-29 12:36:31 +02:00
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)
addcommand"fcolor ("+hex$(pal(i))+")"
2026-04-29 12:36:31 +02:00
case -2
state.bcolor=pal(i)
addcommand"bcolor ("+hex$(pal(i))+")"
2026-05-04 13:49:56 +02:00
end select
2026-04-29 12:36:31 +02:00
next i
2026-04-29 09:28:35 +02:00
end sub
2026-05-06 13:28:56 +02:00
sub addcommand(cmd as string)
'this check is probably more clever than good is.
if commands(ubound(commands)+(ubound(commands)>0))<>cmd then
commands(ubound(commands))=cmd
redim _preserve commands(ubound(commands)+1) as string
end if
end sub
sub canvas
2026-05-04 11:24:14 +02:00
' 1. Define the Viewport (The "Window" on your screen)
dim viewx1 as integer
if showtoolbox then viewx1=70 else viewx1=0
dim viewy1 as integer:viewy1=0
dim viewx2 as integer
if showcommands then viewx2=_width-151 else viewx2=_width-1
dim viewy2 as integer
if showcolorpicker then viewy2=_height-20 else viewy2=_height-1
2026-05-01 00:30:34 +02:00
_dest 0
2026-05-04 13:49:56 +02:00
2026-05-04 11:24:14 +02:00
' 2. Render Layers with Clipping
dim srcx1 as long
dim srcy1 as long
dim srcx2 as long
dim srcy2 as long
dim drawx1 as long
dim drawy1 as long
dim drawx2 as long
dim drawy2 as long
2026-05-04 13:49:56 +02:00
2026-04-30 10:09:05 +02:00
dim i as integer
for i=0 to ubound(layers)
dim img as long:img=layers(i).ihandle
dim imgw as integer:imgw=_width(img)
dim imgh as integer:imgh=_height(img)
2026-05-04 11:24:14 +02:00
' Current scaled dimensions
dim fullscaledw as single:fullscaledw=imgw*state.zoom
dim fullscaledh as single:fullscaledh=imgh*state.zoom
2026-05-04 11:24:14 +02:00
' Calculate visible area in screen coordinates (Overlap of image and viewport)
drawx1=state.offsetx
drawy1=state.offsety
drawx2=state.offsetx+fullscaledw
drawy2=state.offsety+fullscaledh
2026-05-04 11:24:14 +02:00
' Clip the destination to the Viewport
if drawx1<viewx1 then drawx1=viewx1
if drawy1<viewy1 then drawy1=viewy1
if drawx2>viewx2 then drawx2=viewx2
if drawy2>viewy2 then drawy2=viewy2
2026-05-04 11:24:14 +02:00
' Only draw if the image is actually inside the viewport
if drawx2>drawx1 and drawy2>drawy1 then
2026-05-04 11:24:14 +02:00
' Map screen-clipped coordinates back to the source image coordinates
srcx1=int((drawx1-state.offsetx)/state.zoom)
srcy1=int((drawy1-state.offsety)/state.zoom)
srcx2=int((drawx2-state.offsetx)/state.zoom)
srcy2=int((drawy2-state.offsety)/state.zoom)
2026-05-04 11:24:14 +02:00
' Syntax: _PUTIMAGE (destX1, destY1)-(destX2, destY2), sourceHandle, 0, (srcX1, srcY1)-(srcX2, srcY2)
_putimage (drawx1,drawy1)-(drawx2,drawy2),img,0,(srcx1,srcy1)-(srcx2,srcy2)
2026-05-04 11:24:14 +02:00
end if
2026-04-29 21:17:20 +02:00
next
_dest layers(2).ihandle:cls,0:_dest 0
2026-05-04 12:30:34 +02:00
' 2.5 if the mouse is in ui thats all we need
2026-05-19 12:23:01 +02:00
if showtoolbox then
if _mousex>=0 and _mousex<=70 then
2026-05-04 12:30:34 +02:00
exit sub
end if
end if
if showcolorpicker then
if _mousey>=_height-20 then
2026-05-04 12:30:34 +02:00
exit sub
end if
end if
2026-05-06 13:28:56 +02:00
if showcommands then
if _mousex>=drawx2 then
2026-05-06 13:28:56 +02:00
exit sub
end if
end if
2026-05-01 00:30:34 +02:00
' 3. Calculate Canvas Coordinates
dim canx as long
dim cany as long
canx=int((_mousex-state.offsetx)/state.zoom)
cany=int((_mousey-state.offsety)/state.zoom)
2026-05-04 12:14:29 +02:00
static drawcol
if _mousebutton(1) then drawcol=state.fcolor
if _mousebutton(2) then drawcol=state.bcolor
2026-05-18 14:05:35 +02:00
if (mousedown or rmousedown) and state.isdrawing=0 then
state.startx=canx
state.starty=cany
state.isdrawing=-1
end if
2026-05-18 14:05:35 +02:00
select case state.tool
case 1
do.pencil canx,cany,drawcol
2026-05-18 14:05:35 +02:00
case 2
do.line state.startx,state.starty,canx,cany,drawcol
2026-05-18 14:05:35 +02:00
case 3
do.circle state.startx,state.starty,sqr((canx-state.startx)^2+(cany-state.starty)^2),drawcol
2026-05-18 14:05:35 +02:00
case 4
do.fcircle state.startx,state.starty,sqr((canx-state.startx)^2+(cany-state.starty)^2),drawcol
2026-05-18 14:05:35 +02:00
case 5
do.box state.startx,state.starty,canx,cany,drawcol
2026-05-18 14:05:35 +02:00
case 6
do.fbox state.startx,state.starty,canx,cany,drawcol
2026-05-18 14:05:35 +02:00
case 7
do.polygon canx,cany
2026-05-18 14:05:35 +02:00
case 8
do.fpolygon canx,cany
2026-05-18 14:05:35 +02:00
case 9
do.floodfill canx,cany,drawcol
2026-05-18 14:05:35 +02:00
case 10
do.eyedropper canx,cany
2026-05-21 09:22:52 +02:00
case 11
do.gradient state.startx,state.starty,canx,cany
2026-05-18 14:05:35 +02:00
end select
2026-04-29 09:28:35 +02:00
end sub
sub do.pencil(x as long,y as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
_dest layers(1).ihandle
if _mousebutton(1) or _mousebutton(2) then
thickpixel x,y,col
addcommand"pixel ("+tst(x)+","+tst(y)+","+hex$(col)+")"
2026-05-19 12:23:01 +02:00
end if
state.isdrawing=0
2026-05-19 12:23:01 +02:00
_dest odest
2026-05-18 14:05:35 +02:00
end sub
sub do.line(sx as long,sy as long,ex as long,ey as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"line ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+","+hex$(col)+")"
state.isdrawing=0
2026-05-19 12:23:01 +02:00
else
_dest layers(2).ihandle
end if
thickline sx,sy,ex,ey,col
2026-05-19 12:23:01 +02:00
_source osource
_dest odest
end if
2026-05-18 14:05:35 +02:00
end sub
sub do.circle (x as long,y as long,r as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"circle ("+tst(x)+","+tst(y)+","+tst(int(r))+","+hex$(col)+")"
state.isdrawing=0
2026-05-19 12:23:01 +02:00
else
_dest layers(2).ihandle
end if
thickcircle x,y,r,col
2026-05-19 12:23:01 +02:00
_source osource
_dest odest
end if
2026-05-18 14:05:35 +02:00
end sub
sub do.fcircle (x as long,y as long,r as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"fcircle ("+tst(x)+","+tst(y)+","+tst(int(r))+","+hex$(col)+")"
state.isdrawing=0
2026-05-19 12:23:01 +02:00
else
_dest layers(2).ihandle
end if
filledcircle x,y,r,col
2026-05-19 12:23:01 +02:00
_source osource
_dest odest
end if
2026-05-18 14:05:35 +02:00
end sub
2026-05-19 10:34:20 +02:00
sub do.box(sx as long,sy as long,ex as long,ey as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"box ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+","+hex$(col)+")"
state.isdrawing=0
2026-05-19 12:23:01 +02:00
else
_dest layers(2).ihandle
end if
thickbox sx,sy,ex,ey,col
_source osource
_dest odest
end if
2026-05-18 14:05:35 +02:00
end sub
2026-05-19 10:34:20 +02:00
sub do.fbox(sx as long,sy as long,ex as long,ey as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"fbox ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+","+hex$(col)+")"
state.isdrawing=0
2026-05-19 12:23:01 +02:00
else
_dest layers(2).ihandle
end if
filledbox sx,sy,ex,ey,col
_source osource
_dest odest
end if
2026-05-18 14:05:35 +02:00
end sub
sub do.polygon(x as long,y as long)
2026-05-19 12:23:01 +02:00
' 1. Internalized State Memory
static polypoints(500) as long
static pointcount as integer
2026-05-19 10:34:20 +02:00
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
dim p as integer
dim i as integer
dim tmpstr as string
2026-05-18 14:05:35 +02:00
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
' If left-clicked, add the coordinate to this routine's local array
if mouseclicked then
polypoints(pointcount*2)=x
polypoints(pointcount*2+1)=y
pointcount=pointcount+1
2026-05-19 10:34:20 +02:00
end if
2026-05-19 12:23:01 +02:00
' Finish shape on Right-Click
if rmouseclicked and pointcount>2 then
2026-05-19 12:23:01 +02:00
_dest layers(1).ihandle
redim finalp(pointcount*2-1) as long
for p=0 to (pointcount*2)-1:finalp(p)=polypoints(p):next
2026-05-19 12:23:01 +02:00
polygon finalp(),state.fcolor
2026-05-19 12:23:01 +02:00
tmpstr="polygon ("
for i=0 to ubound(finalp)-1
tmpstr=tmpstr+tst(finalp(i))+","
2026-05-19 12:23:01 +02:00
next i
tmpstr=tmpstr+tst(finalp(i))+")"
2026-05-19 12:23:01 +02:00
addcommand tmpstr
' Clean up local tool state
state.isdrawing=0
pointcount=0
2026-05-19 12:23:01 +02:00
else
' Live preview rendering loop
_dest layers(2).ihandle
if pointcount>0 then
for p=1 to pointcount-1
thickline polypoints((p-1)*2),polypoints((p-1)*2+1),polypoints(p*2),polypoints(p*2+1),state.fcolor
2026-05-19 12:23:01 +02:00
next p
thickline polypoints((pointcount-1)*2),polypoints((pointcount-1)*2+1),x,y,state.fcolor
2026-05-19 12:23:01 +02:00
end if
end if
_source osource
_dest odest
2026-05-19 10:34:20 +02:00
end if
2026-05-18 14:05:35 +02:00
end sub
sub do.fpolygon(x as long,y as long)
2026-05-19 12:23:01 +02:00
' 1. Internalized State Memory
static polypoints(500) as long
static pointcount as integer
2026-05-19 10:34:20 +02:00
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
dim p as integer
dim i as integer
dim tmpstr as string
2026-05-18 14:05:35 +02:00
if state.isdrawing then
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
' If left-clicked, add the coordinate to this routine's local array
if mouseclicked then
polypoints(pointcount*2)=x
polypoints(pointcount*2+1)=y
pointcount=pointcount+1
2026-05-19 12:23:01 +02:00
end if
' Finish shape on Right-Click
if rmouseclicked and pointcount>2 then
2026-05-19 12:23:01 +02:00
_dest layers(1).ihandle
redim finalp(pointcount*2-1) as long
for p=0 to (pointcount*2)-1:finalp(p)=polypoints(p):next
2026-05-19 12:23:01 +02:00
filledpolygon finalp(),state.fcolor
2026-05-19 12:23:01 +02:00
tmpstr="fpolygon ("
for i=0 to ubound(finalp)-1
tmpstr=tmpstr+tst(finalp(i))+","
2026-05-19 12:23:01 +02:00
next i
tmpstr=tmpstr+tst(finalp(i))+")"
2026-05-19 12:23:01 +02:00
addcommand tmpstr
' Clean up local tool state
state.isdrawing=0
pointcount=0
2026-05-19 12:23:01 +02:00
else
' Live preview rendering loop
_dest layers(2).ihandle
if pointcount>0 then
for p=1 to pointcount-1
thickline polypoints((p-1)*2),polypoints((p-1)*2+1),polypoints(p*2),polypoints(p*2+1),state.fcolor
2026-05-19 12:23:01 +02:00
next p
thickline polypoints((pointcount-1)*2),polypoints((pointcount-1)*2+1),x,y,state.fcolor
2026-05-19 12:23:01 +02:00
end if
2026-05-19 10:34:20 +02:00
end if
2026-05-19 12:23:01 +02:00
_source osource
_dest odest
2026-05-19 10:34:20 +02:00
end if
2026-05-18 14:05:35 +02:00
end sub
sub do.floodfill(x as long,y as long,col as long)
2026-05-19 12:23:01 +02:00
dim osource as long
dim odest as long
osource=_source
odest=_dest
2026-05-19 12:23:01 +02:00
if mouseclicked or rmouseclicked then
_source layers(1).ihandle
_dest layers(1).ihandle
' Check if either Left Shift (100303) or Right Shift (100304) is held down
if _keydown(100303) or _keydown(100304) then
' Fill until it hits the background color as a border
boundaryfill x,y,col,state.bcolor
addcommand"boundaryfill ("+tst(x)+","+tst(y)+","+hex$(col)+","+hex$(state.bcolor)+")"
else
' Standard color-replace flood fill
floodfill x,y,col
addcommand"floodfill ("+tst(x)+","+tst(y)+","+hex$(col)+")"
end if
state.isdrawing=0
2026-05-19 12:23:01 +02:00
_source osource
_dest odest
end if
2026-05-18 14:05:35 +02:00
end sub
sub do.eyedropper(x as long,y as long)
2026-05-19 12:23:01 +02:00
dim osource as long
if _mousebutton(1) or _mousebutton(2) then
osource=_source
_source layers(1).ihandle ' Read from the main drawing layer
' Ensure the coordinates are within the canvas boundaries
if x>=0 and x<_width(layers(1).ihandle) and y>=0 and y<_height(layers(1).ihandle) then
' Left click sets foreground color, Right click sets background color
if _mousebutton(1) then
state.fcolor=point(x,y)
addcommand"fcolor ("+hex$(point(x,y))+")"
elseif _mousebutton(2) then
state.bcolor=point(x,y)
addcommand"bcolor ("+hex$(point(x,y))+")"
end if
end if
state.isdrawing=0
_source osource
end if
2026-05-18 14:05:35 +02:00
end sub
2026-05-21 09:22:52 +02:00
sub do.gradient(sx as long,sy as long,ex as long,ey as long)
dim osource as long
dim odest as long
if state.isdrawing then
osource=_source
odest=_dest
if mouseclicked or rmouseclicked then
_dest layers(1).ihandle
addcommand"gradient ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+")"
state.isdrawing=0
ditheredgradient sx,sy,ex,ey,state.fcolor,state.bcolor
else
_dest layers(2).ihandle
thickline sx,sy,ex,ey,state.fcolor
end if
_source osource
_dest odest
end if
end sub
2026-04-30 10:09:05 +02:00
function icon (index as long)
2026-04-29 09:28:35 +02:00
static init as integer
static icons() as long
if not init then
2026-04-30 10:09:05 +02:00
redim icons(19) as long ' Room for 20 icons
2026-05-20 22:38:36 +02:00
dim c as _unsigned long:c=highlightcolor ' Main icon color
' --- 1. Pencil Tool ---
icons(0)=_newimage(32,32,32):_dest icons(0)
line (6,26)-(22,10),c
line (22,10)-(26,6),c
line (26,6)-(26,10),c
line (26,10)-(10,26),c
line (10,26)-(6,26),c
pset (7,25),c ' Tip point
_dest 0
' --- 2. Line Tool ---
icons(1)=_newimage(32,32,32):_dest icons(1)
line (5,27)-(27,5),c
_dest 0
' --- 3. Hollow Circle ---
icons(2)=_newimage(32,32,32):_dest icons(2)
circle (16,16),11,c
_dest 0
' --- 4. Filled Circle ---
icons(3)=_newimage(32,32,32):_dest icons(3)
2026-05-20 22:38:36 +02:00
filledcircle 16,16,11,c
_dest 0
2026-05-04 13:49:56 +02:00
' --- 5. Hollow Box ---
icons(4)=_newimage(32,32,32):_dest icons(4)
line (6,6)-(26,26),c,b
2026-05-01 00:30:34 +02:00
_dest 0
2026-05-04 13:49:56 +02:00
' --- 6. Filled Box ---
icons(5)=_newimage(32,32,32):_dest icons(5)
line (6,6)-(26,26),c,bf
_dest 0
' --- 7. Hollow Polygon (Triangle Blueprint) ---
icons(6)=_newimage(32,32,32):_dest icons(6)
line (16,5)-(6,25),c
line (6,25)-(26,25),c
line (26,25)-(16,5),c
_dest 0
' --- 8. Filled Polygon ---
icons(7)=_newimage(32,32,32):_dest icons(7)
dim py as integer
for py=5 to 25
dim hw as integer:hw=(py-5)*10/20
line (16-hw,py)-(16+hw,py),c
next py
2026-05-01 00:30:34 +02:00
_dest 0
' --- 9. Floodfill (Paint Bucket) ---
icons(8)=_newimage(32,32,32):_dest icons(8)
line (8,14)-(20,26),c ' Main body tilt left
line (20,26)-(26,20),c
line (26,20)-(14,8),c
line (14,8)-(8,14),c
2026-05-20 22:38:36 +02:00
circle (14,11),6,c,_pi(1.5),_pi(1)
pset (6,28),c ' Spilling drip point
2026-05-01 13:58:36 +02:00
_dest 0
' --- 10. Eyedropper ---
icons(9)=_newimage(32,32,32):_dest icons(9)
line (6,26)-(10,22),c ' Pipette tip
line (10,22)-(22,10),c ' Shaft side A
line (6,26)-(18,14),c ' Bottom point accent
line (14,18)-(26,6),c ' Shaft side B
line (22,10)-(26,6),c ' Squeeze bulb cap
_dest 0
' Fill remaining fallback slots (10-19) with clean blank images
2026-04-30 10:09:05 +02:00
dim j as integer
for j=10 to 19
if icons(j)=0 then icons(j)=_newimage(32,32,32)
2026-04-30 10:09:05 +02:00
next
2026-05-04 13:49:56 +02:00
init=-1
2026-04-29 09:28:35 +02:00
end if
2026-04-30 10:09:05 +02:00
if index>=0 and index<=19 then
icon=icons(index)
2026-04-30 10:09:05 +02:00
else
icon=icons(9)
2026-04-29 09:28:35 +02:00
end if
end function
'$include: 'include/ui.bm'
'$include: 'include/imgout.bm'
'$include: 'include/palette.bm'
2026-04-30 13:16:00 +02:00
'$include: 'include/tools.bm'
2026-05-04 11:24:14 +02:00
''$include: 'include/effects.bm'
2026-04-29 09:28:35 +02:00
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
2026-05-04 13:49:56 +02:00
if mode<3 then
2026-04-29 09:28:35 +02:00
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
2026-05-04 13:49:56 +02:00
2026-04-29 09:28:35 +02:00
icons(1)=_newimage(23,23,32) 'Down arrow'
_dest icons(1)
color textcolor
2026-05-04 13:49:56 +02:00
2026-04-29 09:28:35 +02:00
icons(2)=_newimage(23,23,32) 'Left arrow'
_dest icons(2)
color textcolor
2026-05-04 13:49:56 +02:00
2026-04-29 09:28:35 +02:00
icons(3)=_newimage(23,23,32) 'Right arrow'
2026-05-04 13:49:56 +02:00
_dest icons(3)
2026-04-29 09:28:35 +02:00
color textcolor
2026-05-04 13:49:56 +02:00
2026-04-29 09:28:35 +02:00
_dest 0
init=-1
end if
2026-05-04 13:49:56 +02:00
2026-04-29 09:28:35 +02:00
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
2026-04-29 12:36:31 +02:00
function checkresize (currentscreen as _unsigned long) 'pulled straight out of the wiki'
dim tempscreen as _unsigned long
checkresize=0
2026-05-19 12:23:01 +02:00
if _resize then
tempscreen=_copyimage(currentscreen,32)
screen tempscreen
_freeimage currentscreen
currentscreen=_newimage(_resizewidth,_resizeheight,32)
screen currentscreen
_putimage (0,0),tempscreen,currentscreen
2026-05-19 12:23:01 +02:00
_display
_freeimage tempscreen
checkresize=-1
2026-05-19 12:23:01 +02:00
end if
end function
2026-05-04 13:49:56 +02:00
sub menu()
2026-05-19 12:23:01 +02:00
dim logo as long
dim filename as string
' A logo is needed'
'logo=_loadimage("logo.png")
line (0,0)-(_width-1,_height-1),_rgb32(0,192),bf
'_putimage ((_width(0)-_width(logo))/2,10),logo
dim i as integer
dim fh as integer
do until done
k$=inkey$
while _mouseinput:wend
mouseclicked=mbd and not _mousebutton(1)
mbd=_mousebutton(1)
if link(10,10,"open") then
filename=textinput(10,10,100,23,"")
if filename=""then exit sub
fh=freefile
2026-05-19 12:23:01 +02:00
redim commands(2000) as string
open filename for input as fh
do until eof(fh)
line input #fh,commands(i)
2026-05-19 12:23:01 +02:00
i=i+1
if i>ubound(commands) then redim _preserve commands(ubound(commands)*2) as string
loop
close fh
redim _preserve commands(i-1) as string
redraw
done=-1
end if
if link(10,34,"save") then
filename=textinput(1,34,100,23,"")
if filename=""then exit sub
fh=freefile
2026-05-19 12:23:01 +02:00
open filename for output as fh
for i=0 to ubound(commands)
print #fh,commands(i)
2026-05-19 12:23:01 +02:00
next i
close fh
done=-1
end if
if link(10,56,"export") then
filename=textinput(10,56,100,23,"")
if filename=""then exit sub
2026-05-19 12:23:01 +02:00
select case lcase$(right$(filename,4))
case ".png"
save32bitpng layers(1).ihandle,filename
2026-05-19 12:23:01 +02:00
case ".bmp"
save24bitbmp layers(1).ihandle,filename
2026-05-19 12:23:01 +02:00
case ".ppm"
savebinaryppm layers(1).ihandle,filename
2026-05-19 12:23:01 +02:00
case else
save32bitpng layers(1).ihandle,filename
2026-05-19 12:23:01 +02:00
end select
done=-1
end if
if link(10,78,"refenece img") then
filename=textinput(10,78,100,23,"")
if filename=""then exit sub
2026-05-19 12:23:01 +02:00
if not _fileexists(filename) then exit sub
if layers(3).ihandle<>0 then _freeimage layers(3).ihandle
2026-05-19 12:23:01 +02:00
layers(3).ihandle=_loadimage(filename)
_setalpha 20,layers(3).ihandle
2026-05-19 12:23:01 +02:00
done=-1
end if
if link(10,100,"exit") then system
if k$=chr$(27) then done=-1
_limit 30
_display
loop
2026-05-04 13:49:56 +02:00
end sub
2026-05-11 10:03:44 +02:00
sub palettemanager(col as _unsigned long)
line (0,0)-(_width-1,_height-1),col,bf
'TODO: build palette mamager ui
end sub
function closestcolor~& (colour as _unsigned long,carr() as _unsigned long)
dim r as integer
dim g as integer
dim b as integer
2026-05-19 12:23:01 +02:00
dim ar as integer
dim ag as integer
dim ab as integer
dim i as integer
2026-05-19 12:23:01 +02:00
dim nearest as integer
dim shortestdistance as integer
dim distance as integer
r=_red (colour)
g=_green(colour)
b=_blue (colour)
shortestdistance=443
for i=0 to ubound(carr)
ar=_red (carr(i))
ag=_green(carr(i))
ab=_blue (carr(i))
distance=sqr((r-ar) ^ 2+(g-ag) ^ 2+(b-ab) ^ 2)
if distance<=shortestdistance then shortestdistance=distance:nearest=i
2026-05-19 12:23:01 +02:00
next i
closestcolor=carr(nearest)
2026-05-19 12:23:01 +02:00
end function
' trimmed str$
function tst$(numb)
tst=_trim$(str$(numb))
end function