|
|
1.1 root 1: % from Lucasfilm Ltd.
2:
3: wallpaperdemo = proc ()
4: size = 128
5: bwidth: int := int$parse(xdemo_default("wallpaper", "BorderWidth"))
6: except when not_found, overflow, bad_format: bwidth := 2 end
7: back: x_pixmap := x_display$white()
8: bdr: x_pixmap := x_display$black()
9: plane: int := 1
10: wallpix: int := BlackPixel
11: if x_display$cells() > 2
12: then begin
13: r, g, b: int := x_parse_color(xdemo_default("wallpaper", "Border"))
14: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
15: end except when not_found: end
16: cback: string := xdemo_default("wallpaper", "Background")
17: except when not_found: cback := "" end
18: cfore: string := xdemo_default("wallpaper", "Foreground")
19: except when not_found: cfore := "" end
20: if string$empty(cback) cand string$empty(cfore)
21: then exit done end
22: pixs: pixellist
23: pixs, plane := x_display$alloc_cells(1, 1, false)
24: back := x_pixmap$tile(pixs[1])
25: r, g, b: int
26: if string$empty(cback)
27: then r, g, b := x_display$query_color(WhitePixel)
28: else r, g, b := x_parse_color(cback)
29: end
30: x_display$store_color(pixs[1], r, g, b)
31: if string$empty(cfore)
32: then r, g, b := x_display$query_color(BlackPixel)
33: else r, g, b := x_parse_color(cfore)
34: end
35: wallpix := pixs[1] + plane
36: x_display$store_color(wallpix, r, g, b)
37: end except when done: end
38: w: x_window, wid0, hgt0: int := x_cons("wallpaper", back, bdr,
39: xdemo_geometry(), "=400x400+1+1",
40: 40, 40, bwidth)
41: w.name := "wallpaper"
42: w.input := UnmapWindow
43: x_window$map(w)
44: w.input := ExposeWindow + UnmapWindow
45: ev: event := x_input$empty_event()
46: nobit: x_bitmap := x_bitmap$none()
47: while true do
48: x_window$clear(w)
49: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
50: if width <= size cor height <= size
51: then x_window$destroy(w)
52: return
53: end
54: idx: int := 0
55: x0: int := 0
56: y0: int := 0
57: x1: int := 0
58: y1: int := 0
59: vx0: int := 0
60: vy0: int := 0
61: vx1: int := 0
62: vy1: int := 0
63: while ~x_input$pending() do
64: func: int := GXinvert
65: if random$next(10) = 0
66: then func := GXset end
67: for x: int in int$from_to_by(x0 - size, x0 + 8 * size, size) do
68: for y: int in int$from_to_by(y0 - size, y0 + 8 * size, size) do
69: xs: int := x1 - x0
70: ys: int := y1 - y0
71: if x < 0
72: then xs := xs + x
73: x := 0
74: end
75: if y < 0
76: then ys := ys + y
77: y := 0
78: end
79: if x >= width cor y >= height
80: then continue end
81: if x + xs >= width
82: then xs := width - 1 - x end
83: if y + ys >= height
84: then ys := height - y end
85: if xs <= 0 cor ys <= 0
86: then continue end
87: x_window$pix_fill(w, 0, nobit, x, y, xs, ys, func, plane)
88: end
89: end
90: vx0 := int$max(-5, int$min(vx0 + random$next(3) - 1, 5))
91: x0 := x0 + vx0
92: if x0 < 0
93: then x0 := -x0
94: vx0 := -vx0
95: elseif x0 > size
96: then x0 := 2 * size - x0
97: vx0 := -vx0
98: end
99: vx1 := int$max(-5, int$min(vx1 + random$next(3) - 1, 5))
100: x1 := x1 + vx1
101: if x1 < 0
102: then x1 := -x1
103: vx1 := -vx1
104: elseif x1 > size
105: then x1 := 2 * size - x1
106: vx1 := -vx1
107: end
108: if x0 > x1
109: then x0, x1 := x1, x0
110: vx0, vx1 := vx1, vx0
111: end
112: vy0 := int$max(-5, int$min(vy0 + random$next(3) - 1, 5))
113: y0 := y0 + vy0
114: if y0 < 0
115: then y0 := -y0
116: vy0 := -vy0
117: elseif y0 > size
118: then y0 := 2 * size - y0
119: vy0 := -vy0
120: end
121: vy1 := int$max(-5, int$min(vy1 + random$next(3) - 1, 5))
122: y1 := y1 + vy1
123: if y1 < 0
124: then y1 := -y1
125: vy1 := -vy1
126: elseif y1 > size
127: then y1 := 2 * size - y1
128: vy1 := -vy1
129: end
130: if y0 > y1
131: then y0, y1 := y1, y0
132: vy0, vy1 := vy1, vy0
133: end
134: end
135: x_input$deq(ev)
136: if ev.kind = UnmapWindow
137: then x_input$deq(ev) end
138: end
139: end wallpaperdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.