Annotation of 43BSD/contrib/X/xdemo/rgb.clu, revision 1.1.1.1

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

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.