/pliant/graphic/image/sharpening.pli
1	module "/pliant/language/compiler.pli"
2	submodule "prototype.pli"
3	module "/pliant/language/compiler/type/inherit.pli"
4	module "/pliant/graphic/color/gamut.pli"
5	module "/pliant/graphic/misc/int.pli"
6
7	# FIXME: Sharpening is not burst compatible
8
9	type ImageSharpening
10	inherit ImagePrototype
11	field Link:ImagePrototype image
12	field Address buffer ; field Int y
13	field Float intensity
14	field ColorBuffer ground
15	field Array:Float32 remain
16	field uInt random_bits ; field Int random_available
17
18	ImagePrototype maybe ImageSharpening
19
20
21	function build s
22	arg_w ImageSharpening s
23	s buffer := null
24
25	function destroy s
26	arg_w ImageSharpening s
27	memory_free s:buffer
28
29
30	method s bind image intensity -> status
31	arg_rw ImageSharpening s ; oarg ImagePrototype image ; arg Float intensity ; arg ExtendedStatus status
32	memory_free s:buffer
33	addressof:s map ImagePrototype := addressof:image map ImagePrototype
34	s image :> image
35	s buffer := memory_allocate 3*(s:line_size+2*s:pixel_size) addressof:s
36	s y := undefined
37	s intensity := intensity/20
38	s:remain  size := s:line_size+s:gamut:pixel_size
39	for (var Int i) 0 s:remain:size-1
40	s:remain i := 0
41	s random_available := 0
42	for (var Int i) 0 s:gamut:pixel_size-1
43	s:ground:bytes i := shunt s:gamut:model=color_gamut_additive 255 0
44	status := success
45
46	method s setup image options -> status
47	arg_rw ImageSharpening s ; arg ImagePrototype image ; arg Str options ; arg ExtendedStatus status
48	var Float intensity := options option "intensity" Float
49	if intensity=undefined
50	return failure:"Sharpening intensity is not defined"
51	status := s bind (addressof:image omap ImagePrototype) intensity
52
53
54	method s read_line y buffer
55	oarg_rw ImageSharpening s ; arg Int y ; arg Address buffer
56	if y>=0 and y<s:size_y
57	memory_copy (addressof s:ground) buffer s:pixel_size
58	s:image read 0 y s:size_x (buffer translate Byte s:pixel_size)
59	memory_copy (addressof s:ground) (buffer translate Byte s:pixel_size+s:line_size) s:pixel_size
60	else
61	for (var Int x) 0 s:size_x+1
62	memory_copy (addressof s:ground) (buffer translate Byte x*s:pixel_size) s:pixel_size
63
64	function min a b c -> m
65	arg Int a b c m
66	m := min (min a b) c
67
68	function max a b c -> m
69	arg Int a b c m
70	m := max (max a b) c
71
72	method s read x y count adr
73	oarg_rw ImageSharpening s ; arg Int x y count ; arg Address adr
74	var Int dim := s:gamut dimension
75	var Int psize := s pixel_size
76	if y=s:y
77	void
78	eif y=s:y+1
79	memory_move (s:buffer translate Byte s:line_size+2*s:pixel_size) s:buffer 2*(s:line_size+2*s:pixel_size)
80	s read_line y+1 (s:buffer translate Byte 2*(s:line_size+2*s:pixel_size))
81	else
82	for (var Int i) 0 2
83	s read_line y+i-1 (s:buffer translate Byte i*(s:line_size+2*s:pixel_size))
84	s y := y
85	var Address src := s:buffer translate Byte s:line_size+(3+x)*s:pixel_size
86	var Int step_x := s:pixel_size
87	var Int step_y := s:line_size+2*s:pixel_size
88	var Address stop := src translate uInt8 count*s:gamut:pixel_size
89	var Address dest := adr
90	var Pointer:Float32 remain :> s:remain x*s:gamut:pixel_size
91	var uInt bits := s random_bits ; var Int available := s random_available
92	var Float intensity := s intensity
93	while src<>stop
94	for (var Int i) 0 dim-1
95	var Int v ; var Float f
96	v := -2*(src map uInt8 -step_x-step_y) + -3*(src map uInt8 -step_y) + -2*(src map uInt8 step_x-step_y)
97	v += -3*(src map uInt8 -step_x) + 20*(src map uInt8 0) + -3*(src map uInt8 step_x)
98	v += -2*(src map uInt8 -step_x+step_y) + -3*(src map uInt8 step_y) + -2*(src map uInt8 step_x+step_y)
99	f := remain+(src map uInt8)+v*intensity
100	v := bound (cast f Int) 0 255
101	dest map uInt8 := v
102	f -= v
103	if f<(-1)
104	f := -1
105	if f>1
106	f := 1
107	if available=0
108	memory_random addressof:bits uInt:size
109	available := uInt:size*8
110	if (bits .and. 1)<>0 # send to the right
111	remain := 0
112	addressof:remain map Float32 psize += f
113	else # send to the bottom
114	remain := f
115	bits := bits\2 ; available -= 1
116	src := src translate uInt8 1
117	dest := dest translate uInt8 1
118	remain :> addressof:remain map Float32 1
119	if psize>dim
120	memory_copy src dest psize-dim
121	src := src translate uInt8 psize-dim
122	dest := dest translate uInt8 psize-dim
123	remain :> addressof:remain map Float32 psize-dim
124	s random_bits := bits
125	s random_available := available
126
127
128	export ImageSharpening '. bind'
129
130
131
132
133