aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/utils.lisp
blob: 7024a8d2a01543b9adfdbcdabb5d304b577c5e1b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
;;;; utils.lisp

(in-package #:wheelwork)

(define-symbol-macro +pi-over-180+ 0.017453292519943295d0)

(defun radians (degrees)
  "Converse DEGREES to radians"
  (* degrees +pi-over-180+))

(defun safe-slot (object slot &optional default)
  (if-let (val (and (slot-exists-p object slot)
                    (slot-boundp object slot)
                    (slot-value object slot)))
    val
    default))

(defun counterclockwisep (a b c)
  "A B and C are vectors created by 3d-vectors:vec, each representing
a 2d point.  Returns T if the three are supplied in counterclockwise
order, nil if not."
  (> (* (- (vec:vx b) (vec:vx a))
        (- (vec:vy c) (vec:vy a)))
     (* (- (vec:vy b) (vec:vy a))
        (- (vec:vx c) (vec:vx a)))))


(defun intersectp (a b c d)
  "A B C and D are vectors of the sort created by 3d-vectors:vec,
each representing a 2d point.  Returns T if the line segment between A
and B intersects the linesegment between C and D, NIL otherwise."
  (or (vec:v= a c) (vec:v= a d) (vec:v= b c) (vec:v= b d)
      (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d)))
           (not (eq (counterclockwisep a b c) (counterclockwisep a b d))))))

(defun path-bounds (path)
  "Path is a list of vectors representing 2d points. Returns the
bounds and width and height as a plist of the form 

(:top N :left N :right N :bottom N :width N :height N)

This is the smallest UNROTATED RECTANGLE that contains the points in
the path."
  (loop
    with max-x = nil
    and max-y = nil
    and min-x = nil
    and min-y = nil
    for vec in path
    for x = (vec:vx vec)
    for y = (vec:vy vec)
    when (or (null max-x) (< max-x x))
      do (setf max-x x)
    when (or (null min-x) (< x min-x))
      do (setf min-x x)
    when (or (null max-y) (< max-y y))
      do (setf max-y y)
    when (or (null min-y) (< y min-y))
      do (setf min-y y)
    finally
       (return (list :top max-y :left min-x :right max-x :bottom min-y
                     :width (- max-x min-x)
                     :height (- max-y min-y)))))