非矩形Windowで画像表示

こちらの記事を参考にClojureで書いてみた。

画像はこちらからお借りしました。

二重ループでピクセル単位の処理をしている部分がなんとなく嫌だったので全座標を要素とするシーケンスをつくり、それを加工しまくって最終的に不透明領域を表すRectangleオブジェクト群を作っています。create-alpha-matrix, get-alpha-bounds, create-rectangles あたりの流れがそれに相当する処理ですが、イマイチ読み難いコードになってしまいました。マトリクスをシーケンス処理で扱うというのはいいアイディアだと思ったんだけどなあ。

(ns sample-shape
    (:use [clojure.contrib.core :only (new-by-name)])
    (:use [clojure.contrib.seq-utils :only (flatten)])
    (:import [com.sun.awt AWTUtilities])
    (:import [java.awt Shape Rectangle])
    (:import [java.awt.image BufferedImage]))

(defn create-buffered-image [image-icon]
  "BufferedImageを作成し、ImageIconの内容をそのまま描画"
  (let [buf (BufferedImage. (.getIconWidth image-icon)
			    (.getIconHeight image-icon)
			    BufferedImage/TYPE_INT_ARGB)]
    (.paintIcon image-icon nil (.createGraphics buf) 0 0)
    buf))

(defn create-alpha-matrix [#^BufferedImage buf]
  "各ピクセルのアルファ値のみを取り出したマトリクス（seqを要素にもつseq）を作成"
  (let [color-model (.getColorModel buf)
	width (.getWidth buf)
	height (.getHeight buf)]
    (->> (for [x (range width) y (range height)] [x y])
     	 (map (fn [[x y]] (.getRGB buf x y)))
	 (map (comp int-array vector))
	 (map #(.getAlpha color-model %))
	 (partition height))))

(defn get-alpha-bounds [alpha-matrix]
  "アルファ値マトリクスから、アルファ値の境界となる座標のみを取得
   境界とはアルファ値が「ゼロから非ゼロ」または「非ゼロからゼロ」になる変化点を指す.
   戻り値は、非透過区間の「始点と終点のペア」を要素とするシーケンス、
   を要素とするシーケンス（シーケンスのネストしたもの）"
  (->> alpha-matrix
       (map (fn [coll] (lazy-cat [0] coll [0])))
       (map (partial partition 2 1))
       (map (partial map vector (iterate inc 0)))
       (map (partial filter (fn [[_ pair]]
				(and (not-every? zero? pair)
				     (not-every? pos? pair)))))
       (map (partial map first))
       (map (partial partition 2))))

(defn create-rectangles [bounds]
  "アルファ値変化点を保持するコレクションを元に、Rectangleオブジェクト（の集合）を作成する。
   Rectangleは幅１で、不透明区間の距離を高さにもつ短冊状の領域。"
  (letfn [(new-rect [[x colls]]
		    (->> colls
			 (map (fn [[a b]] (Rectangle. x a 1 (- b a))))))]
	 (->> bounds
	      (map vector (iterate inc 0))
	      (map new-rect)
	      flatten)))

(defn create-shape [rects]
  "引数のRectangleを全て追加したShapeオブジェクトをかえす"
  (let [shape (java.awt.geom.GeneralPath.)]
    (dorun (->> rects
		(map #(.append shape % true))))
    shape))

(defn create-window [image-icon shape]
  "画像を表示するWindowを作成する"
  (let [img (.getImage image-icon)
	win (proxy [javax.swing.JWindow][]
		   (paint [g] (.drawImage g img 0 0 nil)))]
    (doto win
      (.setSize (.getIconWidth image-icon)
		(.getIconHeight image-icon))
      (.setLocationRelativeTo nil))
    (AWTUtilities/setWindowShape win shape)
    win))

(defn create-mouse-listener [window]
  "マウスイベントリスナー作成
   ドラッグによるwindow移動と、ダブルクリックによるアプリ終了を行う"
  (let [pos-info (atom {:start nil :location nil})]
    (proxy [java.awt.event.MouseAdapter][]
	   (mousePressed [evt]
			 (when (<= 2 (.getClickCount evt))
			   (System/exit 0))
			 (swap! pos-info (fn [pos-info]
					     (assoc pos-info :start evt))))
	   (mouseDragged [evt]
			 (swap! pos-info (fn [pos-info]
					     (->> (:location pos-info)
						  (#(.getLocation window %))
						  (assoc pos-info :location))))
			 (let [{start :start location :location} @pos-info
			       x (- (+ (.x location) (.getX evt))
				    (.getX start))
			       y (- (+ (.y location) (.getY evt))
				    (.getY start))]
			   (.setLocation window x y))))))

(defn main [& args]
  (let [image-icon (->> args first
			(new-by-name "javax.swing.ImageIcon"))
	shape (->> image-icon
		   create-buffered-image
		   create-alpha-matrix
		   get-alpha-bounds
		   create-rectangles
		   create-shape)
	window (create-window image-icon shape)
	mouse-listener (create-mouse-listener window)]
    (doto window
      (.addMouseListener mouse-listener)
      (.addMouseMotionListener mouse-listener)
      (.setVisible true))))

;; 実行時引数にイメージファイルを渡すこと
(apply main *command-line-args*)

全画素情報をシーケンスにしていますが、遅延評価なので一度に大量にメモリを占有することはないと思います。パフォーマンス的にはどうなんでしょうね。map使いまくってるので「軽いコード」とは言えないですよね、たぶん。