pixler/include/imgout.bm

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

    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