/pliant/graphic/image/prototype.pli
1	abstract
2	['ImagePrototype' is defining the API to deal with pixels in a Pliant image.]
3
4	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
5	#
6	# This program is free software; you can redistribute it and/or
7	# modify it under the terms of the GNU General Public License version 2
8	# as published by the Free Software Foundation.
9	#
10	# This program is distributed in the hope that it will be useful,
11	# but WITHOUT ANY WARRANTY; without even the implied warranty of
12	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13	# GNU General Public License for more details.
14	#
15	# You should have received a copy of the GNU General Public License
16	# version 2 along with this program; if not, write to the Free Software
17	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18
19	module "/pliant/language/compiler.pli"
20	module "/pliant/graphic/color/gamut.pli"
21
22	constant optimize true
23
24
25	public
26
27
28	type ImagePrototype
29	field Int size_x size_y pixel_size
30	field Link:ColorGamut gamut
31	field Float x0 y0 x1 y1
32	field Str options
33
34
35	method p setup proto options -> status
36	oarg_rw ImagePrototype p ; arg ImagePrototype proto ; arg Str options ; arg ExtendedStatus status
37	generic
38	status := failure "unsupported"
39
40	method p read x y count adr
41	oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
42	generic
43	error error_id_missing "Not implemented for "+(entry_type addressof:p):name
44
45	method p write x y count adr
46	oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
47	generic
48	error error_id_missing "Not implemented for "+(entry_type addressof:p):name
49
50	method p read_map x y mini maxi count -> adr
51	oarg_rw ImagePrototype p ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
52	generic
53	count := 0 ; adr := null
54
55	method p read_unmap x y count adr
56	oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
57	generic
58
59	method p write_map x y mini maxi count -> adr
60	oarg_rw ImagePrototype p ; arg Int x y mini maxi ; arg_w Int count ; arg Address adr
61	generic
62	count := 0 ; adr := null
63
64	method p write_unmap x y count adr
65	oarg_rw ImagePrototype p ; arg Int x y count ; arg Address adr
66	generic
67
68	method p fill x y count pixel
69	oarg_rw ImagePrototype p ; arg Int x y count ; arg Address pixel
70	generic
71	check count>0 and x>=0 and x+count<=p:size_x and y>=0 and y<p:size_y
72	function fill buf count psize pixel
73	arg Address buf ; arg Int count psize ; arg Address pixel
74	if optimize and psize=1
75	var uInt color := pixel map uInt8 ; color := color+color*2^8
76	fill buf count\2 2 addressof:color
77	if count%2=1
78	buf map uInt8 count-1 := pixel map uInt8
79	eif optimize and psize=2
80	var uInt color := pixel map uInt16 ; color := color+color*2^16
81	fill buf count\2 4 addressof:color
82	if count%2=1
83	buf map uInt16 count-1 := pixel map uInt16
84	eif optimize and psize=3
85	var uInt color := pixel map uInt32
86	var Address dest := buf ; var Address stop := dest translate Byte (count-1)*3
87	while dest<>stop
88	dest map uInt32 := color
89	dest := dest translate Byte psize
90	memory_copy pixel dest psize
91	eif optimize and psize=4
92	var uInt color := pixel map uInt32
93	var Address dest := buf ; var Address stop := dest translate uInt32 count
94	while dest<>stop
95	dest map uInt32 := color
96	dest := dest translate uInt32
97	else
98	var Address dest := buf ; var Address stop := dest translate Byte count*psize
99	while dest<>stop
100	memory_copy pixel dest psize
101	dest := dest translate Byte psize
102	var Int done := 0
103	while done<count
104	var Address start := p write_map x+done y 1 count-done (var Int step)
105	if start<>null
106	fill start step p:pixel_size pixel
107	p write_unmap x+done y step start
108	done += step
109	else
110	var Address buf := memory_allocate (count-done)*p:pixel_size null
111	fill buf count-done p:pixel_size pixel
112	p write x+done y count-done buf
113	memory_free buf
114	done := count
115
116
117	method p clip x0 y0 x1 y1
118	oarg ImagePrototype p ; arg_rw Int x0 y0 x1 y1
119	generic
120	x0 := max x0 0
121	y0 := max y0 0
122	x1 := min x1 p:size_x
123	y1 := min y1 p:size_y
124
125
126	method p rectangle_read_map x y x0 y0 x1 y1 step_x step_y -> adr
127	oarg_rw ImagePrototype p ; arg Int x y ; arg_w Int x0 y0 x1 y1 step_x step_y ; arg Address adr
128	generic
129	adr := p read_map x y 1 p:size_x-x (var Int count)
130	if adr<>null
131	x0 := x ; y0 := y ; x1 := x+count ; y1 := y+1
132	step_x := p pixel_size ; step_y := undefined
133
134	method p rectangle_read_unmap x0 y0 x1 y1 adr
135	oarg_rw ImagePrototype p ; arg Int x0 y0 x1 y1 ; arg Address adr
136	generic
137
138
139	method p query command -> answer
140	oarg_rw ImagePrototype p ; arg Str command answer
141	generic
142	answer := ""
143
144	method p configure command -> status
145	oarg_rw ImagePrototype p ; arg Str command ; arg ExtendedStatus status
146	generic
147	status := failure "unkown command"
148
149
150	method p line_size -> ls
151	arg ImagePrototype p ; arg Int ls
152	ls := p:pixel_size*p:size_x
153
154
155	method p complete
156	arg_rw ImagePrototype p
157	p pixel_size := p:gamut pixel_size
158
159	function image_prototype x0 y0 x1 y1 size_x size_y gamut -> p
160	arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; oarg ColorGamut gamut ; arg ImagePrototype p
161	check exists:gamut
162	p size_x := size_x
163	p size_y := size_y
164	p gamut :> gamut
165	p x0 := x0
166	p y0 := y0
167	p x1 := x1
168	p y1 := y1
169	p options := ""
170	p complete
171
172	constant image_adjust_extend 1001
173	constant image_adjust_reduce 1002
174	constant image_adjust_resolution 1003
175
176	function image_prototype x0 y0 x1 y1 rx ry aa_x aa_y adjust gamut -> p
177	arg Float x0 y0 x1 y1 rx ry ; arg Int aa_x aa_y adjust ; oarg ColorGamut gamut ; arg ImagePrototype p
178	check adjust>=image_adjust_extend and adjust<=image_adjust_resolution
179	var Int size_x := (max (cast (abs x1-x0)*(rx/25.4)/aa_x+(shunt adjust=image_adjust_extend 0.5 adjust=image_adjust_reduce -0.5 0) Int) 1)*aa_x
180	var Int size_y := (max (cast (abs y1-y0)*(ry/25.4)/aa_y+(shunt adjust=image_adjust_extend 0.5 adjust=image_adjust_reduce -0.5 0) Int) 1)*aa_y
181	p := image_prototype x0 y0 x0+size_x/(rx/25.4)*((x1-x0)/(abs x1-x0)) y0+size_y/(ry/25.4)*((y1-y0)/(abs y1-y0)) size_x size_y gamut
182
183	function image_prototype p options -> p2
184	arg ImagePrototype p p2 ; arg Str options
185	var Float margin := options option "margin" Float 0
186	var Float x0 := options option "x0" Float p:x0-margin
187	var Float y0 := options option "y0" Float p:y0-margin
188	var Float x1 := options option "x1" Float p:x1+margin
189	var Float y1 := options option "y1" Float p:y1+margin
190	var Link:ColorGamut g :> p gamut
191	if g:transparency>0 and (options option "drop_transparency")
192	var Link:ColorGamut g2 :> color_gamut (shunt g:name="rgba" "rgb" (replace g:name "+transparencies" ""))
193	if g2=success
194	g :> g2
195	var Int size_x := options option "size_x" Int
196	var Int size_y := options option "size_y" Int
197	if size_x<>undefined and size_y<>undefined and not (options option "resolution")
198	p2 := image_prototype x0 y0 x1 y1 size_x size_y g
199	else
200	if not ((options (options option_position "resolution" 0) options:len) parse word:"resolution" (var Float dpi_x) (var Float dpi_y) any)
201	dpi_x := options option "resolution" Float undefined ; dpi_y := dpi_x
202	if dpi_x=undefined and p:size_x<>undefined
203	dpi_x := p:size_x/(abs p:x1-p:x0)*25.4
204	if dpi_y=undefined and p:size_y<>undefined
205	dpi_y := p:size_y/(abs p:y1-p:y0)*25.4
206	if not ((options (options option_position "antialiasing" 0) options:len) parse word:"antialiasing" (var Int aa_x) (var Int aa_y) any)
207	aa_x := options option "antialiasing" Int 1 ; aa_y := aa_x
208	p2 := image_prototype x0 y0 x1 y1 dpi_x dpi_y aa_x aa_y image_adjust_extend g