/pliant/graphic/color/gradation.pli
1	abstract
2	[Efficients encoding/decoding handling accoding to gradation curve]
3
4
5	module "/pliant/language/unsafe.pli"
6	module "/pliant/language/stream.pli"
7	module "/pliant/math/curve.pli"
8	module "/pliant/graphic/misc/int.pli"
9
10	public
11	constant encoded_resolution 256
12	constant linear_resolution 4096
13
14	type ColorGradation
15	field (Array Float32 encoded_resolution) decode_table
16	field (Array uInt8 linear_resolution) encode_table
17	field Int maximum
18	field Status status <- failure
19
20	method cg compute
21	arg_rw ColorGradation cg
22	for (var Int i) 0 encoded_resolution-1
23	if cg:decode_table:i=undefined
24	cg status := failure
25	return
26	for (var Int i) 1 encoded_resolution-1
27	if cg:decode_table:i<=cg:decode_table:(i-1) and cg:decode_table:i<0.99
28	cg status := failure
29	return
30	var Int encoded := 0
31	for (var Int i) 0 linear_resolution-1
32	var Float linear := i/(linear_resolution-1)
33	while encoded+1<encoded_resolution and (abs linear-cg:decode_table:(encoded+1))<(abs linear-cg:decode_table:encoded)
34	encoded += 1
35	cg:encode_table i := encoded
36	cg maximum := encoded
37	cg status := success
38
39	function color_gamma gamma threshold extra -> cg
40	arg Float gamma threshold extra ; arg ColorGradation cg
41	var Float factor := threshold/((threshold+extra)/(1+extra))^gamma
42	for (var Int i) 0 encoded_resolution-1
43	var Float e := i/(encoded_resolution-1)
44	var Float l
45	if e<threshold
46	l := e/factor
47	else
48	l := ((e+extra)/(1+extra))^gamma
49	if l=undefined
50	l := 0
51	cg:decode_table i := l
52	cg compute
53
54	function color_gradation curve -> cg
55	arg Curve curve ; arg ColorGradation cg
56	# curve is level (0 - 255) -> density (0 - 1)
57	if curve=failure
58	cg status := failure
59	return
60	for (var Int i) 0 encoded_resolution-1
61	cg:decode_table i := curve y i 1e-12
62	cg compute
63
64
65	method cg decode level -> linear
66	arg ColorGradation cg ; arg Int level ; arg Float linear
67	linear := cg:decode_table level
68
69	method cg encode linear -> level
70	arg ColorGradation cg ; arg Float linear ; arg Int level
71	var Int assign := cast linear*(linear_resolution-1) Int
72	level := cg:encode_table (bound assign 0 linear_resolution-1)
73
74
75	function 'cast Status' g -> status
76	arg ColorGradation g ; arg Status status
77	extension
78	status := g status
79
80
81	export ColorGradation color_gamma color_gradation '. decode' '. encode' 'cast Status'
82	export '. decode_table' '. compute' '. maximum'