added place-image and fixed a bunch of bugs related to equality, rotating and other things
svn: r17491
This commit is contained in:
Robby Findler
parent
2d92b5aa91
commit
0b3c30f18e
|
|
@ -46,9 +46,10 @@ and they all have good sample contracts. (It is amazing what we can do with kids
|
|||
|#
|
||||
|
||||
|
||||
(require mrlib/image-core
|
||||
(require "../mrlib/image-core.ss"
|
||||
"private/image-more.ss"
|
||||
"private/img-err.ss")
|
||||
"private/img-err.ss"
|
||||
htdp/error)
|
||||
|
||||
(provide overlay
|
||||
overlay/align
|
||||
|
|
@ -66,7 +67,9 @@ and they all have good sample contracts. (It is amazing what we can do with kids
|
|||
crop
|
||||
rotate
|
||||
frame
|
||||
|
||||
place-image
|
||||
place-image/align
|
||||
|
||||
scale
|
||||
scale/xy
|
||||
|
||||
|
|
@ -94,8 +97,22 @@ and they all have good sample contracts. (It is amazing what we can do with kids
|
|||
mode?
|
||||
angle?
|
||||
side-count?
|
||||
color?
|
||||
|
||||
image-color?
|
||||
(rename-out [build-color make-color])
|
||||
color-red color-blue color-green color? color
|
||||
image-width
|
||||
image-height
|
||||
image-baseline)
|
||||
|
||||
(define build-color
|
||||
(let ([orig-make-color make-color])
|
||||
(let ([make-color
|
||||
(λ (a b c)
|
||||
(check-arg 'make-color (and (integer? a) (<= 0 a 255))
|
||||
'integer\ between\ 0\ and\ 255 1 a)
|
||||
(check-arg 'make-color (and (integer? b) (<= 0 b 255))
|
||||
'integer\ between\ 0\ and\ 255 2 b)
|
||||
(check-arg 'make-color (and (integer? c) (<= 0 c 255))
|
||||
'integer\ between\ 0\ and\ 255 3 c)
|
||||
(make-color a b c))])
|
||||
make-color)))
|
||||
|
|
@ -37,13 +37,23 @@
|
|||
[min-value min-scale]
|
||||
[max-value max-scale]
|
||||
[callback (λ ignore (send c refresh))])]
|
||||
[bp (new horizontal-panel% [parent f] [alignment '(center center)] [stretchable-height #f])]
|
||||
[bp (new horizontal-panel%
|
||||
[parent f]
|
||||
[alignment '(center center)]
|
||||
[stretchable-height #f])]
|
||||
[scale-adjust
|
||||
(λ (f)
|
||||
(send sl set-value (max min-scale (min max-scale (f (send sl get-value)))))
|
||||
(send sl set-value
|
||||
(max min-scale (min max-scale (f (send sl get-value)))))
|
||||
(send c refresh))])
|
||||
(send (new button% [label "√"] [callback (λ x (scale-adjust sub1))] [parent bp]) min-width 100)
|
||||
(send (new button% [label "2"] [callback (λ x (scale-adjust add1))] [parent bp]) min-width 100)
|
||||
(send (new button%
|
||||
[label "√"]
|
||||
[callback (λ x (scale-adjust sub1))]
|
||||
[parent bp]) min-width 100)
|
||||
(send (new button%
|
||||
[label "2"]
|
||||
[callback (λ x (scale-adjust add1))]
|
||||
[parent bp]) min-width 100)
|
||||
(send f show #t)))
|
||||
|
||||
(define (save-image pre-image filename)
|
||||
|
|
@ -97,7 +107,8 @@
|
|||
#f))
|
||||
|
||||
;; overlay : image image image ... -> image
|
||||
;; places images on top of each other with their upper left corners aligned. last one goes on the bottom
|
||||
;; places images on top of each other with their upper left corners aligned.
|
||||
;; last one goes on the bottom
|
||||
(define/chk (overlay image image2 . image3)
|
||||
(overlay/internal 'left 'top image (cons image2 image3)))
|
||||
|
||||
|
|
@ -261,6 +272,9 @@
|
|||
;; crop : number number number number image -> image
|
||||
;; crops an image to be w x h from (x,y)
|
||||
(define/chk (crop x1 y1 width height image)
|
||||
(crop/internal x1 y1 width height image))
|
||||
|
||||
(define (crop/internal x1 y1 width height image)
|
||||
(let ([iw (min width (image-width image))]
|
||||
[ih (min height (image-height image))])
|
||||
(make-image (make-crop (rectangle-points iw ih)
|
||||
|
|
@ -270,6 +284,27 @@
|
|||
(min ih (image-baseline image)))
|
||||
#f)))
|
||||
|
||||
;; place-image : image x y scene -> scene
|
||||
(define/chk (place-image image1 x1 y1 image2)
|
||||
(place-image/internal image1 x1 y1 image2 'left 'top))
|
||||
(define/chk (place-image/align image1 x1 y1 x-place y-place image2)
|
||||
(place-image/internal image1 x1 y1 image2 x-place y-place))
|
||||
|
||||
(define (place-image/internal image orig-dx orig-dy scene x-place y-place)
|
||||
(let ([dx (- orig-dx (find-x-spot x-place image))]
|
||||
[dy (- orig-dy (find-y-spot y-place image))])
|
||||
(crop/internal
|
||||
(if (< dx 0) (- dx) 0)
|
||||
(if (< dy 0) (- dy) 0)
|
||||
(image-right scene)
|
||||
(image-bottom scene)
|
||||
(overlay/δ image
|
||||
(if (< dx 0) 0 dx)
|
||||
(if (< dy 0) 0 dy)
|
||||
scene
|
||||
(if (< dx 0) (- dx) 0)
|
||||
(if (< dy 0) (- dy) 0)))))
|
||||
|
||||
;; frame : image -> image
|
||||
;; draws a black frame around a image where the bounding box is
|
||||
;; (useful for debugging images)
|
||||
|
|
@ -290,47 +325,35 @@
|
|||
;; scales the I by the given factor
|
||||
|
||||
;; rotate : I number -> I
|
||||
;; rotates the I around the top-left corner by the given angle
|
||||
;; (in degrees)
|
||||
;; LINEAR TIME OPERATION (sigh)
|
||||
;; rotates the I around the top-left corner by the given angle (in degrees)
|
||||
(define/chk (rotate angle image)
|
||||
(let-values ([(rotated-shape ltrb)
|
||||
(rotate-normalized-shape/bb angle
|
||||
(normalize-shape (image-shape image)))])
|
||||
|
||||
(let* ([rotated-shape (rotate-normalized-shape
|
||||
angle
|
||||
(send image get-normalized-shape))]
|
||||
[ltrb (normalized-shape-bb rotated-shape)])
|
||||
(make-image (make-translate (- (ltrb-left ltrb)) (- (ltrb-top ltrb)) rotated-shape)
|
||||
(make-bb (- (ltrb-right ltrb) (ltrb-left ltrb))
|
||||
(- (ltrb-bottom ltrb) (ltrb-top ltrb))
|
||||
(- (ltrb-bottom ltrb) (ltrb-top ltrb)))
|
||||
#f)))
|
||||
|
||||
;; rotate-normalized-shape/bb : angle normalized-shape -> (values normalized-shape ltrb)
|
||||
(define (rotate-normalized-shape/bb angle shape)
|
||||
(define (rotate-normalized-shape angle shape)
|
||||
(cond
|
||||
[(overlay? shape)
|
||||
(let-values ([(top-shape top-ltrb) (rotate-normalized-shape/bb angle (overlay-top shape))]
|
||||
[(bottom-shape bottom-ltrb) (rotate-simple/bb angle (overlay-bottom shape))])
|
||||
(values (make-overlay top-shape bottom-shape)
|
||||
(union-ltrb top-ltrb bottom-ltrb)))]
|
||||
(let ([top-shape (rotate-normalized-shape angle (overlay-top shape))]
|
||||
[bottom-shape (rotate-simple angle (overlay-bottom shape))])
|
||||
(make-overlay top-shape bottom-shape))]
|
||||
[else
|
||||
(rotate-cropped-simple/bb angle shape)]))
|
||||
(rotate-cropped-simple angle shape)]))
|
||||
|
||||
;; rotate-cropped-shape/bb : angle cropped-simple-shape -> (values cropped-simple-shape ltrb)
|
||||
(define (rotate-cropped-simple/bb angle shape)
|
||||
;; rotate-cropped-simple : angle cropped-simple-shape -> cropped-simple-shape
|
||||
(define (rotate-cropped-simple angle shape)
|
||||
(cond
|
||||
[(crop? shape)
|
||||
(let-values ([(rotated-shape ltrb) (rotate-cropped-simple/bb angle (crop-shape shape))])
|
||||
(let* ([rotated-points (rotate-points angle (crop-points shape))]
|
||||
[crop-ltrb (points->ltrb rotated-points)])
|
||||
(values (make-crop rotated-points rotated-shape)
|
||||
(intersect-ltrb crop-ltrb ltrb))))]
|
||||
(make-crop (rotate-points angle (crop-points shape))
|
||||
(rotate-cropped-simple angle (crop-shape shape)))]
|
||||
[else
|
||||
(rotate-simple/bb angle shape)]))
|
||||
|
||||
;; rotate-simple/bb : angle simple-shape -> (values simple-shape ltrb)
|
||||
(define (rotate-simple/bb angle shape)
|
||||
(let ([rotated-shape (rotate-simple angle shape)])
|
||||
(values rotated-shape (simple-bb rotated-shape))))
|
||||
(rotate-simple angle shape)]))
|
||||
|
||||
;; rotate-simple : angle simple-shape -> simple-shape
|
||||
(define (rotate-simple θ simple-shape)
|
||||
|
|
@ -366,6 +389,26 @@
|
|||
(min (ltrb-right ltrb1) (ltrb-right ltrb2))
|
||||
(min (ltrb-bottom ltrb1) (ltrb-bottom ltrb2))))
|
||||
|
||||
;; normalized-shape-bb : normalized-shape -> ltrb
|
||||
(define (normalized-shape-bb shape)
|
||||
(cond
|
||||
[(overlay? shape)
|
||||
(let ([top-ltrb (normalized-shape-bb (overlay-top shape))]
|
||||
[bottom-ltrb (simple-bb (overlay-bottom shape))])
|
||||
(union-ltrb top-ltrb bottom-ltrb))]
|
||||
[else
|
||||
(cropped-simple-bb shape)]))
|
||||
|
||||
;; cropped-simple-bb : cropped-simple-shape -> ltrb
|
||||
(define (cropped-simple-bb shape)
|
||||
(cond
|
||||
[(crop? shape)
|
||||
(let ([ltrb (cropped-simple-bb (crop-shape shape))]
|
||||
[crop-ltrb (points->ltrb (crop-points shape))])
|
||||
(intersect-ltrb crop-ltrb ltrb))]
|
||||
[else
|
||||
(simple-bb shape)]))
|
||||
|
||||
;; simple-bb : simple-shape -> ltrb
|
||||
;; returns the bounding box of 'shape'
|
||||
;; (only called for rotated shapes, so bottom=baseline)
|
||||
|
|
@ -445,7 +488,31 @@
|
|||
(max ax bx cx dx)
|
||||
(max ay by cy dy))))
|
||||
|
||||
(define (rotate-points θ points) (map (λ (p) (rotate-point p θ)) points))
|
||||
(define (rotate-points θ in-points)
|
||||
(let* ([cs (map point->c in-points)]
|
||||
[vectors (points->vectors cs)]
|
||||
[rotated-vectors (map (λ (c) (rotate-c c θ)) vectors)]
|
||||
[points (vectors->points rotated-vectors)])
|
||||
points))
|
||||
|
||||
(define (points->vectors orig-points)
|
||||
(let loop ([points (cons 0 orig-points)])
|
||||
(cond
|
||||
[(null? (cdr points)) '()]
|
||||
[else
|
||||
(cons (- (cadr points) (car points))
|
||||
(loop (cdr points)))])))
|
||||
|
||||
(define (vectors->points vecs)
|
||||
(let loop ([vecs vecs]
|
||||
[p 0])
|
||||
(cond
|
||||
[(null? vecs) '()]
|
||||
[else
|
||||
(let ([next-p (+ (car vecs) p)])
|
||||
(cons (c->point next-p)
|
||||
(loop (cdr vecs)
|
||||
next-p)))])))
|
||||
|
||||
(define (center-point np-atomic-shape)
|
||||
(let-values ([(l t r b) (np-atomic-bb np-atomic-shape)])
|
||||
|
|
@ -500,15 +567,22 @@
|
|||
(let-values ([(x y) (rotate-xy (point-x p) (point-y p) θ)])
|
||||
(make-point x y)))
|
||||
|
||||
(define (rotate-c c θ)
|
||||
(* (make-polar 1 (degrees->radians θ))
|
||||
c))
|
||||
|
||||
;; rotate-xy : x,y angle -> x,y
|
||||
(define (rotate-xy x y θ)
|
||||
(c->xy (* (make-polar 1 (degrees->radians θ))
|
||||
(xy->c x y))))
|
||||
(c->xy (rotate-c (xy->c x y) θ)))
|
||||
|
||||
(define (xy->c x y) (make-rectangular x (- y)))
|
||||
(define (c->xy c)
|
||||
(values (real-part c)
|
||||
(- (imag-part c))))
|
||||
(define (point->c p) (xy->c (point-x p) (point-y p)))
|
||||
(define (c->point c)
|
||||
(let-values ([(x y) (c->xy c)])
|
||||
(make-point x y)))
|
||||
|
||||
|
||||
;; bring-between : number number -> number
|
||||
|
|
@ -732,30 +806,6 @@
|
|||
(make-bb w/h w/h w/h)
|
||||
#f)))
|
||||
|
||||
(define (mode-color->pen mode color)
|
||||
(send the-pen-list find-or-create-pen color 1
|
||||
(case mode
|
||||
[(outline) 'solid]
|
||||
[(solid) 'transparent])))
|
||||
|
||||
(define (mode-color->brush mode color)
|
||||
(send the-brush-list find-or-create-brush color
|
||||
(case mode
|
||||
[(outline) 'transparent]
|
||||
[(solid) 'solid])))
|
||||
|
||||
;; add-line : I number number number number -> I
|
||||
;; add-line : string string I number number number number -> I
|
||||
;; like add-line, but adapted to use coordinates relative the top-left of the I,
|
||||
;; or to the user-specified spot
|
||||
|
||||
;; add-curve : I posn number number posn number number -> I
|
||||
;; add-curve : string string I posn number number posn number number -> I
|
||||
;; the posns are the start and end points of the curve
|
||||
;; the pair of numbers following each posn are the angle and "pull" of the curve
|
||||
;; see pin-line in slideshow
|
||||
;; the initial strings in the second instance of add-curve are like the strings in add-line
|
||||
|
||||
(define/chk (image-width image) (inexact->exact (ceiling (image-right image))))
|
||||
(define/chk (image-height image) (inexact->exact (ceiling (image-bottom image))))
|
||||
|
||||
|
|
@ -814,8 +864,11 @@
|
|||
|
||||
rotate
|
||||
crop
|
||||
|
||||
frame
|
||||
|
||||
place-image
|
||||
place-image/align
|
||||
|
||||
|
||||
show-image
|
||||
save-image
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
mode?
|
||||
angle?
|
||||
side-count?
|
||||
color?
|
||||
image-color?
|
||||
image-snip->image
|
||||
bitmap->image)
|
||||
|
||||
|
|
@ -147,15 +147,20 @@
|
|||
(+ arg 360)
|
||||
arg)]
|
||||
[(color)
|
||||
(check-color fn-name i arg)
|
||||
(let ([color-str
|
||||
(cond
|
||||
[(symbol? arg)
|
||||
(symbol->string arg)]
|
||||
[else arg])])
|
||||
(if (send the-color-database find-color color-str)
|
||||
color-str
|
||||
"black"))]
|
||||
(check-arg fn-name (image-color? arg) 'color i arg)
|
||||
;; return either a string or a color object;
|
||||
;; since there may be saved files that have
|
||||
;; strings in the color positions we leave them
|
||||
;; here too.
|
||||
(if (color? arg)
|
||||
arg
|
||||
(let* ([color-str
|
||||
(if (symbol? arg)
|
||||
(symbol->string arg)
|
||||
arg)])
|
||||
(if (send the-color-database find-color color-str)
|
||||
color-str
|
||||
"black")))]
|
||||
[(string)
|
||||
(check-arg fn-name (string? arg) 'string i arg)
|
||||
arg]
|
||||
|
|
@ -207,7 +212,7 @@
|
|||
(define (step-count? i)
|
||||
(and (integer? i)
|
||||
(1 . <= . i)))
|
||||
(define (color? c) (or (symbol? c) (string? c)))
|
||||
(define (image-color? c) (or (symbol? c) (string? c) (color? c)))
|
||||
|
||||
(define (to-img arg)
|
||||
(cond
|
||||
|
|
|
|||
|
|
@ -1,9 +1,16 @@
|
|||
#lang scheme/base
|
||||
#|
|
||||
;; snippet of code for experimentation
|
||||
#lang scheme/gui
|
||||
(require 2htdp/private/image-more
|
||||
mrlib/image-core
|
||||
mrlib/private/image-core-bitmap
|
||||
2htdp/private/img-err
|
||||
(only-in lang/htdp-advanced equal~?))
|
||||
|
||||
(define images
|
||||
(list (round-numbers (rotate 180 (line 20 30 "red")))
|
||||
(round-numbers (line 20 30 "red"))))
|
||||
(list (rhombus 10 90 'solid 'black)
|
||||
(rotate 45 (square 10 'solid 'black))))
|
||||
|
||||
(define t (new text%))
|
||||
(define f (new frame% [label ""] [width 600] [height 400]))
|
||||
|
|
@ -20,15 +27,17 @@
|
|||
scheme/math
|
||||
scheme/class
|
||||
scheme/gui/base
|
||||
schemeunit)
|
||||
schemeunit
|
||||
(only-in lang/htdp-advanced equal~?))
|
||||
|
||||
(require (for-syntax scheme/base))
|
||||
(define-syntax (test stx)
|
||||
(syntax-case stx ()
|
||||
[(test a => b)
|
||||
#`(begin
|
||||
;(printf "running line ~a\n" #,(syntax-line stx))
|
||||
(check-equal? a b))]))
|
||||
(with-syntax ([check-equal? (datum->syntax #'here 'check-equal? stx)])
|
||||
#`(begin
|
||||
;(printf "running line ~a\n" #,(syntax-line stx))
|
||||
#,(quasisyntax/loc stx (check-equal? a b))))]))
|
||||
|
||||
;; test case: (beside (text "a"...) (text "b" ...)) vs (text "ab")
|
||||
|
||||
|
|
@ -39,26 +48,6 @@
|
|||
(number? b)
|
||||
(< (abs (- a b)) 0.001)))
|
||||
|
||||
#;
|
||||
(show-image
|
||||
(overlay/xy (rectangle 100 10 'solid 'red)
|
||||
0
|
||||
10
|
||||
(rectangle 100 10 'solid 'red)))
|
||||
|
||||
|
||||
#;
|
||||
(show-image
|
||||
(let loop ([image (rectangle 400 8 'solid 'red)]
|
||||
[n 2])
|
||||
(cond
|
||||
[(= n 7) image]
|
||||
[else
|
||||
(loop (overlay/align 'center 'center
|
||||
image
|
||||
(rotate (* 180 (/ 1 n)) image))
|
||||
(+ n 1))])))
|
||||
|
||||
(define-syntax-rule
|
||||
(round-numbers e)
|
||||
(call-with-values (λ () e) round-numbers/values))
|
||||
|
|
@ -222,6 +211,17 @@
|
|||
"solid" "plum")
|
||||
(rectangle 10 10 "solid" "plum"))
|
||||
|
||||
;; make sure equality isn't equating everything
|
||||
(check-equal? (equal? (rectangle 10 10 'solid 'blue)
|
||||
(rectangle 10 10 'solid 'red))
|
||||
#f)
|
||||
|
||||
;; make sure 'white and black match up with color structs
|
||||
(check-equal? (rectangle 10 10 'solid (make-color 255 255 255))
|
||||
(rectangle 10 10 'solid 'white))
|
||||
(check-equal? (rectangle 10 10 'solid (make-color 0 0 0))
|
||||
(rectangle 10 10 'solid 'black))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; testing overlays
|
||||
|
|
@ -650,9 +650,11 @@
|
|||
(test (bring-between 720 360) => 0)
|
||||
(test (bring-between 720.5 360) => .5)
|
||||
|
||||
(test (round-numbers (rotate 90 (rectangle 100 100 'solid 'blue)))
|
||||
(test (equal~? (rotate 90 (rectangle 100 100 'solid 'blue))
|
||||
(rectangle 100 100 'solid 'blue)
|
||||
.1)
|
||||
=>
|
||||
(round-numbers (rectangle 100 100 'solid 'blue)))
|
||||
#t)
|
||||
|
||||
(test (round-numbers
|
||||
(normalize-shape (image-shape (rotate 90 (rotate 90 (rectangle 50 100 'solid 'purple))))
|
||||
|
|
@ -678,8 +680,6 @@
|
|||
=>
|
||||
(round-numbers (rotate 90 (ellipse 200 400 'solid 'purple))))
|
||||
|
||||
(require (only-in lang/htdp-advanced equal~?))
|
||||
|
||||
(test (equal~? (rectangle 100 10 'solid 'red)
|
||||
(rotate 90 (rectangle 10 100 'solid 'red))
|
||||
0.1)
|
||||
|
|
@ -787,14 +787,16 @@
|
|||
(test (image-baseline (image-snip->image (make-object image-snip% blue-10x20-bitmap)))
|
||||
=>
|
||||
20)
|
||||
#|
|
||||
(test (scale 2 (make-object image-snip% blue-10x20-bitmap))
|
||||
=>
|
||||
(image-snip->image (make-object image-snip% blue-20x40-bitmap)))
|
||||
|
||||
;; this test fails; sent email to Ian about it.
|
||||
#;
|
||||
(test (rotate 90 (make-object image-snip% blue-10x20-bitmap))
|
||||
=>
|
||||
(image-snip->image (make-object image-snip% blue-20x10-bitmap)))
|
||||
|#
|
||||
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1040,7 +1042,7 @@
|
|||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; cropping
|
||||
;; cropping (and place-image)
|
||||
;;
|
||||
|
||||
(test (crop 0 0 10 10 (rectangle 20 20 'solid 'black))
|
||||
|
|
@ -1058,3 +1060,55 @@
|
|||
=>
|
||||
(beside (rectangle 10 10 'solid 'black)
|
||||
(rectangle 10 10 'solid 'green)))
|
||||
|
||||
(test (place-image (circle 4 'solid 'black)
|
||||
10 10
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
=>
|
||||
(underlay/xy (rectangle 40 40 'solid 'orange)
|
||||
10 10
|
||||
(circle 4 'solid 'black)))
|
||||
|
||||
(test (place-image (circle 4 'solid 'black)
|
||||
50 50
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
=>
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
|
||||
(test (place-image (circle 4 'solid 'black)
|
||||
36 36
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
=>
|
||||
(underlay/xy (rectangle 40 40 'solid 'orange)
|
||||
36 36
|
||||
(crop 0 0 4 4 (circle 4 'solid 'black))))
|
||||
|
||||
(test (place-image (circle 8 'solid 'black)
|
||||
-4 -4
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
=>
|
||||
(overlay (crop 4 4 16 16 (circle 8 'solid 'black))
|
||||
(rectangle 40 40 'solid 'orange)))
|
||||
|
||||
(check-equal? (place-image (circle 4 'solid 'black)
|
||||
-4 0
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
(overlay (crop 4 0 4 8 (circle 4 'solid 'black))
|
||||
(rectangle 40 40 'solid 'orange)))
|
||||
|
||||
(test (place-image/align (circle 4 'solid 'black)
|
||||
5 10 'center 'center
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
=>
|
||||
(underlay/xy (rectangle 40 40 'solid 'orange)
|
||||
1 6
|
||||
(circle 4 'solid 'black)))
|
||||
|
||||
|
||||
(test (place-image/align (circle 4 'solid 'black)
|
||||
10 15 'right 'bottom
|
||||
(rectangle 40 40 'solid 'orange))
|
||||
=>
|
||||
(underlay/xy (rectangle 40 40 'solid 'orange)
|
||||
2 7
|
||||
(circle 4 'solid 'black)))
|
||||
|
|
|
|||
|
|
@ -233,7 +233,9 @@ has been moved out).
|
|||
; ;; ;
|
||||
; ;;;;
|
||||
|
||||
(define-local-member-name get-shape set-shape get-bb get-normalized? set-normalized get-normalized-shape)
|
||||
(define-local-member-name
|
||||
get-shape set-shape get-bb
|
||||
get-normalized? set-normalized get-normalized-shape)
|
||||
|
||||
(define image%
|
||||
(class* snip% (equal<%>)
|
||||
|
|
@ -250,13 +252,8 @@ has been moved out).
|
|||
[bytes1 (make-bytes (* w h 4) 0)]
|
||||
[bytes2 (make-bytes (* w h 4) 0)]
|
||||
[bdc (make-object bitmap-dc%)])
|
||||
(send bdc set-smoothing 'aligned)
|
||||
(and (check-same? bm1 bm2 bytes1 bytes2 bdc "red" that)
|
||||
(check-same? bm1 bm2 bytes1 bytes2 bdc "green" that)))))
|
||||
|
||||
#;
|
||||
(eq-recur (get-normalized-shape)
|
||||
(send that get-normalized-shape)))
|
||||
(check-same? bm1 bm2 bytes1 bytes2 bdc "green" that))))))
|
||||
|
||||
(define/private (check-same? bm1 bm2 bytes1 bytes2 bdc color that)
|
||||
(clear-bitmap/draw/bytes bm1 bdc bytes1 this color)
|
||||
|
|
@ -268,8 +265,8 @@ has been moved out).
|
|||
(send bdc set-pen "black" 1 'transparent)
|
||||
(send bdc set-brush color 'solid)
|
||||
(send bdc draw-rectangle 0 0 (send bm get-width) (send bm get-height))
|
||||
(render-image this bdc 0 0)
|
||||
(send bm get-argb-pixels 0 0 (send bm get-width) (send bm get-height) bytes))
|
||||
(render-image obj bdc 0 0)
|
||||
(send bdc get-argb-pixels 0 0 (send bm get-width) (send bm get-height) bytes))
|
||||
|
||||
(define/public (equal-hash-code-of y) 42)
|
||||
(define/public (equal-secondary-hash-code-of y) 3)
|
||||
|
|
@ -323,10 +320,12 @@ has been moved out).
|
|||
(send dc set-smoothing 'aligned)
|
||||
(render-image this dc x y)
|
||||
(send dc set-smoothing smoothing)))
|
||||
|
||||
(define/override (get-extent dc x y [w #f] [h #f] [descent #f] [space #f] [lspace #f] [rspace #f])
|
||||
(send (get-the-snip-class-list) add snip-class)
|
||||
(let ([bottom (round (bb-bottom bb))])
|
||||
(set-box/f! w (round (bb-right bb)))
|
||||
(let ([bottom (round (bb-bottom bb))]
|
||||
[right (round (bb-right bb))])
|
||||
(set-box/f! w right)
|
||||
(set-box/f! h bottom)
|
||||
(set-box/f! descent (- bottom (round (bb-baseline bb))))
|
||||
(set-box/f! space 0)
|
||||
|
|
@ -571,8 +570,10 @@ has been moved out).
|
|||
(cond
|
||||
[(polygon? simple-shape)
|
||||
(let ([path (polygon-points->path (polygon-points simple-shape))])
|
||||
(send dc set-pen (mode-color->pen (polygon-mode simple-shape) (polygon-color simple-shape)))
|
||||
(send dc set-brush (mode-color->brush (polygon-mode simple-shape) (polygon-color simple-shape)))
|
||||
(send dc set-pen (mode-color->pen (polygon-mode simple-shape)
|
||||
(polygon-color simple-shape)))
|
||||
(send dc set-brush (mode-color->brush (polygon-mode simple-shape)
|
||||
(polygon-color simple-shape)))
|
||||
(send dc draw-path path dx dy 'winding))]
|
||||
[(line-segment? simple-shape)
|
||||
(let ([path (new dc-path%)]
|
||||
|
|
@ -626,19 +627,14 @@ has been moved out).
|
|||
|
||||
(define (polygon-points->path points)
|
||||
(let ([path (new dc-path%)])
|
||||
(send path move-to (point-x (car points)) (point-y (car points)))
|
||||
(let loop ([point (make-rectangular (point-x (car points)) (point-y (car points)))]
|
||||
[last-point (car points)]
|
||||
[points (cdr points)])
|
||||
(send path move-to (round (point-x (car points))) (round (point-y (car points))))
|
||||
(let loop ([points (cdr points)])
|
||||
(unless (null? points)
|
||||
(let* ([vec (make-rectangular (- (point-x (car points))
|
||||
(point-x last-point))
|
||||
(- (point-y (car points))
|
||||
(point-y last-point)))]
|
||||
[endpoint (+ point vec (make-polar -1 (angle vec)))])
|
||||
(send path line-to (real-part endpoint) (imag-part endpoint))
|
||||
(loop endpoint (car points) (cdr points)))))
|
||||
(send path line-to (point-x (car points)) (point-y (car points)))
|
||||
(send path line-to
|
||||
(round (point-x (car points)))
|
||||
(round (point-y (car points))))
|
||||
(loop (cdr points))))
|
||||
(send path line-to (round (point-x (car points))) (round (point-y (car points))))
|
||||
path))
|
||||
|
||||
#|
|
||||
|
|
@ -680,15 +676,14 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|
|||
|
||||
(define (do-rotate bitmap)
|
||||
(let ([θ (degrees->radians (bitmap-angle bitmap))])
|
||||
(let-values ([(bytes w h) (bitmap->bytes (bitmap-rendered-bitmap bitmap) (bitmap-rendered-mask bitmap))])
|
||||
(let-values ([(bytes w h) (bitmap->bytes (bitmap-rendered-bitmap bitmap)
|
||||
(bitmap-rendered-mask bitmap))])
|
||||
(let-values ([(rotated-bytes rotated-w rotated-h)
|
||||
(rotate-bytes bytes w h θ)])
|
||||
(set-bitmap-rendered-bitmap!
|
||||
bitmap
|
||||
(bytes->bitmap rotated-bytes rotated-w rotated-h))
|
||||
(set-bitmap-rendered-mask!
|
||||
bitmap
|
||||
(send (bitmap-rendered-bitmap bitmap) get-loaded-mask))))))
|
||||
(let* ([bm (bytes->bitmap rotated-bytes rotated-w rotated-h)]
|
||||
[mask (send bm get-loaded-mask)])
|
||||
(set-bitmap-rendered-bitmap! bitmap bm)
|
||||
(set-bitmap-rendered-mask! bitmap mask))))))
|
||||
|
||||
(define (do-scale bitmap)
|
||||
(let* ([bdc (make-object bitmap-dc%)]
|
||||
|
|
@ -762,18 +757,29 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|
|||
(* θ 2 pi (/ 360)))
|
||||
|
||||
(define (mode-color->pen mode color)
|
||||
(cond
|
||||
[(eq? mode 'solid)
|
||||
(send the-pen-list find-or-create-pen "black" 1 'transparent)]
|
||||
[else
|
||||
(send the-pen-list find-or-create-pen color 1 'solid)]))
|
||||
(send the-pen-list find-or-create-pen
|
||||
(get-color-arg color)
|
||||
1
|
||||
(case mode
|
||||
[(outline) 'solid]
|
||||
[(solid) 'transparent])))
|
||||
|
||||
(define (mode-color->brush mode color)
|
||||
(cond
|
||||
[(eq? mode 'solid)
|
||||
(send the-brush-list find-or-create-brush color 'solid)]
|
||||
[else
|
||||
(send the-brush-list find-or-create-brush "black" 'transparent)]))
|
||||
(send the-brush-list find-or-create-brush
|
||||
(get-color-arg color)
|
||||
(case mode
|
||||
[(outline) 'transparent]
|
||||
[(solid) 'solid])))
|
||||
|
||||
(define (get-color-arg color)
|
||||
(if (string? color)
|
||||
color
|
||||
(make-object color%
|
||||
(color-red color)
|
||||
(color-green color)
|
||||
(color-blue color))))
|
||||
|
||||
(define-struct/reg-mk color (red green blue) #:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
|
@ -794,6 +800,8 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|
|||
|
||||
make-bitmap bitmap? bitmap-raw-bitmap bitmap-raw-mask bitmap-angle bitmap-x-scale bitmap-y-scale
|
||||
bitmap-rendered-bitmap bitmap-rendered-mask
|
||||
|
||||
(struct-out color)
|
||||
|
||||
degrees->radians
|
||||
normalize-shape
|
||||
|
|
@ -806,7 +814,9 @@ the mask bitmap and the original bitmap are all together in a single bytes!
|
|||
|
||||
text->font
|
||||
compare-all-rotations
|
||||
render-image)
|
||||
render-image
|
||||
|
||||
scale-np-atomic)
|
||||
|
||||
;; method names
|
||||
(provide get-shape get-bb get-normalized? get-normalized-shape)
|
||||
|
|
|
|||
|
|
@ -8,8 +8,8 @@
|
|||
(list
|
||||
(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.0)
|
||||
(list
|
||||
'(image-height
|
||||
(overlay (circle 20 "solid" "orange") (circle 30 "solid" "purple")))
|
||||
|
|
@ -76,6 +76,91 @@
|
|||
'(rotate 45 (ellipse 60 20 "solid" "olivedrab"))
|
||||
'image
|
||||
"28daec71a64.png")
|
||||
(list
|
||||
'(beside
|
||||
(place-image/align
|
||||
(circle 8 "solid" "tomato")
|
||||
0
|
||||
0
|
||||
"center"
|
||||
"center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align
|
||||
(circle 8 "solid" "tomato")
|
||||
8
|
||||
8
|
||||
"center"
|
||||
"center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align
|
||||
(circle 8 "solid" "tomato")
|
||||
16
|
||||
16
|
||||
"center"
|
||||
"center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align
|
||||
(circle 8 "solid" "tomato")
|
||||
24
|
||||
24
|
||||
"center"
|
||||
"center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align
|
||||
(circle 8 "solid" "tomato")
|
||||
32
|
||||
32
|
||||
"center"
|
||||
"center"
|
||||
(rectangle 32 32 "outline" "black")))
|
||||
'image
|
||||
"cf131e14ad.png")
|
||||
(list
|
||||
'(place-image/align
|
||||
(triangle 16 "solid" "yellowgreen")
|
||||
32
|
||||
32
|
||||
"right"
|
||||
"bottom"
|
||||
(rectangle 32 32 "solid" "mediumgoldenrod"))
|
||||
'image
|
||||
"f4c4d435a6.png")
|
||||
(list
|
||||
'(place-image
|
||||
(circle 4 "solid" "white")
|
||||
16
|
||||
18
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
-2
|
||||
4
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
12
|
||||
0
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
6
|
||||
12
|
||||
(rectangle 24 24 "solid" "goldenrod")))))
|
||||
'image
|
||||
"1178fdd1294.png")
|
||||
(list
|
||||
'(place-image
|
||||
(triangle 64 "solid" "red")
|
||||
-8
|
||||
-8
|
||||
(rectangle 48 48 "solid" "gray"))
|
||||
'image
|
||||
"2875b40781.png")
|
||||
(list
|
||||
'(place-image
|
||||
(triangle 32 "solid" "red")
|
||||
8
|
||||
8
|
||||
(rectangle 48 48 "solid" "gray"))
|
||||
'image
|
||||
"2bea495d1f.png")
|
||||
(list
|
||||
'(above/align
|
||||
"center"
|
||||
|
|
@ -256,6 +341,15 @@
|
|||
(ellipse 60 30 "solid" "purple"))
|
||||
'image
|
||||
"bf08c71801.png")
|
||||
(list
|
||||
'(overlay
|
||||
(regular-polygon 20 5 "solid" (make-color 50 50 255))
|
||||
(regular-polygon 25 5 "solid" (make-color 100 100 255))
|
||||
(regular-polygon 30 5 "solid" (make-color 150 150 255))
|
||||
(regular-polygon 35 5 "solid" (make-color 200 200 255))
|
||||
(regular-polygon 40 5 "solid" (make-color 250 250 255)))
|
||||
'image
|
||||
"1aea411192a.png")
|
||||
(list
|
||||
'(overlay
|
||||
(ellipse 10 10 "solid" "red")
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
|
||||
@defproc[(circle [radius (and/c real? (not/c negative?))]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
Constructs a circle with the given radius, height, mode, and color.
|
||||
|
||||
|
|
@ -33,11 +33,10 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
|
||||
}
|
||||
|
||||
|
||||
@defproc[(ellipse [width (and/c real? (not/c negative?))]
|
||||
[height (and/c real? (not/c negative?))]
|
||||
[mode mode?]
|
||||
[color color?]) image?]{
|
||||
[color image-color?]) image?]{
|
||||
Constructs an ellipsis with the given width, height, mode, and color.
|
||||
|
||||
@image-examples[(ellipse 40 20 "outline" "black")
|
||||
|
|
@ -47,7 +46,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
|
||||
@defproc[(triangle [side-length (and/c real? (not/c negative?))]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
Constructs a upward-pointing equilateral triangle.
|
||||
The @scheme[side-length] argument
|
||||
|
|
@ -60,7 +59,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
@defproc[(right-triangle [side-length1 (and/c real? (not/c negative?))]
|
||||
[side-length2 (and/c real? (not/c negative?))]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
|
||||
Constructs a triangle with a right angle where the two sides adjacent
|
||||
|
|
@ -72,7 +71,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
@defproc[(isosceles-triangle [side-length (and/c real? (not/c negative?))]
|
||||
[angle angle?]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
|
||||
Creates a triangle with two equal-length sides, of length @scheme[side-length]
|
||||
|
|
@ -89,7 +88,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
|
||||
@defproc[(square [side-length (and/c real? (not/c negative?))]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
|
||||
Constructs a square.
|
||||
|
|
@ -99,7 +98,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
|
||||
}
|
||||
|
||||
@defproc[(rectangle [width real?] [height real?] [mode mode?] [color color?]) image?]{
|
||||
@defproc[(rectangle [width real?] [height real?] [mode mode?] [color image-color?]) image?]{
|
||||
Constructs a rectangle with the given width, height, mode, and color.
|
||||
@image-examples[(rectangle 40 20 "outline" "black")
|
||||
(rectangle 20 40 "solid" "blue")]
|
||||
|
|
@ -108,7 +107,7 @@ Existing images can be rotated, scaled, and overlaid on top of each other.
|
|||
@defproc[(rhombus [side-length (and/c real? (not/c negative?))]
|
||||
[angle angle?]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
|
||||
Constructs a four sided polygon with all equal sides and thus where opposite angles are equal to each
|
||||
|
|
@ -121,7 +120,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
@defproc[(regular-polygon [side-length (and/c real? (not/c negative?))]
|
||||
[side-count side-count?]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
Constructs a regular polygon with @scheme[side-count] sides.
|
||||
|
||||
|
|
@ -132,7 +131,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
|
||||
@defproc[(star [side-length (and/c real? (not/c negative?))]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
Constructs a star with five points. The @scheme[side-length] argument
|
||||
determines the side length of the enclosing pentagon.
|
||||
|
|
@ -145,7 +144,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
[side-count side-count?]
|
||||
[step-count step-count?]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
|
||||
Constructs an arbitrary regular star polygon (a generalization of the regular polygons).
|
||||
|
|
@ -164,7 +163,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
|
||||
@defproc[(polygon [verticies (listof posn?)]
|
||||
[mode mode?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
Constructs a polygon connecting the given verticies.
|
||||
|
||||
|
|
@ -184,7 +183,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
"solid" "plum")]
|
||||
}
|
||||
|
||||
@defproc[(line [x1 real?] [y1 real?] [color color?]) image?]{
|
||||
@defproc[(line [x1 real?] [y1 real?] [color image-color?]) image?]{
|
||||
Constructs an image representing a line segment that connects the points
|
||||
(0,0) to (x1,y1).
|
||||
|
||||
|
|
@ -196,7 +195,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
@defproc[(add-line [image image?]
|
||||
[x1 real?] [y1 real?]
|
||||
[x2 real?] [y2 real?]
|
||||
[color color?])
|
||||
[color image-color?])
|
||||
image?]{
|
||||
|
||||
Adds a line to the image @scheme[image], starting from the point (@scheme[x1],@scheme[y1])
|
||||
|
|
@ -212,7 +211,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
"darkolivegreen")]
|
||||
}
|
||||
|
||||
@defproc[(text [string string?] [font-size (and/c integer? (<=/c 1 255))] [color color?])
|
||||
@defproc[(text [string string?] [font-size (and/c integer? (<=/c 1 255))] [color image-color?])
|
||||
image?]{
|
||||
|
||||
Constructs an image that draws the given string, using the font size and color.
|
||||
|
|
@ -221,7 +220,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
(text "Goodbye" 36 "indigo")]
|
||||
}
|
||||
|
||||
@defproc[(text/font [string string?] [font-size (and/c integer? (<=/c 1 255))] [color color?]
|
||||
@defproc[(text/font [string string?] [font-size (and/c integer? (<=/c 1 255))] [color image-color?]
|
||||
[face (or/c string? #f)]
|
||||
[family (or/c 'default 'decorative 'roman 'script 'swiss 'modern 'symbol 'system)]
|
||||
[style (or/c 'normal 'italic 'slant)]
|
||||
|
|
@ -258,7 +257,7 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
@image-examples[(bitmap icons/stop-16x16.png)
|
||||
(bitmap icons/b-run.png)]
|
||||
}
|
||||
|
||||
|
||||
@section{Overlaying Images}
|
||||
|
||||
@defproc[(overlay [i1 image?] [i2 image?] [is image?] ...) image?]{
|
||||
|
|
@ -273,7 +272,12 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
(ellipse 30 30 "solid" "red")
|
||||
(ellipse 40 40 "solid" "black")
|
||||
(ellipse 50 50 "solid" "red")
|
||||
(ellipse 60 60 "solid" "black"))]
|
||||
(ellipse 60 60 "solid" "black"))
|
||||
(overlay (regular-polygon 20 5 "solid" (make-color 50 50 255))
|
||||
(regular-polygon 25 5 "solid" (make-color 100 100 255))
|
||||
(regular-polygon 30 5 "solid" (make-color 150 150 255))
|
||||
(regular-polygon 35 5 "solid" (make-color 200 200 255))
|
||||
(regular-polygon 40 5 "solid" (make-color 250 250 255)))]
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -453,6 +457,70 @@ other. The top and bottom pair of angles is @scheme[angle] and the left and righ
|
|||
|
||||
}
|
||||
|
||||
@section{Placing Images}
|
||||
|
||||
Placing images into scenes is particularly useful when building worlds
|
||||
and universes using @scheme[2htdp/universe].
|
||||
|
||||
@defproc[(place-image [image image?] [x real?] [y real?] [scene image?]) image?]{
|
||||
|
||||
Places @scheme[image] onto @scheme[scene] with its upper left corner at the coordinates
|
||||
(@scheme[x],@scheme[y]) and crops the resulting image so that it has the
|
||||
same size as @scheme[scene].
|
||||
|
||||
@image-examples[(place-image
|
||||
(triangle 32 "solid" "red")
|
||||
8 8
|
||||
(rectangle 48 48 "solid" "gray"))
|
||||
|
||||
(place-image
|
||||
(triangle 64 "solid" "red")
|
||||
-8 -8
|
||||
(rectangle 48 48 "solid" "gray"))
|
||||
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
16 18
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
-2 4
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
12 0
|
||||
(place-image
|
||||
(circle 4 "solid" "white")
|
||||
6 12
|
||||
(rectangle 24 24 "solid" "goldenrod")))))]
|
||||
}
|
||||
@defproc[(place-image/align [image image?] [x real?] [y real?] [scene image?] [x-place x-place?] [y-place y-place?])
|
||||
image?]{
|
||||
|
||||
Places @scheme[image] onto @scheme[scene] with its @scheme[x-place] and @scheme[y-place]
|
||||
at the coordinates
|
||||
(@scheme[x],@scheme[y]) and crops the resulting image so that it has the
|
||||
same size as @scheme[scene].
|
||||
|
||||
@image-examples[(place-image/align (triangle 16 "solid" "yellowgreen")
|
||||
32 32 "right" "bottom"
|
||||
(rectangle 32 32 "solid" "mediumgoldenrod"))
|
||||
(beside
|
||||
(place-image/align (circle 8 "solid" "tomato")
|
||||
0 0 "center" "center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align (circle 8 "solid" "tomato")
|
||||
8 8 "center" "center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align (circle 8 "solid" "tomato")
|
||||
16 16 "center" "center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align (circle 8 "solid" "tomato")
|
||||
24 24 "center" "center"
|
||||
(rectangle 32 32 "outline" "black"))
|
||||
(place-image/align (circle 8 "solid" "tomato")
|
||||
32 32 "center" "center"
|
||||
(rectangle 32 32 "outline" "black")))]
|
||||
}
|
||||
|
||||
@section{Rotating, Scaling, Cropping, and Framing Images}
|
||||
|
||||
@defproc[(rotate [angle angle?] [image image?]) image?]{
|
||||
|
|
@ -577,22 +645,30 @@ This section lists predicates for the basic structures provided by the image lib
|
|||
filled in or not.
|
||||
}
|
||||
|
||||
@defproc[(color? [x any/c]) boolean?]{
|
||||
@defproc[(image-color? [x any/c]) boolean?]{
|
||||
|
||||
Determines if @scheme[x] represents a color. Strings, symbols,
|
||||
and @scheme[color] structs are allowed as colors.
|
||||
|
||||
Determines if @scheme[x] represents a color. Both strings and symbols are allowed as colors.
|
||||
For example,
|
||||
@scheme["magenta"], @scheme["black"], @scheme['orange], and @scheme['purple]
|
||||
are allowed. Colors are not case-sensitive, so
|
||||
@scheme["Magenta"], @scheme["Black"], @scheme['Orange], and @scheme['Purple]
|
||||
are also allowed, and are the same colors as in the previous sentence.
|
||||
|
||||
If a color is not recognized, black is used in its place.
|
||||
If a string or symbol color name is not recognized, black is used in its place.
|
||||
|
||||
The complete list of colors is available in the documentation for
|
||||
@scheme[color-database<%>].
|
||||
|
||||
}
|
||||
|
||||
@defstruct[color ([red (and/c natural-number/c (<=/c 255))]
|
||||
[green (and/c natural-number/c (<=/c 255))]
|
||||
[blue (and/c natural-number/c (<=/c 255))])]{
|
||||
The @scheme[color] struct defines a color with red, green, and blue components
|
||||
that range from @scheme[0] to @scheme[255].
|
||||
}
|
||||
|
||||
@defproc[(y-place? [x any/c]) boolean?]{
|
||||
Determines if @scheme[x] is a placement option
|
||||
for the vertical direction. It can be one
|
||||
|
|
|
|||
BIN
collects/teachpack/2htdp/scribblings/img/1178fdd1294.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/1178fdd1294.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 545 B |
BIN
collects/teachpack/2htdp/scribblings/img/1aea411192a.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/1aea411192a.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.4 KiB |
BIN
collects/teachpack/2htdp/scribblings/img/2875b40781.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/2875b40781.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 717 B |
BIN
collects/teachpack/2htdp/scribblings/img/2bea495d1f.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/2bea495d1f.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 457 B |
BIN
collects/teachpack/2htdp/scribblings/img/cf131e14ad.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/cf131e14ad.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 992 B |
BIN
collects/teachpack/2htdp/scribblings/img/f4c4d435a6.png
Normal file
BIN
collects/teachpack/2htdp/scribblings/img/f4c4d435a6.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 285 B |
Loading…
Reference in New Issue
Block a user