Permalink
Browse files

Add polygon intersection project.

  • Loading branch information...
nbeloglazov committed Apr 8, 2012
1 parent 6c42015 commit 5239cfababe75df0fae4b824702d8676bc0193e1
@@ -0,0 +1,8 @@
+/pom.xml
+*jar
+/lib
+/classes
+/native
+/.lein-failures
+/checkouts
+/.lein-deps-sum
@@ -0,0 +1,13 @@
+# polygon_intersection
+
+FIXME: write description
+
+## Usage
+
+FIXME: write
+
+## License
+
+Copyright (C) 2012 FIXME
+
+Distributed under the Eclipse Public License, the same as Clojure.
@@ -0,0 +1,4 @@
+(defproject polygon_intersection "1.0.0-SNAPSHOT"
+ :description "FIXME: write description"
+ :dependencies [[org.clojure/clojure "1.3.0"]
+ [seesaw "1.4.0"]])
@@ -0,0 +1,78 @@
+(ns polygon-intersection.core
+ (:require [seesaw [core :as sc]
+ [graphics :as sg]]
+ [polygon-intersection [intersection :as intersection]])
+ (:import [java.awt.event MouseEvent KeyEvent]))
+
+(def width 1200)
+(def height 700)
+(def polygon (atom []))
+(def view (atom []))
+(def inters (atom []))
+
+(declare frame)
+
+(def styles {polygon (sg/style :stroke 1 :foreground "black")
+ view (sg/style :stroke 1 :foreground "blue")
+ inters (sg/style :stroke 3 :foreground "red" :background "red")})
+
+(defn draw-polygon [g polygon]
+ (println @polygon)
+ (sg/draw g
+ (apply sg/polygon @polygon)
+ (styles polygon)))
+
+(defn draw [c g]
+ (doseq [p [polygon view inters]]
+ (draw-polygon g p)))
+
+
+(defn left-button [e]
+ (= (.getButton e) (MouseEvent/BUTTON1)))
+
+(defn right-button [e]
+ (= (.getButton e) (MouseEvent/BUTTON3)))
+
+(defn add-point [polygon event]
+ (swap! polygon conj [(.getX event)
+ (.getY event)]))
+
+(defn mouse-clicked [e]
+ (cond (and (.isShiftDown e) (left-button e))
+ (reset! inters (intersection/polygon-polygon @view 1 @polygon))
+ (and (.isShiftDown e) (right-button e))
+ (do (reset! polygon [])
+ (reset! view [])
+ (reset! inters []))
+ (left-button e)
+ (add-point polygon e)
+ (right-button e)
+ (add-point view e))
+ (.repaint (sc/select frame [:#canvas])))
+
+(defn canvas []
+ (sc/canvas :size [width :by height]
+ :paint draw
+ :id :canvas
+ :listen [:mouse-clicked mouse-clicked
+ :key-pressed key-clicked]))
+
+(defn create-frame []
+ (sc/frame :title "Hello"
+ :content (canvas)
+ :on-close :dispose))
+
+
+(defn start []
+ (sc/invoke-later
+ (-> frame
+ sc/pack!
+ sc/show!)))
+
+(defn restart []
+ (def frame (create-frame))
+ (start))
+
+(defn -main [& args]
+ (start))
+
@@ -0,0 +1,54 @@
+(ns polygon-intersection.intersection)
+
+(defn vec-mult [[x0 y0] [x1 y1] [x2 y2] [x3 y3]]
+ (let [dx1 (- x1 x0)
+ dy1 (- y1 y0)
+ dx2 (- x3 x2)
+ dy2 (- y3 y2)]
+ (- (* dx1 dy2) (* dx2 dy1))))
+
+(defn line-segment-intersection [[lx0 ly0 :as l0]
+ [lx1 ly1 :as l1]
+ [sx0 sy0 :as s0]
+ [sx1 sy1 :as s1]]
+ (let [ldx (- lx1 lx0)
+ ldy (- ly1 ly0)
+ sdx (- sx1 sx0)
+ sdy (- sy1 sy0)
+ t (/ (- (* ldx (- sy0 ly0))
+ (* ldy (- sx0 lx0)))
+ (vec-mult l0 l1 s0 s1)
+ -1.0)]
+ [(+ sx0 (* t sdx))
+ (+ sy0 (* t sdy))]))
+
+(defn visible? [lp0 lp1 point sign]
+ (>= (* (vec-mult lp0 lp1 lp0 point)
+ sign)
+ 0))
+
+(defn line-segment [[lp0 lp1] [sp0 sp1] sign]
+ (let [p0-visible? (visible? lp0 lp1 sp0 sign)
+ p1-visible? (visible? lp0 lp1 sp1 sign)]
+ (cond (and p0-visible? p1-visible?)
+ [sp1]
+ (and p0-visible? (not p1-visible?))
+ [(line-segment-intersection lp0 lp1 sp0 sp1)]
+ (and (not p0-visible?) p1-visible?)
+ [(line-segment-intersection lp0 lp1 sp0 sp1) sp1]
+ :default
+ [])))
+
+(defn line-polygon [line sign polygon]
+ (->> (cons (last polygon) polygon)
+ (partition 2 1)
+ (map #(line-segment line % sign))
+ (apply concat)))
+
+(defn polygon-polygon [view sign polygon]
+ (->> (cons (last view) view)
+ (partition 2 1)
+ (reduce #(line-polygon %2 sign %1) polygon)))
+
+
+
@@ -0,0 +1,6 @@
+(ns polygon_intersection.test.core
+ (:use [polygon_intersection.core])
+ (:use [clojure.test]))
+
+(deftest replace-me ;; FIXME: write
+ (is false "No tests have been written."))

0 comments on commit 5239cfa

Please sign in to comment.