|
|
1.1 root 1: motiondemo = proc ()
2: vcount = 500
3: bwidth: int := int$parse(xdemo_default("motion", "BorderWidth"))
4: except when not_found, overflow, bad_format: bwidth := 2 end
5: back: x_pixmap := x_display$white()
6: bdr: x_pixmap := x_display$black()
7: plane: int := 1
8: backpix: int := WhitePixel
9: linepix: int := BlackPixel
10: mousepix: int := BlackPixel
11: if x_display$cells() > 2
12: then begin
13: r, g, b: int := x_parse_color(xdemo_default("motion", "Border"))
14: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
15: end except when not_found: end
16: pixs: pixellist
17: pixs, plane := x_display$alloc_cells(1, 1, false)
18: backpix := pixs[1]
19: back := x_pixmap$tile(backpix)
20: linepix := backpix + plane
21: r, g, b: int := x_parse_color(xdemo_default("motion", "Background"))
22: except when not_found:
23: r, g, b := x_display$query_color(WhitePixel)
24: end
25: x_display$store_color(backpix, r, g, b)
26: random_color(linepix)
27: begin
28: r, g, b := x_parse_color(xdemo_default("motion", "Mouse"))
29: mousepix := x_display$alloc_color(r, g, b)
30: end except when not_found: end
31: end
32: w: x_window, wid0, hgt0: int := x_cons("motion", back, bdr,
33: xdemo_geometry(), "=400x400+1+1",
34: 40, 40, bwidth)
35: w.name := "motion"
36: w.input := ButtonPressed + UnmapWindow
37: x_window$map(w)
38: cr: x_cursor := x_cursor$scons(cross_width, cross_height,
39: cross, cross_mask,
40: backpix, mousepix, cross_x, cross_y,
41: GXcopy)
42: w.cursor := cr
43: w.input := ButtonPressed + ExposeWindow + UnmapWindow
44: vlist: x_vlist := x_vlist$create(vcount + 1)
45: ovlist: x_vlist := x_vlist$create(vcount + 1)
46: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
47: height := height - 1
48: width := width - 1
49: ev: event := x_input$empty_event()
50: nobit: x_bitmap := x_bitmap$none()
51: while true do
52: n: int := 0
53: while n < vcount do
54: x_input$deq(ev)
55: if ev.kind = ExposeWindow
56: then sx, sy, width, height, bw, ms, wk, iw := x_window$query(w)
57: if width <= 30 cor height <= 30
58: then x_window$destroy(w)
59: return
60: end
61: height := height - 1
62: width := width - 1
63: x_window$clear(w)
64: for i: int in int$from_to(1, n) do
65: x, y, flags: int := x_vlist$fetch(vlist, i)
66: x_window$pix_fill(w, 0, nobit, x, y, 2, 2, GXinvert, 1)
67: end
68: continue
69: elseif ev.kind = UnmapWindow
70: then continue end
71: if ev.value = MiddleButton
72: then break end
73: x_window$pix_fill(w, 0, nobit, ev.x, ev.y, 2, 2, GXinvert, 1)
74: n := n + 1
75: flags: int := 0
76: if ev.value = LeftButton
77: then flags := VertexCurved end
78: x_vlist$store(vlist, n, ev.x, ev.y, flags)
79: end
80: x_window$clear(w)
81: if n > 2
82: then x, y, flags: int := x_vlist$fetch(vlist, 1)
83: x_vlist$store(vlist, 1, x, y, flags + VertexStartClosed)
84: n := n + 1
85: x_vlist$store(vlist, n, x, y, flags + VertexEndClosed)
86: elseif n < 2
87: then continue end
88: x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1)
89: xd: int := -1
90: dx: int := 1
91: yd: int := -1
92: dy: int := 1
93: count: int := 0
94: while true do
95: if xd < 0
96: then xd := random$next(width)
97: dx := random$next(2)
98: else xd := xd - 1
99: end
100: if yd < 0
101: then yd := random$next(height)
102: dy := random$next(2)
103: else yd := yd - 1
104: end
105: for i: int in int$from_to(1, n - 1) do
106: xx, yy, flags: int := x_vlist$fetch(vlist, i)
107: x_vlist$store(ovlist, i, xx, yy, flags)
108: x: int := random$next(5)
109: if dx = 0
110: then x := -x end
111: x := x + xx
112: if x < 0
113: then x := 0
114: xd := -1
115: if linepix ~= BlackPixel
116: then random_color(linepix) end
117: elseif x > width
118: then x := width
119: xd := -1
120: if linepix ~= BlackPixel
121: then random_color(linepix) end
122: end
123: y: int := random$next(5)
124: if dy = 0
125: then y := -y end
126: y := y + yy
127: if y < 0
128: then y := 0
129: yd := -1
130: if linepix ~= BlackPixel
131: then random_color(linepix) end
132: elseif y > height
133: then y := height
134: yd := -1
135: if linepix ~= BlackPixel
136: then random_color(linepix) end
137: end
138: x_vlist$store(vlist, i, x, y, flags)
139: end
140: if n > 2
141: then x, y, flags: int := x_vlist$fetch(vlist, n)
142: x_vlist$store(ovlist, n, x, y, flags)
143: x, y, flags := x_vlist$fetch(vlist, 1)
144: x_vlist$store(vlist, n, x, y,
145: flags + (VertexEndClosed - VertexStartClosed))
146: end
147: x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1)
148: x_window$draw(w, ovlist, n, 0, 1, 1, GXinvert, 1)
149: if count = 4
150: then count := 0
151: else count := count + 1
152: end
153: if count ~= 0 cor ~x_input$pending()
154: then continue end
155: x_input$deq(ev)
156: if ev.kind = UnmapWindow
157: then x_input$deq(ev) end
158: if ev.kind = ExposeWindow
159: then sx, sy, width, height, bw, ms, wk, iw := x_window$query(w)
160: if width <= 30 cor height <= 30
161: then x_window$destroy(w)
162: return
163: end
164: height := height - 1
165: width := width - 1
166: x_window$clear(w)
167: x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1)
168: elseif ev.value = MiddleButton
169: then break end
170: end
171: end
172: end motiondemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.