Merry Christmas.clj

; A CLR port of Chouser's Christmas tree http://gist.github.com/40012
;
; A WPF app is fired up in another thread. Anything you type in the REPL
; is dispatched to the WPF thread and evaluated there.
;
; Requires the following addition to ClojureCLR's GenDelegate.cs:
;   public static Delegate CreateFunc(IFn fn)
;   {
;       Type delegateType = typeof(Func<>).MakeGenericType(new Type[] { typeof(object) });
;       return Create(delegateType, fn);
;   }

(import '(System.Reflection Assembly))
(Assembly/Load "PresentationFramework, Version=3.0.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35")
(Assembly/Load "PresentationCore, Version=3.0.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35")
(Assembly/Load "WindowsBase, Version=3.0.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35")
(Assembly/Load "System.Xml, Version=2.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089")
(import '(System EventHandler Uri)
        '(System.Windows Application Point Rect)
        '(System.Windows.Markup XamlReader)
        '(System.Windows.Media Brushes Color Colors DrawingVisual Matrix Pen PixelFormats SolidColorBrush)
        '(System.Windows.Media.Imaging RenderTargetBitmap)
        '(System.Windows.Threading Dispatcher DispatcherPriority)
        '(System.IO File FileStream StringReader)
        '(System.Threading ApartmentState Thread ThreadStart)
        '(System.Xml XmlReader))

; From ClojureCLR's celsius sample
(defmacro gen-delegate
  [type argVec & body]
  `(clojure.lang.GenDelegate/Create ~type (fn ~argVec ~@body)))

(defmacro gen-func
  [& body]
  `(clojure.lang.GenDelegate/CreateFunc (fn [] ~@body)))

(def minpoint (Point. 0 0))
(def maxpoint (Point. 1000 1000))

(defn degrees [radians] (* radians (/ 180.0 Math/PI)))
(defn round [p] (Point. (Math/Round (.X p)) (Math/Round (.Y p))))

(defmacro branch [matrix & choices]
  `(let [maxp# (round (.Transform ~matrix maxpoint))
         minp# (round (.Transform ~matrix minpoint))]
     (if (= maxp# minp#)
       maxp#
       (condp = (rand-int ~(count choices))
         ~@(mapcat list (range (count choices)) choices)))))
 
(defn transform [matrix]
  (branch matrix
          (recur (doto matrix (.ScalePrepend 0.5 0.5) (.TranslatePrepend 0 500) (.RotatePrepend (degrees 2))))
          (recur (doto matrix (.ScalePrepend 0.5 0.5) (.TranslatePrepend 0 500) (.RotatePrepend (degrees -2))))
          (recur (doto matrix (.ScalePrepend 0.8 0.8) (.TranslatePrepend 0 300)))
          (recur (doto matrix (.ScalePrepend 0.8 0.8) (.TranslatePrepend 0 300)))
          (recur (doto matrix (.ScalePrepend 0.8 0.8) (.TranslatePrepend 0 300)))))

(defn draw [_]
  (let [p (transform (doto (Matrix.)
                       (.TranslatePrepend 300 650)
                       (.ScalePrepend 0.5 -0.5)))]
    (send *agent* draw)
    p))

(defn rect [x y w h]
  (Rect. (double x) (double y) (double w) (double h)))

(defn render [target p]
  (let [vis (DrawingVisual.)
        context (.RenderOpen vis)]
    (.DrawRectangle context Brushes/Black nil (rect (.X p) (.Y p) 1 1))
    (.Close context)
    (.Render target vis)))

(def xaml "<Window
    xmlns=\"http://schemas.microsoft.com/winfx/2006/xaml/presentation\"
    xmlns:x=\"http://schemas.microsoft.com/winfx/2006/xaml\"
    Title=\"Merry Christmas!\" Height=\"715\" Width=\"600\">
    <ScrollViewer>
    <Image Name=\"img\" Stretch=\"UniformToFill\" />
    </ScrollViewer>
</Window>")

(def app (atom nil))

(defn run-wpf-app
  "Creates a WPF Application and loads xaml-string as raw XAML. The top-level
element from the xaml is passed to init-fn and then used to run the app."
  [xaml-string init-fn]
  (reset! app (Application.))
  (let [top-level (-> xaml StringReader. XmlReader/Create XamlReader/Load)]
    (init-fn top-level)
    (.Run @app top-level)))

(defn ui-init [agents w]
  (println "initializing ui")
  (let [target (RenderTargetBitmap. 600 700 90 90 PixelFormats/Pbgra32)]
    (.set_Source (.FindName w "img") target)
    (doseq [a agents]
      (add-watch a :ui ; When the agent's point changes, draw it
                 (fn [_ _ _ newval]
                   (when newval
                     (.Invoke (.get_Dispatcher w) DispatcherPriority/Normal
                              (gen-func (render target newval)))))))))

(defn wpf-eval
  "evals data by invoking an operation to uithread's dispatcher. As a partial function
with the first two args filled, this can be used as the :eval arg for the repl."
  [uithread repl-ns-sym data]
  (.Invoke (Dispatcher/FromThread uithread) DispatcherPriority/Normal
           (gen-func
            (clojure.main/with-bindings
              (in-ns repl-ns-sym)
              (eval data)))))

(let [agents (map (fn [_] (agent nil)) (range 5))
      uithread (doto (Thread.
                      (gen-delegate ThreadStart []
                                    (run-wpf-app xaml (partial ui-init agents))))
                 (.SetApartmentState ApartmentState/STA)
                 (.Start))]
  (Thread/Sleep 500)
  (println "launching agents")
  (doseq [a agents] (send a draw))
  (println "dropping into repl")
  (clojure.main/repl :eval (partial wpf-eval uithread 'user)))