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

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.