From 4fa7fa299490cf1cb7acf71ec4797a9a714c8e14 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 6 Sep 2010 06:12:45 -0500 Subject: [PATCH] Added docs and exported basic pinhole manipulation primitives --- collects/2htdp/image.rkt | 6 ++++ collects/2htdp/private/image-more.rkt | 18 ++++++++++++ collects/2htdp/tests/test-image.rkt | 4 +-- collects/mrlib/image-core.rkt | 12 ++------ .../teachpack/2htdp/scribblings/image-toc.rkt | 14 +++++++-- .../teachpack/2htdp/scribblings/image.scrbl | 27 ++++++++++++++++++ .../2htdp/scribblings/img/14fa9751041.png | Bin 0 -> 178 bytes .../2htdp/scribblings/img/b2c3ee438.png | Bin 0 -> 172 bytes 8 files changed, 66 insertions(+), 15 deletions(-) create mode 100644 collects/teachpack/2htdp/scribblings/img/14fa9751041.png create mode 100644 collects/teachpack/2htdp/scribblings/img/b2c3ee438.png diff --git a/collects/2htdp/image.rkt b/collects/2htdp/image.rkt index 47dce5b3b7..b25ed2fab7 100644 --- a/collects/2htdp/image.rkt +++ b/collects/2htdp/image.rkt @@ -124,6 +124,12 @@ and they all have good sample contracts. (It is amazing what we can do with kids image-width image-height image-baseline + + put-pinhole + clear-pinhole + center-pinhole + pinhole-x + pinhole-y make-color make-pen pen diff --git a/collects/2htdp/private/image-more.rkt b/collects/2htdp/private/image-more.rkt index 171ed666b6..03942aac0e 100644 --- a/collects/2htdp/private/image-more.rkt +++ b/collects/2htdp/private/image-more.rkt @@ -1198,6 +1198,18 @@ (orig-make-color int0-255-1 int0-255-2 int0-255-3)) make-color)) +(define/chk (pinhole-x image) (let ([ph (send image get-pinhole)]) (and ph (point-x ph)))) +(define/chk (pinhole-y image) (let ([ph (send image get-pinhole)]) (and ph (point-y ph)))) +(define/chk (put-pinhole x1 y1 image) (make-image (image-shape image) (image-bb image) (image-normalized? image) (make-point x1 y1))) +(define/chk (center-pinhole image) + (let ([bb (send image get-bb)]) + (make-image (image-shape image) + (image-bb image) + (image-normalized? image) + (make-point (/ (bb-right bb) 2) + (/ (bb-baseline bb) 2))))) +(define/chk (clear-pinhole image) (make-image (image-shape image) (image-bb image) (image-normalized? image) #f)) + (define build-color/color (let ([orig-make-color make-color]) (define/chk (color int0-255-1 int0-255-2 int0-255-3) @@ -1290,6 +1302,12 @@ rotate-xy + put-pinhole + pinhole-x + pinhole-y + clear-pinhole + center-pinhole + build-color/make-color build-color/color build-pen/make-pen diff --git a/collects/2htdp/tests/test-image.rkt b/collects/2htdp/tests/test-image.rkt index b2075488a2..fd7959c942 100644 --- a/collects/2htdp/tests/test-image.rkt +++ b/collects/2htdp/tests/test-image.rkt @@ -1786,9 +1786,7 @@ (unless (< cpu 4000) (error 'test-image.rkt "saving and loading this image takes too longer than 4 seconds:\n ~s" - (term image))) - (display #\.) (flush-output) - ) + (term image)))) #:attempts 1000))) ;;This expression was found by the above. Its problematic because it has a negative width. diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt index ea070810f4..d1a6fac8bd 100644 --- a/collects/mrlib/image-core.rkt +++ b/collects/mrlib/image-core.rkt @@ -97,10 +97,6 @@ has been moved out). (define (image-normalized? p) (send p get-normalized?)) (define (set-image-shape! p s) (send p set-shape s)) (define (set-image-normalized?! p n?) (send p set-normalized? n?)) -(define (pinhole-x p) (let ([ph (send p get-pinhole)]) (and ph (pinhole-x ph)))) -(define (pinhole-y p) (let ([ph (send p get-pinhole)]) (and ph (pinhole-y ph)))) -(define (put-pinhole x y image) (make-image (image-shape image) (image-bb image) (image-normalized? image) (make-point x y))) -(define (clear-pinhole image) (make-image (image-shape image) (image-bb image) (image-normalized? image) #f)) (define (image? p) (or (is-a? p image%) (is-a? p image-snip%) @@ -372,6 +368,7 @@ has been moved out). #f #f)] [(= 2 (length lst)) + ;; backwards compatibility for saved images that didn't have a pinhole (make-image (list-ref lst 0) (list-ref lst 1) #f @@ -1095,12 +1092,7 @@ the mask bitmap and the original bitmap are all together in a single bytes! to-img bitmap->image - image-snip->image - - put-pinhole - clear-pinhole - pinhole-x - pinhole-y) + image-snip->image) ;; method names (provide get-shape get-bb get-pinhole get-normalized? get-normalized-shape) diff --git a/collects/teachpack/2htdp/scribblings/image-toc.rkt b/collects/teachpack/2htdp/scribblings/image-toc.rkt index 7f865eac14..d8f4fb2da5 100644 --- a/collects/teachpack/2htdp/scribblings/image-toc.rkt +++ b/collects/teachpack/2htdp/scribblings/image-toc.rkt @@ -36,10 +36,20 @@ (above r r r r r r)) 'image "245380940d6-1.png") + (list '(pinhole-y (center-pinhole (rectangle 10 10 "solid" "red"))) 'val '5) + (list '(pinhole-x (center-pinhole (rectangle 10 10 "solid" "red"))) 'val '5) + (list + '(put-pinhole 2 18 (rectangle 40 20 "solid" "forestgreen")) + 'image + "14fa9751041.png") + (list + '(center-pinhole (rectangle 40 20 "solid" "red")) + 'image + "b2c3ee438.png") (list '(image-height (rectangle 100 100 "solid" "black")) 'val '100) (list '(image-baseline (rectangle 100 100 "solid" "black")) 'val '100) - (list '(image-height (text "Hello" 24 "black")) 'val '24) - (list '(image-baseline (text "Hello" 24 "black")) 'val '18) + (list '(image-height (text "Hello" 24 "black")) 'val '41) + (list '(image-baseline (text "Hello" 24 "black")) 'val '31) (list '(image-height (rectangle 10 0 "solid" "purple")) 'val '0) (list '(image-height diff --git a/collects/teachpack/2htdp/scribblings/image.scrbl b/collects/teachpack/2htdp/scribblings/image.scrbl index f0df082ca3..3f48d3bd87 100644 --- a/collects/teachpack/2htdp/scribblings/image.scrbl +++ b/collects/teachpack/2htdp/scribblings/image.scrbl @@ -1274,6 +1274,33 @@ The baseline of an image is the place where the bottoms any letters line up, not Two images are equal if they draw exactly the same way, at their current size (not neccessarily at all sizes). +@section{Pinholes} + +A pinhole is an optional property of an image that identifies a point somewhere +in the image. The pinhole can then be used to facilitate overlaying images by +lining them up on the their pinholes. When an image has a pinhole, the pinhole +is drawn with crosshairs drawn across the image. + +@defproc[(center-pinhole [image image?]) image?]{ + Creates a pinhole in @racket[image] at its center. + @image-examples[(center-pinhole (rectangle 40 20 "solid" "red"))] +} +@defproc[(put-pinhole [x integer?] [y integer?] [image image?]) image?]{ + Creates a pinhole in @racket[image] at the point (@racket[x],@racket[y]). + @image-examples[(put-pinhole 2 18 (rectangle 40 20 "solid" "forestgreen"))] +} +@defproc[(pinhole-x [image image?]) (or/c integer? #f)]{ + Returns the x coordinate of @racket[image]'s pinhole. + @image-examples[(pinhole-x (center-pinhole (rectangle 10 10 "solid" "red")))] +} +@defproc[(pinhole-y [image image?]) (or/c integer? #f)]{ + Returns the y coordinate of @racket[image]'s pinhole. + @image-examples[(pinhole-y (center-pinhole (rectangle 10 10 "solid" "red")))] +} +@defproc[(clear-pinhole [image image?]) image?]{ + Removes a pinhole from @racket[image] (if the image has a pinhole). +} + @section[#:tag "nitty-gritty"]{The nitty gritty of pixels, pens, and lines} The image library treats coordinates as if they are in the upper-left corner diff --git a/collects/teachpack/2htdp/scribblings/img/14fa9751041.png b/collects/teachpack/2htdp/scribblings/img/14fa9751041.png new file mode 100644 index 0000000000000000000000000000000000000000..26c353b7e7dfb7a1031f2fe92616c496510fba6c GIT binary patch literal 178 zcmeAS@N?(olHy`uVBq!ia0vp^nm{bd!2~2jb_J9JsY*{5#}JRsl+ z#O*Elg5%w^JE=(t2|s@ST+cC`!&bMALG4$xW!Coleb%kN)4d+nJ!XLwY3bZ%PSRG&UKCnLk+=MR;;Z|c7Pm1SmTe$23Kro{jM|NZ^7 bCo(d8W7YM%<|D}qbOeK^tDnm{r-UW|q}xhD literal 0 HcmV?d00001 diff --git a/collects/teachpack/2htdp/scribblings/img/b2c3ee438.png b/collects/teachpack/2htdp/scribblings/img/b2c3ee438.png new file mode 100644 index 0000000000000000000000000000000000000000..0652650e6949189a0f6133c732e2439d1054df5b GIT binary patch literal 172 zcmeAS@N?(olHy`uVBq!ia0vp^nm{bd!2~2jb_J9JsbWtT#}JRsw^t5w9x>o?xj6r* zszglk0oyfQ9MS!^40o_EZMN;iBkWsQdlb(z-aQvyb~As& zZPw^0s~NkOmCd;DY|a