Brian's brain.clj

; A CLR port of Brian's functional brain from
; http://blog.bestinclass.dk/index.php/2009/10/brians-functional-brain/
;
; 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 a ClojureCLR implmentation of futures and 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 dim-board   [ 90   90])
(def dim-screen  [600  600])
(def dim-scale   (vec (map / dim-screen dim-board)))

(defn fmap [f coll] (doall (map f coll)))

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

(defn render-cell [context cell]
  (let [[state x y] cell
        x  (inc (* x (dim-scale 0)))
        y  (inc (* y (dim-scale 1)))
        brush (if (= state :dying) Brushes/Gray Brushes/White)]
    (.DrawRectangle context brush nil (rect x y (dec (dim-scale 0)) (dec (dim-scale 1))))))

(defn render [target stage]
  (let [vis (DrawingVisual.)
        context (.RenderOpen vis)]
    (.DrawRectangle context Brushes/Black nil (rect 0 0 (dim-screen 0) (dim-screen 1)))
    (fmap (fn [col]
            (fmap #(when (not= :off (% 0))
                     (render-cell context %)) col)) stage)
    (.Close context)
    (.Render target vis)))

(def board
     (for [x (range (dim-board 0))]
       (for [y (range (dim-board 1))]
         [(if (< 50 (rand-int 100)) :on :off) x y])))

(defn active-neighbors [above [left _ right] below]
  (count
   (filter #(= :on (% 0))
           (concat above [left right] below))))

(defn torus-window [coll]
  (partition 3 1 (concat [(last coll)] coll [(first coll)])))

(defn rules [above current below]
  (let [[self x y]  (second current)]
    (cond
      (= :on    self)                              [:dying x y]
      (= :dying self)                              [:off   x y]
      (= 2 (active-neighbors above current below)) [:on    x y]
      :else                                        [:off   x y])))

(defn step [board]
  (doall
   (pmap (fn [window]
           (apply #(doall (apply map rules %&))
                  (doall (map torus-window window))))
         (torus-window board))))

(defn activity-loop [stage]
  (swap! stage step)
  (recur stage))

(def xaml "<Window
    xmlns=\"http://schemas.microsoft.com/winfx/2006/xaml/presentation\"
    xmlns:x=\"http://schemas.microsoft.com/winfx/2006/xaml\"
    Title=\"Brian's Brain\" Height=\"600\" 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 [stage w]
  (println "initializing ui")
  (let [target (RenderTargetBitmap. 600 600 90 90 PixelFormats/Pbgra32)]
    (.set_Source (.FindName w "img") target)
    (add-watch stage :ui ; When the stage 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 [stage (atom board)
      uithread (doto (Thread.
                      (gen-delegate ThreadStart []
                                    (run-wpf-app xaml (partial ui-init stage))))
                 (.SetApartmentState ApartmentState/STA)
                 (.Start))]
  (Thread/Sleep 500)
  (println "starting activity loop")
  (doto (Thread.
         (gen-delegate ThreadStart []
                       (activity-loop stage)))
    (.Start))
  (println "dropping into repl")
  (clojure.main/repl :eval (partial wpf-eval uithread 'user)))