I added CatchImagePOI. I also found out, if you compress the .qoi with lzma (e.g. .7z), you can reduce the file size:
Code: Select all
; https://qoiformat.org/
; https://qoiformat.org/qoi-specification.pdf
; https://github.com/phoboslab/qoi/blob/master/qoi.h
; 2021.12.27
; CatchImageQOI added by Jamirokwai
; LoadImageQOI edited to decode image data for Catch + LoadImageQOI in a single function
Structure qoi_desc
width.l
height.l
channels.a
colorspace.a
EndStructure
Macro QOI_MALLOC(sz)
AllocateMemory(sz)
EndMacro
Macro QOI_FREE(p)
FreeMemory(p)
EndMacro
Macro QOI_ZEROARR(_arr)
FillMemory(_arr, MemorySize(_arr), 0)
EndMacro
#QOI_OP_INDEX = $00 ; 00xxxxxx
#QOI_OP_DIFF = $40 ; 01xxxxxx
#QOI_OP_LUMA = $80 ; 10xxxxxx
#QOI_OP_RUN = $c0 ; 11xxxxxx
#QOI_OP_RGB = $fe ; 11111110
#QOI_OP_RGBA = $ff ; 11111111
#QOI_MASK_2 = $c0 ; 11000000
Macro QOI_COLOR_HASH(C)
(C\rgba\r *3 + C\rgba\g * 5 + C\rgba\b * 7 + C\rgba\a * 11)
EndMacro
#QOI_MAGIC = 'q' << 24 | 'o' << 16 | 'i' << 8 | 'f'
#QOI_HEADER_SIZE = 14
; 2GB is the max file size that this implementation can safely handle. We guard
; against anything larger than that, assuming the worst Case With 5 bytes per
; pixel, rounded down To a nice clean value. 400 million pixels ought To be
; enough For anybody.
#QOI_PIXELS_MAX = 400000000
Structure rgba_Structure
r.a
g.a
b.a
a.a
EndStructure
Structure qoi_rgba_t
StructureUnion
rgba.rgba_Structure
v.l
EndStructureUnion
EndStructure
Global Dim qoi_padding.a(7)
qoi_padding(7) = 1
Procedure qoi_write_32(*bytesPtr.Integer, v.l)
Protected *bytes.qoi_rgba_t
*bytes = *bytesPtr\i
*bytes\rgba\r = ($ff000000 & v) >> 24
*bytes\rgba\g = ($00ff0000 & v) >> 16
*bytes\rgba\b = ($0000ff00 & v) >> 8
*bytes\rgba\a = ($000000ff & v)
*bytesPtr\i + 4
EndProcedure
Procedure.l qoi_read_32(*bytesPtr.Integer)
Protected Result.l, *bytes.qoi_rgba_t
*bytes = *bytesPtr\i
Result = *bytes\rgba\r << 24 | *bytes\rgba\g << 16 | *bytes\rgba\b << 8 | *bytes\rgba\a
*bytesPtr\i + 4
ProcedureReturn Result
EndProcedure
Procedure.i qoi_encode(*data, *desc.qoi_desc, *out_len.Long)
Protected.i i, max_size, run
Protected.i px_len, px_end, px_pos, channels
Protected *bytes.Ascii
Protected *pixels.qoi_rgba_t
Protected *buffer
Protected Dim index.qoi_rgba_t(63)
Protected.qoi_rgba_t px, px_prev
If *Data = #Null Or *out_len = #Null Or *desc = #Null Or *desc\width = 0 Or *desc\height = 0 Or *desc\channels < 3 Or *desc\channels > 4 Or *desc\colorspace > 1 Or *desc\height >= #QOI_PIXELS_MAX / *desc\width
ProcedureReturn #Null
EndIf
max_size = *desc\width * *desc\height * (*desc\channels + 1) + #QOI_HEADER_SIZE + ArraySize(qoi_padding()) + 1
*buffer = QOI_MALLOC(max_size)
If Not *buffer
ProcedureReturn #Null
EndIf
*bytes = *buffer
qoi_write_32(@*bytes, #QOI_MAGIC)
qoi_write_32(@*bytes, *desc\width)
qoi_write_32(@*bytes, *desc\height)
*bytes\a = *desc\channels : *bytes + 1
*bytes\a = *desc\colorspace : *bytes + 1
*pixels = *Data
px_prev\rgba\a = 255
px\rgba\a = 255
px_len = *desc\width * *desc\height * *desc\channels
px_end = px_len - *desc\channels
channels = *desc\channels
While px_pos < px_len
If channels = 4
px\rgba\r = *pixels\rgba\r
px\rgba\g = *pixels\rgba\g
px\rgba\b = *pixels\rgba\b
px\rgba\a = *pixels\rgba\a
Else
px\rgba\r = *pixels\rgba\r
px\rgba\g = *pixels\rgba\g
px\rgba\b = *pixels\rgba\b
EndIf
If px\v = px_prev\v
run + 1
If run = 62 Or px_pos = px_end
*bytes\a = #QOI_OP_RUN | (run - 1) : *bytes + 1
run = 0
EndIf
Else
Protected.i index_pos
If run > 0
*bytes\a = #QOI_OP_RUN | (run - 1) : *bytes + 1
run = 0
EndIf
index_pos = QOI_COLOR_HASH(px) % 64
If index(index_pos)\v = px\v
*bytes\a = #QOI_OP_INDEX | index_pos : *bytes + 1
Else
index(index_pos)\v = px\v
If px\rgba\a = px_prev\rgba\a
Protected.i vr, vg, vb, va, vg_r, vg_b
vr = px\rgba\r - px_prev\rgba\r
vg = px\rgba\g - px_prev\rgba\g
vb = px\rgba\b - px_prev\rgba\b
vg_r = vr - vg
vg_b = vb - vg
If vr > -3 And vr < 2 And vg > -3 And vg < 2 And vb > -3 And vb < 2
*bytes\a = #QOI_OP_DIFF | ((vr + 2) << 4) | (vg + 2) << 2 | (vb + 2) : *bytes + 1
ElseIf vg_r > -9 And vg_r < 8 And vg > -33 And vg < 32 And vg_b > -9 And vg_b < 8
*bytes\a = #QOI_OP_LUMA | (vg + 32) : *bytes + 1
*bytes\a = (vg_r + 8) << 4 | (vg_b + 8) : *bytes + 1
Else
*bytes\a = #QOI_OP_RGB : *bytes + 1
*bytes\a = px\rgba\r : *bytes + 1
*bytes\a = px\rgba\g : *bytes + 1
*bytes\a = px\rgba\b : *bytes + 1
EndIf
Else
*bytes\a = #QOI_OP_RGBA : *bytes + 1
*bytes\a = px\rgba\r : *bytes + 1
*bytes\a = px\rgba\g : *bytes + 1
*bytes\a = px\rgba\b : *bytes + 1
*bytes\a = px\rgba\a : *bytes + 1
EndIf
EndIf
EndIf
px_prev\v = px\v
*pixels + channels
px_pos + channels
Wend
For i = 0 To ArraySize(qoi_padding())
*bytes\a = qoi_padding(i) : *bytes + 1
Next i
*out_len\l = *bytes - *buffer
ProcedureReturn *buffer
EndProcedure
Procedure.i qoi_decode(*Data, size.i, *desc.qoi_desc, channels.i)
Protected *bytes.Ascii
Protected.l header_magic
Protected *pixels.qoi_rgba_t, *pixel.qoi_rgba_t
Protected Dim index.qoi_rgba_t(63)
Protected px.qoi_rgba_t
Protected.i px_len, chunks_len, px_pos
Protected.i run
If *Data = #Null Or *desc = #Null Or (channels <> 0 And channels <> 3 And channels <> 4) Or size < #QOI_HEADER_SIZE + ArraySize(qoi_padding()) + 1
ProcedureReturn #Null
EndIf
*bytes = *Data
header_magic = qoi_read_32(@*bytes)
*desc\width = qoi_read_32(@*bytes)
*desc\height = qoi_read_32(@*bytes)
*desc\channels = *bytes\a : *bytes + 1
*desc\colorspace = *bytes\a : *bytes + 1
If *desc\width = 0 Or *desc\height = 0 Or *desc\channels < 3 Or *desc\channels > 4 Or *desc\colorspace > 1 Or header_magic <> #QOI_MAGIC Or *desc\height >= #QOI_PIXELS_MAX / *desc\width
ProcedureReturn #Null
EndIf
If channels = 0
channels = *desc\channels
EndIf
px_len = *desc\width * *desc\height * channels
*pixels = QOI_MALLOC(px_len)
If *pixels = #Null
ProcedureReturn #Null
EndIf
px\rgba\a = 255
Protected.i b1, b2, b3, vg
chunks_len = size - (ArraySize(qoi_padding()) + 1)
;For (int px_pos = 0; px_pos < px_len; px_pos += channels) {
While px_pos < px_len
If run > 0
run - 1
ElseIf *bytes - *data < chunks_len
b1 = *bytes\a : *bytes + 1
If b1 = #QOI_OP_RGB
px\rgba\r = *bytes\a : *bytes + 1
px\rgba\g = *bytes\a : *bytes + 1
px\rgba\b = *bytes\a : *bytes + 1
ElseIf b1 = #QOI_OP_RGBA
px\rgba\r = *bytes\a : *bytes + 1
px\rgba\g = *bytes\a : *bytes + 1
px\rgba\b = *bytes\a : *bytes + 1
px\rgba\a = *bytes\a : *bytes + 1
ElseIf (b1 & #QOI_MASK_2) = #QOI_OP_INDEX
px\v = index(b1)\v
ElseIf (b1 & #QOI_MASK_2) = #QOI_OP_DIFF
px\rgba\r + ((b1 >> 4) & $03) - 2
px\rgba\g + ((b1 >> 2) & $03) - 2
px\rgba\b + ( b1 & $03) - 2
ElseIf (b1 & #QOI_MASK_2) = #QOI_OP_LUMA
b2 = *bytes\a : *bytes + 1
vg = (b1 & $3f) - 32
px\rgba\r + vg - 8 + ((b2 >> 4) & $0f)
px\rgba\g + vg
px\rgba\b + vg - 8 + (b2 & $0f)
ElseIf (b1 & #QOI_MASK_2) = #QOI_OP_RUN
run = (b1 & $3F)
EndIf
index(QOI_COLOR_HASH(px) % 64)\v = px\v
EndIf
If channels = 4
;*(qoi_rgba_t*)(*pixels + px_pos) = *px
*pixel = *pixels + px_pos
*pixel\rgba\r = px\rgba\r
*pixel\rgba\g = px\rgba\g
*pixel\rgba\b = px\rgba\b
*pixel\rgba\a = px\rgba\a
Else
*pixel = *pixels + px_pos
*pixel\rgba\r = px\rgba\r
*pixel\rgba\g = px\rgba\g
*pixel\rgba\b = px\rgba\b
EndIf
px_pos + channels
Wend
ProcedureReturn *pixels
EndProcedure
Procedure.i qoi_write(filename$, *Data, *desc.qoi_desc)
Protected size.l
Protected *encoded
Protected f.i
f = CreateFile(#PB_Any, filename$)
If Not f
ProcedureReturn 0
EndIf
*encoded = qoi_encode(*Data, *desc, @size)
If Not *encoded
CloseFile(f)
ProcedureReturn 0
EndIf
WriteData(f, *encoded, size)
CloseFile(f)
QOI_FREE(*encoded)
ProcedureReturn size
EndProcedure
Procedure.i qoi_read(filename$, *desc.qoi_desc, channels.i)
Protected.q size, bytes_read
Protected *pixels, *data
Protected f.i
f = ReadFile(#PB_Any, filename$)
If Not f
ProcedureReturn #Null
EndIf
size = Lof(f)
*data = QOI_MALLOC(size)
If Not *data
CloseFile(f)
ProcedureReturn #Null
EndIf
bytes_read = ReadData(f, *data, size)
CloseFile(f)
*pixels = qoi_decode(*data, bytes_read, *desc, channels)
QOI_FREE(*Data)
ProcedureReturn *pixels
EndProcedure
;- PB commands
Global QOILoadImageMutex.i
Global *QOILoadImg
Global *QOILoadImgPixel.rgba_Structure
Global desc.qoi_desc
QOILoadImageMutex = CreateMutex()
Procedure QOILoadImageFilterCallback(x, y, Channels, NotNeeded)
*QOILoadImgPixel + Channels
ProcedureReturn RGBA(*QOILoadImgPixel\r, *QOILoadImgPixel\g, *QOILoadImgPixel\b, *QOILoadImgPixel\a)
EndProcedure
Procedure.i QOIDecodeBuffer(Image.i)
Protected Result.i
If *QOILoadImg
Result = CreateImage(Image, desc\width, desc\height, 8 * desc\channels)
If Result
If Image = #PB_Any
Image = Result
EndIf
If StartDrawing(ImageOutput(Image))
*QOILoadImgPixel = *QOILoadImg - desc\channels
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@QOILoadImageFilterCallback())
Box(0, 0, desc\width, desc\height, desc\channels)
StopDrawing()
EndIf
EndIf
FreeMemory(*QOILoadImg)
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i LoadImageQOI(Image.i, Filename$, Flags.i=0)
Protected Result.i
LockMutex(QOILoadImageMutex)
*QOILoadImg = qoi_read(Filename$, @desc, 0)
Result = QOIDecodeBuffer(Image)
UnlockMutex(QOILoadImageMutex)
ProcedureReturn Result
EndProcedure
Procedure.i CatchImageQOI(Image.i, *Data, size.i)
Protected Result.i
LockMutex(QOILoadImageMutex)
*QOILoadImg = qoi_decode(*data, size, desc, channels)
Result = QOIDecodeBuffer(Image)
UnlockMutex(QOILoadImageMutex)
ProcedureReturn Result
EndProcedure
Global *QOISaveBuffer
Global QOISaveImageMutex.i
Global *QOISaveImg
Global *QOISaveImgPixel.rgba_Structure
QOISaveImageMutex = CreateMutex()
Procedure QOISaveImageFilterCallback(x, y, Channels, Target)
*QOISaveImgPixel + Channels
*QOISaveImgPixel\r = Red(Target)
*QOISaveImgPixel\g = Green(Target)
*QOISaveImgPixel\b = Blue(Target)
*QOISaveImgPixel\a = Alpha(Target)
ProcedureReturn Target
EndProcedure
Procedure.i SaveImageQOI(Image.i, Filename$)
Protected desc.qoi_desc
If IsImage(Image)
desc\width = ImageWidth(Image)
desc\height = ImageHeight(Image)
desc\channels = ImageDepth(Image) / 8
LockMutex(QOISaveImageMutex)
*QOISaveImg = AllocateMemory(desc\width * desc\height * desc\channels, #PB_Memory_NoClear)
If *QOISaveImg
If StartDrawing(ImageOutput(Image))
*QOISaveImgPixel = *QOISaveImg - desc\channels
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@QOISaveImageFilterCallback())
Box(0, 0, desc\width, desc\height, desc\channels)
StopDrawing()
qoi_write(Filename$, *QOISaveImg, @desc)
EndIf
FreeMemory(*QOISaveImg)
EndIf
UnlockMutex(QOISaveImageMutex)
EndIf
EndProcedure
