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