rev: 3827f53bae88e48a594610914ba74b9512ead6dd tukan/testing/test_bluenoise.sc -rw-r--r-- 4.9 KiB View raw Log this file
3827f53bae88 — Leonard Ritter * more work on module system 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
#!/usr/bin/env scopes

using import glm
using import glsl
using import itertools
using import ..tukan.gl
using import ..tukan.bitmap
using import ..tukan.random
using import .testfragment

import ..tukan.blur
let blur = tukan.blur

let N = 512
let R2 = 9

local random : (Random)

let image =
    Bitmap1 (ivec2 N)
for x y in (dim N N)
    ('fetch image x y) =
        (x % 256) as u8
#static-if true
    # shuffle
    for n in (range (N * N * 4))
        let x0 y0 =
            'range random N
            'range random N
        let x1 y1 =
            (+ x0 1 ('range random (N - 1))) % N
            (+ y0 1 ('range random (N - 1))) % N
        let p0 =
            'fetch image x0 y0
        let p1 =
            'fetch image x1 y1
        let v0 v1 =
            deref p0; deref p1
        p0 = v1
        p1 = v0

fn gaussian (x mu sigma)
    h := (x - mu) / sigma
    h := h * h * -0.5:f64
    a := 1.0:f64 / (sigma * (sqrt (2.0:f64 * pi:f64)))
    a * (exp h)

# 1.4375
# 1.40625
# 1.390625
# 1.3984375
# 1.39453125

let lo = 1.390625:f64
let hi = 1.3984375:f64
let mid = (((lo + hi) * 0.5) as f64)
let mid = 1.414214:f64
print "sigma=" mid
print "smallest coefficient=" (gaussian (R2 / 2) 0.0:f64 mid)
#if true
    exit 0

fn quantify-error (image x y R2 val0 val1)
    let Rf = ((R2 / 2) as f64)
    let R = (Rf as i32)
    local has0 = 0.0:f64
    local has1 = 0.0:f64
    local w = 0.0:f64

    for sx sy in (dim R2 R2)
        let sx sy =
            sx - R
            sy - R
        let d = (length (dvec2 sx sy))
        if ((d > Rf) | ((sx == 0) & (sy == 0)))
            continue;
        let px =
            (x + sx + N) % N
        let py =
            (y + sy + N) % N
        let v = (deref ('fetch image px py))

        let dist0 = (abs ((v as i32) - (val0 as i32)))
        let dist1 = (abs ((v as i32) - (val1 as i32)))

        let q = (gaussian d 0.0:f64 mid)

        w += 1.0:f64
        inline distf (x)
            1.0:f64 - (clamp ((x / 255) as f64) 0.0:f64 1.0:f64)
        has0 += ((distf dist0) * q)
        has1 += ((distf dist1) * q)

    _
        has0 / w
        has1 / w

global rando-chance = 0.25
fn exchange (image random x0 y0 x1 y1)
    let p0 =
        'fetch image x0 y0
    let p1 =
        'fetch image x1 y1

    let v0 = (deref p0)
    let v1 = (deref p1)

    if (('random-f32 random) < rando-chance)
        p0 = v1
        p1 = v0
        return true

    let s0 x0 = (quantify-error image x0 y0 R2 v0 v1)
    let s1 x1 = (quantify-error image x1 y1 R2 v1 v0)

    inline pow2 (x) (x * x)

    let err_s =
        +
            pow2 s0
            pow2 s1
    let err_x =
        +
            pow2 x0
            pow2 x1

    if (err_x < err_s)
        p0 = v1
        p1 = v0
        true
    else
        false

global passno = 0
fn process (image random)
    local changes = 0

    #
        inline coords (k)
            _ (k // N) (k % N)

        let NN = (N * N)
        for k1 in (range (k0 + 1) NN 977)
            let x0 y0 = (coords k0)
            let x1 y1 = (coords k1)
            if (exchange image x0 y0 x1 y1)
                changes += 1
        k0 += 1

    let xorval =
        'range random (N * N)
    for x0 y0 in (dim N N)
        let x1 =
            (x0 ^ xorval) % N
        let y1 =
            (y0 ^ xorval) % N
        if (exchange image random x0 y0 x1 y1)
            changes += 1

    #for i in (range (N * N))
        let x0 y0 =
            'range random N
            'range random N
        let x1 y1 =
            (+ x0 1 ('range random (N - 1))) % N
            (+ y0 1 ('range random (N - 1))) % N
        if (exchange image random x0 y0 x1 y1)
            changes += 1
    rando-chance = (max 0.0 (rando-chance - 0.01))
    passno += 1
    print (deref passno) changes (deref rando-chance)

inline main ()
    let texture0 = (GL.CreateTexture GL.TEXTURE_2D)
    let texture1 = (GL.CreateTexture GL.TEXTURE_2D)

    'setup texture0
        bitmap = image
    'setup texture1
        bitmap = image

    uniform smp0 : sampler2D
        location = 2
    uniform smp1 : sampler2D
        location = 3

    global frame = 0
    inline per-frame-setup ()
        let oldtex newtex =
            if (frame == 0)
                _ (view texture1) (view texture0)
            else
                _ (view texture0) (view texture1)
        process image random
        'update newtex image
        GL.BindTextureUnit 0 newtex
        GL.BindTextureUnit 1 oldtex
        GL.Uniform smp0 0
        GL.Uniform smp1 1
        frame = (frame + 1) % 2

    inline shader (uv)
        let r0 = ((texture smp0 uv) . r)
        let r1 = ((texture smp1 uv) . r)
        vec4 (vec3 r0) 1
    #
        if (r0 == r1)
            #vec4 r0 r0 r0 1
            vec4 0 0 0 1
        else
            vec4 1 1 1 1

    # need to move test_texture to caller so resource survives
    _ per-frame-setup shader

render-fragment-shader main
    #debug = true
    size = (ivec2 N)
'save-png image (.. module-dir "/bluenoise.png")