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

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.