![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to shades.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 shades.clu CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo |
1.1 root 1: shadesdemo = proc ()
2: ai = array[int]
3: side: int := 8
4: pixs: pixellist
5: mask: int
6: while true do
7: pixs, mask := x_display$alloc_cells(side * side, 0, false)
8: except when error (why: string):
9: if side = 1
10: then signal failure(why) end
11: side := side - 1
12: continue
13: end
14: break
15: end
16: bwidth: int := int$parse(xdemo_default("shades", "BorderWidth"))
17: except when not_found, overflow, bad_format: bwidth := 2 end
18: bdr: x_pixmap := x_display$black()
19: begin
20: r, g, b: int := x_parse_color(xdemo_default("shades", "Border"))
21: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
22: end except when not_found: end
23: w: x_window, wid0, hgt0: int := x_cons("shades", bdr, bdr,
24: xdemo_geometry(), "=400x400+1+1",
25: 40, 40, bwidth)
26: w.name := "shades"
27: x_window$map(w)
28: w.input := ButtonPressed + ExposeWindow
29: w.cursor := x_cursor$scons(cross_width, cross_height, cross, cross_mask,
30: WhitePixel, BlackPixel, cross_x, cross_y, GXcopy)
31: ev: event := x_input$empty_event()
32: deltas: ai := ai$fill(1, side, 0)
33: for i: int in int$from_to(1, side) do
34: deltas[i] := (255 * 256 * (i - 1)) / (side - 1)
35: end
36: defs: colordeflist := colordeflist$predict(1, side * side)
37: for i: int in int$from_to(1, side) do
38: for j: int in int$from_to(1, side) do
39: colordeflist$addh(defs, colordef${pixel: pixs[(i - 1) * side + j],
40: red: 0,
41: green: 0,
42: blue: 0})
43: end
44: end
45: x_display$store_colors(defs)
46: addblue: bool := true
47: addgreen: bool := false
48: addred: bool := false
49: donew: bool := true
50: delta: int := 1
51: while true do
52: sx, sy, pwidth, pheight, bw, ms, wk: int, iw: x_window := x_window$query(w)
53: width: int := pwidth / side
54: height: int := pheight / side
55: if height <= 1 cor width <= 1
56: then x_window$destroy(w)
57: return
58: end
59: x: int := (pwidth - width * side) / 2
60: y: int := (pheight - height * side) / 2
61: for i: int in int$from_to(1, side) do
62: for j: int in int$from_to(1, side) do
63: d: colordef := defs[(i - 1) * side + j]
64: x_window$pix_set(w, d.pixel,
65: (i - 1) * width + x, (j - 1) * height + y,
66: width, height)
67: end
68: end
69: while true do
70: if donew
71: then for i: int in int$from_to(1, side) do
72: for j: int in int$from_to(1, side) do
73: d: colordef := defs[(i - 1) * side + j]
74: if addblue
75: then d.red := deltas[i]
76: d.green := deltas[j]
77: d.blue := 0
78: elseif addgreen
79: then d.blue := deltas[i]
80: d.red := deltas[j]
81: d.green := 0
82: else d.green := deltas[i]
83: d.blue := deltas[j]
84: d.red := 0
85: end
86: end
87: end
88: delta := 1
89: x_display$store_colors(defs)
90: donew := false
91: end
92: while true do
93: x_input$deq(ev)
94: if ev.kind = ExposeWindow
95: then exit done end
96: if ev.value = MiddleButton
97: then break end
98: if ev.value = LeftButton cand delta > 1
99: then delta := delta - 1
100: elseif ev.value = RightButton cand delta < side
101: then delta := delta + 1
102: else continue end
103: val: int := deltas[delta]
104: for d: colordef in colordeflist$elements(defs) do
105: if addblue
106: then d.blue := val
107: elseif addgreen
108: then d.green := val
109: else d.red := val end
110: end
111: x_display$store_colors(defs)
112: end
113: if addblue
114: then addblue := false
115: addgreen := true
116: elseif addgreen
117: then addgreen := false
118: addred := true
119: else addred := false
120: addblue := true
121: end
122: donew := true
123: end except when done: end
124: end
125: end shadesdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.