;;; KRA 12JUN99: Conflicts with generic silk:
;;; get -> getfield
;;; set -> setfield 
;;; toString ->toString@ 
;;; add -> add@ 
;;; exit -> exit


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.scm 
;;
;;
;; This is a library of Scheme/Java interface procedures designed
;; to allow one to easily write graphical user interfaces
;; for Scheme programs. 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;||
;;||
;;|| ****************************************************************
;;|| *
;;|| *               JLIB + SILK extensions
;;|| *
;;|| *
;;|| *      1998 Copyright Tim Hickey, All Rights Reserved
;;|| *      Author:      Tim Hickey, www.cs.brandeis.edu/~tim
;;|| *      Last Change: 26SEP98
;;|| *
;;|| *
;;|| * This library provides a convenient scheme interface to 
;;|| * parts of the Java standard libraries (awt, lang, net,...)
;;|| * 
;;|| * Applets and applications written using JLIB and R4RS scheme
;;|| * should run on any Scheme implementation which provides the
;;|| * following extensions to R4RS scheme:
;;|| *
;;|| *   thisInterpreter
;;|| *   thisApplet
;;|| *   thisDocumentbase
;;|| *   (method "methodname" "classname" "arg1type" ... "argntype")
;;|| *   (constructor "classname" "arg1type" ... "argntype")
;;|| *
;;|| * TYPE MANAGEMENT
;;|| *   (stringToJstring S)
;;|| *   (jstringToString J) 
;;|| *
;;|| * REFLECTION
;;|| *   (getclass Object)
;;|| *   (getfield Object "instancefieldname")
;;|| *   (setfield Object "instancefieldname" newvalue)
;;|| *   (setint    Object "intfieldname"    newintvalue)
;;|| *   (setdouble Object "doublefieldname" newdoublevalue)
;;|| *   (getstatic "classname" "instancefieldname")
;;|| *   (setstatic "classname" "instancefieldname" newvalue)
;;|| *
;;|| * JAVA/SCHEME I/O INTERFACING
;;|| *   (exprToString E)
;;|| *   (stringToInputStream)
;;|| *   (openInputStream S)
;;|| *   (stringToInputPort x)
;;|| *   (loadFromPort P)
;;|| *
;;|| * METAINTERPRETATION

;;|| *   (newinterpreter)
;;|| *   (evalInInterpreter I Expr)
;;|| *   (applyInInterpreter I Fn Args)
;;|| *
;;|| * THREAD SUPPORT
;;|| *   (newthread Closure)
;;|| *
;;|| * AWT SUPPORT (EVENT HANDLING USING CLOSURES)
;;|| *   (eventwindow interpreter title)
;;|| *   (eventpanel interpreter)
;;|| *   (addcallback evtpanel evttype closure)
;;|| *   (addactioncallback evtwindow closure)
;;|| ****************************************************************
;;||
;;||


(display "Loading Jlib version 2.1,  12/June/1999") (newline)


;;; Load Java extensions into the interpreter.
;;; First we add the (constructor ....) procedures

(display "JLIB:.... loading auxilliary Java methods/constructors") (newline)


;;; Next we load in all of the helper methods and constructors:
;;;
;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.applet 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define java.applet.Applet.showStatus (method "showStatus" "java.applet.Applet" "java.lang.String"))
(define java.applet.Applet.getAppletContext (method "getAppletContext" "java.applet.Applet"))
(define java.applet.Applet.getParameter (method "getParameter" "java.applet.Applet" "java.lang.String"))

(define java.applet.AppletContext.showDocument (method "showDocument" "java.applet.AppletContext" "java.net.URL"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.awt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define java.awt.BorderLayout (constructor "java.awt.BorderLayout"))

(define java.awt.Button (constructor "java.awt.Button" "java.lang.String"))
(define java.awt.Button.getLabel        (method "getLabel"         "java.awt.Button"))
(define java.awt.Button.setLabel        (method "setLabel"         "java.awt.Button" "java.lang.String"))

(define java.awt.Canvas (constructor "java.awt.Canvas"))

(define java.awt.Choice (constructor "java.awt.Choice"))
(define java.awt.Choice.addItem (method "addItem" "java.awt.Choice" "java.lang.String"))
(define java.awt.Choice.getSelectedItem (method "getSelectedItem"  "java.awt.Choice"))

(define java.awt.Color (constructor "java.awt.Color" "int" "int" "int"))

(define java.awt.Component.resize (method "resize" "java.awt.Component" "int" "int"))
(define java.awt.Component.setFont (method "setFont" "java.awt.Component" "java.awt.Font"))

(define java.awt.Component.show (method "show" "java.awt.Component"))
(define java.awt.Component.hide (method "hide" "java.awt.Component"))
(define java.awt.Component.invalidate (method "invalidate" "java.awt.Component"))
(define java.awt.Component.repaint (method "repaint" "java.awt.Component"))
(define java.awt.Component.resize (method "resize" "java.awt.Component" "int" "int"))
(define java.awt.Component.repaint (method "repaint" "java.awt.Component"))
(define java.awt.Component.getGraphics (method "getGraphics" "java.awt.Component"))
(define java.awt.Component.setBackground (method "setBackground" "java.awt.Component" "java.awt.Color"))

(define java.awt.Container.add (method "add" "java.awt.Container" "java.awt.Component"))
(define java.awt.Container.getLayout (method "getLayout" "java.awt.Container"))
(define java.awt.Container.validate (method "validate" "java.awt.Container"))
(define java.awt.Container.setLayout (method "setLayout" "java.awt.Container" "java.awt.LayoutManager"))
(define java.awt.Container.add2 (method "add" "java.awt.Container" "java.lang.String" "java.awt.Component"))

(define java.awt.FlowLayout (constructor "java.awt.FlowLayout"))

(define java.awt.Font (constructor "java.awt.Font" "java.lang.String" "int" "int"))

(define java.awt.Frame.setMenuBar (method "setMenuBar" "java.awt.Frame" "java.awt.MenuBar"))

(define java.awt.Graphics.fillRect  (method "fillRect" "java.awt.Graphics" "int" "int" "int" "int"))
(define java.awt.Graphics.setColor (method "setColor" "java.awt.Graphics" "java.awt.Color"))


(define java.awt.GridBagConstraints (constructor "java.awt.GridBagConstraints"))

(define java.awt.GridBagLayout (constructor "java.awt.GridBagLayout"))
(define java.awt.GridBagLayout.setConstraints 
      (method "setConstraints" "java.awt.GridBagLayout" "java.awt.Component" "java.awt.GridBagConstraints"))

(define java.awt.GridLayout (constructor "java.awt.GridLayout" "int" "int"))

(define java.awt.Insets (constructor "java.awt.Insets" "int" "int" "int" "int"))

(define java.awt.Label (constructor "java.awt.Label" "java.lang.String"))
(define java.awt.Label.getText          (method "getText"          "java.awt.Label"))
(define java.awt.Label.setText          (method "setText"          "java.awt.Label" "java.lang.String"))

(define java.awt.Menu (constructor "java.awt.Menu" "java.lang.String"))
(define java.awt.Menu.add (method "add" "java.awt.Menu" "java.awt.MenuItem"))

(define java.awt.MenuBar (constructor "java.awt.MenuBar"))
(define java.awt.MenuBar.add (method "add" "java.awt.MenuBar" "java.awt.Menu"))

(define java.awt.MenuComponent.setFont (method "setFont" "java.awt.MenuComponent" "java.awt.Font"))

(define java.awt.MenuItem (constructor "java.awt.MenuItem" "java.lang.String"))
(define java.awt.MenuItem.getLabel (method "getLabel" "java.awt.MenuItem"))

(define java.awt.Panel (constructor "java.awt.Panel"))

(define java.awt.TextArea (constructor "java.awt.TextArea" "int" "int"))
(define java.awt.TextArea.appendText (method "appendText" "java.awt.TextArea" "java.lang.String"))
(define java.awt.TextArea.getText       (method "getText"          "java.awt.TextArea"))
(define java.awt.TextArea.setText       (method "setText"          "java.awt.TextArea" "java.lang.String"))

(define java.awt.TextField (constructor "java.awt.TextField" "java.lang.String" "int"))
(define java.awt.TextField.getText      (method "getText"          "java.awt.TextField"))
(define java.awt.TextField.setText      (method "setText"          "java.awt.TextField" "java.lang.String"))

(define java.awt.Window.pack (method "pack" "java.awt.Window"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.lang
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define java.lang.Class.getField (method "getField" "java.lang.Class" "java.lang.String"))
(define java.lang.Class.isInstance (method "isInstance" "java.lang.Class" "java.lang.Object"))

(define java.lang.Math.random (method "random" "java.lang.Math")) 

(define java.lang.Number.longValue (method "longValue" "java.lang.Number"))

(define java.lang.Object.toString (method "toString" "java.lang.Object"))
(define java.lang.Object.getClass (method "getClass" "java.lang.Object"))

(define java.lang.String.endsWith (method "endsWith" "java.lang.String" "java.lang.String"))
(define java.lang.String.copyValueOf  (method "copyValueOf" "java.lang.String" "[C"))
(define java.lang.String.toCharArray (method "toCharArray" "java.lang.String"))

(define java.lang.StringBuffer (constructor "java.lang.StringBuffer" "int"))
(define java.lang.StringBuffer.append (method "append" "java.lang.StringBuffer" "java.lang.String"))

(define java.lang.System.exit (method "exit" "java.lang.System" "int"))
(define java.lang.System.getProperty (method "getProperty" "java.lang.System" "java.lang.String"))

(define java.lang.Thread.start (method "start" "java.lang.Thread"))
(define java.lang.Thread.sleep (method "sleep" "java.lang.Thread" "long"))
(define java.lang.Thread.currentThread (method "currentThread" "java.lang.Thread"))
(define java.lang.Thread.suspend (method "suspend" "java.lang.Thread"))
(define java.lang.Thread.resume (method "resume" "java.lang.Thread"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.lang.reflect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define java.lang.reflect.Field.get (method "get" "java.lang.reflect.Field" "java.lang.Object"))
(define java.lang.reflect.Field.set (method "set" "java.lang.reflect.Field" "java.lang.Object" "java.lang.Object"))
(define java.lang.reflect.Field.setInt (method "setInt" "java.lang.reflect.Field" "java.lang.Object" "int"))
(define java.lang.reflect.Field.setBoolean (method "setBoolean" "java.lang.reflect.Field" "java.lang.Object" "boolean"))
(define java.lang.reflect.Field.setDouble (method "setDouble" "java.lang.reflect.Field" "java.lang.Object" "double"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.io
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define java.io.BufferedReader (constructor "java.io.BufferedReader" "java.io.Reader"))
(define java.io.BufferedReader.readLine (method "readLine" "java.io.BufferedReader"))

(define java.io.InputStreamReader (constructor "java.io.InputStreamReader" "java.io.InputStream"))

(define java.io.StringBufferInputStream (constructor "java.io.StringBufferInputStream" "java.lang.String"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; java.net
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define java.net.URL        (constructor "java.net.URL" "java.lang.String"))
(define java.net.URL2       (constructor "java.net.URL" "java.net.URL" "java.lang.String"))
(define java.net.URL3       (constructor "java.net.URL" "java.lang.String" "java.lang.String" "java.lang.String"))
(define java.net.URL.openStream (method "openStream" "java.net.URL"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; silk
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define silk.Scheme (constructor "silk.Scheme" "java.applet.Applet" "java.net.URL"))
(define silk.Scheme.load (method "load" "silk.Scheme" "silk.InputPort"))
(define silk.Scheme.eval (method "eval" "silk.Scheme" "java.lang.Object"))
(define silk.Scheme.apply (method "apply" "silk.Scheme" "silk.Procedure" "silk.Pair"))

(define silk.SchemeUtils.stringify  (method "stringify" "silk.SchemeUtils" "java.lang.Object"))
(define silk.SchemeUtils.stringify2 (method "stringify" "silk.SchemeUtils" "java.lang.Object" "boolean"))

(define silk.InputPort (constructor "silk.InputPort" "java.io.InputStream"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; jlib
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define jlib.ThreadClosure (constructor "jlib.ThreadClosure" "silk.Scheme" "silk.Procedure"))

(define jlib.EasyWin (constructor "jlib.EasyWin" "java.lang.String" "silk.Scheme"))
(define jlib.EasyWin.addActionCallback  (method "addActionCallback" "jlib.EasyWin" "silk.Procedure"))

(define jlib.EventPanel (constructor "jlib.EventPanel" "silk.Scheme"))
(define jlib.EventPanel.addCallback (method "addCallback" "jlib.EventPanel" "int" "silk.Procedure"))

(define jlib.ExceptionHandler (constructor "jlib.ExceptionHandler" "silk.Procedure" "silk.Procedure"))
(define jlib.ExceptionHandler.throwit (method "throwit" "jlib.ExceptionHandler" "java.lang.Throwable"))


(display "SILK extensions to Scheme") (newline)

;;|| ****************************************************************
;;|| * Some String conversion procedures: Scheme types <==> Java types
;;|| ****************************************************************

;;|| (stringToJstring S) ==> transforms the Scheme string S into a Java string 
;;||                         e.g. (stringToJstring "hello world") mainly needed to supply arguments to Java methods
    (define stringToJstring java.lang.String.copyValueOf)

;;|| (jstringToString J) ==> transforms the Java string J into a Scheme string 
;;||                     e.g. (jstringToString (readStringFromComponent mytextarea))  mainly needed to handle Java return values
    (define jstringToString java.lang.String.toCharArray )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * REFLECTION PROCEDURES
;;|| * these extend the Scheme ==> Java access functions to include
;;|| * access functions for instance and static variables
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;|| (getclass X)       ==> returns the class of the object X
;;||                        e.g. (getclass 123) or (getclass +)
    (define getclass java.lang.Object.getClass )


    ;; get/set the values of instance variables
;;|| (getfield X V)         ==> gets the value of the object X's variable V
;;||                       e.g. (getfield thisInterpreter "documentbase") to get the Scheme interpreter's documentbase
(define getfield 
   (lambda (ob fieldname)
     (java.lang.reflect.Field.get
        (java.lang.Class.getField (getclass ob) (stringToJstring fieldname)) 
         ob)))

;;|| (setfield X VAR VAL)   ==> sets the value of the object X's variable VAR to be VAL
;;||                       e.g. (setfield thisInterpreter "documentbase" U) to set the documentbase to be U
(define setfield
   (lambda (ob fieldname newvalue)
     (java.lang.reflect.Field.set
        (java.lang.Class.getField (getclass ob) (stringToJstring fieldname)) 
         ob
         newvalue)))

  ;; set value of an integer field
;;|| (setint X VAR VAL) ==> sets the value of an integer instance variable
;;||                        e.g. (setint gbc "gridx" 10) sets the variable gbc.gridx to 10
(define setint
   (lambda (ob fieldname newvalue)
     (java.lang.reflect.Field.setInt
        (java.lang.Class.getField (getclass ob) (stringToJstring fieldname)) 
         ob
         newvalue)))

  ;; set value of an double field
;;|| (setdouble X VAR VAL) ==> sets the value of a "double" instance variable
;;||                        e.g. (setdouble gbc "weightx" 1.0) sets the variable gbc.weightx to 1.0
(define setdouble
   (lambda (ob fieldname newvalue)
     (java.lang.reflect.Field.setDouble
        (java.lang.Class.getField (getclass ob) (stringToJstring fieldname)) 
         ob
         newvalue)))

    ;; get/set the values of static variables
;;|| (getstatic CLASSNAME VAR) ==> gets the value of the static variable VAR in the specified class,
;;||                               e.g. (getstatic "java.lang.Math" "PI") gets the value of PI
(define getstatic 
   (lambda (classname fieldname)
     (java.lang.reflect.Field.get
        (java.lang.Class.getField (class (stringToJstring classname)) (stringToJstring fieldname)) 
         "")))

;;|| (setstatic CLASSNAME VAR VAL) ==> sets the value of the static variable VAR, in the specified class, to VAL
;;||                               e.g. (setstatic "MyPackage.MyClass" "debug" #t) sets the debug field of MyClass to true.
(define setstatic 
   (lambda (classname fieldname newvalue)
     (java.lang.reflect.Field.set
        (java.lang.Class.getField (class (stringToJstring classname)) (stringToJstring fieldname)) 
         ""
         newvalue)))

  ;; set value of a static boolean field
;;|| (setboolean X VAR VAL) ==> sets the value of an integer instance variable
;;||                        e.g. (setint gbc "gridx" 10) sets the variable gbc.gridx to 10
(define setstaticboolean
   (lambda (classname fieldname newvalue)
     (java.lang.reflect.Field.setBoolean
        (java.lang.Class.getField (class (stringToJstring classname)) (stringToJstring fieldname)) 
         ""
         newvalue)))




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * Silk/Java 
;;|| * 
;;|| * 
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(define thisInterpreter this-interpreter)
(define thisApplet (getfield this-interpreter "applet"))
(define thisDocumentbase (getfield thisInterpreter "documentbase"))
(define thisEnvironment (getfield thisInterpreter "environment"))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * Java/Scheme I/O interface
;;|| * 
;;|| * 
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;|| (exprToString E)    ==> transforms the expression E into a Scheme string
;;||                         e.g. (exprToString (* 12345679 8))  mainly need to write expressions into textareas
(define exprToString 
        (lambda (x) (jstringToString (silk.SchemeUtils.stringify2 x #f))))

;;|| (exprToQuotedString E)    ==> transforms the expression E into a Scheme string
;;||                         e.g. (exprToString (* 12345679 8))  mainly need to write expressions into textareas
(define exprToQuotedString 
        (lambda (x) (jstringToString (silk.SchemeUtils.stringify2 x #t))))


;;|| (stringToInputStream S) ==> converts the string into an inputport
;;||                         e.g. (read (openInputStream (stringToInputStream (readStringFromComponent mytextarea))))
(define stringToInputStream java.io.StringBufferInputStream)

;;|| (openInputStream S) ==> creates an input port from and inputstream
;;||                         e.g. (read (openInputStream (stringToInputStream (readStringFromComponent mytextarea))))
(define openInputStream silk.InputPort)



;;|| (stringToInputPort S) ==> converts the string into an inputport
;;||                         e.g. (read (stringToInputPort (readStringFromComponent mytextarea)))
(define (stringToInputPort x)
  (openInputStream (stringToInputStream x)))

;;|| (loadFromPort port environment) ==> loads scheme code from the specified port, into the specified environment
;;||             e.g. (loadFromPort thisEnvironment (openInputStream (stringToInputStream "(define a 5)")))
(define loadFromPort silk.Scheme.load) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * Scheme evaluators
;;|| * 
;;|| * 
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;|| (newinterpreter) ==> creates a new scheme interpreter
;;||

(define newinterpreter
    (lambda ()
      (silk.Scheme thisApplet thisDocumentbase)))


;;|| (evalInInterpreter interp expr) ==> evaluate the expression in the interpreter
;;||             e.g. (evalInInterpreter thisInterpreter '(+ 1 2 3 4 5))
(define (evalInInterpreter interp x) 
  (silk.Scheme.eval interp x))

;;|| (applyInInterpreter INTERPRETER CLOSURE ARGLIST) ==> have the INTERPRETER apply the FUNCTION to the ARGLIST 
;;||          e.g. (apply thisInterpreter  + (list 1 2 3 4))
(define applyInInterpreter silk.Scheme.apply )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * Thread management
;;|| * 
;;|| * 
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;|| (newthread interpreter closure) ==> create a newthread which will run the closure (of no arguments)
;;||          e.g. (let ((start (method "start" "java.lang.Thread"))) (start (newthread thisInterpreter (lambda() (loop)))))
(define newthread jlib.ThreadClosure)




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * Exception Handling
;;|| * 
;;|| * 
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;|| (addErrorHandler proc handler) ==> extends a procedure by adding an error handler
;;||          e.g. (define URL (addErrorHandler java.net.URL (lambda (e U A) (reportError e U a) defaultURL)))
(define addErrorHandler jlib.ExceptionHandler)

;;|| (tryCatch Expression (lambda (e) Handler)) trys to evaluate Expr calls handler if an exeception, e, is thrown.
;;||          e.g. (define URL (addErrorHandler java.net.URL (lambda (e U A) (reportError e U a) defaultURL)))
;;(define-syntax tryCatch
;;  (lambda (Expr Handler)
;;     `((addErrorHandler (lambda () ,Expr) (let ((h ,Handler)) (lambda (e f a) (h e)))))))

;; this version can be handled by the compiler
(evalInInterpreter this-interpreter
  '(define-syntax tryCatch   
      (lambda (Expr Handler)      
        `((addErrorHandler (lambda () ,Expr) (let ((h ,Handler)) (lambda (e f a) (h e))))))))

;; note this is not hygenic in the sense that ,Handler could be equal to the symbol 'e at call time!

(define throw jlib.ExceptionHandler.throwit)

(define printSchemeStackTrace 
  (method "printSchemeStackTrace" "silk.SchemeException" "java.io.PrintWriter"))

(define (setDebugging b)  (setstaticboolean "silk.Code" "debugging" b))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;||
;;||
;;|| **************************************************************** 
;;|| * AWT Extensions
;;|| * 
;;|| * 
;;|| **************************************************************** 
;;||
;;||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(display "JLIB:.... loading awt extension procedures")  (newline)




;;|| (eventwindow X Y TITLE)  ==> creates a window of size XxY with given TITLE
;;||                         e.g. (define win (window 200 200 "win")) (show win)
(define eventwindow jlib.EasyWin)


;;|| (eventpanel interpreter)  ==> creates a panel that can respond to events using callbacks
;;||                         e.g. (define mypanel (eventpanel thisInterpreter))
(define eventpanel jlib.EventPanel)


;;|| (addcallback epanel evtype closure)  ==> adds a callback for events of that type
;;||                         e.g. (addcallback mypanel "action" (lambda(e) (hide win)))
(define addcallback jlib.EventPanel.addCallback ) 

;;|| (addactioncallback easywin closure)  ==> adds a callback for events of that type
;;||                         e.g. (addactioncallback win (lambda(e) (hide win)))
(define addactioncallback jlib.EasyWin.addActionCallback )

;;|| epMOUSEDOWN  eventpanel constant for specifying the type of action to handle
(define epMOUSEDOWN (getstatic "jlib.EventPanel" "MOUSEDOWN"))

;;|| epMOUSEUP  eventpanel constant for specifying the type of action to handle
(define epMOUSEUP (getstatic "jlib.EventPanel" "MOUSEUP"))

;;|| epMOUSEMOVE  eventpanel constant for specifying the type of action to handle
(define epMOUSEMOVE (getstatic "jlib.EventPanel" "MOUSEMOVE"))

;;|| epMOUSEDRAG  eventpanel constant for specifying the type of action to handle
(define epMOUSEDRAG (getstatic "jlib.EventPanel" "MOUSEDRAG"))


;;||
;;|| **************************************************************** 
;;|| * Applet class methods
;;|| * these provide access to various useful Applet methods
;;|| **************************************************************** 
;;||



(define appletcontext 
  (if (null? thisApplet) () 
    (java.applet.Applet.getAppletContext thisApplet)))

;;|| (writeToStatusBar TEXT) ==> this writes the TEXT to the browser status bar
;;||                         e.g. (writeToStatusBar "loading JLIB, please wait....")

(define writeToStatusBar
    (lambda (x)
       (display x) (newline)
       (if (null? thisApplet) '()
           (java.applet.Applet.showStatus thisApplet (stringToJstring x)))))
           



;;|| (showdocument URLstring) ==> this makes the browser display the specified URL
;;||                        e.g. (showdocument "http://java.sun.com")

(define showdocument
    (lambda (x)
       (if (null? thisApplet) '()
           (java.applet.AppletContext.showDocument 
                 appletcontext 
                 (java.net.URL x))
       )))


;;|| (showreldocument RELURLstring) ==> this makes the browser display the specified URL
;;||                        e.g. (showreldocument "../demos/silkGUI.scm")
(define showreldocument
  (lambda (x)
    (java.applet.AppletContext.showDocument 
          appletcontext 
          (java.net.URL2 thisDocumentbase x))))


;;|| (getparameter PARAMname) ==>
;;||                 e.g. (getparameter "prog")
(define getparameter
   (lambda (x)
    (if (null? applet) '()
        (let ((param (java.applet.Applet.getParameter thisApplet x )))
           (if (null? param) () (jstringToString param))))))

;;||
;;|| **************************************************************** 
;;|| * COMPONENT constructors
;;|| * these provide access to all of the Java AWT components
;;|| **************************************************************** 
;;||
(writeToStatusBar "JLIB:.... loading library functions")
;;    (writeToStatusBar "JLIB:.... loading Component constructors")



;;|| (window X Y TITLE . Components)  ==> creates a window given size, title, components
;;||                         e.g. (define win (window 200 200 "win" (label "Hi"))) (show win)
(define window
    (lambda (x y title . components)
       (begin 
         (define win (eventwindow (stringToJstring title) thisInterpreter))
         (java.awt.Component.resize win x y)
         (addlist win components)
         win)))



;;|| (label TEXT)            ==> creates a label with the specified TEXT
;;||                             e.g. (add@ win (label "My Demo"))  (validate win)
(define label java.awt.Label)


;;|| (textarea ROWS COLS)   ==> creates a textarea with the specified numbers of ROWS and COLS
;;||                             e.g. (define ta (textarea 10 80)) (add@ win ta)
(define textarea java.awt.TextArea)


;;|| (button TEXT)          ==> creates a button with the specified TEXT
;;||                            e.g. (pad (button "quit") (lambda () (hide win)))
(define button java.awt.Button)


;;|| (colorbutton TEXT R G B) ==> creates a colored button with the specified TEXT
;;||                            e.g. (define zz (colorbutton "eval" 100 100 255))
(define (colorbutton string x y z)
  (define b (button string))
  (setcolor b x y z)
  b)



;;|| (textfield TEXT COLS)  ==> creates a textfield with the specified TEXT and number of COLS
;;||                            e.g. (define tf (textfield "" 20))
(define textfield java.awt.TextField)



;;|| (choice C1 C2 ... CN)  ==> creates a choice component with choices C1 C2 ... Cn
;;||                            e.g. (define demos (choice "bmi.scm" "calc.scm" "paint.scm"))

(define choice 
  (lambda cs
     (define ch (java.awt.Choice))
     (for-each (lambda (s) (java.awt.Choice.addItem ch s))  cs)
                ch))


;;|| (canvas)               ==> creates a canvas component
;;||                            e.g. (define cc (canvas))
(define canvas java.awt.Canvas)



;;||
;;|| ****************************************************************
;;|| *  Component visibility methods
;;|| ****************************************************************
;;||

(writeToStatusBar "JLIB:.... loading Component visibility methods")

;;|| (show COMPONENT) ==> make COMPONENT visible
(define show java.awt.Component.show)

;;|| (hide COMPONENT) ==> make COMPONENT invisible
(define hide java.awt.Component.hide )

;;|| (repaint COMPONENT) ==> redraw COMPONENT
(define repaint java.awt.Component.repaint )

;;|| (resize COMPONENT W H) ==> change the COMPONENTS size to WxH pixels
(define resize java.awt.Component.resize )

;;|| (validate CONTAINER) ==> redraw all components in the container
(define validate java.awt.Container.validate )

;;|| (invalidate COMPONENT) ==> invalidate the comp. and its ancestors
(define invalidate java.awt.Component.invalidate )

;;|| (pack WINDOW) ==> resize the window to its minimal viewable size
(define pack java.awt.Window.pack )


;;||
;;|| ****************************************************************
;;|| * Querying the type of a Component
;;|| ****************************************************************
;;||
(writeToStatusBar "JLIB:.... loading Component type predicates")



(define frameClass    (class "java.awt.Frame"))
(define buttonClass    (class "java.awt.Button"))
(define labelClass     (class "java.awt.Label"))
(define textFieldClass (class "java.awt.TextField"))
(define textAreaClass  (class "java.awt.TextArea"))
(define choiceClass    (class "java.awt.Choice"))

;;|| (window? COMPONENT) ==> returns #t if COMPONENT is a framed window
(define (window? x)    (eq? (getclass x) frameClass))
(define (button? x)    (eq? (getclass x) buttonClass))
(define (label? x)     (eq? (getclass x) labelClass))
(define (textfield? x) (eq? (getclass x) textFieldClass))
(define (textarea? x)  (eq? (getclass x) textAreaClass))
(define (choice? x)    (eq? (getclass x) choiceClass))


;;||
;;|| ****************************************************************
;;|| * Reading/Writing text on components
;;|| ****************************************************************
;;||
(writeToStatusBar "JLIB:.... loading Component read/write procedures")

;;|| (readStringFromComponent COMPONENT) ==> returns the string labelling the COMPONENT
;;||        e.g. (writeStringToComponent TA (readStringFromComponent MyChoice))
(define readStringFromComponent 
  (lambda (comp)
   (jstringToString
    (cond 
          ((label? comp)       (java.awt.Label.getText          comp))
          ((button? comp)      (java.awt.Button.getLabel        comp))
          ((textfield? comp)   (java.awt.TextField.getText      comp))
          ((textarea? comp)    (java.awt.TextArea.getText       comp))
          ((choice? comp)      (java.awt.Choice.getSelectedItem comp))
          (else "")))))
          

;;|| (writeStringToComponent COMPONENT STRING) ==> write the STRING onto the COMPONENT
;;||               e.g. (writeStringToComponent MyLabel "You are correct!")
(define (writeStringToComponent comp text)
   (cond 
          ((label? comp)       (java.awt.Label.setText          comp text))
          ((button? comp)      (java.awt.Button.setLabel        comp text))
          ((textfield? comp)   (java.awt.TextField.setText      comp text))
          ((textarea? comp)    (java.awt.TextArea.setText       comp text))
          (else "")))
          

;;|| (appendStringToComponent COMPONENT TEXT) ==> appends the TEXT to the COMPONENT's label
;;||                   e.g. (appendStringToComponent RESULTS (exprToString (evaluate (readStringFromComponent USERWIN))))


(define (appendStringToComponent ta s)
  (if (textarea? ta)
      (java.awt.TextArea.appendText ta s)
      (writeStringToComponent ta (string-append (readStringFromComponent ta) s))))


;;|| newlinestring ==> A constant string containing the newline character
;;||               e.g. (appendStringToComponent RESULTS "yes") (appendStringToComponent RESULTS newlinestring)
(define newlinestring (make-string 1 #\newline))


;;|| (toString@ X) ==> invokes the Object method X.toString() and converts to a String
;;||               e.g. (appendStringToComponent RESULTS "yes") (appendStringToComponent RESULTS newlinestring)

(define (toString@ x)
  (jstringToString 
    (java.lang.Object.toString x)))


;;|| (readString COMPONENT) ==> reads a string from the COMPONENT
;;||      e.g. (if (equal? (readString mytext) "run system") (runSystem))
(define (readString x) (readStringFromComponent x))

;;|| (stringToExpr STRING) ==> converts a string into a Scheme object
;;||  (define (myReadExpr COMPONENT) (stringToExpr (readString COMPONENT)))
(define (stringToExpr x) (read (openInputStream (stringToInputStream x))))

;;|| (readExpr COMPONENT) ==> reads a Scheme term from the componenet
;;||    e.g. (if (< (readExpr userInput) 0) (writeExpr errors "Only positive values allowed"))
(define (readExpr x) 
  (stringToExpr (readStringFromComponent x)))

;;|| (readList COMPONENT) ==> returns a list of all Scheme terms that are written on the COMPONENT
;;||   e.g. (if (null? (readList userInput)) (writeExpr errors "You must enter a value"))
(define (readList x)
  (define (readLoop inport)
    (let ((x (read inport)))
       (if (eof-object? x) ()
           (cons x (readLoop inport)))))
  (readLoop 
    (openInputStream 
      (stringToInputStream (readStringFromComponent x)))))



;;|| (writeExpr COMPONENT EXPRESSION) ==> evaluates the Scheme EXPRESSION and writes the result on the COMPONENT
(define (writeExpr c e)
  (writeStringToComponent c (exprToString e)))

;;|| (writelnExpr COMPONENT EXPRESSION) ==> same as writeExpr but the writes a newline
(define (writelnExpr c e) 
  (writeStringToComponent c (string-append (exprToString e) newlinestring)))

;;|| (appendExpr COMPONENT EXPRESSION) ==> evaluates the expressions and appends the result to the COMPONENT
(define (appendExpr ta e)
  (appendStringToComponent ta (exprToString e)))

;;|| (appendlnExpr COMPONENT EXPRESSION) ==> evaluates the expressions and 
;;||                                         appends the result and a newline to the COMPONENT
(define (appendlnExpr ta e)
  (appendStringToComponent ta (string-append (exprToString e) newlinestring)))








;;||
;;|| ****************************************************************
;;|| * General Container and LayoutManager constructors and methods
;;|| *   containers are components that can hold other components
;;|| *   each container has a layout manager that specifies how
;;|| *   the elements are to be arranged when the container's size changes
;;|| ****************************************************************
;;||

(writeToStatusBar "JLIB:.... loading general Container procedures")



;;|| (setlayout CONTAINER LAYOUTMANAGER) ==> sets the containers layout to the specified manager
;;||                          e.g. (setlayout win (gridlayout 1 1))
(define setlayout java.awt.Container.setLayout )


;;|| (gridlayout R C)      ==> create a GridLayout manager with R rows and C cols
;;||                       e.g. (define g2x2 (gridlayout 2 2))
(define gridlayout java.awt.GridLayout)

;;|| (flowlayout)          ==> create a FlowLayout manager
;;||                       e.g. (setlayout win (flowlayout))
(define flowlayout java.awt.FlowLayout)

;;|| (borderlayout)          ==> create a BorderLayout manager
;;||                       e.g. (setlayout win (flowlayout))
(define borderlayout java.awt.BorderLayout)

;;|| ** CONSTANTS used in Borderlayouts

;;||    BLNORTH
(define BLNORTH  (stringToJstring "NORTH"))

;;||    BLSOUTH
(define BLSOUTH  (stringToJstring "SOUTH"))

;;||    BLEAST
(define BLEAST   (stringToJstring "EAST"))

;;||    BLWEST
(define BLWEST   (stringToJstring "WEST"))

;;||    BLCENTER
(define BLCENTER (stringToJstring "CENTER"))

;;|| (BLadd CONTAINER POSITION COMPONENT) ==> add the component to the Border container as specified
;;||                     e.g.  (BLadd win BLNORTH (label "My Demo"))
(define BLadd java.awt.Container.add2 )



;;|| (panel LAYOUTMANAGER) ==> create a generic container with the specified manager
;;||                           e.g. (define p (panel g2x2))

(define (panel layoutmanager)
    (define p (java.awt.Panel))
    (setlayout p layoutmanager)
     p)


;;|| (addlist CONTAINER COMPONENTLIST) ==> adds the components in the LIST to the container
;;||                   e.g. (addlist win (list (label "Yin") (label "Yang")))


(define (addlist container components)
  (for-each (lambda (x) (java.awt.Container.add container x)) components)
   container)

;;|| (add@ CONTAINER A1 A2 ... An) ==> add the components A1, A2, ... An to the CONTAINER
;;||              e.g. (add@ win (add@ p (label "NW") (label "NE") (label "SW") (label "SE")))
(define add@ 
  (lambda (container . components) 
    (addlist container components)))


;;||
;;||
;;|| ****************************************************************
;;|| *             GrigBagLayout constructors and methods
;;|| * this is the most complex and versatile of the layout managers
;;|| ****************************************************************
;;||
;;||

(writeToStatusBar "JLIB:.... loading GridBagLayout procedures")



;;||   (gridbaglayout) ==> create a gridbaglayout manager
;;||                       e.g. (define p (panel (gridbaglayout)))
(define gridbaglayout java.awt.GridBagLayout)

;;||   (gridbagpanel) ==> create a panel with a gridbaglayout manager
;;||                       e.g. (define p (gridbagpanel))
(define (gridbagpanel)
  (panel (gridbaglayout)))

;;||   (gridbagconstraints GRIDX GRIDY GRIDWIDTH GRIDHEIGHT FILL IPADX IPADY T L B R ANCHOR WEIGHTX WEIGHTY)
;;||                 ==> creates a gridbaglayout constraints object specifying where a component will go
;;||                     (GRIDX,GRIDY) is the upper left corner of the component
;;||                     (GRIDWIDTH,GRIDHEIGHT) is the number of cols and rows the component's gridbox will span
;;||                     FILL specifies how the component will fill its gridbox
;;||                     (IPADX, IPADY) specifies the number of pixel the component should be stretched or shrunk in each direction
;;||                     (T,L,B,R) specifies the insets, i.e. the  space around the Top, Left, Bottom, and Right edges of the gridbox
;;||                     ANCHOR specifies how the component should be aligned in its gridbox
;;||                     (WEIGHTX,WEIGHTY) specify the relative proportion this gridbox should grow when the container grows
;;||                               You should look at the Java documentation for more details
;;||                 e.g. (define myconstraints (gridbagconstraints 2 5 1 4 GBCHORIZONTAL 1 1 5 5 5 5 GBCCENTER 1.0 1.0))

(define gridbagconstraints 
    (lambda (gridx gridy gridwidth gridheight fill ipadx ipady insetT insetL insetB insetR anchor weightx weighty)
      (define gbc (java.awt.GridBagConstraints))
      (setint gbc "gridx" gridx)
      (setint gbc "gridy" gridy)
      (setint gbc "gridwidth" gridwidth)
      (setint gbc "gridheight" gridheight)
      (setint gbc "fill" fill)
      (setint gbc "ipadx" ipadx)
      (setint gbc "ipady" ipady)
      (setfield gbc "insets" (java.awt.Insets insetT insetL insetB insetR))
      (setint gbc "anchor" anchor)
      (setdouble gbc "weightx" weightx)
      (setdouble gbc "weighty" weighty)
      gbc
))


;;||
;;|| **************************************************************** 
;;|| ** GridBagConstraints constants, used to specify the ANCHOR constraints
;;|| **************************************************************** 

;;||       GBCCENTER
(define GBCCENTER     (getstatic "java.awt.GridBagConstraints" "CENTER"))

;;||       GBCNORTH
(define GBCNORTH      (getstatic "java.awt.GridBagConstraints" "NORTH"))

;;||       GBCNORTHEAST
(define GBCNORTHEAST  (getstatic "java.awt.GridBagConstraints" "NORTHEAST"))

;;||       GBCEAST
(define GBCEAST       (getstatic "java.awt.GridBagConstraints" "EAST"))

;;||       GBCSOUTHEAST
(define GBCSOUTHEAST  (getstatic "java.awt.GridBagConstraints" "SOUTHEAST"))

;;||       GBCSOUTH
(define GBCSOUTH      (getstatic "java.awt.GridBagConstraints" "SOUTH"))

;;||       GBCSOUTHWEST
(define GBCSOUTHWEST  (getstatic "java.awt.GridBagConstraints" "SOUTHWEST"))

;;||       GBCWEST
(define GBCWEST       (getstatic "java.awt.GridBagConstraints" "WEST"))

;;||       GBCNORTHWEST
(define GBCNORTHWEST  (getstatic "java.awt.GridBagConstraints" "NORTHWEST"))

;;|| **************************************************************** 
;;|| ** GridBagConstraints constants, used to specify the FILL constraints
;;|| **************************************************************** 
;;||       GBCBOTH
(define GBCBOTH       (getstatic "java.awt.GridBagConstraints" "BOTH"))
;;||       GBCHORIZONTAL
(define GBCHORIZONTAL (getstatic "java.awt.GridBagConstraints" "HORIZONTAL"))
;;||       GBCVERTICAL
(define GBCVERTICAL   (getstatic "java.awt.GridBagConstraints" "VERTICAL"))
;;||       GBCNONE
(define GBCNONE       (getstatic "java.awt.GridBagConstraints" "NONE"))

;;|| **************************************************************** 
;;|| ** GridBagConstraints constant, used to specify the GRIDX, GRIDY constraints
;;|| ****************************************************************
;;||  GBCRELATIVE ==>  If the value is GBCRELATIVE, then the component will go in the next
;;||                    available row or column (depending on which one is GBCRELATIVE)
(define GBCRELATIVE   (getstatic "java.awt.GridBagConstraints" "RELATIVE"))

;;||  
;;|| **************************************************************** 
;;|| ** GridBagConstraints constant, used to specify the GRIDWIDTH, GRIDHEIGHT constraints
;;|| **************************************************************** 
;;||   GBCREMAINDER ==>  if the gridwidth or gridheight value is GBCREMAINDER, 
;;||                     then the component must be the last on a row or column, 
;;||                     and it will take all remaining space on that  row or column.
(define GBCREMAINDER  (getstatic "java.awt.GridBagConstraints" "REMAINDER"))


;;||   
;;||   (gbAddWithConstraints CONTAINER CONSTRAINTS COMPONENT) ==> add the COMPONENT to the CONTAINER with the specified CONSTRAINTS
;;||                       e.g. (gbAddWithConstraints mypanel myconstraints (label "Main Console"))

(define (gbAddWithConstraints panel gb gbc cs)
  (for-each
     (lambda (x) 
        (java.awt.GridBagLayout.setConstraints gb x gbc)
        (java.awt.Container.add panel x))
     cs))



;;||   (gbadd PANEL X Y W H WX WY ANCHOR FILL COMPONENT) ==> this adds the COMPONENT to the PANEL with the specified constraints
;;||                    e.g.  (gbadd p 1 4 1 1 0.0 0.0 GBCCENTER GBCNONE (setfont (label "Program:") "SansSerif" 0 18))
(define gbadd 
   (lambda (panel x y w h wx wy anchor fill c)
      (java.awt.GridBagLayout.setConstraints 
          (java.awt.Container.getLayout panel) 
          c 
          (gridbagconstraints x y w h fill 1 1 5 5 5 5 anchor wx wy))
      (java.awt.Container.add panel c)
))


;;||   
;;|| **************************************************************** 
;;|| * THREE SIMPLE CONTAINER OBJECTS
;;|| * The following containers allow you to layout components in
;;|| * grids, rows, and columns and can be embedded.
;;|| * They are often all that is needed for simple layouts.
;;|| **************************************************************** 
;;||

(writeToStatusBar "JLIB:.... ROW/COL/GRID procedures")


;;||
;;|| (grid R C A1 A2 ... An) ==> create an RxC grid panel containing the components A1,...,An
;;||                         e.g.(add@ win (grid 2 2 (label "NW") (label "NE") (label "SW") (label "SE")))
(define grid 
 (lambda (x y . Cs)
   (define g (panel (gridlayout x y)))
   (addlist g Cs)
   g
 )
)


;;|| (row A1 A2 ... An) ==> create a horizontal panel containing the components A1 A2 ...
;;||                    e.g. (add@ win (row (button "a") (button "b") (choice "c" "d" "e")))
(define row 
  (let ((rowgridbag (gridbagconstraints GBCRELATIVE 0            1 1 GBCNONE 1 1 5 5 5 5 GBCWEST 0.0 0.0)))
    (lambda cs
      (define gbl (gridbaglayout))
      (define g (panel gbl))
      (gbAddWithConstraints g gbl rowgridbag cs)
      g)))



;;|| (col A1 A2 ... An) ==> create a vertical panel containing the components A1 A2 ...
;;||                    e.g. (add@ win (col (button "a") 
;;||                                       (row (button "b") (button "c"))
;;||                                       (choice "c" "d" "e")))
(define col 
  (let ((colgridbag (gridbagconstraints 0            GBCRELATIVE 1 1 GBCNONE 1 1 5 5 5 5 GBCWEST 0.0 0.0)))
    (lambda cs
      (define gbl (gridbaglayout))
      (define g (panel gbl))
      (gbAddWithConstraints g gbl colgridbag cs)
      g)))







;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;|| ****************************************************************
;;|| *
;;|| * Miscellaneous Methods 
;;|| *
;;|| ****************************************************************
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
(writeToStatusBar "JLIB:.... loading GRAPHICS procedures")



;;|| (getgraphics COMPONENT) ==> gets the graphics context object of a given COMPONENT
;;||                          e.g. (setdrawingcolor (getGraphics win) (color 100 100 150)) 
    (define getgraphics java.awt.Component.getGraphics )

;;|| (fillrect GRAPHICSCONTEXT X Y W H) ==> draws a filled rectangle in the specified context
;;||                          e.g. (fillrect (getGraphics win) 100 100 50 5)
    (define fillrect java.awt.Graphics.fillRect  )

;;|| (random) ==> generates a "random" number between 0.0 and 1.0
;;||                          e.g. (define pickme (round (* 100 (random))))
    (define random java.lang.Math.random)

;;|| (setdrawingcolor GRAPHICSCONTEXT COLOR) ==> sets the COLOR to be used to draw in the CONTEXT
;;||                          e.g. (setdrawingcolor (color 0 0 250))
    (define setdrawingcolor java.awt.Graphics.setColor )

;;|| (repaint COMPONENT) ==> redraws the component
;;||                          e.g. (repaint win)
    (define repaint java.awt.Component.repaint )

;;|| (exit N) ==> causes the interpreter to halt and returns the value N to the operating system
;;||                          e.g. (exit 0) successfully ends an application
    (define exit java.lang.System.exit )

;;|| (getSystemProperty NAME) ==> returns the value of the named property
;;||                           e.g. (getSystemProperty "os.name") returns the name of the operating system
    (define getSystemProperty java.lang.System.getProperty )

;;|| (font NAME STYLE SIZE) ==> returns the font with the given NAME, STYLE, and SIZE
;;||                        e.g. (font "TimesRoman" 0 12) returns the plain TimesRoman 12pt font
    (define font java.awt.Font)



;;|| ****************************************************************
;;|| * Color management
;;|| ****************************************************************

;;|| (color R G B) ==> create the color from RGB in the range 0 to 255
;;||          e.g. (setbackground mywin (color 100 200 100))
(define color java.awt.Color)

;;|| (setbackground COMPONENT COLOR) ==> sets the background COLOR of a COMPONENT
;;||          e.g. (setbackground quitbutton (color 255 0 0))
(define setbackground java.awt.Component.setBackground )

;;|| (setcolor COMPONENT x y z) ==> set the background color of COMPONENT to RGB, returns COMPONENT
;;||          e.g. (setcolor quitbutton 255 0 0)
(define (setcolor component x y z)
  (setbackground component (color x y z))
  component)

;;|| ****************************************************************
;;|| * Thread management
;;|| ****************************************************************

;;|| (runthread PROCEDURE) ==> this runs the PROCEDURE (which must have no arguments) as a thread
;;||              e.g. (runthread turtle1) (runthread turtle2) (runthread turtle3)

(define (runthread closure)
   (java.lang.Thread.start (newthread thisInterpreter closure)))

;;|| (sleep N) ==> causes the current thread to sleep for N milliseconds
;;||             e.g. (sleep 100)  causes interpreter to sleep for 0.1 seconds

(define (sleep n)
  (java.lang.Thread.sleep (java.lang.Number.longValue n)))

;;|| (currentthread) ==> this returns the currently executing thread
;;||       e.g. (display (currentthread))
(define currentthread java.lang.Thread.currentThread )

;;|| (suspend THREAD) ==> this suspends the specified THREAD
;;||       e.g. (suspend (currentthread))
(define suspend java.lang.Thread.suspend)

;;|| (resume THREAD) ==> this causes the THREAD to resume
;;||       e.g. (define x (currenthread)) (runthread (lambda() (sleep 1000) (resume x))) (suspend x)
(define resume java.lang.Thread.resume )

;;||
;;|| ****************************************************************
;;|| * Font management 
;;|| ****************************************************************
;;||

;;|| (setfont Component FONTNAME STYLE SIZE) ==> sets the font of a component
;;||             e.g. (setfont (label "My Demo") "SansSerif" fontBbold 24)
(define (setfont comp fontname style size)
   (java.awt.Component.setFont comp (java.awt.Font fontname style size))
    comp)

;;|| ** Constants used to specify font styles:
;;|| fontPlain
(define fontPlain (getstatic "java.awt.Font" "PLAIN"))

;;|| fontBold
(define fontBold (getstatic "java.awt.Font" "BOLD"))

;;|| fontItalic
(define fontItalic (getstatic "java.awt.Font" "ITALIC"))



;;|| ****************************************************************
;;|| *  Menu Constructors and Methods
;;|| ****************************************************************
;;||

(writeToStatusBar "JLIB:.... loading MENU procedures")


    (define menufont (font "Helvetica" 0 12))



;;|| (menuitem NAME FONT) ==> this creates a menuitem with the specified NAME and FONT
(define (menuitem  str menufont)      
    (define x (java.awt.MenuItem str))
    (java.awt.MenuComponent.setFont x menufont) 
    x)



;;|| (menu TITLE M1 M2 ... Mn) ==> create a menu with given TITLE containing strings or submenus M1,...,Mn
;;||                e.g. (define demomenu (menu "Demos" (menu "TESTS" "r4rstest.scm") (menu "SIMPLE" "hi.scm" "bye.scm") "winGUI.scm"))

(define stringClass (class "java.lang.String"))
(define charArrayClass (class "[C"))

(define menu
    (lambda (t . cs)
       (define ch (java.awt.Menu t))
       (java.awt.MenuComponent.setFont ch menufont)
       (for-each (lambda (s) 
                     (if (eq? (getclass s) stringClass)
                         (java.awt.Menu.add ch (menuitem s menufont))
                         (if (eq? (getclass s) charArrayClass)
                             (java.awt.Menu.add ch (menuitem s menufont))
                             (java.awt.Menu.add ch s))))
                 cs)
       ch))

;;|| (menubar M1 M2 ... Mk) ==> create a menubar with the specified sub menus M1,...,Mk
;;||               (define MB (menubar filemenu demomenu))

(define menubar
  (lambda cs
     (define ch (java.awt.MenuBar))
     (for-each (lambda (s) (java.awt.MenuBar.add ch  s)) cs)
     ch))

;;|| (setmenubar WINDOW MENUBAR) ==> sets the menubar of the WINDOW to be MENUBAR
;;||                 e.g. (setmenubar win MB)
(define setmenubar java.awt.Frame.setMenuBar) 

;;|| (addMenuAction WINDOW CALLBACK) ==> installs the specified callback as the menu event handler
;;||                 e.g. (addMenuAction win menuaction)
(define addMenuAction addactioncallback)

;;|| (getmenuselection EVENT) ==> returns the menu string that was selected
;;||                     (define menuaction (lambda (e) (process (getmenuselection e))))

(define (getmenuselection e)
  (jstringToString (java.awt.MenuItem.getLabel (getfield e "target"))))


;;||
;;|| ****************************************************************
;;|| * EventPanel methods and constructors 
;;|| * these methods allow one to use closures to handle events in a Component
;;|| ****************************************************************
;;||



(writeToStatusBar "JLIB:.... loading EVENT HANDLING procedures")


;;|| (target event) ==> this returns the target of the event, e.g. the button pushed
;;||                      (pad (button "Hello") (lambda (e) (displayExpr (target e) "Hi")))
(define (target e) (getfield e "target"))


;;|| (pad COMPONENT EVENTHANDLER) ==> this creates a panel containing only the COMPONENT
;;||                                 and the action events are handled by the EVENTHANDLER
;;||                                 the EVENTHANDLER must be a procedure of the type
;;||                                     (lambda (event) expressions)
;;||                                 where "event" is the action event to be handled.
;;||           e.g. (pad (button "help") (lambda (e) (show helpwindow)))

(define pad 
  (lambda (component callback)
    (define p (eventpanel thisInterpreter))
    (setlayout p (gridlayout 1 1))
    (add@ p component)
    (addcallback p 1 callback)
    p))

;;|| (mousepad COMPONENT DOWN UP DRAG MOVE)
;;||        ==> this defines a pad containing a component (typically a canvas)
;;||            which can respond to mouse events, mouse down, up, drag, and move
;;||            The event handlers DOWN, UP, DRAG, MOVE are procedures of the type
;;||                    (lambda (event x y) expressions)
;;||            where "event" is the mouse event to be handled, and (x,y) are
;;||            current coordinates of the mouse
;;|| e.g. (add@ win (mousepad mycanvas (lambda (e x y) (drawcircle x y mycanvas) nop3 nop3 nop3)))
(define mousepad 
  (lambda (component downcallback upcallback dragcallback movecallback)
    (define p (eventpanel thisInterpreter))
    (setlayout p (gridlayout 1 1))
    (add@ p component)
    (addcallback p epMOUSEDOWN downcallback)
    (addcallback p epMOUSEUP upcallback)
    (addcallback p epMOUSEDRAG dragcallback)
    (addcallback p epMOUSEMOVE movecallback)
    p))



(writeToStatusBar "JLIB:.... loading COLOR, FONT,THREAD management procedures")

;;||
;;|| ****************************************************************
;;|| * Network management
;;|| * these load into the Scheme system bound to "interpreter"
;;|| ****************************************************************
;;||


(writeToStatusBar "JLIB:.... loading NETWORK management procedures")


;;|| (loadurl URLNAME) ==> loads scheme program off net from specified URL
;;||              e.g. (loadurl (string-append (toString@ thisDocumentbase) "helloworld.scm"))


(define (loadURL urlname)
  (loadFromPort 
     thisEnvironment
    (openInputStream 
      (java.net.URL.openStream 
        (java.net.URL
          urlname)))))

;;|| baseURL ==> this is the base url used by relativeURL. Initially documentbase or user.dir.
;;||              e.g. (set! baseURL .....) (loadurl (relativeURL "bmi.scm"))



(define baseURL
  (if (null? thisApplet) 
      (java.net.URL3
          "file" "localhost" 
          (let ((user.dir (getSystemProperty "user.dir")))
               (if (equal? #f (java.lang.String.endsWith user.dir "/")) 
                   (string-append user.dir "/") 
                   user.dir)))
      thisDocumentbase))

;;|| (relativeURL URLstring) ==> creates a URL object relative to the documentbase 
;;||             e.g. (readURLtoString (relativeURL "../demos/maptest.scm"))

(define (relativeURL x)
  (java.net.URL2 baseURL x))

;;|| (url URLstring) ==> creates a URL object given the specificaiton
;;||             e.g. (readURLToString (url "http://www.cs.brandeis.edu/~tim/Packages/jlib/demos/maptest.scm"))
(define url java.net.URL)

;;|| (readURLToString URL) ==> reads text from named relative URL into a string
;;||             e.g. (readURLToString (url "http://www.cs.brandeis.edu/~tim/Packages/jlib/demos/maptest.scm"))


  

(define (readURLToString url)

  (define reader 
      (java.io.BufferedReader
         (java.io.InputStreamReader
            (java.net.URL.openStream
               url))))

  (define (readloop sb)
    (define x (java.io.BufferedReader.readLine reader))
    (if (null? x) sb
        (readloop 
           (java.lang.StringBuffer.append
               (java.lang.StringBuffer.append sb x)
                newlinestring))))

  (jstringToString
    (toString
      (readloop
        (java.lang.StringBuffer 8192))))
)

        
(writeToStatusBar "JLIB:.... done loading")