From 64c3a98e45bda91b39eb811456ab409b72f0936e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jens=20Axel=20S=C3=B8gaard?= <jensaxel@soegaard.net>
Date: Thu, 5 Aug 2010 18:18:06 +0200
Subject: [PATCH] Added triangle/sss, triangle/ass, triangle/sas, triangle/ssa,
 triangle/aas, triangle/asa, and, triangle/saa.

---
 collects/2htdp/image.rkt              |   7 ++
 collects/2htdp/private/image-more.rkt | 114 ++++++++++++++++++++++++++
 collects/2htdp/private/img-err.rkt    |   5 +-
 collects/htdp/error.rkt               |   7 +-
 4 files changed, 130 insertions(+), 3 deletions(-)

diff --git a/collects/2htdp/image.rkt b/collects/2htdp/image.rkt
index ce8b406d65..35cca9e859 100644
--- a/collects/2htdp/image.rkt
+++ b/collects/2htdp/image.rkt
@@ -89,6 +89,13 @@ and they all have good sample contracts. (It is amazing what we can do with kids
          star-polygon
          radial-star
          triangle
+         triangle/sss
+         triangle/ssa
+         triangle/sas
+         triangle/ass
+         triangle/aas
+         triangle/asa
+         triangle/saa
          isosceles-triangle
          right-triangle
          line
diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt
index baf6ecccdc..5486da5b76 100644
--- a/collects/2htdp/private/image-more.rkt
+++ b/collects/2htdp/private/image-more.rkt
@@ -900,10 +900,116 @@
   (check-mode/color-combination 'triangle 3 mode color)
   (make-polygon/star side-length 3 mode color values))
 
+; excess : R+ R+ -> R
+;  compute the Euclidean excess
+;  Note: If the excess is 0, the the C is 90 deg.
+;        If the excess is negative, then C is obtuse.
+;        If the excess is positive, then C is acuse.
+(define (excess a b c)
+  (+ (sqr a) (sqr b) (- (sqr c))))
+
+; polar->posn : R+ R -> (posn R R)
+;  return a position with x and y coordinates
+(define (polar->posn radius angle)
+  (make-posn (* radius (cos angle))
+             (* radius (sin angle))))
+
+; cos-rel : R R R -> R+
+;   return c^2 = a^2 + b^2 - 2ab cos(C)
+(define (cos-rel a b C)
+  (+ (sqr a) (sqr b) (* -2 a b (cos C))))
+
+; sin-rel : R R R -> R
+;  return the side b
+(define (sin-rel A a B)
+  (/ (* a (sin B)) (sin A)))
+
+; last-angle : R R -> R
+;   return pi-(A+B)
+(define (last-angle A B)
+  (- pi A B))
+
+(define (radians degree)
+  (* (/ degree 180.0) pi))
+
+
+(define (triangle/sss side-a side-b side-c mode color)
+  (define (triangle-vertices/sss a b c)
+    (let ([A (acos (/ (excess b c a) (* 2 b c)))])
+      (list (make-posn 0 0)
+            (make-posn c 0)
+            (polar->posn b A))))
+  (check-dependencies 'triangle/sss
+                      (and (>= (+ side-a side-b) side-c) 
+                           (>= (+ side-a side-c) side-b) 
+                           (>= (+ side-b side-c) side-a))
+                      "the given side lengths will not form a triangle ~a, ~a, and, ~a."
+                      side-a side-b side-c)
+  (polygon (triangle-vertices/sss side-a side-b side-c) mode color))
+
+(define/chk (triangle/ass angle-a side-b side-c mode color)
+  (define (triangle-vertices/ass A b c)
+    (list (make-posn 0 0) (make-posn c 0) (polar->posn b A)))
+  (polygon (triangle-vertices/ass angle-a side-b side-c) mode color))
+
+(define/chk (triangle/sas side-a angle-b side-c mode color)
+  (define (triangle-vertices/sas a B c)
+    (let ([b^2 (cos-rel a c B)])
+      (check-dependencies 'triangle/sas
+                          "the given side, angle, and, side will not form a triangle ~a, ~a, and, ~a."
+                          side-a angle-b side-c)
+      (let* ([b (sqrt b^2)]
+             [A (acos (/ (excess b c a) (* 2 b c)))])
+        (list (make-posn 0 0) (make-posn c 0) (polar->posn b A)))))
+  (polygon (triangle-vertices/sas side-a (radians angle-b) side-c) mode color))
+(define/chk (triangle/ssa side-a side-b angle-c mode color)
+  (define (triangle-vertices/ssa a b C)
+    (let ([c^2 (cos-rel a b C)])
+      (check-dependencies 'triangle/ssa 
+                          (positive? c^2)
+                          "the given side, side, and, angle will not form a triangle ~a, ~a, and, ~a."
+                          side-a side-b angle-c)
+      (let*([c (sqrt c^2)]
+            [A (acos (/ (excess b c a) (* 2 b c)))])
+        (list (make-posn 0 0)
+              (make-posn c 0)
+              (polar->posn b A)))))
+  (polygon (triangle-vertices/ssa side-a side-b (radians angle-c)) mode color))
+
+(define/chk (triangle/aas angle-a angle-b side-c mode color)
+  (define (triangle-vertices/aas A B c)
+    (let* ([C (last-angle A B)]
+           [b (sin-rel C c B)])
+      (list (make-posn 0 0) (make-posn c 0) (polar->posn b A))))
+  (polygon (triangle-vertices/aas (radians angle-a) (radians angle-b) side-c) mode color))
+
+(define/chk (triangle/asa angle-a side-b angle-c mode color)
+  (define (triangle-vertices/asa A b C)
+    (let* ([B (last-angle A C)]
+           [c (sin-rel B b C)])
+      (list (make-posn 0 0) (make-posn c 0) (polar->posn b A))))
+  (polygon (triangle-vertices/asa (radians angle-a) side-b (radians angle-c)) mode color))
+
+(define/chk (triangle/saa side-a angle-b angle-c mode color)
+  (define (triangle-vertices/saa a B C)
+    (let* ([A (last-angle B C)]
+           [b (sin-rel A a B)]
+           [c (sin-rel A a C)])
+      (list (make-posn 0 0)
+            (make-posn c 0)
+            (polar->posn b A))))
+  (polygon (triangle-vertices/saa side-a (radians angle-b) (radians angle-c)) mode color))
+
+
+
 (define/chk (regular-polygon side-length side-count mode color)
   (check-mode/color-combination 'regular-polygon 4 mode color)
   (make-polygon/star side-length side-count mode color values))
 
+
+
+
+
 (define/chk (star-polygon side-length side-count step-count mode color)
   (check-mode/color-combination 'star-polygon 5 mode color)
   (check-arg 'star-polygon
@@ -1111,6 +1217,14 @@
          polygon
          regular-polygon
          triangle 
+         triangle/sss
+         triangle/ssa
+         triangle/sas
+         triangle/ass
+         triangle/aas
+         triangle/asa
+         triangle/saa
+
          isosceles-triangle
          right-triangle
          star
diff --git a/collects/2htdp/private/img-err.rkt b/collects/2htdp/private/img-err.rkt
index f3801bd6c3..bbfb001c4b 100644
--- a/collects/2htdp/private/img-err.rkt
+++ b/collects/2htdp/private/img-err.rkt
@@ -114,7 +114,8 @@
      (if (string? arg)
          (string->symbol arg)
          arg)]
-    [(width height radius radius1 radius2 side-length side-length1 side-length2)
+    [(width height radius radius1 radius2 side-length side-length1 side-length2
+            side-a side-b side-c)
      (check-arg fn-name
                 (and (real? arg)
                      (not (negative? arg)))
@@ -153,7 +154,7 @@
                 'step-count
                 i arg)
      arg]
-    [(angle angle1 angle2)
+    [(angle angle1 angle2 angle-a angle-b angle-c)
      (check-arg fn-name
                 (angle? arg)
                 'angle\ in\ degrees
diff --git a/collects/htdp/error.rkt b/collects/htdp/error.rkt
index f0084bf1cd..674fb5c40d 100644
--- a/collects/htdp/error.rkt
+++ b/collects/htdp/error.rkt
@@ -4,7 +4,7 @@
 ;; --------------------------------------------------------------------------
 (provide check-arg check-arity check-proc check-result 
          check-list-list check-color
-         check-fun-res
+         check-fun-res check-dependencies
          natural?
          find-non tp-exn? number->ord)
 
@@ -24,6 +24,11 @@
     (check-result (object-name f) pred? type r)
     r))
 
+;; check-dependencies : Symbol x Boolean x FormatString x Any* -> Void
+(define (check-dependencies pname condition fmt . args)
+  (unless condition
+    (tp-error pname (apply format fmt args))))
+
 #| Tests ------------------------------------------------------------------
   (not (find-non list? '((1 2 3) (a b c))))
   (symbol? (find-non number? '(1 2 3 a)))