Quick OK Image format

[infratec]

I made a test with a very big png / QOI file.

PNG filesize @ compression 9: 18.632.518 bytes

Converted to QOI : 23.812.385 bytes

Loadtime of the PNG with IrfanView : 496ms

Compiled with 6.00B1 X64 Assembler: 746ms
Compiled with 6.00B1 X64 C Optimized: 447ms

[infratec]

I 'optimized' the drawing of the image.
But I'm not really lucky about it, because it uses a global variable as pointer.

I use now a mutex to prevent collisions.

Now the C version needs 336ms for loading the image.
Save takes 505ms

CODE REMOVED SINCE FINAL SPECS ARE NOW AVAILABLE

[infratec]

master version from 2021.12.13


CODE REMOVED SINCE FINAL SPECS ARE NOW AVAILABLE

[infratec]

And a modified test programn since I tried to display the world

https://visibleearth.nasa.gov/collectio ... ble?page=2

To convert it to QOI I need to compile the qoiconv program as x64 programm.
Also the following viewer needs to compile as x64 bi, best with optimized C compiler.

In IrfanView it needs 3792ms to load.
As QOI in PB it needs 2998ms.

Ok, it is 30MB larger as the PNG (155.906.152 -> 181.528.403) (The august picture)

It is 21600 x 10800 in size.

So I needed a ScrollAreaGadget():

Code: Select all

EnableExplicit

IncludeFile "qoi.pbi"


Define filename$, StartTime.q, EndTime.q, WinWidth.i, WinHeight.i


filename$ = OpenFileRequester("Choose a QOI file", "", "QOI|*.qoi", 0)
If filename$
  StartTime = ElapsedMilliseconds()
  If LoadImageQOI(0, filename$)
    EndTime = ElapsedMilliseconds()
    
    If ImageWidth(0) > 1024
      WinWidth = 1024
    Else
      WinWidth = ImageWidth(0)
    EndIf
    
    If ImageHeight(0) > 768
      WinHeight = 768
    Else
      WinHeight = ImageHeight(0)
    EndIf
    
    OpenWindow(0, 0, 0, WinWidth, WinHeight, "QOI Test", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
    CreateStatusBar(0, WindowID(0))
    ScrollAreaGadget(1, 0, 0, WinWidth, WinHeight - StatusBarHeight(0), ImageWidth(0), ImageHeight(0))
    ImageGadget(0, 0, 0, 0, 0, ImageID(0))
    CloseGadgetList()
    AddStatusBarField(150)
    AddStatusBarField(120)
    AddStatusBarField(150)
    
    StatusBarText(0, 0, GetFilePart(filename$), #PB_StatusBar_Center)
    StatusBarText(0, 1, Str(ImageWidth(0)) + "x" + Str(ImageHeight(0)), #PB_StatusBar_Center)
    StatusBarText(0, 2, "Loadtime: " + Str(EndTime - StartTime) + "ms", #PB_StatusBar_Center)
    
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
    
    If MessageRequester("Would you ...", "save the file?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
      StartTime = ElapsedMilliseconds()
      SaveImageQOI(0, GetFilePart(filename$, #PB_FileSystem_NoExtension) + "_saved.qoi")
      EndTime = ElapsedMilliseconds()
      
      MessageRequester("Info", "Savetime: " + Str(EndTime - StartTime))
    EndIf
    
  Else
    Debug "qoi read failed"
  EndIf
EndIf

[infratec]

Final specs V1 are available.

Here is my PB implementation: (save it as qoi.pbi)

Code: Select all

; https://qoiformat.org/
; https://qoiformat.org/qoi-specification.pdf
; https://github.com/phoboslab/qoi/blob/master/qoi.h

; 2021.12.20

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

QOILoadImageMutex = CreateMutex()


Procedure QOILoadImageFilterCallback(x, y, Channels, NotNeeded)
  *QOILoadImgPixel + Channels
  ProcedureReturn RGBA(*QOILoadImgPixel\r, *QOILoadImgPixel\g, *QOILoadImgPixel\b, *QOILoadImgPixel\a)
EndProcedure



Procedure.i LoadImageQOI(Image.i, Filename$, Flags.i=0)
  
  Protected Result.i, desc.qoi_desc
  
  
  LockMutex(QOILoadImageMutex)
  
  *QOILoadImg = qoi_read(Filename$, @desc, 0)
  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
  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

As already mentioned:

Best result is achieved with PB 6.00 x64 Beta 1 with C compiler and optimization enabled.

[wilbert]

It's an interesting file format.
I might try myself as well to optimize for speed.

One thing that can help a bit for the PB compiler is to use & 63 instead of % 64 .

[chi]

Final specs V1 are available.

Here is my PB implementation: (save it as qoi.pbi)

You forgot *QOISaveImgPixel\a = Alpha(Target) in the QOISaveImageFilterCallback()

Other than that, great job! Thanks for sharing.

[infratec]

@chi

you were right

I added it in the listing above.

[infratec]

I can eliminate one if inside the while loop.
But then I have a lot of duplicate code.
The decision if it is 4 channel can be done outside of the loop.
But then 2 different loops are needed.

The main point for PB is the conversion to a PB image.
The easiest/fastest way for me was to use the callback.

Else I had to swap 2 bytes (RGB to BGR).
Then I could use the image buffer.
But I'm not sure is this is always the case
1. Y reversed
2. BGR

Maybe this is OS dependent, so I decided to use the callback.

[jamirokwai]

Hi there,

I added CatchImagePOI. I also found out, if you compress the .qoi with lzma (e.g. .7z), you can reduce the file size:

test.png - 20k
test.qoi - 43k
test.png.7z - 17k
test.qoi.7z - 14k

But that's maybe only for academic reasons

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

[wilbert]

Here's my attempt of a catch procedure using the drawing buffer.

Code: Select all

; https://qoiformat.org/

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  Enumeration
    #QOI_B : #QOI_G : #QOI_R : #QOI_A
  EndEnumeration
CompilerElse
  Enumeration
    #QOI_R : #QOI_G : #QOI_B : #QOI_A
  EndEnumeration
CompilerEndIf

Macro qoi_hash(px)
  (px\b[#QOI_R] * 3 + px\b[#QOI_G] * 5 + px\b[#QOI_B] * 7 + px\b[#QOI_A] * 11) & 63
EndMacro

Structure qoi_array
  StructureUnion
    v.l
    b.a[0]
  EndStructureUnion
EndStructure

Procedure.i CatchQOI(Image, *MemoryAddress, Size = $7fffffff)
  Protected Dim index.qoi_array(63)
  Protected.qoi_array px, *px, *px_end, *b = *MemoryAddress
  Protected.i result, width, height, db, pitch, vg, run
  
  If *b = #Null Or Size < 14 Or *b\v <> $66696f71; check for "qoif"
    ProcedureReturn #Null
  EndIf
  
  width  = *b\b[4] << 24 | *b\b[5] << 16 | *b\b[ 6] << 8 | *b\b[ 7]
  height = *b\b[8] << 24 | *b\b[9] << 16 | *b\b[10] << 8 | *b\b[11]
  If width < 1 Or height < 1
    ProcedureReturn #Null
  EndIf
  
  result = CreateImage(Image, width, height, 32)
  If result = 0
    ProcedureReturn #Null
  ElseIf Image = #PB_Any
    Image = result
  EndIf
  
  *b + 14
  Size - 8
  px\b[3] = $ff
  If StartDrawing(ImageOutput(Image))
    If DrawingBufferPixelFormat() & #PB_PixelFormat_ReversedY  
      db = DrawingBuffer() + DrawingBufferPitch() * (height - 1)
      pitch = -DrawingBufferPitch()
    Else
      db = DrawingBuffer()
      pitch = DrawingBufferPitch()
    EndIf
    
    While height
      *px = db
      *px_end = *px + width << 2
      While *px < *px_end
        If run > 0
          run - 1
        ElseIf *b - *MemoryAddress < Size
          Select *b\b[0] >> 6
            Case 0                  ; QOI_OP_INDEX
              px\v = index(*b\b[0])\v
              *b + 1
            Case 1                  ; QOI_OP_DIFF
              px\b[#QOI_R] + ((*b\b[0] >> 4) & 3) - 2
              px\b[#QOI_G] + ((*b\b[0] >> 2) & 3) - 2
              px\b[#QOI_B] + ( *b\b[0]       & 3) - 2
              *b + 1
              index(qoi_hash(px))\v = px\v
            Case 2                  ; QOI_OP_LUMA
              vg = (*b\b[0] & $3f) - 32
              px\b[#QOI_R] + vg - 8 + ((*b\b[1] >> 4) & $f)
              px\b[#QOI_G] + vg
              px\b[#QOI_B] + vg - 8 + ( *b\b[1]       & $f)
              *b + 2
              index(qoi_hash(px))\v = px\v
            Default
              If *b\b[0] = $fe      ; QOI_OP_RGB
                px\b[#QOI_R] = *b\b[1]
                px\b[#QOI_G] = *b\b[2]
                px\b[#QOI_B] = *b\b[3]              
                *b + 4
                index(qoi_hash(px))\v = px\v
              ElseIf *b\b[0] = $ff  ; QOI_OP_RGBA
                px\b[#QOI_R] = *b\b[1]
                px\b[#QOI_G] = *b\b[2]
                px\b[#QOI_B] = *b\b[3]
                px\b[#QOI_A] = *b\b[4]
                *b + 5
                index(qoi_hash(px))\v = px\v
              Else                  ; QOI_OP_RUN
                run = *b\b[0] & $3f
                *b + 1
              EndIf
          EndSelect
        EndIf
        *px\v = px\v
        *px + 4        
      Wend
      db + pitch
      height - 1
    Wend
    StopDrawing()
  EndIf
  
  ProcedureReturn result
EndProcedure

Code: Select all

DataSection
  Image:
  IncludeBinary "qoi_test_images/dice.qoi"
  ImageEnd:
EndDataSection

If CatchQOI(0, ?Image, ?ImageEnd - ?Image)
  OpenWindow(0, 0, 0, 800, 600, "QOI Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  ImageGadget(0, 0, 0, 800, 600, ImageID(0))
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

[netmaestro]

I guess browsers won't recognize or understand it for now?

[wilbert]

I guess browsers won't recognize or understand it for now?

No and that probably will never happen.
But there are a few plugins for image editors and a plugin to make windows show thumbnails.
The image format could be very useful when you want to embed some images inside an application and don't want to include the png or jpg decoders.