PNG SCREENshot function

[counting_pine]

Latest version at: http://www.freebasic.net/forum/viewtopi ... 65#p106365
In a sudden fit of spontaneousnessness, I decided to create a function to save screenshots in PNG format; basically it's a PNG version of bsave.

savepng.bas

Code: Select all

#include "zlib.bi"

declare function savepng(byref filename as string = "screenshot.png") as integer
declare function bswap(byval n as uinteger) as uinteger

const pngheader as string = chr(&h89) & "PNG" & chr(&hd, &ha, &h1a, &ha)
const ihdrcrc as uinteger = &ha8a1ae0a 'crc32(0, @"IHDR", 4)
const pltecrc as uinteger = &h4ba88955 'crc32(0, @"PLTE", 4)
const idatcrc as uinteger = &h35af061e 'crc32(0, @"IDAT", 4)
const iendcrc as uinteger = &hae426082 'crc32(0, @"IEND", 4)

type struct_ihdr field = 1
    width as uinteger
    height as uinteger
    bitdepth as ubyte
    colortype as ubyte
    compression as ubyte
    filter as ubyte
    interlace as ubyte
end type

function bswap(byval n as uinteger) as uinteger
    
    return (n and &h000000ff) shl 24 or _
           (n and &h0000ff00) shl 8  or _
           (n and &h00ff0000) shr 8  or _
           (n and &hff000000) shr 24
    
end function

function savepng(byref filename as string = "screenshot.png") as integer
    
    dim as uinteger w, h, depth
    screeninfo w, h, depth
    
    select case as const depth
        
        case 1 to 8
            
            scope
                
                dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 3, 0, 0, 0)
                dim as uinteger ihdr_crc32 = crc32(ihdrcrc, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
                
                dim palsize as uinteger = (1 shl depth)
                dim pltesize as uinteger = palsize * 3
                dim plte(0 to 767) as ubyte
                dim plte_crc32 as uinteger
                
                dim as uinteger l = w + 1
                dim as uinteger imgsize = l * h
                dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
                dim imgdata(0 to imgsize - 1) as ubyte
                dim idat(0 to idatsize - 1) as ubyte
                dim as uinteger idat_crc32
                dim as uinteger x, y, col, r, g, b
                
                for col = 0 to palsize - 1
                    palette get col, r, g, b
                    plte(col * 3)     = r
                    plte(col * 3 + 1) = g
                    plte(col * 3 + 2) = b
                next col
                
                plte_crc32 = crc32(pltecrc, @plte(0), pltesize)
                
                screenlock
                for y = 0 to h - 1
                    imgdata(y * l) = 0
                    for x = 0 to w - 1
                        col = point(x, y)
                        imgdata(y * l + x + 1) = col
                    next w
                next y
                screenunlock
                
                if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
                idat_crc32 = crc32(idatcrc, @idat(0), idatsize)
                
                if open (filename for output as #1) then return -1
                
                    put #1, , pngheader
                    
                    put #1, , bswap(13)
                    put #1, , "IHDR"
                    put #1, , ihdr
                    put #1, , bswap(ihdr_crc32)
                    
                    put #1, , bswap(pltesize)
                    put #1, , "PLTE"
                    put #1, , plte(0), 3 * (1 shl depth)
                    put #1, , bswap(plte_crc32)
                    
                    put #1, , bswap(idatsize)
                    put #1, , "IDAT"
                    put #1, , idat(0), idatsize
                    put #1, , bswap(idat_crc32)
                    
                    put #1, , bswap(0)
                    put #1, , "IEND"
                    put #1, , bswap(iendcrc)
                    
                close #1
                
            end scope
            
        case 9 to 32
            
            scope
                
                dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 2, 0, 0, 0)
                dim as uinteger ihdr_crc32 = crc32(ihdrcrc, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
                
                dim as uinteger l = (w * 3) + 1
                dim as uinteger imgsize = l * h
                dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
                dim imgdata(0 to imgsize - 1) as ubyte
                dim idat(0 to idatsize - 1) as ubyte
                dim as uinteger idat_crc32
                dim as uinteger x, y, col, r, g, b
                
                screenlock
                for y = 0 to h - 1
                    imgdata(y * l) = 0
                    for x = 0 to w - 1
                        col = point(x, y)
                        r = col shr 16
                        g = col shr 8
                        b = col
                        imgdata(y * l + x * 3 + 1) = r
                        imgdata(y * l + x * 3 + 2) = g
                        imgdata(y * l + x * 3 + 3) = b
                    next w
                next y
                screenunlock
                
                if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
                idat_crc32 = crc32(idatcrc, @idat(0), idatsize)
                
                if open (filename for output as #1) then return -1
                
                    put #1, , pngheader
                    
                    put #1, , bswap(13)
                    put #1, , "IHDR"
                    put #1, , ihdr
                    put #1, , bswap(ihdr_crc32)
                    
                    put #1, , bswap(idatsize)
                    put #1, , "IDAT"
                    put #1, , idat(0), idatsize
                    put #1, , bswap(idat_crc32)
                    
                    put #1, , bswap(0)
                    put #1, , "IEND"
                    put #1, , bswap(iendcrc)
                    
                close #1
                
            end scope
            
        case else
            
            return -1
            
    end select
    
end function

Here's some example code:
example.bas

Code: Select all

option explicit

#include "savepng.bas"

dim i as integer
screen 13

randomize timer
for i = 1 to 100
    line (int(rnd * 320), int(rnd * 200))-(int(rnd * 320), int(rnd * 200)), int(rnd * 256), bf
next i

sleep
savepng "screenshot.png"

This line should tell you pretty much everything you need to know about how to use it:

Code: Select all

declare function savepng(byref filename as string = "screenshot.png") as integer

Use it as a fuction or a sub. If you don't specify a filename, it defaults to "screenshot.png" in the current directory. If it comes across an error (either with compressing the IDAT, or opening the file for output), it returns -1.

Sorry it's not commented, I only really spent a couple of hours on it, but it should be quite reliable. It should work in paletted and normal SCREEN modes.

[relsoft]

Cool!!!! But why do we need zlib?

[cha0s]

nice work, counting_pine ;)


@rel, its because pngs use zlib compression ;)

[relsoft]

Oh IC. Thanks!

[counting_pine]

zlib also has its own CRC32 checksum function, so I use that instead of writing my own.

By the way, if anyone wants a bit of extra speed they could probably use a couple of tricks to avoid the multiplication in the array access sections of the code. At some point, given the time and inclination, I will probably make the changes myself and update my post.

[Clyde]

Nice!

Could that be adapted to say, load in png images?

Cheers,
Clyde.

[counting_pine]

It's actually quite a difficult task to write a PNG loader, as Thrawn89 would probably tell you.

It's quite easy to read or write any one particular type of PNG image, but a proper PNG loader has to be able to cope with many different types of PNG image.

It wouldn't be too difficult to write a loader for specific images, for example, maybe a 24-bit uninterlaced image (interlacing's a real headache), although at the very least I really should add in an unfiltering process (mild headache.)
(PNG rows can be 'filtered', which basically means that each pixel can be written as a difference to neighbouring pixels. In my PNG saver, I just used filter type 0, so it just writes the pixels' absolute values.)

I'm not sure how much time I should be spending on programming at the moment, but if I ever make one, I'll be sure to post it.

[counting_pine]

Here's a slightly updated version of the code, just a couple of small changes. The main difference is, I've removed all the multipication from the IDAT and Palette making routines, so it should be slightly faster.

Code: Select all

#include "zlib.bi"

declare function savepng(byref filename as string = "screenshot.png") as integer
declare function bswap(byval n as uinteger) as uinteger

const PNGHEADER as string = chr(&h89) & "PNG" & chr(&hd, &ha, &h1a, &ha)
const IHDRCRC0 as uinteger = &ha8a1ae0a 'crc32(0, @"IHDR", 4)
const PLTECRC0 as uinteger = &h4ba88955 'crc32(0, @"PLTE", 4)
const IDATCRC0 as uinteger = &h35af061e 'crc32(0, @"IDAT", 4)
const IENDCRC0 as uinteger = &hae426082 'crc32(0, @"IEND", 4)

type struct_ihdr field = 1
    width as uinteger
    height as uinteger
    bitdepth as ubyte
    colortype as ubyte
    compression as ubyte
    filter as ubyte
    interlace as ubyte
end type

function bswap(byval n as uinteger) as uinteger
    
    return (n and &h000000ff) shl 24 or _
           (n and &h0000ff00) shl 8  or _
           (n and &h00ff0000) shr 8  or _
           (n and &hff000000) shr 24
    
end function

function savepng(byref filename as string = "screenshot.png") as integer
    
    dim as uinteger w, h, depth
    screeninfo w, h, depth
    
    select case as const depth
    
    case 1 to 8
        
        scope
            
            dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 3, 0, 0, 0)
            dim as uinteger ihdr_crc32 = crc32(IHDRCRC0, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
            
            dim palsize as uinteger = 1 shl depth
            dim pltesize as uinteger = palsize * 3
            dim plte(0 to 767) as ubyte
            dim plte_crc32 as uinteger
            
            dim as uinteger l = w + 1
            dim as uinteger imgsize = l * h
            dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
            dim imgdata(0 to imgsize - 1) as ubyte
            dim idat(0 to idatsize - 1) as ubyte
            dim as uinteger idat_crc32
            dim as uinteger x, y, col, r, g, b
            dim as uinteger index
            
            index = 0
            for col = 0 to palsize - 1
                palette get col, r, g, b
                plte(index) = r : index += 1
                plte(index) = g : index += 1
                plte(index) = b : index += 1
            next col
            
            plte_crc32 = crc32(PLTECRC0, @plte(0), pltesize)
            
            index = 0
            screenlock
            for y = 0 to h - 1
                imgdata(index) = 0 : index += 1
                for x = 0 to w - 1
                    col = point(x, y)
                    imgdata(index) = col : index += 1
                next w
            next y
            screenunlock
            
            if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
            idat_crc32 = crc32(IDATCRC0, @idat(0), idatsize)
            
            if open (filename for output as #1) then return -1
            
            put #1, 1, PNGHEADER
            
            put #1, , bswap(13)
            put #1, , "IHDR"
            put #1, , ihdr
            put #1, , bswap(ihdr_crc32)
            
            put #1, , bswap(pltesize)
            put #1, , "PLTE"
            put #1, , plte(0), 3 * (1 shl depth)
            put #1, , bswap(plte_crc32)
            
            put #1, , bswap(idatsize)
            put #1, , "IDAT"
            put #1, , idat(0), idatsize
            put #1, , bswap(idat_crc32)
            
            put #1, , bswap(0)
            put #1, , "IEND"
            put #1, , bswap(IENDCRC0)
            
            close #1
            
        end scope
        
    case 9 to 32
        
        scope
            
            dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 2, 0, 0, 0)
            dim as uinteger ihdr_crc32 = crc32(IHDRCRC0, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
            
            dim as uinteger l = (w * 3) + 1
            dim as uinteger imgsize = l * h
            dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
            dim imgdata(0 to imgsize - 1) as ubyte
            dim idat(0 to idatsize - 1) as ubyte
            dim as uinteger idat_crc32
            dim as uinteger x, y, col, r, g, b
            dim as uinteger index
            
            index = 0
            
            screenlock
            for y = 0 to h - 1
                imgdata(index) = 0 : index += 1
                for x = 0 to w - 1
                    col = point(x, y)
                    r = col shr 16
                    g = col shr 8
                    b = col
                    imgdata(index) = r : index += 1
                    imgdata(index) = g : index += 1
                    imgdata(index) = b : index += 1
                next w
            next y
            screenunlock
            
            if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
            idat_crc32 = crc32(IDATCRC0, @idat(0), idatsize)
            
            if open (filename for output as #1) then return -1
            
            put #1, 1, PNGHEADER
            
            put #1, , bswap(13)
            put #1, , "IHDR"
            put #1, , ihdr
            put #1, , bswap(ihdr_crc32)
            
            put #1, , bswap(idatsize)
            put #1, , "IDAT"
            put #1, , idat(0), idatsize
            put #1, , bswap(idat_crc32)
            
            put #1, , bswap(0)
            put #1, , "IEND"
            put #1, , bswap(IENDCRC0)
            
            close #1
            
        end scope
        
    case else
        
        return -1
        
    end select
    
end function

[D.J.Peters]

Hello counting_pine
looks clean and simple where are the counterpart LoadPNG of your selected png format or must i write it self?

Joshy

[ikkejw]

Joshy: http://www.freebasic.net/forum/viewtopic.php?t=5130

[D.J.Peters]

Joshy: http://www.freebasic.net/forum/viewtopic.php?t=5130

Thanx I know about pload but for the simple png format from counting_pine it's to mutch you know what i mean?

Joshy

[counting_pine]

Hmm... Sure, why not:

Here's the full package, savepng and loadpng. loadpng doen't support every possible PNG by a long short, and so it could produce some pretty weird looking images. But if you save an image with savepng, then load it again with loadpng, you should end up pretty much what you started with. Best not to muck around with the color depth or the palette though.

saveloadpng.bas

Code: Select all

#include "zlib.bi"

declare function savepng(byref filename as string = "screenshot.png") as integer
declare function loadpng(byref filename as string = "screenshot.png") as any ptr
declare function bswap(byval n as uinteger) as uinteger

const pngheader as string = chr(&h89) & "PNG" & chr(&hd, &ha, &h1a, &ha)
const ihdrcrc as uinteger = &ha8a1ae0a 'crc32(0, @"IHDR", 4)
const pltecrc as uinteger = &h4ba88955 'crc32(0, @"PLTE", 4)
const idatcrc as uinteger = &h35af061e 'crc32(0, @"IDAT", 4)
const iendcrc as uinteger = &hae426082 'crc32(0, @"IEND", 4)

type struct_ihdr field = 1
    width as uinteger
    height as uinteger
    bitdepth as ubyte
    colortype as ubyte
    compression as ubyte
    filter as ubyte
    interlace as ubyte
end type

function bswap(byval n as uinteger) as uinteger
    
    dim p as ubyte ptr = cptr(ubyte ptr, @n)
    return cuint(p[0]) shl 24 or _
           cuint(p[1]) shl 16 or _
           cuint(p[2]) shl  8 or _
           cuint(p[3])
    
end function

function savepng(byref filename as string = "screenshot.png") as integer
    
    dim as uinteger w, h, depth
    screeninfo w, h, depth
    
    select case as const depth
    
    case 1 to 8
        
        scope
            
            dim f as integer
            dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 3, 0, 0, 0)
            dim as uinteger ihdr_crc32 = crc32(ihdrcrc, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
            
            dim palsize as uinteger = (1 shl depth)
            dim pltesize as uinteger = palsize * 3
            dim plte(0 to 767) as ubyte
            dim plte_crc32 as uinteger
            
            dim as uinteger l = w + 1
            dim as uinteger imgsize = l * h
            dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
            dim imgdata(0 to imgsize - 1) as ubyte
            dim idat(0 to idatsize - 1) as ubyte
            dim as uinteger idat_crc32
            dim as uinteger x, y, col, r, g, b
            
            for col = 0 to palsize - 1
                palette get col, r, g, b
                plte(col * 3)     = r
                plte(col * 3 + 1) = g
                plte(col * 3 + 2) = b
            next col
            
            plte_crc32 = crc32(pltecrc, @plte(0), pltesize)
            
            screenlock
            for y = 0 to h - 1
                imgdata(y * l) = 0
                for x = 0 to w - 1
                    col = point(x, y)
                    imgdata(y * l + x + 1) = col
                next w
            next y
            screenunlock
            
            if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
            idat_crc32 = crc32(idatcrc, @idat(0), idatsize)
            
            f = freefile
            if open (filename for output as #f) then return -1
            
            put #f, , pngheader
            
            put #f, , bswap(13)
            put #f, , "IHDR"
            put #f, , ihdr
            put #f, , bswap(ihdr_crc32)
            
            put #f, , bswap(pltesize)
            put #f, , "PLTE"
            put #f, , plte(0), 3 * (1 shl depth)
            put #f, , bswap(plte_crc32)
            
            put #f, , bswap(idatsize)
            put #f, , "IDAT"
            put #f, , idat(0), idatsize
            put #f, , bswap(idat_crc32)
            
            put #f, , bswap(0)
            put #f, , "IEND"
            put #f, , bswap(iendcrc)
            
            close #f
            
        end scope
        
    case 9 to 32
        
        scope
            
            dim f as integer
            dim ihdr as struct_ihdr = (bswap(w), bswap(h), 8, 2, 0, 0, 0)
            dim as uinteger ihdr_crc32 = crc32(ihdrcrc, cptr(ubyte ptr, @ihdr), sizeof(ihdr))
            
            dim as uinteger l = (w * 3) + 1
            dim as uinteger imgsize = l * h
            dim as uinteger idatsize = imgsize + 11 + 5 * (imgsize \ 16383)
            dim imgdata(0 to imgsize - 1) as ubyte
            dim idat(0 to idatsize - 1) as ubyte
            dim as uinteger idat_crc32
            dim as uinteger x, y, col, r, g, b
            
            screenlock
            for y = 0 to h - 1
                imgdata(y * l) = 0
                for x = 0 to w - 1
                    col = point(x, y)
                    r = col shr 16
                    g = col shr 8
                    b = col
                    imgdata(y * l + x * 3 + 1) = r
                    imgdata(y * l + x * 3 + 2) = g
                    imgdata(y * l + x * 3 + 3) = b
                next w
            next y
            screenunlock
            
            if compress2(@idat(0), @idatsize, @imgdata(0), imgsize, 9) then return -1
            idat_crc32 = crc32(idatcrc, @idat(0), idatsize)
            
            f = freefile
            if open (filename for output as #f) then return -1
            
            put #f, , pngheader
            
            put #f, , bswap(13)
            put #f, , "IHDR"
            put #f, , ihdr
            put #f, , bswap(ihdr_crc32)
            
            put #f, , bswap(idatsize)
            put #f, , "IDAT"
            put #f, , idat(0), idatsize
            put #f, , bswap(idat_crc32)
            
            put #f, , bswap(0)
            put #f, , "IEND"
            put #f, , bswap(iendcrc)
            
            close #f
            
        end scope
        
    case else
        
        return -1
        
    end select
    
end function

function loadpng(byref filename as string = "screenshot.png") as any ptr
    
    #define goto_loadpng_end print __line__: goto loadpng__end
    dim ret as any ptr = 0
    
    dim f as integer
    dim ihdr as struct_ihdr
    dim as integer l, w, h, bypp, size
    dim header as string * 8
    dim chunkname as string * 4, chunklength as integer, chunkcrc as uinteger
    
    f = freefile
    if open (filename for binary access read as #f) then return 0
    
    get #f, 1, header
    if header <> pngheader then goto_loadpng_end
    
    
    get #f, , chunklength: chunklength = bswap(chunklength)
    get #f, , chunkname: if chunkname <> "IHDR" then goto_loadpng_end
    get #f, , ihdr
    w = bswap(ihdr.width)
    h = bswap(ihdr.height)
    if w <= 0 or h <= 0 then goto_loadpng_end
    select case ihdr.colortype
        case 0, 3:  bypp = 1
        case 2:     bypp = 3
        case 4:     bypp = 2
        case 6:     bypp = 4
        case else: goto_loadpng_end
    end select
    l = w * bypp + 1
    size = l * h
    if size <= 1 then goto_loadpng_end
    seek #f, seek(f) + 4
    
    
    do
        
        get #f, , chunklength: chunklength = bswap(chunklength)
        get #f, , chunkname
        
        if chunkname = "IDAT" then
            
            dim idat(0 to chunklength - 1) as ubyte
            get #f, , idat()
            
            dim image(0 to size - 1) as ubyte
            
            uncompress(@image(0), @size, @idat(0), chunklength)
            
            dim buf as any ptr = imagecreate(w, h, 0)
            
            dim i as integer = 0
            dim as integer x, y
            dim as ubyte r, g, b, a
            dim as uinteger c
            
            for y = 0 to h - 1
                
                i += 1
                
                for x = 0 to w - 1
                    
                    select case as const bypp
                        
                        case 1
                            r = image(i)
                            c = rgb(r, r, r)
                            i += 1
                        case 2
                            r = image(i)
                            c = rgba(r, r, r, a)
                            i += 2
                        case 3
                            r = image(i)
                            g = image(i + 1)
                            b = image(i + 2)
                            c = rgb(r, g, b)
                            i += 3
                        case 4
                            r = image(i)
                            g = image(i + 1)
                            b = image(i + 2)
                            a = image(i + 3)
                            c = rgba(r, g, b, a)
                            i += 4
                    end select
                    
                    pset buf, (x, y), c
                    
                    
                next x
                
            next y
            
            ret = buf
            exit do
            
        else
            
            seek #f, seek(f) + chunklength + 4
            
        end if
        
    loop until eof(f) or chunkname = "IEND"
    
    loadpng__end:
    
    close #f
    
    function = ret
    
end function

example.bas

Code: Select all

#include "saveloadpng.bas"

#define irnd(n) int(rnd * n)
#define rndcol (irnd(2^32) xor irnd(2^24) xor irnd(2^16) xor irnd(2^8))

const w = 320, h = 240, b = 24
screenres w, h, b

randomize timer
dim i as integer

for i = 1 to 1000
    line (irnd(w), irnd(h))-(irnd(w), irnd(h)), rndcol, bf
next i

sleep
savepng "screenshot.png"

cls: sleep

dim p as any ptr = loadpng("screenshot.png")

put (0, 0), p
sleep

imagedestroy p

If anyone wants to pretty this up and make it into a library or a namespace or something, please do. I'm a bit wary of namespaces at the minute, and haven't experimented much with them.

Anyway, pngload returns a pointer to a buffer, which you should destroy when you're done with it.
pngsave doesn't support buffers though, just the screen. Maybe another time...

[Bob the Hamster]

Hey, counting_pine. What is the license on this PNG code of yours? Public Domain? BSD? Attribution? Something else? If I wanted to include it in a GPL project, would that be okay with you?

[counting_pine]

That's fine. Anyone can use and modify the code for their own projects if they want.

[agamemnus]

Is this currently the latest in PNG technology?

BTW, you have a few typos... some of the "next w"s should be "next x".