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 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(3) as layertype dim shared state as statetype dim shared showtoolbox as _byte: showtoolbox=-1 dim shared showcolorpicker as _byte: showcolorpicker=-1 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 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 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 = 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 dim mouseWorldX as single: mouseWorldX = (_mousex - state.offsetX) / state.zoom dim mouseWorldY as single: 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 and LOCK them to integers ' This prevents the canvas from sitting "between" screen pixels 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 case "-" if state.brushsize>1 then state.brushsize=state.brushsize-1 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 end select canvas if showtoolbox then toolbox if showcolorpicker then 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 ' 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: 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 drawX1 < viewX1 then drawX1 = viewX1 if drawY1 < viewY1 then drawY1 = viewY1 if drawX2 > viewX2 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 ' 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 ' 3. Calculate Canvas Coordinates dim canX as integer: canX = int((_mousex - state.offsetX) / state.zoom) dim canY as integer: 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 ' 4. Interaction Logic 'if _mousex > boxX1 then ' Start Drawing Logic if state.tool = 9 and (mouseclicked or rmouseclicked) then _dest layers(1).ihandle _source layers(1).ihandle if mouseclicked then floodfill canX,canY,state.fcolor else floodfill canX,canY,state.bcolor end if _dest 0 _source 0 exit sub end if if state.tool = 10 and (mouseclicked or rmouseclicked) then _dest layers(1).ihandle _source layers(1).ihandle if mouseclicked then state.fcolor=point(canX,canY) else state.bcolor=point(canX,canY) end if _dest 0 _source 0 exit sub end if if state.tool = 7 or state.tool = 8 then if mouseclicked then polypoints(pointCount * 2) = canX polypoints(pointCount * 2 + 1) = canY pointCount = pointCount + 1 state.isDrawing = -1 end if else if (mousedown or rmousedown) and state.isDrawing = 0 then state.startX = canX state.startY = canY state.isDrawing = -1 end if end if if state.isDrawing then ' We use Layer 2 as the temporary preview "rubber-band" layer _dest layers(2).ihandle cls , 0 select case state.tool case 1 ' Pencil _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 ' Circle dim r as single: r = sqr((canX - state.startX)^2 + (canY - state.startY)^2) thickcircle state.startX, state.startY, r + 1, drawCol case 4 ' Filled Circle dim r_f as single: r_f = sqr((canX - state.startX)^2 + (canY - state.startY)^2) filledcircle state.startX, state.startY, r_f, drawCol case 5 ' Rect 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 Rect line (state.startX, state.startY)-(canX, canY), drawCol, bf case 7, 8 ' Polygons 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), canX, canY, state.fcolor end if end select ' 5. Commit Logic dim commit as integer: commit = 0 if state.tool = 7 or state.tool = 8 then if rmouseclicked then commit = -1 else if (mousedown=0) and (rmousedown=0) then commit = -1 end if if commit then _dest layers(1).ihandle ' Final destination is always the drawing layer if (state.tool = 8 or state.tool=7) and pointCount > 2 then redim finalP(pointCount * 2 - 1) as long for p = 0 to (pointCount * 2) - 1: finalP(p) = polypoints(p): next if state.tool =8 then filledPolygon finalP(), state.fcolor else Polygon finalP(), state.fcolor else ' Merge the preview into the drawing layer _putimage , layers(2).ihandle, layers(1).ihandle end if _dest layers(2).ihandle: cls , 0 state.isDrawing = 0 pointCount = 0 end if end if 'end if _dest 0 ' Ensure we return to main screen 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 icons(6) = _newimage(32,32,32): _dest icons(6) line (5,15)-(15,5):line -(25,15):line -(20,25): line -(10,25):line -(5,15) _dest 0 icons(7) = _newimage(32, 32, 32): _dest icons(7) ' Draw a small filled shape for the filled polygon icon for fy = 10 to 20: line (10, fy)-(22, fy): next _dest 0 icons(8) = _newimage(32, 32, 32): _dest icons(8) ' Simple "Bucket" icon line (8, 10)-(24, 10): line -(26, 22): line -(6, 22): line -(8, 10) line (10, 8)-(22, 8) ' Handle _dest 0 ' Fill the remaining slots with blank 32x32 images dim j as integer for j = 0 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' ''$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() Line (0,0)-(_width-1,_height-1),_rgb32(0,1),bf do until done k$=inkey$ while _mouseinput:wend mouseclicked=mbd and not _mousebutton(1) mbd=_mousebutton(1) if button(10,10,60,23,"open") then system if button(10,34,60,23,"save") then system if button(10,56,60,23,"exit") then system if k$=chr$(27) then done=-1 _limit 30 _display loop end sub