Mercurial > rlm

     1 (ns rlm.image-utils

     2   (:import [javax.swing JFrame]

     3 	   [java.awt Color BorderLayout]

     4 	   [ij ImagePlus IJ]

     5 	   [java.lang Math]

     6 	   [java.awt Graphics2D Panel]

     7 	   [ij Macro]

     8 	   [java.io BufferedReader InputStreamReader]

     9 	   [java.awt.image BufferedImage])

    10   (:use [clojure.contrib

    11 	 [math]

    12 	 [def]]))

    13 

    14 

    15 (defmulti frame-hash-multi  class)

    16 

    17 (defmethod frame-hash-multi ImagePlus

    18   [image+]

    19     (with-meta

    20       (let [buf (.. image+ getBufferedImage)

    21 	    color (.getColorModel buf)]

    22 	(apply hash-map 

    23 	       (interleave 

    24 		(doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]

    25 			 (vector x y)))

    26 		(doall (for [x (range (.getWidth image+)) y (range (.getHeight image+))]

    27 			 (let [data (.getRGB buf x y)] 

    28 			   (hash-map :r (bit-shift-right (bit-and 0xff0000 data) 16)

    29 				     :g (bit-shift-right (bit-and 0x00ff00 data) 8)

    30 				     :b (bit-and 0x0000ff data))))))))

    31       {:width  (.getWidth image+) :height (.getHeight image+)}))

    32 

    33 (defmethod frame-hash-multi String

    34   [image-name]

    35   (let [image+ (ImagePlus. image-name)]

    36     (frame-hash-multi image+)))

    37 

    38 (defn frame-hash

    39   "yields a convienent representation for the pixles in an image.

    40    Because of the size of the structvre generated, this must only be used

    41    in a transient way so that java can do it's garbage collection."

    42   [something]

    43   (frame-hash-multi something))

    44 

    45 

    46 (def white {:r 255, :g 255, :b 255})

    47 (def black {:r 0,   :g 0,   :b 0})

    48 

    49 (defn rgb-euclidian

    50   [{r1 :r g1 :g b1 :b} {r2 :r g2 :g b2 :b} ]

    51   (expt (+ (expt (- r1 r2) 2)

    52 	  (expt (- g1 g2) 2)

    53 	  (expt (- b1 b2) 2)) 0.5))

    54 

    55 (defn b&w

    56   "turn everything strictly black or white"

    57   [window]

    58   (with-meta

    59   (zipmap

    60    (keys window)

    61    (map (fn  [rgb] 

    62 	  (if (> (rgb-euclidian rgb white) (rgb-euclidian rgb black))

    63 	    black white))

    64 	(vals window))) (meta window)))

    65 

    66 (defn frame-hash->bufferedImage

    67   [frame-hash]

    68     (let [data  (meta frame-hash)

    69 	image (BufferedImage. (:width data) (:height data) BufferedImage/TYPE_INT_BGR)]

    70 	

    71 	(doall (for [element frame-hash] 

    72 	  (let [coord  (key element) 

    73 		rgb   (val element)

    74 		packed-RGB 

    75 		(+ (bit-shift-left (:r rgb) 16)

    76 		   (bit-shift-left (:g rgb) 8)

    77 		                   (:b rgb))]

    78 	    (.setRGB image (first coord) (last coord) packed-RGB))))

    79 	image))

    80   

    81 (defmulti  display "Creates a JFrame and displays a buffered image"  class)

    82 

    83 (defn- makePanel [image]

    84   (proxy [Panel] [] (paint [g]  (.drawImage g image 0 0 nil))))

    85 

    86 (defmethod display 

    87   BufferedImage  [image] 

    88   (let [panel (makePanel image)

    89 	frame (JFrame. "Oh Yeah!")]

    90     (.add frame panel) 

    91     (.pack frame) 

    92     (.setVisible frame true ) 

    93     (.setSize frame(.getWidth image) (.getHeight image))))

    94  

    95 (defmethod display

    96   ImagePlus [image]

    97   (display (.getBufferedImage image)))

    98 

    99 (defmethod display

   100   clojure.lang.PersistentHashMap [frame-hash]

   101   (display (frame-hash->bufferedImage frame-hash)))

   102 

   103 (defmethod display

   104     clojure.lang.PersistentArrayMap [frame-hash]

   105     (display (frame-hash->bufferedImage frame-hash)))

   106 

   107 (defn rotate [degrees #^ImagePlus image]

   108   (.rotate (.getChannelProcessor image) degrees)

   109   image)

   110 

   111 

   112 (defn-memo width [pic]

   113   (inc (first (last (sort (fn [[x0 y0] [x1 y1]] (> x1 x0)) (keys pic))))))

   114 

   115 (defn-memo height [pic]

   116     (inc (last (last (sort (fn [[x0 y0] [x1 y1]] (> y1 y0)) (keys pic))))))

   117
author	Robert McIntyre <rlm@mit.edu>
date	Tue, 18 Oct 2011 00:57:08 -0700
parents
children