guiserver/tabs-demo.lsp

   1 #!/usr/bin/newlisp
   2 ;;
   3 ;; tabs-demo.lsp - demonstrate tabs and icons
   4
   5 ;;;; initialization
   6 (set-locale "C")
   7 (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
   8
   9 (gs:init)
  10
  11 (gs:get-screen)
  12 (set 'x (/ (- (gs:screen 0) 450) 2))
  13 (set 'y (/ (- (gs:screen 1) 580) 2))
  14
  15 ;;;; describe the GUI
  16
  17 (gs:frame 'TheFrame x y 450 580 "Tabbed Pane Demo")
  18 ;; When mapping gs:xxx functions the quote before gs:xxx is important
  19 ;; so the functions get executed woth gs as the current context which makes
  20 ;; the names from wigets be prefixed with their proper context name.
  21 (map 'gs:panel '(first second third icons))
  22 (gs:set-color 'first 1 0 0)
  23 (gs:set-color 'second 0 1 0)
  24 (gs:set-color 'third 0 0 1)
  25 (gs:set-color 'icons 0 0 1 0.1)
  26 (gs:set-flow-layout 'icons "center" 30 50)
  27
  28 (gs:label 'new "new")
  29 (gs:label 'edit "edit")
  30 (gs:label 'cut "cut")
  31 (gs:label 'copy "copy")
  32 (gs:label 'paste "paste")
  33 (gs:label 'folder "folder")
  34 (gs:label 'openfolder "openfolder")
  35 (gs:label 'save "save")
  36 (gs:label 'info "info")
  37 (gs:label 'run "run")
  38 (gs:label 'restart "restart")
  39 (gs:label 'stop "stop")
  40 (gs:label 'fontbook "fontbook")
  41 (gs:label 'clear "clear")
  42 (gs:label 'search "search")
  43
  44 ;; if an icon path is prefixed with /local/ it means that this
  45 ;; icon is built-in to guiserver.jar. Other paths to user
  46 ;; supplied external icon images can be used instead (gif, jpg, png)
  47 (gs:set-icon 'new "/local/new32.png")
  48 (gs:set-icon 'edit "/local/edit32.png")
  49 (gs:set-icon 'cut "/local/cut32.png")
  50 (gs:set-icon 'copy "/local/copy32.png")
  51 (gs:set-icon 'paste "/local/paste32.png")
  52 (gs:set-icon 'folder "/local/folder-closed32.png")
  53 (gs:set-icon 'openfolder "/local/folder-opened32.png")
  54 (gs:set-icon 'save "/local/save32.png")
  55 (gs:set-icon 'info "/local/info32.png")
  56 (gs:set-icon 'run "/local/run32.png")
  57 (gs:set-icon 'restart "/local/restart32.png")
  58 (gs:set-icon 'stop "/local/stop32.png")
  59 (gs:set-icon 'fontbook "/local/font-book32.png")
  60 (gs:set-icon 'clear "/local/clear32.png")
  61 (gs:set-icon 'search "/local/search32.png")
  62
  63 ; an alternative way to make labels with icons
  64 (gs:image-label 'newLISP "/local/newLISP32.png")
  65 (gs:set-text 'newLISP "newLISP")
  66 (gs:image-label 'newLISPlogo "/local/newLISP128.png")
  67
  68 (gs:add-to 'icons 'new 'edit 'cut 'copy 'paste 'folder 'openfolder 'save)
  69 (gs:add-to 'icons 'info 'run 'restart 'stop 'fontbook 'clear 'search 'newLISP 'newLISPlogo)
  70
  71 (gs:tabbed-pane 'MyTabs 'tabs-action "top"
  72                         'first "first tab"
  73                         'second "second tab"
  74                         'third "third tab")
  75
  76 (gs:insert-tab 'MyTabs 'icons "icons tab" 3 "/local/newLISP16.png")
  77 ;(gs:remove-tab 'MyTabs 0) ; just for test
  78 (gs:request-focus 'MyTabs 3)
  79 (gs:add-to 'TheFrame 'MyTabs)
  80 (gs:set-visible 'TheFrame true)
  81
  82 ;;;; define actions
  83
  84 (define (tabs-action id cid tab)
  85         (println id " " cid " " (base64-dec tab)))
  86
  87 ;;;; listen for incoming action requests and dispatch
  88 (gs:listen)
  89
  90 ;; eof
  91