/pliant/graphic/image/resampling.pli
1	module "/pliant/language/compiler.pli"
2	submodule "prototype.pli"
3	module "/pliant/language/compiler/type/inherit.pli"
4	module "/pliant/graphic/misc/int.pli"
5	module "/pliant/graphic/misc/mtbuffer.pli"
6
7
8	type ImageResampling
9	inherit ImagePrototype
10	field Link:ImagePrototype image
11	field Float translate_x translate_y
12	field CBool same_resolution
13	field Array:Int xs offsets
14	field Float delta_x step_x delta_y step_y
15	field Int start_x stop_x
16	field MtBuffer buffers
17
18	ImagePrototype maybe ImageResampling
19
20
21	method r map_pixel x y xx yy
22	arg_rw ImageResampling r ; arg Int x y ; arg_w Float xx yy
23	var Float mm_x := r:x0+(x+0.5)*(r:x1-r:x0)/r:size_x
24	mm_x -= r translate_x
25	xx := (mm_x-r:image:x0)/(r:image:x1-r:image:x0)*r:image:size_x-0.5
26	var Float mm_y := r:y0+(y+0.5)*(r:y1-r:y0)/r:size_y
27	mm_y -= r translate_y
28	yy := (mm_y-r:image:y0)/(r:image:y1-r:image:y0)*r:image:size_y-0.5
29
30
31	method r bind image x0 y0 x1 y1 size_x size_y tx ty -> status
32	arg_rw ImageResampling r ; arg ImagePrototype image ; arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; arg Float tx ty ; arg ExtendedStatus status
33	addressof:r map ImagePrototype := addressof:image map ImagePrototype
34	r x0 := x0 ; r y0 := y0 ; r x1 := x1 ; r y1 := y1
35	r size_x := size_x ; r size_y := size_y
36	r image :> image
37	r translate_x := tx ; r translate_y := ty
38	r map_pixel 0 0 r:delta_x r:delta_y
39	r map_pixel 1 1 r:step_x r:step_y ; r step_x -= r delta_x ; r step_y -= r delta_y
40	r same_resolution := (abs (x1-x0)/size_x-(image:x1-image:x0)/image:size_x)<1e-6 and (abs (y1-y0)/size_y-(image:y1-image:y0)/image:size_y)<1e-6
41	r:xs size := r size_x ; r:offsets size := r size_x
42	r start_x := 0 ; r stop_x := r:size_x
43	for (var Int x) 0 r:size_x-1
44	var Int ix := cast r:delta_x+x*r:step_x Int
45	if ix<0
46	if r:step_x>=0
47	r start_x := x+1
48	else
49	r stop_x := min x r:stop_x
50	eif ix>=r:image:size_x
51	if r:step_x>=0
52	r stop_x := min x r:stop_x
53	else
54	r start_x := x+1
55	else
56	r:xs x := ix ; r:offsets x := ix*image:pixel_size
57	r:buffers size := image line_size
58	status := success
59
60	method r bind image x0 y0 x1 y1 size_x size_y -> status
61	arg_rw ImageResampling r ; arg ImagePrototype image ; arg Float x0 y0 x1 y1 ; arg Int size_x size_y ; arg ExtendedStatus status
62	status := r bind image x0 y0 x1 y1 size_x size_y 0 0
63
64	method r setup image options -> status
65	oarg_rw ImageResampling r ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
66	if not ((options (options option_position "area" 0) options:len) parse word:"area" (var Float x0) (var Float y0) (var Float x1) (var Float y1) any)
67	x0 := image x0 ; y0 := image y0 ; x1 := image x1 ; y1 := image y1
68	if not ((options (options option_position "size" 0) options:len) parse word:"size" (var Int size_x) (var Int size_y) any)
69	return failure:"Resampled image size not specified"
70	if not ((options (options option_position "translate" 0) options:len) parse word:"translate" (var Float tx) (var Float ty) any)
71	tx := 0 ; ty := 0
72	status := r bind (addressof:image omap ImagePrototype) x0 y0 x1 y1 size_x size_y tx ty
73
74
75	method r read x y count adr
76	arg_rw ImageResampling r ; arg Int x y count ; arg Address adr
77	check x>=0 and count>=0 and x+count<=r:size_x and y>=0 and y<r:size_y
78	var Int iy := cast r:delta_y+y*r:step_y Int
79	if iy<0 or iy>=r:image:size_y
80	memory_clear adr count*r:pixel_size
81	eif x<r:start_x
82	var Int n := min r:start_x-x count
83	memory_clear adr n*r:pixel_size
84	if n<count
85	r read x+n y count-n (adr translate Byte n*r:pixel_size)
86	eif x+count>r:stop_x
87	var Int n := min x+count-r:stop_x count
88	memory_clear (adr translate Byte (count-n)*r:pixel_size) n*r:pixel_size
89	if n<count
90	r read x y count-n adr
91	else
92	var Address buffer := r:buffers allocate
93	var Int done := 0
94	while done<count
95	var Int ix0 := r:xs x+done
96	var Int ix1 := (r:xs x+count-1)+1
97	if ix1<ix0
98	swap ix0 ix1
99	var Address map := r:image read_map ix0 iy 1 ix1-ix0 (var Int map_count)
100	var Address buf ; var Int step
101	if map<>null
102	buf := map translate Byte -ix0*r:pixel_size
103	if map_count=ix1-ix0
104	step := count-done
105	else
106	var Int step := bound (cast ((ix0+map_count)-r:delta_x)/r:step_x Int)-(x+done) 1 count-done
107	while (r:xs x+done+step-1)>=ix0+map_count
108	step -= 1
109	else
110	r:image read ix0 iy ix1-ix0 (buffer translate Byte ix0*r:pixel_size)
111	buf := buffer ; step := count-done
112	if r:same_resolution
113	memory_copy (buf translate Byte (r:offsets x+done)) (adr translate Byte done*r:pixel_size) step*r:pixel_size
114	else
115	var Address ptr := addressof (r:offsets x+done)
116	var Address cur := adr translate Byte done*r:pixel_size ; var Address stop := cur translate Byte step*r:pixel_size
117	while cur<>stop
118	memory_copy (buf translate Byte (ptr map Int)) cur r:pixel_size
119	cur := cur translate Byte r:pixel_size
120	ptr := ptr translate Int 1
121	if map<>null
122	r:image read_unmap ix0 iy map_count map
123	done += step
124	r:buffers free buffer
125
126
127	export ImageResampling '. bind'
128
129