/pliant/graphic/filter/packed.pli
1	module "/pliant/language/compiler.pli"
2	module "/pliant/language/stream.pli"
3	module "/pliant/language/stream/filesystembase.pli"
4	module "/pliant/util/encoding/pack4.pli"
5	module "/pliant/graphic/filter/prototype.pli"
6	module "/pliant/graphic/color/gamut.pli"
7
8
9	constant default_tile_x 512
10	constant default_tile_y 16
11
12
13	type ImageReadFilterPacked
14	field Stream stream
15	field Int size_x size_y pixel_size
16	field Int tile_x tile_y
17	field CBool plan
18	field Array:Address lines
19	field Address cbuf
20	field Int y
21
22	ImageReadFilter maybe ImageReadFilterPacked
23
24
25	method f open stream options h -> status
26	arg_rw ImageReadFilterPacked f ; arg_rw Stream stream ; arg Str options ; arg_w ImagePrototype h ; arg ExtendedStatus status
27	f:stream open "gzip:" "" in+safe pliant_default_file_system stream
28	if f:stream=failure
29	return (failure "Failed to open gzip stream")
30	if f:stream:readline<>"pliant image packed"
31	return failure
32	f plan := false
33	h options := ""
34	var Str gamut_name
35	while { var Str l := f:stream readline ; l<>"" }
36	l parse word:"x0" h:x0
37	l parse word:"y0" h:y0
38	l parse word:"x1" h:x1
39	l parse word:"y1" h:y1
40	l parse word:"size_x" h:size_x
41	l parse word:"size_y" h:size_y
42	l parse word:"gamut" gamut_name
43	l parse word:"tile_x" f:tile_x
44	l parse word:"tile_y" f:tile_y
45	if l="plan"
46	f plan := true
47	l parse word:"options" h:options
48	h gamut :> color_gamut gamut_name
49	h complete
50	f size_x := h size_x
51	f size_y := h size_y
52	f pixel_size := h pixel_size
53	f:lines size := f:tile_y
54	for (var Int i) 0 f:tile_y-1
55	f:lines i := memory_allocate h:line_size addressof:f
56	f cbuf := memory_allocate 2*f:tile_x*f:tile_y*f:pixel_size addressof:f
57	f y := 0
58	status := success
59
60	method f readline adr -> status
61	arg_rw ImageReadFilterPacked f ; arg Address adr ; arg Status status
62	if f:y%f:tile_y=0
63	var Int tile_y := min f:size_y-f:y f:tile_y
64	for (var Int x) 0 f:size_x-1 step f:tile_x
65	var Int tile_x := min f:size_x-x f:tile_x
66	f:stream raw_read addressof:(var Int32 csize) Int32:size
67	f:stream raw_read f:cbuf csize
68	if f:plan
69	var Int offset := 0
70	for (var Int c) 0 f:pixel_size-1
71	for (var Int i) 0 tile_y-1
72	var Address previous := null
73	if i>0
74	previous := f:lines:(i-1) translate Byte x*f:pixel_size+c
75	offset += pack4_plan_decode (f:cbuf translate Byte offset) (f:lines:i translate Byte x*f:pixel_size+c) f:pixel_size tile_x previous
76	else
77	var Int offset := 0
78	for (var Int i) 0 tile_y-1
79	var Address previous := null
80	if i>0
81	previous := f:lines:(i-1) translate Byte x*f:pixel_size
82	offset += pack4_decode (f:cbuf translate Byte offset) (f:lines:i translate Byte x*f:pixel_size) f:pixel_size tile_x previous
83	memory_copy f:lines:(f:y%f:tile_y) adr f:size_x*f:pixel_size
84	f y += 1
85	status := success
86
87	method f close -> status
88	arg_rw ImageReadFilterPacked f ; arg ExtendedStatus status
89	f:stream close
90	for (var Int i) 0 f:lines:size-1
91	memory_free f:lines:i
92	memory_free f:cbuf
93	status := success
94
95
96
97
98
99	type ImageWriteFilterPacked
100	field Stream stream
101	field Int size_x size_y pixel_size
102	field Int tile_x tile_y
103	field CBool plan
104	field Array:Address lines
105	field Address cbuf
106	field Int base_y y
107
108	ImageWriteFilter maybe ImageWriteFilterPacked
109
110
111	method f open stream options h -> status
112	arg_rw ImageWriteFilterPacked f ; arg_rw Stream stream ; arg Str options ; arg ImagePrototype h ; arg ExtendedStatus status
113	f:stream open "gzip:" options out+safe pliant_default_file_system stream
114	if f:stream=failure
115	return (failure "Failed to open gzip stream")
116	f size_x := h size_x
117	f size_y := h size_y
118	f pixel_size := h pixel_size
119	f tile_x := options option "tile_x" Int (min h:size_x default_tile_x)
120	f tile_y := options option "tile_y" Int (min h:size_y default_tile_y)
121	f plan := options option "plan"
122	f:lines size := f:tile_y
123	for (var Int i) 0 f:tile_y-1
124	f:lines i := memory_allocate h:line_size addressof:f
125	f cbuf := memory_allocate 2*f:tile_x*f:tile_y*f:pixel_size addressof:f
126	f:stream writeline "pliant image packed"
127	f:stream writeline "x0 "+(string h:x0)
128	f:stream writeline "y0 "+(string h:y0)
129	f:stream writeline "x1 "+(string h:x1)
130	f:stream writeline "y1 "+(string h:y1)
131	f:stream writeline "size_x "+(string h:size_x)
132	f:stream writeline "size_y "+(string h:size_y)
133	f:stream writeline "tile_x "+(string f:tile_x)
134	f:stream writeline "tile_y "+(string f:tile_y)
135	if f:plan
136	f:stream writeline "plan"
137	f:stream writeline "gamut "+(string h:gamut:name)
138	f:stream writeline "pixel_size "+(string h:gamut:pixel_size)
139	if h:options<>""
140	f:stream writeline "options "+(string h:options)
141	f:stream writeline ""
142	f base_y := 0 ; f y := 0
143	status := success
144
145	method f writeline adr -> status
146	arg_rw ImageWriteFilterPacked f ; arg Address adr ; arg Status status
147	memory_copy adr f:lines:(f:y%f:tile_y) f:size_x*f:pixel_size
148	f y += 1
149	if f:y%f:tile_y=0 or f:y=f:size_y
150	var Int tile_y := f:y-f:base_y
151	for (var Int x) 0 f:size_x-1 step f:tile_x
152	var Int tile_x := min f:size_x-x f:tile_x
153	if f:plan
154	var Int32 csize := 0
155	for (var Int c) 0 f:pixel_size-1
156	for (var Int i) 0 tile_y-1
157	var Address previous := null
158	if i>0
159	previous := f:lines:(i-1) translate Byte x*f:pixel_size+c
160	csize += pack4_plan_encode (f:lines:i translate Byte x*f:pixel_size+c) (f:cbuf translate Byte csize) f:pixel_size tile_x previous
161	else
162	var Int32 csize := 0
163	for (var Int i) 0 tile_y-1
164	var Address previous := null
165	if i>0
166	previous := f:lines:(i-1) translate Byte x*f:pixel_size
167	csize += pack4_encode (f:lines:i translate Byte x*f:pixel_size) (f:cbuf translate Byte csize) f:pixel_size tile_x previous
168	f:stream raw_write addressof:csize Int32:size
169	f:stream raw_write f:cbuf csize
170	f base_y := f y
171	status := shunt f:stream=success success failure
172
173	method f close -> status
174	arg_rw ImageWriteFilterPacked f ; arg ExtendedStatus status
175	f:stream close
176	for (var Int i) 0 f:lines:size-1
177	memory_free f:lines:i
178	memory_free f:cbuf
179	status := success
180
181	image_record_filters ".packed" ImageReadFilterPacked false ImageWriteFilterPacked false
182
183
184