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

slideshow/balloon: Rackety

Browse Source
This commit is contained in:
Matthew Flatt 2012-09-20 09:30:23 -06:00
parent a422256393
commit d05f9bacb3
1 changed files with 13 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/texpict/balloon.rkt
View File

@ -1,15 +1,14 @@
(module balloon mzscheme (module balloon racket/base
(require "mrpict.rkt" (require "mrpict.rkt"
"utils.rkt" "utils.rkt"
racket/draw racket/draw
mzlib/class mzlib/class
mzlib/etc
mzlib/math) mzlib/math)
(provide wrap-balloon pip-wrap-balloon (provide wrap-balloon pip-wrap-balloon
place-balloon place-balloon
pin-balloon pin-balloon
(rename mk-balloon balloon) (rename-out [mk-balloon balloon])
make-balloon make-balloon
balloon? balloon?
balloon-pict balloon-pict
@ -136,22 +135,25 @@
(define corner-size 32) (define corner-size 32)
(define wrap-balloon (define wrap-balloon
(opt-lambda (p corner dx dy [color balloon-color][c-rad corner-size]) (lambda (p corner dx dy [color balloon-color] [c-rad corner-size]
#:factor [factor 1])
(let ([b (mk-balloon (+ (pict-width p) (* 2 c-rad)) (let ([b (mk-balloon (+ (pict-width p) (* 2 c-rad))
(+ (pict-height p) c-rad) (+ (pict-height p) c-rad)
c-rad c-rad
corner dx dy corner dx dy
color)]) color)])
(make-balloon (make-balloon
(cc-superimpose (scale (cc-superimpose
(balloon-pict b) (balloon-pict b)
p) p)
(balloon-point-x b) factor)
(balloon-point-y b))))) (* factor (balloon-point-x b))
(* factor (balloon-point-y b))))))
(define pip-wrap-balloon (define pip-wrap-balloon
(opt-lambda (p corner dx dy [color balloon-color][c-rad corner-size]) (lambda (p corner dx dy [color balloon-color] [c-rad corner-size]
(pin-balloon (wrap-balloon p corner dx dy color c-rad) (blank 0) 0 0))) #:factor [factor 1])
(pin-balloon (wrap-balloon p corner dx dy color c-rad) (blank 0) 0 0 #:factor factor)))
(define (do-place-balloon flip-proc? balloon p to find-to) (define (do-place-balloon flip-proc? balloon p to find-to)
(let-values ([(x y) (if (and (number? to) (let-values ([(x y) (if (and (number? to)