diff --git a/include/imgout.bm b/include/imgout.bm index e1dfe8d..cfd979f 100644 --- a/include/imgout.bm +++ b/include/imgout.bm @@ -1,203 +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 Pixler" + 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 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 Pixler"+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 +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) + 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) + 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 + 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))) +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) + 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 + 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) +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) + 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 + 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 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 +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 diff --git a/include/palette.bm b/include/palette.bm index 3014be7..8607dd5 100644 --- a/include/palette.bm +++ b/include/palette.bm @@ -1,160 +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 +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/tools.bm b/include/tools.bm index 501da0e..7a7cc0a 100644 --- a/include/tools.bm +++ b/include/tools.bm @@ -1,51 +1,51 @@ sub thickbox(sx,sy,ex,ey,col as long) - thickline sx, sy, ex, sy, col - thickline ex, sy, ex, ey, col - thickline ex, ey, sx, ey, col - thickline sx, ey, sx, sy, col + thickline sx,sy,ex,sy,col + thickline ex,sy,ex,ey,col + thickline ex,ey,sx,ey,col + thickline sx,ey,sx,sy,col end sub sub filledbox(sx,sy,ex,ey,col as long) line(sx,sy)-(ex,ey),col,bf end sub -sub filledPolygon (Points() as long, col as long) - dim i as integer, j as integer - dim x1 as single, y1 as single, x2 as single, y2 as single - dim intersectX as single +sub filledpolygon (points() as long,col as long) + dim i as integer,j as integer + dim x1 as single,y1 as single,x2 as single,y2 as single + dim intersectx as single ' get the number of points from the upper bound of the array ' divide by 2 since we have x,y pairs - dim numPoints as integer - numPoints = (ubound(Points) + 1) \ 2 + dim numpoints as integer + numpoints=(ubound(points)+1) \ 2 ' loop through each scanline (rows of pixels) dim intersections(100) as single - dim numIntersections as integer - for y = 0 to _height ' adjust for screen height - numIntersections = 0 + dim numintersections as integer + for y=0 to _height ' adjust for screen height + numintersections=0 ' check for intersections between the polygon edges and this scanline - for i = 0 to numPoints - 1 - x1 = Points(i * 2) - y1 = Points(i * 2 + 1) - x2 = Points(((i + 1) mod numPoints) * 2) - y2 = Points(((i + 1) mod numPoints) * 2 + 1) + for i=0 to numpoints-1 + x1=points(i*2) + y1=points(i*2+1) + x2=points(((i+1) mod numpoints)*2) + y2=points(((i+1) mod numpoints)*2+1) ' check if the scanline intersects with the edge of the polygon - if ((y1 > y and y2 <= y) or (y2 > y and y1 <= y)) then + if ((y1>y and y2<=y) or (y2>y and y1<=y)) then ' calculate intersection point with the scanline - intersectX = x1 + (y - y1) * (x2 - x1) / (y2 - y1) - intersections(numIntersections) = intersectX - numIntersections = numIntersections + 1 + intersectx=x1+(y-y1)*(x2-x1)/(y2-y1) + intersections(numintersections)=intersectx + numintersections=numintersections+1 end if next i ' sort the intersections (sort by x-coordinates) - for i = 0 to numIntersections - 1 - for j = i + 1 to numIntersections - 1 - if intersections(i) > intersections(j) then - swap intersections(i), intersections(j) + for i=0 to numintersections-1 + for j=i+1 to numintersections-1 + if intersections(i)>intersections(j) then + swap intersections(i),intersections(j) end if next j next i ' fill the area between pairs of intersections - for i = 0 to numIntersections - 1 step 2 + for i=0 to numintersections-1 step 2 line(intersections(i),y)-(intersections(i+1),y),col next i next y @@ -55,170 +55,170 @@ sub thickpixel(x,y,col as long) if state.brushsize=1 then pset(x,y),col else - line(x-0.5 * state.brushsize,y-0.5 * state.brushsize)-(x+0.5 * state.brushsize,y+0.5 * state.brushsize),col,bf + line(x-0.5*state.brushsize,y-0.5*state.brushsize)-(x+0.5*state.brushsize,y+0.5*state.brushsize),col,bf end if end sub -sub thickline(x1,y1,x2,y2, col as long) +sub thickline(x1,y1,x2,y2,col as long) if state.brushsize=1 then line(x1,y1)-(x2,y2),col else dim tempimg as long dim od as long tempimg=_newimage(1,1,32) - od =_dest + od=_dest _dest tempimg pset(0,0),col _dest od - a = _Atan2(y2 - y1, x2 - x1) - a = a + _Pi / 2 - x0 = 0.5 * state.brushsize * Cos(a) - y0 = 0.5 * state.brushsize * Sin(a) - _maptriangle _seamless(0,0)-(0,0)-(0,0),tempimg to(x1-x0, y1-y0)-(x1+x0,y1+y0)-(x2+x0,y2+y0),,_smooth - _maptriangle _seamless(0,0)-(0,0)-(0,0),tempimg to(x1-x0, y1-y0)-(x2+x0,y2+y0)-(x2-x0,y2-y0),,_smooth + a=_atan2(y2-y1,x2-x1) + a=a+_pi/2 + x0=0.5*state.brushsize*cos(a) + y0=0.5*state.brushsize*sin(a) + _maptriangle _seamless(0,0)-(0,0)-(0,0),tempimg to (x1-x0,y1-y0)-(x1+x0,y1+y0)-(x2+x0,y2+y0),,_smooth + _maptriangle _seamless(0,0)-(0,0)-(0,0),tempimg to (x1-x0,y1-y0)-(x2+x0,y2+y0)-(x2-x0,y2-y0),,_smooth _freeimage tempimg end if end sub -Sub polygon (pa() As Long,col as long) - For i = 2 To UBound(pa) Step 2 - thickLine pa(i - 2), pa(i - 1),pa(i), pa(i + 1),col - Next i - thickLine pa(ubound(pa)-1), pa(ubound(pa)),pa(0), pa(1),col -End Sub +sub polygon (pa() as long,col as long) + for i=2 to ubound(pa) step 2 + thickline pa(i-2),pa(i-1),pa(i),pa(i+1),col + next i + thickline pa(ubound(pa)-1),pa(ubound(pa)),pa(0),pa(1),col +end sub -sub thickcircle(x, y, r, col as long) - if state.brushsize <= 1 then - circle (x, y), r, col +sub thickcircle(x,y,r,col as long) + if state.brushsize<=1 then + circle (x,y),r,col else - dim rp as single, rm as single, rp2 as single, rm2 as single - dim rpi2 as single, rmi2 as single, sp as single, sm as single + dim rp as single,rm as single,rp2 as single,rm2 as single + dim rpi2 as single,rmi2 as single,sp as single,sm as single dim i as single - rp = r + state.brushsize / 2 - rm = r - state.brushsize / 2 - + rp=r+state.brushsize/2 + rm=r-state.brushsize/2 + ' If the brush is thicker than the circle, it's just a filled circle - if rm < 0 then - filledcircle x, y, rp, col + if rm<0 then + filledcircle x,y,rp,col exit sub end if - rp2 = rp ^ 2 - rm2 = rm ^ 2 + rp2=rp ^ 2 + rm2=rm ^ 2 ' Outer edges (Top/Bottom caps) - for i = -rp to -rm step .2 - rpi2 = rp2 - i ^ 2 - if rpi2 < 0 then rpi2 = 0 ' Safety Gate - sp = sqr(rpi2) - line (x + i, y - sp)-(x + i, y + sp), col, bf + for i=-rp to -rm step .2 + rpi2=rp2-i ^ 2 + if rpi2<0 then rpi2=0 ' Safety Gate + sp=sqr(rpi2) + line (x+i,y-sp)-(x+i,y+sp),col,bf next ' Side rings (where the hole in the middle exists) - for i = -rm to rm step .2 - rpi2 = rp2 - i ^ 2 - rmi2 = rm2 - i ^ 2 - if rpi2 < 0 then rpi2 = 0 ' Safety Gate - if rmi2 < 0 then rmi2 = 0 ' Safety Gate - sp = sqr(rpi2) - sm = sqr(rmi2) + for i=-rm to rm step .2 + rpi2=rp2-i ^ 2 + rmi2=rm2-i ^ 2 + if rpi2<0 then rpi2=0 ' Safety Gate + if rmi2<0 then rmi2=0 ' Safety Gate + sp=sqr(rpi2) + sm=sqr(rmi2) ' Draw the top and bottom segments only - line (x + i, y + sm)-(x + i, y + sp), col, bf - line (x + i, y - sm)-(x + i, y - sp), col, bf + line (x+i,y+sm)-(x+i,y+sp),col,bf + line (x+i,y-sm)-(x+i,y-sp),col,bf next ' Outer edges (Right cap) - for i = rm to rp step .2 - rpi2 = rp2 - i ^ 2 - if rpi2 < 0 then rpi2 = 0 ' Safety Gate - sp = sqr(rpi2) - line (x + i, y - sp)-(x + i, y + sp), col, bf + for i=rm to rp step .2 + rpi2=rp2-i ^ 2 + if rpi2<0 then rpi2=0 ' Safety Gate + sp=sqr(rpi2) + line (x+i,y-sp)-(x+i,y+sp),col,bf next - end if + end if end sub sub filledcircle(x,y,r,col as long) - dim __radius as integer, radiuserror as integer - dim tx as integer, ty as integer - __radius=abs(r)-1 - radiuserror=-__radius - tx=__radius - ty=0 - line (x-tx,y)-(x+tx,y),col - while tx>ty - radiuserror=radiuserror+ty*2+1 - if radiuserror >= 0 then - if tx<>ty+1 then - line (x-ty,y-tx)-(x+ty,y-tx),col - line (x-ty,y+tx)-(x+ty,y+tx),col - end if - tx=tx-1 - radiuserror=radiuserror-tx*2 + dim __radius as integer,radiuserror as integer + dim tx as integer,ty as integer + __radius=abs(r)-1 + radiuserror=-__radius + tx=__radius + ty=0 + line (x-tx,y)-(x+tx,y),col + while tx>ty + radiuserror=radiuserror+ty*2+1 + if radiuserror>=0 then + if tx<>ty+1 then + line (x-ty,y-tx)-(x+ty,y-tx),col + line (x-ty,y+tx)-(x+ty,y+tx),col end if - ty=ty+1 - line (x-tx,y-ty)-(x+tx,y-ty),col - line (x-tx,y+ty)-(x+tx,y+ty),col - wend + tx=tx-1 + radiuserror=radiuserror-tx*2 + end if + ty=ty+1 + line (x-tx,y-ty)-(x+tx,y-ty),col + line (x-tx,y+ty)-(x+tx,y+ty),col + wend +end sub + +sub floodfill (startx,starty,fillcolor~&) + ' We use a simple array as a stack for (x, y) pairs + ' For large images, you may need to increase this size + dim stackx(2000) as integer + dim stacky(2000) as integer + targetcolor~&=point(startx,starty) + if targetcolor~&=fillcolor~& then exit sub + stackptr=1 + + stackx(stackptr)=startx + stacky(stackptr)=starty + + while stackptr>0 + curx=stackx(stackptr) + cury=stacky(stackptr) + stackptr=stackptr-1 + + ' Move to the left edge of the span + x=curx + while point(x,cury)=targetcolor~& and x>=0 + x=x-1 + wend + x=x+1 + + spanabove=0 + spanbelow=0 + + ' Process the span moving right + while point(x,cury)=targetcolor~& and x<_width + pset (x,cury),fillcolor~& + + ' Check row above + if cury>0 then + if spanabove=0 and point(x,cury-1)=targetcolor~& then + stackptr=stackptr+1 + stackx(stackptr)=x + stacky(stackptr)=cury-1 + spanabove=1 + elseif spanabove=1 and point(x,cury-1)<>targetcolor~& then + spanabove=0 + end if + end if + + ' Check row below + if cury<_height-1 then + if spanbelow=0 and point(x,cury+1)=targetcolor~& then + stackptr=stackptr+1 + stackx(stackptr)=x + stacky(stackptr)=cury+1 + spanbelow=1 + elseif spanbelow=1 and point(x,cury+1)<>targetcolor~& then + spanbelow=0 + end if + end if + + x=x+1 + wend + wend end sub - SUB FloodFill (startX, startY, fillColor~&) - ' We use a simple array as a stack for (x, y) pairs - ' For large images, you may need to increase this size - DIM stackX(2000) AS INTEGER - DIM stackY(2000) AS INTEGER - targetColor~&=point(startX,startY) - if targetColor~&=fillColor~& then exit sub - stackPtr = 1 - - stackX(stackPtr) = startX - stackY(stackPtr) = startY - - WHILE stackPtr > 0 - curX = stackX(stackPtr) - curY = stackY(stackPtr) - stackPtr = stackPtr - 1 - - ' Move to the left edge of the span - x = curX - WHILE POINT(x, curY) = targetColor~& AND x >= 0 - x = x - 1 - WEND - x = x + 1 - - spanAbove = 0 - spanBelow = 0 - - ' Process the span moving right - WHILE POINT(x, curY) = targetColor~& AND x < _WIDTH - PSET (x, curY), fillColor~& - - ' Check row above - IF curY > 0 THEN - IF spanAbove = 0 AND POINT(x, curY - 1) = targetColor~& THEN - stackPtr = stackPtr + 1 - stackX(stackPtr) = x - stackY(stackPtr) = curY - 1 - spanAbove = 1 - ELSEIF spanAbove = 1 AND POINT(x, curY - 1) <> targetColor~& THEN - spanAbove = 0 - END IF - END IF - - ' Check row below - IF curY < _HEIGHT - 1 THEN - IF spanBelow = 0 AND POINT(x, curY + 1) = targetColor~& THEN - stackPtr = stackPtr + 1 - stackX(stackPtr) = x - stackY(stackPtr) = curY + 1 - spanBelow = 1 - ELSEIF spanBelow = 1 AND POINT(x, curY + 1) <> targetColor~& THEN - spanBelow = 0 - END IF - END IF - - x = x + 1 - WEND - WEND - END SUB - diff --git a/include/ui.bm b/include/ui.bm index 86c1476..4ff80dd 100644 --- a/include/ui.bm +++ b/include/ui.bm @@ -1,8 +1,8 @@ function textinput$ (x as integer,y as integer,w as integer,h as integer,__text as string) - dim text as string, keyin as string - dim cursor as integer, done as integer + dim text as string,keyin as string + dim cursor as integer,done as integer text=__text - if not (_mousex>x and _mousey>y AND _mousexx and _mousey>y and _mousex1 THEN + if cursor>1 then text=left$(text,cursor-2)+mid$(text,cursor) cursor=cursor-1 end if @@ -48,11 +48,11 @@ function textinput$ (x as integer,y as integer,w as integer,h as integer,__text done=-1 end select end if - while _mouseinput: wend + while _mouseinput:wend if _mousebutton(1) then - IF (_mousex>x and _mousey>y AND _mousexx and _mousey>y and _mousexlen(text)+1 then cursor=len(text)+1 else @@ -68,8 +68,8 @@ end function sub drawtextinput (x as integer,y as integer,w as integer,h as integer,text as string,state as integer) dim outtext as string - dim charWidth as integer:charWidth = 8 - dim cursorX as integer,textX as integer,textY as integer + dim charwidth as integer:charwidth=8 + dim cursorx as integer,textx as integer,texty as integer if state>0 then color backgroundcolor1 else @@ -78,22 +78,22 @@ sub drawtextinput (x as integer,y as integer,w as integer,h as integer,text as s line(x,y)-(x+w,y+h),,bf if state>0 then color highlightcolor - ELSE + else color textcolor end if line(x,y)-(x+w,y+h),,b _printmode _keepbackground - outtext=right$(text,min(w/charWidth,len(text))) - textX=2+x - textY=1+y+h/2-8 - _printstring(textX,textY),outtext + outtext=right$(text,min(w/charwidth,len(text))) + textx=2+x + texty=1+y+h/2-8 + _printstring(textx,texty),outtext if state>0 then if int(timer*2) mod 2=0 then - dim relativeCursor as integer - relativeCursor=state-(len(text)-len(outtext)) - if relativeCursor>=1 and relativeCursor<=len(outtext)+1 then - cursorX=textX+(relativeCursor-1)*charWidth - line(cursorX,textY)-(cursorX,textY+14),highlightcolor + dim relativecursor as integer + relativecursor=state-(len(text)-len(outtext)) + if relativecursor>=1 and relativecursor<=len(outtext)+1 then + cursorx=textx+(relativecursor-1)*charwidth + line(cursorx,texty)-(cursorx,texty+14),highlightcolor end if end if end if @@ -103,7 +103,7 @@ function min(a,b) if a<=b then min=a else min=b end function -function clickregion(x as integer, y as integer, w as integer, h as integer) +function clickregion(x as integer,y as integer,w as integer,h as integer) if _mousex>x and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousexx and _mousey>y and _mousex x and _mousey > y - 5 and _mousex < x + w and _mousey < y + 15 then - drawslider x, y, w, value, 1 - if _mousebutton(1) then - tmpval = ((_mousex - x) / w) * 100 + tmpval=value + if _mousex>x and _mousey>y-5 and _mousex 100 then tmpval = 100 - slider = tmpval + if tmpval<0 then tmpval=0 + if tmpval>100 then tmpval=100 + slider=tmpval end function function vscrollbar(x as long,y as long,h as long,value as single) -dim tmpval as single -tmpval=value -if buttonhold(x,y,23,23,"U") then tmpval=tmpval-1 -if buttonhold(x,h-23,23,23,"D") then tmpval=tmpval+1 -tmpval= vbar(x,y+23,h-46,tmpval) -if tmpval<0 then tmpval=0 -if tmpval>100 then tmpval=100 -vscrollbar=tmpval + dim tmpval as single + tmpval=value + if buttonhold(x,y,23,23,"U") then tmpval=tmpval-1 + if buttonhold(x,h-23,23,23,"D") then tmpval=tmpval+1 + tmpval=vbar(x,y+23,h-46,tmpval) + if tmpval<0 then tmpval=0 + if tmpval>100 then tmpval=100 + vscrollbar=tmpval end function function vbar(x as long,y as long,h as long,value as single) @@ -208,30 +208,30 @@ function vbar(x as long,y as long,h as long,value as single) vbar=tmpval end function -function hscrollbar(x as long, y as long, w as long, value as single) +function hscrollbar(x as long,y as long,w as long,value as single) dim tmpval as single - tmpval = value - if button(x, y, 23, 23, "L") then tmpval = tmpval - 1 - if button(x + w - 23, y, 23, 23, "R") then tmpval = tmpval + 1 - tmpval = hbar(x + 23, y, w - 46, tmpval) - if tmpval < 0 then tmpval = 0 - if tmpval > 100 then tmpval = 100 - hscrollbar = tmpval + tmpval=value + if button(x,y,23,23,"L") then tmpval=tmpval-1 + if button(x+w-23,y,23,23,"R") then tmpval=tmpval+1 + tmpval=hbar(x+23,y,w-46,tmpval) + if tmpval<0 then tmpval=0 + if tmpval>100 then tmpval=100 + hscrollbar=tmpval end function -function hbar(x as long, y as long, w as long, value as single) +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 + tmpval=value + if _mousex>x and _mousey>y and _mousex