Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Add projection project.

  • Loading branch information...
commit 0c6d1712bffe6560639c8069cb61fbd036d3885b 1 parent 58ed350
Nikita Beloglazov authored April 24, 2012
10  computer_graphics/projection/.gitignore
... ...
@@ -0,0 +1,10 @@
  1
+/target
  2
+/lib
  3
+/classes
  4
+/checkouts
  5
+pom.xml
  6
+*.jar
  7
+*.class
  8
+.lein-deps-sum
  9
+.lein-failures
  10
+.lein-plugins
15  computer_graphics/projection/README.md
Source Rendered
... ...
@@ -0,0 +1,15 @@
  1
+# projection
  2
+
  3
+I'm an app. Or maybe I'm a library? I haven't decided yet. 
  4
+
  5
+The choice is up to you!
  6
+
  7
+## Usage
  8
+
  9
+FIXME
  10
+
  11
+## License
  12
+
  13
+Copyright © 2012 FIXME
  14
+
  15
+Distributed under the Eclipse Public License, the same as Clojure.
3  computer_graphics/projection/project.clj
... ...
@@ -0,0 +1,3 @@
  1
+(defproject projection "0.1.0-SNAPSHOT"
  2
+  :dependencies [[org.clojure/clojure "1.4.0"]
  3
+                 [seesaw "1.4.0"]])
111  computer_graphics/projection/src/projection/core.clj
... ...
@@ -0,0 +1,111 @@
  1
+(ns projection.core)
  2
+
  3
+(defn transpose [mat]
  4
+  (apply mapv vector mat))
  5
+
  6
+(defn scalar-mult [a b]
  7
+  (apply + (map * a b)))
  8
+
  9
+(defn vector-mult [[x1 y1 z1] [x2 y2 z2]]
  10
+  (mapv #(* -1 %)
  11
+  [(- (* y1 z2) (* z1 y2))
  12
+   (- (* z1 x2) (* z2 x1))
  13
+   (- (* x1 y2) (* y1 x2))]))
  14
+
  15
+(defn mult [scalar v]
  16
+  (mapv #(* scalar %) v))
  17
+
  18
+(defn matrix-mult [a b]
  19
+  (let [t-b (transpose b)]
  20
+    (mapv (fn [row] (mapv #(scalar-mult row %) t-b)) a)))
  21
+
  22
+(defn norm [v]
  23
+  (->> (mapv #(* % %) v)
  24
+       (apply +)
  25
+       (Math/sqrt)))
  26
+
  27
+(defn normalize [v]
  28
+  (let [v-norm (norm v)]
  29
+    (mapv #(/ % v-norm) v)))
  30
+
  31
+(defn R-mat [{:keys [VPN VUP]}]
  32
+  (let [r-z (mult -1 VPN)
  33
+        r-x (normalize (vector-mult VPN VUP))
  34
+        r-y (vector-mult r-x r-z)]
  35
+    (transpose [(conj r-x 0)
  36
+                (conj r-y 0)
  37
+                (conj r-z 0)
  38
+                [0 0 0 1]])))
  39
+
  40
+(defn rotation-matrix [a [x y z]]
  41
+  (let [c (Math/cos a)
  42
+        s (Math/sin a)]
  43
+    [[(+ c (* x x (- 1 c))) (- (* x y (- 1 c)) (* z s)) (+ (* x z (- 1 c)) (* y s))]
  44
+     [(+ (* x y (- 1 c)) (* z s)) (+ c (* y y (- 1 c))) (- (* y z (- 1 c)) (* x s))]
  45
+     [(- (* z x (- 1 c)) (* y s)) (+ (* z y (- 1 c)) (* x s)) (+ c (* z z (- 1 c)))]]))
  46
+
  47
+(defn rotate [{:keys [VPN VPN-y VPN-z] :as config} a-y a-z]
  48
+  (let [rot (matrix-mult (rotation-matrix  a-y VPN-y)
  49
+                         (rotation-matrix  a-z VPN-z))]
  50
+    (reduce #(update-in %1 [%2] (fn [v] (first (matrix-mult [v] rot)))) config [:VPN :VPN-y :VPN-z])))
  51
+
  52
+(defn S-mat [x y z]
  53
+  [[x 0 0 0]
  54
+   [0 y 0 0]
  55
+   [0 0 z 0]
  56
+   [0 0 0 1]])
  57
+
  58
+(defn T-mat [x y z]
  59
+  [[1 0 0 0]
  60
+   [0 1 0 0]
  61
+   [0 0 1 0]
  62
+   [x y z 1]])
  63
+
  64
+(defn M-mat [z-min]
  65
+  (let [z (- z-min)]
  66
+   [[1 0 0 0]
  67
+    [0 1 0 0]
  68
+    [0 0 (/ (inc z)) 1]
  69
+    [0 0 (/ z (inc z)) 0]]))
  70
+
  71
+
  72
+(defn calc-parameters [{:keys [COP TRG focus VPN] :as config}]
  73
+  (let [VRP (mapv + COP (mult focus VPN))
  74
+        F (* -0.9 focus)]
  75
+    (merge config
  76
+           {:VRP VRP
  77
+            :F F
  78
+            :B 1000})))
  79
+
  80
+(defn calc-matrix [{:keys [VPN VUP VRP COP B F width height] :as config}]
  81
+  (let [T (apply T-mat (mult -1 COP))
  82
+        R (R-mat config)
  83
+        T-pl (S-mat 1 1 -1)
  84
+        mid (reduce matrix-mult [T R T-pl])
  85
+        [[w-x w-y w-z _]] (matrix-mult [(conj VRP 1)] mid)
  86
+        [a b] (mapv #(/ % w-z -1) [w-x w-y])
  87
+        Sh [[1 0 0 0]
  88
+            [0 1 0 0]
  89
+            [a b 1 0]
  90
+            [0 0 0 1]]
  91
+        S (S-mat(/ w-z 0.5 (+ w-z B)) (/ w-z 0.5 (+ w-z B)) (/ (+ w-z B)))
  92
+        z-min (/ (+ w-z F) (+ w-z B))
  93
+        M (M-mat z-min)]
  94
+    ;(println "T" T)
  95
+    ;(println "R" R)
  96
+    ;(println "Sh" Sh)
  97
+                                        ;(println "S" S)
  98
+    ;(println M)
  99
+    ;(println z-min)
  100
+    (assoc config
  101
+      :matrix (reduce matrix-mult [mid Sh S])
  102
+      :matrix-2 (reduce matrix-mult [M (T-mat 1 1 0) (S-mat 0.5 0.5 1) (S-mat width height 1)])
  103
+      :z-min z-min)))
  104
+
  105
+(defn transform [point {:keys [matrix matrix-2 z-min]}]
  106
+  (let [[p] (matrix-mult [(conj point 1)] matrix)]
  107
+    (if (<= z-min (p 2) 1)
  108
+      (let [[pp] (matrix-mult [p] matrix-2)]
  109
+        (->> (mapv #(/ % (last pp)) pp)
  110
+             (take 2)))
  111
+      nil)))
71  computer_graphics/projection/src/projection/digits.clj
... ...
@@ -0,0 +1,71 @@
  1
+(ns projection.digits)
  2
+
  3
+(defn create-points [& points]
  4
+  (concat (map #(cons 0 %) points)
  5
+          (map #(cons 1 %) points)))
  6
+
  7
+(defn conjv [s v]
  8
+  (conj (vec s) v))
  9
+
  10
+(defn rangel
  11
+  ([start end]
  12
+     (conjv (range start end) start))
  13
+  ([end]
  14
+     (rangel 0 end)))
  15
+
  16
+(defn create-faces [s1 s2]
  17
+  (map (fn [[f0 f1] [b0 b1]] [f0 f1 b1 b0 f0])
  18
+       (partition 2 1 s1)
  19
+       (partition 2 1 s2)))
  20
+
  21
+(def digits-map
  22
+  {\0 {:points (create-points
  23
+                [0 0]
  24
+                [0 5]
  25
+                [3 5]
  26
+                [3 0]
  27
+                [1 1]
  28
+                [1 4]
  29
+                [2 4]
  30
+                [2 1])
  31
+       :faces (let [f-out (rangel 4)
  32
+                    f-in (rangel 4 8)
  33
+                    b-out (rangel 8 12)
  34
+                    b-in (rangel 12 16)]
  35
+                (concat (create-faces f-in f-out)
  36
+                        (create-faces b-in b-out)
  37
+                        (create-faces f-in b-in)
  38
+                        (create-faces f-out b-out)))}
  39
+   \1 {:points (create-points
  40
+                [0 0]
  41
+                [0 1]
  42
+                [1 1]
  43
+                [1 4]
  44
+                [0 4]
  45
+                [0 5]
  46
+                [2 5]
  47
+                [2 1]
  48
+                [3 1]
  49
+                [3 0])
  50
+       :faces (let [front (rangel 10)
  51
+                    back (rangel 10 20)]
  52
+                (concat [front back]
  53
+                        (create-faces front back)))}})
  54
+
  55
+
  56
+(defn move-object [{:keys [points] :as object} shift]
  57
+  (assoc object
  58
+    :points (mapv #(mapv + % shift) points)))
  59
+
  60
+(defn digits [num]
  61
+  (->> (Integer/toBinaryString num)
  62
+       (seq)
  63
+       (concat [\0 \0 \0 \0 \0])
  64
+       (take-last 6)))
  65
+
  66
+(defn get-objects [num]
  67
+  (let [shift [20 -12 -2.5]]
  68
+    (->> (digits num)
  69
+         (map digits-map)
  70
+         (map-indexed #(move-object %2 [0 (* 4 %1) 0]))
  71
+         (mapv #(move-object % shift)))))
184  computer_graphics/projection/src/projection/gui.clj
... ...
@@ -0,0 +1,184 @@
  1
+(ns projection.gui
  2
+  (:require [seesaw [core :as sc]
  3
+                    [graphics :as sg]]
  4
+            [projection [core :as core]
  5
+                        [digits :as digits]])
  6
+  (:import [java.awt.event MouseEvent KeyEvent]))
  7
+
  8
+
  9
+#_(def objects [{:points [[5 1 -1]
  10
+                        [5 1 1]
  11
+                        [5 -1 1]
  12
+                        [5 -1 -1]
  13
+                        [3 0 0]]
  14
+               :faces [[0 1 2 3 0]
  15
+                       [0 1 4 0]
  16
+                       [1 4 2 1]
  17
+                       [2 3 4 2]
  18
+                       [0 4 3 0]]}])
  19
+
  20
+(def objects (atom []))
  21
+
  22
+(def width 750)
  23
+(def height 750)
  24
+(def angle-sp 0.003)
  25
+(def speed 0.1)
  26
+(def radius 2)
  27
+
  28
+(def config (atom
  29
+             {:VUP [0 0 1]
  30
+              :VPN [1 0 0]
  31
+              :VPN-y [0 1 0]
  32
+              :VPN-z [0 0 1]
  33
+              :u [-0.5 0.5]
  34
+              :v [-0.5 0.5]
  35
+              :COP [0 0 0]
  36
+              :TRG [2 0 0]
  37
+              :focus 1
  38
+              :width width
  39
+              :height height}))
  40
+
  41
+(def cursor (let [img (java.awt.image.BufferedImage. 16, 16, java.awt.image.BufferedImage/TYPE_INT_ARGB)]
  42
+              (.createCustomCursor (java.awt.Toolkit/getDefaultToolkit) img (java.awt.Point. 0 0) "blank cursor")))
  43
+
  44
+(declare frame)
  45
+(def prev-pos (atom nil))
  46
+
  47
+(defn rotate [crds]
  48
+  (let [old @prev-pos]
  49
+    (reset! prev-pos crds)
  50
+    (when-not (nil? old)
  51
+      (let [[dx dy] (map - crds old)
  52
+            a-z (* (- angle-sp) dx)
  53
+            a-y (* (- angle-sp) dy)]
  54
+        (swap! config core/rotate a-y a-z)))))
  55
+
  56
+
  57
+
  58
+(def styles {:point (sg/style :stroke 1 :background "red")
  59
+             :line (sg/style :stroke 1 :foreground "blue")
  60
+             :border (sg/style :stroke 3 :foreground "black")})
  61
+
  62
+(defn draw-points [g points]
  63
+  (doseq [[x y] (remove nil? points)]
  64
+    (sg/draw g
  65
+             (sg/circle x y radius)
  66
+             (styles :point))))
  67
+
  68
+(defn draw-face [g points face]
  69
+  (doseq [[a b] (partition 2 1 face)]
  70
+    (when (every? #(not (nil? (points %))) [a b])
  71
+      (let [[x1 y1] (points a)
  72
+            [x2 y2] (points b)]
  73
+        (sg/draw g
  74
+                 (sg/line x1 y1 x2 y2)
  75
+                 (styles :line))))))
  76
+
  77
+(defn draw-object [g {:keys [points faces]}]
  78
+  (let [transformed (mapv #(core/transform % @config) points)]
  79
+    (draw-points g transformed)
  80
+    (doseq [face faces] (draw-face g transformed face))))
  81
+
  82
+(defn draw-border [g]
  83
+  (sg/draw g
  84
+           (sg/rect 2 2 (- width 3) (- height 3))
  85
+           (styles :border)))
  86
+
  87
+(defn draw [c g]
  88
+  (doseq [object @objects]
  89
+    (draw-object g object))
  90
+  (draw-border g))
  91
+
  92
+
  93
+(defn left-button [e]
  94
+  (= (.getButton e) (MouseEvent/BUTTON1)))
  95
+
  96
+(defn right-button [e]
  97
+  (= (.getButton e) (MouseEvent/BUTTON3)))
  98
+
  99
+(defn recalculate []
  100
+  (swap! config #(-> % core/calc-parameters core/calc-matrix)))
  101
+
  102
+(defn mouse-dragged [e]
  103
+  (rotate [(.getX e) (.getY e)])
  104
+  (recalculate)
  105
+  (.repaint (sc/select frame [:#canvas])))
  106
+
  107
+(defn mouse-wheel [e]
  108
+  (let [dist (* (.getWheelRotation e) speed -1)
  109
+        move (fn [{:keys [COP VPN] :as config}]
  110
+               (assoc config
  111
+                 :COP (mapv + COP (core/mult dist VPN))))]
  112
+    (swap! config move))
  113
+  (recalculate)
  114
+  (.repaint (sc/select frame [:#canvas])))
  115
+
  116
+(defn mouse-pressed [e]
  117
+  (reset! prev-pos [(.getX e) (.getY e)]))
  118
+
  119
+(defn move [{:keys [COP] :as config} dist dir]
  120
+  (assoc config
  121
+    :COP (mapv + COP (core/mult dist (config dir)))))
  122
+
  123
+(def keymap
  124
+  {KeyEvent/VK_W [1 :VPN]
  125
+   KeyEvent/VK_S [-1 :VPN]
  126
+   KeyEvent/VK_A [-1 :VPN-y]
  127
+   KeyEvent/VK_D [1 :VPN-y]
  128
+   KeyEvent/VK_Q [1 :VPN-z]
  129
+   KeyEvent/VK_E [-1 :VPN-z]})
  130
+
  131
+(defn key-pressed [e]
  132
+  (when (contains? keymap (.getKeyCode e))
  133
+    (let [[sign dir] (keymap (.getKeyCode e))
  134
+          mult (if (.isShiftDown e) 10 1)]
  135
+      (swap! config move (* sign speed mult) dir)
  136
+      (recalculate)
  137
+      (.repaint (sc/select frame [:#canvas])))))
  138
+
  139
+
  140
+
  141
+(defn canvas []
  142
+  (let [canvas (sc/canvas :size [width :by height]
  143
+                          :paint draw
  144
+                          :id :canvas
  145
+                          :listen [:mouse-dragged mouse-dragged
  146
+                                   :mouse-pressed mouse-pressed
  147
+                                   :key-pressed key-pressed
  148
+                                   :mouse-wheel-moved mouse-wheel])]
  149
+    (.setCursor canvas cursor)
  150
+    canvas))
  151
+
  152
+(defn create-frame []
  153
+  (sc/frame :title "Hello"
  154
+            :content (canvas)
  155
+            :on-close :dispose))
  156
+
  157
+(defn run-timer []
  158
+  (let [listener (proxy [java.awt.event.ActionListener] []
  159
+                   (actionPerformed [e]
  160
+                     (reset! objects (digits/get-objects (.getSeconds (java.util.Date.))))
  161
+                     (.repaint (sc/select frame [:#canvas]))))]
  162
+    (def timer (javax.swing.Timer. 1000 listener))
  163
+    (.start timer)))
  164
+
  165
+(defn start []
  166
+  (sc/invoke-later
  167
+   (-> frame
  168
+       sc/pack!
  169
+       sc/show!)))
  170
+
  171
+(defn restart []
  172
+  (def frame (create-frame))
  173
+  (.setFocusable (sc/select frame [:#canvas]) true)
  174
+  (run-timer)
  175
+  (recalculate)
  176
+  (start))
  177
+
  178
+(defn stop-timer []
  179
+  (.stop timer))
  180
+
  181
+
  182
+(defn -main [& args]
  183
+  (start))
  184
+
7  computer_graphics/projection/test/projection/core_test.clj
... ...
@@ -0,0 +1,7 @@
  1
+(ns projection.core-test
  2
+  (:use clojure.test
  3
+        projection.core))
  4
+
  5
+(deftest a-test
  6
+  (testing "FIXME, I fail."
  7
+    (is (= 0 1))))

0 notes on commit 0c6d171

Please sign in to comment.
Something went wrong with that request. Please try again.