ふせんちっくなウィンドウを作ってみます。
無駄にクリック時の動作をかえられるようにしたりしてみました。
;;; MouseAdapter
(ns example.MouseAdapter
(:gen-class
:extends java.awt.event.MouseAdapter
:init init
:state actionTable
:constructors {[clojure.lang.Atom][] [][]}
:main false
;; :expose-methods {mouseClicked mouseClicked}
:methods
[
[clickAction [java.awt.event.MouseEvent] void]
[doubleClickAction [java.awt.event.MouseEvent] void]
[rightClickAction [java.awt.event.MouseEvent] void]
]))
(defmacro call-action [action-type]
`(let [act# (get @(.actionTable ~'this) ~action-type)]
(when act#
(act# ~'evt))))
(defn -init ([action-table-atom] [[] action-table-atom])
([] (letfn ((dummy [evt] nil))
[[] (atom {:click-action dummy :double-click-action dummy :right-click-action dummy :press-action dummy
:drag-action dummy})])))
(defn -clickAction [this evt] (call-action :click-action))
(defn -doubleClickAction [this evt] (call-action :double-click-action))
(defn -rightClickAction [this evt] (call-action :right-click-action))
(defn -mouseClicked [this evt]
(cond
(= java.awt.event.MouseEvent/BUTTON3 (.getButton evt)) (.rightClickAction this evt)
(= java.awt.event.MouseEvent/BUTTON1 (.getButton evt))
(if (>= (.getClickCount evt) 2)
(.doubleClickAction this evt)
(.clickAction this evt))))
(defn -mousePressed [this evt]
(call-action :press-action))
(defn -mouseDragged [this evt]
(call-action :drag-action))
(defn alter-action [adapter type action]
(swap! (.actionTable adapter) assoc type action))
(defn set-action-table [adapter action-table]
(set! (.actionTable adapter) action-table))
(defn get-action-table [adapter]
@(.actionTable adapter))
(require 'example.MouseAdapter)
(defstruct item :name :object :listener)
(defstruct husen-window :window :label :adapter :popup :item-map :size)
(def *default-husen-size* (list 150 50))
(defn get-x [size] (first size))
(defn get-y [size] (second size))
(defmacro define-and-add-item [[popup item-map name text] [evt] & action-performer]
`(let [obj# (javax.swing.JMenuItem. ~text)
listener# (proxy [java.awt.event.ActionListener][]
(actionPerformed [~'evt]
~@action-performer))]
(.addActionListener obj# listener#)
(.add ~'popup obj#)
(swap! ~'item-map assoc ~'name (struct item obj# listener#))))
(defn make-husen-window []
(let [win (javax.swing.JWindow.)
adapter (atom (example.MouseAdapter.))
popup (javax.swing.JPopupMenu.)
item-map (atom nil)
lbl (javax.swing.JLabel. "")
size (atom *default-husen-size*)
point-map (atom {:location nil :press-point nil})]
(.setSize lbl (get-x @size) (get-y @size))
(.setVisible lbl true)
(.add (.getContentPane win) lbl)
(define-and-add-item [popup item-map :set-visible-item "setVisible(false)"]
[evt]
(.setVisible win false))
(define-and-add-item [popup item-map :set-text-item "Set Text"]
[evt]
(let [txt (javax.swing.JOptionPane/showInputDialog (.getContentPane win) "Input Text:")]
(when txt
(.setText lbl txt))))
(define-and-add-item [popup item-map :set-icon-item "Set Icon"]
[evt]
(let [chooser (javax.swing.JFileChooser.)]
(if (= javax.swing.JFileChooser/APPROVE_OPTION
(.showOpenDialog chooser (.getContentPane win)))
(let [icon (javax.swing.ImageIcon. (.. chooser getSelectedFile getAbsolutePath))]
(if icon
(.setIcon lbl icon)
(.setText lbl (.. chooser getSelectedFile getName)))))))
(define-and-add-item [popup item-map :set-default-size "Set Default Size"]
[evt]
(.setSize win (get-x @size) (get-y @size))
(.setSize lbl (get-x @size) (get-y @size)))
(define-and-add-item [popup item-map :set-icon-size "Set Icon Size"]
[evt]
(let [icon (.getIcon lbl)
height
(if (isa? (.getClass icon) javax.swing.ImageIcon)
(.getHeight (.getImage icon))
(.getIconHeight icon))
width
(if (isa? (.getClass icon) javax.swing.ImageIcon)
(.getWidth (.getImage icon))
(.getIconWidth icon))]
(.setSize win width height)
(.setSize lbl width height)))
(example.MouseAdapter/alter-action
@adapter
:right-click-action
(fn [evt]
(.show popup (.getComponent evt) (.getX evt) (.getY evt))))
(example.MouseAdapter/alter-action
@adapter
:press-action
(fn [evt]
(swap! point-map assoc :press-point (.getPoint evt))))
(example.MouseAdapter/alter-action
@adapter
:drag-action
(fn [evt]
(swap! point-map assoc :location (.getLocation win))
(let [{p :press-point loc :location} @point-map
x (-
(+ (.x loc)
(.getX evt))
(.getX p))
y (- (+ (.y loc) (.getY evt)) (.getY p))]
(.setLocation win x y))))
(doto win
(.addMouseListener @adapter)
(.addMouseMotionListener @adapter)
(.setSize (get-x @size) (get-y @size))
(.setVisible true))
(struct husen-window win lbl adapter popup item-map size)))
