![[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.