;; @module guiserver.lsp
;; @description Functions for programming GUIs and 2D graphics.
;; @version 1.01
;; @author Lutz Mueller, August 2007
;;
;; This module has been tested on MacOS X 10.8 and Windows XP, both with the
;; Standard SUN Java RE v.1.5 (runtime environment) which came pre-installed on
;; those platforms.
;; <br><br>
;; <h2>What is newLISP-GS</h2>
;; <tt>guiserver.lsp</tt> is a module for interfacing to <tt>guiserver.jar</tt>
;; a Java server application for generating GUIs (graphical user interfaces)
;; and 2D graphics for newLISP applications. The <tt>guiserver.lsp</tt> module
;; implements a newLISP API much smaller and more abstract than the APIs of the
;; Java Swing libraries which it interfaces with. Because of this, GUI applications
;; can be built much faster than when using the original Java APIs.
;; <br><br>
;; <h2>Requirements</h2>
;; At the beginning of the program file, include a 'load' statement for the module:
;; <pre>
;; (load "/usr/local/share/newlisp/guiserver.lsp")
;; </pre>
;; or on MS Windows:
;; <pre>
;; (load "c:/Program Files/newlisp/guiserver.lsp")
;; </pre>
;;
;; <tt>guiserver.lsp</tt> expects the server <tt>guiserver.jar</tt> to be
;; installed in <tt>/usr/local/share/newlisp</tt> on MacOS X and Unix OSs, and
;; in <tt>C:\Program Files\newlisp</tt> on MS Windows systems. On Win32 the
;; standard environment variable <tt>PROGRAMFILES</tt> is used to find the exact location
;; of non-English installations of Windows.. Both, the <tt>guiserver.lsp</tt> and
;; <tt>guiserver.jar</tt> are installed by default when installing newLISP with one of
;; the binary installers available.
;; <br><br>
;; <h3>Architecture of a newLISP GUI application</h3>
;; A GUI application in newLISP is composed of four parts:
;;
;; <blockquote>
;; <em>initialization</em> - this means starting the newLISP-GS 'guiserver.jar' and initializing
;; communications with it. Only one function call is required to do this.
;;
;; <em>building widgets</em> - in this step windows, buttons, text fields etc., and
;; all visual aspects of the GUI are described. newLISP newLISP-GS offers a wide range
;; of different control widgets.
;;
;; <em>defining event actions</em> - in this step all the functions are defined to
;; react to events coming from the GUI as a consequence of button pushes, keystrokes,
;; mouse-movements etc.. These event actions send many commands back to the GUI
;; to change information for the user, popup dialogs etc..
;;
;; <em>listening for events</em> - the newLISP program sits in a loop waiting for
;; events and dispatching them to the defined event actions. Only one function call
;; is required for this step.
;; </blockquote>
;; <br><br>
;; <h2>Example</h2>
;; The following example application shows all the essential elements of a newLISP GUI
;; application:
;; <blockquote><pre>
;; #!/usr/local/bin/newlisp
;; ; button-demo.lsp - demonstrate the button control
;;
;; ;;;; initialization
;; (if (= ostype "Win32")
;; (load (string (env "PROGRAMFILES") "/newlisp/guiserver.lsp"))
;; (load "/usr/local/share/newlisp/guiserver.lsp")
;; )
;; (gs:init)
;;
;; ;;;; describe the GUI
;; (gs:frame 'ButtonDemo 100 100 400 300 "Button demo")
;; (gs:set-resizable 'ButtonDemo nil)
;; (gs:panel 'ColorPanel 360 200)
;; (gs:set-color 'ColorPanel (random) (random) (random))
;; (gs:button 'aButton 'abutton-action "color")
;; (gs:set-flow-layout 'ButtonDemo "center" 2 15)
;; (gs:add-to 'ButtonDemo 'ColorPanel 'aButton)
;; (gs:set-visible 'ButtonDemo true)
;;
;; ;;;; define actions
;; (define (abutton-action id)
;; (gs:set-color 'ColorPanel (random) (random) (random)))
;;
;; ;;;; listen for incoming action requests and dispatch
;; (gs:listen)
;;
;; ;; eof
;; </pre></blockquote>
;; <br>
;; <h3>Application start</h3>
;; <pre>
;; ./button-demo ; on MacOS X and Unix
;;
;; newlisp button-demo ; on Win32
;; </pre>
;; By default guiserver.jar uses the ports 47011 and 47012, but this setting can be overwritten
;; either by supplying a port number parameter to the 'gs:init' function or by overwriting the
;; port number from the command-line. newLISP-GS will then use the port number supplied and the number
;; following it:
;; <pre>
;; ./button-demo 10001 ; on MacOS X and Unix
;;
;; newlisp button-demo 10001 ; on Win32
;; </pre>
;; newLISP-GS 'guiserver.jsr' will now use the ports '10001' and '10002'.
;; Ports under <tt>1024</tt> should not be used, as many of them are already in use by other
;; OS services and need administrator privileges to use them.
;;
;; A second method to start a newLISP-GS application starts the 'guiserver.jar' first, which then
;; starts the newLISP application:
;; <pre>
;; Java -jar /usr/local/share/newlisp/guiserver.jar 47011 /usr/home/aUser/MyApplication.lsp
;; </pre>
;; A different port number can be used. Port numbers below 1024 need administrator
;; permissions. Optionally a splash screen can be specified as the last parameter:
;; <pre>
;; Java -jar /usr/local/share/newlisp/guiserver.jar 47011 /home/apps/myapp.lsp /local/newLISP128.png
;; </pre>
;; The example specifies an image inside 'guiserver.jar'. Any other image path on the local file system
;; can be used.
;;
;; On Win32 similar methods can be used replacing the appropriate file paths, but on Win32 Java jar files
;; can also be treated as executables and executed directly without calling Java explicitly. By default
;; 'guiserver.jar' and 'guiserver.lsp' are installed in 'c:\Program Files\newlisp\' or any other
;; directory configured on a Win32 platform using the 'PROGRAMFILES' environment variable:
;; <pre>
;; "c:\Program Files\newlisp\guiserver.jar" 47011 c:\myprogs\MyApplication.lsp
;; </pre>
;; Quotes are necessary when spaces are present in the argument string. The example also assumes that
;; 'newlisp.exe' is in the path for executables.
;;
;; <br><br>
;; <h2>Debugging</h2>
;; <b>Tracing commands to newLISP-GS</b><br><br>
;; For debugging purpose put the following directive at the beginning of your application
;; or at the place from where to start tracing.
;; <pre>
;; (gs:set-trace true)
;; </pre>
;; Then start the application from a terminal or command shell window. Now newLISP-GS
;; will output startup, version and connection messages and a trace for each 'gs:xxs' directive
;; as it is received by the newLISP-GS dispatcher:
;;
;; <blockquote><pre>
;; newLISP-GS v.0.94
;; listening on 47011
;; accepted from 0.0.0.0
;; connecting to 0.0.0.0 47012
;; retrying to connect
;; connected
;; -> frame MAIN:ButtonDemo 100 100 400 300 QnV0dG9uIGRlbW8= nil
;; -> set-resizable MAIN:ButtonDemo nil
;; -> panel MAIN:ColorPanel 360 200
;; -> set-color MAIN:ColorPanel 0 1 0 0.2
;; -> button MAIN:aButton MAIN:abutton-action Y29sb3I=
;; -> set-flow-layout MAIN:ButtonDemo center 2 15
;; -> add-to MAIN:ButtonDemo MAIN:ColorPanel MAIN:aButton
;; -> set-visible MAIN:ButtonDemo true
;; -> set-color MAIN:ColorPanel 0.8401877172 0.3943829268 0.7830992238
;; server shut down
;; </blockquote></pre>
;;
;; Text strings for button names, icon paths and other texts are encode in
;; Base64 strings as the first trace line for MAIN:ButtonDemo shows. To switch
;; off tracing mode use:
;; <pre>
;; (gs:set-trace nil)
;; </pre>
;; Even if trace mode is switched off, wrong or missing parameters are still messaged
;; by newLISP-GS in a small message box. After such an error the application and guiserver
;; will exit. Unknown commands will be ignored. Functions which are not applicable to
;; certain widgets will also pop up an error message box. In certain situations a
;; function will have no effect, e.g. 'gs:set-size' or 'gs:set-color' sometimes do not
;; have an effect, depending on how a widget is configured or depending on the layout
;; which hosts the widget. Sometimes the platform look-and-feel overwrites colors.
;; <br><br>
;;
;; <b>Event handlers</b><br><br>
;; For most widgets, event handlers must be defined. Sometimes an event handler is
;; not required. In this case specify <tt>'gs:no-action</tt> as the event handler
;; symbol. When developing programs it is useful to watch the event handler first
;; before coding for it. This can be done easily by printing out event parameters:
;;
;; <blockquote><pre>
;; (gs:button 'aButton 'abutton-handler "press")
;;
;; (define (abutton-handler id)
;; (println id))
;; </pre></blockquote>
;;
;; Sometimes the same event handler function is attached to several widgets' keyboard
;; or mouse events. Some of these events receive a greater number of parameters. There
;; are two easy ways to discover the nature of an event:
;;
;; <blockquote><pre>
;; (define (the-handler)
;; (doargs (p)
;; (println "->" p)))
;; </pre></blockquote>
;;
;; The other method looks at the source of the event as it was transmitted by the newLISP-GS.
;; This is useful to recognize the data types used in the event:
;;
;; <blockquote><pre>
;; (define (the-handler)
;; (println gs:event))
;; </pre></blockquote>
;;
;; All text from text fields are received as base64-encoded strings. E.g. the text:
;; '"Hello World"' would be received as: '"SGVsbG8gV29ybGQ="':
;;
;; <blockquote><pre>
;; (gs:text-field 'TextField 'textfield-handler)
;;
;; (define (textfield-handler id text)
;; (printnl id ": " (base64-dec text)))
;; </pre></blockquote>
;;
;; When the text "Hello World" is entered in the text field, the following output
;; would be generated:
;;
;; <blockquote><pre>
;; TextField: "Hello World"
;; </pre></blockquote>
;;
;; In case the ESC key is pressed in the text field, the event handler would
;; report 'nil' for the text field. A handler should therefore always check text
;; for string contents before trying to apply the 'base64-dec' function on it.
;; <br><br>
;;
;; <h3>Coding considerations</h3>
;; <b>mapping or applying 'gs:xxx' functions</b><br><br>
;; Like any newLISP functions, 'gs:xxx' functions can be mapped or applied to lists of
;; parameters using the newLISP 'map' and 'apply' functions. When doing this, make sure to
;; map or apply the quoted <tt>'gs:xxx symbol</tt>, so the <tt>gs:xx</tt> functions
;; get executed under the <tt>gs</tt> context, prefixing symbols in parameter lists
;; correctly with the context prefix of their origin.
;;
;; <blockquote><pre>
;; (map 'gs:panel '(first second third fourth)) ; note quoted gs: function
;; </blockquote></pre>
;;
;; <br>
;; <h2>Some shortcuts when writing 'gs:xxx' functions</h2>
;; Due to the nature of transfer between newLISP and the guiserver as text, the following
;; convenient shortcuts can be taken when writing functions:
;;
;; <blockquote>
;; <ul>
;; <li>Symbol ids of components can be expressed as strings.</li>
;; <li>Number values can be expressed as strings.</li>
;; <li>Numbers can be expressed as floats or integers.</li>
;; <li>String constants for type and orientation constants can be given as symbols.</li>
;; </ul>
;; </blockquote>
;;
;; Here are some examples:
;; <pre>
;; (gs:panel 'ColorPanel 360 200)
;; ; is the same as
;; (gs:panel "ColorPanel" 360 200)
;; ; is the same as
;; (gs:panel "ColorPanel" "360" "200")
;; ; is the same as
;; (gs:panel "ColorPanel" 360.0 "200.00")
;;
;; (gs:set-flow-layout 'ButtonDemo "center" 2 15)
;; ; is the same as
;; (gs:set-flow-layout 'ButtonDemo 'center 2 15)
;; </pre>
;; Although the first form is preferred for clarity and readability, in some cases coding
;; may be more efficient using the other forms.
;;
;; Except for the symbols used for action handlers, all symbols are used only by their
;; face (name) value. This means that reserved symbols of the newLISP programming
;; language can be used freely in symbol ids for all components, e.g:
;; <pre>
;; (gs:label 'name "Input here")
;; </pre>
;; The usage of the reserved symbol 'name' will not pose a problem.
;; <br><br>
;; <h2>Return values</h2>
;; The return value of all functions is usually the number of characters
;; sent to newLISP-GS. In general, return values of 'gs:xxx' functions do not have
;; any specific meaning and can be discarded. Only the functions 'gs:get-version',
;; 'gs:get-screen' and 'gs:get-fonts' return their respective data and copy them
;; also to the variables 'gs:version', 'gs:screen' and 'gs:fonts' for later access.
;;
;; <br><br>
;; <h2>Function overview</h2>
;; <ul>
;; <li><b>Initialization and application setup</b><br>
;; <pre>
;; (gs:init [<server-port>])
;; </pre>
;; The initialization function starts <tt>guiserver.jar</tt> which will listen to the <i>server-port</i>
;; and initiate another connection on <tt>server-port + 1</tt> back to newLISP. If a <server-port>
;; is not supplied <tt>guiserver</tt> will assume <tt>47011</tt> and <tt>47012</tt>.
;;
;; As the last statement in the application put:
;; <pre>
;; (gs:listen)
;; </pre>
;; This function listens on <tt>47012</tt> (by default) for event messages from newLISP-GS
;; and dispatches them to the user-defined action handlers. To avoid newLISP shutting down
;; when the guiserver shuts down, use:
;; <pre>
;; (gs:listen true)
;; </pre>
;; </li>
;;
;; Sometimes it is necessary to run other tasks while listening for events. In this case use
;; 'gs:check-event', which will wait for certain amount of microseconds for an event
;; to be executed. After the wait-time, it returns. The function is typically used in a loop:
;;
;; <pre>
;; (while (gs:check-event 10000) ; check for 10 milli seconds
;; (do-myprocess)
;; )
;;
;; (exit)
;; </pre>
;;
;; The loop will exit when 'gs:check-event' returns 'nil' on communications errors, e.g.
;; when the window's close button was clicked.
;;
;; <li><b>Containers</b><br>
;; A <em>container</em> can contain any other container or control widget. Except for the
;; <tt>menu-bar</tt> and the <tt>split-pane</tt>, containers can have a special layout-manager set
;; with one of the three layout-manager function commands. By default containers have a flow layout. By
;; nesting different containers and using different layout-manager settings, complex layouts
;; can be configured. The function/command <tt>add-to</tt> is used to add components to containers.
;;
;; <pre>
;; (gs:dialog <sym-id> <sym-parent-frame> <str-message> <int-width> <int-height> [<boolean-visible> [<boolean-modal>]])
;; (gs:frame <sym-id> <int-x> <int-y> <int-width> <int-height> [<str-title> <boolean-visible>])
;; (gs:menu-bar <sym-frame> [<sym-menu-1> ...])
;; (gs:panel <sym-id> [<int-width> <int-height>])
;; (gs:scroll-pane <sym-id> <sym-widget> [<int-width> <int-height>])
;; (gs:split-pane <sym-id> <str-orientation> [<float-weight> [<float-location> [int-divider-size>]]])
;; (gs:tabbed-pane <sym-id> <sym-action> <str-orientation> [<sym-widget> <sym-tab-title> ...])
;; (gs:tool-bar <sym-frame> [<bool-floatable> <int-hgap> <int-vgap>])
;; (gs:canvas <sym-id>)
;; (gs:window <sym-id> <int-x> <int-y> <int-width> <int-height>)
;; </pre>
;; </li>
;; <li><b>Labels</b><br>
;; Labels can have text or an image or both. A normal text <tt>label</tt> can have an icon
;; added to it and a <tt>image-label</tt> can have text added to it. Labels don't initiate
;; actions and can be placed in any container like all button-type widgets - buttons, checkboxes
;; and menu items. A basic set of icon images is built into <tt>guiserver.jar</tt>,
;; but user-supplied images and icons in <tt>.jpg</tt>, <tt>.png</tt> and <tt>.gif</tt> formats
;; can be used.
;; <pre>
;; (gs:label <sym-id> <str-text> [<str-align> [<int-width> <int-height>]])
;; (gs:image-label <sym-id> <str-icon-path> [<str-align>])
;; </pre>
;; </li>
;; <li><b>Control widgets</b><br>
;; Except for the passive progress bar, all control widgets fire action requests to
;; the newLISP program. These requests must be served to avoid error messages but can
;; be defined as empty functions, if an action is not required:
;; <pre>
;; ; empty action definition
;; (define (my-button-action) )
;;
;; ; action handler printing the name of the button pressed
;; (define (my-button-action id) (println id " has been pressed"))
;; </pre>
;; All action events calls carry information about the widget, that initiated that the event,
;; and event parameters like keystrokes, slider positions etc..
;; <pre>
;; (gs:button <sym-id> <sym-action> [<str-text> [<int-width> <int-height>]])
;; (gs:check-box <sym-id> <sym-action> [<str-text> [<bool-selected>]])
;; (gs:combo-box <sym-id> <sym-action> [<str-item-1> ...])
;; (gs:combo-box <sym-id> <sym-action> [<list-str-items>])
;; (gs:image-button <sym-id> <sym-action> <str-icon-path> [<str-down-icon-path> [<int-width> <int-height>]])
;; (gs:list-box <sym-id> <sym-action> [<str-item-1> ...])
;; (gs:list-box <sym-id> <sym-action> [<list-str-items>])
;; (gs:menu <sym-id> <str-text>)
;; (gs:menu-popup <sym-id> <str-text>)
;; (gs:menu-item <sym-id> <sym-action> <str-text>)
;; (gs:menu-item-check <sym-id> <sym-action> <str-text> [<bool-selected>])
;; (gs:progress-bar <sym-id> <int-min> <in-max> <int-initial-value>)
;; (gs:radio-button <sym-id> <sym-action> [<str-text> [<bool-selected>]])
;; (gs:slider <sym-id> <sym-action> <str-orientation> <int-min> <int-max> <int-initial-value>)
;; (gs:text-area <sym-id> <sym-action> [<int-width> <int-height>])
;; (gs:text-field <sym-id> <sym-action> <int-columns>)
;; (gs:text-pane <sym-id> <sym-action> <str-style> [<int-width> <int-height>])
;; (gs:toggle-button <sym-id> <sym-action> [<str-text> <bool-selected>])
;; </pre>
;; For all button widgets, and the check box and menu-item widgets, icons can be set using
;; the 'gs:set-icon' and 'gs:set-pressed-icon' functions.
;;
;; </li>
;; <li><b>Placing components in containers</b><br>
;; For the flow and grid layouts the components are added in the sequence they are listed.
;; The grid-layout fills the grid row by row starting with the left most column.
;; <pre>
;; (gs:add-to <sym-container> <sym-component> [<sym-component ...])
;; </pre>
;; For the border layout an orientation parameter is specified as either <tt>"north"</tt>,
;; <tt>"west"</tt>, <tt>"center"</tt>, <tt>"east"</tt> or <tt>"south"</tt>.
;; <pre>
;; (gs:add-to <sym-container> [<sym-component> <str-orientation> ...])
;; </pre>
;; </li>
;; <li><b>Summary of commands</b><br>
;; Most of the commands set special attributes of containers or control widgets. The
;; function <tt>get-text</tt> is the only function which will prompt a control widget
;; to initiate an event back to newLISP. This event will contain the text requested.
;; Not all functions can be applied to all containers and control widgets. A wrong
;; application will either pop up an error message box or do nothing.
;;
;; Some functions will work on certain widgets only in certain situations. For example
;; <tt>set-size</tt> will work not on components in a grid layout but on components
;; in a flow layout. Some widgets have a preset background color which cannot be changed
;; or is overwritten by the current 'gs:look-and-feel' settings.
;;
;; <pre>
;; (gs:add-list-item <sym-list-combo> <str-text> [<str-text> ...])
;; (gs:add-separator <sym-menu-tool-bar>)
;; (gs:add-to <sym-container> <sym-component> [<sym-component ...])
;; (gs:add-to <sym-container> <sym-component> <str-orientation> [<sym-component> <str-orientation> ...])
;; (gs:append-text <sym-id> <str-text>)
;; (gs:check-event <int-microseconds>)
;; (gs:clear-list <sym-id>)
;; (gs:clear-text <sym-id>)
;; (gs:copy-text <sym-id>)
;; (gs:cut-text <sym-id>)
;; (gs:frame-closed <sym-id> <sym-action>)
;; (gs:disable <sym-id-1> [<sym-id-2> ...])
;; (gs:dispose <sym-id>)
;; (gs:dispose-splash)
;; (gs:enable <sym-id-1> [<sym-id-2> ...])
;; (gs:find-text <sym-id> <str-text> <sym-action> [<str-direction>]])
;; (gs:get-fonts)
;; (gs:get-bounds <sym-id>)
;; (gs:get-font-metrics <sym-id> <str-text>)
;; (gs:get-screen)
;; (gs:get-selected-text <sym-id> <sym-action>)
;; (gs:get-text <sym-id> <sym-action>)
;; (gs:get-text-position <sym-id>)
;; (gs:get-version);
;; (gs:goto-text <sym-id> <sym-row> <sym-column>)
;; (gs:insert-list-item <sym-list-combo> <str-text> <int-index> [<str-text> <int-index>])
;; (gs:insert-tab <sym-tabbed-pane> <sym-component> [<str-text> [<int-index> [<str-icon-path>]])
;; (gs:insert-text <sym-id> <str-text> <int-pos>)
;; (gs:layout <sym-container>)
;; (gs:load-text <sym-id> <str-path>)
;; (gs:no-action)
;; (gs:paste-text <sym-id> [<str-text>])
;; (gs:redo-text <sym-id>)
;; (gs:remove-from <sym-container> <sym-component> [<sym-component> ...])
;; (gs:remove-list-item <sym-list-combo> <int-index> [<int-index> ...])
;; (gs:remove-tab <sym-tabbed-pane> <int-index>)
;; (gs:request-focus <sym-id>)
;; (gs:select-list-item <sym-id> <str-item> [<boolean-flag>])
;; (gs:select-text <sym-id> <int-from> [<int-to>])
;; (gs:set-resizable <sym-frame> <boolean-flag>)
;; (gs:set-accelerator <sym-menu-item> <str-keystroke>)
;; (gs:set-background <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; (gs:set-background <sym-id> <list-rgb> [<float-alpha>])
;; (gs:set-bevel-border <sym-panel> <str-type>)
;; (gs:set-border-layout <sym-container> [<int-hgap> <int-vgap>])
;; (gs:set-caret-color <sym-id> <list-rgb>)
;; (gs:set-caret-color <sym-id> <float-red> <float-green> <float-blue>)
;; (gs:set-color <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; (gs:set-color <sym-id> <list-rgb> [<float-alpha>])
;; (gs:set-cursor <sym-id> <str-shape>)
;; (gs:set-editable <sym-id> <boolean-flag>)
;; (gs:set-flow-layout <sym-container> [<str-alignment> [<int-hgap> <int-vgap>]])
;; (gs:set-font <sym-id> <str-family> <int-size> <str-type>)
;; (gs:set-foreground <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; (gs:set-foreground <sym-id> <list-rgb> [<float-alpha>])
;; (gs:set-grid-layout <sym-container> <int-columns> <int-rows> [<int-hgap> <int-vgap>])
;; (gs:set-icon <sym-id> <str-icon-path> [<int-index>])
;; (gs:set-look-and-feel <str-look>)
;; (gs:set-pressed-icon <sym-id> <str-icon-path>)
;; (gs:set-selected <sym-id> <boolean-flag>)
;; (gs:set-size <sym-id> <int-width> <int-height>)
;; (gs:set-selection-color <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; (gs:set-syntax <sym-id> <str-type>)
;; (gs:set-syntax-colors <list-rgb-comments> <list-rgb-keywords> <list-rgb-string> <list-rgb-number> <list-rgb-quoted> <list-rgb-prantheses>)
;; (gs:set-tab-size <sym-id> <int-size>)
;; (gs:set-text <sym-id> <str-text> [<int-index>])
;; (gs:set-titled-border <sym-component> <str-title>)
;; (gs:set-tool-tip <sym-id> <str-text>)
;; (gs:set-trace <boolean-flag>)
;; (gs:set-value <sym-id> <int-value>)
;; (gs:set-visible <sym-id> <boolean-visible>)
;; (gs:undo-text <sym-id>)
;; </pre>
;; </li>
;; <li><b>Special dialogs</b><br>
;; These are standard dialogs for opening and saving files and for choosing colors.
;; Each dialog when closed fires an event for which a handler function must be
;; defined by the newLISP program.
;; <pre>
;; (gs:color-dialog <sym-parent-frame> <sym-action> <str-title> <float-red> <float-green> <float-blue>)
;; (gs:message-dialog <sym-parent-frame> <str-title> <str-message> [<str-type> [<str-icon-path>]])
;; (gs:confirm-dialog <sym-parent-frame> <sym-action> <str-title> <str-message> [<str-type>])
;; (gs:open-file-dialog <sym-parent-frame> <sym-action> [<str-directory> [<str-mask> <str-description>]])
;; (gs:save-file-dialog <sym-parent-frame> <sym-action> [<str-directory> [<str-initial-file> [<str-mask> <str-description>]]])
;; </pre>
;; </li>
;; <li><b>2D Graphics functions</b><br>
;; Every call to a 'gs:draw-xxx' or 'gs:fill-xxx' function will create a new graphics object, which
;; will persist until destroyed by a call to 'gs:delete-tag'. Graphics objects are animated
;; using the tag operations 'gs:move-tag', 'gs:rotate-tag', 'gs:scale-tag' and
;; 'gs:shear-tag' or using 'gs:hide-tag' and 'gs:show-tag'.
;;
;; Any 'gs:draw-xxx' or 'gs:fill-xxx' will create graphics objects but not force a screen update.
;; The canvas is automatically redrawn when made visible for the first time using 'gs:set-visible' or
;; after a call to 'gs:update'. Redrawing is also forced when resizing the window which hosts the canvas
;; or any action covering and uncovering the canvas.
;;
;; After all tag operations redrawing is initiated by default, but it can be forced off by spcifying
;; 'nil' as the last parameter in a 'gs:xxx-tag' command. Suppressing immediate redraw is useful to avoid
;; flicker when a batch of tag operations is performed.
;;
;; Every graphics object (line, shape, text, or image) carries a group tag. Objects are deleted
;; using 'gs:delete-tag' and will disappear immediately from the canvas. Using 'gs:move-tag'
;; lines, shapes, text and images can be moved to a different position.
;;
;; <pre>
;; (gs:delete-tag <sym-tag>[<boolean-repaint>))
;; (gs:draw-arc <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-start> <int-angle> [<list-rgb>])
;; (gs:draw-circle <sym-tag> <int-x> <int-y> <int-radius> [<list-rgb>])
;; (gs:draw-ellipse <sym-tag> <int-x> <int-y> <int-radius-x> <int-radius-y> [<list-rgb>])
;; (gs:draw-image <sym-tag> <str-path> <int-x> <int-y> [<int-width> <int-height>])
;; (gs:draw-line <sym-tag> <int-x1> <int-y1> <int-x2> <int-y2> [<list-rgb>])
;; (gs:draw-path <sym-tag> <list-points> [<list-rgb>])
;; (gs:draw-polygon <sym-tag> <list-points> [<list-rgb>])
;; (gs:draw-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> [<list-rgb>])
;; (gs:draw-round-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-arc-width> <int-arc-height> [<list-rgb>])
;; (gs:draw-text <sym-tag> <str-text> <int-x> <int-y> [<list-rgb> [<float-angle>]])
;; (gs:export <str-path-file> [<int-width> <int-height>])
;; (gs:fill-arc <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-start> <int-angle> [<list-rgb>])
;; (gs:fill-circle <sym-tag> <int-x> <int-y> <int-radius> [<list-rgb>])
;; (gs:fill-ellipse <sym-tag> <int-x> <int-y> <int-radius-x> <int-radius-y> [<list-rgb>])
;; (gs:fill-polygon <sym-tag> <list-points> [<list-rgb>])
;; (gs:fill-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> [<list-rgb>])
;; (gs:fill-round-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-arc-width> <int-arc-height> [<list-rgb>])
;; (gs:hide-tag <sym-tag> [<boolean-repaint>])
;; (gs:key-event <sym-id> <sym-action>)
;; (gs:mouse-clicked <sym-canvas> <sym-action> [<boolean-tags>])
;; (gs:mouse-dragged <sym-canvas> <sym-action>)
;; (gs:mouse-event <sym-id> <sym-action>)
;; (gs:mouse-moved <sym-canvas> <sym-action>)
;; (gs:mouse-pressed <sym-canvas> <sym-action> [<boolean-tags>])
;; (gs:mouse-released <sym-canvas> <sym-action> [<boolean-tags>])
;; (gs:mouse-wheel <sym-canvas> <sym-action>)
;; (gs:move-tag <sym-tag> <int-dx> <int-dy> [<boolean-repaint>])
;; (gs:rotate-tag <sym-tag> <float theta> <int-x> <int-y> [<boolean-repaint>])
;; (gs:save-text <sym-id> <str-path>)
;; (gs:scale-tag <sym-tag> <float-x> <float-y> [<boolean-repaint>])
;; (gs:shear-tag <sym-tag> <float-x> <float-y> [<boolean-repaint>])
;; (gs:show-popup <sym-tag> <sym-host> <int-x> <int-y>)
;; (gs:show-tag <sym-tag> [<boolean-repaint>])
;; (gs:set-canvas <sym-tag>)
;; (gs:set-paint <list-rgb>)
;; (gs:set-rotation <float-angle>)
;; (gs:set-scale <int-x> <int-y>)
;; (gs:set-stroke <float-width> [<str-cap> [<str-join> [<float-miterlimit>]]])
;; (gs:set-translation <int-x> <int-y>)
;; (gs:set-anti-aliasing <boolean-flag>)
;; (gs:translate-tag <sym-tag> <int-x> <int-y> [<boolean-repaint>])
;; (gs:update)
;; </pre>
;; </li>
;;
;; <li><b>Built-in icons and images</b><br>
;; The 'guiserver.jar' file has the following icons and images built in. Each of
;; them is prefixed with the path '/local/'. For example '/local/newLISP128.png'
;; addresses the newLISP logo of size 128x128. To address images outside of
;; 'guiserver.jar', use a normal file path suitable to your platform. On Win32
;; use forward slashes instead of backslashes.
;;
;; <pre>
;; Image path
;; ----------
;; clear-down32.png
;; clear32.png
;; copy-down32.png
;; copy32.png
;; cut-down32.png
;; cut32.png
;; dotgray16.png
;; dotgray32.png
;; dotgreen16.png
;; dotgreen32.png
;; dotred16.png
;; dotred32.png
;; dotyellow16.png
;; dotyellow32.png
;; edit-down32.png
;; edit32.png
;; folder-closed-down32.png
;; folder-closed32.png
;; folder-opened-down32.png
;; folder-opened32.png
;; font-book-down32.png
;; font-book32.png
;; green10.png
;; info-down32.png
;; info32.png
;; new-down32.png
;; new32.png
;; newLISP-down32.png
;; newLISP128.png
;; newLISP16.png
;; newLISP20.png
;; newLISP32.png
;; newLISP64.png
;; newLISPsplashWin.png
;; paste-down32.png
;; paste32.png
;; pressedbutton32.png
;; red10.png
;; restart-down32.png
;; restart32.png
;; run-down32.png
;; run32.png
;; save-down32.png
;; save32.png
;; search-down32.png
;; search32.png
;; stop-down32.png
;; stop32.png
;; </pre>
;; <li><b>Predefined colors</b><br>
;; The following colors are predefined:
;; <pre>
;; Name rgb components
;; ---- --------------
;; gs:black (0.0 0.0 0.0)
;; gs:blue (0.0 0.0 1.0)
;; gs:cyan (0.0 1.0 1.0)
;; gs:darkGray (0.2509804 0.2509804 0.2509804)
;; gs:gray (0.5019608 0.5019608 0.5019608)
;; gs:green (0.0 1.0 0.0)
;; gs:lightGray (0.7529412 0.7529412 0.7529412)
;; gs:magenta (1.0 0.0 1.0)
;; gs:orange (1.0 0.78431374 0.0)
;; gs:pink (1.0 0.6862745 0.6862745)
;; gs:red (1.0 0.0 0.0)
;; gs:white (1.0 1.0 1.0)
;; gs:yellow (1.0 1.0 0.0)
;; </pre>
;;
;; Colors in newLISP-GS can be specified as three (four with alpha component) single
;; numbers or as a list of the three RGB values followed by the alpha channel number.
;; <pre>
;; (gs:set-background 'aPanel gs:magenta
;; (gs:set-background 'aPanel 1.0 0 1
;; (gs:set-background 'aPanel '(1 0 1)
;; </pre>
;; All of the above statements will produce the same background color on the <tt>aPanel</tt>.
;; <li><b>Sound API</b><br>
;; <pre>
;; (gs:play-sound <str-file-path>)
;; </ul>
(set 'gs:black '(0.0 0.0 0.0))
(set 'gs:blue '(0.0 0.0 1.0))
(set 'gs:cyan '(0.0 1.0 1.0))
(set 'gs:darkGray '(0.2509804 0.2509804 0.2509804))
(set 'gs:gray '(0.5019608 0.5019608 0.5019608))
(set 'gs:green '(0.0 1.0 0.0))
(set 'gs:lightGray '(0.7529412 0.7529412 0.7529412))
(set 'gs:magenta '(1.0 0.0 1.0))
(set 'gs:orange '(1.0 0.78431374 0.0))
(set 'gs:pink '(1.0 0.6862745 0.6862745))
(set 'gs:red '(1.0 0.0 0.0))
(set 'gs:white '(1.0 1.0 1.0))
(set 'gs:yellow '(1.0 1.0 0.0))
(context 'gs)
(if (= ostype "Win32")
(set 'server-path (string "\"" (env "PROGRAMFILES") "/newlisp/guiserver.jar\""))
(set 'server-path "/usr/local/share/newlisp/guiserver.jar"))
;; <br><br><br>
;; @syntax (gs:add-list-item <sym-list-combo> <str-text> [<str-text> ...])
;; @param <sym-list-combo> The name of the combo box or list box to which text entries are added.
;; @param <str-text> The text of the entry to be added.
;;
;; Items are added in the same sequence as they appear in the 'gs:add-list' command and added to the
;; end of the existing list of items.
(define (add-list-item comp)
(let (s (string "add-list-item " comp " "))
(doargs (item)
(write-buffer s (string (base64-enc item) " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:add-separator <sym-menu-tool-bar>)
;; @param <sym-menu-tool-bar> The name of the tool bar or menu bar to which a spacer entry is added.
;;
;; Depending on the OS platform the separator may not be visible and only occupy space before the next
;; component added to the tool or menu bar.
(define (add-separator bar)
(net-send out (string "add-separator " bar "\n"))
)
;; @syntax (gs:add-to <sym-container> <sym-component> [<sym-componentl> ...])
;; @param <sym-container> The name of the container to which components are added.
;; @param <sym-component> One or more symbols of the components to add.
;; @syntax (gs:add-to <sym-container> <sym-component> <str-orientation> [<sym-component> <str-orientation> ...])
;; @param <sym-container> The name of the container to which components are added.
;; @param <sym-component> The name of a component to add.
;; @param <str-orientation> The orientation of a component to add in border layout, '"north"', '"west"', '"center"', '"east"' or '"south"'.
(define (add-to id)
(let (s (string "add-to " id " "))
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s)
)
)
;; @syntax (gs:append-text <sym-id> <str-text>)
;; @param <sym-id> The name of the text field or text area to which text is appended.
;; @param <str-text> The text to be appended.
(define (append-text id text)
(net-send out (string "append-text " id " " (base64-enc text) "\n"))
)
;; @syntax (gs:button <sym-id> <sym-action> [<str-text> [<int-width> <int-height>]])
;; @param <sym-id> The name of the button.
;; @param <sym-action> The name of the event handler.
;; @param <str-icon-path> An optional text for the button.
;; @param <int-width> The optional width of the button.
;; @param <int-height> The optional height of the button.
(define (button id action text x y)
(if text
(if (and x y)
(net-send out (string "button " id " " action " " (base64-enc text) " " x " " y "\n"))
(net-send out (string "button " id " " action " " (base64-enc text) "\n")))
(net-send out (string "button " id " " action "\n"))
)
)
;; @syntax (gs:canvas <sym-id>)
;; @param <sym-id> The name of the canvas.
;;
;; A canvas is a pane for drawing and receiving mouse input events. For most
;; applications a background color should be specified for the canvas using
;; 'gs:set-background' or 'gs:set-color' which call the same function internally. The
;; background forces the canvas to be cleared before redrawing components
;; which have been moved, rotated, scaled or deleted. In applications where
;; this is not desired but a background color is still required, the background
;; color can be specified for the container hosting the canvas. The canvas
;; background will then appear in the color of the container, but erasing
;; the canvas before repainting is not enforced.
;;
;; A canvas can also be used to host widgets like buttons etc.. In this case
;; the canvas is treated like a 'gs:pane', with a flow layout by default.
;; Similar to a panel created with 'gs:pane' other layouts can be set.
;;
;; When widgets are present on a canvas they appear to be floating over
;; the drawing. See the file 'textrot-demo.lsp' for an example.
(define (canvas id parent)
(set 'gs:currentCanvas id)
(net-send out (string "canvas " id "\n"))
)
;; @syntax (gs:check-box <sym-id> <sym-action> [<str-text> [<bool-selected>]])
;; @param <sym-id> The name of the check box.
;; @param <sym-action> The name of the event handler.
;; @param <str-text> The text of the check box.
;; @param <bool-selected> An optional flag indicating the selection state 'true' or 'nil' (default).
;;
(define (check-box id action text selected)
(if text
(net-send out (string "check-box " id " " action " " (base64-enc text) " " selected "\n"))
(net-send out (string "check-box " id " " action "\n")))
)
;; @syntax (gs:check-event <int-microseconds>)
;; @param <int-microseconds> Wait for for an event a maximum of <int-microseconds> and execute it.
;;
;; The function 'gs:check-event' is used as an alternative to 'gs:listen' when the application
;; is performing some activity while waiting for user input from the GUI. Typically
;; 'gs:check-event' is used in a loop, which performs some other task and at the same time
;; checks for events from the GUI part of the application. Like 'gs:listen' the function will
;; force an exit of the application when communication between the newLISP-GS and the newLISP
;; application process fails.
;;
;; @example
;; (while (gs:check-event 10000) ; check for 10 milliseconds
;; (do-myprocess)
;; )
(define (check-event us)
(if (net-select in "read" us)
(if (net-receive in 'event 1000000000 "\n")
(eval-string event)
(exit)))
true
)
;; @syntax (gs:clear-list <sym-id>)
;; @param <sum-id> The name of the list component in which to clear all entries.
(define (clear-list id)
(net-send out (string "clear-list " id "\n"))
)
;; @syntax (gs:clear-text <sym-id>)
;; @param <sum-id> The name of the component in which to clear the text.
(define (clear-text id)
(net-send out (string "clear-text " id "\n"))
)
;; @syntax (gs:copy-text <sym-id>)
;; @param <sum-id> The name of the text component from which to copy the selection to the clipboard.
(define (copy-text id)
(net-send out (string "copy-text " id "\n"))
)
;; @syntax (gs:cut-text <sym-id>)
;; @param <sum-id> The name of the text component from which to cut selected text and place it on the clipboard..
(define (cut-text id)
(net-send out (string "cut-text " id "\n"))
)
;; @syntax (gs:color-dialog <sym-parent-frame> <sym-action> <str-title> <float-red> <float-green> <float-blue>)
;; @param <sym-parent-frame> The name symbol of the parent frame.
;; @param <sym-action> The symbol of the handler to call when leaving the dialog
;; @param <str-title> The title of the color dialog.
;; @param <float-red> The initial red color component.
;; @param <float-green> The initial green color component.
;; @param <float-blue The initial blue color component.
(define (color-dialog parent action title red green blue)
(net-send out (string "color-dialog " parent " " action " " (base64-enc title) " " red " " green " " blue "\n"))
)
;; @syntax (gs:combo-box <sym-id> <sym-action> [<str-item-1> ...])
;; @param <sym-id> The name of the combo box.
;; @param <sym-action> The name of the event handler.
;; @param <str-item> Zero, one or more text entries in the combo box.
;; @syntax (gs:combo-box <sym-id> <sym-action> [<list-str-items>])
;; @param <sym-id> The name of the combo box.
;; @param <sym-action> The name of the event handler.
;; @param <list-str-items> Zero, one or more text entries in a list.
(define (combo-box id action)
(let ( s (string "combo-box " id " " action " ")
entries (if (list? (args 0)) (args 0) (args)) )
(dolist (item entries)
(write-buffer s (string (base64-enc item) " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:confirm-dialog <sym-parent-frame> <sym-action> <str-title> <str-message> [<str-type>])
;; @param <sym-parent-frame> The symbol name of the parent frame.
;; @param <sym-action> The action to perform when the diaog is closed.
;; @param <str-title> The title of the message box.
;; @param <str-message> The message in the message box.
;; @param <str-type> The type of the message box.
;;
;; The type of the message box can be one of: '"yes-no"', '"yes-no-cancel"'
;; On return of the message box <sym-action> carries one of the responses <tt>0</tt> for the yes-,
;; <tt>1</tt> for the no- or <tt>3</tt> for the cancel-button.
(define (confirm-dialog parent action title message (type plain))
(net-send out (string "confirm-dialog " parent " " action " "
(base64-enc title) " " (base64-enc message) " " type "\n"))
)
;; @syntax (gs:delete-tag <sym-tag> [<boolean-repaint>])
;; @param <sym-tag> The tag group to be deleted.
;;
;; Deletes all 2D objects (lines, shapes, text, images) tagged with <sym-tag>.
;;
;; Each time a 'gs:draw-xxx' or 'gs:fill-xxx' function is called a graphical
;; object is created. The tag used during creation is a way to address one
;; or more of these objects. See the file 'mouse-demo.lsp' for an example.
(define (delete-tag tag (repaint true))
(net-send out (string "delete-tag " gs:currentCanvas " " tag " " repaint "\n"))
)
;; @syntax (gs:dialog <sym-id> <sym-parent> <str-title> <int-width> <int-height> [<boolean-visible> [<boolean-modal>]])
;; @param <sym-id> The name of the dialog
;; @param <sym-parent> The name of the parent frame.
;; @param <str-title> The title string of the dialog frame.
;; @param <int-width> The width of the dialog frame.
;; @param <int-height> The height of the dialog frame.
;; @param <boolean-visible> The optional flag with a value of 'true' or 'nil' for visibility of the dialog.
;; @param <boolean-modal> The optional flag with a value of 'true' or 'nil' for modality of the dialog.
;;
;; Initially the dialog should not be visible until all widgets are added to it.
;; When no flags for visibility and modality are specified, 'nil' is assumed. A modal dialog will
;; prevent input in the parent window. Components can be added to a dialog using 'gs:add-to'.
;; Use the 'gs:set-border-layout', 'ga:set-flow-layout' or 'gs:set-grid-layout' to set a specific
;; layout.
(define (dialog id parent title width height visible modal)
(net-send out (string "dialog " id " " parent " " (base64-enc title) " " width " " height " " visible " " modal"\n"))
)
;; @syntax (gs:disable <sym-id-1> [sym-id-2 ...])
;; @param <sym-id> The name of the component to disable.
;;
;; Disabled components are grayed and do not accept input.
(define (disable)
(let (s "disable ")
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s)
)
)
;; @syntax (gs:dispose <sym-id>)
;; @param <sym-id> The name of the component to dispose of.
(define (dispose id)
(net-send out (string "dispose " id "\n"))
)
;; @syntax (gs:dispose-splash)
;;
;; A splash screen can be specified when starting the newLISP-GS process before newLISP.
;; The function 'gs:dispose-splash' is used to turn off the splash image after
;; the newLISP GUI application has started.
;;
;; @example
;; java -jar /usr/local/share/newlisp/guiserver.jar 4711 program.lsp /local/newLISP128.png
;; ; or on Win32
;; java -jar "c:\Program Files\newlisp\guiserver.jar" 4711 "newlisp program.lsp" /local/newLISPsplashWin.png
;; The example starts newLISP-GS with an application 'program.lsp' and a splash
;; screen showing the built-in newLISP logos and using port 4711. Instead, the full pathname
;; of a different image file can be specified. Inside 'program.lsp' the function
;; 'gs:dispose-splash' or a mouse click on the image will turn off the splash screen.
;; For 'program.lsp' the full pathname may be necessary. On Win32 quotes are necessary to bracket
;; arguments to 'guiserver.jar' which contain spaces.
(define (dispose-splash)
(net-send out "dispose-splash System\n")
)
;; @syntax (gs:draw-arc <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-start> <int-angle> [<list-rgb>])
;; @param <sym-tag> The tag group of the arc.
;; @param <int-x> The X position of the arc.
;; @param <int-y> The Y position of the arc.
;; @param <int-width> The width of the arc.
;; @param <int-height> The height of the arc.
;; @param <int-start-angle> The start angle of the arc in 0 to 360 degrees.
;; @param <int-arc-angle> The opening angle of the arc in 0 to 360 degrees.
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components
;;
;; The resulting arc begins at <int-start-angle> and extends for <int-arc-angle degrees>,
;; using the current color. Angles are interpreted such that 0 degrees is at the 3 o'clock
;; position. A positive value indicates a counter-clockwise rotation while a negative value
;; indicates a clockwise rotation.
;;
;; The center of the arc is the center of the rectangle whose origin is (x, y) and whose size
;; is specified by the width and height arguments.
;;
;; The resulting arc covers an area <int-width> pixels wide by <int-height> pixels tall.
(define (draw-arc id x y width height start angle color)
(if color
(net-send out (string "draw-arc " gs:currentCanvas " " id " " x " " y " "
width " " height " " start " " angle " "
(color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "draw-arc " gs:currentCanvas " " id " " x " " y " "
width " " height " " start " " angle "\n"))
)
)
;; @syntax (gs:draw-circle <sym-tag> <int-x> <int-y> <int-radius> [<list-rgb>])
;; @param <sym-tag> The tag group of the circle.
;; @param <int-x> The X position of the circle center.
;; @param <int-y> The Y position of the circle center.
;; @param <int-radius> The radius of the circle.
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components
;;
;; Creates the outline of a circle. The color numbers must be entered in list form.
;; If no <list-rgb> is used the current paint specified with 'gs:set-paint' is used.
(define (draw-circle tag x y radius color)
(if color
(net-send out (string "draw-circle " gs:currentCanvas " "
tag " " x " " y " " radius " " (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "draw-circle " gs:currentCanvas " "
tag " " x " " y " " radius "\n"))
)
)
;; @syntax (gs:draw-ellipse <sym-tag> <int-x> <int-y> <int-radius-x> <int-radius-y> [<list-rgb>])
;; @param <sym-tag> The tag group of the ellipse.
;; @param <int-x> The X position of the ellipse center.
;; @param <int-y> The Y position of the ellipse center.
;; @param <int-radius-x> The radius of the ellipse.
;; @param <int-radius-y> The radius of the ellipse.
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components
;;
;; Creates the outline of an ellipse. The color numbers must be enterd in list form.
;; If no <list-rgb> is used the current paint specified with 'gs:set-paint' is used.
(define (draw-ellipse tag x y radius-x radius-y color)
(if color
(net-send out (string "draw-ellipse " gs:currentCanvas " "
tag " " x " " y " " radius-x " " radius-y " " (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "draw-ellipse " gs:currentCanvas " "
tag " " x " " y " " radius-x " " radius-y "\n"))
)
)
;; @syntax (gs:draw-image <sym-tag> <str-path> <int-x> <int-y> [<int-width> <int-height>])
;; @param <sym-tag> The tag group of the image.
;; @param <int-x> The X position of the image top left corner.
;; @param <int-y> The Y position of the image top left corner.
;; @param <int-width> The optional width in which to draw the image.
;; @param <int-height> The optional height in which to draw the image.
;;
;; When <int-width> and <int-height> parameters are specified and they are not
;; equal to the original size of the image (measured in pixels) the image will
;; be displayed in either compressed or zoomed form.
(define (draw-image tag path x y width height)
(if (and width height)
(net-send out (string "draw-image " gs:currentCanvas " " tag " "
(base64-enc path) " " x " " y " " width " " height "\n"))
(net-send out (string "draw-image " gs:currentCanvas " " tag " "
(base64-enc path) " " x " " y "\n"))
)
)
;; @syntax (gs:draw-line <sym-tag> <int-x1> <int-y1> <int-x2> <int-y2> [<list-rgb>])
;; @param <sym-tag> The tage of the line.
;; @param <int-x1> The X position of the first point.
;; @param <int-y1> The Y position of the first point.
;; @param <int-x2> The X position of the second point.
;; @param <int-y2> The Y position of the second point.
;;
;; Draws a line. The color numbers must be entered in list form.
;; If no <list-rgb> is used the current paint specified with 'gs:set-paint' is used.
(define (draw-line tag x1 y1 x2 y2 color)
(if color
(net-send out (string "draw-line " gs:currentCanvas " " tag " "
x1 " " y1 " " x2 " " y2 " " (color 0) " " (color 1) " " (color 2) "\n"))
)
)
;; @syntax (gs:draw-path <sym-tag> <list-points> [<list-rgb>])
;; @param <sym-tag> The tage group of the path.
;; @param <list-points> The list of x and y coordinates of the points.
;;
;; Draws a path with the points found in <list-points>.
;;
;; @example
;; (gs:draw-path 'P '(1 0 2 2 3 0))
;; The example will draw an upwards-pointing triangle without base at the
;; points '1,0', '2,2' and '3,0'
(define (draw-path tag points color)
(if color
(let (s (string "draw-path " gs:currentCanvas " " tag " " (/ (length points) 2) " "))
(dolist (p points)
(write-buffer s (string p " ")))
(write-buffer s (string (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out s)
)
(let (s (string "draw-path " gs:currentCanvas " " tag " " (/ (length points) 2) " "))
(dolist (p points)
(write-buffer s (string p " ")))
(write-buffer s "\n")
(net-send out s)
)
)
)
;; @syntax (gs:draw-polygon <sym-tag> <list-points> [<list-rgb>])
;; @param <sym-tag> The tag group of the polygon.
;; @param <list-points> The list of x and y coordinates of the points.
;;
;; Draws a polygon with the points found in <list-points>.
;;
;; @example
;; (gs:draw-polygon 'P '(1 0 2 2 3 0))
;; The example will draw an upwards-pointing triangle with the points '1,0', '2,2'
;; and '3,0'.
(define (draw-polygon tag points color)
(if color
(let (s (string "draw-polygon " gs:currentCanvas " " tag " " (/ (length points) 2) " "))
(dolist (p points)
(write-buffer s (string p " ")))
(write-buffer s (string (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out s)
)
(let (s (string "draw-polygon " gs:currentCanvas " " tag " " (/ (length points) 2) " "))
(dolist (p points)
(write-buffer s (string p " ")))
(write-buffer s "\n")
(net-send out s)
)
)
)
;; @syntax (gs:draw-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> [<list-rgb>])
;; @param <sym-tag> The tag group of the rectangle.
;; @param <int-x> The X position of the top left corner.
;; @param <int-y> The Y position of the top left corner.
;; @param <int-width> The width of the rectangle.
;; @param <int-height> The height of the rectangle..
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components
;;
;; Creates the outline of a rectangle. The color numbers must be entered in list form.
;; If no <list-rgb> is used the current paint specified with 'gs:set-paint' is used.
(define (draw-rect tag x y width height color)
(if color
(net-send out (string "draw-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "draw-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height "\n"))
)
)
;; @syntax (gs:draw-round-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-arc-width> <int-arc-height> [<list-rgb>])
;; @param <sym-tag> The tag group of the round rectangle.
;; @param <int-x> The X position of the top left corner.
;; @param <int-y> The Y position of the top left corner.
;; @param <int-width> The width of the rectangle.
;; @param <int-height> The height of the rectangle..
;; @param <int-arc-width> The width of the corner rectangle.
;; @param <int-arc-height> The height of the corner rectangle..
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components
;;
;; Draws a rectangle shape with round corners. The rounding is defined by the rectangle enclosing
;; the rounding arc.
(define (draw-round-rect tag x y width height arcw arch color)
(if color
(net-send out (string "draw-round-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " arcw " " arch " "
(color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "draw-round-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " arcw " " arch "\n"))
)
)
;; @syntax (gs:draw-text <sym-tag> <str-text> <int-x> <int-y> [<list-rgb> [<float-angle>])
;; @param <sym-tag> The tag group of the text.
;; @param <str-text> The text to be drawn.
;; @param <int-x> The X position of the text.
;; @param <int-y> The Y position of the text.
;; @param <list-rgb> The optonal color for the text.
;; @param <float-angle> The optional angle for text in degrees
;;
;; If no <list-rgb> is used, the current paint specified with 'gs:set-paint' is used.
;; The optional angle is <tt>0</tt> by default for horizontal text. A value of <tt>90</tt>
;; will rotate the text around the <tt>x</tt>, <tt>y</tt> position downwards clockwise.
(define (draw-text tag text x y color angle)
(if color
(if angle
(net-send out (string "draw-text " gs:currentCanvas " "
tag " " (base64-enc text) " " x " " y " "
(color 0) " " (color 1) " " (color 2) " " angle "\n"))
(net-send out (string "draw-text " gs:currentCanvas " "
tag " " (base64-enc text) " " x " " y " "
(color 0) " " (color 1) " " (color 2) "\n"))
)
(net-send out (string "draw-text " gs:currentCanvas " "
tag " " (base64-enc text) " " x " " y "\n"))
)
)
;; @syntax (gs:enable <sym-id-1> [sym-id-2 ...])
;; @param <sym-id> The name of a component to enable.
;;
;; Components are enabled by default.
(define (enable)
(let (s (string "enable "))
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s)
)
)
;; @syntax (gs:export <str-path-file> [<int-width> <int-height>])
;; @param <str-path-file> The path and file name of the image file to write to.
;; @param <int-width> The optional width of the image in pixels.
;; @param <int-height> The optional height of the image in pixels.
;;
;; If no width and height are specified, the current size of the canvas is assumed.
;;
;; @example
;;
;; (gs:export "/usr/home/pictures/mypic.png")
;; This will generate a '.png' file exactly as the image seen on the screen.
;; The color format is RGBA with 8 bit per color and an alpha channel. When
;; no background color is defined for the canvas, the background will be
;; transparent.
;;
;; When specifying width and height, a smaller or bigger portion of the canvas
;; than seen on the screen is printed to the image.
(define (export path width height)
(if (and width height)
(net-send out (string "export " gs:currentCanvas " " (base64-enc path) " " width " " height "\n"))
(net-send out (string "export " gs:currentCanvas " " (base64-enc path) "\n"))
)
)
;; @syntax (gs:fill-arc <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-start> <int-angle> [<list-rgb>])
;; @param <sym-tag> The tag group of the arc.
;; @param <int-x> The X position of the arc.
;; @param <int-y> The Y position of the arc.
;; @param <int-width> The width of the arc.
;; @param <int-height> The height of the arc.
;; @param <int-start-angle> The start angle of the arc in 0 to 360 degrees.
;; @param <int-arc-angle> The opening angle of the arc in 0 to 360 degrees.
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components.
;;
;; The resulting arc begins at <int-start-angle> and extends for <int-arc-angle degrees>,
;; using the current color. Angles are interpreted such that 0 degrees is at the 3 o'clock
;; position. A positive value indicates a counter-clockwise rotation while a negative value
;; indicates a clockwise rotation.
;;
;; The center of the arc is the center of the rectangle whose origin is (x, y) and whose size
;; is specified by the width and height arguments.
;;
;; The resulting arc covers an area <int-width> pixels wide by <int-height> pixels tall.
(define (fill-arc id x y width height start angle color)
(if color
(net-send out (string "fill-arc " gs:currentCanvas " " id " " x " " y " "
width " " height " " start " " angle " "
(color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "fill-arc " gs:currentCanvas " " id " " x " " y " "
width " " height " " start " " angle "\n"))
)
)
;; @syntax (gs:fill-circle <sym-tag> <int-x> <int-y> <int-radius> [<list-rgb>])
;; @param <sym-tag> The tag group of the circle.
;; @param <int-x> The X position of the circle center.
;; @param <int-y> The Y position of the circle center.
;; @param <int-radius> The radius of the circle.
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components.
;;
;; Creates a filled circle. The color numbers must be entered in list form.
;; If no <list-rgb> is used, the current paint specified with 'gs:set-paint' is used.
(define (fill-circle tag x y radius color)
(if color
(net-send out (string "fill-circle " gs:currentCanvas " "
tag " " x " " y " " radius " " (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "fill-circle " gs:currentCanvas " "
tag " " x " " y " " radius "\n"))
)
)
;; @syntax (gs:fill-ellipse <sym-tag> <int-x> <int-y> <int-radius-x> <int-radius-y> [<list-rgb>])
;; @param <sym-tag> The tag group of the ellipse.
;; @param <int-x> The X position of the ellipse center.
;; @param <int-y> The Y position of the ellipse center.
;; @param <int-radius-x> The radius of the ellipse.
;; @param <int-radius-y> The radius of the ellipse.
;; @param <list-rgb> The fill color as a list of 3 numbers for the rgb components.
;;
;; Creates a filled ellipse. The color numbers must be entered in list form.
;; If no <list-rgb> is used, the current paint specified with 'gs:set-paint' is used.
(define (fill-ellipse tag x y radius-x radius-y color)
(if color
(net-send out (string "fill-ellipse " gs:currentCanvas " "
tag " " x " " y " " radius-x " " radius-y " "
(color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "fill-ellipse " gs:currentCanvas " "
tag " " x " " y " " radius-x " " radius-y "\n"))
)
)
;; @syntax (gs:fill-polygon <sym-tag> <list-points> [<list-color>])
;; @param <sym-tag> The tag group of the polygon.
;; @param <list-points> The list of x and y coordinates of the points.
;;
;; Draws a polygon with the points found in <list-points> and fills it with
;; the current color set with 'gs:set-paint' or the optional color
;; given in <list-color>.
;;
;; @example
;; (gs:fill-polygon 'P '(1 0 2 2 3 0))
;;
;; (gs:fill-polygon 'P '(1 0 2 2 3 0) gs:gray)
;; The example will fill an upwards pointing triangle with the points '1,0', '2,2'
;; and '3,0' and fill it with the current color set with 'gs:set-paint'. The second
;; example paints a gray triangle regardless of the current color set with
;; 'gs:set-paint'.
(define (fill-polygon tag points color)
(if color
(let (s (string "fill-polygon " gs:currentCanvas " " tag " " (/ (length points) 2) " "))
(dolist (p points)
(write-buffer s (string p " ")))
(write-buffer s (string (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out s)
)
(let (s (string "fill-polygon " gs:currentCanvas " " tag " " (/ (length points) 2) " "))
(dolist (p points)
(write-buffer s (string p " ")))
(write-buffer s "\n")
(net-send out s)
)
)
)
;; @syntax (gs:fill-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> [<list-rgb>])
;; @param <sym-tag> The tag group of the rectangle.
;; @param <int-x> The X position of the top left corner.
;; @param <int-y> The Y position of the top left corner.
;; @param <int-width> The width of the rectangle.
;; @param <int-height> The height of the rectangle.
;; @param <list-rgb> The fill color as a list of 3 numbers for the rgb components.
;;
;; Creates a filled rectangle. The color numbers must be entered in list form.
;; If no <list-rgb> is used, the current paint specified with 'gs:set-paint' is used.
(define (fill-rect tag x y width height color)
(if color
(net-send out (string "fill-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " (color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "fill-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height "\n"))
)
)
;; @syntax (gs:fill-round-rect <sym-tag> <int-x> <int-y> <int-width> <int-height> <int-arc-width> <int-arc-height> [<list-rgb>])
;; @param <sym-tag> The tag group of the round rectangle.
;; @param <int-x> The X position of the top left corner.
;; @param <int-y> The Y position of the top left corner.
;; @param <int-width> The width of the rectangle.
;; @param <int-height> The height of the rectangle..
;; @param <int-arc-width> The width of the corner rectangle.
;; @param <int-arc-height> The height of the corner rectangle.
;; @param <list-rgb> The outline color as a list of 3 numbers for the rgb components.
;;
;; Paints a rectangle shape with round corners. The rounding is defined by the rectangle enclosing
;; the rounding arc.
(define (fill-round-rect tag x y width height arcw arch color)
(if color
(net-send out (string "fill-round-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " arcw " " arch " "
(color 0) " " (color 1) " " (color 2) "\n"))
(net-send out (string "fill-round-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " arcw " " arch "\n"))
)
)
;; @syntax (gs:find-text <sym-id> <str-text> <sym-action> [<str-direction>])
;; @param <sym-id> The name of the textr area or text pane.
;; @param <boolean-next> The optional direction string '"next"' (default) or '"previous"'.
;; @param <sym-action> A optional action to peform after find-text.
;;
;; The text area or text pane will be searched starting at the current caret position
;; forward or backwards depending on the optional direction field. After the search
;; the found text is highlighted. If the optional <sym-action> is specified an event
;; containing the id of the text area or pane and found position or '-1' will be fired.
(define (find-text id text action (direction "next"))
(net-send out (string "find-text " id " " (base64-enc text) " " action " " direction "\n"))
)
;; @syntax (gs:frame <sym-id> <int-x> <int-y> <int-width> <int-height> [<str-title> <boolean-visible>])
;; @param <sym-id> The name of the frame window.
;; @param <int-x> The X position of the top left window corner.
;; @param <int-y> The Y position of the top left windows corner.
;; @param <int-width> The width of the window frame.
;; @param <int-height> The height of the windows frame.
;; @param <str-title> The optional title of the window.
;; @param <boolean-visible> The optional flag with a value of 'true' or 'nil' for the visibility of the window.
;;
;; Initially the frame should not be visible until all widgets are added to it.
;; When no flag for visibility is specified 'nil' is assumed. The default layout of a frame behaves
;; like a grid layout with one cell. Use the 'set-flow-layout', 'set-border-layout' and
;; 'set-grid-layout' to change the layout.
(define (frame id x y width height text visible)
(if text
(net-send out (string "frame " id " " x " " y " " width " " height " " (base64-enc text) " " visible "\n"))
(net-send out (string "frame " id " " x " " y " " width " " height "\n"))
)
)
;; @syntax (gs:get-bounds <sym-id>)
;; @param <sym-id> The id of the component for which to get the list of bounding values.
;; @return The bounding list '(<x> <y> <width> <height>)'
(define (get-bounds id)
(set 'gs:bounds nil)
(net-send out (string "get-bounds " id "\n"))
(while (not gs:bounds) (check-event 10000))
gs:bounds
)
;; @syntax (gs:get-fonts)
;; @return A list of family names for fonts on the current system.
;;
;; The function should be called only once because it may take considerable
;; time in a system loaded with many fonts. The variable 'gs:fonts' contains
;; the same list of fonts originally returned by a call to 'gs:get-fonts'.
(define (get-fonts)
(if (not gs:fonts)
(begin
(net-send out (string "get-fonts System\n"))
(while (not gs:fonts) (check-event 10000))
(set 'gs:fonts (map base64-dec gs:fonts))
)
)
)
;; @syntax (gs:get-font-metrics <sym-id> <str-text>)
;; @return A list of the two values for width and height in pixels.
;;
;; The font metrics for the currently set font in <sym-id> are returned as a list
;; of width and height in pixels when displaying the string in <str-text>.
;; After the function call the variable 'gs:font-metrics' contains the same list
;; of values as originally returned by the call to 'gs:get-font-metrics'.
(define (get-font-metrics id text)
(set 'gs:font-metrics nil)
(net-send out (string "get-font-metrics " id " " (base64-enc text) "\n"))
(while (not gs:font-metrics) (check-event 10000))
gs:font-metrics
)
;; @syntax (gs:get-screen)
;; @return A list of screen width, height and resolution of the main computer screen.
;;
;; After calling the 'gs:get-screen' once the screen parameters are also available
;; in the variable 'gs:screen'.
(define (get-screen)
(net-send out (string "get-screen System\n"))
(while (not gs:screen) (check-event 10000))
gs:screen
)
;; @syntax (gs:get-selected-text <sym-id> <sym-action>)
;; @param <sym-id> The name of the component from which to get the selected text.
;; @param <sym-action> The symbol of the event handler which will receive the selected text.
(define (get-selected-text id action)
(net-send out (string "get-selected-text " id " " action "\n"))
)
;; @syntax (gs:get-text <sym-id> <sym-action>)
;; @param <sym-id> The name of the component from which to get the text.
;; @param <sym-action> The symbol of the event handler which will receive the text.
(define (get-text id action)
(net-send out (string "get-text " id " " action "\n"))
)
;; @syntax (gs:get-text-position <sym-id>)
;; @param <sym-id> The name of the text component for which the line and column position is returned.
;; @return A list of line and column position of the text caret.
;;
(define (get-text-position id)
(set 'gs:text-position nil)
(net-send out (string "get-text-position " id "\n"))
(while (not gs:text-position) (check-event 10000))
gs:text-position
)
;; @syntax (gs:get-version)
;; @return The version string of newLISP-GS running.
;;
;; After calling the 'gs:get-version' once the version number is also
;; available in 'gs:version'.
(define (get-version)
(net-send out (string "get-version System\n"))
(while (not gs:version) (check-event 10000))
gs:version
)
;; @syntax (gs:goto-text <sym-id> <int-row> <int-column>)
;; @param <sym-id> The name of the text widget.
;; @param <int-row> The row number where to place the cursor.
;; @param <int-column> The column number where to place the cursor.
(define (goto-text id row col)
(net-send out (string "goto-text " id " " row " " col "\n"))
)
;; @syntax (gs:hide-tag <sym-tag> [<boolean-repaint>])
;; @param <sym-tag> The tag of the group to hide.
;;
(define (hide-tag tag (repaint true))
(net-send out (string "hide-tag " gs:currentCanvas " " tag " " repaint "\n"))
)
;; @syntax (gs:image-button <sym-id> <sym-action> <str-icon-path> [<str-down-icon-path> [<int-width> <int-height>]])
;; @param <sym-id> The name of the image button.
;; @param <sym-action> The name of the event handler.
;; @param <str-icon-path> The path for an image icon.
;; @param <str-down-con-path> The path for a pressed down image icon.
;; @param <int-width> The optional width of the image button.
;; @param <int-height> The optional height of the image button.
(define (image-button id action icon down-icon x y)
(if down-icon
(if (and x y)
(net-send out (string "image-button " id " " action " " (base64-enc icon) " " (base64-enc down-icon) " " x " " y "\n"))
(net-send out (string "image-button " id " " action " " (base64-enc icon) " " (base64-enc down-icon) "\n"))
)
(net-send out (string "image-button " id " " action " " (base64-enc icon) "\n"))
)
)
;; @syntax (gs:image-label <sym-id> <str-icon-path> [<str-align>])
;; @param <sym-id> The name of the label.
;; @param <str-ucon-path> A string with the icon file path.
;; @param <str-align> An optional alignment '"left"', '"center"' or '"right"', '"leading"', '"trailing"', '"bottom"' or '"top"'.
(define (image-label id icon align)
(if align
(net-send out (string "image-label " id " " (base64-enc icon) " " align "\n"))
(net-send out (string "image-label " id " " (base64-enc icon) "\n")))
)
;; @syntax (gs:init [<int-port> <str-host>])
;; @param <int-port> The optional guiserver server port.
;; @param <str-host> The optional remote host of the guiserver.
(define (init (portIn 47011) (host "localhost"))
; check for server portIn and if this was started by java
; note: when this was started from inside the new console
; starting a GUI script in the console then main-args
; will contain ("newlisp" "-c" "-p" "64003"). But the
; following lines will still work because the int conversion
; doesn't fail on "-p" but takes the portIn as default
(if (main-args 2) (set 'portIn (int (main-args 2) portIn)))
(if (not (= (main-args 3) "javastart"))
(if (= ostype "Win32")
(process (string "cmd /c " server-path " " portIn))
(process (string "java -jar " server-path " " portIn)))
)
(set 'portOut (+ portIn 1))
(set 'retry 0)
(set 'out nil)
(while (not out)
(if (> retry 300) ; try for 30 seconds
(begin
(println "Could not connect to guiserver")
(exit))
(inc 'retry))
(set 'out (net-connect host portIn))
(sleep 100))
(set 'listenSock (net-listen portOut))
(set 'in (net-accept listenSock))
(net-close listenSock)
)
;; @syntax (gs:insert-list-item <sym-list-combo> <str-text> <int-index> [<str-text> <int-index>])
;; @param <sym-list-combo> The name of the combo box or list box from which entries are removed.
;; @param <str-text> The text of the list or combo box item to insert.
;; @param <int-index> The index of an entry to add to the list or combo box.
;;
;; When specifying an index of <tt>0</tt> the first item gets inserted at the beginning.
;; When specifying an index equal or greater to the number of items in the list, the item
;; is added at the end.
(define (insert-list-item comp)
(let ( s (string "insert-list-item " comp " ")
p (args))
(while p
(write-buffer s (string (base64-enc (pop p)) " " (pop p) " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:insert-tab <sym-tabbed-pane> <sym-component> [<str-text> [<int-index> [<str-icon-path>]]])
;; @param <sym-tabbed-pane> The name of the tabbed pane.
;; @param <sym-component> The name of the component to insert as a tab.
;; @param <str-text> The optional text on the tab.
;; @param <int-index> The optional index where to insert the new tab.
;; @param <str-icon-path> The file path to an optional icon.
(define (insert-tab pane comp text idx icon)
(if text
(if idx
(if icon
(net-send out (string "insert-tab " pane " " comp " " (base64-enc text) " " idx " " (base64-enc icon) "\n"))
(net-send out (string "insert-tab " pane " " comp " " (base64-enc text) " " idx "\n")))
(net-send out (string "insert-tab " pane " " comp " " (base64-enc text) "\n")))
(net-send out (string "insert-tab " pane " " comp "\n")))
)
;; @syntax (gs:insert-text <sym-id> <str-text> <int-position>)
;; @param <sym-id> The name of the text component.
;; @param <str-text> The text to insert.
;; @param <int-position> The offset position where to insert the text.
(define (insert-text id text position)
(replace "\r" text "")
(net-send out (string "insert-text " id " " (base64-enc text) " " position "\n"))
)
;; @syntax (gs:key-event <sym-id> <sym-action>)
;; @param <sym-canvas> The id of the component to register the action handler.
;; @param <sym-action> The symbol of the action handler.
;;
;; 'gs:key-event' can be used to register a general unspecific key event handler
;; for any component in the system, with exception of the text widgets, which
;; alrady handle key events using their normal ebent handler function. Components
;; respond to the following key event types:
;; '"pressed"', '"released"', '"typed"',
;;
;; @example
;;
;; (define (key-action id type code modifiers)
;; (println "id:" id " type:" type " key code:" code " modifiers:" modifiers)
;; )
;; The example shows a handler which prints all key event parameters to the terminal/shell
;; window where the applicaton was started.
;;
;; In order for key events to work, the component for which a key action handler
;; is registered must have the input focus. Use '"gs:request-focus"' to set the
;; input focus for the component.
(define (gs:key-event id action)
(net-send out (string "key-event " id " " action "\n"))
)
;; @syntax (gs:label <sym-id> <str-text> [<str-align> [<int-width> <int-height>]])
;; @param <sym-id> The name of the label.
;; @param <str-text> The text to appear on the label.
;; @param <str-align> The optional alignment of the text.
;; @param <int-width> The optional width of the label.
;; @param <int-height> The optional height of the label.
;;
;; The following alignment constants can be supplied: '"left"', '"center"', '"right"",
;; '"leading"', '"trailing"', '"bottom"' and "'top'". By default each label text is
;; '"center"' aligned.
(define (label id text align width height)
(if align
(if (and width height)
(net-send out (string "label " id " " (base64-enc text) " " align " " width " " height "\n"))
(net-send out (string "label " id " " (base64-enc text) " " align "\n")))
(net-send out (string "label " id " " (base64-enc text) "\n")))
)
;; @syntax (gs:layout <sym-container>)
;; @param <sym-container> The id of the container to lay out.
;;
;; Forces the container to lay out its components again, e.g. after a 'gs:add-to' or 'gs:remove-from'
;; when the container was already visible.
(define (layout id)
(net-send out (string "layout " id "\n"))
)
;; @syntax (gs:load-text <sym-id> <str-path>)
;; @param <sym-id> The id of the 'gs:text-pane'.
;; @param <str-path> The full path name of the file to load.
;;
;; 'gs:load-text' will load text into a 'gs:text-pane' directly by specifying
;; the path name. During loading, CR-LF line terminators are automatically
;; translated to LF-only line terminators by stripping all CRs from the file. All internal
;; operations of guiserver on text assume LF as a line terminator.
(define (load-text id path)
(net-send out (string "load-text " id " " (base64-enc path) "\n"))
)
;; @syntax (gs:listen [<boolean-flag>])
;; @param <boolean-flag> Prevent exit on loss of communication.
;; @return Never returns. Exits the application when the guiserver exits, except when <boolean-flag> is 'true'.
(define (listen flag)
(while (net-receive in 'event 1000000000 "\n")
(eval-string event))
(println "server shut down")
(if (not flag) (exit))
)
;; @syntax (gs:list-box <sym-id> <sym-action> [<str-item-1> ...])
;; @param <sym-id> The name of the list box.
;; @param <sym-action> The name of the event handler.
;; @param <str-item> Zero, one or more text entries in the list box.
;; @syntax (gs:list-box <sym-id> <sym-action> [<list-str-items>])
;; @param <sym-id> The name of the list box.
;; @param <sym-action> The name of the event handler.
;; @param <str-item> Zero, one or more text entries in the list box.
(define (list-box id action)
(let ( s (string "list-box " id " " action " ")
entries (if (list? (args 0)) (args 0) (args)) )
(dolist (item entries)
(write-buffer s (string (base64-enc item) " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:message-dialog <sym-parent-frame> <str-title> <str-message> [<str-type> [<str-icon-path>]])
;; @param <sym-parent-frame> The symbol name of the parent frame.
;; @param <str-title> The title of the message box.
;; @param <str-message> The message in the message box.
;; @param <str-type> The type of the message box.
;; @param <str-icon-path> The optional path for an icon.
;;
;; The type of the message box can be one of: '"error"', '"information"', '"warning"', '"question"', '"plain"'.
;; The function initiating the message-dialog will return when the dialog is closed.
(define (message-dialog parent title message (type "plain") icon)
(if icon
(net-send out (string "message-dialog " parent " "
(base64-enc title) " " (base64-enc message) " " type " " (base64-enc icon) "\n"))
(net-send out (string "message-dialog " parent " "
(base64-enc title) " " (base64-enc message) " " type "\n"))
)
)
;; @syntax (gs:menu <sym-id> <str-text>)
;; @param <sym-id> The name of the menu.
;; @param <str-text> The title string of the menu.
(define (menu id text)
(net-send out (string "menu " id " " (base64-enc text) "\n"))
)
;; @syntax (gs:menu-popup <sym-id> <str-text>)
;; @param <sym-id> The name of the menu.
;; @param <str-text> The title string of the menu.
(define (menu-popup id text)
(net-send out (string "menu-popup " id " " (base64-enc text) "\n"))
)
;; @syntax (gs:menu-bar <sym-frame> [<sym-menu-1> ...])
;; @param <sym-frame> The name of the frame hosting the menu bar.
;; @param <sym-menu> Zero or more symbol names of menus to be positioned on the menu bar.
(define (menu-bar aframe)
(let (s (string "menu-bar " aframe " "))
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:menu-item <sym-id> <sym-action> <str-text>)
;; @param <sym-id> The name of the menu item.
;; @param <sym-action> The name of the event handler.
;; @param <str-text> The text to appear for the menu item.
(define (menu-item id action text)
(net-send out (string "menu-item " id " " action " " (base64-enc text) "\n"))
)
;; @syntax (gs:menu-item-check <sym-id> <sym-action> <str-text> [<bool-selected>])
;; @param <sym-id> The name of the menu item.
;; @param <sym-action> The name of the event handler.
;; @param <str-text> The text to appear for the menu item.
;; @param <bool-selected> An optional flag indicating the selection state 'true' or 'nil' (default).
(define (menu-item-check id action text selected)
(net-send out (string "menu-item-check " id " " action " " (base64-enc text) " " selected "\n"))
)
;; @syntax (gs:mouse-clicked <sym-canvas> <sym-action> [<boolean-tags>])
;; @param <sym-canvas> The id of the canvas to register the action handler.
;; @param <sym-action> The symbol of the action handler.
;; @param <boolean-tags> A 'true' to indicate checking for tags.
;;
;; If <boolean-tags> is 'true', the action event will carry a list of
;; all tags which contained the X,Y coordinates of the mouse.
(define (mouse-clicked cnvs action flag)
(net-send out (string "mouse-clicked " cnvs " " action " " flag "\n"))
)
;; @syntax (gs:mouse-dragged <sym-canvas> <sym-action>)
;; @param <sym-canvas> The id of the canvas to register the action handler.
;; @param <sym-action> The symbol of the action handler.
(define (gs:mouse-dragged cnvs action)
(net-send out (string "mouse-dragged " cnvs " " action "\n"))
)
;; @syntax (gs:mouse-event <sym-id> <sym-action>)
;; @param <sym-canvas> The id of the component to register the action handler.
;; @param <sym-action> The symbol of the action handler.
;;
;; 'gs:mouse-event' can be used to register a general unspecific mouse event handler
;; for any component in the system. Components respond to the following types:
;; '"pressed"', '"released"', '"clicked"',
;;
;; @example
;;
;; (define (mouse-action id type x y button cnt mods)
;; (println "id:" id " type:" type " x:" x " y:" y " button:" button " count:" cnt " mods:" mods)
;; )
;; The example shows a handler which prints all mouse event parameters to the terminal/shell
;; window where the applicaton was started.
(define (gs:mouse-event id action)
(net-send out (string "mouse-event " id " " action "\n"))
)
;; @syntax (gs:mouse-moved <sym-canvas> <sym-action>)
;; @param <sym-canvas> The id of the canvas to register the action handler.
;; @param <sym-action> The symbol of the action handler.
(define (gs:mouse-moved cnvs action)
(net-send out (string "mouse-moved " cnvs " " action "\n"))
)
;; @syntax (gs:mouse-pressed <sym-canvas> <sym-action> [<boolean-tags>])
;; @param <sym-canvas> The id of the canvas to register the action handler.
;; @param <sym-action> The symbol of the action handler.
;; @param <boolean-tags> A 'true' to indicate checking for tags.
;;
;; If <boolean-tags> is 'true', the action event will carry a list of
;; all tags which contained the X,Y coordinates of the mouse.
(define (gs:mouse-pressed cnvs action flag)
(net-send out (string "mouse-pressed " cnvs " " action " " flag "\n"))
)
;; @syntax (gs:mouse-released <sym-canvas> <sym-action> [<boolean-tags>])
;; @param <sym-canvas> The id of the canvas to register the action handler.
;; @param <sym-action> The symbol of the action handler.
;; @param <boolean-tags> A 'true' to indicate checking for tags.
;;
;; If <boolean-tags> is 'true', the the action event will carry a list of
;; all tags which contained the X,Y coordinates of the mouse.
(define (gs:mouse-released cnvs action flag)
(net-send out (string "mouse-released " cnvs " " action " " flag "\n"))
)
;; @syntax (gs:mouse-wheel <sym-canvas> <sym-action>)
;; @param <sym-canvas> The id of the canvas to register the action handler.
;; @param <sym-action> The symbol of the action handler.
(define (gs:mouse-wheel cnvs action)
(net-send out (string "mouse-wheel " cnvs " " action "\n"))
)
;; @syntax (gs:move-tag <sym-tag> <int-dx> <int-dy> [<boolean-repaint>])
;; @param <sym-tag> The tag of the group of objects to move.
;; @param <int-dx> The distance to move on the X-axis.
;; @param <int-dy> The distance to move on the Y-axis.
;;
;; 'gs:move-tag' is the only tag operation which actually changes the
;; internal data of a drawn object. All other tag operations like
;; 'gs:translate-tag', 'gs:scale-tag', 'gs:rotate-tag' and 'gs:shear-tag'
;; will transform object coordinates only for drawing.
(define (gs:move-tag tag dx dy (repaint true))
(net-send out (string "move-tag " gs:currentCanvas " " tag " "
dx " " dy " " repaint "\n"))
)
;; @syntax (gs:no-action)
;;
;; Specify as <sym-action> for widgets where no action handler is defined.
(define (no-action))
;; @syntax (gs:open-file-dialog <sym-parent-frame> <sym-action> [<str-directory> [<str-mask> <str-description>]])
;; @param <sym-parent-frame> The parent frame of the file dialog.
;; @param <sym-action> The handler function symbol.
;; @param <str-directory> The initial directory to show.
;; @param <str-mask> An optonal string mask.
;; @param Mstr-description> An optional mask description.
(define (open-file-dialog parent action dir mask desc)
(if dir
(if (and mask desc)
(net-send out (string "open-file-dialog " parent " " action " " (base64-enc dir) " "
(base64-enc mask) " " (base64-enc desc) "\n"))
(net-send out (string "open-file-dialog " parent " " action " " (base64-enc dir) "\n")))
(net-send out (string "open-file-dialog " parent " " action "\n")))
)
;; @syntax (gs:panel <sym-id> [<int-width> <int-height>])
;; @param <sym-id> The name of the panel.
;; @param <int-width> The optional width of the panel.
;; @param <int-height> The optional height of the panel.
;;
;; Panels have a flow layout by default. In a flow layout an unsized button will
;; assume the natural size necessary to display the text on it.
;; To change the layout use the 'set-flow-layout' or 'set-grid-layout' functions.
(define (panel id width height)
(if (and width height)
(net-send out (string "panel " id " " width " " height "\n"))
(net-send out (string "panel " id "\n"))
))
;; @syntax (gs:paste-text <sym-id> [<str-text>])
;; @param <sym-id> The name of the text component in which to paste text.
;; @param <str-text> An optional text string to paste instead of the clipboard contents.
;;
;; If the <sym-id> contains selected text, this text gets replaced,
;; otherwise the text is inserted at the current caret position.
;; If no text is given in <str-text>, the text is taken from the clipboard.
(define (paste-text id text)
(if text
(net-send out (string "paste-text " id " " (base64-enc text) "\n"))
(net-send out (string "paste-text " id "\n")))
)
;; @syntax (gs:play-sound <str-file-path>)
;; @param <str-file-path> The path and file name of the sound file.
;;
;; On most OS platforms '.au' and '.wav' sound file formats are supported.
(define (play-sound file-name)
(net-send out (string "play-sound System " (base64-enc file-name) "\n"))
)
;; @syntax (gs:progress-bar <sym-id> <int-min> <in-max> <int-initial-value>)
;; @param <sym-id> The symbols of the progress bar.
;; @param <int-min> The minimum value of the slider.
;; @param <int-max> The maximum value of the slider.
;; @param <int-initial-value> The initial value of the slider.
(define (progress-bar id posmin posmax posinit)
(net-send out (string "progress-bar " id " " posmin " " posmax " " posinit "\n"))
)
;; @syntax (gs:radio-button <sym-id> <sym-action> [<str-text> [<bool-selected>]])
;; @param <sym-id> The name of the radio button.
;; @param <sym-action> The name of the event handler.
;; @param <str-text> The optional text of the radio button.
;; @param <bool-seected> An optional flag 'true' or 'nil' (default) indicating the initial state of the radio button.
(define (radio-button id action text selected)
(if text
(net-send out (string "radio-button " id " " action " " (base64-enc text) " " selected "\n"))
(net-send out (string "radio-button " id " " action "\n")))
)
;; @syntax (gs:redo-text <sym-id>)
;; @param <sym-id> The id of the 'gs:text-pane' where to perform a redo operation.
(define (redo-text id)
(net-send out (string "redo-text " id "\n"))
)
;; @syntax (gs:remove-from <sym-container> <sym-component> [<sym-component> ...])
;; @param <sym-container> The container from which to remove a component.
;; @param <sym-component> One or more optional components to remove.
;;
(define (remove-from id)
(let (s (string "remove-from " id " "))
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:remove-list-item <sym-list-combo> <int-index> [<int-index> ...])
;; @param <sym-list-combo> The name of the combo box or list box from which entries are removed.
;; @param <int-index> The index of an entry to remove from the list or combo box.
;;
;; When specifying an index of <tt>0</tt>, the first item gets removed. When specifying an
;; index equal or greater to the number of items in the list, the item is added at the end.
(define (remove-list-item comp)
(let (s (string "remove-list-item " comp " "))
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:remove-tab <sym-tabbed-pane> [<int-index>])
;; @param <sym-tabbed-pane> The name of the tabbed pane.
;; @param <int-index> The optional index of the tab to remove. The default is <tt>0</tt> for the first tab.
(define (remove-tab pane idx)
(if idx
(net-send out (string "remove-tab " pane " " idx "\n"))
(net-send out (string "remove-tab " pane "\n")))
)
;; @syntax (gs:request-focus <sym-id> [<int-tab-index>])
;; @param <sym-id> The name of the component for which to request focus.
;; @param <int-tab-index> The index of a tab for which focus is requested.
(define (request-focus id idx)
(if idx
(net-send out (string "request-focus " id " " idx "\n"))
(net-send out (string "request-focus " id "\n")))
)
;; @syntax (gs:rotate-tag <sym-tag> <float theta> <int-x> <int-y> [<boolean-repaint>])
;; @param <sym-tag> The tag group to rotate.
;; @param <float-theta> The rotation angle in degrees (0 - 360).
;; @param <int-x> The X-coordinate of the rotation center.
;; @param <int-y> The Y-coordinate of the rotation center.
;;
;; Like all tag operations, multiple 'gs:rotate-tag' operations are cumulative.
(define (rotate-tag tag angle x y (repaint true))
(net-send out (string "rotate-tag " gs:currentCanvas " " tag " " angle " "
x " " y " " repaint "\n"))
)
;; @syntax (gs:save-file-dialog <sym-parent-frame> <sym-action> [<str-directory> [<str-initial-file> [<str-mask> <str-description>]]])
;; @param <sym-parent-frame> The parent frame of the file dialog.
;; @param <sym-action> The handler function symbol.
;; @param <str-directory> The initial directory to show.
;; @param <str-file> The initial file name.
;; @param <str-mask> An optional string mask.
;; @param <str-description> An optional mask description.
(define (save-file-dialog parent action dir file mask desc)
(if dir
(if file
(if (and mask desc)
(net-send out (string "save-file-dialog " parent " " action " " (base64-enc dir) " " (base64-enc file)
" " (base64-enc mask) " " (base64-enc desc) "\n"))
(net-send out (string "save-file-dialog " parent " " action " " (base64-enc dir) " " (base64-enc file) "\n")))
(net-send out (string "save-file-dialog " parent " " action " " (base64-enc dir) "\n")))
(net-send out (string "save-file-dialog " parent " " action "\n")))
)
;; @syntax (gs:save-text <sym-id> <str-path>)
;; @param <sym-id> The id of the 'gs:text-pane'.
;; @param <str-path> The full path name of the file to save.
;;
;; This function will write text back from a 'gs:text-pane' directly
;; by specifying a path name only. Line feed characters (ASCII 10)
;; are used as line terminators. If this behavior is not desired,
;; as is the case with Windows text files, then 'gs:get-text' should
;; be used instead. A program can then add CR characters using a
;; newLISP 'replace', i.e. '(replace "\n" text "\r\n")' before
;; saving the text to a file.
(define (save-text id path)
(net-send out (string "save-text " id " " (base64-enc path) "\n"))
)
;; @syntax (gs:scale-tag <sym-tag> <float-x> <float-y> [<boolean-repaint>])
;; @param <sym-tag> The tag group to scale.
;; @param <float-x> The X scaling factor.
;; @param <float-y> The Y scaling factor.
;;
;; 'gs:scale' scales the object to draw relative to the '0,0' point of
;; the coordinate system. This means if a object is not at the center it
;; will not only change in size when scaled but also change the distance
;; to the center point of the coordinate system, moving away when scaling
;; up with scale factor bigger '1.0' and moving closer to the center
;; when scaling down using factors smaller than '1.0'.
;;
;; This means that objects which will be scaled should be defined in
;; coordinates relative to their center point. Then a 'gs:translate-tag'
;; command should be used to place the object to correct place:
;;
;; @example
;; (gs:circle 'C 0 0 50)
;; (gs:gs:translate-tag 'C 200 100)
;; ...
;; (gs:scale-tag 'C 1.1 1.1)
;; In the example the circle, although defined for '0,0', will be displayed
;; at the '200,200' position because of the 'gs:translate-tag' statement. When
;; later scaling the circle will get bigger but stay in place.
;; Like all tag operations, multiple 'gs:scale-tag' operations are cumulative.
(define (scale-tag tag sx sy (repaint true))
(net-send out (string "scale-tag " gs:currentCanvas " " tag " "
sx " " sy " " repaint "\n"))
)
;; @syntax (gs:select-list-item <sym-id> <str-item> [<boolean-flag>])
;; @param <sym-id> The name of the list or combo box.
;; @param <str-item> The item to select.
;; @param <boolean-flag> An optional flag only for list boxes to force scrolling to the selected entry.
;;
;; On combo boxes the optional <boolean-flag> has no effect. The selected entry will always
;; appear as the visible text of the combo box. The flag has either the value 'true' or 'nil'.
(define (select-list-item id item flag)
(net-send out (string "select-list-item " id " " (base64-enc item) " " flag "\n")))
;; @syntax (gs:select-text <sym-id> <int-from> [<int-to>])
;; @param <sym-id> The ame of the text component.
;; @param <int-from> Start offset of selection.
;; @param <int-to> Optional end offset of selection.
;;
;; If no <int-to> end offset is given, 'gs:select-text' will
;; select to the end of the text.
(define (select-text id from to)
(if to
(net-send out (string "select-text " id " " from " " to "\n"))
(net-send out (string "select-text " id " " from "\n")))
)
;; @syntax (gs:scroll-pane <sym-id> <sym-widget> [<int-width> <int-height>])
;; @param <sym-id> The name of the scroll pane.
;; @param <sym-widget> The component in the scroll pane to be scrolled.
;; @param <int-width> The optional width of the scroll pane.
;; @param <int-height> The optional height of the scroll pane.
(define (scroll-pane id widget width height)
(if (and width height)
(net-send out (string "scroll-pane " id " " widget " " width " " height "\n"))
(net-send out (string "scroll-pane " id " " widget "\n")))
)
;; @syntax (gs:set-accelerator <sym-menu-item> <str-keystroke>)
;; @param <sym-menu-item> The name of the menu item for which an accelerator key is set.
;; @param <str-keystroke> A text string identifying the keystroke.
;;
;; The following rules are used to create keystroke strings:
;;
;; Syntax:
;; <blockquote><pre>
;; modifiers* (typedID | pressedReleasedID)
;; modifiers := shift | control | ctrl | meta | alt | button1 | button2 | button3
;; typedID := typed typedKey
;; typedKey := string of length 1 giving Unicode character.
;; pressedReleasedID := (pressed | released) key
;; key := KeyEvent key code name, i.e. the name following "VK_".
;; </pre></blockquote>
;; Examples:
;; <blockquote><pre>
;; "INSERT"
;; "control DELETE"
;; "alt shift X"
;; "alt shift released X"
;; "typed a"
;; </pre></blockquote>
;; Note that the <i>apple</i> key on MacOS X is the 'meta' key.
;; The 'alt' on MacOS X is the <i>option</i> key.
;; For letters use uppercase.
;; Keys are added to the menu item display automatically on all platforms.
(define (set-accelerator item key)
(net-send out (string "set-accelerator " item " " (base64-enc key) "\n"))
)
;; @syntax (gs:set-anti-aliasing <boolean-flag>)
;; @param <boolean-flag> The anti aliasing setting for the current canvas 'true' or 'nil'.
;;
;; The default setting is 'true'.
(define (gs:set-anti-aliasing flag)
(net-send out (string "set-anti-aliasing " gs:currentCanvas " " flag "\n"))
)
;; @syntax (gs:set-background <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <float-red> The red color component expressed as a number between 0.0 and 1.0.
;; @param <float-green> The green color component expressed as a number between 0.0 and 1.0.
;; @param <float-blue> The blue color component expressed as a number between 0.0 and 1.0.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; @syntax (gs:set-background <sym-id> <list-rgb> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <list-rgb> The rgb color can be given as a list of three numbers.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; Note 'set-background' is the same as 'set-color'.
(define (set-background id red green blue alpha)
(if (list? red)
(begin
(set 'alpha (or green 1.0))
(map set '(red green blue) red))
(set 'alpha (or alpha 1.0)))
(net-send out (string "set-color " id " " red " " green " " blue " " alpha "\n"))
)
;; @syntax (gs:set-bevel-border <sym-id> <str-type>)
;; @param <sym-id> The name of the component.
;; @param <str-type> The type of the bevel '"raised"' or '"lowered"'.
(define (set-bevel-border id type)
(net-send out (string "set-bevel-border " id " " type "\n"))
)
;; @syntax (gs:set-border-layout <sym-container> [<int-hgap> <int-vgap>])
;; @param <sym-container> The name of the container for which border layout is set.
;; @param <int-hgap> The horizontal gap between components in the border layout.
;; @param <int-vgap> The vertical gap between components in the border layout.
;;
;; Border layout divides the layout into 5 zones labeled '"north"', '"west"',
;; '"center"', '"east"' and '"south"'. These string constants are used in
;; the 'gs:add-to' command when adding components to a border layout.
;;
;; In a border layout each component will take the maximum size if components
;; are not sized. If components are sized only some dimensions will be honored.
;; The '"north"' and '"south"' components will stretch to maximum width and
;; assume the height given in a size parameter of the component. The '"east"'
;; and '"west"' components will stretch to the maximum height available assuming
;; their width specified earlier. The '"center"' component will take the left over
;; maximum space.
(define (set-border-layout container hgap vgap)
(if (and hgap vgap)
(net-send out (string "set-border-layout " container " " hgap " " vgap "\n"))
(net-send out (string "set-border-layout " container "\n")))
)
;; @syntax (gs:set-canvas <sym-id>)
;; @param <sym-id> The id of the canvas to switch to.
;;
;; The canvas in <sym-id> must have been created earlier with a 'gs:canvas'
;; statement. All graphics operations which do not take a canvas as argument
;; will automatically refer to this current canvas. If no 'gs:set-canvas' is
;; used, the current canvas is assumed to be the last one created.
(define (gs:set-canvas id)
(net-send out (string "set-canvas " id "\n"))
)
;; @syntax (gs:set-caret-color <sym-id> <float-red> <float-green> <float-blue>)
;; @param <sym-id> The name of the component for which to set the color.
;; @param <float-red> The red color component expressed as a number between 0.0 and 1.0.
;; @param <float-green> The green color component expressed as a number between 0.0 and 1.0.
;; @param <float-blue> The blue color component expressed as a number between 0.0 and 1.0.
;; @syntax (gs:set-caret-color <sym-id> <list-rgb> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <list-rgb> The rgb color can be given as a list of three numbers.
(define (set-caret-color id red green blue)
(if (list? red)
(map set '(red green blue) red))
(net-send out (string "set-caret-color " id " " red " " green " " blue "\n"))
)
;; @syntax (gs:set-color <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <float-red> The red color component expressed as a number between 0.0 and 1.0.
;; @param <float-green> The green color component expressed as a number between 0.0 and 1.0.
;; @param <float-blue> The blue color component expressed as a number between 0.0 and 1.0.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; @syntax (gs:set-color <sym-id> <list-rgb> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <list-rgb> The rgb color can be given as a list of three numbers.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; Note that 'set-color' is the same as 'set-background'.
(define set-color set-background)
;; @syntax (gs:set-cursor <sym-id> <str-shape>)
;; @param <sym-id> The name of the frame, dialog or window.
;; @param <str-shape> The string describing the cursor shape.
;;
;; The cursor shape can be one of the following:
;; <pre>
;; "default"
;; "crosshair"
;; "text"
;; "wait"
;; "sw-resize"
;; "se-resize"
;; "nw-resize"
;; "ne-resize"
;; "n-resize"
;; "s-resize"
;; "w-resize"
;; "e-resize"
;; "hand"
;; "move"
;; </pre>
(define (set-cursor id shape)
(net-send out (string "set-cursor " id " " shape "\n"))
)
;; @syntax (gs:set-editable <sym-id> <boolean-editable>)
;; @param <sym-id> The name of the text widget.
;; @param <boolean-editable> The flag 'true' or 'nil' to indicate if this text widget can be edited.
(define (set-editable id flag)
(net-send out (string "set-editable " id " " flag "\n"))
)
;; @syntax (gs:set-flow-layout <sym-container> [<str-alignment> [<int-hgap> <int-vgap>]])
;; @param <sym-container> The name of the container for which flow layout is set.
;; @param <sym-alignment> The alignment of the flow layout '"left"', '"center"' or '"right"'.
;; @param <int-hgap> The horizontal gap between components in the flow layout.
;; @param <int-vgap> The vertical gap between components in the flow layout.
;;
;; The flow layout lets components appear in their natural or preferred size. The preferred
;; size of a component is set using the function 'gs:set-size'. Button-type widgets and
;; combo boxes will take as much space as necessary to show the included text.
(define (set-flow-layout id (direction "left") hGap vGap)
(if (and hGap vGap)
(net-send out (string "set-flow-layout " id " " direction " " hGap " " vGap "\n"))
(net-send out (string "set-flow-layout " id " " direction "\n"))
)
)
;; @syntax (gs:set-font <sym-id> <str-family> <int-size> <str-type>)
;; @param <sym-id> The name of the component for which to set the text font.
;; @param <str-familiy> The family of the font, e.g.: '"Monospaced"', '"Serif"', '"Sans Serif"'.
;; @param <int-size> The font size in points.
;; @param <str-type> The type of the font, one or more of '"plain"', '"bold"', '"italic"'.
;;
;; More than the above noted families are available depending on the platform.
(define (set-font id family size type)
(net-send out (string "set-font " id " " (base64-enc family) " " size " " type "\n"))
)
;; @syntax (gs:set-foreground <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <float-red> The red color component expressed as a number between 0.0 and 1.0.
;; @param <float-green> The green color component expressed as a number between 0.0 and 1.0.
;; @param <float-blue> The blue color component expressed as a number between 0.0 and 1.0.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; @syntax (gs:set-foreground <sym-id> <list-rgb> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the color.
;; @param <list-rgb> The rgb color can be given as a list of three numbers.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; The foreground color is the color of the text in a component.
(define (set-foreground id red green blue alpha)
(if (list? red)
(begin
(set 'alpha (or green 1.0))
(map set '(red green blue) red))
(set 'alpha (or alpha 1.0)))
(net-send out (string "set-foreground " id " " red " " green " " blue " " alpha "\n"))
)
;; @syntax (gs:set-grid-layout <sym-container> <int-rows> <int-columns> [<int-hgap> <int-vgap>])
;; @param <sym-container> The name of the container for which grid layout is set.
;; @param <int-rows> The number of rows in the layout grid.
;; @param <int-columns> The number of columns in the layout grid.
;; @param <int-hgap> The horizontal gap between components in the grid layout.
;; @param <int-vgap> The vertical gap between components in the grid layout.
;;
;; In a grid layout each component will assume the maximum size the grid cell allows
;; regardless of sizes preset using 'gs:set-size' Because of this grid layout cells are
;; frequently filled with panels using 'gs:panel' which have flow layout by default
;; and allow deliberate sizing of components using 'gs:set-size'.
(define (set-grid-layout container rows cols hgap vgap)
(if (and hgap vgap)
(net-send out (string "set-grid-layout " container " " rows " " cols " " hgap " " vgap "\n"))
(net-send out (string "set-grid-layout " container " " rows " " cols "\n")))
)
;; @syntax (gs:set-icon <sym-id> <str-icon-path> [<int-index>])
;; @param <sym-id> The name of a button or label or menu-item for which to set an icon.
;; @param <str-icon-path> The file path of the icon to be set.
;; @param <int-index> If <sym-id> is a tabbed pane <int-index> is the index of the tab.
(define (set-icon comp text idx)
(if idx
(net-send out (string "set-icon " comp " " (base64-enc text) " " idx "\n"))
(net-send out (string "set-icon " comp " " (base64-enc text) "\n"))
)
)
;; @syntax (gs:set-look-and-feel <str-look>)
;; @param <str-look> The class description string for the look and feel of the application.
;;
;; The following strings can be tried in <str-look>, but not all will work on a specific
;; platform. On the Mac the default look-and-feel is built-in to the JVM as the default
;; style. The '"MacLookAndFeel"' is not available as an explicit flavor here, but may be
;; on other platforms.
;; <pre>
;; '"com.sun.java.swing.plaf.motif.MotifLookAndFeel"'<br>
;; '"javax.swing.plaf.metal.MetalLookAndFeel"'<br>
;; '"com.sun.java.swing.plaf.windows.WindowsLookAndFeel"'<br>
;; '"javax.swing.plaf.mac.MacLookAndFeel"'<br>
;; '"com.sun.java.swing.plaf.gtk.GTKLookAndFeel"'
;; </pre>
(define (set-look-and-feel look)
(net-send out (string "set-look-and-feel System " look "\n"))
)
;; @syntax (gs:set-paint <list-rgb>)
;; @param <list-rgb> The current paint used for outlines, text and fill color.
(define (gs:set-paint color)
(net-send out (string "set-paint " gs:currentCanvas " " (color 0) " " (color 1) " " (color 2) "\n"))
)
;; @syntax (gs:set-pressed-icon <sym-id> <str-icon-path>)
;; @param <sym-id> The name of the button, image button or toggle button.
;; @param <str-icon-path> The file path of the icon or image to be set to the button in pressed state.
;;
;; By default a small grey dot is shown on image buttons when in a pressed state.
(define (set-pressed-icon comp text)
(net-send out (string "set-pressed-icon " comp " " (base64-enc text) "\n"))
)
;; @syntax (gs:set-resizable <sym-frame> <boolean-resizable>)
;; @param <sym-frame> The name of the frame window.
;; @param <bbolean-resizable> The flag 'true' or 'nil' to indicate if a frame can be resized by the user.
(define (set-resizable id flag)
(net-send out (string "set-resizable " id " " flag "\n"))
true
)
;; @syntax (gs:set-rotation <float-angle>)
;; @param <float-angle> The angle in degrees (0 - 360) of the canvas rotation.
;;
;; Unlike the 'gs:rotate-tag' operation which is cumulative, 'gs:set-rotation'
;; will set an absolute rotation value each time it is called.
(define (gs:set-rotation angle)
(net-send out (string "set-rotation " gs:currentCanvas " " angle "\n"))
)
;; @syntax (gs:set-scale <int-x> <int-y>)
;; @param <int-x> The X-scale value of the current canvas.
;; @param <int-y> The Y-scale value of the current canvas.
;;
;; Unlike the 'gs:scale-tag' operation which is cumulative, 'gs:set-scale'
;; will set an absolute scale value each time it is called.
(define (gs:set-scale x y)
(net-send out (string "set-scale " gs:currentCanvas " " x " " y "\n"))
)
;; @syntax (gs:set-selected <sym-id> <boolean-selected> [<sym-id> <boolean-selected>])
;; @param <sym-id> The name of the toggle or radio button or check box or menu item.
;; @param <boolean-selected> A flag of 'true' or 'nil' to indicated the selection state.
;;
;; More then one toggle control may be set selected or unselected.
(define (set-selected id flag)
(let (s (string "set-selected " id " " flag " "))
(doargs (item)
(write-buffer s (string item " ")))
(write-buffer s "\n")
(net-send out s)
)
)
;; @syntax (gs:set-selection-color <sym-id> <float-red> <float-green> <float-blue> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the text selection color.
;; @param <float-red> The red color component expressed as a number between 0.0 and 1.0.
;; @param <float-green> The green color component expressed as a number between 0.0 and 1.0.
;; @param <float-blue> The blue color component expressed as a number between 0.0 and 1.0.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; @syntax (gs:set-selection-color <sym-id> <list-rgb> [<float-alpha>])
;; @param <sym-id> The name of the component for which to set the text selection color.
;; @param <list-rgb> The rgb color can be given as a list of three numbers.
;; @param <float-alpha> The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque).
;;
;; Note 'set-background' is the same as 'set-color'.
(define (set-selection-color id red green blue alpha)
(if (list? red)
(begin
(set 'alpha (or green 1.0))
(map set '(red green blue) red))
(set 'alpha (or alpha 1.0)))
(net-send out (string "set-selection-color " id " " red " " green " " blue " " alpha "\n"))
)
;; @syntax (gs:set-size <sym-id> <int-width> <int-height>)
;; @param <sym-id> The name of the component of which a preferred size is set.
;; @param <int-width> The preferred width of the component.
;; @param <int-height> The preferred height of the component.
;;
;; Note that not all layouts allow setting the size of a component. The grid and
;; border layouts will size the component to its maximum possible in the layout.
(define (set-size id width height)
(net-send out (string "set-size " id " " width " " height "\n"))
)
;; @syntax (gs:set-stroke <float-width> [<str-cap> [<str-join> [<float-miterlimit>]]])
;; @param <float-width> The width for drawing lines and outlines in shapes.
;; @param <str-cap> One of optional '"butt"' (default), '"round"' or '"sqare"'.
;; @param <str-join> One of optional '"miter"' (default), '"bevel"' or '"round"'
;;
;; For a <float-width> 0f 0.0 the thinnest possible line width be be chosen.
;; Join is the decoration applied at the intersection of two path segments and at the
;; intersection of the endpoints.
;; Cap is the decoration applied to the ends of unclosed subpaths and dash segments.
;; The <float-miterlimit> should be greater or equal 1.0.
(define (gs:set-stroke width cap jn limit)
(if cap
(if join
(if limit
(net-send out (string "set-stroke " gs:currentCanvas " " width " " cap " " jn " " limit "\n"))
(net-send out (string "set-stroke " gs:currentCanvas " " width " " cap " " jn "\n"))
)
(net-send out (string "set-stroke " gs:currentCanvas " " width " " cap "\n"))
)
(net-send out (string "set-stroke " gs:currentCanvas " " width "\n"))
)
)
;; @syntax (gs:set-syntax <sym-id> <str-type>)
;; @param <sym-id> The name of the text pane for syntax coloring is enabled or disabled.
;; @param <str-type> A string '"lsp"', '"c"', '"cpp"', '"java"' or '"php"' to indicate the
;; syntax desired, or 'nil' to switch off syntax highlighting.
;;
;; Colors for syntax highlighting are preselected for a white background, but can be changed using
;; the following functions: 'gs:set-background', 'gs:set-foreground', 'gs:set-caret', 'gs:set-selection-color'
;; and 'gs:set-syntax-colors'.
(define (set-syntax id type)
(net-send out (string "set-syntax " id " " type "\n"))
)
;; @syntax (gs:set-syntax-colors <list-rgb-comment> <list-rgb-keyword> <list-rgb-string> <list-rgb-number> <list-rgb-quoted> <list-rgb-parentheses>)
;; @param <list-rgb-comment> The color for comments.
;; @param <list-rgb-keyword> The color for reserved keywords.
;; @param <list-rgb-string> The color for strings.
;; @param <list-rgb-number> The color for numbers.
;; @param <list-rgb-quoted> The color for the quote and quoted symbols.
;; @param <list-rgb-parentheses> The color for parenthesis.
;;
;; Syntax highlighting colors are given as lists of red, green and blue values between 0.0 and 1.0.
;; Depending on the syntax colors and the foreground and background colors set for the text pane,
;; the caret color and color for selected text should also be changed. Only text widgets created
;; using 'gs:text-pane' feature syntax highlighting.
(define (set-syntax-colors comment keyword text number quoted parentheses)
(let ( components (append comment keyword text number quoted parentheses)
str "set-syntax-colors System ")
(dolist (c components)
(write-buffer str (string c " ")))
(write-buffer str "\n")
(net-send out str))
)
;; @syntax (gs:set-tab-size <sym-id> <int-size>)
;; @param <sym-id> The name of the text area component.
;; @param <int-size> The tabulator size.
;;
;; Note that 'gs:set-tab-size' will only work with fixed spaced fonts.
(define (set-tab-size id size)
(net-send out (string "set-tab-size " id " " size "\n"))
)
;; @syntax (gs:set-text <sym-id> <str-text> [<int-index>])
;; @param <sym-id> The name of the component for which text is set.
;; @param <str-text> The text to be set in the component.
;; @param <int-index> The index for a tab if the <sym-id> is a tabbed pane.
(define (set-text id text idx)
(replace "\r" text "")
(if idx
(net-send out (string "set-text " id " " (base64-enc text) " " idx "\n"))
(net-send out (string "set-text " id " " (base64-enc text) "\n"))
)
)
;; @syntax (gs:set-titled-border <sym-component> <str-title>)
;; @param <sym-component> The name of the component.
;; @param <str-title> The text in the titled border around the component.
;;
;; The component is usually a 'panel'.
(define (set-titled-border id text)
(net-send out (string "set-titled-border " id " " (base64-enc text) "\n"))
)
;; @syntax (gs:set-tool-tip <sym-id> <str-text>)
;; @param <sym-id> The name of the widget for which to supply a tool tip.
;; @param <str-text> The text of the tool tip.
;;
;; The tool tip text is shown when leaving the mouse over the widget for certain
;; amount of time.
(define (set-tool-tip id text)
(net-send out (string "set-tool-tip " id " " (base64-enc text) "\n"))
)
;; @syntax (gs:set-trace <boolean-flag>)
;; @param <boolean-flag> The flag 'true' or 'nil'.
(define (set-trace flag)
(net-send out (string "set-trace System " flag "\n"))
)
;; @syntax (gs:set-translation <int-x> <int-y>)
;; @param <int-x> The X-translation value of the current canvas.
;; @param <int-y> The Y-translation value of the current canvas.
;;
;; Translates the current origin of the current canvas to the point in <int-x> <int-y>.
;; Unlike the 'gs:translate-tag' operation which is cumulative, 'gs:set-translation'
;; will set an absolute translation value each time it is called.
(define (gs:set-translation x y)
(net-send out (string "set-translation " gs:currentCanvas " " x " " y "\n"))
)
;; @syntax (gs:set-value <sym-id> <int-value>)
;; @param <sym-id> The name of a slider or progress bar for which to set the value.
;; @param <int-value> The integer value of the name to be set.
;;
;; The value should not be bigger or smaller than the minimum or maximum values set
;; when creating the slider or progress bar, otherwise the setting will default to either
;; the minimum or maximum preset value.
(define (set-value id value)
(net-send out (string "set-value " id " " value "\n"))
)
;; @syntax (gs:set-visible <sym-id> <boolean-visible>)
;; @param <sym-id> The component which is hidden or made visible.
;; @param <boolean-visible> A flag indicating if the component is visible '"true"', '"nil"'.
;;
;; Except for frames and dialog windows, components are visible by default. Normally
;; frames and dialogs are not set visible before all other components are placed inside.
(define (set-visible id flag)
(net-send out (string "set-visible " id " " flag "\n"))
)
;; @syntax (gs:shear-tag <sym-tag> <int-x> <int-y> [<boolean-repaint>])
;; @param <sym-tag> The tag group to shear.
;; @param <float-x> The X shearing factor.
;; @param <float-y> The Y shearing factor.
(define (shear-tag tag sx sy (repaint true))
(net-send out (string "shear-tag " gs:currentCanvas " " tag " "
sx " " sy " " repaint "\n"))
)
;; @syntax (gs:show-popup <sym-tag> <sym-host> <int-x> <int-y>)
;; @param <sym-tag> The id of the popup menu.
;; @param <sym-host> The host container where to pop up the menu.
;; @param <int-x> The X coordinate of the menu popup position.
;; @param <int-y> The Y coordinate of the menu popup position.
(define (gs:show-popup id host x y)
(net-send out (string "show-popup " id " " host " " x " " y "\n"))
)
;; @syntax (gs:show-tag <sym-tag> [<boolean-repaint>])
;; @param <sym-tag> The tag of the group to show.
;;
(define (show-tag tag (repaint true))
(net-send out (string "show-tag " gs:currentCanvas " " tag " " repaint "\n"))
)
;; @syntax (gs:slider <sym-id> <sym-action> <str-orientation> <int-min> <int-max> <int-initial-value>)
;; @param <sym-id> The name of the slider.
;; @param <sym-action> The name of the event handler.
;; @param <str-orientation> The orientation of the slider '"horizontal"' or '"vertical"'
;; @param <int-min> The minimum value of the slider.
;; @param <int-max> The maximum value of the slider.
;; @param <int-initial-value> The initial value of the slider.
(define (slider id action orient posmin posmax posinit)
(net-send out (string "slider " id " " action " " orient " " posmin " " posmax " " posinit "\n"))
)
;; @syntax (gs:split-pane <sym-id> <str-orientation> [<float-weight> [<float-location> [<int-divider-size>]]])
;; @param <sym-id> The name of the split-pane.
;; @param <str-orientation> The orientation '"horizontal"' or '"vertical"'.
;; @param <float-weight> The optional weight distribution between '0.0' and '1.0' when re-sizing the window. The default is '0.0'.
;; @param <float-location> The optional initial divider location between '0.0' and '1.0'.
;; @param <int-divider-size) The optional size of the draggable divider in pixels.
(define (split-pane id orient (weight 0.0) (pos 0.5) (dvdr 5))
(net-send out (string "split-pane " id " " orient " " weight " " pos " " dvdr "\n"))
)
;; @syntax (gs:tabbed-pane <sym-id> <sym-action> <str-orientation> [<sym-tab> <sym-tab-title> ...])
;; @param <sym-id> The name of the tabbed pane.
;; @param <str-orientation> The position of the tabs; either '"top"' (default), '"bottom"','"left"' or '"right"'.
;; @param <sym-tab> The id symbol name of a tab
;; @param <str-title> The title of the tab.
(define (tabbed-pane id action orient)
(let (s (string "tabbed-pane " id " " action " " orient " ")
t (args))
(while t
(write-buffer s (string (pop t) " " (base64-enc (pop t)) " "))
)
(write-buffer s "\n")
(net-send out s))
)
;; @syntax (gs:text-area <sym-id> <sym-action> <int-width> <int-height>)
;; @param <symid> The name of the text area.
;; @param <sym-action> The name of the event handler.
;; @param <int-width> The optional width of the text area..
;; @param <int-height> The optional height of the text area.
;; @example
;; (gs:text-area 'TheText 'textarea-event 10 8)
;;
;; (define (textarea-event id code dot mark) ...)
;; 'gs:text-area' transmits the following parameters in its event:
;; <pre>
;; id - name of the widget
;; code - key code equals ASCII code. Only for text keys
;; dot - position of text caret in the text
;; mark - extended (selection) position of caret
;; </pre>
(define (text-area id action width height)
(if (and width height)
(net-send out (string "text-area " id " " action " " width " " height "\n"))
(net-send out (string "text-area " id " " action "\n")))
)
;; @syntax (gs:text-field <sym-id> <sym-action> <int-columns>)
;; @param <sym-id> The name of the text field.
;; @param <sym-action> The name of the event handler.
;; @param <int-columns> The number of columns in the text field.
;; @example
;; (gs:text-field 'TheText 'textfield-event)
;; The 'textfield-event' is fired when the enter key is pressed in the
;; text field.
(define (text-field id action columns)
(net-send out (string "text-field " id " " action " " columns "\n"))
)
;; @syntax (gs:text-pane <sym-id> <sym-action> <str-style> [<int-width> <int-height>])
;; @param <sym-id> The name of the text pane.
;; @param <sym-action> The key action handler for the html pane.
;; @param <sym-style> The content type of the text pane.
;; @param <int-width> The optional width of the pane.
;; @param <int-height> The optional height of the pane.
;;
;; The 'gs:text-pane' is used similar to 'gs:text-area. The following styles
;; are supported in <sym-style>:
;; <pre>
;; "text/plain"
;; "text/html"
;; </pre>
;;
;; The 'gs:text-pane' widget will automatically display scroll bars when
;; text does not fit in the visible space of the pane. When entering parentheses
;; they are automatically matched with their opening or closing counterparts, if they exist.
;; If this is undesired behavior, the simpler 'gs:text-area' control should
;; be used instead.
;;
;; On each change of the caret or selection in the text pane
;; an event is fired containing several parameters about the caret and selection
;; positions, the last character typed, and the modifier keys used. See the
;; the file 'newlisp-edit.lsp' for a complex application using all features
;; available in this widget.
;;
;; To make hyperlinks in 'HTML' formatted text clickable, editing must
;; be disabled using the 'gs:set-editable' function. The functions 'gs:set-font'
;; and 'gs:append-text' will work only on the 'text/plain' content style.
;; @example
;; (gs:text-pane 'TheTextPane 'textpane-event "text/plain")
;;
;; (define (textpane-event id code mods dot mark len undo redo) ...)
;; 'gs:text-pane' transmits the following parameters in its event:
;; <pre>
;; id - name of the widget
;; code - key code equals ASCII code. Only for text keys
;; mods - keys pressed together with the previous, like shift, ctrl etc.
;; dot - position of the text caret in the text
;; mark - extended (selection) position of the caret
;; len - length of the text in the textarea
;; undo - undo enabled/disabled
;; redo - redo enabled/disabled
;; </pre>
(define (text-pane id action style width height)
(if (and width height)
(net-send out (string "text-pane " id " " action " " style " " width " " height "\n"))
(net-send out (string "text-pane " id " " action " " style "\n"))
)
)
;; @syntax (gs:toggle-button <sym-id> <sym-action> <str-text> [<bool-selected>])
;; @param <sym-id> The name of the toggle button.
;; @param <sym-action> The name of the event handler.
;; @param <str-text> The optional text of the toggle button.
;; @param <bool-selected> An optional flag 'true' or 'nil' (default) indicating the initial state of the toggle button.
(define (toggle-button id action text selected)
(if text
(net-send out (string "toggle-button " id " " action " " (base64-enc text) " " selected "\n"))
(net-send out (string "toggle-button " id " " action "\n")))
)
;; @syntax (gs:tool-bar <sym-frame> [<bool-floatable> <int-hgap> <int-vgap>])
;; @param <sym-frame> The name of the frame hosting the toolbar.
;; @param <bool-floatable> The optional flag 'true' or 'nil' to indicate if the toolbar can be detached.
;; @param <int-hgap> The horizontal gap between components on the toolbar.
;; @param <int-vgap> The vertical gap between the components on the toolbar.
(define (tool-bar aframe floatable width height)
(if (and width height)
(net-send out (string "tool-bar " aframe " " floatable " " width " " height "\n"))
(net-send out (string "tool-bar " aframe " " floatable "\n")))
)
;; @syntax (gs:translate-tag <sym-tag> <int-x> <int-y> [<boolean-repaint>])
;; @param <sym-tag> The name tag of the group to translate.
;; @param <int-x> The X-coordinate translation value.
;; @param <int-y> The Y-coordinate translation value.
;;
;; Moves the origin of the coordinate system of all objects tagged with <sym-tag>.
;; Like all tag operations multiple 'gs:translate-tag' operations are cumulative.
(define (translate-tag tag x y (repaint true))
(net-send out (string "translate-tag " gs:currentCanvas " " tag " " x " " y " " repaint "\n"))
)
;; @syntax (gs:undo-text <sym-id>)
;; @param <sym-id> The id of the 'gs:text-pane' where to perform an undo operation.
(define (undo-text id)
(net-send out (string "undo-text " id "\n"))
)
;; @syntax (gs:update)
;;
;; Forces a repaint of the current canvas, e.g. after changing the scale or translation of a visible
;; canvas. This function is rarely used, as most screen updates are performed automatically.
;; All tag operations can carry an additional parameter to force update after they have been
;; draw.
(define (update)
(net-send out (string "update " gs:currentCanvas "\n"))
)
;; @syntax (gs:window <sym-id> <int-x> <int-y> <int-width> <int-height>)
;; @param <sym-id> The name of the invisible window.
;; @param <int-x> The x-coordinate of the screen position.
;; @param <int-y> The y-coordinate of the screen position.
;; @param <int-width> The width of the window.
;; @param <int-height> The height of the window.
;;
;; Creates a borderless window. Note that a borderless window may treat
;; some hosted components differently from normal frames and dialogs.
(define (window id x y width height)
(net-send out (string "window " id " " x " " y " " width " " height "\n"))
)
;; @syntax (gs:window-closed <sym-id> <sym-action>)
;; @param <sym-id> The name of the frame or dialog.
;; @param <sym-action> The action to perform when the frame or dialog closes.
;;
;; A window or dialog window can be closed using the system close button in
;; one of the corners of the window. In this case it is useful to specify
;; a handler function which is called upon closing.
(define (frame-closed id action)
(net-send out (string "frame-closed " id " " action "\n"))
)
; eof
syntax highlighted by Code2HTML, v. 0.9.1