From ecfaf41f9158c9ff3fdae246483992b48c974d51 Mon Sep 17 00:00:00 2001 From: visionmercer <62051836+visionmercer@users.noreply.github.com> Date: Wed, 29 Apr 2026 09:28:35 +0200 Subject: [PATCH] init --- include/effects.bm | 0 include/imgout.bm | 203 ++++++++++++++++++++++++++++++++ include/palette.bm | 160 +++++++++++++++++++++++++ include/ui.bm | 285 +++++++++++++++++++++++++++++++++++++++++++++ pixler.bas | 135 +++++++++++++++++++++ 5 files changed, 783 insertions(+) create mode 100644 include/effects.bm create mode 100644 include/imgout.bm create mode 100644 include/palette.bm create mode 100644 include/ui.bm create mode 100644 pixler.bas diff --git a/include/effects.bm b/include/effects.bm new file mode 100644 index 0000000..e69de29 diff --git a/include/imgout.bm b/include/imgout.bm new file mode 100644 index 0000000..633512a --- /dev/null +++ b/include/imgout.bm @@ -0,0 +1,203 @@ + +Sub SaveBinaryPPM (imageHandle As Long, fileName As String) + Dim r As _Unsigned _Byte + Dim g As _Unsigned _Byte + Dim b As _Unsigned _Byte + Dim fileHandle As Integer + Dim w As _Unsigned Long + Dim h As _Unsigned Long + Dim head As String + Dim fileout As String + Dim image As _MEM + Dim filebuffer As _MEM + Dim inPosition As _Offset + Dim outPosition As _Offset + Dim length As _Offset + image = _MemImage(imageHandle) + inPosition = image.OFFSET + w = _Width(imageHandle) + h = _Height(imageHandle) + length = inPosition + w * h * 4 + head = "P6" + Chr$(10) + head = head + "# Created with QB64" + Chr$(10) + head = head + LTrim$(Str$(w) + Str$(h)) + Chr$(10) + head = head + "255" + Chr$(10) + filebuffer = _MemNew(w * h * 3) + outPosition = filebuffer.OFFSET + Do + b = _MemGet(image, inPosition, _Unsigned _Byte) + g = _MemGet(image, inPosition + 1, _Unsigned _Byte) + r = _MemGet(image, inPosition + 2, _Unsigned _Byte) + _MemPut filebuffer, outPosition, r As _UNSIGNED _BYTE + _MemPut filebuffer, outPosition + 1, g As _UNSIGNED _BYTE + _MemPut filebuffer, outPosition + 2, b As _UNSIGNED _BYTE + inPosition = inPosition + 4 + outPosition = outPosition + 3 + Loop Until inPosition = length + fileout = Space$(w * h * 3) + _MemGet filebuffer, filebuffer.OFFSET, fileout + fileHandle = FreeFile + Open fileName For Binary As fileHandle + Put fileHandle, , head + Put fileHandle, , fileout + Close fileHandle + _MemFree image + _MemFree filebuffer +End Sub + +Sub save24bitBmp (imageHandle As Long, fileName As String) + Dim oSource As Long + Dim ff As Long + Dim x As Long, y As Long + Dim header As String * 54 + Dim outBytes As String * 3 + Dim padding As String + oSource = _Source + _Source imageHandle + + header = "BM" + MKL$(_Width * _Height * 3 + 54) +_ + String$(4, 0) + MKL$(54) + MKL$(40) +_ + MKL$(_Width) + MKL$(_Height) +_ + MKI$(1) + MKI$(24) + MKL$(0) + MKL$(0) +_ + MKL$(11811) + MKL$(11811) + MKL$(0) + MKL$(0) + + If ((_Width * 3) Mod 4) Then padding$ = String$(4 - ((_width * 3) Mod 4), 0) + + ff = FreeFile + Open fileName For Binary As ff + Put ff, , header + For y = _Height - 1 To 0 Step -1 + For x = 0 To _Width - 1 + outBytes = Left$(MKL$(Point(x, y)), 3) + Put #ff, , outBytes + Next + put #ff, , padding + Next + Close ff + _Source oSource +End Sub + +Sub save8bitPNG (imagehandle As Long, filename As String) + Dim PngHeader As String + Dim IHDR As String + Dim IDAT As String + Dim IEND As String + Dim PLTE As String + Dim x As _Unsigned Long, y As _Unsigned Long + Dim colorvalue As _Unsigned Long + Dim chunksize As String + Dim ff As Long + Dim imageData As String + dim sourceMem as _mem + dim c As _Unsigned _byte + sourceMem = _memimage(imagehandle) + PngHeader = chr$(137) + "PNG" + Chr$(13) + Chr$(10) + Chr$(26) + Chr$(10) + IHDR = "IHDR" + MKL$(FlipBytes(_Width(imagehandle))) + MKL$(FlipBytes(_Height(imagehandle))) + Chr$(8) + Chr$(3) + String$(3, 0) + IHDR = MKL$(FlipBytes(&H0D)) + IHDR + MKL$(FlipBytes(crc32(IHDR))) + IEND = MKL$(0) + "IEND" + MKL$(FlipBytes(&HAE426082)) + PLTE = "PLTE" + for c = 0 to 255 + PLTE = PLTE + chr$(_Red32(_PaletteColor(c))) + PLTE = PLTE + chr$(_Green32(_PaletteColor(c))) + PLTE = PLTE + chr$(_Blue32(_PaletteColor(c))) + Next + PLTE = mkl$(FlipBytes(256 * 3)) + PLTE + MKL$(FlipBytes(crc32(PLTE))) + + imageData = string$(_Height(imagehandle) * _Width(imagehandle) + _Height(imagehandle), 0) + + For y = 0 To _Height(imagehandle) - 1 + For x = 0 To _Width(imagehandle) - 1 + c = _memget(sourceMem, sourceMem.OFFSET + bytecount + 0, _Unsigned _byte) + asc(imageData,bytecount + y + 2) = c + bytecount = bytecount + 1 + Next x + Next y + _memfree sourceMem + IDAT = _Deflate$(imageData) + chunksize = MKL$(FlipBytes(Len(IDAT))) + IDAT = "IDAT" + IDAT + IDAT = IDAT + MKL$(FlipBytes(crc32(IDAT))) + IDAT = chunksize + IDAT + ff = FreeFile + Open filename For Output As ff: Close ff + Open filename For Binary As ff + Put ff, , PngHeader + Put ff, , IHDR + put ff, , PLTE + Put ff, , IDAT + Put ff, , IEND + Close ff +End Sub + +Sub save32bitPNG (imagehandle As Long, filename As String) + Dim PngHeader As String + Dim IHDR As String + Dim IDAT As String + Dim IEND As String + Dim x As _Unsigned Long, y As _Unsigned Long + Dim colorvalue As _Unsigned Long + Dim chunksize As String + Dim ff As Long + Dim imageData As String + dim sourceMem as _mem + dim as _Unsigned _byte r, g, b + sourceMem = _memimage(imagehandle) + PngHeader = chr$(137) + "PNG" + Chr$(13) + Chr$(10) + Chr$(26) + Chr$(10) + IHDR = "IHDR" + MKL$(FlipBytes(_Width(imagehandle))) + MKL$(FlipBytes(_Height(imagehandle))) + Chr$(8) + Chr$(6) + String$(3, 0) + IHDR = MKL$(FlipBytes(&H0D)) + IHDR + MKL$(FlipBytes(crc32(IHDR))) + IEND = MKL$(0) + "IEND" + MKL$(FlipBytes(&HAE426082)) + imageData = string$(_Height(imagehandle) * _Width(imagehandle) * 4 + _Height(imagehandle), 0) + + For y = 0 To _Height(imagehandle) - 1 + For x = 0 To _Width(imagehandle) - 1 + b = _memget(sourceMem, sourceMem.OFFSET + bytecount + 0, _Unsigned _byte) + g = _memget(sourceMem, sourceMem.OFFSET + bytecount + 1, _Unsigned _byte) + r = _memget(sourceMem, sourceMem.OFFSET + bytecount + 2, _Unsigned _byte) + a = _memget(sourceMem, sourceMem.OFFSET + bytecount + 3, _Unsigned _byte) + + asc(imageData,bytecount + y + 2) = r + asc(imageData,bytecount + y + 3) = g + asc(imageData,bytecount + y + 4) = b + asc(imageData,bytecount + y + 5) = a + bytecount = bytecount + 4 + Next x + Next y + _memfree sourceMem + IDAT = _Deflate$(imageData) + chunksize = MKL$(FlipBytes(Len(IDAT))) + IDAT = "IDAT" + IDAT + IDAT = IDAT + MKL$(FlipBytes(crc32(IDAT))) + IDAT = chunksize + IDAT + ff = FreeFile + Open filename For Output As ff: Close ff + Open filename For Binary As ff + Put ff, , PngHeader + Put ff, , IHDR + Put ff, , IDAT + Put ff, , IEND + Close ff +End Sub + +Function FlipBytes~& (value As _Unsigned Long) + FlipBytes~& = (value \ 16777216)_ + Or (value * 16777216)_ + Or ((value And 16711680) \ 256)_ + Or ((value And 65280) * 256) +End Function + +Function crc32~& (IN$) + Dim As _Unsigned Long CRC32_POLY, CRC + CRC32_POLY = &HEDB88320 + CRC = &HFFFFFFFF + For I = 1 To Len(IN$) + CRC = CRC Xor Asc(IN$, I) + For J = 1 To 8 + If CRC And 1 Then + CRC = (CRC \ 2) Xor CRC32_POLY + Else + CRC = CRC \ 2 + End If + Next J + Next I + crc32~& = Not CRC +End Function \ No newline at end of file diff --git a/include/palette.bm b/include/palette.bm new file mode 100644 index 0000000..3014be7 --- /dev/null +++ b/include/palette.bm @@ -0,0 +1,160 @@ +sub loadpalette(palname as string, palarray() as _unsigned long) +Dim SLSO8(7) As _Unsigned Long +select case lcase$(palname) + case "slso8" + redim palarray(7) as _unsigned long + palarray(0) = &HFF0D2B45 + palarray(1) = &HFF203C56 + palarray(2) = &HFF544E68 + palarray(3) = &HFF8D697A + palarray(4) = &HFFD08159 + palarray(5) = &HFFFFAA5E + palarray(6) = &HFFFFD4A3 + palarray(7) = &HFFFFECD6 + case "endesga16" + redim palarray(15) as _Unsigned Long + palarray( 0) = &HFFe4a672 + palarray( 1) = &HFFb86f50 + palarray( 2) = &HFF743f39 + palarray( 3) = &HFF3f2832 + palarray( 4) = &HFF9e2835 + palarray( 5) = &HFFe53b44 + palarray( 6) = &HFFfb922b + palarray( 7) = &HFFffe762 + palarray( 8) = &HFF63c64d + palarray( 9) = &HFF327345 + palarray(10) = &HFF193d3f + palarray(11) = &HFF4f6781 + palarray(12) = &HFFafbfd2 + palarray(13) = &HFFffffff + palarray(14) = &HFF2ce8f4 + palarray(15) = &HFF0484d1 + case "kinkan" + redim palarray(7) as _Unsigned Long + palarray(0) = &HFF446176 + palarray(1) = &HFF3EAAAE + palarray(2) = &HFF8CEFB6 + palarray(3) = &HFFC4F0C2 + palarray(4) = &HFFFFFEE4 + palarray(5) = &HFFBEC0C0 + palarray(6) = &HFFFFA7B9 + palarray(7) = &HFFFF7A8F + case "custodian-8" + redim palarray(7) as _Unsigned Long + palarray(0) = &HFF2b3634 + palarray(1) = &HFF474848 + palarray(2) = &HFF6e5f52 + palarray(3) = &HFFa2856c + palarray(4) = &HFFa0a294 + palarray(5) = &HFFdcb9a0 + palarray(6) = &HFFf3dbc6 + palarray(7) = &HFFfffefe + case "greyteen" + redim palarray(17) as _unsigned long + palarray( 0) = &hff272524 + palarray( 1) = &hff444140 + palarray( 2) = &hf626368 + palarray( 3) = &hff918783 + palarray( 4) = &hffa7a8b9 + palarray( 5) = &hffd7c7c0 + palarray( 6) = &hffdadceb + palarray( 7) = &hfff2ece9 + palarray( 8) = &hff4e393a + palarray( 9) = &hff7d5c51 + palarray(10) = &hffcd9f83 + palarray(11) = &hffebd8a3 + palarray(12) = &hff95ae91 + palarray(13) = &hff5a7054 + palarray(14) = &hff3f4459 + palarray(15) = &hff7b8caa + palarray(16) = &hffb0c6d5 + palarray(17) = &hff745e72 + case "ega" + redim palarray(63) As _unsigned Long + palarray( 0) = &hff000000 + palarray( 1) = &hff000055 + palarray( 2) = &hff0000aa + palarray( 3) = &hff0000ff + palarray( 4) = &hff550000 + palarray( 5) = &hff550055 + palarray( 6) = &hff5500aa + palarray( 7) = &hff5500ff + palarray( 8) = &hffaa0000 + palarray( 9) = &hffaa0055 + palarray(10) = &hffaa00aa + palarray(11) = &hffaa00ff + palarray(12) = &hffff0000 + palarray(13) = &hffff0055 + palarray(14) = &hffff00aa + palarray(15) = &hffff00ff + palarray(16) = &hff005500 + palarray(17) = &hff005555 + palarray(18) = &hff0055aa + palarray(19) = &hff0055ff + palarray(20) = &hff555500 + palarray(21) = &hff555555 + palarray(22) = &hff5555aa + palarray(23) = &hff5555ff + palarray(24) = &hffaa5500 + palarray(25) = &hffaa5555 + palarray(26) = &hffaa55aa + palarray(27) = &hffaa55ff + palarray(28) = &hffff5500 + palarray(29) = &hffff5555 + palarray(30) = &hffff55aa + palarray(31) = &hffff55ff + palarray(32) = &hff00aa00 + palarray(33) = &hff00aa55 + palarray(34) = &hff00aaaa + palarray(35) = &hff00aaff + palarray(36) = &hff55aa00 + palarray(37) = &hff55aa55 + palarray(38) = &hff55aaaa + palarray(39) = &hff55aaff + palarray(40) = &hffaaaa00 + palarray(41) = &hffaaaa55 + palarray(42) = &hffaaaaaa + palarray(43) = &hffaaaaff + palarray(44) = &hffffaa00 + palarray(45) = &hffffaa55 + palarray(46) = &hffffaaaa + palarray(47) = &hffffaaff + palarray(48) = &hff00ff00 + palarray(49) = &hff00ff55 + palarray(50) = &hff00ffaa + palarray(51) = &hff00ffff + palarray(52) = &hff55ff00 + palarray(53) = &hff55ff55 + palarray(54) = &hff55ffaa + palarray(55) = &hff55ffff + palarray(56) = &hffaaff00 + palarray(57) = &hffaaff55 + palarray(58) = &hffaaffaa + palarray(59) = &hffaaffff + palarray(60) = &hffffff00 + palarray(61) = &hffffff55 + palarray(62) = &hffffffaa + palarray(63) = &hffffffff + case else + redim palarray(1) as _unsigned long + if _fileexists(palname) then + dim fh as integer + dim i as integer + dim colorload as string + fh=freefile + open palname for input as fh + do until eof(fh) + line input #fh, colorload + i = i + 1 + if i > ubound(palarray) then + redim _preserve palarray(i) as _unsigned long + End If + palarray(i) = Val("&HFF" + colorload) + Loop + Close fh + else + palarray(0)=&hff000000 + palarray(1)=&hffffffff + end if + end select +end sub diff --git a/include/ui.bm b/include/ui.bm new file mode 100644 index 0000000..e729b8a --- /dev/null +++ b/include/ui.bm @@ -0,0 +1,285 @@ + +function button (x as integer,y as integer,w as integer,h as integer,caption as string) + if _mousex>x and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousex100 then tmpval=100 +vscrollbar=tmpval +end function + +function vbar(x as long,y as long,h as long,value as single) + dim tmpval as single + tmpval=value + if _mousex>x and _mousey>y and _mousex 100 then tmpval = 100 + hscrollbar = tmpval +end function + +function hbar(x as long, y as long, w as long, value as single) + dim tmpval as single + tmpval = value + if _mousex > x and _mousey > y and _mousex < x + w and _mousey < y + 23 then + drawhbar x, y, w, value, 1 + if _mousebutton(1) then tmpval=((_mousex-x)/(w))*100 + else + drawhbar x, y, w, value, 0 + end if + hbar = tmpval +end function + +sub drawbutton(x as integer,y as integer,w as integer,h as integer,caption as string, state as integer) + if state and 2 then + color backgroundcolor2 + line (x,y)-(x+w,y+h),,bf + else + color backgroundcolor2 + line (x,y)-(x+w,y+h),,bf + end if + if state and 1 then + color highlightcolor + line (x,y)-(x+w,y+h),,b + else + color textcolor + line (x,y)-(x+w,y+h),,b + end if + _printmode _keepbackground + _printstring (1+x+w/2-len(caption)*8/2,1+y+h/2-8),caption +end sub + +sub drawimagebutton(x as integer,y as integer,w as integer,h as integer,iconhandle as long, state as integer) + if state and 2 then + color backgroundcolor2 + line (x,y)-(x+w,y+h),,bf + _putimage (x,y),iconhandle + else + color backgroundcolor2 + line (x,y)-(x+w,y+h),,bf + _putimage (x,y),iconhandle + end if + if state and 1 then + color highlightcolor + line (x,y)-(x+w,y+h),,b + else + color textcolor + line (x,y)-(x+w,y+h),,b + end if +end sub + +sub drawcheckbox(x,y,state) + if state and 2 then + color highlightcolor + line (x,y)-(x+16,y+16),&hffdddddd,b + else + color textcolor + line (x,y)-(x+16,y+16),&hffbbbbbb,b + end if + if state and 1 then + color textcolor + line (x+3,y+3)-(x+13,y+13),,bf + end if +end sub + +sub drawframe(x,y,w,h,label as string) + +end sub + +sub drawlink(x,y,label as string,state as integer) + if state=1 then + color highlightcolor + else + color textcolor + end if +_printstring (x,y),label +end sub + +sub drawhline(x,y,w) + line (x,y)-(x+w,y),backgroundcolor1 + line (x,y+1)-(x+w,y+1),backgroundcolor2 +end sub + +sub drawvbar(x as long,y as long,h as long,value as single, state as integer) +if state and 2 then + color backgroundcolor2 + line (x,y)-(x+23,y+h),,bf + else + color backgroundcolor2 + line (x,y)-(x+23,y+h),,bf + end if + if state and 1 then + color highlightcolor + line (x,y)-(x+23,y+h),,b + else + color textcolor + line (x,y)-(x+23,y+h),,b + end if + dim indicator as long + indicator=((h-23) / 100)*value + line (x+1,y+indicator)-step(21,21),,bf +end sub + +sub drawhbar(x as long, y as long, w as long, value as single, state as integer) + color backgroundcolor2 + line (x, y)-(x + w, y + 23),, bf + if state and 1 then + color highlightcolor + line (x, y)-(x + w, y + 23),, b + else + color textcolor + line (x, y)-(x + w, y + 23),, b + end if + dim indicator as long + indicator = ((w - 23) / 100) * value + line (x + indicator, y + 1)-step(21, 21),, bf +end sub + + +sub textcolor (value as long) +ignore=__interncolors(1,1,value) +end sub + +sub highlightcolor (value as long) +ignore=__interncolors(1,2,value) +end sub + +sub backgroundcolor1 (value as long) +ignore=__interncolors(1,3,value) +end sub + +sub backgroundcolor2 (value as long) +ignore=__interncolors(1,4,value) +end sub + + +function textcolor () +textcolor=__interncolors(2,1,ignore) +end function + +function highlightcolor () +highlightcolor=__interncolors(2,2,ignore) +end function + +function backgroundcolor1 () +backgroundcolor1=__interncolors(2,3,ignore) +end function + +function backgroundcolor2 () +backgroundcolor2=__interncolors(2,4,ignore) +end function + + +function __interncolors(mode as integer, object as integer, value as long) +static textc as long +static highc as long +static bgrc1 as long +static bgrc2 as long +static linc as long +static init as long +if init=0 then + textc=&hffbbbbbb + highc=&hffdddddd + bgrc1=&hff282828 + bgrc2=&hff282828 + linc =&hffdddddd + init =-1 +end if + if mode=1 then + select case object + case 1 + textc=value + case 2 + highc=value + case 3 + bgrc1=value + case 4 + bgrc2=value + end select + end if + if mode=2 then + select case object + case 1 + __interncolors=textc + case 2 + __interncolors=highc + case 3 + __interncolors=bgrc1 + case 4 + __interncolors=bgrc2 + end select + end if +end function diff --git a/pixler.bas b/pixler.bas new file mode 100644 index 0000000..e74a1cc --- /dev/null +++ b/pixler.bas @@ -0,0 +1,135 @@ +type statetype + tool as long + fcolor as long + bcolor as long +end type + +type layertype + ihandle as long + blendmode as long + filter as long +end type + +dim shared layers(0) as layertype +dim shared state as statetype + + + +dim shared mouseclicked as integer +dim shared mousedown as integer +screen _newimage(640,480,32) +redim pal(0) as _unsigned long +dim as integer ch1,ch2,ch3,bt +loadpalette "slso8",pal() + +do + line (0,0)-(_width-1,_height-1),backgroundcolor1,bf + while _mouseinput:wend + mouseclicked=0 + if mousedown=-1 and _mousebutton(1)=0 then mouseclicked=-1 + mousedown=_mousebutton(1) + toolbox + colorpicker + canvas + locate 10,10: print state.tool + _limit 30 + _display +loop + +sub toolbox + dim x,y + if imagebutton(0,0,32,32,icon(0)) then state.tool=1 + if imagebutton(32,0,32,32,icon(1)) then state.tool=2 +end sub + +sub colorpicker + +end sub + +sub canvas + +end sub + +function icon(index as long) + static init as integer + static icons() as long + if not init then + dim icons(5) as long + icons(0)=_newimage(32,32,32) + _dest icons(0) + line (5,27)-(27,5) + icons(1)=_newimage(32,32,32) + _dest icons(1) + circle (15,15),13 + icons(2)=_newimage(32,32,32) + _dest icons(2) + + _dest 0 + init = -1 + end if + if (index>=lbound(icons)) and (index<=ubound(icons)) then + icon=icons(index) + end if +end function + +'$include: 'include/ui.bm' + +'$include: 'include/imgout.bm' +'$include: 'include/palette.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