FEAT: added a simple codec for decoding/encoding ICO files

(cherry picked from commit fd67a59)

Author: Oldes

make/rebol3.nest

@@ -447,6 +447,12 @@ include-codec-tar:           [mezz-lib-files:  %mezz/codec-tar.reb          ]
 ; other codecs:
 include-codec-bbcode:        [mezz-lib-files:  %mezz/codec-bbcode.reb       ]
 include-codec-html-entities: [mezz-lib-files:  %mezz/codec-html-entities.reb]
+include-codec-ico: [
+	; at this moment ico can be encoded only from pngs!
+	:include-native-png-codec 
+	mezz-lib-files: %mezz/codec-ico.reb
+	mezz-lib-files: %mezz/codec-image-ext.reb ; png/size? function
+]
 include-codec-json:          [mezz-lib-files:  %mezz/codec-json.reb         ]
 include-codec-xml:           [mezz-lib-files:  %mezz/codec-xml.reb          ]
 include-codec-swf:           [mezz-lib-files:  %mezz/codec-swf.reb          ]
@@ -505,6 +511,7 @@ include-rebol-bulk: [
 	:include-codec-tar
 	:include-codec-bbcode
 	:include-codec-html-entities
+	:include-codec-ico
 	:include-codec-json
 	:include-codec-xml
 	:include-codec-swf

src/mezz/codec-ico.reb

@@ -0,0 +1,93 @@
+REBOL [
+	title: "REBOL 3 codec for ICO files"
+	name: 'codec-ico
+	author: rights: "Oldes"
+	version: 0.0.1
+	history: [6-Mar-2021 "Oldes" {Initial version}]
+]
+
+system/options/log/ico: 2
+register-codec [
+	name:  'ico
+	title: "Windows icon or cursor file"
+	suffixes: [%.ico %.cur]
+
+	decode: function [
+		{Extract content of the ICO file}
+		data  [binary! file! url!]
+	][
+		unless binary? data [ data: read data ]
+		sys/log/info 'ICO ["^[[1;32mDecode ICO data^[[m (^[[1m" length? data "^[[mbytes )"]
+		bin: binary data
+		;- ICONDIR:
+		binary/read bin [ tmp: UI16LE type: UI16LE num: UI16LE ]
+		unless all [tmp = 0 any [type = 1 type = 2] ] [return none]
+		icons: copy []
+		repeat n num [
+			binary/read bin [
+				width:  UI8
+				height: UI8
+				colors: UI8
+						UI8
+				planes: UI16LE
+				bpp:    UI16LE
+				size:   UI32LE
+				ofs:    UI32LE
+			]
+			binary/read bin [
+				pos:    INDEX
+						ATz   :ofs
+				data:   BYTES :size
+						AT    :pos
+			]
+			if width  = 0 [width:  256]
+			if height = 0 [height: 256]
+			sys/log/more 'ICO ["Image^[[1;33m" n "^[[0;36mbpp:^[[33m" bpp "^[[36mcolors:^[[33m" colors "^[[36msize:^[[33m" as-pair width height]
+			append/only icons reduce [width bpp data]
+		]
+		icons
+	]
+	encode: function [
+		data [block!]
+	][
+		out: binary 30000
+		images: copy []
+		parse data [
+			some [
+				set file: file! (
+					bin: read/binary file
+					if size: codecs/png/size? bin [
+						append/only images reduce ['png to integer! size/1 32 bin]
+					]
+				)
+			]
+		]
+		imgs: length? images
+		offset: 6 + (imgs * 16)
+		img-data: clear #{}
+		binary/write out [UI16LE 0 UI16LE 1 UI16LE :imgs]
+
+		forall images [
+			set [type: size: bpp: bin:] images/1
+			bytes: length? bin
+			if size = 256 [size: 0]
+			binary/write out [
+				UI8    :size
+				UI8    :size
+				UI16LE 0 ;colors
+				UI16LE 0 ;planes
+				UI16LE :bpp
+				UI32LE :bytes
+				UI32LE :offset
+			]
+			append img-data bin
+			offset: offset + length? bin
+		]
+		binary/write out img-data
+		copy out/buffer
+	]
+
+	identify: function [data [binary!]][
+		parse b [#{0000} [#{0100} | #{0200}] to end] ;.ico or .cur
+	]
+]

src/tests/units/codecs-test.r3

@@ -280,6 +280,38 @@ if find codecs 'unixtime [
 	===end-group===
 ]
 
+if all [
+	find codecs 'ICO
+	find codecs 'PNG
+][
+	===start-group=== "ICO codec"
+	--test-- "ICO encode"
+		--assert all [
+			binary? bin: try [codecs/ico/encode [
+			    %units/files/ico/icon_16.png
+			    %units/files/ico/icon_24.png
+			    %units/files/ico/icon_32.png
+			    %units/files/ico/icon_48.png
+			    %units/files/ico/icon_128.png
+			]]
+			#{35FB14C61A0E81F4FC525B9243116D3C} = checksum bin 'md5
+		]
+	--test-- "ICO decode"
+		--assert all [
+			block? ico: try [codecs/ico/decode %units/files/test.ico]
+			ico/1/1 = 16   ico/1/2 = 32  binary? ico/1/3
+			ico/2/1 = 24   ico/2/2 = 32  binary? ico/2/3
+			ico/3/1 = 32   ico/3/2 = 32  binary? ico/3/3
+			ico/4/1 = 48   ico/4/2 = 32  binary? ico/4/3
+			ico/5/1 = 128  ico/5/2 = 32  binary? ico/5/3
+		]
+		--assert all [
+			image? img: try [decode 'png ico/1/3]
+			16x16 = img/size
+		]
+	===end-group===
+]
+
 if find codecs 'JSON [
 	===start-group=== "JSON codec"
 	--test-- "JSON encode/decode"