colorsdemo = proc () cwidth = 8 cheight = 12 ai = array[int] bwidth: int := int$parse(xdemo_default("colors", "BorderWidth")) except when not_found, overflow, bad_format: bwidth := 2 end bdr: x_pixmap := x_display$black() begin r, g, b: int := x_parse_color(xdemo_default("colors", "Border")) bdr := x_pixmap$tile(x_display$alloc_color(r, g, b)) end except when not_found: end f: x_font := x_font$create("8x13") w: x_window, width, height: int := x_tcons("colors", bdr, bdr, xdemo_geometry(), "=40x8+1+1", f, cwidth, cheight, 0, 3, 2, bwidth) x_font$destroy(f) w.name := "colors" x_window$set_resize(w, cwidth, cwidth, cheight, cheight) w.input := UnmapWindow x_window$map(w) w.input := ExposeWindow + UnmapWindow pixs: pixellist := pixellist$new() mask: int ev: event := x_input$empty_event() while true do if ~pixellist$empty(pixs) then x_display$free_colors(pixs, mask) end sx, sy, pwidth, pheight, bw, ms, wk: int, iw: x_window := x_window$query(w) width := pwidth / cwidth height := pheight / cheight if height <= 1 cor width <= 1 then x_window$destroy(w) return end pixs, mask := x_display$alloc_cells(height, 0, false) deltas: ai := ai$fill(1, height, 0) for i: int in int$from_to(1, height) do deltas[i] := (255 * 256 * (i - 1)) / (height - 1) end defs: colordeflist := colordeflist$predict(1, height) for i: int in int$from_to(1, height) do colordeflist$addh(defs, colordef${pixel: pixs[i], red: 0, green: 0, blue: 0}) x_display$store_color(pixs[i], 0, 0, 0) x_window$pix_set(w, pixs[i], 0, (i - 1) * cheight, pwidth, cheight) end basered: bool := true basegreen: bool := false baseblue: bool := false dored: bool := false dogreen: bool := true doblue: bool := false while true do for i: int in ai$indexes(deltas) do d: int := deltas[i] def: colordef := defs[i] if basered then def.red := d else def.red := 0 end if basegreen then def.green := d else def.green := 0 end if baseblue then def.blue := d else def.blue := 0 end end for d: int in ai$elements(deltas) do for def: colordef in colordeflist$elements(defs) do if dored then def.red := d end if dogreen then def.green := d end if doblue then def.blue := d end end x_display$store_colors(defs) x_window$query_mouse(w) if x_input$pending() then x_input$deq(ev) if ev.kind = UnmapWindow then x_input$deq(ev) end exit done end end if basered then if dogreen then dogreen := false doblue := true else basered := false basegreen := true doblue := false dored := true end elseif basegreen then if dored then dored := false doblue := true else basegreen := false baseblue := true doblue := false dored := true end else if dored then dored := false dogreen := true else baseblue := false basered := true end end end except when done: end end end colorsdemo