Merge pull request #68 from clojerl/54-image-functions

[#54] image functions

src/doodler/core.clje

@@ -455,6 +455,76 @@
   ([img x y w h]
    (p/image *canvas* img x y w h)))
 
+(defn get-pixel
+  "Reads the color of any pixel or grabs a section of an image. If no
+  parameters are specified, a copy of entire image is returned. Get the
+  value of one pixel by specifying an x,y coordinate. Get a section of
+  the image by specifying an additional width and height parameter.
+  If the pixel requested is outside of the image window, black is returned.
+  The numbers returned are scaled according to the current color ranges,
+  but only RGB values are returned by this function. For example, even though
+  you may have drawn a shape with (color-mode :hsb), the numbers returned
+  will be in RGB.
+
+  Getting the color of a single pixel with (get x y) is easy, but not
+  as fast as grabbing the data directly using the pixels fn.
+
+  If no img specified - current-graphics is used."
+  ([] (p/get-pixel *canvas*))
+  ([img] (p/get-pixel *canvas* img))
+  ([x y] (p/get-pixel *canvas* x y))
+  ([img x y] (p/get-pixel *canvas* img x y))
+  ([x y w h] (p/get-pixel *canvas* x y w h))
+  ([img x y w h] (p/get-pixel *canvas* img x y w h)))
+
+(defn pixels
+  "Binary containing the values for all the pixels in the display
+  window or image. This array is therefore the size of the display window.
+
+  The return value is a binary with values representing in RGBRGBRGB... format
+  in the top-to-bottom, left-to-right order, that is the first RGB triplet
+  corresponds to the first pixel of the first row, the second one - to the
+  second pixel of the first row and so on until the end of the first row,
+  with second row following after it and so on."
+  ([] (p/pixels *canvas*))
+  ([img] (p/pixels *canvas* img)))
+
+(defn resize
+  "Resize the image to a new width and height.
+  To make the image scale proportionally, use 0 as the value for the wide or
+  high parameter. For instance, to make the width of an image 150 pixels,
+  and change the height using the same proportion, use resize(150, 0)."
+  [img w h]
+  (p/resize *canvas* img w h))
+
+(defn save
+  "Saves an image from the display window. Images are saved in TIFF,
+  BMP, JPEG, and PNG format depending on the extension within the
+  filename parameter. For example, image.tif will have a TIFF image
+  and image.png will save a PNG image. If no extension is included in
+  the filename, the image will save in TIFF format and .tif will be
+  added to the name. All images saved from the main drawing window
+  will be opaque. To save images without a background, use
+  create-graphics."
+  [filename]
+  (p/save *canvas* (str filename)))
+
+(declare frame-count)
+
+(defn save-frame
+  "Saves an image identical to the current display window as a
+  file. May be called multple times - each file saved will have a
+  unique name. Name and image formate may be modified by passing a
+  string parameter of the form \"foo-####.ext\" where foo- can be any
+  arbitrary string, #### will be replaced with the current frame id
+  and .ext is one of .tiff, .targa, .png, .jpeg or .jpg
+
+  Examples:
+  (save-frame)
+  (save-frame \"pretty-pic-####.jpg\")"
+  ([] (p/save-frame *canvas* (frame-count)))
+  ([name] (p/save-frame *canvas* (frame-count) (str name))))
+
 ;; Stroke & fill
 
 (defn- save-current-stroke

src/doodler/examples/image.clje

@@ -9,8 +9,30 @@
 (defn draw []
   (d/background 200)
   (d/text (str (d/current-frame-rate)) 0 10)
-  (let [img (d/load-image "resources/pacman.png")]
-    (d/image img 10 10 50 50)))
+  (d/text (str (d/frame-count)) 0 20)
+  (let [img (d/load-image "resources/pacman.png")
+        img (d/resize img 20 20)]
+    (d/image img 50 50)
+    (when (< 20 (d/frame-count) 30)
+      (println :color-panel (d/get-pixel 10 10)
+               :color-img (d/get-pixel img 5 5)
+               :subimage-pane (d/get-pixel 5 5 5 5)
+               :subimage-img (d/get-pixel img 5 5 5 5)))
+    ;; Test save-image
+    (when (< 10 (d/frame-count) 20)
+      (d/save-frame)
+      (d/save-frame "screen-#######.jpg"))
+    ;; Test save
+    (when (= (d/frame-count) 200)
+      (println "Saving files...")
+      (d/save "foo.jpg")
+      (d/save "foo.jpeg")
+      (d/save "foo.png")
+      (d/save "foo.tif")
+      (d/save "foo.bmp")
+      ;; Unsupported or missing will use TIFF
+      (d/save "foo.gif")
+      (d/save "foo"))))
 
 (d/defsketch sketch
   :title "Load image"

src/doodler/protocols.clje

@@ -8,7 +8,12 @@
 (defprotocol IBitmap
   (create-image [this w h])
   (load-image [this filename])
-  (image [this img x y] [this img x y w h]))
+  (image [this img x y] [this img x y w h])
+  (get-pixel [this] [this img] [this x y] [this img x y] [this x y w h] [this img x y w h])
+  (pixels [this] [this img])
+  (resize [this img w h])
+  (save [this filename])
+  (save-frame [this frame-count] [this frame-count name]))
 
 (defprotocol IPrimitives
   (arc [this x y w h start end])
@@ -56,7 +61,7 @@
   (post-draw [this])
   (paint [this])
   (refresh [this])
-  (resize [this]))
+  (resize-canvas [this]))
 
 (defprotocol ITransform
   (push-matrix [this])

src/doodler/sketch.clje

@@ -72,7 +72,7 @@
 
 (defn on-resize
   [sketch]
-  (update sketch :canvas p/resize))
+  (update sketch :canvas p/resize-canvas))
 
 (def ^{:private true}
   supported-features

src/doodler/wx/gui.clje

@@ -1,3 +1,4 @@
+;; These constants are found in erlang/lib/wx/include/wx.hrl
 (ns doodler.wx.gui)
 
 (def frame-style-system-menu 2048)
@@ -24,6 +25,42 @@
           frame-style-caption
           frame-style-clip-children))
 
+;; wxBitmapType enum
+(def bitmap-type-invalid 0)
+(def bitmap-type-bmp 1)
+(def bitmap-type-bmp-resource 2)
+(def bitmap-type-resource bitmap-type-bmp-resource)
+(def bitmap-type-ico (+ bitmap-type-bmp-resource 1))
+(def bitmap-type-ico-resource (+ bitmap-type-bmp-resource 2))
+(def bitmap-type-cur (+ bitmap-type-bmp-resource 3))
+(def bitmap-type-cur-resource (+ bitmap-type-bmp-resource 4))
+(def bitmap-type-xbm (+ bitmap-type-bmp-resource 5))
+(def bitmap-type-xbm-data (+ bitmap-type-bmp-resource 6))
+(def bitmap-type-xpm (+ bitmap-type-bmp-resource 7))
+(def bitmap-type-xpm-data (+ bitmap-type-bmp-resource 8))
+(def bitmap-type-tif (+ bitmap-type-bmp-resource 9))
+(def bitmap-type-tif-resource (+ bitmap-type-bmp-resource 10))
+(def bitmap-type-gif (+ bitmap-type-bmp-resource 11))
+(def bitmap-type-gif-resource (+ bitmap-type-bmp-resource 12))
+(def bitmap-type-png (+ bitmap-type-bmp-resource 13))
+(def bitmap-type-png-resource (+ bitmap-type-bmp-resource 14))
+(def bitmap-type-jpeg (+ bitmap-type-bmp-resource 15))
+(def bitmap-type-jpeg-resource (+ bitmap-type-bmp-resource 16))
+(def bitmap-type-pnm (+ bitmap-type-bmp-resource 17))
+(def bitmap-type-pnm-resource (+ bitmap-type-bmp-resource 18))
+(def bitmap-type-pcx (+ bitmap-type-bmp-resource 19))
+(def bitmap-type-pcx-resource (+ bitmap-type-bmp-resource 20))
+(def bitmap-type-pict (+ bitmap-type-bmp-resource 21))
+(def bitmap-type-pict-resource (+ bitmap-type-bmp-resource 22))
+(def bitmap-type-icon (+ bitmap-type-bmp-resource 23))
+(def bitmap-type-icon-resource (+ bitmap-type-bmp-resource 24))
+(def bitmap-type-ani (+ bitmap-type-bmp-resource 25))
+(def bitmap-type-iff (+ bitmap-type-bmp-resource 26))
+(def bitmap-type-tga (+ bitmap-type-bmp-resource 27))
+(def bitmap-type-maccursor (+ bitmap-type-bmp-resource 28))
+(def bitmap-type-maccursor-resource (+ bitmap-type-bmp-resource 29))
+(def bitmap-type-any 50)
+
 (def feature->style
   {:keep-on-top [frame-style-stay-on-top]
    :resizable   [frame-style-resize-border

src/doodler/wx/panel.clje

@@ -1,6 +1,6 @@
 (ns doodler.wx.panel
-  (:require [doodler.protocols :as p]
-            [doodler.core :as core]
+  (:require [clojure.string :as str]
+            [doodler.protocols :as p]
             [doodler.wx.gui :as gui]))
 
 (declare init-canvas)
@@ -31,6 +31,54 @@
     (let [img (wxImage/scale img w h)
           bitmap (wxBitmap/new img)]
       (wxDC/drawBitmap bitmap-dc bitmap #erl[x y])))
+  (get-pixel [_this]
+    (wxBitmap/convertToImage bitmap))
+  (get-pixel [_this img]
+    (wxImage/copy img))
+  (get-pixel [this x y]
+    (p/get-pixel this (wxBitmap/convertToImage bitmap) x y))
+  (get-pixel [_this img x y]
+    #erl[(bit-and (wxImage/getRed img x y) 0xFF)
+         (bit-and (wxImage/getGreen img x y) 0xFF)
+         (bit-and (wxImage/getBlue img x y) 0xFF)])
+  (get-pixel [_this x y w h]
+    (-> bitmap
+        wxBitmap/convertToImage
+        (wxImage/getSubImage #erl[x y w h])))
+  (get-pixel [_this img x y w h]
+    (wxImage/getSubImage img #erl[x y w h]))
+  (pixels [_this]
+    (wxImage/getData (wxBitmap/convertToImage bitmap)))
+  (pixels [_this img]
+    (wxImage/getData img))
+  (resize [_this img w h]
+    (wxImage/scale img w h))
+  (save [_this filename]
+    (let [ext (-> filename (str/split #"\.") last)
+          ;; Check for no extension
+          ext (if (= ext filename) "" ext)
+          bitmap-type (case ext
+                        "tif" gui/bitmap-type-tif
+                        "png" gui/bitmap-type-png
+                        "jpeg" gui/bitmap-type-jpeg
+                        "jpg" gui/bitmap-type-jpeg
+                        "bmp" gui/bitmap-type-bmp
+                        "" gui/bitmap-type-tif
+                        (do
+                          (println "Unsupported extension" ext ", using TIFF")
+                          gui/bitmap-type-tif))]
+      (wxBitmap/saveFile bitmap filename bitmap-type)))
+  (save-frame [this frame-count]
+    (p/save-frame this frame-count "screen-####.tif"))
+  (save-frame [this frame-count name]
+    (let [pounds (re-find #"#+" name)
+          frame-count (str frame-count)
+          pad-left (repeat (- (count pounds)
+                              (count frame-count))
+                           "0")
+          n (str (apply str pad-left) frame-count)
+          filename (str/replace name #"#+" n)]
+      (p/save this filename)))
 
   p/IPrimitives
   (arc [_this x y w h start end]
@@ -115,20 +163,20 @@
     (wxDC/drawBitmap bitmap-dc img #erl[x y]))
 
   p/IEvents
-  (pre-draw [this]
+  (pre-draw [_this]
     (vreset! gc (wxGraphicsContext/create bitmap-dc)))
   (post-draw [this]
     (wxGraphicsContext/destroy @gc))
-  (paint [this]
+  (paint [_this]
     (let [dc (wxPaintDC/new panel)]
       (try
         (wxDC/drawBitmap dc bitmap #erl[0 0])
         (finally
           (wxPaintDC/destroy dc)))))
-  (refresh [this]
+  (refresh [_this]
     (wxWindow/refresh panel
                       #erl(#erl[:eraseBackground false])))
-  (resize [this]
+  (resize-canvas [_this]
     (let [bgcolor (wxBrush/getColour bg-brush)
           _ (wxMemoryDC/destroy bitmap-dc)
           _ (wxBitmap/destroy bitmap)