% from Lucasfilm Ltd. bouncedemo = proc () nbounce = 20 bwidth: int := int$parse(xdemo_default("bounce", "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 ballpix: int := BlackPixel if x_display$cells() > 2 then begin r, g, b: int := x_parse_color(xdemo_default("bounce", "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) back := x_pixmap$tile(pixs[1]) r, g, b: int := x_parse_color(xdemo_default("bounce", "Background")) except when not_found: r, g, b := x_display$query_color(WhitePixel) end x_display$store_color(pixs[1], r, g, b) ballpix := pixs[1] + plane random_color(ballpix) end w: x_window, wid0, hgt0: int := x_cons("bounce", back, bdr, xdemo_geometry(), "=400x400+1+1", 40, 40, bwidth) w.name := "bounce" w.input := UnmapWindow x_window$map(w) w.input := ExposeWindow + UnmapWindow ev: event := x_input$empty_event() nobit: x_bitmap := x_bitmap$none() while true do x_window$clear(w) sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w) if width <= 30 cor height <= 30 then x_window$destroy(w) return end width := width - nbounce height := height - nbounce - 1 x: int := 0 y: int := 0 vx: int := 4 vy: int := 0 wait: bool := false while ~x_input$pending() do x_window$pix_fill(w, 0, nobit, x, y, nbounce, nbounce, GXinvert, plane) wait := ~wait if wait then x_window$query_mouse(w) end x := x + vx if x >= width then x := 2 * width - x - 2 vx := -vx elseif x < 0 then x := -x vx := -vx end vy := vy + 1 y := y + vy if y >= height then y := 2 * height - y if vy < nbounce then vy := 1 - vy else vy := vy / nbounce - vy end if vy = 0 then x := 0 y := 0 vx := 4 vy := 0 if ballpix ~= BlackPixel then random_color(ballpix) end end end end x_input$deq(ev) if ev.kind = UnmapWindow then x_input$deq(ev) end end end bouncedemo