rgbdemo = proc () basevalue = 2**8 initialvalue = basevalue * 2**7 offvalue = 2**16 maxvalue = offvalue - basevalue pixs: pixellist, mask: int := x_display$alloc_cells(4, 0, false) defs: colordeflist := colordeflist$[colordef${pixel: pixs[1], red: initialvalue, green: 0, blue: 0}, colordef${pixel: pixs[2], red: 0, green: initialvalue, blue: 0}, colordef${pixel: pixs[3], red: 0, green: 0, blue: initialvalue}, colordef${pixel: pixs[4], red: initialvalue, green: initialvalue, blue: initialvalue}] x_display$store_colors(defs) bwidth: int := int$parse(xdemo_default("rgb", "BorderWidth")) except when not_found, overflow, bad_format: bwidth := 2 end bdr: x_pixmap := x_display$black() mousep: int := BlackPixel begin r, g, b: int := x_parse_color(xdemo_default("rgb", "Border")) bdr := x_pixmap$tile(x_display$alloc_color(r, g, b)) end except when not_found: end begin r, g, b: int := x_parse_color(xdemo_default("rgb", "Mouse")) mousep := x_display$alloc_color(r, g, b) end except when not_found: end w: x_window, wid0, hgt0: int := x_cons("rgb", x_pixmap$tile(pixs[4]), bdr, xdemo_geometry(), "=200x200+1+1", 40, 40, bwidth) w.name := "rgb" x_window$map(w) sx, sy, width, height, wb, ms, wk: int, iw: x_window := x_window$query(w) w3: int := width / 3 h3: int := height / 3 rw: x_window := x_window$create(0, 0, w3, h3, x_pixmap$tile(pixs[1]), w, 0, x_pixmap$none()) gw: x_window := x_window$create(w3, 0, w3, h3, x_pixmap$tile(pixs[2]), w, 0, x_pixmap$none()) bw: x_window := x_window$create(2 * w3, 0, width - 2 * w3, h3, x_pixmap$tile(pixs[3]), w, 0, x_pixmap$none()) x_window$map_subwindows(w) cr: x_cursor := x_cursor$scons(cross_width, cross_height, cross, cross_mask, pixs[4], mousep, cross_x, cross_y, GXcopy) w.cursor := cr w.input := ExposeWindow rw.input := ButtonPressed + ButtonReleased + MiddleDownMotion gw.input := ButtonPressed + ButtonReleased + MiddleDownMotion bw.input := ButtonPressed + ButtonReleased + MiddleDownMotion f: x_font := x_font$create("8x13") rgb: string := "" rgbx: int := (width - x_font$width(f, "ffffff")) / 2 rgby: int := height - h3 ev: event := x_input$empty_event() tracking: bool := false while true do if string$empty(rgb) then rgb := string$rest(i_hunparse((defs[4].red + offvalue) / basevalue), 2) || string$rest(i_hunparse((defs[4].green + offvalue) / basevalue), 2) || string$rest(i_hunparse((defs[4].blue + offvalue) / basevalue), 2) x_window$text(w, rgb, f, WhitePixel, BlackPixel, rgbx, rgby) end x_input$deq(ev) if ev.kind = ExposeWindow then if ev.sub = x_window$none() then sx, sy, width, height, wb, ms, wk, iw := x_window$query(w) if width <= 30 cor height <= 30 then x_window$destroy(w) return end w3 := width / 3 h3 := height / 3 x_window$change(rw, w3, h3) x_window$configure(gw, w3, 0, w3, h3) x_window$configure(bw, 2 * w3, 0, width - 2 * w3, h3) rgb := "" rgbx := (width - x_font$width(f, "ffffff")) / 2 rgby := height - h3 end continue elseif ev.kind = MouseMoved cor ev.value = MiddleButton then y: int := ev.y if ev.kind = MouseMoved then x: int sub: x_window x, y, sub := x_window$query_mouse(ev.win) else tracking := ~tracking end if y < 0 then y := 0 elseif y >= h3 then y := h3 - 1 end y := (maxvalue * y) / (h3 - 1) if ev.win = rw then defs[1].red := y defs[4].red := y elseif ev.win = gw then defs[2].green := y defs[4].green := y else defs[3].blue := y defs[4].blue := y end x_display$store_colors(defs) rgb := "" elseif ~tracking cand ev.kind = ButtonPressed then value: int := basevalue if ev.value = LeftButton then value := -value end if ev.win = rw then defs[1].red := int$min(int$max(defs[1].red + value, 0), maxvalue) defs[4].red := defs[1].red elseif ev.win = gw then defs[2].green := int$min(int$max(defs[2].green + value, 0), maxvalue) defs[4].green := defs[2].green else defs[3].blue := int$min(int$max(defs[3].blue + value, 0), maxvalue) defs[4].blue := defs[3].blue end x_display$store_colors(defs) value := basevalue rgb := "" end end end rgbdemo