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