From b9147c1b5dd7bceb34207d37c75f7f7ad5a42cd4 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Tue, 3 Jan 2006 16:17:09 +0000
Subject: [PATCH] changed add-line from image

svn: r1754
---
 collects/htdp/world.ss | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/collects/htdp/world.ss b/collects/htdp/world.ss
index 8404aea2e2..aec0b18a74 100644
--- a/collects/htdp/world.ss
+++ b/collects/htdp/world.ss
@@ -1,3 +1,4 @@
+;; Tue Jan  3 11:17:50 EST 2006: changed add-line behavior in world.ss 
 ;; Sat Dec 10 19:39:03 EST 2005: fixed name, changed interface to on-key-event
 ;; Fri Dec  9 21:39:03 EST 2005: remoevd (update ... produce ...); added on-redraw 
 ;; Thu Dec  1 17:03:03 EST 2005: fixed place-image; all coordinates okay now
@@ -11,7 +12,7 @@
    (lib "prim.ss" "lang"))
   
   ;; --- provide ---------------------------------------------------------------
-  (provide (all-from (lib "image.ss" "htdp")))
+  (provide (all-from-except (lib "image.ss" "htdp") add-line))
   
   (provide      ;; forall(World):
    big-bang     ;; Number Number Number World -> true 
@@ -21,6 +22,8 @@
    place-image  ;; Image Number Number Scence -> Scene
    empty-scene  ;; Number Number -> Scene 
    run-movie    ;; (Listof Image) -> true 
+   (rename add-line-to-scene add-line)
+                ;; Scene Number Number Number Number Color -> Scene 
    )
 
   (provide-higher-order-primitive
@@ -81,6 +84,25 @@
 	  ns
 	  (shrink ns 0 0 sw sh))))
   
+  (define (add-line-to-scene image x0 y0 x1 y1 color)
+    #|
+    (check-image 'add-line image "first")
+    (check-pos 'add-line x0 "second")
+    (check-pos 'add-line y0 "third")
+    (check-pos 'add-line x1 "fourth")
+    (check-pos 'add-line x2 "fifth")
+    (check-color 'add-line x2 "sixth")
+    |#
+    (let ()
+      (define sw (image-width image))
+      (define sh (image-height image))
+      (define ns (add-line image x0 y0 x1 y1 color))
+      (define nw (image-width ns))
+      (define nh (image-height ns))
+      (if (and (= sw nw) (= sh nh)) 
+	  ns
+	  (shrink ns 0 0 sw sh))))
+  
   (define (empty-scene width height)
     (check-pos 'empty-scene width "first")
     (check-pos 'empty-scene height "second")