|
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: 5087 (0x13df)
Types: TextFile
Names: »balls.clu«
└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
└─⟦526ad3590⟧ »EUUGD11/gnu-31mar87/X.V10.R4.tar.Z«
└─⟦2109abc41⟧
└─⟦this⟧ »./X.V10R4/xdemo/balls.clu«
% from Lucasfilm Ltd.
ballsdemo = proc ()
ai = array[int]
n = 20
bsize = 21
rad = bsize / 2
nx = 48
ny = -36
nz = 80
qi = sequence[int]
dmat = sequence[qi]$[qi$[1, 13, 4, 16],
qi$[9, 5, 12, 8],
qi$[3, 15, 2, 14],
qi$[11, 7, 10, 6]]
bwidth: int := int$parse(xdemo_default("balls", "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
if x_display$cells() > 2
then begin
r, g, b: int := x_parse_color(xdemo_default("balls", "Border"))
bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
end except when not_found: end
cback: string := xdemo_default("balls", "Background")
except when not_found: cback := "" end
cfore: string := xdemo_default("balls", "Foreground")
except when not_found: cfore := "" end
if string$empty(cback) cand string$empty(cfore)
then exit done end
pixs: pixellist
pixs, plane := x_display$alloc_cells(1, 1, false)
back := x_pixmap$tile(pixs[1])
r, g, b: int
if string$empty(cback)
then r, g, b := x_display$query_color(WhitePixel)
else r, g, b := x_parse_color(cback)
end
x_display$store_color(pixs[1], r, g, b)
if string$empty(cfore)
then r, g, b := x_display$query_color(BlackPixel)
else r, g, b := x_parse_color(cfore)
end
x_display$store_color(pixs[1] + plane, r, g, b)
end except when done: end
w: x_window, wid0, hgt0: int := x_cons("balls", back, bdr,
xdemo_geometry(), "=400x400+1+1",
40, 40, bwidth)
w.name := "balls"
w.input := UnmapWindow
x_window$map(w)
w.input := ExposeWindow + UnmapWindow
x: ai := ai$fill(0, n, 0)
y: ai := ai$fill(0, n, 0)
vx: ai := ai$fill(0, n, 0)
vy: ai := ai$fill(0, n, 0)
r: _wordvec := _wordvec$create(bsize)
r[1] := 1
swap: bool := _wordvec$bfetch(r, 1) = 0
r[1] := 0
for xx: int in int$from_to(-rad, rad) do
maxy: int := isqrt(rad * rad - xx * xx)
for yy: int in int$from_to(-maxy, maxy) do
if (nx * xx + ny * yy +
nz * isqrt(rad * rad - xx * xx - yy * yy)) *
17 / (100 * rad) < dmat[xx // 4 + 1][yy // 4 + 1]
then yy := yy + rad + 1
r[yy] := r[yy] + 2 ** (xx + rad)
end
end
end
if swap
then for i: int in int$from_to_by(1, 4 * bsize, 4) do
v: int := _wordvec$bfetch(r, i)
_wordvec$bstore(r, i, _wordvec$bfetch(r, i + 2))
_wordvec$bstore(r, i + 2, v)
v := _wordvec$bfetch(r, i + 1)
_wordvec$bstore(r, i + 1, _wordvec$bfetch(r, i + 3))
_wordvec$bstore(r, i + 3, v)
end
end
ball: x_pixmap := x_pixmap$create(x_bitmap$create(bsize, bsize, r),
plane, 0)
ev: event := x_input$empty_event()
while true do
sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
if width <= 5 * bsize cor height <= 5 * bsize
then x_window$destroy(w)
return
end
x_window$clear(w)
width := width - bsize
height := height - bsize
for i: int in int$from_to(0, n - 1) do
x[i] := random$next(width)
y[i] := random$next(height)
vx[i] := random$next(13) - 6
vy[i] := random$next(13) - 6
x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, x[i], y[i],
GXxor, plane)
end
count: int := 0
while count ~= 0 cor ~x_input$pending() do
if count = 4
then count := 0
else count := count + 1
end
for i: int in int$from_to(0, n - 1) do
x0: int := x[i]
y0: int := y[i]
xx: int := x0 + vx[i]
if xx < 0
then xx := -xx
vx[i] := -vx[i]
elseif xx >= width
then xx := 2 * (width - 1) - xx
vx[i] := -vx[i]
end
x[i] := xx
yy: int := y0 + vy[i]
if yy < 0
then yy := -yy
vy[i] := -vy[i]
elseif yy >= height
then yy := 2* (height - 1) - yy
vy[i] := -vy[i]
end
y[i] := yy
x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, x0, y0,
GXxor, plane)
x_window$pixmap_put(w, ball, 0, 0, bsize, bsize, xx, yy,
GXxor, plane)
end
for i: int in int$from_to(1, n - 1) do
for j: int in int$from_to(0, i - 1) do
x0: int := x[i] - x[j]
y0: int := y[i] - y[j]
if int$abs(x0) >= bsize cor int$abs(y0) >= bsize cor
x0 * x0 + y0 * y0 >= bsize * bsize
then continue end
if y0 < 0
then y0 := -y0
x0 := -x0
end
if rad * int$abs(x0) > rad * int$abs(y0)
then vx[i] := -vx[i]
vx[j] := -vx[j]
elseif rad * int$abs(y0) > (rad + 2) * int$abs(x0)
then vy[i] := -vy[i]
vy[j] := -vy[j]
elseif y0 > 0
then t: int := vx[i]
vx[i] := -vy[i]
vy[i] := -t
t := vx[j]
vx[j] := -vy[j]
vy[j] := -t
else t: int := vx[i]
vx[i] := -vy[i]
vy[i] := t
t := vx[j]
vx[j] := -vy[j]
vy[j] := t
end
end
end
end
x_input$deq(ev)
if ev.kind = UnmapWindow
then x_input$deq(ev) end
end
end ballsdemo