suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

changed add-line from image

Browse Source 
svn: r1754
This commit is contained in:
Matthias Felleisen 2006-01-03 16:17:09 +00:00
parent 0c869469a6
commit b9147c1b5d
1 changed files with 23 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/htdp/world.ss
View File

@ -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 ;; 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 ;; 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 ;; Thu Dec 1 17:03:03 EST 2005: fixed place-image; all coordinates okay now
@ -11,7 +12,7 @@
(lib "prim.ss" "lang")) (lib "prim.ss" "lang"))
;; --- provide --------------------------------------------------------------- ;; --- provide ---------------------------------------------------------------
(provide (all-from (lib "image.ss" "htdp"))) (provide (all-from-except (lib "image.ss" "htdp") add-line))
(provide ;; forall(World): (provide ;; forall(World):
big-bang ;; Number Number Number World -> true big-bang ;; Number Number Number World -> true
@ -21,6 +22,8 @@
place-image ;; Image Number Number Scence -> Scene place-image ;; Image Number Number Scence -> Scene
empty-scene ;; Number Number -> Scene empty-scene ;; Number Number -> Scene
run-movie ;; (Listof Image) -> true run-movie ;; (Listof Image) -> true
(rename add-line-to-scene add-line)
;; Scene Number Number Number Number Color -> Scene
) )
(provide-higher-order-primitive (provide-higher-order-primitive
@ -81,6 +84,25 @@
ns ns
(shrink ns 0 0 sw sh)))) (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) (define (empty-scene width height)
(check-pos 'empty-scene width "first") (check-pos 'empty-scene width "first")
(check-pos 'empty-scene height "second") (check-pos 'empty-scene height "second")