Return to cookie.clu CVS log

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

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

1.1     ! root        1: cookiedemo = proc ()
        !             2:     s = "COOKIE"
        !             3:     s1 = "cookie"
        !             4:     x_keymap$load("")
        !             5:     root: x_window := x_display$root()
        !             6:     bwidth: int := int$parse(xdemo_default("cookie", "BorderWidth"))
        !             7:        except when not_found, overflow, bad_format: bwidth := 5 end
        !             8:     back: x_pixmap := x_display$white()
        !             9:     bdr: x_pixmap := x_display$black()
        !            10:     plane: int := 1
        !            11:     backpix: int := WhitePixel
        !            12:     textpix: int := BlackPixel
        !            13:     if x_display$cells() > 2
        !            14:        then begin
        !            15:            r, g, b: int := x_parse_color(xdemo_default("cookie", "Border"))
        !            16:            bdr := x_pixmap$tile(x_display$alloc_color(r, g, b))
        !            17:            end except when not_found: end
        !            18:            begin
        !            19:            r, g, b: int := x_parse_color(xdemo_default("cookie", "Background"))
        !            20:            backpix := x_display$alloc_color(r, g, b)
        !            21:            back := x_pixmap$tile(backpix)
        !            22:            end except when not_found: end
        !            23:            begin
        !            24:            r, g, b: int := x_parse_color(xdemo_default("cookie", "Foreground"))
        !            25:            textpix := x_display$alloc_color(r, g, b)
        !            26:            end except when not_found: end
        !            27:        end
        !            28:     font: x_font := x_font$create("esch80")
        !            29:        except when error (*): font := x_font$create("oldeng") end
        !            30:        except when error (*): font := x_font$create(xdemo_default("cookie",
        !            31:                                                                  "BodyFont"))
        !            32:              end
        !            33:     fwidth, fheight: int, f, l: char, b: int, fix: bool := x_font$query(font)
        !            34:     swid: int := x_font$width(font, s)
        !            35:     w: x_window := x_window$create((x_display$width() - swid - 20) / 2,
        !            36:                                   (x_display$height() - fheight - 20) / 2,
        !            37:                                   swid + 5, fheight + 5,
        !            38:                                   back, root, bwidth, bdr)
        !            39:     w.name := "cookie"
        !            40:     w.input := KeyPressed + KeyReleased + ExposeWindow
        !            41:     x_window$map(w)
        !            42:     x_window$text(w, s, font, textpix, backpix, 5, 5)
        !            43:     i: int := 1
        !            44:     ev: event := x_input$empty_event()
        !            45:     while i <= string$size(s) do
        !            46:        x_input$deq(ev)
        !            47:        if ev.kind = ExposeWindow
        !            48:           then x_window$text(w, s, font, textpix, backpix, 5, 5)
        !            49:         elseif ev.kind = KeyPressed
        !            50:           then c: char := x_keymap$getc(ev.value, ev.mask)
        !            51:                   except when none, multi (*): continue end
        !            52:                if c = s[i]  cor  c = s1[i]
        !            53:                   then i := i + 1
        !            54:                   else i := 1
        !            55:                   end
        !            56:         else i := 1 end
        !            57:        end
        !            58:     x_window$clear(w)
        !            59:     x_window$text(w, "YUMMY", font, textpix, backpix, 5, 5)
        !            60:     x_flush()
        !            61:     sleep(2)
        !            62:     x_window$destroy(w)
        !            63:     end cookiedemo

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