|
|
1.1 root 1: % from Steve Ward
2:
3: webdemo = proc ()
4: ai = array[int]
5: minord = 7
6: maxord = 16
7: minweb = 10
8: maxweb = 45
9: bwidth: int := int$parse(xdemo_default("web", "BorderWidth"))
10: except when not_found, overflow, bad_format: bwidth := 2 end
11: back: x_pixmap := x_display$white()
12: bdr: x_pixmap := x_display$black()
13: linepix: int := BlackPixel
14: if x_display$cells() > 2
15: then begin
16: r, g, b: int := x_parse_color(xdemo_default("web", "Background"))
17: back := x_pixmap$tile(x_display$alloc_color(r, g, b))
18: end except when not_found: end
19: begin
20: r, g, b: int := x_parse_color(xdemo_default("web", "Border"))
21: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
22: end except when not_found: end
23: linepix := x_display$alloc_cell()
24: end
25: w: x_window, wid0, hgt0: int := x_cons("web", back, bdr,
26: xdemo_geometry(), "=400x400+1+1",
27: 40, 40, bwidth)
28: w.name := "web"
29: w.input := UnmapWindow
30: x_window$map(w)
31: w.input := ExposeWindow + UnmapWindow
32: ev: event := x_input$empty_event()
33: while true do
34: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
35: if width <= 30 cor height <= 30
36: then x_window$destroy(w)
37: return
38: end
39: height := height - 1
40: width := width - 1
41: pvec: ai := ai$fill(0, maxord * 2, 0)
42: x: ai := ai$fill(0, maxord, 0)
43: y: ai := ai$fill(0, maxord, 0)
44: dx: ai := ai$fill(0, maxord, 0)
45: dy: ai := ai$fill(0, maxord, 0)
46: vlist: x_vlist := x_vlist$create(maxord * 2 * 2)
47: while ~x_input$pending() do
48: x_window$clear(w)
49: if linepix ~= BlackPixel
50: then random_color(linepix) end
51: order: int := minord + random$next(maxord - minord + 1)
52: sweb: int := minweb + (random$next(maxweb) * 2**random$next(4)) / 8
53: for i: int in int$from_to_by(0, 2 * order - 2, 2) do
54: pvec[i] := random$next(width)
55: pvec[i + 1] := random$next(height)
56: end
57: for i: int in int$from_to(0, order - 1) do
58: x[i] := 32 * pvec[2 * i]
59: y[i] := 32 * pvec[2 * i + 1]
60: if i ~= 0
61: then dx[i - 1] := ((x[i] - x[i - 1]) * 32) / (sweb * 32)
62: dy[i - 1] := ((y[i] - y[i - 1]) * 32) / (sweb * 32)
63: end
64: end
65: order := order - 1
66: for j: int in int$from_to_by(0, sweb, 2) do
67: xx: int := int$max(0, int$min(x[0] / 32, width))
68: yy: int := int$max(0, int$min(y[0] / 32, height))
69: x[0] := x[0] + dx[0]
70: y[0] := y[0] + dy[0]
71: idx: int := 1
72: for i: int in int$from_to(1, order - 1) do
73: nx: int := int$max(0, int$min(x[i] / 32, width))
74: ny: int := int$max(0, int$min(y[i] / 32, height))
75: x_vlist$store(vlist, idx, xx, yy, VertexDontDraw)
76: x_vlist$store(vlist, idx + 1, nx, ny, VertexDrawLastPoint)
77: idx := idx + 2
78: xx := nx
79: yy := ny
80: x[i] := x[i] + dx[i]
81: y[i] := y[i] + dy[i]
82: end
83: j := j + 1
84: if j > sweb
85: then x_window$draw(w, vlist, idx - 1, linepix, 1, 1,
86: GXcopy, -1)
87: break
88: end
89: i: int := order - 1
90: xx := int$max(0, int$min(x[i] / 32, width))
91: yy := int$max(0, int$min(y[i] / 32, height))
92: x[i] := x[i] + dx[i]
93: y[i] := y[i] + dy[i]
94: for i in int$from_to_by(i - 1, 0, -1) do
95: nx: int := int$max(0, int$min(x[i] / 32, width))
96: ny: int := int$max(0, int$min(y[i] / 32, height))
97: x_vlist$store(vlist, idx, xx, yy, VertexDontDraw)
98: x_vlist$store(vlist, idx + 1, nx, ny, VertexDrawLastPoint)
99: idx := idx + 2
100: xx := nx
101: yy := ny
102: x[i] := x[i] + dx[i]
103: y[i] := y[i] + dy[i]
104: end
105: x_window$draw(w, vlist, idx - 1, linepix, 1, 1, GXcopy, -1)
106: end
107: x_flush()
108: sleep(2)
109: end
110: x_input$deq(ev)
111: if ev.kind = UnmapWindow
112: then x_input$deq(ev) end
113: end
114: end webdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.