;; @module guiserver.lsp
;; @description Functions for programming GUIs and 2D graphics.
;; @version 1.40 use text-field as a password field with additional parameter
;; @version 1.41 bug fixes for gs:listen and gs:check-event
;; @version 1.42 new table UI
;; @version 1.43 bug fix in new table UI action parameters
;; @version 1.44 fixes in newlisp-edit.lsp
;; @version 1.50 doc fixes
;; @version 1.51 return value for gs:export
;; @version 1.52 fix in run-shell for Java 7 update 21
;; @version 1.53 doc fixes
;; @version 1.60 new table functions, new naming gs:table-show-row-number
;; @version 1.61 more options for gs:scroll-pane added by FdB
;; @version 1.62 doc corrections
;; @version 1.63 make deprecated gs:table-set-row-number work
;; @version 1.70 default comm port with Guiserver are now 64001 and 64002
;; @version 1.71 references to /usr/ changed to /usr/local/
;; @version 1.72 doc corrections
;; @author LM, 2008, 2009, 2010, 2015, Unya 2012, FdB 2013, LM 2015
;;
;; This module has been tested on MacOS X 10.5 (Leopard) and Windows XP, both with the
;; Standard SUN Java RE v.1.5 (runtime environment) which came pre-installed on
;; those platforms. On Linux the installation of the original Sun Java Runtime
;; Environment is required the preinstalled GNU Java is not compatible. After
;; installation a soft-link has to be made from the original java executable to
;; '/usr/bin/java'.
;;
;;
;; On Windows the MIDI sound features require a soundbank file to
;; be installed. See the description for 'gs:play-note' for details.
;;
;;
What is newLISP-GS
;; 'guiserver.lsp' is a module for interfacing to 'guiserver.jar'
;; a Java server application for generating GUIs (graphical user interfaces)
;; and 2D graphics for newLISP applications. The 'guiserver.lsp', 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.
;;
;; Usage
;; At the beginning of the program file, include a 'load' statement for the module:
;;
;; (load "/usr/local/share/newlisp/guiserver.lsp")
;;
;; or on MS Windows:
;;
;; (load "c:/Program Files/newlisp/guiserver.lsp")
;;
;; 'guiserver.lsp' expects the server 'guiserver.jar' to be
;; in the directoey specified in the environment variable NEWLISPDIR.
;; When newLISP starts up and this variable is not set yet, it sets it
;; to a default value of '/usr/local/share/newlisp' on MacOS X and Unix OSs, and
;; to 'C:\Program Files\newlisp' or whatever it finds in the 'PROGRAMFILES'
;; environment variable on MS Windows systems and adding '/newlisp' to it.
;; This can be overwritten by specifying system wide setting for the environment
;; variable NEWLISPDIR, which normally is set to '%PROGRAMFILES%/newlisp'
;; on MS Windows. When using the MS Windows binary installer 'NEWLISPDIR' is written
;; to the registry automatically and gets into effect after rebooting.
;;
;; Architecture of a newLISP GUI application
;; A GUI application in newLISP is composed of four parts:
;;
;;
;; initialization - this means starting the newLISP-GS 'guiserver.jar' and initializing
;; communications with it. Only one function call is required to do this.
;;
;; building widgets - 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.
;;
;; defining event actions - 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..
;;
;; listening for events - 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.
;;
;;
;; Example
;; The following example application shows all the essential elements of a newLISP GUI
;; application:
;;
;; @example
;; #!/usr/bin/newlisp
;; ; button-demo.lsp - demonstrate the button control
;;
;; ; initialization
;; (load (append (env "NEWLISPDIR") "/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
;;
;; Application start
;;
;; ./button-demo ; on MacOS X and Unix
;; newlisp button-demo ; on MS Windows
;;
;; By default guiserver.jar uses the ports 64001 and 64002, 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:
;;
;; ./button-demo 10001 ; on MacOS X and Unix
;; newlisp button-demo 10001 ; on MS Windows
;;
;; newLISP-GS 'guiserver.jar' will now use the ports '64001' and '60002'.
;; Ports under 1024 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:
;;
;; java -jar /usr/local/share/newlisp/guiserver.jar 64001 /usr/home/aUser/MyApplication.lsp
;;
;; 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:
;;
;; java -jar /usr/local/share/newlisp/guiserver.jar 64001 /home/apps/myapp.lsp /local/newLISP128.png
;;
;; The example specifies an image inside 'guiserver.jar'. Any other image path on the local file system
;; can be used.
;;
;; On MS Windows similar methods can be used replacing the appropriate file paths, but on MS Windows 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 MS Windows platform using the 'PROGRAMFILES' environment variable:
;;
;; "c:\Program Files\newlisp\guiserver.jar" 64001 c:\myprogs\MyApplication.lsp
;;
;; Quotes are necessary when spaces are present in the argument string. The example assumes that
;; 'newlisp.exe' is in the path for executables, and it also assumes that the Windows registry has
;; an association of the .jar file extension with the javaw.exe executable. This
;; association is normally present when a java run-time environment (JRE) is installed in Windows.
;; If this association is not registered, the following method can be used:
;;
;; javaw -jar "c:\Program Files\newlisp\guiserver.jar" 64001 c:\myprogs\MyApplication.lsp
;;
;; The quotes are necessary for path-names containing spaces.
;;
;; Debugging
;; Tracing commands to newLISP-GS
;; For debugging purpose put the following directive at the beginning of your application
;; or at the place from where to start tracing.
;;
;; (gs:set-trace true)
;;
;; 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:
;;
;;
;; newLISP-GS v.0.94
;; listening on 64001
;; accepted from 0.0.0.0
;; connecting to 0.0.0.0 64002
;; 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
;;
;;
;; 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:
;;
;; (gs:set-trace nil)
;;
;; 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.
;;
;; Event handlers
;; For most widgets, event handlers must be defined. Sometimes an event handler is
;; not required. In this case specify 'gs:no-action 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:
;;
;; (gs:button 'aButton 'abutton-handler "press")
;; (define (abutton-handler id)
;; (println id))
;;
;; 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:
;;
;; (define (the-handler)
;; (doargs (p)
;; (println "->" p)))
;;
;; 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:
;;
;; (define (the-handler)
;; (println gs:event))
;;
;; All text from text fields are received as base64-encoded strings. E.g. the text:
;; '"Hello World"' would be received as: '"SGVsbG8gV29ybGQ="':
;;
;; (gs:text-field 'TextField 'textfield-handler)
;;
;; (define (textfield-handler id text)
;; (printnl id ": " (base64-dec text)))
;;
;; When the text "Hello World" is entered in the text field, the following output
;; would be generated:
;;
;; TextField: "Hello World"
;;
;; 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.
;;
;; Mapping or applying 'gs:xxx' functions
;; 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 'gs:xxx symbol, so the gs:xx functions
;; get executed under the gs context, prefixing symbols in parameter lists
;; correctly with the context prefix of their origin.
;;
;; (map 'gs:panel '(first second third fourth)) ; note quoted gs: function
;;
;; Some shortcuts when writing 'gs:xxx' functions
;; Due to the nature of transfer between newLISP and the guiserver as text, the following
;; convenient shortcuts can be taken when writing functions:
;;
;;
;; - Symbol ids of components can be expressed as strings.
;; - Number values can be expressed as strings.
;; - Numbers can be expressed as floats or integers.
;;
;;
;; Here are some examples:
;;
;; (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")
;;
;; 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 (term) value. This means that reserved symbols of the newLISP programming
;; language can be used freely in symbol ids for all components, e.g:
;;
;; (gs:label 'term "Input here") ; term is a reserved name since v10.2.0
;;
;; The usage of the reserved symbol 'term' will not pose a problem.
;;
;; Return values
;; newLISP-GS is an event driven asynchronous system. Most functions return
;; right away the number of characters sent out to the server.
;; In general, return values of 'gs:xxx' functions do not have
;; any specific meaning and can be discarded. Only the functions 'gs:get-bounds',
;; 'gs:get-fonts', 'gs:get-font-metrics', 'gs:get-instruments'
;; 'gs:get-screen', 'gs:get-text' and 'gs:get-version' return meaningful values or
;; lists of values, which are stored in similar named variables: 'gs:bounds',
;; 'gs:fonts', 'gs:font-metrics', 'gs:instruments', 'gs:screen', 'gs:text' and
;; 'gs:version'. These functions will not return right away but block until
;; the return valuse is sent back from newLISP-GS.
;;
;; The function 'gs:get-text' can work both ways: event driven or with a return
;; value depending on the call pattern used.
;;
;; Function overview
;;
;; - Initialization and application setup
;;
;; (gs:init [])
;;
;; The initialization function starts guiserver.jar which will listen to the server-port
;; and initiate another connection on server-port + 1 back to newLISP. If a
;; is not supplied guiserver will assume 64001 and 64002.
;;
;; As the last statement in the application put:
;;
;; (gs:listen)
;;
;; This function listens on 64002 (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:
;;
;; (gs:listen true)
;;
;;
;; 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:
;;
;; (while (gs:check-event 10000) ; check for 10 milli seconds
;; (do-myprocess))
;; (exit)
;;
;; The loop will exit when 'gs:check-event' returns 'nil' on communications errors, e.g.
;; when the window's close button was clicked.
;;
;; Containers
;; A container can contain any other container or control widget. Except for the
;; menu-bar and the split-pane, 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 add-to is used to add components to containers.
;;
;; (gs:dialog [ []])
;; (gs:frame [ ])
;; (gs:menu-bar [ ...])
;; (gs:panel [ ])
;; (gs:scroll-pane [ ])
;; (gs:split-pane [ [ [int-divider-size>]]])
;; (gs:tabbed-pane [ ...])
;; (gs:tool-bar [ ])
;; (gs:canvas )
;; (gs:window )
;;
;;
;; Labels
;; Labels can have text or an image or both. A normal text label can have an icon
;; added to it and a image-label 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 guiserver.jar,
;; but user-supplied images and icons in .jpg, .png and .gif formats
;; can be used.
;;
;; (gs:label [ [ ]])
;; (gs:image-label [])
;;
;;
;; Control widgets
;; 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:
;;
;; ; 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"))
;;
;; All action events calls carry information about the widget, that initiated that the event,
;; and event parameters like keystrokes, slider positions etc..
;;
;; (gs:button [ [ ]])
;; (gs:check-box [ []])
;; (gs:combo-box [ ...])
;; (gs:combo-box [])
;; (gs:image-button [ [ ]])
;; (gs:list-box [ ...])
;; (gs:list-box [])
;; (gs:menu )
;; (gs:menu-popup )
;; (gs:menu-item )
;; (gs:menu-item-check [])
;; (gs:progress-bar )
;; (gs:radio-button [ []])
;; (gs:slider )
;; (gs:text-area [ ])
;; (gs:text-field [])
;; (gs:text-pane [ ])
;; (gs:toggle-button [ ])
;;
;; 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.
;;
;; Placing components in containers
;; 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.
;;
;; (gs:add-to [
;; For the border layout an orientation parameter is specified as either "north",
;; "west", "center", "east" or "south".
;;
;; (gs:add-to [ ...])
;;
;;
;; Summary of commands
;; Most of the commands set special attributes of containers or control widgets.
;; 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
;; set-size 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.
;;
;; (gs:add-list-item [ ...])
;; (gs:add-separator )
;; (gs:add-to [ [ ...])
;; (gs:append-text )
;; (gs:check-event )
;; (gs:clear-list )
;; (gs:clear-text )
;; (gs:copy-text )
;; (gs:cut-text )
;; (gs:destroy-shell )
;; (gs:disable [ ...])
;; (gs:dispose )
;; (gs:dispose-splash)
;; (gs:enable [ ...])
;; (gs:eval-shell )
;; (gs:find-text []])
;; (gs:frame-closed )
;; (gs:get-fonts)
;; (gs:get-bounds )
;; (gs:get-font-metrics )
;; (gs:get-screen)
;; (gs:get-selected-text )
;; (gs:get-text [])
;; (gs:get-text-position )
;; (gs:get-version);
;; (gs:goto-text )
;; (gs:insert-list-item [ ])
;; (gs:insert-tab [ [ []])
;; (gs:insert-text )
;; (gs:layout )
;; (gs:load-text )
;; (gs:no-action)
;; (gs:paste-text [])
;; (gs:redo-text )
;; (gs:remove-from [ ...])
;; (gs:remove-list-item [ ...])
;; (gs:remove-tab )
;; (gs:request-focus )
;; (gs:run-shell )
;; (gs:select-list-item [])
;; (gs:select-text [])
;; (gs:set-accelerator )
;; (gs:set-background [])
;; (gs:set-background [])
;; (gs:set-bevel-border )
;; (gs:set-border-layout [ ])
;; (gs:set-caret )
;; (gs:set-caret-color )
;; (gs:set-caret-color )
;; (gs:set-color [])
;; (gs:set-color [])
;; (gs:set-cursor )
;; (gs:set-echo-char )
;; (gs:set-editable )
;; (gs:set-flow-layout [ [ ]])
;; (gs:set-font )
;; (gs:set-foreground [])
;; (gs:set-foreground [])
;; (gs:set-grid-layout [ ])
;; (gs:set-icon [])
;; (gs:set-look-and-feel )
;; (gs:set-resizable )
;; (gs:set-pressed-icon )
;; (gs:set-selected )
;; (gs:set-size )
;; (gs:set-selection-color [])
;; (gs:set-syntax )
;; (gs:set-syntax-colors )
;; (gs:set-tab-size )
;; (gs:set-text [])
;; (gs:set-titled-border )
;; (gs:set-tool-tip )
;; (gs:set-trace )
;; (gs:set-utf8 )
;; (gs:set-value )
;; (gs:set-visible )
;; (gs:undo-text )
;; (gs:undo-enable )
;;
;;
;; The Table UI
;; Since version 1.42 Guiserver has a table widget and supporting functions.
;;
;; (gs:table [ ...])
;; (gs:table-add-column ...)
;; (gs:table-add-row [ ... ])
;; (gs:table-get )
;; (gs:table-get-cell )
;; (gs:table-get-size )
;; (gs:table-remove-row
;; (gs:table-set-cell )
;; (gs:table-set-column [])
;; (gs:table-set-column-name [ [ ...])
;; (gs:table-set-row-count
;; (gs:table-set-row-number ) DEPRECATED use gs:table-show-row-number
;; (gs:table-show-row-number )
;;
;;
;; Special dialogs
;; 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.
;;
;; (gs:color-dialog )
;; (gs:message-dialog [ []])
;; (gs:confirm-dialog [])
;; (gs:open-file-dialog [ [ ]])
;; (gs:save-file-dialog [ [ [ ]]])
;;
;;
;; 2D Graphics functions
;; 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 specifying
;; '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.
;;
;; All positions given in int x and int y must be given as integers. Values
;; will not be converted automatically as is the case with newLISP's built-in functions. To
;; guarantee integer type, values can be casted e.g.:
;; (gs:draw-circle 'MyCircle (int x) (int y) (int r))
;;
;; (gs:color-tag [])
;; (gs:delete-tag [])
;; (gs:draw-arc [])
;; (gs:draw-circle [])
;; (gs:draw-ellipse [])
;; (gs:draw-image [ ])
;; (gs:draw-line [])
;; (gs:draw-path [])
;; (gs:draw-polygon [])
;; (gs:draw-rect [])
;; (gs:draw-round-rect [])
;; (gs:draw-text [ []])
;; (gs:export [ ])
;; (gs:fill-arc [])
;; (gs:fill-circle [])
;; (gs:fill-ellipse [])
;; (gs:fill-polygon [])
;; (gs:fill-rect [])
;; (gs:fill-round-rect [])
;; (gs:hide-tag [])
;; (gs:move-tag [])
;; (gs:reorder-tags )
;; (gs:rotate-tag [])
;; (gs:save-text )
;; (gs:scale-tag [])
;; (gs:shear-tag [])
;; (gs:show-popup )
;; (gs:show-tag [])
;; (gs:set-canvas )
;; (gs:set-paint )
;; (gs:set-rotation )
;; (gs:set-scale )
;; (gs:set-stroke [ [ []]])
;; (gs:set-translation )
;; (gs:set-anti-aliasing )
;; (gs:translate-tag [])
;; (gs:update)
;;
;;
;; Events
;; Additionally to the event actions registered when creating a widget,
;; the canvas, windows and dialogs can fire events as a result of key or mouse
;; actions or when the position or size of a windows or dialog has changed.
;;
;; (gs:key-event )
;; (gs:mouse-clicked [])
;; (gs:mouse-dragged )
;; (gs:mouse-event )
;; (gs:mouse-moved [])
;; (gs:mouse-pressed [])
;; (gs:mouse-released [])
;; (gs:mouse-wheel )
;; (gs:window-closed )
;; (gs:window-moved )
;; (gs:window-resized )
;;
;;
;; Built-in icons and images
;; 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 MS Windows
;; use forward slashes instead of backslashes.
;;
;; 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
;;
;; Predefined colors
;; The following colors are predefined:
;;
;; 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)
;;
;; 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.
;;
;; (gs:set-background 'aPanel gs:magenta
;; (gs:set-background 'aPanel 1.0 0 1
;; (gs:set-background 'aPanel '(1 0 1)
;;
;; All of the above statements will produce the same background color on the aPanel.
;;
;; Sound and MIDI API
;; The newLISP-GS sound API uses the default saundbank and sound hardware installed
;; on the platform newLISP-GS is running on. On Mac OS X nothing additional needs to be
;; installed. On MS Windows and some Unix platforms a soundbank file needs to be installed.
;; Soundbanks for the Java JRE can be obtained at:
;; @link http://java.sun.com/products/java-media/sound/soundbanks.html http://java.sun.com/products/java-media/sound/soundbanks.html
;; The demo files shipped with the newLISP-GS installation use the midsize soundbank. Other soundbanks
;; may require different naming of instruments in the 'gs:midi-patch' statement.
;;
;; The sound API is capable of playing of mutliple tracks at the same time
;; depending on the sound hardware installed on a specific platform. Mac OS X platforms
;; and most MS Windows platforms should be capable of playing 16 instruments (channels) at the
;; the same time 32 on parallel sounding tracks. newLISP GS supports 128 instruments of the
;; default soundbank installed.
;;
;; On Mac OS X and MS Windows channel 9 is a special channel sounding a different rythm
;; instrument for all 128 different keys/notes.
;;
;; Basic capabilities of the sound API are shown in the demo files midi-demo.lsp
;; and midi2-demo.lsp in the /usr/local/share/newlisp/guiserver/ or
;; c:\Program files\newlisp\guiserver\ directory.
;;
;; (gs:add-track )
;; (gs:channel-bend )
;; (gs:get-instruments)
;; (gs:instruments)
;; (gs:midi-bpm [])
;; (gs:midi-close)
;; (gs:midi-init [])
;; (gs:midi-patch [])
;; (gs:mute-track )
;; (gs:play-note [ [ [ [int-bend]]]])
;; (gs:play-sequence [ [ [ []]]])
;; (gs:save-sequence )
;; (gs:stop-sequence)
;; (gs:play-sound )
;;
;;
(context 'gs)
; ======================= preset colors
(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))
; ====================== utility routines
; set server path
(if (= ostype "Windows")
; on some MS Windows systems the jar -> javaw.exe association my be missing, the use the following:
;(set 'server-path (string "javaw.exe -jar " "'\"" (env "NEWLISPDIR") "/guiserver.jar\"'"))
(set 'server-path (string "'\"" (env "NEWLISPDIR") "/guiserver.jar\"'"))
(set 'server-path (string (env "NEWLISPDIR") "/guiserver.jar"))
)
; Not documented gs:begin-cmd and gs:end-cmd
; sends graphics ommands in transactions, to be used in:
;
; draw-arc, draw-circle, draw-ellipse, draw-image, draw-line,
; draw-path, draw-polyon, draw-rect, draw-round-rect, draw-text,
;
; fill-arc, fill-circle, fill-ellipse, fill-polygon, fill-rect,
; fill-round-rect,
;
; color-tag, delete-tag, hide-tag, move-tag, rotate-tag, scale-tag,
; shear-tag, translate-tag
;
; example:
; (gs:begin-cmd)
; ; andy code containing
; ; gs:draw-xxx, gs:fill-xx, gs:xxx-tag
; ; comands
; (gs:end-cmd)
;
; The whole command sequence between gs:begin-cmd and gs:end-cmd
; will be sent at once to the Java guiserver. This way minimizing
; network overhead.
; Turns out, the speedup is too small in most of the demos.
(define (gs:begin-cmd)
(set 'transaction-active true)
(set 'transaction-buffer "")
)
(define (gs:end-cmd)
(net-send out transaction-buffer)
(set 'transaction-buffer "")
(set 'transaction-active nil)
)
(define (gs:send-out str)
(if transaction-active
(write-buffer transaction-buffer str)
(net-send out str);
)
)
;;
;; @syntax (gs:add-list-item [ ...])
;; @param The name of the combo box or list box to which text entries are added.
;; @param The text of the entry to be added.
;;
;; Items are added in the same sequence as they appear in the 'gs:add-list-item' 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 )
;; @param 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-track )
;; @param The channel belonging to this track.
;; @param A list of notes. Each note is a list of key duration velocity and bend.
;;
;; In case of 'gs:add-track' the duration of a note is given in ticks.
;; 16 ticks are in a quarter note or beat.
;;
;; A note is a list of 4 elements: '( [])'.
;; , and can be given as variables, which will be evaluated by
;; 'gs:add-track'. The parameter is optional and assumed as 0 if not
;; present. See the command 'gs:play-note' for more information on the note bend parameter.
;; The following code is a complete example:
;;
;; @example
;; (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
;; (gs:init)
;; (gs:midi-init)
;;
;; (map set '(C C# D D# E F F# G G# A A# B c c# d e f f# g g# a a# b) (sequence 60 82))
;; (set 'pp 30 'p 40 'm 64 'f 127) ; set velocity/volume
;;
;; (gs:midi-patch "Piano" 0)
;; (gs:midi-patch "Pizzicato Strings" 1)
;; (gs:midi-patch "Woodblock" 2)
;;
;; (gs:add-track 0 '( (C 12 m) (C# 4 m) (D 16 m) (c 16 f) (D 16 m)) )
;; (gs:add-track 1 (dup '(d 4 pp) 16))
;; (gs:add-track 2 '( (c 4 p) (c 12 p) (c 4 p) (c 12 p) (c 4 p) (c 12 p) (c 4 p) (c 12 p)) )
;;
;; (gs:play-sequence)
;;
;; (sleep 5000)
;; (gs:midi-close)
;; (exit)
;; The second example shows the usage of pitch-bend in notes:
;;
;; @example
;; (load (append (env "NEWLISPDIR") "/guiserver.lsp"))
;; (gs:init)
;; (gs:midi-init)
;;
;; (gs:midi-patch "Piano" 0)
;; (gs:midi-patch "Gunshot" 1)
;; (gs:midi-patch "Telephone" 2)
;;
;; (for (n -8192 8191 128) (push (list 64 1 95 n) track0 -1))
;; (for (n 64 96 2) (push (list n 8 76) track1 -1))
;;
;; (gs:add-track 0 track0)
;; (gs:add-track 1 track1)
;; (gs:add-track 2 '((44 128 127)))
;;
;; (gs:play-sequence)
;; ;(gs:save-sequence "extremeAlarm.mid")
;;
;; (sleep 8000)
;; (gs:midi-close)
;; (exit)
(define (add-track channel notes)
(net-send out (string "add-track System " channel " "))
(local (bend)
(dolist (n notes)
(set 'bend (if (= 4 (length n)) (eval (n 3)) 0))
(net-send out (string (eval (n 0)) " " (eval (n 1)) " " (eval (n 2)) " " bend " ")))
)
(net-send out "\n")
)
;; @syntax (gs:add-to [ ...])
;; @param The name of the container to which components are added.
;; @param One or more symbols of the components to add.
;; @syntax (gs:add-to [ ...])
;; @param The name of the container to which components are added.
;; @param The name of a component to add.
;; @param 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 )
;; @param The name of the text field or text area to which text is appended.
;; @param The text to be appended.
(define (append-text id text)
(net-send out (string "append-text " id " " (base64-enc text) "\n"))
)
;; @syntax (gs:button [ [ ]])
;; @param The name of the button.
;; @param The name of the event handler.
;; @param An optional text for the button.
;; @param The optional width of the button.
;; @param 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 )
;; @param The name of the canvas.
;;
;; A canvas is a panel 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:panel', with a flow layout by default.
;; Similar to a panel created with 'gs:panel' 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:channel-bend )
;; @param The channel where the pitch bend is set.
;; @param The channel bend between 0 and 16383.
;;
;; Numbers upwards of 8192 bend the tone upwards, numbers smaller
;; than 8192 bend the tone downwards. To switch off channel bend set
;; the number to the middle posiotion of 8192. 'gs:channel-bend' can
;; be used to bring a channel in tune with an external sound source.
(define (channel-bend channel bend)
(net-send out (string "channel-bend System " channel " " bend "\n"))
)
; @syntax (gs:channel-reverb )
; @param The channel where the reverb is set.
; @param The channel reverb between 0 and 127.
;
; Sets the reverberation of the channel for all notes.
(define (channel-reverb channel reverb)
(net-send out (string "channel-reverb System " channel " " reverb "\n"))
)
;; @syntax (gs:check-box [ []])
;; @param The name of the check box.
;; @param The name of the event handler.
;; @param The text of the check box.
;; @param 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 )
;; @param Wait for an event a maximum of 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 , event)
(when (net-select in "read" us)
(if (net-receive in event 1000000000 "\n")
(begin
; (println "check-event: " event)
(eval-string event))
(exit)))
true
)
;; @syntax (gs:clear-list )
;; @param 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 )
;; @param 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 )
;; @param 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 )
;; @param 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 )
;; @param The name symbol of the parent frame.
;; @param The symbol of the handler to call when leaving the dialog
;; @param The title of the color dialog.
;; @param The initial red color component.
;; @param The initial green color component.
;; @param 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:color-tag [])
;; @param The name tag of the shape(s) to set a new color.
;; @param The new color as a list of 3 numbers for the rgb components.
;; @param An optional flag to indicate if repainting is required (default is 'true').
(define (color-tag tag color (update true))
(send-out (string "color-tag " gs:currentCanvas " " tag " "
(color 0) " " (color 1) " " (color 2) " " update "\n"))
)
;; @syntax (gs:combo-box [ ...])
;; @param The name of the combo box.
;; @param The name of the event handler.
;; @param Zero, one or more text entries in the combo box.
;; @syntax (gs:combo-box [])
;; @param The name of the combo box.
;; @param The name of the event handler.
;; @param 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 [])
;; @param The symbol name of the parent frame.
;; @param The action to perform when the diaog is closed.
;; @param The title of the message box.
;; @param The message in the message box.
;; @param 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 carries one of the responses 0 for the yes-,
;; 1 for the no- or 2 for the cancel-button.
(define (confirm-dialog parent action title msg (type "plain"))
(net-send out (string "confirm-dialog " parent " " action " "
(base64-enc title) " " (base64-enc msg) " " type "\n"))
)
;; @syntax (gs:delete-tag [])
;; @param The tag group to be deleted.
;; @param An optional flag to indicate if repainting is required (default is 'true').
;;
;; Deletes all 2D objects (lines, shapes, text, images) tagged with .
;;
;; 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))
(send-out (string "delete-tag " gs:currentCanvas " " tag " " repaint "\n"))
)
;; @syntax (gs:destroy-shell )
;; @param The name of the text component for which the shell process is destroyed.
(define (destroy-shell id)
(net-send out (string "destroy-shell " id "\n"))
)
;; @syntax (gs:dialog [ []])
;; @param The name of the dialog
;; @param The name of the parent frame.
;; @param The title string of the dialog frame.
;; @param The width of the dialog frame.
;; @param The height of the dialog frame.
;; @param The optional flag with a value of 'true' or 'nil' for visibility of the dialog.
;; @param 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-2 ...])
;; @param 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 )
;; @param The name of the component to dispose of.
;;
;; Only objects created with 'gs:dialog', 'gs:frame' or 'gs:window' can be
;; deleted with 'gs:dispose'.
(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/share/newlisp/guiserver.jar 64001 program.lsp /local/newLISP128.png
;; ; or on MS Windows
;; java -jar "c:\Program Files\newlisp\guiserver.jar" 64001 "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 64001/2. 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 MS Windows 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 [])
;; @param The tag group of the arc.
;; @param The X position of the arc.
;; @param The Y position of the arc.
;; @param The width of the arc.
;; @param The height of the arc.
;; @param The start angle of the arc in 0 to 360 degrees.
;; @param The opening angle of the arc in 0 to 360 degrees.
;; @param The outline color as a list of 3 numbers for the rgb components
;;
;; The resulting arc begins at and extends for ,
;; 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 pixels wide by pixels tall.
(define (draw-arc id x y width height start angle color)
(if color
(send-out (string "draw-arc " gs:currentCanvas " " id " " x " " y " "
width " " height " " start " " angle " "
(color 0) " " (color 1) " " (color 2) "\n"))
(send-out (string "draw-arc " gs:currentCanvas " " id " " x " " y " "
width " " height " " start " " angle "\n"))
)
)
;; @syntax (gs:draw-circle [])
;; @param The tag group of the circle.
;; @param The X position of the circle center.
;; @param The Y position of the circle center.
;; @param The radius of the circle.
;; @param 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 is used the current paint specified with 'gs:set-paint' is used.
(define (draw-circle tag x y radius color)
(if color
(send-out (string "draw-circle " gs:currentCanvas " "
tag " " x " " y " " radius " " (color 0) " " (color 1) " " (color 2) "\n"))
(send-out (string "draw-circle " gs:currentCanvas " "
tag " " x " " y " " radius "\n"))
)
)
;; @syntax (gs:draw-ellipse [])
;; @param The tag group of the ellipse.
;; @param The X position of the ellipse center.
;; @param The Y position of the ellipse center.
;; @param The radius of the ellipse.
;; @param The radius of the ellipse.
;; @param 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 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
(send-out (string "draw-ellipse " gs:currentCanvas " "
tag " " x " " y " " radius-x " " radius-y " " (color 0) " " (color 1) " " (color 2) "\n"))
(send-out (string "draw-ellipse " gs:currentCanvas " "
tag " " x " " y " " radius-x " " radius-y "\n"))
)
)
;; @syntax (gs:draw-image [ ])
;; @param The tag group of the image.
;; @param The file path-name of the image.
;; @param The X position of the image top left corner.
;; @param The Y position of the image top left corner.
;; @param The optional width in which to draw the image.
;; @param The optional height in which to draw the image.
;;
;; When and 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 image-path x y width height)
(if (and width height)
(send-out (string "draw-image " gs:currentCanvas " " tag " "
(base64-enc image-path) " " x " " y " " width " " height "\n"))
(send-out (string "draw-image " gs:currentCanvas " " tag " "
(base64-enc image-path) " " x " " y "\n"))
)
)
;; @syntax (gs:draw-line [])
;; @param The tage of the line.
;; @param The X position of the first point.
;; @param The Y position of the first point.
;; @param The X position of the second point.
;; @param The Y position of the second point.
;;
;; Draws a line. The color numbers must be entered in list form.
;; If no is used the current paint specified with 'gs:set-paint' is used.
(define (draw-line tag x1 y1 x2 y2 color)
(if color
(send-out (string "draw-line " gs:currentCanvas " " tag " "
x1 " " y1 " " x2 " " y2 " " (color 0) " " (color 1) " " (color 2) "\n"))
)
)
;; @syntax (gs:draw-path [])
;; @param The tage group of the path.
;; @param The list of x and y coordinates of the points.
;;
;; Draws a path with the points found in .
;;
;; @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"))
(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")
(send-out s)
)
)
)
;; @syntax (gs:draw-polygon [])
;; @param The tag group of the polygon.
;; @param The list of x and y coordinates of the points.
;;
;; Draws a polygon with the points found in .
;;
;; @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"))
(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")
(send-out s)
)
)
)
;; @syntax (gs:draw-rect [])
;; @param The tag group of the rectangle.
;; @param The X position of the top left corner.
;; @param The Y position of the top left corner.
;; @param The width of the rectangle.
;; @param The height of the rectangle..
;; @param 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 is used the current paint specified with 'gs:set-paint' is used.
(define (draw-rect tag x y width height color)
(if color
(send-out (string "draw-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height " " (color 0) " " (color 1) " " (color 2) "\n"))
(send-out (string "draw-rect " gs:currentCanvas " "
tag " " x " " y " " width " " height "\n"))
)
)
;; @syntax (gs:draw-round-rect [])
;; @param The tag group of the round rectangle.
;; @param The X position of the top left corner.
;; @param The Y position of the top left corner.
;; @param The width of the rectangle.
;; @param The height of the rectangle..
;; @param The width of the corner rectangle.
;; @param The height of the corner rectangle..
;; @param