/pliant/graphic/misc/dither.pli
1	module "/pliant/language/unsafe.pli"
2	module "/pliant/language/stream.pli"
3	module "/pliant/util/crypto/random.pli"
4
5	constant dither_matrix_mini 192
6	constant dither_matrix_maxi 384
7	constant dither_matrix_release 1
8
9
10	type DitherMatrix
11	field (Array Array:Int) coefs
12	field Int size_x size_y
13
14	method m resize size_x size_y
15	arg_rw DitherMatrix m ; arg Int size_x size_y
16	m size_x := size_x ; m size_y := size_y
17	m:coefs size := size_y
18	for (var Int y) 0 size_y-1
19	m:coefs:y size := size_x
20
21	method m '' x y -> coef
22	arg DitherMatrix m ; arg Int x y ; arg_C Int coef
23	check x>=0 and x<m:size_x
24	check y>=0 and y<m:size_y
25	coef :> m:coefs:y x
26
27	method m cell xx yy -> coef
28	arg DitherMatrix m ; arg Int xx yy ; arg_C Int coef
29	var Int x := xx%m:size_x
30	if x<0
31	x += m size_x
32	var Int y := yy%m:size_y
33	if y<0
34	y += m size_y
35	coef :> m:coefs:y x
36
37	method m save filename
38	arg_rw DitherMatrix m ; arg Str filename
39	(var Stream s) open filename out+mkdir+safe
40	s writeline "Pliant dithering matrix"
41	s writeline "release "+string:dither_matrix_release
42	s writeline "size_x "+(string m:size_x)
43	s writeline "size_y "+(string m:size_y)
44	s writeline ""
45	for (var Int y) 0 m:size_y-1
46	s raw_write addressof:(m 0 y) m:size_x*Int:size
47
48	method m load filename -> status
49	arg_rw DitherMatrix m ; arg Str filename ; arg Status status
50	(var Stream s) open filename in+safe
51	var Int r := undefined ; var Int sx sy
52	while { var Str l := s readline ; l<>"" }
53	l parse word:"release" r
54	l parse word:"size_x" sx
55	l parse word:"size_y" sy
56	if r<>dither_matrix_release
57	return failure
58	m resize sx sy
59	for (var Int y) 0 m:size_y-1
60	s raw_read addressof:(m 0 y) m:size_x*Int:size
61	status := shunt s=success success failure
62
63	function random n -> r
64	arg Int n r
65	memory_strong_random addressof:(var uInt u) uInt:size
66	# memory_random addressof:(var uInt u) uInt:size
67	r := u%(cast n uInt)
68
69	function distance m x y radius x_stretch y_stretch -> d
70	arg DitherMatrix m ; arg Int x y radius x_stretch y_stretch ; arg Float d
71	var Int radius2 := radius*radius
72	d := 0
73	for (var Int yy) y-radius y+radius
74	var Int dy2 := (yy-y)*(yy-y)*y_stretch*y_stretch
75	if dy2<=radius2
76	for (var Int xx) x-radius x+radius
77	var Int d2 := (xx-x)*(xx-x)*x_stretch*x_stretch+dy2
78	if d2<=radius2
79	if (m cell xx yy)=defined
80	d += 1/d2
81
82	function random_matrix sx sy try radius x_stretch y_stretch -> m
83	arg Int sx sy try radius x_stretch y_stretch ; arg DitherMatrix m
84	m resize sx sy
85	var Int count := sx*sy
86	(var Array:Int buffer_x) size := count
87	(var Array:Int buffer_y) size := count
88	for (var Int y) 0 sy-1
89	for (var Int x) 0 sx-1
90	m x y := undefined
91	buffer_x x+y*sx := x
92	buffer_y x+y*sx := y
93	for (var Int index) 1 sx*sy
94	part point "point "+string:index+"/"+(string sx*sy)
95	var Int selected ; var Float best := undefined
96	for (var Int lap) 1 (min (count+1)\2 try)
97	var Int i := random count
98	var Float d := distance m buffer_x:i buffer_y:i radius x_stretch y_stretch
99	if best=undefined or d<best
100	selected := i ; best := d
101	m buffer_x:selected buffer_y:selected := index
102	count -= 1
103	buffer_x selected := buffer_x count
104	buffer_y selected := buffer_y count
105
106
107	function is_prime n -> p
108	arg Int n ; arg CBool p
109	if n<2
110	return false
111	var Int i := 2
112	while i*i<=n
113	if n%i=0
114	return false
115	i += 1
116	p := true
117
118
119	function dither_matrix index options -> m
120	arg Int index ; arg Str options ; arg DitherMatrix m
121	var Int dpi_x := options option "dpi_x" Int 1
122	var Int dpi_y := options option "dpi_y" Int 1
123	if (m load "file:/pliant_data/pliant/graphic/dithering/matrix"+string:index+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin")=failure
124	var Int m1 := options option "dither_matrix_mini" Int dither_matrix_mini
125	var Int m2 := options option "dither_matrix_maxi" Int dither_matrix_maxi
126	part shake "select dithering pattern size for channel "+string:index
127	part shake_x
128	var Int sx := m1+(random m2-m1+1)
129	if not is_prime:sx
130	restart shake_x
131	part shake_y
132	var Int sy := m1+(random m2-m1+1)
133	if not is_prime:sy
134	restart shake_y
135	for (var Int j) 0 index-1
136	(var DitherMatrix mm) load "file:/pliant_data/pliant/graphic/dithering/matrix"+string:j+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin"
137	if mm:size_x=sx or mm:size_y=sy
138	restart shake
139	part matrix "compute "+string:sx+" x "+string:sy+" dither matrix for channel "+string:index
140	m := random_matrix sx sy 64 16 (shunt dpi_y>dpi_x 2 1) (shunt dpi_x>dpi_y 2 1)
141	m save "file:/pliant_data/pliant/graphic/dithering/matrix"+string:index+(shunt dpi_x>dpi_y "x" "")+(shunt dpi_y>dpi_x "y" "")+".bin"
142
143
144	export DitherMatrix '. size_x' '. size_y' '' '. cell'
145	export dither_matrix