Return to colors.clu CVS log

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

Annotation of 43BSD/contrib/X/xdemo/colors.clu, revision 1.1

1.1     ! root        1: colorsdemo = proc ()
        !             2:     cwidth = 8
        !             3:     cheight = 12
        !             4:     ai = array[int]
        !             5:     bwidth: int := int$parse(xdemo_default("colors", "BorderWidth"))
        !             6:        except when not_found, overflow, bad_format: bwidth := 2 end
        !             7:     bdr: x_pixmap := x_display$black()
        !             8:     begin
        !             9:     r, g, b: int := x_parse_color(xdemo_default("colors", "Border"))
        !            10:     bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
        !            11:     end except when not_found: end
        !            12:     f: x_font := x_font$create("8x13")
        !            13:     w: x_window, width, height: int := x_tcons("colors", bdr, bdr,
        !            14:                                               xdemo_geometry(), "=40x8+1+1",
        !            15:                                               f, cwidth, cheight,
        !            16:                                               0, 3, 2, bwidth)
        !            17:     x_font$destroy(f)
        !            18:     w.name := "colors"
        !            19:     x_window$set_resize(w, cwidth, cwidth, cheight, cheight)
        !            20:     w.input := UnmapWindow
        !            21:     x_window$map(w)
        !            22:     w.input := ExposeWindow + UnmapWindow
        !            23:     pixs: pixellist := pixellist$new()
        !            24:     mask: int
        !            25:     ev: event := x_input$empty_event()
        !            26:     while true do
        !            27:        if ~pixellist$empty(pixs)
        !            28:           then x_display$free_colors(pixs, mask) end
        !            29:        sx, sy, pwidth, pheight, bw, ms, wk: int, iw: x_window := x_window$query(w)
        !            30:        width := pwidth / cwidth
        !            31:        height := pheight / cheight
        !            32:        if height <= 1  cor  width <= 1
        !            33:           then x_window$destroy(w)
        !            34:                return
        !            35:           end
        !            36:        pixs, mask := x_display$alloc_cells(height, 0, false)
        !            37:        deltas: ai := ai$fill(1, height, 0)
        !            38:        for i: int in int$from_to(1, height) do
        !            39:            deltas[i] := (255 * 256 * (i - 1)) / (height - 1)
        !            40:            end
        !            41:        defs: colordeflist := colordeflist$predict(1, height)
        !            42:        for i: int in int$from_to(1, height) do
        !            43:            colordeflist$addh(defs, colordef${pixel: pixs[i],
        !            44:                                              red:   0,
        !            45:                                              green: 0,
        !            46:                                              blue:  0})
        !            47:            x_display$store_color(pixs[i], 0, 0, 0)
        !            48:            x_window$pix_set(w, pixs[i], 0, (i - 1) * cheight, pwidth, cheight)
        !            49:            end
        !            50:        basered: bool := true
        !            51:        basegreen: bool := false
        !            52:        baseblue: bool := false
        !            53:        dored: bool := false
        !            54:        dogreen: bool := true
        !            55:        doblue: bool := false
        !            56:        while true do
        !            57:            for i: int in ai$indexes(deltas) do
        !            58:                d: int := deltas[i]
        !            59:                def: colordef := defs[i]
        !            60:                if basered
        !            61:                   then def.red := d
        !            62:                   else def.red := 0
        !            63:                   end
        !            64:                if basegreen
        !            65:                   then def.green := d
        !            66:                   else def.green := 0
        !            67:                   end
        !            68:                if baseblue
        !            69:                   then def.blue := d
        !            70:                   else def.blue := 0
        !            71:                   end
        !            72:                end
        !            73:            for d: int in ai$elements(deltas) do
        !            74:                for def: colordef in colordeflist$elements(defs) do
        !            75:                    if dored
        !            76:                       then def.red := d end
        !            77:                    if dogreen
        !            78:                       then def.green := d end
        !            79:                    if doblue
        !            80:                       then def.blue := d end
        !            81:                    end
        !            82:                x_display$store_colors(defs)
        !            83:                x_window$query_mouse(w)
        !            84:                if x_input$pending()
        !            85:                   then x_input$deq(ev)
        !            86:                        if ev.kind = UnmapWindow
        !            87:                           then x_input$deq(ev) end
        !            88:                        exit done
        !            89:                   end
        !            90:                end
        !            91:            if basered
        !            92:               then if dogreen
        !            93:                       then dogreen := false
        !            94:                            doblue := true
        !            95:                       else basered := false
        !            96:                            basegreen := true
        !            97:                            doblue := false
        !            98:                            dored := true
        !            99:                       end
        !           100:             elseif basegreen
        !           101:               then if dored
        !           102:                       then dored := false
        !           103:                            doblue := true
        !           104:                       else basegreen := false
        !           105:                            baseblue := true
        !           106:                            doblue := false
        !           107:                            dored := true
        !           108:                       end
        !           109:             else if dored
        !           110:                     then dored := false
        !           111:                          dogreen := true
        !           112:                     else baseblue := false
        !           113:                          basered := true
        !           114:                     end
        !           115:             end
        !           116:            end except when done: end
        !           117:        end
        !           118:     end colorsdemo

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