added image->color-list and color-list->bitmap

This commit is contained in:
Robby Findler 2010-09-04 13:52:49 -05:00
parent a2b11a0329
commit 1fa6be75b5
11 changed files with 191 additions and 33 deletions

View File

@ -105,6 +105,8 @@ and they all have good sample contracts. (It is amazing what we can do with kids
scene+curve
text
text/font
image->color-list
color-list->bitmap
x-place?
y-place?

View File

@ -1159,7 +1159,39 @@
(current-directory)))])])
#`(make-object image-snip% (make-object bitmap% #,path 'unknown/mask)))]))
(define/chk (image->color-list image)
(let* ([w (image-width image)]
[h (image-height image)]
[bm (make-object bitmap% w h)]
[bdc (make-object bitmap-dc% bm)]
[c (make-object color%)])
(send bdc clear)
(render-image image bdc 0 0)
(for/list ([i (in-range 0 (* w h))])
(send bdc get-pixel (remainder i w) (quotient i w) c)
(color (send c red) (send c green) (send c blue)))))
(define/chk (color-list->bitmap color-list width height)
(check-dependencies 'color-list->bitmap
(= (* width height) (length color-list))
"the length of the color list to match the product of the width and the height, but the list has ~a elements and the width and height are ~a and ~a respectively"
(length color-list) width height)
(let* ([bmp (make-object bitmap% width height)]
[bdc (make-object bitmap-dc% bmp)]
[o (make-object color%)])
(for ([c (in-list color-list)]
[i (in-naturals)])
(cond
[(color? c)
(send o set (color-red c) (color-green c) (color-blue c))
(send bdc set-pixel (remainder i width) (quotient i width) o)]
[else
(let* ([str (if (string? c) c (symbol->string c))]
[clr (or (send the-color-database find-color str)
(send the-color-database find-color "black"))])
(send bdc set-pixel (remainder i width) (quotient i width) clr))]))
(bitmap->image bmp)))
(define build-color/make-color
(let ([orig-make-color make-color])
(define/chk (make-color int0-255-1 int0-255-2 int0-255-3)
@ -1249,6 +1281,8 @@
scene+curve
text
text/font
image->color-list
color-list->bitmap
bitmap

View File

@ -182,6 +182,9 @@
(if (send the-color-database find-color color-str)
color-str
"black"))])]
[(color-list)
(check-arg fn-name (and (list? arg) (andmap image-color? arg)) 'color-list i arg)
arg]
[(string)
(check-arg fn-name (string? arg) 'string i arg)
arg]

View File

@ -644,9 +644,9 @@
(test (empty-scene 185 100)
=>
(overlay/align "left" "top"
(rectangle 184 99 'outline 'solid)
(rectangle 185 100 'solid 'white)))
(crop 0 0 185 100
(overlay (rectangle 185 100 'outline (pen "black" 2 'solid 'round 'round))
(rectangle 185 100 'solid 'white))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -1555,6 +1555,29 @@
160 160 0 1/2
(make-pen "black" 12 "solid" "round" "round")))
(test (image->color-list
(above (beside (rectangle 1 1 'solid (color 1 1 1))
(rectangle 1 1 'solid (color 2 2 2))
(rectangle 1 1 'solid (color 3 3 3)))
(beside (rectangle 1 1 'solid (color 4 4 4))
(rectangle 1 1 'solid (color 5 5 5))
(rectangle 1 1 'solid (color 6 6 6)))))
=>
(list (color 1 1 1) (color 2 2 2) (color 3 3 3)
(color 4 4 4) (color 5 5 5) (color 6 6 6)))
(test (color-list->bitmap
(list (color 1 1 1) (color 2 2 2) (color 3 3 3)
(color 4 4 4) (color 5 5 5) (color 6 6 6))
3 2)
=>
(above (beside (rectangle 1 1 'solid (color 1 1 1))
(rectangle 1 1 'solid (color 2 2 2))
(rectangle 1 1 'solid (color 3 3 3)))
(beside (rectangle 1 1 'solid (color 4 4 4))
(rectangle 1 1 'solid (color 5 5 5))
(rectangle 1 1 'solid (color 6 6 6)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -1633,6 +1656,12 @@
(test/exn (color #f #f #f)
=>
#rx"^color:")
(test/exn (color-list->bitmap
(list (color 1 1 1) (color 2 2 2) (color 3 3 3)
(color 4 4 4) (color 5 5 5) (color 6 6 6))
3 3)
=>
#rx"^color-list->bitmap")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
@ -1760,7 +1789,7 @@
(term image))))
#:attempts 1000)))
;;This expression was found by the below. Its problematic because it has a negative width.
;;This expression was found by the above. Its problematic because it has a negative width.
#;
(begin
(define i
@ -1769,3 +1798,22 @@
(rotate 30 (crop 54 30 20 10 i))))
(image-width i) (image-height i) i)
#|
This was found by the first redex check above:
(let ((i (flip-horizontal
(let ((i (line (+ (* 10 1) -2) (+ (* 10 3) 4) "green")))
(crop (max 0 (min (image-width i) (+ (* 10 4) 13)))
(max 0 (min (image-height i) (+ (* 10 2) 0)))
(+ (* 10 3) 2)
(+ (* 10 7) 0)
i)))))
(crop (max 0 (min (image-width i) (+ (* 10 0) 2)))
(max 0 (min (image-height i) (+ (* 10 2) 12)))
(+ (* 10 1) 7) (+ (* 10 1) 2)
i))
raises an exception crop: expected <number that is between 0 than the width (-1)> as first argument, given: 0
|#

View File

@ -513,7 +513,7 @@ graphical elements as expressions within a program. Plug-in tools can
extend the available graphical syntax, but this section describes some
of the more commonly used elements.
@subsection{Images}
@subsection[#:tag "images"]{Images}
DrRacket's @menuitem["Insert" "Insert Image..."] menu item lets you
select an image file from disk (in various formats such as GIF, PNG,

View File

@ -40,7 +40,8 @@
(printf "\nerror evaluating:\n")
(pretty-write exp)
(raise x))])
(parameterize ([current-namespace image-ns]) (eval exp)))])
(parameterize ([current-namespace image-ns])
(rewrite (eval exp))))])
(cond
[(image? result)
(let ([fn (exp->filename exp)])
@ -52,7 +53,18 @@
(unless (equal? result (read/write result))
(error 'handle-image "expression ~s produced ~s, which I can't write"
exp result))
(set! mapping (cons `(list ',exp 'val ,result) mapping))])))
(set! mapping (cons `(list ',exp 'val ',result) mapping))])))
(define (rewrite exp)
(let loop ([exp exp])
(cond
[(list? exp)
`(list ,@(map loop exp))]
[(color? exp)
`(color ,(color-red exp)
,(color-green exp)
,(color-blue exp))]
[else exp])))
(define (exp->filename exp)
(let loop ([prev 0])

View File

@ -36,26 +36,47 @@
(above r r r r r r))
'image
"245380940d6-1.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 (rectangle 10 0 "solid" "purple")) 'val 0)
(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 (rectangle 10 0 "solid" "purple")) 'val '0)
(list
'(image-height
(overlay (circle 20 "solid" "orange") (circle 30 "solid" "purple")))
'val
60)
(list '(image-height (circle 30 "solid" "orange")) 'val 60)
(list '(image-height (ellipse 30 40 "solid" "orange")) 'val 40)
(list '(image-width (rectangle 0 10 "solid" "purple")) 'val 0)
'60)
(list '(image-height (circle 30 "solid" "orange")) 'val '60)
(list '(image-height (ellipse 30 40 "solid" "orange")) 'val '40)
(list '(image-width (rectangle 0 10 "solid" "purple")) 'val '0)
(list
'(image-width
(beside (circle 20 "solid" "orange") (circle 20 "solid" "purple")))
'val
80)
(list '(image-width (circle 30 "solid" "orange")) 'val 60)
(list '(image-width (ellipse 30 40 "solid" "orange")) 'val 30)
'80)
(list '(image-width (circle 30 "solid" "orange")) 'val '60)
(list '(image-width (ellipse 30 40 "solid" "orange")) 'val '30)
(list
'(scale 40 (color-list->bitmap (list "red" "green" "blue") 3 1))
'image
"2e45632f5de.png")
(list
'(image->color-list
(above
(beside
(rectangle 1 1 "solid" (make-color 1 1 1))
(rectangle 1 1 "solid" (make-color 2 2 2)))
(beside
(rectangle 1 1 "solid" (make-color 3 3 3))
(rectangle 1 1 "solid" (make-color 4 4 4)))))
'val
'(list (color 1 1 1) (color 2 2 2) (color 3 3 3) (color 4 4 4)))
(list
'(image->color-list (rectangle 2 2 "solid" "black"))
'val
'(list (color 0 0 0) (color 0 0 0) (color 0 0 0) (color 0 0 0)))
(list '(bitmap icons/b-run.png) 'image "13aef4074e9.png")
(list '(bitmap icons/stop-16x16.png) 'image "72aef3dc67.png")
(list
'(beside
(ellipse 20 70 "solid" "lightsteelblue")
@ -641,8 +662,6 @@
"2dde939d6dc.png")
(list '(right-triangle 36 48 "solid" "black") 'image "1a0088e3819.png")
(list '(triangle 40 "solid" "tan") 'image "aeddf66d5d.png")
(list '(bitmap icons/b-run.png) 'image "13aef4074e9.png")
(list '(bitmap icons/stop-16x16.png) 'image "72aef3dc67.png")
(list
'(text/font "not really a link" 18 "blue" #f 'roman 'normal 'normal #t)
'image

View File

@ -177,18 +177,6 @@ Unlike @racket[scene+curve], if the line passes outside of @racket[image], the i
#f 'roman 'normal 'normal #t)]
}
@defform/subs[(bitmap bitmap-spec)
([bitmap-spec rel-string
id])]{
Loads the bitmap specified by @racket[bitmap-spec]. If @racket[bitmap-spec] is a string, it is treated as a
relative path. If it is an identifier, it is treated like a require spec and used to refer to a file
in a collection.
@image-examples[(bitmap icons/stop-16x16.png)
(bitmap icons/b-run.png)]
}
@section{Polygons}
@defproc*[([(triangle [side-length (and/c real? (not/c negative?))]
@ -1060,6 +1048,58 @@ the parts that fit onto @racket[scene].
(ellipse 20 10 "solid" "navy"))]
}
@section{Bitmaps}
DrRacket's @seclink["images" #:doc '(lib "scribblings/drracket/drracket.scrbl")]{Insert Image ...}
menu item allows you to insert images into your program text, and those images are treated
as images for this library.
Unlike all of the other images in this library, those images (and the other images created
by functions in this section of the documentation)
are represented as bitmaps, i.e., a (potentially quite large) array of colors.
This means that scaling and rotating them loses fidelity in the image and is significantly
more expensive than with the other shapes.
@defform/subs[(bitmap bitmap-spec)
([bitmap-spec rel-string
id])]{
Loads the bitmap specified by @racket[bitmap-spec]. If @racket[bitmap-spec] is a string, it is treated as a
relative path. If it is an identifier, it is treated like a require spec and used to refer to a file
in a collection.
@image-examples[(bitmap icons/stop-16x16.png)
(bitmap icons/b-run.png)]
}
@defproc[(image->color-list [image image?]) (listof color?)]{
Returns a list of colors that correspond to the colors in the
image, reading from left to right, top to bottom.
@image-examples[(image->color-list (rectangle 2 2 "solid" "black"))
(image->color-list
(above (beside (rectangle 1 1 "solid" (make-color 1 1 1))
(rectangle 1 1 "solid" (make-color 2 2 2)))
(beside (rectangle 1 1 "solid" (make-color 3 3 3))
(rectangle 1 1 "solid" (make-color 4 4 4)))))]
}
@defproc[(color-list->bitmap [colors (listof image-color?)]
[width (and/c real? (not/c negative?))]
[height (and/c real? (not/c negative?))])
image?]{
Constructs a bitmap from the given @racket[colors], with the given @racket[width] and @racket[height].
@image-examples[(scale
40
(color-list->bitmap
(list "red" "green" "blue")
3 1))]
}
@section{Image Properties}
@defproc[(image-width [i image?]) (and/c integer? (not/c negative?) exact?)]{

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.7 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 2.1 KiB

Binary file not shown.

After

Width:  |  Height:  |  Size: 184 B