[j-devel] Swing example

[<as...@pr...>]

Here's a Lisp version of

http://java.sun.com/docs/books/tutorial/uiswing/mini/example-1dot3/SwingApplication.java

to illustrate the new event handling stuff. It's a bit more eventful
than the original, but otherwise a literal translation. It's not meant
to be an example of good Java-in-Lisp style.

Andras


;;; Copyright (c) 1997-1999 by Sun Microsystems, Inc. All Rights Reserved.
;;;
;;; Sun grants you ("Licensee") a non-exclusive, royalty free, license to use,
;;; modify and redistribute this software in source and binary code form,
;;; provided that i) this copyright notice and license appear on all copies of
;;; the software; and ii) Licensee does not utilize the software in a manner
;;; which is disparaging to Sun.
;;;
;;; This software is provided "AS IS," without a warranty of any kind. ALL
;;; EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, INCLUDING ANY
;;; IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE OR
;;; NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN AND ITS LICENSORS SHALL NOT BE
;;; LIABLE FOR ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING
;;; OR DISTRIBUTING THE SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN OR ITS
;;; LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR FOR DIRECT,
;;; INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE DAMAGES, HOWEVER
;;; CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, ARISING OUT OF THE USE OF
;;; OR INABILITY TO USE SOFTWARE, EVEN IF SUN HAS BEEN ADVISED OF THE
;;; POSSIBILITY OF SUCH DAMAGES.
;;;
;;; This software is not designed or intended for use in on-line control of
;;; aircraft, air traffic, aircraft navigation or aircraft communications; or in
;;; the design, construction, operation or maintenance of any nuclear
;;; facility. Licensee represents and warrants that it will not use or
;;; redistribute the Software for such purposes.

(in-package :cl-user)

(defun create-components ()
  (let* ((num-clicks 0)
          (panel-constructor (jconstructor "javax.swing.JPanel"))
          (pane (jnew panel-constructor))
          (border
            (jstatic
              (jmethod "javax.swing.BorderFactory" "createEmptyBorder" "int" "int" "int" "int")
              "javax.swing.BorderFactory" 30 30 10 30))
          (layout (jnew (jconstructor "java.awt.GridLayout" "int" "int") 0 1))
          (label-constructor (jconstructor "javax.swing.JLabel" "java.lang.String"))
          (label (jnew label-constructor "Number of button clicks: 0"))
          (button-constructor (jconstructor "javax.swing.JButton" "java.lang.String"))
          (button (jnew button-constructor "I'm a Swing button!")))
    (jcall (jmethod "javax.swing.JButton" "setMnemonic" "int")
      button
      (jfield "java.awt.event.KeyEvent" "VK_I"))
    (jstatic (jmethod "org.armedbear.lisp.java.awt.ActionListener" "addTo" "javax.swing.AbstractButton")
      "org.armedbear.lisp.java.awt.ActionListener"
      button)
    (jregister-handler button :actionPerformed
      #'(lambda (data object longs strings event seqnum)
          (format t "data: ~s~%object: ~s~%longs: ~s~%strings: ~s~%event: ~s~%seqnum: ~s~%" data object longs strings event seqnum)
          (incf num-clicks)
          (jcall (jmethod "javax.swing.JLabel" "setText" "java.lang.String")
            label
            (format nil "Number of button clicks: ~d" num-clicks)))
      :data 23 :count 10)
    (jstatic (jmethod "org.armedbear.lisp.java.awt.MouseAdapter" "addTo" "java.awt.Component")
      "org.armedbear.lisp.java.awt.MouseAdapter"
      label)
    (jregister-handler label :mouseEntered
      #'(lambda (data object longs strings event seqnum)
          (format t "mouse entered label~%data: ~s~%object: ~s~%longs: ~s~%strings: ~s~%event: ~s~%seqnum: ~s~%" data object longs strings event seqnum)) :data 'entered)
    (jregister-handler label :mouseExited
      #'(lambda (data object longs strings event seqnum)
          (format t "mouse exited label~%data: ~s~%object: ~s~%longs: ~s~%strings: ~s~%event: ~s~%seqnum: ~s~%" data object longs strings event seqnum)))
    (jcall (jmethod "javax.swing.JLabel" "setLabelFor" "java.awt.Component") label button)
    (jcall (jmethod "javax.swing.JPanel" "setBorder" "javax.swing.border.Border") pane border)
    (jcall (jmethod "javax.swing.JPanel" "setLayout" "java.awt.LayoutManager") pane layout)
    (jcall (jmethod "javax.swing.JPanel" "add" "java.awt.Component") pane button)
    (jcall (jmethod "javax.swing.JPanel" "add" "java.awt.Component") pane label)
    pane))

(defun main ()
  (jstatic (jmethod "javax.swing.UIManager" "setLookAndFeel" "java.lang.String")
    "javax.swing.UIManager"
    (jstatic "getSystemLookAndFeelClassName" "javax.swing.UIManager"))
  (let* ((frame-constructor (jconstructor "javax.swing.JFrame" "java.lang.String"))
          (frame (jnew frame-constructor "Swing Application"))
          (contents (create-components))
          (frame-content-pane (jcall (jmethod "javax.swing.JFrame" "getContentPane") frame))
          (center-border-layout (jfield "java.awt.BorderLayout" "CENTER")))
    (jcall (jmethod "java.awt.Container" "add" "java.awt.Component" "java.lang.Object")
      frame-content-pane contents center-border-layout)
    (jstatic (jmethod "org.armedbear.lisp.java.awt.WindowAdapter" "addTo" "java.awt.Window")
      "org.armedbear.lisp.java.awt.WindowAdapter"
      frame)
    (jregister-handler frame :windowClosing
      (lambda (&rest x) (print x)))
    (jcall (jmethod "java.awt.Window" "pack") frame)
    (jcall (jmethod "java.awt.Component" "setVisible" "boolean") frame (make-immediate-object t :boolean))))