clojureでAAを生成する。

何だかまだclojureには慣れないなー*1
read-lines*とか自分で作らなければいけないはずがないとおもうのだけと。*2

(ns tool.aa
  (:use [clojure.contrib.command-line :only (with-command-line)]
	[clojure.contrib.duck-streams :only (reader)])
  (:import java.io.File
	   java.awt.image.BufferedImage
	   (java.awt Font Color RenderingHints GraphicsEnvironment)))
  
(defn read-lines* []
  ((fn step []
     (lazy-seq
      (when-let [line (read-line)]
	(cons line (step)))))))

(defn main [args]
  (with-command-line args
    "AA to png file"
    [[width "image width" 600]
     [height "image height" 300]
     [font-path "font-path" "/usr/share/fonts/truetype/ttf-ipamonafont/ipagp-mona.ttf"]
     [output "output file" "foo.png"]
       remaining]
    (let [env (GraphicsEnvironment/getLocalGraphicsEnvironment)
	  font (Font/createFont Font/TRUETYPE_FONT
				(File. font-path))
	  width (if (string? width) (Integer/parseInt width) width)
	  height (if (string? height) (Integer/parseInt height) height)]
      (. env (registerFont font))
      (let [coll (read-lines*)
	    lineLnegth (count coll)
	    fontHeight (/ (float height) lineLnegth)
	    image (BufferedImage. width height BufferedImage/TYPE_INT_RGB)
	    g  (. image createGraphics)]
	(doto g 
	  (. setRenderingHint 
	     RenderingHints/KEY_TEXT_ANTIALIASING
	     RenderingHints/VALUE_TEXT_ANTIALIAS_LCD_VBGR)
	  (. setColor Color/WHITE)
	  (. fillRect 0 0 (. image getWidth) (. image getHeight)))
	(doto g
	  (. setColor Color/BLACK)
	  (. setFont (. font deriveFont fontHeight)))
	(doseq [[i line] (map vector (iterate inc 0) coll)]
	  (. g drawString line 10 (int (+ (* i fontHeight) fontHeight))))
	(javax.imageio.ImageIO/write image "png" (File. output))))))

(main *command-line-args*)

*1:javaに慣れていないのかもしれないけれど

*2:duck-streamのread-linesに*in*を渡すとcloseしたstreamを延々と読みつづけるようになってしまう

clojureの中を覗く

• • classpathのリスト
  • 現在のnamespaceで利用できる関数
  • classが持っているmethod

classpath

clojureはjavaのSystemClassLoader以外のところにclasspathを格納していた。

(defn current-classpath []
  (let [xs (list (.. java.lang.ClassLoader getSystemClassLoader getURLs)
		 (.. clojure.lang.RT getRootClassLoader getURLs))]
    (apply concat  (map (fn [urls] (map #(. % getFile) urls)) xs))))

;;how-to-use
;(current-classpath)

現在利用できる関数の表示

(defn usable-functions
  ([]  (usable-functions *ns*))
  ([ns] ((comp keys ns-map) ns)))

;;how-to-use
;(usable-functions)
;(usable-functions (fisrt (all-ns)))

classの情報を調べる

(defn class-info [k]
  (letfn [(get-method-info [m]
	   {:name (. m getName)
	    :args (map class-simple (. m getParameterTypes))
	    :return-type (class-simple (. m getReturnType))})
	  (class-simple [k] (let [k* (. k getSimpleName)]
			      (if (= "Object" k*) "o" k*)))]
    (let [k (if (class? k) k (class k))]
      {:class k
       :methods (sort-by #(:name %) (map get-method-info (. k getMethods)))})))

(defn describe-class [k]
  (let [table (class-info k)]
    (println "==" (:class table) "==")
    (doseq [x (:methods table)] (println x))))

;;how-to-use
;(describe-class (type #""))