pixler/pixler.bas

373 lines
11 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
2026-04-30 10:09:05 +02:00
offsetX as single
offsetY as single
zoom as single
2026-04-30 13:16:00 +02:00
brushsize as integer
startX as integer
startY as integer
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
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
2026-04-29 09:28:35 +02:00
dim as integer ch1,ch2,ch3,bt
2026-05-01 00:30:34 +02:00
loadpalette "slso8",pal()
2026-04-29 21:17:20 +02:00
layers(0).ihandle=_newimage(640,350,32)
layers(1).ihandle=_newimage(640,350,32)
2026-04-30 13:16:00 +02:00
layers(2).ihandle=_newimage(640,350,32)
2026-05-01 00:30:34 +02:00
layers(3).ihandle=_newimage(640, 350, 32)
2026-04-29 21:17:20 +02:00
_dest layers(0).ihandle
line (0,0)-(_width-1,_height-1),_rgb32(255),bf
_dest 0
2026-04-30 10:09:05 +02:00
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
2026-04-30 13:16:00 +02:00
state. brushsize = 1
2026-04-30 10:09:05 +02:00
dim lastMX, lastMY
dim diffX as integer
dim diffY as integer
dim oldWidth as integer
dim oldHeight as integer
2026-04-30 13:16:00 +02:00
dim keyin as string
2026-04-29 09:28:35 +02:00
2026-04-30 10:09:05 +02:00
oldWidth=_width
oldHeight=_height
2026-04-29 09:28:35 +02:00
do
2026-04-30 10:09:05 +02:00
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
2026-04-29 09:28:35 +02:00
line (0,0)-(_width-1,_height-1),backgroundcolor1,bf
2026-04-30 10:09:05 +02:00
2026-04-30 13:16:00 +02:00
'Mouse Handling
while _mouseinput:mw=mw+_mousewheel:wend
2026-04-30 10:09:05 +02:00
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
2026-04-30 13:16:00 +02:00
' Keyboarding
keyin=inkey$
select case keyin
case "+"
state.brushsize=state.brushsize+1
case "-"
if state.brushsize>1 then state.brushsize=state.brushsize-1
2026-05-01 00:30:34 +02:00
case chr$(19) ' ctrl+s
'TODO: save logic
case chr$(27)' esc
'TODO: main menu
end select
canvas
2026-04-29 09:28:35 +02:00
toolbox
2026-04-30 13:16:00 +02:00
colorpicker
2026-04-30 10:09:05 +02:00
2026-04-29 09:28:35 +02:00
_limit 30
_display
loop
sub toolbox
2026-04-30 10:09:05 +02:00
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
2026-04-29 09:28:35 +02:00
end sub
sub colorpicker
2026-04-29 12:36:31 +02:00
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
2026-04-29 09:28:35 +02:00
end sub
sub canvas
2026-05-01 00:30:34 +02:00
dim boxX1 as integer: boxX1 = 70
2026-04-29 21:17:20 +02:00
dim boxWidth as integer: boxWidth = _width - 1 - boxX1
dim boxHeight as integer: boxHeight = _height - 20
2026-04-30 13:28:15 +02:00
static polypoints(200) as single
static pointCount as integer
2026-04-30 10:09:05 +02:00
2026-05-01 00:30:34 +02:00
_dest 0
2026-04-30 10:09:05 +02:00
line (boxX1, 0)-(_width - 1, boxHeight), _rgb32(32), bf
dim i as integer
2026-04-29 21:17:20 +02:00
for i = 0 to ubound(layers)
2026-04-30 10:09:05 +02:00
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
2026-04-29 21:17:20 +02:00
next
2026-05-01 00:30:34 +02:00
' 3. Calculate Canvas Coordinates
2026-04-30 13:16:00 +02:00
dim canX as integer: canX = (_mousex - state.offsetX) / state.zoom
dim canY as integer: canY = (_mousey - state.offsetY) / state.zoom
dim drawCol as _unsigned long
2026-04-30 13:28:15 +02:00
drawCol = state.fcolor
2026-04-30 13:16:00 +02:00
2026-05-01 00:30:34 +02:00
' 4. Interaction Logic
2026-04-30 13:16:00 +02:00
if _mousex > boxX1 then
2026-05-01 00:30:34 +02:00
' Start Drawing Logic
if state.tool = 7 or state.tool = 8 then
if mouseclicked then
2026-04-30 13:28:15 +02:00
polypoints(pointCount * 2) = canX
polypoints(pointCount * 2 + 1) = canY
pointCount = pointCount + 1
state.isDrawing = -1
2026-05-01 00:30:34 +02:00
end if
else
if (mousedown or rmousedown) and state.isDrawing = 0 then
2026-04-30 13:28:15 +02:00
state.startX = canX
state.startY = canY
state.isDrawing = -1
end if
2026-04-30 13:16:00 +02:00
end if
if state.isDrawing then
2026-05-01 00:30:34 +02:00
' We use Layer 2 as the temporary preview "rubber-band" layer
_dest layers(2).ihandle
2026-04-30 13:16:00 +02:00
cls , 0
select case state.tool
2026-05-01 11:29:53 +02:00
case 1 ' Pencil: This is the only tool that writes to Layer 1 IMMEDIATELY
2026-04-30 13:16:00 +02:00
_dest layers(1).ihandle
thickline state.startX, state.startY, canX, canY, drawCol
state.startX = canX: state.startY = canY
2026-05-01 00:30:34 +02:00
case 2 ' Straight Line
2026-04-30 13:16:00 +02:00
thickline state.startX, state.startY, canX, canY, drawCol
2026-04-30 13:28:15 +02:00
case 3 ' Circle
2026-04-30 13:16:00 +02:00
dim r as single: r = sqr((canX - state.startX)^2 + (canY - state.startY)^2)
2026-04-30 13:28:15 +02:00
thickcircle state.startX, state.startY, r + 1, drawCol
2026-04-30 13:16:00 +02:00
case 4 ' Filled Circle
2026-05-01 00:30:34 +02:00
dim r_f as single: r_f = sqr((canX - state.startX)^2 + (canY - state.startY)^2)
filledcircle state.startX, state.startY, r_f, drawCol
2026-04-30 13:28:15 +02:00
case 5 ' Rect
2026-04-30 13:16:00 +02:00
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
2026-04-30 13:28:15 +02:00
case 6 ' Filled Rect
2026-04-30 13:16:00 +02:00
line (state.startX, state.startY)-(canX, canY), drawCol, bf
2026-05-01 00:30:34 +02:00
case 7, 8 ' Polygons[cite: 2]
2026-04-30 13:28:15 +02:00
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), drawCol
next p
thickline polypoints((pointCount - 1) * 2), polypoints((pointCount - 1) * 2 + 1), canX, canY, drawCol
end if
2026-04-30 13:16:00 +02:00
end select
2026-05-01 00:30:34 +02:00
' 5. Commit Logic
dim commit as integer: commit = 0
2026-04-30 13:28:15 +02:00
if state.tool = 7 or state.tool = 8 then
2026-05-01 00:30:34 +02:00
if rmouseclicked then commit = -1
2026-04-30 13:28:15 +02:00
else
2026-05-01 00:30:34 +02:00
if mousedown = 0 then commit = -1
2026-04-30 13:28:15 +02:00
end if
2026-05-01 00:30:34 +02:00
if commit then
_dest layers(1).ihandle ' Final destination is always the drawing layer
2026-04-30 13:28:15 +02:00
if state.tool = 8 and pointCount > 2 then
2026-05-01 00:30:34 +02:00
redim finalP(pointCount * 2 - 1) as single
for p = 0 to (pointCount * 2) - 1: finalP(p) = polypoints(p): next
filledPolygon finalP(), drawCol ' Using tools.bm sub[cite: 2]
2026-04-30 13:28:15 +02:00
else
2026-05-01 00:30:34 +02:00
' Merge the preview into the drawing layer[cite: 1]
_putimage , layers(2).ihandle, layers(1).ihandle
2026-04-30 13:28:15 +02:00
end if
2026-05-01 00:30:34 +02:00
' Clear preview layer[cite: 1]
2026-04-30 13:28:15 +02:00
_dest layers(2).ihandle: cls , 0
2026-04-30 13:16:00 +02:00
state.isDrawing = 0
2026-05-01 00:30:34 +02:00
pointCount = 0
2026-04-30 10:09:05 +02:00
end if
end if
end if
2026-05-01 00:30:34 +02:00
_dest 0 ' Ensure we return to main screen[cite: 1]
2026-04-29 09:28:35 +02:00
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-04-29 09:28:35 +02:00
2026-04-30 10:09:05 +02:00
' 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
2026-05-01 00:30:34 +02:00
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
2026-04-30 10:09:05 +02:00
2026-05-01 00:30:34 +02:00
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
2026-04-30 10:09:05 +02:00
' Fill the remaining slots with blank 32x32 images
dim j as integer
2026-05-01 00:30:34 +02:00
for j = 0 to 19
2026-04-30 10:09:05 +02:00
if icons(j) = 0 then icons(j) = _newimage(32, 32, 32)
next
init = -1
2026-04-29 09:28:35 +02:00
end if
2026-04-30 10:09:05 +02:00
' Bounds checking to prevent returning 0 or crashing
if index >= 0 and index <= 19 then
icon = icons(index)
else
icon = icons(0)
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-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
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
2026-04-29 12:36:31 +02:00
2026-04-29 13:37:02 +02:00
FUNCTION CheckResize (CurrentScreen AS _UNSIGNED LONG) 'pulled straight out of the wiki'
2026-04-29 12:36:31 +02:00
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