|
|
1.1 root 1: rgbdemo = proc ()
2: basevalue = 2**8
3: initialvalue = basevalue * 2**7
4: offvalue = 2**16
5: maxvalue = offvalue - basevalue
6: pixs: pixellist, mask: int := x_display$alloc_cells(4, 0, false)
7: defs: colordeflist := colordeflist$[colordef${pixel: pixs[1],
8: red: initialvalue,
9: green: 0,
10: blue: 0},
11: colordef${pixel: pixs[2],
12: red: 0,
13: green: initialvalue,
14: blue: 0},
15: colordef${pixel: pixs[3],
16: red: 0,
17: green: 0,
18: blue: initialvalue},
19: colordef${pixel: pixs[4],
20: red: initialvalue,
21: green: initialvalue,
22: blue: initialvalue}]
23: x_display$store_colors(defs)
24: bwidth: int := int$parse(xdemo_default("rgb", "BorderWidth"))
25: except when not_found, overflow, bad_format: bwidth := 2 end
26: bdr: x_pixmap := x_display$black()
27: mousep: int := BlackPixel
28: begin
29: r, g, b: int := x_parse_color(xdemo_default("rgb", "Border"))
30: bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
31: end except when not_found: end
32: begin
33: r, g, b: int := x_parse_color(xdemo_default("rgb", "Mouse"))
34: mousep := x_display$alloc_color(r, g, b)
35: end except when not_found: end
36: w: x_window, wid0, hgt0: int := x_cons("rgb", x_pixmap$tile(pixs[4]), bdr,
37: xdemo_geometry(), "=200x200+1+1",
38: 40, 40, bwidth)
39: w.name := "rgb"
40: x_window$map(w)
41: sx, sy, width, height, wb, ms, wk: int, iw: x_window := x_window$query(w)
42: w3: int := width / 3
43: h3: int := height / 3
44: rw: x_window := x_window$create(0, 0, w3, h3, x_pixmap$tile(pixs[1]), w,
45: 0, x_pixmap$none())
46: gw: x_window := x_window$create(w3, 0, w3, h3, x_pixmap$tile(pixs[2]), w,
47: 0, x_pixmap$none())
48: bw: x_window := x_window$create(2 * w3, 0, width - 2 * w3, h3,
49: x_pixmap$tile(pixs[3]), w,
50: 0, x_pixmap$none())
51: x_window$map_subwindows(w)
52: cr: x_cursor := x_cursor$scons(cross_width, cross_height,
53: cross, cross_mask,
54: pixs[4], mousep, cross_x, cross_y,
55: GXcopy)
56: w.cursor := cr
57: w.input := ExposeWindow
58: rw.input := ButtonPressed + ButtonReleased + MiddleDownMotion
59: gw.input := ButtonPressed + ButtonReleased + MiddleDownMotion
60: bw.input := ButtonPressed + ButtonReleased + MiddleDownMotion
61: f: x_font := x_font$create("8x13")
62: rgb: string := ""
63: rgbx: int := (width - x_font$width(f, "ffffff")) / 2
64: rgby: int := height - h3
65: ev: event := x_input$empty_event()
66: tracking: bool := false
67: while true do
68: if string$empty(rgb)
69: then rgb := string$rest(i_hunparse((defs[4].red + offvalue) / basevalue), 2) ||
70: string$rest(i_hunparse((defs[4].green + offvalue) / basevalue), 2) ||
71: string$rest(i_hunparse((defs[4].blue + offvalue) / basevalue), 2)
72: x_window$text(w, rgb, f, WhitePixel, BlackPixel, rgbx, rgby)
73: end
74: x_input$deq(ev)
75: if ev.kind = ExposeWindow
76: then if ev.sub = x_window$none()
77: then sx, sy, width, height, wb, ms, wk, iw := x_window$query(w)
78: if width <= 30 cor height <= 30
79: then x_window$destroy(w)
80: return
81: end
82: w3 := width / 3
83: h3 := height / 3
84: x_window$change(rw, w3, h3)
85: x_window$configure(gw, w3, 0, w3, h3)
86: x_window$configure(bw, 2 * w3, 0, width - 2 * w3, h3)
87: rgb := ""
88: rgbx := (width - x_font$width(f, "ffffff")) / 2
89: rgby := height - h3
90: end
91: continue
92: elseif ev.kind = MouseMoved cor ev.value = MiddleButton
93: then y: int := ev.y
94: if ev.kind = MouseMoved
95: then x: int
96: sub: x_window
97: x, y, sub := x_window$query_mouse(ev.win)
98: else tracking := ~tracking
99: end
100: if y < 0
101: then y := 0
102: elseif y >= h3
103: then y := h3 - 1 end
104: y := (maxvalue * y) / (h3 - 1)
105: if ev.win = rw
106: then defs[1].red := y
107: defs[4].red := y
108: elseif ev.win = gw
109: then defs[2].green := y
110: defs[4].green := y
111: else defs[3].blue := y
112: defs[4].blue := y
113: end
114: x_display$store_colors(defs)
115: rgb := ""
116: elseif ~tracking cand ev.kind = ButtonPressed
117: then value: int := basevalue
118: if ev.value = LeftButton
119: then value := -value end
120: if ev.win = rw
121: then defs[1].red := int$min(int$max(defs[1].red + value,
122: 0),
123: maxvalue)
124: defs[4].red := defs[1].red
125: elseif ev.win = gw
126: then defs[2].green := int$min(int$max(defs[2].green + value,
127: 0),
128: maxvalue)
129: defs[4].green := defs[2].green
130: else defs[3].blue := int$min(int$max(defs[3].blue + value,
131: 0),
132: maxvalue)
133: defs[4].blue := defs[3].blue
134: end
135: x_display$store_colors(defs)
136: value := basevalue
137: rgb := ""
138: end
139: end
140: end rgbdemo
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.