![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to balls.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo|
Return to balls.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo |
1.1 root 1: % from Lucasfilm Ltd.
2:
3: ballsdemo = proc ()
4: ai = array[int]
5: n = 20
6: bsize = 21
7: rad = bsize / 2
8: nx = 48
9: ny = -36
10: nz = 80
11: qi = sequence[int]
12: dmat = sequence[qi]$[qi$[1, 13, 4, 16],
13: qi$[9, 5, 12, 8],
14: qi$[3, 15, 2, 14],
15: qi$[11, 7, 10, 6]]
16:
17: bwidth: int := int$parse(xdemo_default("balls", "BorderWidth"))
18: except when not_found, overflow, bad_format: bwidth := 2 end
19: back: x_pixmap := x_display$white()
20: bdr: x_pixmap := x_display$black()
21: plane: int := 1
22: if x_display$cells() > 2
23: then begin
24: r, g, b: int := x_parse_color(xdemo_default("balls", "Border"))
25: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
26: end except when not_found: end
27: cback: string := xdemo_default("balls", "Background")
28: except when not_found: cback := "" end
29: cfore: string := xdemo_default("balls", "Foreground")
30: except when not_found: cfore := "" end
31: if string$empty(cback) cand string$empty(cfore)
32: then exit done end
33: pixs: pixellist
34: pixs, plane := x_display$alloc_cells(1, 1, false)
35: back := x_pixmap$tile(pixs[1])
36: r, g, b: int
37: if string$empty(cback)
38: then r, g, b := x_display$query_color(WhitePixel)
39: else r, g, b := x_parse_color(cback)
40: end
41: x_display$store_color(pixs[1], r, g, b)
42: if string$empty(cfore)
43: then r, g, b := x_display$query_color(BlackPixel)
44: else r, g, b := x_parse_color(cfore)
45: end
46: x_display$store_color(pixs[1] + plane, r, g, b)
47: end except when done: end
48: w: x_window, wid0, hgt0: int := x_cons("balls", back, bdr,
49: xdemo_geometry(), "=400x400+1+1",
50: 40, 40, bwidth)
51: w.name := "balls"
52: w.input := UnmapWindow
53: x_window$map(w)
54: w.input := ExposeWindow + UnmapWindow
55: x: ai := ai$fill(0, n, 0)
56: y: ai := ai$fill(0, n, 0)
57: vx: ai := ai$fill(0, n, 0)
58: vy: ai := ai$fill(0, n, 0)
59: r: _wordvec := _wordvec$create(bsize)
60: r[1] := 1
61: swap: bool := _wordvec$bfetch(r, 1) = 0
62: r[1] := 0
63: for xx: int in int$from_to(-rad, rad) do
64: maxy: int := isqrt(rad * rad - xx * xx)
65: for yy: int in int$from_to(-maxy, maxy) do
66: if (nx * xx + ny * yy +
67: nz * isqrt(rad * rad - xx * xx - yy * yy)) *
68: 17 / (100 * rad) < dmat[xx // 4 + 1][yy // 4 + 1]
69: then yy := yy + rad + 1
70: r[yy] := r[yy] + 2 ** (xx + rad)
71: end
72: end
73: end
74: if swap
75: then for i: int in int$from_to_by(1, 4 * bsize, 4) do
76: v: int := _wordvec$bfetch(r, i)
77: _wordvec$bstore(r, i, _wordvec$bfetch(r, i + 2))
78: _wordvec$bstore(r, i + 2, v)
79: v := _wordvec$bfetch(r, i + 1)
80: _wordvec$bstore(r, i + 1, _wordvec$bfetch(r, i + 3))
81: _wordvec$bstore(r, i + 3, v)
82: end
83: end
84: ball: x_pixmap := x_pixmap$create(x_bitmap$create(bsize, bsize, r),
85: plane, 0)
86: ev: event := x_input$empty_event()
87: while true do
88: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
89: if width <= 5 * bsize cor height <= 5 * bsize
90: then x_window$destroy(w)
91: return
92: end
93: x_window$clear(w)
94: width := width - bsize
95: height := height - bsize
96: for i: int in int$from_to(0, n - 1) do
97: x[i] := random$next(width)
98: y[i] := random$next(height)
99: vx[i] := random$next(13) - 6
100: vy[i] := random$next(13) - 6
101: x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, x[i], y[i],
102: GXxor, plane)
103: end
104: count: int := 0
105: while count ~= 0 cor ~x_input$pending() do
106: if count = 4
107: then count := 0
108: else count := count + 1
109: end
110: for i: int in int$from_to(0, n - 1) do
111: x0: int := x[i]
112: y0: int := y[i]
113: xx: int := x0 + vx[i]
114: if xx < 0
115: then xx := -xx
116: vx[i] := -vx[i]
117: elseif xx >= width
118: then xx := 2 * (width - 1) - xx
119: vx[i] := -vx[i]
120: end
121: x[i] := xx
122: yy: int := y0 + vy[i]
123: if yy < 0
124: then yy := -yy
125: vy[i] := -vy[i]
126: elseif yy >= height
127: then yy := 2* (height - 1) - yy
128: vy[i] := -vy[i]
129: end
130: y[i] := yy
131: x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, x0, y0,
132: GXxor, plane)
133: x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, xx, yy,
134: GXxor, plane)
135: end
136: for i: int in int$from_to(1, n - 1) do
137: for j: int in int$from_to(0, i - 1) do
138: x0: int := x[i] - x[j]
139: y0: int := y[i] - y[j]
140: if int$abs(x0) >= bsize cor int$abs(y0) >= bsize cor
141: x0 * x0 + y0 * y0 >= bsize * bsize
142: then continue end
143: if y0 < 0
144: then y0 := -y0
145: x0 := -x0
146: end
147: if rad * int$abs(x0) > rad * int$abs(y0)
148: then vx[i] := -vx[i]
149: vx[j] := -vx[j]
150: elseif rad * int$abs(y0) > (rad + 2) * int$abs(x0)
151: then vy[i] := -vy[i]
152: vy[j] := -vy[j]
153: elseif y0 > 0
154: then t: int := vx[i]
155: vx[i] := -vy[i]
156: vy[i] := -t
157: t := vx[j]
158: vx[j] := -vy[j]
159: vy[j] := -t
160: else t: int := vx[i]
161: vx[i] := -vy[i]
162: vy[i] := t
163: t := vx[j]
164: vx[j] := -vy[j]
165: vy[j] := t
166: end
167: end
168: end
169: end
170: x_input$deq(ev)
171: if ev.kind = UnmapWindow
172: then x_input$deq(ev) end
173: end
174: end ballsdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.