include 'unPNG.inc'

PNG.ALPHA       := 0    ; change to run second test
PNG.WIDTH       := 256
PNG.HEIGHT      := 256

virtual at 0
PNG.DATA::
        repeat PNG.HEIGHT,y:0
                repeat PNG.WIDTH,x:0
                        if PNG.ALPHA
                                db x,y,128,(x+y) shr 1 ; RGBA test
                        else
                                db x,y,128 ; RGB test
                        end if
                end repeat
        end repeat
end virtual    

; PNG.ALPHA     : indicate if pixel data is 24-bit (RGB) or 32-bit (RGBA)
; PNG.WIDTH     : > 0 and < 16383
; PNG.HEIGHT    : > 0
; PNG.DATA      : an address space defining pixel data

if ~ definite PNG ; once
PNG := 1

virtual at 0
crc32:: ; the little table
dd 0,0x1DB71064,0x3B6E20C8,0x26D930AC,0x76DC4190,0x6B6B51F4,0x4DB26158,0x5005713C,0xEDB88320,0xF00F9344,0xD6D6A3E8,0xCB61B38C,0x9B64C2B0,0x86D3D2D4,0xA00AE278,0xBDBDF21C
end virtual

namespace PNG

macro Chunk type*,ddata&
        local dstart,dend,CRC
        dd (dend - dstart - 4) bswap 4
        dstart:
                db type
                assert ($ - dstart) = 4 ; chunk id is four bytes
                match ,ddata
                else
                        db ddata
                end match
        dend:
        CRC = 0xFFFFFFFF
        repeat $ - dstart
                load b:1 from dstart+%-1
                CRC = CRC xor b
                load t:4 from crc32:(CRC and 15) shl 2
                CRC = (CRC shr 4) xor t
                load t:4 from crc32:(CRC and 15) shl 2
                CRC = (CRC shr 4) xor t
        end repeat
        dd (CRC xor 0xFFFFFFFF) bswap 4
end macro


format binary as 'png'
db 89h,'PNG',13,10,26,10

virtual at 0
        dd WIDTH bswap 4
        dd HEIGHT bswap 4
        assert ALPHA and 1 = ALPHA ; 0 or 1
        ; Depth=8, Color=True color with/without alpha
        ; Compression=Deflate, Filter=No, Interlace=No
        db 8,2+(ALPHA shl 2),0,0,0
        load dat:$ from 0
end virtual
Chunk 'IHDR',dat

virtual at 0
        ; for Adler-32 checksum of uncompressed data:
        s1 = 1 ; sum of all bytes mod 65521
        s2 = 0 ; sum of all s1 mod 65521

        if ALPHA
                pitch = 4 * WIDTH
        else
                pitch = 3 * WIDTH
        end if

        db 78h,1 ; deflate data, blocked by horizontal lines
        repeat HEIGHT,h:0
                if % = %%
                        db 1
                else
                        db 0
                end if
                dw pitch+1, 0xFFFF xor (pitch+1)
                load dat:pitch from DATA:pitch*h
idata.h:
                db 0
                db dat
                repeat pitch+1
                        load b:1 from idata.h + % - 1
                        s1 = (s1 + b) mod 65521
                        s2 = (s2 + s1) mod 65521
                end repeat
        end repeat
        dd ((s2 shl 16) or s1) bswap 4
        load dat:$ from 0
end virtual
Chunk 'IDAT',dat

Chunk 'IEND'

end namespace ; PNG

end if ; PNG    

PNG.ALPHA       := 0    ; change to run second test
PNG.WIDTH       := 256*3
PNG.HEIGHT      := 256

virtual ;at 0
PNG.DATA::
        ; start with black canvas
        if PNG.ALPHA
                dd PNG.HEIGHT*PNG.WIDTH dup ?
        else
                db PNG.HEIGHT*PNG.WIDTH dup (?,?,?)
        end if

db -1 ; force size?

        LogMap  (1 shl 32),(4 shl 32)
end virtual

struc GET x*,y*
        if PNG.ALPHA
                load .:4 from PNG.DATA:4*(x + y*PNG.WIDTH)
        else
                load .:3 from PNG.DATA:3*(x + y*PNG.WIDTH)
        end if
end struc
struc SET x*,y*
        if PNG.ALPHA
                store .:4 at PNG.DATA:4*(x + y*PNG.WIDTH)
        else
                store .:3 at PNG.DATA:3*(x + y*PNG.WIDTH)
        end if
end struc

; y coordinate always mapped to range (0,1)
; 0 < λ_min < λ_max < 4 shl S
macro LogMap λ_min*, λ_max*, S:32
        local Δλ,ΔFn,λ,Fn,x,y,c
        Δλ    := (λ_max - λ_min)/PNG.WIDTH
        ΔFn    := ((1 shl S)+(PNG.HEIGHT - 1))/PNG.HEIGHT

        λ = λ_min
        repeat PNG.WIDTH,x:0
                c = 0
                Fn = 1 shl (S-1) ; 0.5
                while c and $FF <> $FF
                        Fn = (λ * ((Fn * ((1 shl S) - Fn)) shr S)) shr S
                        y = Fn/ΔFn
                        c GET x,y
                        c = c + 0x010101
                        c SET x,y
                end while
                λ = λ + Δλ
        end repeat
end macro

include 'unPNG.inc'    

calminstruction (pixel) GET x*, y*
        compute size, 3+PNG.ALPHA
        compute offset, size * (x + y*PNG.WIDTH)
        arrange command, =load pixel:size =from =PNG.=DATA:offset
        assemble command
end calminstruction
calminstruction (pixel) SET x*, y*
        compute size, 3+PNG.ALPHA
        compute offset, size * (x + y*PNG.WIDTH)
        arrange command, =store pixel:size =at =PNG.=DATA:offset
        assemble command
end calminstruction