motiondemo = proc () vcount = 500 bwidth: int := int$parse(xdemo_default("motion", "BorderWidth")) except when not_found, overflow, bad_format: bwidth := 2 end back: x_pixmap := x_display$white() bdr: x_pixmap := x_display$black() plane: int := 1 backpix: int := WhitePixel linepix: int := BlackPixel mousepix: int := BlackPixel if x_display$cells() > 2 then begin r, g, b: int := x_parse_color(xdemo_default("motion", "Border")) bdr := x_pixmap$tile(x_display$alloc_color(r, g, b)) end except when not_found: end pixs: pixellist pixs, plane := x_display$alloc_cells(1, 1, false) backpix := pixs[1] back := x_pixmap$tile(backpix) linepix := backpix + plane r, g, b: int := x_parse_color(xdemo_default("motion", "Background")) except when not_found: r, g, b := x_display$query_color(WhitePixel) end x_display$store_color(backpix, r, g, b) random_color(linepix) begin r, g, b := x_parse_color(xdemo_default("motion", "Mouse")) mousepix := x_display$alloc_color(r, g, b) end except when not_found: end end w: x_window, wid0, hgt0: int := x_cons("motion", back, bdr, xdemo_geometry(), "=400x400+1+1", 40, 40, bwidth) w.name := "motion" w.input := ButtonPressed + UnmapWindow x_window$map(w) cr: x_cursor := x_cursor$scons(cross_width, cross_height, cross, cross_mask, backpix, mousepix, cross_x, cross_y, GXcopy) w.cursor := cr w.input := ButtonPressed + ExposeWindow + UnmapWindow vlist: x_vlist := x_vlist$create(vcount + 1) ovlist: x_vlist := x_vlist$create(vcount + 1) sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w) height := height - 1 width := width - 1 ev: event := x_input$empty_event() nobit: x_bitmap := x_bitmap$none() while true do n: int := 0 while n < vcount do x_input$deq(ev) if ev.kind = ExposeWindow then sx, sy, width, height, bw, ms, wk, iw := x_window$query(w) if width <= 30 cor height <= 30 then x_window$destroy(w) return end height := height - 1 width := width - 1 x_window$clear(w) for i: int in int$from_to(1, n) do x, y, flags: int := x_vlist$fetch(vlist, i) x_window$pix_fill(w, 0, nobit, x, y, 2, 2, GXinvert, 1) end continue elseif ev.kind = UnmapWindow then continue end if ev.value = MiddleButton then break end x_window$pix_fill(w, 0, nobit, ev.x, ev.y, 2, 2, GXinvert, 1) n := n + 1 flags: int := 0 if ev.value = LeftButton then flags := VertexCurved end x_vlist$store(vlist, n, ev.x, ev.y, flags) end x_window$clear(w) if n > 2 then x, y, flags: int := x_vlist$fetch(vlist, 1) x_vlist$store(vlist, 1, x, y, flags + VertexStartClosed) n := n + 1 x_vlist$store(vlist, n, x, y, flags + VertexEndClosed) elseif n < 2 then continue end x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1) xd: int := -1 dx: int := 1 yd: int := -1 dy: int := 1 count: int := 0 while true do if xd < 0 then xd := random$next(width) dx := random$next(2) else xd := xd - 1 end if yd < 0 then yd := random$next(height) dy := random$next(2) else yd := yd - 1 end for i: int in int$from_to(1, n - 1) do xx, yy, flags: int := x_vlist$fetch(vlist, i) x_vlist$store(ovlist, i, xx, yy, flags) x: int := random$next(5) if dx = 0 then x := -x end x := x + xx if x < 0 then x := 0 xd := -1 if linepix ~= BlackPixel then random_color(linepix) end elseif x > width then x := width xd := -1 if linepix ~= BlackPixel then random_color(linepix) end end y: int := random$next(5) if dy = 0 then y := -y end y := y + yy if y < 0 then y := 0 yd := -1 if linepix ~= BlackPixel then random_color(linepix) end elseif y > height then y := height yd := -1 if linepix ~= BlackPixel then random_color(linepix) end end x_vlist$store(vlist, i, x, y, flags) end if n > 2 then x, y, flags: int := x_vlist$fetch(vlist, n) x_vlist$store(ovlist, n, x, y, flags) x, y, flags := x_vlist$fetch(vlist, 1) x_vlist$store(vlist, n, x, y, flags + (VertexEndClosed - VertexStartClosed)) end x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1) x_window$draw(w, ovlist, n, 0, 1, 1, GXinvert, 1) if count = 4 then count := 0 else count := count + 1 end if count ~= 0 cor ~x_input$pending() then continue end x_input$deq(ev) if ev.kind = UnmapWindow then x_input$deq(ev) end if ev.kind = ExposeWindow then sx, sy, width, height, bw, ms, wk, iw := x_window$query(w) if width <= 30 cor height <= 30 then x_window$destroy(w) return end height := height - 1 width := width - 1 x_window$clear(w) x_window$draw(w, vlist, n, 0, 1, 1, GXinvert, 1) elseif ev.value = MiddleButton then break end end end end motiondemo