Return to rgb.clu CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / X / xdemo

Annotation of 43BSD/contrib/X/xdemo/rgb.clu, revision 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

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