examples/tcltk/fig17-9.scm

   1 #!/usr/bin/env gsi-script
   2
   3 ; File: "fig17-9.scm"
   4
   5 ; Copyright (c) 1997-2007 by Marc Feeley, All Rights Reserved.
   6
   7 ; Translation into Scheme of Figure 17.9 from Chapter 17 of John
   8 ; Ousterhout's "Tcl and the Tk Toolkit".
   9
  10 (include "tcltk#.scm") ; import Tcl/Tk procedures and variables
  11
  12 (load "tcltk")
  13
  14 (define pts       "pts")
  15 (define bold      "bold")
  16 (define italic    "italic")
  17 (define underline "underline")
  18
  19 (frame ".f1")
  20 (frame ".f2")
  21
  22 (define rbuttons
  23   (map (lambda (size)
  24          (let* ((size-str (number->string size))
  25                 (rb (string-append ".f1." size-str)))
  26            (radiobutton rb
  27                         text: (string-append size-str " points")
  28                         relief: 'flat
  29                         variable: pts
  30                         value: size-str)
  31            rb))
  32        '(8 10 12 18 24)))
  33
  34 (checkbutton ".f2.bold"
  35              text: "Bold"
  36              relief: 'flat
  37              variable: bold)
  38 (checkbutton ".f2.italic"
  39              text: "Italic"
  40              relief: 'flat
  41              variable: italic)
  42 (checkbutton ".f2.underline"
  43              text: "Underline"
  44              relief: 'flat
  45              variable: underline)
  46
  47 (define cbuttons '(".f2.bold" ".f2.italic" ".f2.underline"))
  48
  49 (set-variable! pts "10")
  50
  51 (pack ".f1" side: 'left padx: "3m" pady: "3m")
  52 (pack ".f2" side: 'right padx: "3m" pady: "3m")
  53
  54 (apply pack (append rbuttons '(in: ".f1" side: top anchor: w)))
  55 (apply pack (append cbuttons '(in: ".f2" side: top anchor: w)))