guiserver/widgets-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; widgets-demo.lsp - demonstrate all widgets
   4
   5
   6 ;;;; initialization
   7 (set-locale "C")
   8 (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
   9
  10 (gs:init)
  11
  12 ;(gs:set-trace true)
  13
  14 ;(gs:set-look-and-feel "com.sun.java.swing.plaf.motif.MotifLookAndFeel")
  15 ;(gs:set-look-and-feel "javax.swing.plaf.metal.MetalLookAndFeel")
  16 ;(gs:set-look-and-feel "com.sun.java.swing.plaf.windows.WindowsLookAndFeel") ;????
  17 ;(gs:set-look-and-feel "javax.swing.plaf.mac.MacLookAndFeel") ; ????
  18
  19 ;;;; describe the GUI
  20 (gs:frame 'WidgetsDemo 200 40 640 640 "Widgets Demo")
  21 (gs:set-grid-layout 'WidgetsDemo 5 1 10 1)
  22
  23 ;; the monitor area
  24 (gs:text-area 'MonitorArea 'action-handler)
  25 (gs:set-editable 'MonitorArea nil)
  26 (gs:set-background 'MonitorArea 0.5 0.5 0.5)
  27 (gs:set-font 'MonitorArea "Monospaced" 12 "plain")
  28 (gs:set-foreground 'MonitorArea 1 1 0.0)
  29
  30 ;; the button panel
  31 (gs:panel 'ButtonPanel)
  32 (gs:set-flow-layout 'ButtonPanel "left" 10 10)
  33 (gs:set-titled-border 'ButtonPanel "buttons")
  34 (gs:button 'TheButton 'button-handler "button")
  35 ;(gs:set-color 'TheButton 1 0 0) ; just for testing
  36 (gs:image-button 'TheImageButton 'action-handler "/local/newLISP32.png")
  37 (gs:toggle-button 'TheToggleButton 'action-handler " ")
  38 ;(gs:set-selected 'TheToggleButton true)
  39 (gs:radio-button 'TheRadioButton 'action-handler "radio button")
  40 ;(gs:set-selected 'TheRadioButton true)
  41 (gs:check-box 'TheCheckBox 'action-handler "check box")
  42 (gs:set-selected 'TheCheckBox true)
  43 (gs:button 'TheMessage 'action-handler "press")
  44 (gs:add-to 'ButtonPanel 'TheButton 'TheImageButton 'TheToggleButton 'TheRadioButton 'TheCheckBox 'TheMessage)
  45
  46 ;; list and combo boxes
  47 (gs:panel 'ListPanel)
  48 (gs:set-flow-layout 'ListPanel "center"  50 1)
  49 (gs:set-titled-border 'ListPanel "combox-box and list-box")
  50 (gs:combo-box 'TheComboBox 'action-handler "one" "two" "three")
  51 (gs:set-background 'TheComboBox 1.0 0.9 0.9)
  52 (gs:set-foreground 'TheComboBox 0 0 1)
  53 (gs:set-font 'TheComboBox "Lucida Serif Typewriter" 14 "plain")
  54 (gs:list-box 'TheListBox 'action-handler "first entry" "second entry" "third entry")
  55 (gs:set-background 'TheListBox 1.0 0.9 0.9)
  56 (gs:set-foreground 'TheListBox 0 0 1)
  57 (gs:set-size 'TheListBox 200 80)
  58 (gs:add-list-item 'TheListBox "fourth entry" "fifth entry" "sixth entry" "seventh entry")
  59 (gs:add-list-item 'TheListBox "eight entry")
  60 (gs:insert-list-item 'TheListBox "double-click me" 2)
  61 ;(gs:remove-list-item 'TheListBox 2) ; just for testing
  62 (gs:add-to 'ListPanel 'TheComboBox 'TheListBox )
  63
  64 ;; text entry widgets
  65 (gs:panel 'TextPanel)
  66 (gs:set-flow-layout 'TextPanel "left" 10 1)
  67 (gs:set-titled-border 'TextPanel "text-field and text-area")
  68 (gs:text-field 'TheTextField 'textfield-handler 10)
  69 (gs:set-background 'TheTextField 0.7 0.8 0.8)
  70 (gs:text-area 'TheTextArea 'textarea-handler 160 80)
  71 (gs:set-background 'TheTextArea 0.7 0.8 0.8)
  72 (gs:button 'GetTextFieldButton 'gettextfield-handler "get text field")
  73 (gs:button 'GetTextAreaButton 'gettextarea-handler "get text area")
  74 (gs:add-to 'TextPanel 'TheTextField 'TheTextArea 'GetTextFieldButton  'GetTextAreaButton)
  75
  76 ;; slider, progress-bar and scroll-area
  77 (gs:panel 'SlidePanel)
  78 (gs:set-titled-border 'SlidePanel "slider, progress-bar and scroll-pane")
  79 (gs:set-flow-layout 'SlidePanel "left" 20 1)
  80 (gs:slider 'TheSlider 'slider-handler "horizontal" 1 100 30)
  81 (gs:label 'SliderStatus "30" "right" 30 10)
  82 (gs:progress-bar 'TheProgress 1 100 30)
  83 (gs:image-label 'TheLogo "/local/newLISP128.png")
  84 (gs:scroll-pane 'TheScrollPane 'TheLogo 100 90)
  85
  86 (gs:add-to 'SlidePanel 'TheSlider 'SliderStatus 'TheProgress 'TheScrollPane)
  87
  88
  89 ;; add all panels to the grid laount in the main frame
  90 (gs:add-to 'WidgetsDemo 'MonitorArea 'ButtonPanel 'ListPanel 'TextPanel 'SlidePanel)
  91
  92 (gs:set-visible 'WidgetsDemo true)
  93
  94 ;;;; define actions
  95
  96 (define (button-handler)
  97         (gs:dialog 'TheDialog 'WidgetsDemo "A Dialog Window" 300 200 true true))
  98
  99
 100 ;; several widgets can be served by one handler
 101 ;; the first parameter is always the source of the event
 102 (define (action-handler)
 103         (if (= "MAIN:TheToggleButton" (args 0))
 104                 (if (true? (args 1))
 105                         (gs:disable 'TheButton 'TheImageButton 'TheRadioButton 'TheCheckBox 'TheMessage)
 106                         (gs:enable 'TheButton 'TheImageButton 'TheRadioButton 'TheCheckBox 'TheMessage)
 107                 ))
 108
 109         (if (= "MAIN:TheImageButton" (args 0))
 110                 (gs:color-dialog 'WidgetsDemo 'action-handler "Choose a color" 1 1 1))
 111
 112         (if (= "MAIN:TheMessage" (args 0))
 113                 (gs:confirm-dialog 'WidgetsDemo 'action-handler
 114                                 "A Message" "Enjoy GUI server"
 115                                 "yes-no"
 116                                 ;(amb "error" "informaton" "warning" "question" "plain")
 117                 ))
 118
 119         (let (s "")
 120                 (doargs (item)
 121                         (write-buffer s (string item " ")))
 122                 (write-buffer s "\n")
 123                 (gs:append-text 'MonitorArea s)
 124         )
 125 )
 126
 127 (define (textfield-handler id text)
 128         (gs:append-text 'MonitorArea (base64-dec text))
 129         (gs:append-text 'MonitorArea "\n")
 130         (gs:add-list-item 'TheListBox (base64-dec text))
 131         (gs:add-list-item 'TheComboBox (base64-dec text))
 132 )
 133
 134 (define (textarea-handler)) ; not interested in keystrokes
 135
 136 (define (gettextarea-handler id text)
 137         (gs:get-text 'TheTextArea 'gettextcallback-handler)
 138 )
 139
 140 (define (gettextfield-handler id text)
 141         (gs:get-text 'TheTextField 'gettextcallback-handler)
 142 )
 143
 144 (define (gettextcallback-handler id text)
 145         (if text
 146                 (begin
 147                         (gs:append-text 'MonitorArea (base64-dec text))
 148                         (gs:append-text 'MonitorArea "\n"))
 149         )
 150 )
 151
 152 (define (slider-handler id value)
 153         (gs:set-text 'SliderStatus (string value))
 154         (gs:set-value 'TheProgress value)
 155 )
 156
 157 ;;;; listen for incoming action requests and dispatch
 158 (gs:listen)
 159
 160 ;; eof
 161