From 2a0153cadbfa1212d082136fc185a4f8023cd366 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Sat, 30 Jul 2011 18:13:19 -0500
Subject: [PATCH] unstable/gui/pict: added scale-to

---
 collects/unstable/gui/pict.rkt               | 27 ++++++++++++++++++++
 collects/unstable/scribblings/gui/pict.scrbl | 24 +++++++++++++++++
 2 files changed, 51 insertions(+)

diff --git a/collects/unstable/gui/pict.rkt b/collects/unstable/gui/pict.rkt
index 73f2b71447..cb42ca2a86 100644
--- a/collects/unstable/gui/pict.rkt
+++ b/collects/unstable/gui/pict.rkt
@@ -356,6 +356,33 @@
  [pin-arrow-label-line pin-arrow-label-line-contract]
  [pin-arrows-label-line pin-arrow-label-line-contract])
 
+;; the following are by ryanc
+
+(define (scale-to p w h #:mode [mode 'preserve])
+  (let* ([w0 (pict-width p)]
+         [h0 (pict-height p)]
+         [wfactor0 (if (zero? w0) 1 (/ w w0))]
+         [hfactor0 (if (zero? h0) 1 (/ h h0))])
+    (let-values ([(wfactor hfactor)
+                  (case mode
+                    ((preserve inset)
+                     (let ([factor (min wfactor0 hfactor0)])
+                       (values factor factor)))
+                    ((distort)
+                     (values wfactor0 hfactor0)))])
+      (let ([scaled-pict (scale p wfactor hfactor)])
+        (case mode
+          ((inset)
+           (cc-superimpose (blank w h) scaled-pict))
+          (else
+           scaled-pict))))))
+
+(provide/contract
+ [scale-to
+  (->* (pict? real? real?)
+       (#:mode (or/c 'preserve 'inset 'distort))
+       pict?)])
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;;  Tagged picts
diff --git a/collects/unstable/scribblings/gui/pict.scrbl b/collects/unstable/scribblings/gui/pict.scrbl
index 770bf90fd4..9c8ac1947b 100644
--- a/collects/unstable/scribblings/gui/pict.scrbl
+++ b/collects/unstable/scribblings/gui/pict.scrbl
@@ -93,6 +93,30 @@ Extends @racket[pict]'s bounding box to a minimum @racket[width] and/or
 ]
 }
 
+@defproc[(scale-to [pict pict?]
+                   [width real?]
+                   [height real?]
+                   [#:mode mode (or/c 'preserve 'inset 'distort) 'preserve])
+         pict?]{
+
+Scales @racket[pict] so that its width and height are at most
+@racket[width] and @racket[height], respectively. If @racket[mode] is
+@racket['preserve], the width and height are scaled by the same factor
+so @racket[pict]'s aspect ratio is preserved; the result's bounding
+box may be smaller than @racket[width] by @racket[height]. If
+@racket[mode] is @racket['inset], the aspect ratio is preserved as
+with @racket['preserve], but the resulting pict is centered in a
+bounding box of exactly @racket[width] by @racket[height]. If
+@racket[mode] is @racket['distort], the width and height are scaled
+separately.
+
+@examples[#:eval the-eval
+(frame (scale-to (circle 100) 40 20))
+(frame (scale-to (circle 100) 40 20 #:mode 'inset))
+(frame (scale-to (circle 100) 40 20 #:mode 'distort))
+]
+}
+
 @subsection{Conditional Manipulations}
 
 These pict transformers all take boolean arguments that determine whether to