tasks a-s

Task/Ray-casting-algorithm/Common-Lisp/ray-casting-algorithm-1.lisp

@@ -0,0 +1,30 @@
+(defun point-in-polygon (point polygon)
+  (do ((in-p nil)) ((endp polygon) in-p)
+    (when (ray-intersects-segment point (pop polygon))
+      (setf in-p (not in-p)))))
+
+(defun ray-intersects-segment (point segment &optional (epsilon .001))
+  (destructuring-bind (px . py) point
+    (destructuring-bind ((ax . ay) . (bx . by)) segment
+      (when (< ay by)
+        (rotatef ay by)
+        (rotatef ax bx))
+      (when (or (= py ay) (= py by))
+        (incf py epsilon))
+      (cond
+       ;; point is above, below, or to the right of the rectangle
+       ;; determined by segment; ray does not intesect the segment.
+       ((or (> px (max ax bx)) (> py (max ay by)) (< py (min ay by)))
+        nil)
+       ;; point is to left of the rectangle; ray intersects segment
+       ((< px (min ax bx))
+        t)
+       ;; point is within the rectangle...
+       (t (let ((m-red (if (= ax bx) nil
+                         (/ (- by ay) (- bx ax))))
+                (m-blue (if (= px ax) nil
+                          (/ (- py ay) (- px ax)))))
+            (cond
+             ((null m-blue) t)
+             ((null m-red) nil)
+             (t (>= m-blue m-red)))))))))

Task/Ray-casting-algorithm/Common-Lisp/ray-casting-algorithm-2.lisp

@@ -0,0 +1,35 @@
+(defparameter *points*
+  #((0 . 0) (10 . 0) (10 . 10) (0 . 10)
+    (2.5 . 2.5) (7.5 . 2.5) (7.5 . 7.5) (2.5 . 7.5)
+    (0 . 5) (10 . 5) (3 . 0) (7 . 0)
+    (7 . 10) (3 . 10)))
+
+(defun create-polygon (indices &optional (points *points*))
+  (loop for (a b) on indices by 'cddr
+        collecting (cons (aref points (1- a))
+                         (aref points (1- b)))))
+
+(defun square ()
+  (create-polygon '(1 2 2 3 3 4 4 1)))
+
+(defun square-hole ()
+  (create-polygon '(1 2 2 3 3 4 4 1 5 6 6 7 7 8 8 5)))
+
+(defun strange ()
+  (create-polygon '(1 5 5 4 4 8 8 7 7 3 3 2 2 5)))
+
+(defun exagon ()
+  (create-polygon '(11 12 12 10 10 13 13 14 14 9 9 11)))
+
+(defparameter *test-points*
+  #((5 . 5) (5 . 8) (-10 . 5) (0 . 5)
+    (10 . 5) (8 . 5) (10 . 10)))
+
+(defun test-pip ()
+  (dolist (shape '(square square-hole strange exagon))
+    (print shape)
+    (loop with polygon = (funcall shape)
+          for test-point across *test-points*
+          do (format t "~&~w ~:[outside~;inside ~]."
+                     test-point
+                     (point-in-polygon test-point polygon)))))