![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to qix.clu CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / new / X / xdemo|
Return to qix.clu CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / new / X / xdemo |
1.1 root 1: % from Symbolics?
2:
3: rec = record[x1, y1, x2, y2: int]
4: ar = array[rec]
5:
6: qixdemo = proc ()
7: vsize = 100 * 2
8: bwidth: int := int$parse(xdemo_default("qix", "BorderWidth"))
9: except when not_found, overflow, bad_format: bwidth := 2 end
10: back: x_pixmap := x_display$white()
11: bdr: x_pixmap := x_display$black()
12: plane: int := 1
13: if x_display$cells() > 2
14: then begin
15: r, g, b: int := x_parse_color(xdemo_default("qix", "Border"))
16: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
17: end except when not_found: end
18: cback: string := xdemo_default("qix", "Background")
19: except when not_found: cback := "" end
20: cfore: string := xdemo_default("qix", "Foreground")
21: except when not_found: cfore := "" end
22: if string$empty(cback) cand string$empty(cfore)
23: then exit done end
24: pixs: pixellist
25: pixs, plane := x_display$alloc_cells(1, 1, false)
26: back := x_pixmap$tile(pixs[1])
27: r, g, b: int
28: if string$empty(cback)
29: then r, g, b := x_display$query_color(WhitePixel)
30: else r, g, b := x_parse_color(cback)
31: end
32: x_display$store_color(pixs[1], r, g, b)
33: if string$empty(cfore)
34: then r, g, b := x_display$query_color(BlackPixel)
35: else r, g, b := x_parse_color(cfore)
36: end
37: x_display$store_color(pixs[1] + plane, r, g, b)
38: end except when done: end
39: w: x_window, wid0, hgt0: int := x_cons("qix", back, bdr,
40: xdemo_geometry(), "=400x400+1+1",
41: 40, 40, bwidth)
42: w.name := "qix"
43: w.input := UnmapWindow
44: x_window$map(w)
45: w.input := ExposeWindow + UnmapWindow
46: vlist: x_vlist := x_vlist$create(vsize)
47: ev: event := x_input$empty_event()
48: while true do
49: x_window$clear(w)
50: sx, sy, width, height, bw, ms, wk: int, iw: x_window := x_window$query(w)
51: if width <= 30 cor height <= 30
52: then x_window$destroy(w)
53: return
54: end
55: hsize: int := 100 + random$next(int$min(width, height) / 8)
56: h: ar := ar$fill_copy(0, hsize, rec${x1, y1, x2, y2: 0})
57: i: int := 0
58: idx: int := 1
59: x1: int := 0
60: y1: int := height - 1
61: x2: int := 0
62: y2: int := height - 1
63: dx1: int := 5
64: dy1: int := 12
65: dx2: int := 12
66: dy2: int := 5
67: first: bool := true
68: while ~x_input$pending() do
69: r: rec := h[i]
70: if ~first
71: then x_vlist$store(vlist, idx, r.x1, r.y1, VertexDontDraw)
72: idx := idx + 1
73: x_vlist$store(vlist, idx, r.x2, r.y2, VertexDrawLastPoint)
74: if idx = vsize
75: then x_window$draw(w, vlist, vsize, 0, 1, 1,
76: GXinvert, plane)
77: idx := 1
78: else idx := idx + 1
79: end
80: end
81: r.x1 := x1
82: r.y1 := y1
83: r.x2 := x2
84: r.y2 := y2
85: x_vlist$store(vlist, idx, x1, y1, VertexDontDraw)
86: idx := idx + 1
87: x_vlist$store(vlist, idx, x2, y2, VertexDrawLastPoint)
88: if idx = vsize
89: then x_window$draw(w, vlist, vsize, 0, 1, 1, GXinvert, plane)
90: idx := 1
91: else idx := idx + 1
92: end
93: i := i + 1
94: if i = hsize
95: then i := 0
96: first := false
97: end
98: dx1 := int$max(-12, int$min(dx1 + random$next(3) - 1, 12))
99: x1 := x1 + dx1
100: if x1 >= width cor x1 < 0
101: then x1 := x1 - 2 * dx1
102: dx1 := -dx1
103: end
104: dy1 := int$max(-12, int$min(dy1 + random$next(3) - 1, 12))
105: y1 := y1 + dy1
106: if y1 >= height cor y1 < 0
107: then y1 := y1 - 2 * dy1
108: dy1 := -dy1
109: end
110: dx2 := int$max(-12, int$min(dx2 + random$next(3) - 1, 12))
111: x2 := x2 + dx2
112: if x2 >= width cor x2 < 0
113: then x2 := x2 - 2 * dx2
114: dx2 := -dx2
115: end
116: dy2 := int$max(-12, int$min(dy2 + random$next(3) - 1, 12))
117: y2 := y2 + dy2
118: if y2 >= height cor y2 < 0
119: then y2 := y2 - 2 * dy2
120: dy2 := -dy2
121: end
122: end
123: x_input$deq(ev)
124: if ev.kind = UnmapWindow
125: then x_input$deq(ev) end
126: end
127: end qixdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.