type statetype tool as long fcolor as long bcolor as long offsetx as long offsety as long zoom as single brushsize as integer startx as long starty as long isdrawing as integer end type type layertype ihandle as long blendmode as long filter as long kind as long end type redim shared layers(3) as layertype dim shared state as statetype 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 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"slso8",pal() 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) _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 else line (x,y)-(x+16,y+16),_rgb32(192),bf end if next next _dest 0 state.tool=1 state.zoom=1.0 state.offsetx=70+20 state.offsety=20 state. brushsize=1 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)+")" dim lastmx,lastmy 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 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 canvas if showtoolbox then toolbox if showcolorpicker then colorpicker if showcommands then commandlist '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=int(state.offsetx+(_mousex-lastmx)) state.offsety=int(state.offsety+(_mousey-lastmy)) end if lastmx=_mousex:lastmy=_mousey ' Zooming if mw<>0 then ' 1. Capture current world position mouseworldx=(_mousex-state.offsetx)/state.zoom mouseworldy=(_mousey-state.offsety)/state.zoom ' 2. Calculate the new zoom level (Snap to whole numbers) if mw>0 then state.zoom=state.zoom+1 else state.zoom=state.zoom-1 end if ' 3. Constrain zoom (Min 1, Max 20) if state.zoom<1 then state.zoom=1 if state.zoom>20 then state.zoom=20 ' 4. Adjust offsets state.offsetx=_mousex-(mouseworldx*state.zoom) state.offsety=_mousey-(mouseworldy*state.zoom) mw=0 end if ' Keyboarding keyin=inkey$ select case keyin case "+" state.brushsize=state.brushsize+1 addcommand"brushsize ("+tst(state.brushsize)+")" case "-" if state.brushsize>1 then state.brushsize=state.brushsize-1 addcommand"brushsize ("+tst(state.brushsize)+")" case chr$(19) ' ctrl+s 'TODO: save logic case chr$(27) ' esc 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) case "t" showtoolbox=not showtoolbox case "c" showcolorpicker=not showcolorpicker case "l" showcommands=not showcommands end select _limit 30 _display line (0,0)-(_width-1,_height-1),backgroundcolor1,bf loop sub commandlist dim i as long dim listwidth as integer:listwidth=250 dim x as integer:x=_width-listwidth ' Draw background for the list line (x,0)-(_width-1,_height-1),backgroundcolor1,bf line (x,0)-(x,_height-1),backgroundcolor2 _printmode _keepbackground 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 end if next i if button(x,_height-25,60,23,"redraw") then redraw end sub sub redraw redim numarr(0) as long dim i as integer dim j as integer dim x as long dim y as long _dest layers(1).ihandle _source layers(1).ihandle cls,_rgb32(255) _clearcolor _rgb32(255) for i=lbound(commands) to ubound(commands) getnums commands(i),numarr() _dest layers(1).ihandle _source layers(1).ihandle select case lcase$(_trim$(left$(commands(i),instr(commands(i),"(")-1))) 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) 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 else line (x,y)-(x+16,y+16),_rgb32(192),bf end if next next 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 case "floodfill" floodfill numarr(0),numarr(1),numarr(2) case "" ' blank line do nothing case else 'debug info print"'"+lcase$(_trim$(left$(commands(i),instr(commands(i),"(")-1)))+"'" end select next i _dest 0 _source 0 end sub sub getnums (inputstr$,numarray() as long) ' 1. Extract inner content spos=instr(inputstr$,"(") epos=instr(inputstr$,")") if spos=0 or epos<=spos then exit sub content$=mid$(inputstr$,spos+1,epos-spos-1) idx=-1 ' Start at -1 so the first increment hits 0 ' 2. Parse segments do cpos=instr(content$,",") if cpos>0 then part$=ltrim$(rtrim$(left$(content$,cpos-1))) content$=mid$(content$,cpos+1) else part$=ltrim$(rtrim$(content$)) content$="" end if if len(part$)>0 then idx=idx+1 redim _preserve numarray(idx) as long ' 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 exit for end if next i if ishex then numarray(idx)=val("&H"+part$) else numarray(idx)=val(part$) end if end if loop while len(content$)>0 end sub 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 'colorindicator y=y+btnsize+16 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 palettemanager state.fcolor elseif clickregion(16,y+16,48,48) then palettemanager state.bcolor end if end sub sub colorpicker static img as long if img=0 then 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) addcommand"fcolor ("+hex$(pal(i))+")" case -2 state.bcolor=pal(i) addcommand"bcolor ("+hex$(pal(i))+")" end select next i end sub 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 ' 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 _dest 0 ' 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 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) ' Current scaled dimensions dim fullscaledw as single:fullscaledw=imgw*state.zoom dim fullscaledh as single:fullscaledh=imgh*state.zoom ' 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 ' Clip the destination to the Viewport if drawx1viewx2 then drawx2=viewx2 if drawy2>viewy2 then drawy2=viewy2 ' Only draw if the image is actually inside the viewport if drawx2>drawx1 and drawy2>drawy1 then ' 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) ' Syntax: _PUTIMAGE (destX1, destY1)-(destX2, destY2), sourceHandle, 0, (srcX1, srcY1)-(srcX2, srcY2) _putimage (drawx1,drawy1)-(drawx2,drawy2),img,0,(srcx1,srcy1)-(srcx2,srcy2) end if next _dest layers(2).ihandle:cls,0:_dest 0 ' 2.5 if the mouse is in ui thats all we need if showtoolbox then if _mousex>=0 and _mousex<=70 then exit sub end if end if if showcolorpicker then if _mousey>=_height-20 then exit sub end if end if if showcommands then if _mousex>=drawx2 then exit sub end if end if dim r as integer ' 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) static polypoints(200) as single static pointcount as integer static drawcol if _mousebutton(1) then drawcol=state.fcolor if _mousebutton(2) then drawcol=state.bcolor if (mousedown or rmousedown) and state.isdrawing=0 then state.startx=canx state.starty=cany state.isdrawing=-1 end if select case state.tool case 1 do.pencil canx,cany,drawcol case 2 do.line state.startx,state.starty,canx,cany,drawcol case 3 do.circle state.startx,state.starty,sqr((canx-state.startx)^2+(cany-state.starty)^2),drawcol case 4 do.fcircle state.startx,state.starty,sqr((canx-state.startx)^2+(cany-state.starty)^2),drawcol case 5 do.box state.startx,state.starty,canx,cany,drawcol case 6 do.fbox state.startx,state.starty,canx,cany,drawcol case 7 do.polygon canx,cany case 8 do.fpolygon canx,cany case 9 do.floodfill canx,cany,drawcol case 10 do.eyedropper canx,cany end select end sub sub do.pencil(x as long,y as long,col as long) dim osource as long dim odest as long osource=_source odest=_dest _dest layers(1).ihandle if _mousebutton(1) or _mousebutton(2) then thickpixel x,y,col addcommand"pixel ("+tst(x)+","+tst(y)+","+hex$(col)+")" end if state.isdrawing=0 _dest odest end sub sub do.line(sx as long,sy as long,ex as long,ey as long,col 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"line ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+","+hex$(col)+")" state.isdrawing=0 else _dest layers(2).ihandle end if thickline sx,sy,ex,ey,col _source osource _dest odest end if end sub sub do.circle (x as long,y as long,r as long,col 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"circle ("+tst(x)+","+tst(y)+","+tst(int(r))+","+hex$(col)+")" state.isdrawing=0 else _dest layers(2).ihandle end if thickcircle x,y,r,col _source osource _dest odest end if end sub sub do.fcircle (x as long,y as long,r as long,col 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"fcircle ("+tst(x)+","+tst(y)+","+tst(int(r))+","+hex$(col)+")" state.isdrawing=0 else _dest layers(2).ihandle end if filledcircle x,y,r,col _source osource _dest odest end if end sub sub do.box(sx as long,sy as long,ex as long,ey as long,col 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"box ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+","+hex$(col)+")" state.isdrawing=0 else _dest layers(2).ihandle end if thickbox sx,sy,ex,ey,col _source osource _dest odest end if end sub sub do.fbox(sx as long,sy as long,ex as long,ey as long,col 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"fbox ("+tst(sx)+","+tst(sy)+","+tst(ex)+","+tst(ey)+","+hex$(col)+")" state.isdrawing=0 else _dest layers(2).ihandle end if filledbox sx,sy,ex,ey,col _source osource _dest odest end if end sub sub do.polygon(x as long,y as long) ' 1. Internalized State Memory static polypoints(500) as long static pointcount as integer dim osource as long dim odest as long dim p as integer dim i as integer dim tmpstr as string if state.isdrawing then osource=_source odest=_dest ' 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 end if ' Finish shape on Right-Click if rmouseclicked and pointcount>2 then _dest layers(1).ihandle redim finalp(pointcount*2-1) as long for p=0 to (pointcount*2)-1:finalp(p)=polypoints(p):next polygon finalp(),state.fcolor tmpstr="polygon (" for i=0 to ubound(finalp)-1 tmpstr=tmpstr+tst(finalp(i))+"," next i tmpstr=tmpstr+tst(finalp(i))+")" addcommand tmpstr ' Clean up local tool state state.isdrawing=0 pointcount=0 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 next p thickline polypoints((pointcount-1)*2),polypoints((pointcount-1)*2+1),x,y,state.fcolor end if end if _source osource _dest odest end if end sub sub do.fpolygon(x as long,y as long) ' 1. Internalized State Memory static polypoints(500) as long static pointcount as integer dim osource as long dim odest as long dim p as integer dim i as integer dim tmpstr as string if state.isdrawing then osource=_source odest=_dest ' 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 end if ' Finish shape on Right-Click if rmouseclicked and pointcount>2 then _dest layers(1).ihandle redim finalp(pointcount*2-1) as long for p=0 to (pointcount*2)-1:finalp(p)=polypoints(p):next filledpolygon finalp(),state.fcolor tmpstr="fpolygon (" for i=0 to ubound(finalp)-1 tmpstr=tmpstr+tst(finalp(i))+"," next i tmpstr=tmpstr+tst(finalp(i))+")" addcommand tmpstr ' Clean up local tool state state.isdrawing=0 pointcount=0 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 next p thickline polypoints((pointcount-1)*2),polypoints((pointcount-1)*2+1),x,y,state.fcolor end if end if _source osource _dest odest end if end sub sub do.floodfill(x as long,y as long,col as long) dim osource as long dim odest as long osource=_source odest=_dest if mouseclicked or rmouseclicked then _source layers(1).ihandle _dest layers(1).ihandle floodfill x,y,col addcommand"floodfill ("+tst(x)+","+tst(y)+","+hex$(col)+")" state.isdrawing=0 _source osource _dest odest end if end sub sub do.eyedropper(x as long,y as long) 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 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 dim c as _unsigned long:c=_rgb32(255,255,255) ' 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) dim r as integer for r=0 to 11:circle (16,16),r,c:next r _dest 0 ' --- 5. Hollow Box --- icons(4)=_newimage(32,32,32):_dest icons(4) line (6,6)-(26,26),c,b _dest 0 ' --- 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 _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 ' Fixed syntax: Using valid multiplier expressions for the arc circle (14,11),6,c,_pi(1),_pi(1.5) pset (6,28),c ' Spilling drip point _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 dim j as integer for j=10 to 19 if icons(j)=0 then icons(j)=_newimage(32,32,32) next init=-1 end if if index>=0 and index<=19 then icon=icons(index) else icon=icons(9) end if end function '$include: 'include/ui.bm' '$include: 'include/imgout.bm' '$include: 'include/palette.bm' '$include: 'include/tools.bm' ''$include: 'include/effects.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 sub menu() 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 redim commands(2000) as string open filename for input as fh do until eof(fh) line input #fh,commands(i) 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 open filename for output as fh for i=0 to ubound(commands) print #fh,commands(i) 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 select case lcase$(right$(filename,4)) case ".png" save32bitpng layers(1).ihandle,filename case ".bmp" save24bitbmp layers(1).ihandle,filename case ".ppm" savebinaryppm layers(1).ihandle,filename case else save32bitpng layers(1).ihandle,filename end select done=-1 end if if link(10,78,"refenece img") then filename=textinput(10,78,100,23,"") if filename=""then exit sub if not _fileexists(filename) then exit sub if layers(3).ihandle<>0 then _freeimage layers(3).ihandle layers(3).ihandle=_loadimage(filename) _setalpha 20,layers(3).ihandle done=-1 end if if link(10,100,"exit") then system if k$=chr$(27) then done=-1 _limit 30 _display loop end sub 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 dim ar as integer dim ag as integer dim ab as integer dim i as integer 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 next i closestcolor=carr(nearest) end function ' trimmed str$ function tst$(numb) tst=_trim$(str$(numb)) end function