guiserver/font-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; font-demo.lsp - show all built-in Java fonts (available on all platforms)
   4
   5 ;;;; initialization
   6 (set-locale "C")
   7 (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
   8
   9 (gs:init)
  10
  11 ;;;; describe the GUI
  12 (gs:frame 'TestFrame 100 100 480 320 "newLISP-GS built-in Font Families")
  13 (gs:set-background 'TestFrame 1 1 1)
  14 (gs:set-grid-layout 'TestFrame 12 1)
  15 (gs:label 'L1 "Lucida Sans Regular")
  16 (gs:set-font 'L1 "Lucida Sans" 20 "plain")
  17 (gs:label 'L2 "Lucida Sans Bold")
  18 (gs:set-font 'L2 "Lucida Sans" 20 "bold")
  19 (gs:label 'L3 "Lucida Sans Oblique")
  20 (gs:set-font 'L3 "Lucida Sans" 20 "italic")
  21
  22 (gs:label 'L4 "Lucida Bright Regular")
  23 (gs:set-font 'L4 "Lucida Bright" 20 "plain")
  24 (gs:label 'L5 "Lucida Bright Bold")
  25 (gs:set-font 'L5 "Lucida Bright" 20 "bold")
  26 (gs:label 'L6 "Lucida Bright Oblique")
  27 (gs:set-font 'L6 "Lucida Bright" 20 "italic")
  28
  29 (gs:label 'L7 "Lucida Sans Typewriter Regular")
  30 (gs:set-font 'L7 "Lucida Sans Typewriter" 20 "plain")
  31 (gs:label 'L8 "Lucida Sans Typewriter Bold")
  32 (gs:set-font 'L8 "Lucida Sans Typewriter" 20 "bold")
  33 (gs:label 'L9 "Lucida Sans Typewriter Oblique")
  34 (gs:set-font 'L9 "Lucida Sans Typewriter" 20 "italic")
  35
  36 (gs:label 'L10 "Monospaced Regular")
  37 (gs:set-font 'L10 "Monospaced" 20 "plain")
  38 (gs:label 'L11 "Monospaced Bold")
  39 (gs:set-font 'L11 "Monospaced" 20 "bold")
  40 (gs:label 'L12 "Monospaced Oblique")
  41 (gs:set-font 'L12 "Monospaced" 20 "italic")
  42
  43 (dolist (i '(L1 L2 L3 L4 L5 L6 L7 L8 L9 L10 L11 L12))
  44         (gs:set-foreground i 0 0 0.4))
  45
  46 (gs:add-to 'TestFrame 'L1 'L2 'L3 'L4 'L5 'L6 'L7 'L8 'L9 'L10 'L11 'L12)
  47 (gs:set-visible 'TestFrame true)
  48
  49 ;; actions
  50
  51 (define (toggle-action id flag)
  52         (if flag
  53                 (gs:set-icon 'aImage "/local/newLISP32.png")
  54                 (gs:set-icon 'aImage "/local/newLISP128.png"))
  55 )
  56
  57 ;;;; listen for incoming action requests and dispatch
  58 (gs:listen)
  59
  60 ;; eof
  61