|
|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T b
Length: 2394 (0x95a)
Types: TextFile
Names: »bounce.clu«
└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
└─⟦526ad3590⟧ »EUUGD11/gnu-31mar87/X.V10.R4.tar.Z«
└─⟦2109abc41⟧
└─⟦this⟧ »./X.V10R4/xdemo/bounce.clu«
% 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