Add rotation

posn/main.scrbl

@@ -17,3 +17,4 @@ source code: @url["https://github.com/jackfirth/racket-posn"]
 @scribble-include/no-subsection["private/add.scrbl"]
 @scribble-include/no-subsection["private/multiply.scrbl"]
 @scribble-include/no-subsection["private/scale.scrbl"]
+@scribble-include/no-subsection["private/rotate.scrbl"]

posn/private/degrees.rkt

@@ -0,0 +1,29 @@
+#lang racket/base
+
+(require racket/contract
+         racket/math)
+
+(provide
+ (contract-out
+  [tau radians?]
+  [degrees? predicate/c]
+  [radians? predicate/c]
+  [modulo-degrees (-> real? degrees?)]
+  [modulo-radians (-> real? radians?)]))
+
+
+(define tau (* 2 pi))
+
+(define (degrees? x)
+  (and (real? x)
+       (<= 0 x 360)))
+
+(define (radians? x)
+  (and (real? x)
+       (<= 0 x tau)))
+
+(define (modulo-degrees x)
+  (modulo x 360))
+
+(define (modulo-radians x)
+  (modulo x tau))

posn/private/main.rkt

@@ -4,11 +4,13 @@ require
   "add.rkt"
   "base.rkt"
   "multiply.rkt"
+  "rotate.rkt"
   "scale.rkt"
 
 provide
   all-from-out
     "add.rkt"
     "base.rkt"
     "multiply.rkt"
+    "rotate.rkt"
     "scale.rkt"

posn/private/rotate.rkt

@@ -0,0 +1,76 @@
+#lang sweet-exp racket/base
+
+require racket/contract/base
+
+provide
+  contract-out
+    posn-rotate-origin-ccw-90 (-> posn? posn?)
+    posn-rotate-origin-ccw-180 (-> posn? posn?)
+    posn-rotate-origin-ccw-270 (-> posn? posn?)
+    posn-rotate-origin-ccw (-> degrees? posn? posn?)
+
+require fancy-app
+        racket/match
+        racket/math
+        "base.rkt"
+        "degrees.rkt"
+
+module+ test
+  require rackunit
+
+
+module+ test
+  (define current-tolerance (make-parameter 0.000000001))
+  (define (tolerance=? a b)
+    (<= (abs (- a b)) (current-tolerance)))
+  (define-check (check-posn=? actual-posn expected-posn)
+    (let ()
+      (match-define (posn actual-x actual-y) actual-posn)
+      (match-define (posn expected-x expected-y) expected-posn)
+      (and (tolerance=? actual-x expected-x)
+           (tolerance=? actual-y expected-y))))
+
+
+(define (posn-rotate-origin-ccw-90 a-posn)
+  (match-define (posn x y) a-posn)
+  (posn (- y) x))
+
+module+ test
+  (check-equal? (posn-rotate-origin-ccw-90 (posn 2 1)) (posn -1 2))
+
+
+(define (posn-rotate-origin-ccw-180 a-posn)
+  (match-define (posn x y) a-posn)
+  (posn (- x) (- y)))
+
+module+ test
+  (check-equal? (posn-rotate-origin-ccw-180 (posn 2 1)) (posn -2 -1))
+
+
+(define (posn-rotate-origin-ccw-270 a-posn)
+  (match-define (posn x y) a-posn)
+  (posn y (- x)))
+
+module+ test
+  (check-equal? (posn-rotate-origin-ccw-270 (posn 2 1)) (posn 1 -2))
+
+
+(define (posn-rotate-origin-ccw angle a-posn)
+  (define theta (degrees->radians angle))
+  (match-define (posn x y) a-posn)
+  (define sin-t (sin theta))
+  (define cos-t (cos theta))
+  (define -sin-t (- sin-t))
+  (define x2 (+ (* cos-t x) (* -sin-t y)))
+  (define y2 (+ (* sin-t x) (* cos-t y)))
+  (posn x2 y2))
+
+module+ test
+  (check-posn=? (posn-rotate-origin-ccw 90 (posn 1 2))
+                (posn-rotate-origin-ccw-90 (posn 1 2)))
+  (check-posn=? (posn-rotate-origin-ccw 180 (posn 1 2))
+                (posn-rotate-origin-ccw-180 (posn 1 2)))
+  (check-posn=? (posn-rotate-origin-ccw 270 (posn 1 2))
+                (posn-rotate-origin-ccw-270 (posn 1 2)))
+  (check-posn=? (posn-rotate-origin-ccw 45 (posn 1 1))
+                (posn 0 (sqrt 2)))

posn/private/rotate.scrbl

@@ -0,0 +1,34 @@
+#lang scribble/manual
+
+@(require "util/doc.rkt")
+
+
+@defproc[(posn-rotate-origin-ccw-90 [a-posn posn?]) posn?]{
+  Returns @racket[a-posn] rotated ninety degrees counter
+  clockwise around the origin.
+  @posn-examples[
+    (posn-rotate-origin-ccw-90 (posn 2 1))
+]}
+
+@defproc[(posn-rotate-origin-ccw-180 [a-posn posn?]) posn?]{
+  Returns @racket[a-posn] rotated one hundred and eighty
+  degrees counter clockwise around the origin.
+  @posn-examples[
+    (posn-rotate-origin-ccw-180 (posn 2 1))
+]}
+
+@defproc[(posn-rotate-origin-ccw-270 [a-posn posn?]) posn?]{
+  Returns @racket[a-posn] rotated two hundred and seventy
+  degrees counter clockwise around the origin.
+  @posn-examples[
+    (posn-rotate-origin-ccw-270 (posn 2 1))
+]}
+
+@defproc[(posn-rotate-origin-ccw [degrees (between/c 0 360)]
+                                 [a-posn posn?])
+         posn?]{
+  Returns @racket[a-posn] rotated @racket[degrees] counter
+  clockwise around the origin.
+  @posn-examples[
+    (posn-rotate-origin-ccw 70 (posn 1 1))
+]}