Image compression with Red

Image compression could be necessary when processing images. For example in the lab we are using a lot of timelapse  images of cells which correspond to several days of recording. Of course, it's easy to zip or unzip the recorded images. But sometimes, we also need to online compress images such as images originating from camera. Due to courtesy of Bruno Anselme, Red can use zlib (https://zlib.net) and his binding can be used with RedCV without any problem. Since Bruno's binding to zlib is focused on string compression, I just wrote two routines which allow to use binary values rather than strings. Routines are really convenient in Red since it's possible to directly include Red/System code inside a Red program. 

compressRGB 

This routine takes a red binary! as parameter, then calls zlib compression algorithm and returns the compressed values as binary!

compressRGB: routine [rgb [binary!] return: [binary!]
    /local 
    byte-count
    data
    buffer 
    ] [
    byte-count: 0
    data: binary/rs-head as red-binary! rgb
    buffer: zlib/compress data binary/rs-length? rgb :byte-count Z_DEFAULT_COMPRESSION
    as red-binary! stack/set-last as red-value! binary/load buffer byte-count
]

decompressRGB

The routine makes the opposite job and uncompresses the compressed binary values.

decompressRGB: routine [ rgb [binary!] bCount [integer!] return: [binary!]
    /local 
    data
    buffer 
    ] [
    data: binary/rs-head as red-binary!  rgb
    buffer: zlib/decompress data bCount
    as red-binary! stack/set-last as red-value! binary/load buffer bCount
]

Code sample

With these two routines, it is really simple to compress images with Red. Just load a Red supported image and extract rgb values as binary! from the image and then compress and uncompress data.

Red [
    Title:   "Test camera Red VID "
    Author:  "Francois Jouen"
    File:    %compress1.red
    Needs:   'View
]

#system [
    #include %../../libs/ZLib/zlib.reds ; for ZLib compression
    ; Thanks to Bruno Anselme
]

defSize: 256x256
imgSize: 0x0
isFile: false

compressRGB: routine [ rgb [binary!] return: [binary!]
    /local 
    byte-count
    data
    buffer 
    ] [
    byte-count: 0
    data: binary/rs-head as red-binary! rgb
    buffer: zlib/compress data binary/rs-length? rgb :byte-count Z_DEFAULT_COMPRESSION
    as red-binary! stack/set-last as red-value! binary/load buffer byte-count
]


decompressRGB: routine [ rgb [binary!] bCount [integer!] return: [binary!]
    /local 
    data
    buffer 
    ] [
    data: binary/rs-head as red-binary!  rgb
    buffer: zlib/decompress data bCount
    as red-binary! stack/set-last as red-value! binary/load buffer bCount
]



loadImage: does [
    isFile: false
    tmp: request-file
    if not none? tmp [
        img0: load tmp
        imgSize: img0/size
        rgb: copy img0/rgb
        img1: make image! imgSize 
        img2: make image! imgSize 
        img3: make image! imgSize 
        img1/rgb: rgb
        img2/rgb: 0.0.0
        img3/rgb: 0.0.0
        b1/image: img1
        b2/image: img2
        b3/image: img3
        f0/text: f1/text: f11/text: f2/text: f3/text: ""
        result: copy #{}
        result2: copy #{}
        f1/text: form imgSize
        isFile: true
    ]
]


compressImage: does [
    f0/text: f2/text:  ""
    n: length? rgb
    result: compressRGB rgb 
    n1: length? result  
    compression: 100 - (100 * n1 / n)
    f0/text: rejoin [" Compression: " form compression]
    append f0/text " %"
    f11/text: rejoin [form n " bytes"]
    f2/text: rejoin [form n1 " bytes"]
    ; not useful for compression
    ; only to show img2 and avoid pointer error
    if cb/data [
        i: n1 
        while [i < n ] [
            append result 0
            i: i + 1
        ]
        img2/rgb: copy result
        b2/image: img2
    ]
]

uncompressImage: does [
    f3/text: ""
    n: length? rgb
    result2: decompressRGB result n
    f3/text: rejoin [form length? result2 " bytes"]
    img3/rgb: copy result2
    b3/image: img3
]


view win: layout [
    title "Compress/Uncompress Images with Red"
    button "load" [loadImage]
    button "Compress Image" [if isFile [compressImage]]
    pad 50x0
    f0: field 156
    cb: check "Show Result"
    button "Uncompress Image" [if isFile [uncompressImage]]
    pad 25x0
    button "Quit" [quit]
    return
    f1: field 120 f11: field 125
    text 120 "Compressed" f2: field 125
    text 120 "Uncompressed" f3: field 125
    return
    
    b1: base defSize black
    b2: base defSize black
    b3: base defSize black
]

Result

Of course the compression ratio depends on the nature of your image, but zlib compression is pretty good on most of images :)

Example with a low size image (512x512 pixels)

Example with a huge image (4032 × 3024 pixels)