pixler/pixler.bas
visionmercer e343e06f1c integers!
2026-05-04 11:51:47 +02:00

450 lines
15 KiB
QBasic

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(640,350,32)
layers(1).ihandle=_newimage(640,350,32)
layers(2).ihandle=_newimage(640,350,32)
layers(3).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 = 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 the current world position under the mouse
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
state.zoom = state.zoom + (mw * 0.1 * state.zoom) ' Multiplier makes it feel smoother
if state.zoom < 0.05 then state.zoom = 0.05
if state.zoom > 20 then state.zoom = 20
' 3. Adjust offsets so the world position stays under the mouse
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
'TODO: main 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
' 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 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 = 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