Permalink
Browse files

Add projection project.

  • Loading branch information...
1 parent 58ed350 commit 0c6d1712bffe6560639c8069cb61fbd036d3885b @nbeloglazov committed Apr 24, 2012
View
10 computer_graphics/projection/.gitignore
@@ -0,0 +1,10 @@
+/target
+/lib
+/classes
+/checkouts
+pom.xml
+*.jar
+*.class
+.lein-deps-sum
+.lein-failures
+.lein-plugins
View
15 computer_graphics/projection/README.md
@@ -0,0 +1,15 @@
+# projection
+
+I'm an app. Or maybe I'm a library? I haven't decided yet.
+
+The choice is up to you!
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2012 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.
View
3 computer_graphics/projection/project.clj
@@ -0,0 +1,3 @@
+(defproject projection "0.1.0-SNAPSHOT"
+ :dependencies [[org.clojure/clojure "1.4.0"]
+ [seesaw "1.4.0"]])
View
111 computer_graphics/projection/src/projection/core.clj
@@ -0,0 +1,111 @@
+(ns projection.core)
+
+(defn transpose [mat]
+ (apply mapv vector mat))
+
+(defn scalar-mult [a b]
+ (apply + (map * a b)))
+
+(defn vector-mult [[x1 y1 z1] [x2 y2 z2]]
+ (mapv #(* -1 %)
+ [(- (* y1 z2) (* z1 y2))
+ (- (* z1 x2) (* z2 x1))
+ (- (* x1 y2) (* y1 x2))]))
+
+(defn mult [scalar v]
+ (mapv #(* scalar %) v))
+
+(defn matrix-mult [a b]
+ (let [t-b (transpose b)]
+ (mapv (fn [row] (mapv #(scalar-mult row %) t-b)) a)))
+
+(defn norm [v]
+ (->> (mapv #(* % %) v)
+ (apply +)
+ (Math/sqrt)))
+
+(defn normalize [v]
+ (let [v-norm (norm v)]
+ (mapv #(/ % v-norm) v)))
+
+(defn R-mat [{:keys [VPN VUP]}]
+ (let [r-z (mult -1 VPN)
+ r-x (normalize (vector-mult VPN VUP))
+ r-y (vector-mult r-x r-z)]
+ (transpose [(conj r-x 0)
+ (conj r-y 0)
+ (conj r-z 0)
+ [0 0 0 1]])))
+
+(defn rotation-matrix [a [x y z]]
+ (let [c (Math/cos a)
+ s (Math/sin a)]
+ [[(+ c (* x x (- 1 c))) (- (* x y (- 1 c)) (* z s)) (+ (* x z (- 1 c)) (* y s))]
+ [(+ (* x y (- 1 c)) (* z s)) (+ c (* y y (- 1 c))) (- (* y z (- 1 c)) (* x s))]
+ [(- (* z x (- 1 c)) (* y s)) (+ (* z y (- 1 c)) (* x s)) (+ c (* z z (- 1 c)))]]))
+
+(defn rotate [{:keys [VPN VPN-y VPN-z] :as config} a-y a-z]
+ (let [rot (matrix-mult (rotation-matrix a-y VPN-y)
+ (rotation-matrix a-z VPN-z))]
+ (reduce #(update-in %1 [%2] (fn [v] (first (matrix-mult [v] rot)))) config [:VPN :VPN-y :VPN-z])))
+
+(defn S-mat [x y z]
+ [[x 0 0 0]
+ [0 y 0 0]
+ [0 0 z 0]
+ [0 0 0 1]])
+
+(defn T-mat [x y z]
+ [[1 0 0 0]
+ [0 1 0 0]
+ [0 0 1 0]
+ [x y z 1]])
+
+(defn M-mat [z-min]
+ (let [z (- z-min)]
+ [[1 0 0 0]
+ [0 1 0 0]
+ [0 0 (/ (inc z)) 1]
+ [0 0 (/ z (inc z)) 0]]))
+
+
+(defn calc-parameters [{:keys [COP TRG focus VPN] :as config}]
+ (let [VRP (mapv + COP (mult focus VPN))
+ F (* -0.9 focus)]
+ (merge config
+ {:VRP VRP
+ :F F
+ :B 1000})))
+
+(defn calc-matrix [{:keys [VPN VUP VRP COP B F width height] :as config}]
+ (let [T (apply T-mat (mult -1 COP))
+ R (R-mat config)
+ T-pl (S-mat 1 1 -1)
+ mid (reduce matrix-mult [T R T-pl])
+ [[w-x w-y w-z _]] (matrix-mult [(conj VRP 1)] mid)
+ [a b] (mapv #(/ % w-z -1) [w-x w-y])
+ Sh [[1 0 0 0]
+ [0 1 0 0]
+ [a b 1 0]
+ [0 0 0 1]]
+ S (S-mat(/ w-z 0.5 (+ w-z B)) (/ w-z 0.5 (+ w-z B)) (/ (+ w-z B)))
+ z-min (/ (+ w-z F) (+ w-z B))
+ M (M-mat z-min)]
+ ;(println "T" T)
+ ;(println "R" R)
+ ;(println "Sh" Sh)
+ ;(println "S" S)
+ ;(println M)
+ ;(println z-min)
+ (assoc config
+ :matrix (reduce matrix-mult [mid Sh S])
+ :matrix-2 (reduce matrix-mult [M (T-mat 1 1 0) (S-mat 0.5 0.5 1) (S-mat width height 1)])
+ :z-min z-min)))
+
+(defn transform [point {:keys [matrix matrix-2 z-min]}]
+ (let [[p] (matrix-mult [(conj point 1)] matrix)]
+ (if (<= z-min (p 2) 1)
+ (let [[pp] (matrix-mult [p] matrix-2)]
+ (->> (mapv #(/ % (last pp)) pp)
+ (take 2)))
+ nil)))
View
71 computer_graphics/projection/src/projection/digits.clj
@@ -0,0 +1,71 @@
+(ns projection.digits)
+
+(defn create-points [& points]
+ (concat (map #(cons 0 %) points)
+ (map #(cons 1 %) points)))
+
+(defn conjv [s v]
+ (conj (vec s) v))
+
+(defn rangel
+ ([start end]
+ (conjv (range start end) start))
+ ([end]
+ (rangel 0 end)))
+
+(defn create-faces [s1 s2]
+ (map (fn [[f0 f1] [b0 b1]] [f0 f1 b1 b0 f0])
+ (partition 2 1 s1)
+ (partition 2 1 s2)))
+
+(def digits-map
+ {\0 {:points (create-points
+ [0 0]
+ [0 5]
+ [3 5]
+ [3 0]
+ [1 1]
+ [1 4]
+ [2 4]
+ [2 1])
+ :faces (let [f-out (rangel 4)
+ f-in (rangel 4 8)
+ b-out (rangel 8 12)
+ b-in (rangel 12 16)]
+ (concat (create-faces f-in f-out)
+ (create-faces b-in b-out)
+ (create-faces f-in b-in)
+ (create-faces f-out b-out)))}
+ \1 {:points (create-points
+ [0 0]
+ [0 1]
+ [1 1]
+ [1 4]
+ [0 4]
+ [0 5]
+ [2 5]
+ [2 1]
+ [3 1]
+ [3 0])
+ :faces (let [front (rangel 10)
+ back (rangel 10 20)]
+ (concat [front back]
+ (create-faces front back)))}})
+
+
+(defn move-object [{:keys [points] :as object} shift]
+ (assoc object
+ :points (mapv #(mapv + % shift) points)))
+
+(defn digits [num]
+ (->> (Integer/toBinaryString num)
+ (seq)
+ (concat [\0 \0 \0 \0 \0])
+ (take-last 6)))
+
+(defn get-objects [num]
+ (let [shift [20 -12 -2.5]]
+ (->> (digits num)
+ (map digits-map)
+ (map-indexed #(move-object %2 [0 (* 4 %1) 0]))
+ (mapv #(move-object % shift)))))
View
184 computer_graphics/projection/src/projection/gui.clj
@@ -0,0 +1,184 @@
+(ns projection.gui
+ (:require [seesaw [core :as sc]
+ [graphics :as sg]]
+ [projection [core :as core]
+ [digits :as digits]])
+ (:import [java.awt.event MouseEvent KeyEvent]))
+
+
+#_(def objects [{:points [[5 1 -1]
+ [5 1 1]
+ [5 -1 1]
+ [5 -1 -1]
+ [3 0 0]]
+ :faces [[0 1 2 3 0]
+ [0 1 4 0]
+ [1 4 2 1]
+ [2 3 4 2]
+ [0 4 3 0]]}])
+
+(def objects (atom []))
+
+(def width 750)
+(def height 750)
+(def angle-sp 0.003)
+(def speed 0.1)
+(def radius 2)
+
+(def config (atom
+ {:VUP [0 0 1]
+ :VPN [1 0 0]
+ :VPN-y [0 1 0]
+ :VPN-z [0 0 1]
+ :u [-0.5 0.5]
+ :v [-0.5 0.5]
+ :COP [0 0 0]
+ :TRG [2 0 0]
+ :focus 1
+ :width width
+ :height height}))
+
+(def cursor (let [img (java.awt.image.BufferedImage. 16, 16, java.awt.image.BufferedImage/TYPE_INT_ARGB)]
+ (.createCustomCursor (java.awt.Toolkit/getDefaultToolkit) img (java.awt.Point. 0 0) "blank cursor")))
+
+(declare frame)
+(def prev-pos (atom nil))
+
+(defn rotate [crds]
+ (let [old @prev-pos]
+ (reset! prev-pos crds)
+ (when-not (nil? old)
+ (let [[dx dy] (map - crds old)
+ a-z (* (- angle-sp) dx)
+ a-y (* (- angle-sp) dy)]
+ (swap! config core/rotate a-y a-z)))))
+
+
+
+(def styles {:point (sg/style :stroke 1 :background "red")
+ :line (sg/style :stroke 1 :foreground "blue")
+ :border (sg/style :stroke 3 :foreground "black")})
+
+(defn draw-points [g points]
+ (doseq [[x y] (remove nil? points)]
+ (sg/draw g
+ (sg/circle x y radius)
+ (styles :point))))
+
+(defn draw-face [g points face]
+ (doseq [[a b] (partition 2 1 face)]
+ (when (every? #(not (nil? (points %))) [a b])
+ (let [[x1 y1] (points a)
+ [x2 y2] (points b)]
+ (sg/draw g
+ (sg/line x1 y1 x2 y2)
+ (styles :line))))))
+
+(defn draw-object [g {:keys [points faces]}]
+ (let [transformed (mapv #(core/transform % @config) points)]
+ (draw-points g transformed)
+ (doseq [face faces] (draw-face g transformed face))))
+
+(defn draw-border [g]
+ (sg/draw g
+ (sg/rect 2 2 (- width 3) (- height 3))
+ (styles :border)))
+
+(defn draw [c g]
+ (doseq [object @objects]
+ (draw-object g object))
+ (draw-border g))
+
+
+(defn left-button [e]
+ (= (.getButton e) (MouseEvent/BUTTON1)))
+
+(defn right-button [e]
+ (= (.getButton e) (MouseEvent/BUTTON3)))
+
+(defn recalculate []
+ (swap! config #(-> % core/calc-parameters core/calc-matrix)))
+
+(defn mouse-dragged [e]
+ (rotate [(.getX e) (.getY e)])
+ (recalculate)
+ (.repaint (sc/select frame [:#canvas])))
+
+(defn mouse-wheel [e]
+ (let [dist (* (.getWheelRotation e) speed -1)
+ move (fn [{:keys [COP VPN] :as config}]
+ (assoc config
+ :COP (mapv + COP (core/mult dist VPN))))]
+ (swap! config move))
+ (recalculate)
+ (.repaint (sc/select frame [:#canvas])))
+
+(defn mouse-pressed [e]
+ (reset! prev-pos [(.getX e) (.getY e)]))
+
+(defn move [{:keys [COP] :as config} dist dir]
+ (assoc config
+ :COP (mapv + COP (core/mult dist (config dir)))))
+
+(def keymap
+ {KeyEvent/VK_W [1 :VPN]
+ KeyEvent/VK_S [-1 :VPN]
+ KeyEvent/VK_A [-1 :VPN-y]
+ KeyEvent/VK_D [1 :VPN-y]
+ KeyEvent/VK_Q [1 :VPN-z]
+ KeyEvent/VK_E [-1 :VPN-z]})
+
+(defn key-pressed [e]
+ (when (contains? keymap (.getKeyCode e))
+ (let [[sign dir] (keymap (.getKeyCode e))
+ mult (if (.isShiftDown e) 10 1)]
+ (swap! config move (* sign speed mult) dir)
+ (recalculate)
+ (.repaint (sc/select frame [:#canvas])))))
+
+
+
+(defn canvas []
+ (let [canvas (sc/canvas :size [width :by height]
+ :paint draw
+ :id :canvas
+ :listen [:mouse-dragged mouse-dragged
+ :mouse-pressed mouse-pressed
+ :key-pressed key-pressed
+ :mouse-wheel-moved mouse-wheel])]
+ (.setCursor canvas cursor)
+ canvas))
+
+(defn create-frame []
+ (sc/frame :title "Hello"
+ :content (canvas)
+ :on-close :dispose))
+
+(defn run-timer []
+ (let [listener (proxy [java.awt.event.ActionListener] []
+ (actionPerformed [e]
+ (reset! objects (digits/get-objects (.getSeconds (java.util.Date.))))
+ (.repaint (sc/select frame [:#canvas]))))]
+ (def timer (javax.swing.Timer. 1000 listener))
+ (.start timer)))
+
+(defn start []
+ (sc/invoke-later
+ (-> frame
+ sc/pack!
+ sc/show!)))
+
+(defn restart []
+ (def frame (create-frame))
+ (.setFocusable (sc/select frame [:#canvas]) true)
+ (run-timer)
+ (recalculate)
+ (start))
+
+(defn stop-timer []
+ (.stop timer))
+
+
+(defn -main [& args]
+ (start))
+
View
7 computer_graphics/projection/test/projection/core_test.clj
@@ -0,0 +1,7 @@
+(ns projection.core-test
+ (:use clojure.test
+ projection.core))
+
+(deftest a-test
+ (testing "FIXME, I fail."
+ (is (= 0 1))))

0 comments on commit 0c6d171

Please sign in to comment.