;; @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: ;;
;; ;;
;; 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

;; (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 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 (send-out (string "draw-round-rect " gs:currentCanvas " " tag " " x " " y " " width " " height " " arcw " " arch " " (color 0) " " (color 1) " " (color 2) "\n")) (send-out (string "draw-round-rect " gs:currentCanvas " " tag " " x " " y " " width " " height " " arcw " " arch "\n")) ) ) ;; @syntax (gs:draw-text [ []) ;; @param The tag group of the text. ;; @param The text to be drawn. ;; @param The X position of the text. ;; @param The Y position of the text. ;; @param The optonal color for the text. ;; @param The optional angle for text in degrees ;; ;; If no is used, the current paint specified with 'gs:set-paint' is used. ;; The optional angle is 0 by default for horizontal text. A value of 90 ;; will rotate the text around the x, y position downwards clockwise. (define (draw-text tag text x y color angle) (if color (if angle (send-out (string "draw-text " gs:currentCanvas " " tag " " (base64-enc text) " " x " " y " " (color 0) " " (color 1) " " (color 2) " " angle "\n")) (send-out (string "draw-text " gs:currentCanvas " " tag " " (base64-enc text) " " x " " y " " (color 0) " " (color 1) " " (color 2) "\n")) ) (send-out (string "draw-text " gs:currentCanvas " " tag " " (base64-enc text) " " x " " y "\n")) ) ) ;; @syntax (gs:enable [sym-id-2 ...]) ;; @param 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:eval-shell ) ;; @param The name of the text area in which to evaluate text. ;; @param The text to evaluate in the shell. (define (eval-shell id command) (net-send out (string "eval-shell " id " " (base64-enc command) "\n")) ) ;; @syntax (gs:export [ ]) ;; @param The path and file name of the image file to write to. ;; @param The optional width of the image in pixels. ;; @param 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 image-path width height) (let (result (if (and width height) (net-send out (string "export " gs:currentCanvas " " (base64-enc image-path) " " width " " height "\n")) (net-send out (string "export " gs:currentCanvas " " (base64-enc image-path) "\n")) )) (if (number? result) true nil) ) ) ;; @syntax (gs:fill-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 (fill-arc id x y width height start angle color) (if color (send-out (string "fill-arc " gs:currentCanvas " " id " " x " " y " " width " " height " " start " " angle " " (color 0) " " (color 1) " " (color 2) "\n")) (send-out (string "fill-arc " gs:currentCanvas " " id " " x " " y " " width " " height " " start " " angle "\n")) ) ) ;; @syntax (gs:fill-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 a filled 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 (fill-circle tag x y radius color) (if color (send-out (string "fill-circle " gs:currentCanvas " " tag " " x " " y " " radius " " (color 0) " " (color 1) " " (color 2) "\n")) (send-out (string "fill-circle " gs:currentCanvas " " tag " " x " " y " " radius "\n")) ) ) ;; @syntax (gs:fill-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 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 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 (send-out (string "fill-ellipse " gs:currentCanvas " " tag " " x " " y " " radius-x " " radius-y " " (color 0) " " (color 1) " " (color 2) "\n")) (send-out (string "fill-ellipse " gs:currentCanvas " " tag " " x " " y " " radius-x " " radius-y "\n")) ) ) ;; @syntax (gs:fill-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 and fills it with ;; the current color set with 'gs:set-paint' or the optional color ;; given in . ;; ;; @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")) (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") (send-out s) ) ) ) ;; @syntax (gs:fill-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 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 is used, the current paint specified with 'gs:set-paint' is used. (define (fill-rect tag x y width height color) (if color (send-out (string "fill-rect " gs:currentCanvas " " tag " " x " " y " " width " " height " " (color 0) " " (color 1) " " (color 2) "\n")) (send-out (string "fill-rect " gs:currentCanvas " " tag " " x " " y " " width " " height "\n")) ) ) ;; @syntax (gs:fill-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 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 (send-out (string "fill-round-rect " gs:currentCanvas " " tag " " x " " y " " width " " height " " arcw " " arch " " (color 0) " " (color 1) " " (color 2) "\n")) (send-out (string "fill-round-rect " gs:currentCanvas " " tag " " x " " y " " width " " height " " arcw " " arch "\n")) ) ) ;; @syntax (gs:find-text []) ;; @param The name of the text area or text pane. ;; @param The searching text. ;; @param A optional action to peform after find-text. ;; @param The optional direction string '"next"' (default) or '"previous"'. ;; ;; 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 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 [ ]) ;; @param The name of the frame window. ;; @param The X position of the top left window corner. ;; @param The Y position of the top left windows corner. ;; @param The width of the window frame. ;; @param The height of the windows frame. ;; @param The optional title of the window. ;; @param 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 ) ;; @param The id of the component for which to get the list of bounding values. ;; @return The bounding list '( )' (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 ) ;; @return A list of the two values for width and height in pixels. ;; ;; The font metrics for the currently set font in are returned as a list ;; of width and height in pixels when displaying the string in . ;; 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-instruments) ;; @return A list of instrument names in the default MIDI soundbank. ;; ;; The function should be called only once because it may take considerable ;; time in a system loaded with a big soundbank. The variable 'gs:instruments' contains ;; the same list of instruments originally returned by a call to 'gs:get-instruments'. (define (get-instruments) (if (not gs:instruments) (begin (net-send out (string "get-instruments System\n")) (while (not gs:instruments) (check-event 10000)) (set 'gs:instruments (map base64-dec gs:instruments)) ) ) ) ;; @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 ) ;; @param The name of the component from which to get the selected text. ;; @param 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 []) ;; @param The name of the component from which to get the text. ;; @param The optional symbol of the event handler which will receive the text. ;; ;; If no is specified the function will block until the text is returned. ;; After return the text is also available in the variable 'gs:text'. ;; If is specified the function will return immediately and a event ;; is fired containing the text. (define (get-text id action) (if action (net-send out (string "get-text " id " " action "\n")) (begin (set 'gs:text nil) (net-send out (string "get-text " id "\n")) (while (not gs:text) (check-event 10000)) gs:text) ) ) ;; @syntax (gs:get-text-position ) ;; @param 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 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 ) ;; @param The name of the text widget. ;; @param The row number where to place the cursor. ;; @param 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 []) ;; @param The tag of the group to hide. ;; @param An optional flag to indicate if repainting is required (default is 'true'). ;; (define (hide-tag tag (repaint true)) (send-out (string "hide-tag " gs:currentCanvas " " tag " " repaint "\n")) ) ;; @syntax (gs:image-button [ [ ]]) ;; @param The name of the image button. ;; @param The name of the event handler. ;; @param The path for an image icon. ;; @param The path for a pressed down image icon. ;; @param The optional width of the image button. ;; @param 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 []) ;; @param The name of the label. ;; @param A string with the icon file path. ;; @param 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 [ [bool-manual]]) ;; @param The optional guiserver server port. ;; @param The optional remote host of the guiserver. (define (init (portIn 64001) (host "127.0.0.1") manual) ; check for server portIn and if this was started by java (if (main-args 2) (set 'portIn (int (main-args 2) portIn))) ; if guiserver.jar did not start this process then guiserver.jar ; still has to be started, except when manual parameter is true (if (and (not (= (main-args 3) "javastart")) (not manual)) (if (= ostype "Windows") (process (string "cmd /c " server-path " " portIn)) (= ostype "OSX") (process (string "/usr/bin/java -jar " server-path " " portIn)) (env "JAVA_HOME") (process (string (env "JAVA_HOME") "/bin/java -jar " server-path " " portIn)) (process (string "/usr/bin/java -jar " server-path " " portIn)) ) ) (set 'portOut (+ portIn 1)) (set 'retry 0) (set 'out nil) (while (not out) (if (> retry 200) ; try for 20 seconds (begin (println "Could not connect to guiserver.jar") (when (= ostype "Windows") (import "user32.dll" "MessageBoxA") (MessageBoxA 0 "Could not connect to guiserver.jar" "Problem connecting" 1) ) (exit)) (inc retry)) (set 'out (net-connect host portIn)) (sleep 100)) (set 'listenSock (net-listen portOut)) (set 'in (net-accept listenSock)) (net-close listenSock) (gs:set-utf8 (primitive? MAIN:utf8)) ) ;; @syntax (gs:insert-list-item [ ]) ;; @param The name of the combo box or list box from which entries are removed. ;; @param The text of the list or combo box item to insert. ;; @param The index of an entry to add to the list or combo box. ;; ;; When specifying an index of 0 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 [ [ []]]) ;; @param The name of the tabbed pane. ;; @param The name of the component to insert as a tab. ;; @param The optional text on the tab. ;; @param The optional index where to insert the new tab. ;; @param 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 ) ;; @param The name of the text component. ;; @param The text to insert. ;; @param 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 ) ;; @param The id of the component to register the action handler. ;; @param 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. Since version 1.05 of newLISP-GS this also ;; includes 'gs:text-field', which already handles key events ;; using the normal event handler function. With 'gs:key-event' a second handler ;; function can be registered. Both functions will fire on their respective events. ;; ;; 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 [ [ ]]) ;; @param The name of the label. ;; @param The text to appear on the label. ;; @param The optional alignment of the text. ;; @param The optional width of the label. ;; @param 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 ) ;; @param 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 ) ;; @param The id of the 'gs:text-pane'. ;; @param 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 image-path) (net-send out (string "load-text " id " " (base64-enc image-path) "\n")) ) ;; @syntax (gs:listen []) ;; @param Prevent exit on loss of communication. ;; @return Never returns. Exits the application when the guiserver exits, except when is 'true'. (define (listen flag , event) (while (net-receive in event 1000000000 "\n") ;(println "===>" event "<===") (eval-string event)) (println "server shut down") (if (not flag) (exit)) ) ;; @syntax (gs:list-box [ ...]) ;; @param The name of the list box. ;; @param The name of the event handler. ;; @param Zero, one or more text entries in the list box. ;; @syntax (gs:list-box []) ;; @param The name of the list box. ;; @param The name of the event handler. ;; @param Zero, one or more text entries in a list. ;; The listbox when clicked with the mouse, or when the [enter] key is ;; presses, will pass the following parameters to the event handler: ;;

;; - the id string of the list box
;; - the zero offset index of the highlighted listbox entry
;; - the string of the highlighted listbox entry
;; - the number of times the mouse has been clicked
(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 [ []]) ;; @param The symbol name of the parent frame. ;; @param The title of the message box. ;; @param The message in the message box. ;; @param The type of the message box. ;; @param 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 msg (type "plain") icon) (if icon (net-send out (string "message-dialog " parent " " (base64-enc title) " " (base64-enc msg) " " type " " (base64-enc icon) "\n")) (net-send out (string "message-dialog " parent " " (base64-enc title) " " (base64-enc msg) " " type "\n")) ) ) ;; @syntax (gs:menu ) ;; @param The name of the menu. ;; @param The title string of the menu. (define (menu id text) (net-send out (string "menu " id " " (base64-enc text) "\n")) ) ;; @syntax (gs:menu-popup ) ;; @param The name of the menu. ;; @param 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 [ ...]) ;; @param The name of the frame hosting the menu bar. ;; @param 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 ) ;; @param The name of the menu item. ;; @param The name of the event handler. ;; @param 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 []) ;; @param The name of the menu item. ;; @param The name of the event handler. ;; @param The text to appear for the menu item. ;; @param 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:midi-bpm [ []]]) ;; @param Beats per minute pay speed. Default is 120 BPM. ;; @param Ticks per beat. Deafult is 16 ticks per beat; ;; ;; Sets the speed of playing a notes with with either 'gs:play-note' or playing a ;; sequence with 'gs:play-sequence' in beats per minute (BPM). ;; ;; Before using 'gs:midi-bpm' the default speed is set to 120 BPM, which corresponds ;; to two beats per second, where each beat corresponds to a quarter note of 16 ticks ;; default resolution. ;; ;; While the BPM parameter controls the play-back speed of the sequencer, the ;; resolution is a parameter of the sequence creation itself and must be set before ;; the first 'gs:add-track' call. ;; ;; The preset resolution of 16 ticks per quarter note is the highest which can be set ;; and should be sufficient for all applications. (define (midi-bpm (bpm 120) (resolution 16)) (set 'resolution (min resolution 16)) (net-send out (string "midi-bpm System " (string bpm) " " (string resolution) "\n")) ) ;; ;; @syntax (gs:midi-close) ;; ;; Shut down the MIDI subsystem. (define (midi-close) (net-send out (string "midi-close System\n")) ) ;; @syntax (gs:midi-init []) ;; @param The optional file path for a soundbank file. ;; ;; Initialize the MIDI subsystem. If a soundbank file is specified load it, ;; else load the built-in synthesizer's default soundbank. ;; ;; When not using the default soundbank, the function 'gs:get-instruments' ;; should be used first to find out the correct naming of instruments ;; for the 'gs:midi-patch' statements. The soundbank used for testing the ;; demo files 'midi-demo.lsp' and 'midi2-demo.lsp' on Windows is the midsize ;; soundbank available here: ;; @link http://java.sun.com/products/java-media/sound/soundbanks.html http://java.sun.com/products/java-media/sound/soundbanks.html ;; This soundbank has equivalent named instruments to those used in the Mac OS X default JRE installation. ;; Currently only the first 128 instruments in a soundbank are accessed by newLISP-GS. (define (midi-init soundbank) (if soundbank (net-send out (string "midi-init System " (base64-enc soundbank) "\n")) (net-send out (string "midi-init System\n")) ) ) ;; @syntax (gs:midi-patch []) ;; @param The name of the instrument to attach to a channel. ;; @param The channel for the instrument, default is 0. ;; ;; An instrument from the current soundbank is attached to a ;; specific channel or to channel 0 if no channel is specified. ;; ;; @example ;; (gs:midi-patch (find "Electric Grand" gs:instruments) 0) ;; In order for the 'gs:instruments' variable to contain a list of instruments, ;; 'gs:get-instruments' must have been called earlier, i.e. after 'gs:midi-init'. (define (midi-patch program (channel 0)) (net-send out (string "midi-patch System " (base64-enc program) " " channel "\n")) ) ;; @syntax (gs:mouse-clicked []) ;; @param The id of the canvas to register the action handler. ;; @param The symbol of the action handler. ;; @param A 'true' to indicate checking for tags. ;; ;; If 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 ) ;; @param The id of the canvas to register the action handler. ;; @param 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 ) ;; @param The id of the component to register the action handler. ;; @param 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 ) ;; @param The id of the canvas to register the action handler. ;; @param The symbol of the action handler. ;; @param A 'true' to indicate checking for tags. ;; ;; If is 'true', the action event will carry a list of ;; all tags which contained the X,Y coordinates of the mouse. (define (gs:mouse-moved cnvs action flag) (net-send out (string "mouse-moved " cnvs " " action " " flag "\n")) ) ;; @syntax (gs:mouse-pressed []) ;; @param The id of the canvas to register the action handler. ;; @param The symbol of the action handler. ;; @param A 'true' to indicate checking for tags. ;; ;; If 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 []) ;; @param The id of the canvas to register the action handler. ;; @param The symbol of the action handler. ;; @param A 'true' to indicate checking for tags. ;; ;; If is 'true', 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 ) ;; @param The id of the canvas to register the action handler. ;; @param 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 []) ;; @param The tag of the group of objects to move. ;; @param The distance to move on the X-axis. ;; @param The distance to move on the Y-axis. ;; @param An optional flag to indicate if repainting is required (default is 'true'). ;; ;; '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)) (send-out (string "move-tag " gs:currentCanvas " " tag " " dx " " dy " " repaint "\n")) ) ;; @syntax (gs:mute-track []) ;; @param The number of the track starting with 0 for the first. Default is true. ;; @param The track will be muted with a value of true ;; ;; Any other value than true will unmute the track again. Muting tracks is practical ;; during music development. The track can only be muted when th sequence has benn started ;; using 'gs:play-sequence'. To completely mute a track the 'gs:mute-track' statement should ;; come right after the 'gs:play-sequece' statement. (define (mute-track number (bool true)) (net-send out (string "mute-track System " number " " (string bool) "\n")) ) ;; @syntax (gs:no-action) ;; ;; Specify as for widgets where no action handler is defined. (define (no-action)) ;; @syntax (gs:open-file-dialog [ [ ]]) ;; @param The parent frame of the file dialog. ;; @param The handler function symbol. ;; @param The initial directory to show. ;; @param An optonal string mask. ;; @param 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 [ ]) ;; @param The name of the panel. ;; @param The optional width of the panel. ;; @param 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 []) ;; @param The name of the text component in which to paste text. ;; @param An optional text string to paste instead of the clipboard contents. ;; ;; If the contains selected text, this text gets replaced, ;; otherwise the text is inserted at the current caret position. ;; If no text is given in , 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-note [ [ [ []]]]) ;; @param The note or midi key 0 to 127. ;; @param The duration of the note in ticks, default is 16 for one beat or quarter note. ;; @param The velocity/volume of the note between 0 and 127, default is 64. ;; @param The channel through which to play the note from 0 to 15, default is 0. ;; @param The optional note bend to tune the note lower or higher from '-8192' to '8191'. ;; ;; Before using 'gs:play-note', 'gs:midi-init' should be used to initialize the MIDI system. ;; The key of the note increases in half-tone steps. The key 60 corresponds to a Middle-C. ;; The velocity of the note is usually it's volume and/or brightness, i.e. the speed with which ;; a key was pressed on an instrument. The channel is 0 by default and assigned to ;; a Piano instrument unless the function 'gs:midi-patch' has been used to change assignment ;; to a different instrument. ;; ;; On Windows and some Linux or other UNIX no MIDI soundbank files are installed by default. Goto ;; @link http://java.sun.com/products/java-media/sound/soundbanks.html http://java.sun.com/products/java-media/sound/soundbanks.html ;; for instructions how to download and install a soundbank. For the demo files 'mide-demo.lsp' and ;; 'midi2-demo' the midsize quality soundbank was used. On Mac OS X a soundbank is installed by default. ;; The default for the bend parameer is 0 for no bend. Negative values down to '-8192' ;; tune the note lower. Positive values up to '8191' tune the note higher. ;; The following code is a complete example: ;; ;; @example ;; ; load Guiserver ;; (load (append (env "NEWLISPDIR") "/guiserver.lsp")) ;; (gs:init) ;; ;; ; play a chromatic scale on the default instrument (piano) ;; ; each note a 16th note of 4 ticks and a moderate volume ;; ;; (gs:midi-init) ;; (gs:midi-patch "Piano" 0) ;; (for (key 24 95) (gs:play-note key 4 95 0)) ;; (sleep 2000) ; wait until playing has finished ;; (gs:midi-close) ;; ;; The second example demonstrated usage of the parameter: ;; ;; @example ;; ; play the same note but with different bends below and above the note ;; (gs:midi-patch "Violin" 0) ;; (for (bend -2024 2024 128) ;; (gs:play-note 80 1 95 0 bend)) ;; To play polyphone music of multiple parallel tracks see the function 'gs:add-track' for ;; a complete code example. (define (play-note key (duration 4) (velocity 64) (channel 0) (bend 0)) (net-send out (string "play-note System " key " " duration " " velocity " " channel " " bend "\n")) ) ;; @syntax (gs:play-sequence [ [ [ []]]) ;; @param The starting point in the sequence in ticks. Default is 0 for the beginning. ;; @param The number of repetitions for looping. Default is 0 for no looping. ;; @param The start of the loop to play in ticks. Default is 0. ;; @param The end of the loop in ticks. Default is -1 for the end. ;; ;; All parameters are optional. When no parameters are given all tracks in the sequence are ;; sequenced from start to end with no repetiton (loop count of 0). Note that the start-loop and ;; end-loop positions refer only to loop played after playing the full track. After the sequence ;; started playing 'gs:stop-sequence' can be used to stop it at any time. The midi system ;; should not be closed using 'gs:midi-close' before playing has finished or playing will ;; be cut off. ;; ;; See the function 'gs:add-track' for complete code example. (define (play-sequence (ticks 0) (loop 0) (start 0) (end -1)) (net-send out (string "play-sequence System " ticks " " loop " " start " " end "\n")) ) ;; @syntax (gs:play-sound ) ;; @param 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 ) ;; @param The symbols of the progress bar. ;; @param The minimum value of the slider. ;; @param The maximum value of the slider. ;; @param 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 [ []]) ;; @param The name of the radio button. ;; @param The name of the event handler. ;; @param The optional text of the radio button. ;; @param 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 ) ;; @param 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 [ ...]) ;; @param The container from which to remove a component. ;; @param 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 [ ...]) ;; @param The name of the combo box or list box from which entries are removed. ;; @param The index of an entry to remove from the list or combo box. ;; ;; When specifying an index of 0, the first item gets removed. When specifying an ;; index equal or greater to the number of items in the list, the item is removed 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 []) ;; @param The name of the tabbed pane. ;; @param The optional index of the tab to remove. The default is 0 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 []) ;; @param The name of the component for which to request focus. ;; @param 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:reorder-tags ) ;; @param The list of tag symbols or tag string names in the new order of display. ;; ;; The re-ordering itself will not repaint the canvas use 'gs:update' to repaint the current ;; canvas after using 'gs:reorder-tags'. The list of tags can be given as either a list of ;; tags symbols or name strings. Tags not appearing in will be deleted. (define (reorder-tags tags) (let (s (string "reorder-tags " gs:currentCanvas " ")) (dolist (tag tags) (write-buffer s (string tag " "))) (write-buffer s "\n") (net-send out s) ) ) ;; @syntax (gs:rotate-tag []) ;; @param The tag group to rotate. ;; @param The rotation angle in degrees (0 - 360). ;; @param The X-coordinate of the rotation center. ;; @param The Y-coordinate of the rotation center. ;; @param An optional flag to indicate if repainting is required (default is 'true'). ;; ;; Like all tag operations, multiple 'gs:rotate-tag' operations are cumulative. (define (rotate-tag tag angle x y (repaint true)) (send-out (string "rotate-tag " gs:currentCanvas " " tag " " angle " " x " " y " " repaint "\n")) ) ;; @syntax (gs:run-shell ) ;; @param The id of the text area to wich a shell process will be attached. ;; @param The command string to start the shell process. ;; @param The arguments of the command (max 8 arguments). (define (run-shell id command arguments) (net-send out (string "run-shell " id " " (base64-enc command) " " (base64-enc arguments) "\n")) ) ;; @syntax (gs:save-file-dialog [ [ [ ]]]) ;; @param The parent frame of the file dialog. ;; @param The handler function symbol. ;; @param The initial directory to show. ;; @param The initial file name. ;; @param An optional string mask. ;; @param 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-sequence ) ;; @param The name of the MIDI file to save to. ;; ;; Save the contents of a sequence created with 'gs:add-track' to a MIDI file. ;; The file always should have the extension .mid. ;; ;; Note that all MIDI files created with 'gs:save-sequence' will play back at a fixed ;; speed of 120 BPM. Therefore, when creating sequences for recording using 'gs:add-track', ;; they should be timed for a play-back speed of 120 BPM. ;; ;; To change the speed for replay from a saved MIDI file the resolution parameter can ;; be chaged from it's default of 16 tick per beat using the second optional parameter ;; of 'gs:midi-bpm'. In this case the resolution parameter should be adjusted before ;; calling 'gs:add-track' the first time. (define (save-sequence file-path) (net-send out (string "save-sequence System " (base64-enc file-path) "\n")) ) ;; @syntax (gs:save-text ) ;; @param The id of the 'gs:text-pane'. ;; @param 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 image-path) (net-send out (string "save-text " id " " (base64-enc image-path) "\n")) ) ;; @syntax (gs:scale-tag []) ;; @param The tag group to scale. ;; @param The X scaling factor. ;; @param The Y scaling factor. ;; @param An optional flag to indicate if repainting is required (default is 'true'). ;; ;; '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)) (send-out (string "scale-tag " gs:currentCanvas " " tag " " sx " " sy " " repaint "\n")) ) ;; @syntax (gs:select-list-item []) ;; @param The name of the list or combo box. ;; @param The item to select. ;; @param An optional flag only for list boxes to force scrolling to the selected entry. ;; ;; On combo boxes the optional 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 []) ;; @param The ame of the text component. ;; @param Start offset of selection. ;; @param Optional end offset of selection. ;; ;; If no 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 [ ]) ;; @param The name of the scroll pane. ;; @param The component in the scroll pane to be scrolled. ;; @param The optional width of the scroll pane. ;; @param The optional height of the scroll pane. ;; @param The optional table widget for a custom column header. ;; @param The optional table widget for a custom row header ;; @param The optional widget component in the upper left corner. ;; ;; @example ;; (gs:scroll-pane 'scroll 'data-table 700 600 'col-table 'row-table 'Canvas) ;; (define (scroll-pane id widget width height col-table row-table upper-left-corner ) (if (and col-table row-table upper-left-corner) (net-send out (string "scroll-pane " id " " widget " " width " " height " " col-table " " row-table " " upper-left-corner "\n")) (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 ) ;; @param The name of the menu item for which an accelerator key is set. ;; @param A text string identifying the keystroke. ;; ;; The following rules are used to create keystroke strings: ;; ;; Syntax: ;;
;; 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_".
;; 
;; Examples: ;;
;; "INSERT"
;; "control DELETE"
;; "alt shift X"
;; "alt shift released X"
;; "typed a"
;; 
;; Note that the apple key on MacOS X is the 'meta' key. ;; The 'alt' on MacOS X is the option 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 ) ;; @param 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 []) ;; @param The name of the component for which to set the color. ;; @param The red color component expressed as a number between 0.0 and 1.0. ;; @param The green color component expressed as a number between 0.0 and 1.0. ;; @param The blue color component expressed as a number between 0.0 and 1.0. ;; @param The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque). ;; ;; @syntax (gs:set-background []) ;; @param The name of the component for which to set the color. ;; @param The rgb color can be given as a list of three numbers. ;; @param 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 ) ;; @param The name of the component. ;; @param 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 [ ]) ;; @param The name of the container for which border layout is set. ;; @param The horizontal gap between components in the border layout. ;; @param 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 ) ;; @param The id of the canvas to switch to. ;; ;; The canvas in 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) (set 'gs:currentCanvas id) (net-send out (string "set-canvas " id "\n")) ) ;; @syntax (gs:set-caret ) ;; @param The name of the component for which to set the cursor caret. ;; ;; The functions has the same effect as calling 'gs:select-text' with the same ;; offset for the dot and mark position. (define (gs:set-caret id offset) (net-send out (string "set-caret " id " " offset "\n")) ) ;; @syntax (gs:set-caret-color ) ;; @param The name of the component for which to set the color. ;; @param The red color component expressed as a number between 0.0 and 1.0. ;; @param The green color component expressed as a number between 0.0 and 1.0. ;; @param The blue color component expressed as a number between 0.0 and 1.0. ;; @syntax (gs:set-caret-color []) ;; @param The name of the component for which to set the color. ;; @param 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 []) ;; @param The name of the component for which to set the color. ;; @param The red color component expressed as a number between 0.0 and 1.0. ;; @param The green color component expressed as a number between 0.0 and 1.0. ;; @param The blue color component expressed as a number between 0.0 and 1.0. ;; @param The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque). ;; ;; @syntax (gs:set-color []) ;; @param The name of the component for which to set the color. ;; @param The rgb color can be given as a list of three numbers. ;; @param 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 ) ;; @param The name of the frame, dialog or window. ;; @param The string describing the cursor shape. ;; ;; The cursor shape can be one of the following: ;;
;;  "default"
;;  "crosshair"
;;  "text"
;;  "wait"
;;  "sw-resize"
;;  "se-resize"
;;  "nw-resize"
;;  "ne-resize"
;;  "n-resize"
;;  "s-resize"
;;  "w-resize"
;;  "e-resize"
;;  "hand"
;;  "move"
;; 
(define (set-cursor id shape) (net-send out (string "set-cursor " id " " shape "\n")) ) ;; @syntax (gs:set-echo-char []) ;; @param The name of the component for which text is set. ;; @param Cover character for password entry. ;; @example ;; (gs:set-echo-char 'TheTextField "*") ;; (gs:set-echo-char 'TheTextField) ; no echo, behave as normal text field (define (set-echo-char id text) (if (and text (> (length text) 0)) (net-send out (string "set-echo-char " id " " (base64-enc text) "\n")) (net-send out (string "set-echo-char " id "\n"))) ) ;; If no is specyfied or the string in is of ;; 0 length, then the text field behaves as a normal text field. ;; @syntax (gs:set-editable ) ;; @param The name of the text widget. ;; @param 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 [ [ ]]) ;; @param The name of the container for which flow layout is set. ;; @param The alignment of the flow layout '"left"', '"center"' or '"right"'. ;; @param The horizontal gap between components in the flow layout. ;; @param 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 ) ;; @param The name of the component for which to set the text font. ;; @param The family of the font, e.g.: '"Monospaced"', '"Serif"', '"Sans Serif"'. ;; @param The font size in points. ;; @param 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 []) ;; @param The name of the component for which to set the color. ;; @param The red color component expressed as a number between 0.0 and 1.0. ;; @param The green color component expressed as a number between 0.0 and 1.0. ;; @param The blue color component expressed as a number between 0.0 and 1.0. ;; @param The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque). ;; ;; @syntax (gs:set-foreground []) ;; @param The name of the component for which to set the color. ;; @param The rgb color can be given as a list of three numbers. ;; @param 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 [ ]) ;; @param The name of the container for which grid layout is set. ;; @param The number of rows in the layout grid. ;; @param The number of columns in the layout grid. ;; @param The horizontal gap between components in the grid layout. ;; @param 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 []) ;; @param The name of a button or label or menu-item for which to set an icon. ;; @param The file path of the icon to be set. ;; @param If is a tabbed pane 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 ) ;; @param The class description string for the look and feel of the application. ;; ;; The following strings can be tried in , 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. ;;
;;    '"com.sun.java.swing.plaf.motif.MotifLookAndFeel"'
;; '"javax.swing.plaf.metal.MetalLookAndFeel"'
;; '"com.sun.java.swing.plaf.windows.WindowsLookAndFeel"'
;; '"javax.swing.plaf.mac.MacLookAndFeel"'
;; '"com.sun.java.swing.plaf.gtk.GTKLookAndFeel"' ;;
(define (set-look-and-feel look) (net-send out (string "set-look-and-feel System " look "\n")) ) ;; @syntax (gs:set-paint ) ;; @param 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 ) ;; @param The name of the button, image button or toggle button. ;; @param 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 ) ;; @param The name of the frame window. ;; @param 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 ) ;; @param 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 ) ;; @param The X-scale value of the current canvas. ;; @param 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 [ ]) ;; @param The name of the toggle or radio button or check box or menu item. ;; @param 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 []) ;; @param The name of the component for which to set the text selection color. ;; @param The red color component expressed as a number between 0.0 and 1.0. ;; @param The green color component expressed as a number between 0.0 and 1.0. ;; @param The blue color component expressed as a number between 0.0 and 1.0. ;; @param The transparency of the color expressed as a number between 0.0 (fully transparent)and 1.0 (completely opaque). ;; ;; @syntax (gs:set-selection-color []) ;; @param The name of the component for which to set the text selection color. ;; @param The rgb color can be given as a list of three numbers. ;; @param 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 ) ;; @param The name of the component of which a preferred size is set. ;; @param The preferred width of the component. ;; @param 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 [ [ []]]) ;; @param The width for drawing lines and outlines in shapes. ;; @param One of optional '"butt"' (default), '"round"' or '"sqare"'. ;; @param One of optional '"miter"' (default), '"bevel"' or '"round"' ;; ;; For a 0f 0.0 the thinnest possible line width 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 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 ) ;; @param The name of the text pane for syntax coloring is enabled or disabled. ;; @param 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 ) ;; @param The color for comments. ;; @param The color for reserved keywords. ;; @param The color for strings. ;; @param The color for numbers. ;; @param The color for the quote and quoted symbols. ;; @param 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 ) ;; @param The name of the text area component. ;; @param 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 []) ;; @param The name of the component for which text is set. ;; @param The text to be set in the component. ;; @param The index for a tab if the 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 ) ;; @param The name of the component. ;; @param 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 ) ;; @param The name of the widget for which to supply a tool tip. ;; @param 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 ) ;; @param The flag 'true' or 'nil'. (define (set-trace flag) (net-send out (string "set-trace System " flag "\n")) ) ;; @syntax (gs:set-translation ) ;; @param The X-translation value of the current canvas. ;; @param The Y-translation value of the current canvas. ;; ;; Translates the current origin of the current canvas to the point in . ;; 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-utf8 ) ;; @param The flag 'true' or 'nil' to indicate if in UTF-8 mode. ;; ;; When set in UTF-8 mode, guiserver will convert files to UTF-8 encoding ;; when loading and saving files. On Mac OS X UTF-8 mode is by default enabled. ;; On startup guiserver.lsp will detect if newLISP is UTF-8 enabled and ;; switch the mode in Guiserver accordingly using 'gs:set-utf8'. (define (gs:set-utf8 flag) (net-send out (string "set-utf8 System " flag "\n")) ) ;; @syntax (gs:set-value ) ;; @param The name of a slider or progress bar for which to set the value. ;; @param 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 ) ;; @param The component which is hidden or made visible. ;; @param 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 []) ;; @param The tag group to shear. ;; @param The X shearing factor. ;; @param The Y shearing factor. ;; @param An optional flag to indicate if repainting is required (default is 'true'). (define (shear-tag tag sx sy (repaint true)) (send-out (string "shear-tag " gs:currentCanvas " " tag " " sx " " sy " " repaint "\n")) ) ;; @syntax (gs:show-popup ) ;; @param The id of the popup menu. ;; @param The host container where to pop up the menu. ;; @param The X coordinate of the menu popup position. ;; @param 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 []) ;; @param The tag of the group to show. ;; @param An optional flag to indicate if repainting is required (default is 'true'). ;; (define (show-tag tag (repaint true)) (net-send out (string "show-tag " gs:currentCanvas " " tag " " repaint "\n")) ) ;; @syntax (gs:slider ) ;; @param The name of the slider. ;; @param The name of the event handler. ;; @param The orientation of the slider '"horizontal"' or '"vertical"' ;; @param The minimum value of the slider. ;; @param The maximum value of the slider. ;; @param 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 [ [ []]]) ;; @param The name of the split-pane. ;; @param The orientation '"horizontal"' or '"vertical"'. ;; @param The optional weight distribution between '0.0' and '1.0' when re-sizing the window. The default is '0.0'. ;; @param The optional initial divider location between '0.0' and '1.0'. ;; @param 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:stop-sequence) ;; ;; Stops playing tracks, as started with 'gs:play-sequence'. (define (gs:stop-sequence) (net-send out (string "stop-sequence System\n")) ) ;; @syntax (gs:tabbed-pane [ ...]) ;; @param The name of the tabbed pane. ;; @param The position of the tabs; either '"top"' (default), '"bottom"','"left"' or '"right"'. ;; @param The id symbol name of a tab ;; @param 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:table [ ...]) ;; @param The name of the table. ;; @param The handler function symbol when a cell is selected. ;; @param The optional column header name. ;; ;; Creates a table with specified column and empty row. ;; For empty strings specified as column headers, the header will be left empty. ;; If all header in a table are specified as empty, the table will be created ;; without a header row. If there are no columns at all, an empty table (0 x 0) ;; is created. ;; ;; When a cell is selected, the function in gets called with the table ;; id, row, column and cell-contents. See the file 'table-demo.lsp' for an example. ;; Cells can be edited by either selecting or double clicking a cell. (define (table id action) (let (s (string "table " id " " action) columns (if (null? (args)) '() (if (list? (args 0)) (args 0) (args)))) (dolist (col columns) (write-buffer s (string " " (base64-enc col)))) ;(println "gs:table " s) (write-buffer s "\n") (net-send out s) ) ) ;; @syntax (gs:table-add-column ...) ;; @param The name of the table. ;; @param Add column header name(s). ;; ;; More than one can be specified to add more ;; than one column. A column header can be set empty using and empty string "". ;; When all headers in a table are empty, the ;; table will be displayed without a header row. (define (table-add-column id) (let (s (string "table-add-column " id) columns (if (null? (args)) '() (if (list? (args 0)) (args 0) (args)))) (dolist (col columns) (write-buffer s (string " " (base64-enc col)))) ;(println "gs:table-add-column " s) (write-buffer s "\n") (net-send out s) ) ) ;; @syntax (gs:table-add-row [ ... ]) ;; @syntax (gs:table-add-row ([ ...)) ;; @param The name of the table. ;; @param Add a row with contents in ;; ;; Add row with each column value. If necessary a scrollbar will appear. ;; If no contents is defined in , or if contents for less ;; columns is defined than available, column contents is left empty. ;; Multiple column content can be specified as either a list ;; of strings or as additional parameters of 'gs:table-add-row'. (define (table-add-row id) (let (s (string "table-add-row " id) columns (if (null? (args)) '() (if (list? (args 0)) (args 0) (args)))) (dolist (col columns) (write-buffer s (string " " (base64-enc col)))) ;(println "gs:table-add-row " s) (write-buffer s "\n") (net-send out s) ) ) ;; @syntax (gs:table-get-cell ) ;; @param The name of the table. ;; @param The row of the cell. ;; @param The column of the cell. ;; @return cell value. stored in gs:table-cell. ;; ;; Get the cell contents as a string at sepcifed and . (define (table-get-cell id row col) (set 'gs:table-cell nil) (let (s (string "table-get-cell " id " " row " " col)) ;(println "gs:table-get-cell " s) (write-buffer s "\n") (net-send out s) (while (not gs:table-cell) (check-event 10000)) gs:table-cell) ) ;; @syntax (gs:table-get-size ) ;; @param The name of the table. ;; @return table size list (row-size, column-size) ;; ;; Get table size, stored in 'gs:table-size'. ;; Note, that adding columns or row will not automatically update ;; the 'gs:table-size' variable. Use 'gs:table-get-size' to update ;; this variable. (define (table-get-size id) (set 'gs:table-size nil) (let (s (string "table-get-size " id)) ;(println "gs:table-get-size " s) (write-buffer s "\n") (net-send out s) (while (not gs:table-size) (check-event 10000)) gs:table-size ) ) ; FdB ;; @syntax (gs:table-remove-row ) ;; @param The name of the table. ;; @param The row to remove ;; ;; Removes a row See also 'gs:table-set-row-count'. (define (table-remove-row id row) (let (s (string "table-remove-row " id " " row)) ;(println "gs:table-remove-row " s) (write-buffer s "\n") (net-send out s) ) ) ;; @syntax (gs:table-set-cell ) ;; @param The name of the table. ;; @param The row of the cell set. ;; @param The column of the cell set. ;; @param The cell value. ;; @return The previous contents of the cell; also stored in 'gs:table-cell'. ;; ;; Sets a new table cell contents and returns the old cell contents. Row and ;; column numbering starts with '0' (zero). The cell contents is passed ;; as a string. (define (table-set-cell id row col value) (set 'gs:table-cell nil) (let (s (string "table-set-cell " id " " row " " col " " (base64-enc value))) ;(println "gs:table-set-cell " s) (write-buffer s "\n") (net-send out s) (while (not gs:table-cell) (check-event 10000)) gs:table-cell ) ) ;; @syntax (gs:table-set-column []) ;; @param The name of the table. ;; @param The column number of align. ;; @param The column width. ;; @param The column align property, "left", "center", "right". ;; ;; A table column property is changed, adjusting the column width and alignment of cell ;; contents. The parameter is optional and alignment is "left" ;; by default. (define (table-set-column id columnNum width (justification "left")) (let (s (string "table-set-column " id " " columnNum " " width " " justification)) ;(println "gs:table-set-column " s) (write-buffer s "\n") (net-send out s) ) ) ; FdB ;; @syntax (gs:table-set-column-name [ ... ]) ;; @syntax (gs:table-set-column-name ([ ...)) ;; @param The name of the table. ;; @param Set column names with contents in ;; ;; Replaces the column names in the table. If the number of names ;; is greater than the current number of columns, new columns are added to the end ;; of each row in the table. If the number of columnnames is less than the current ;; number of columns, all the extra columns at the end of a row are discarded. (define (table-set-column-name id) (let (s (string "table-set-column-name " id) columns (if (null? (args)) '() (if (list? (args 0)) (args 0) (args)))) (dolist (col columns) (write-buffer s (string " " (base64-enc col)))) ;(println "gs:table-set-column-name " s) (write-buffer s "\n") (net-send out s))) ; FdB ;; @syntax (gs:table-set-row-count ) ;; @param The name of the table. ;; @param Set the numbers of rows in the table with ;; ;; Sets the number of rows in the table. If the new size is greater than the ;; current size, new rows are added to the end of the table. If the new size is ;; less than the current size, all rows at index rownumber and greater are discarded. (define (table-set-row-count id num) (let (s (string "table-set-row-count " id " " num)) (write-buffer s " \n") (net-send out s)) ) ;; @syntax (gs:table-get ) ;; @return table cells. stored in 'gs:table-full'. ;; ;; Get full table as a list of row lists. ;;
;; ( ("column0" "column1" ... ) ; 1'st row
;;   ("column0" "column1" ... ) ; 2'nd row
;;   ...
;;   ... )
;; 
;; ;; The entire table contents is stored as a list of row lists in the ;; return value of 'gs:table-get', and is also stored in the variable ;; 'gs:table-full'. (define (table-get id) (set 'gs:table-full nil) (let (s (string "table-get " id)) (write-buffer s "\n") ;(println "gs:table-get " s) (net-send out s) (while (not gs:table-full) (check-event 10000)) ; decode base64 cell contents for each row in each cell (set 'gs:table-full (map (lambda (x) (map (lambda (s) (if (nil? s) nil (base64-dec s)) ) x ) ) gs:table-full)) ) ) ;; @syntax (gs:table-set-row-number ) DEPRECATED ;; ;; Use 'gs:table-show-row-number'. The old naming is deprecated but will ;; still work. ;; @syntax (gs:table-show-row-number ) ;; @param The name of the table. ;; @param 'true' if rows should carry a row number; default 'nil'. ;; ;; Show or hide the row number headers. The default is hiding row numbers. (define (table-show-row-number id boolRowheader) (let (s (string "table-show-row-number " id " " boolRowheader)) ;(println "gs:table-show-row-number " s) (write-buffer s "\n") (net-send out s) ) ) (define table-set-row-number table-show-row-number) ;; @syntax (gs:text-area ) ;; @param The name of the text area. ;; @param The name of the event handler. ;; @param The optional width of the text area.. ;; @param 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: ;;
;; 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 
;; 
(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 []) ;; @param The name of the text field. ;; @param The name of the event handler. ;; @param The number of columns in the text field. ;; @param Cover character for password entry. ;; @example ;; (gs:text-field 'TheTextField 'textfield-event) ;; (gs:text-field 'PasswordTextField 'textfield-event "*") ;; The 'textfield-event' is fired when the enter key is pressed in the ;; text field. As an alternative the cover character for passwords can be ;; set with 'gs:set-echo-char'. (define (text-field id action columns text) (if text (net-send out (string "text-field " id " " action " " columns " " (base64-enc text) "\n")) (net-send out (string "text-field " id " " action " " columns "\n"))) ) ;; @syntax (gs:text-pane [ ]) ;; @param The name of the text pane. ;; @param The key action handler for the html pane. ;; @param The content type of the text pane. ;; @param The optional width of the pane. ;; @param The optional height of the pane. ;; ;; The 'gs:text-pane' is used similar to 'gs:text-area. The following styles ;; are supported in : ;;
;;    "text/plain"
;;    "text/html"
;; 
;; ;; 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: ;;
;; 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 
;; 
(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 []) ;; @param The name of the toggle button. ;; @param The name of the event handler. ;; @param The optional text of the toggle button. ;; @param 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 [ ]) ;; @param The name of the frame hosting the toolbar. ;; @param The optional flag 'true' or 'nil' to indicate if the toolbar can be detached. ;; @param The horizontal gap between components on the toolbar. ;; @param 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 []) ;; @param The name tag of the group to translate. ;; @param The X-coordinate translation value. ;; @param The Y-coordinate translation value. ;; @param An optional flag to indicate if repainting is required (default is 'true'). ;; ;; Moves the origin of the coordinate system of all objects tagged with . ;; Like all tag operations multiple 'gs:translate-tag' operations are cumulative. (define (translate-tag tag x y (repaint true)) (send-out (string "translate-tag " gs:currentCanvas " " tag " " x " " y " " repaint "\n")) ) ;; @syntax (gs:undo-text ) ;; @param 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:undo-enable ) ;; @param The id of the 'gs:text-pane' for which to enabe/disable undo. ;; @param 'true' or 'nil' to enable or disable undo. (define (undo-enable id enabled) (net-send out (string "undo-enable " id " " enabled "\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 ) ;; @param The name of the invisible window. ;; @param The x-coordinate of the screen position. ;; @param The y-coordinate of the screen position. ;; @param The width of the window. ;; @param 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 ) ;; @param The name of the frame or dialog. ;; @param 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")) ) (define (window-closed id action) (net-send out (string "frame-closed " id " " action "\n")) ) ;; @syntax (gs:window-moved ) ;; @param The name of the frame or dialog. ;; @param The action to perform when the frame or dialog moves. ;; ;; The event will carry the of the window or dialog and current X and Y ;; coordinates on the screen. ;; (define (frame-moved id action) (net-send out (string "frame-moved " id " " action "\n")) ) (define (window-moved id action) (net-send out (string "frame-moved " id " " action "\n")) ) ;; @syntax (gs:window-resized ) ;; @param The name of the frame or dialog. ;; @param The action to perform when the frame or dialog is resized. ;; ;; The event will carry the of the window or dialog and current width and ;; height. (define (frame-resized id action) (net-send out (string "frame-resized " id " " action "\n")) ) (define (window-resized id action) (net-send out (string "frame-resized " id " " action "\n")) ) ; eof