From 2d63f11949d0221d6bdc18488500d509a8e70857 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 20 Aug 2014 22:24:37 -0500
Subject: [PATCH] add slide-pict/center

---
 pkgs/pict-pkgs/pict-doc/pict/scribblings/anim.scrbl | 11 +++++++++++
 pkgs/pict-pkgs/pict-lib/pict/main.rkt               |  1 +
 pkgs/pict-pkgs/pict-lib/pict/private/play-pict.rkt  |  9 +++++++++
 3 files changed, 21 insertions(+)

diff --git a/pkgs/pict-pkgs/pict-doc/pict/scribblings/anim.scrbl b/pkgs/pict-pkgs/pict-doc/pict/scribblings/anim.scrbl
index 5079d767be..6ca921c2c3 100644
--- a/pkgs/pict-pkgs/pict-doc/pict/scribblings/anim.scrbl
+++ b/pkgs/pict-pkgs/pict-doc/pict/scribblings/anim.scrbl
@@ -73,6 +73,17 @@ The @racket[p-from] and @racket[p-to] picts are typically
 @racket[launder]ed @racket[ghost]s of @racket[p] within @racket[base],
 but they can be any picts within @racket[base].}
 
+@defproc[(slide-pict/center [base pict?]
+                            [p pict?]
+                            [p-from pict?]
+                            [p-to pict?]
+                            [n (real-in 0.0 1.0)])
+         pict?]{
+
+  Like @racket[slide-pict], but aligns the center of @racket[p]
+  with @racket[p-from] and @racket[p-to].
+}
+
 @; --------------------------------------------------
 
 @section{Merging Animations}
diff --git a/pkgs/pict-pkgs/pict-lib/pict/main.rkt b/pkgs/pict-pkgs/pict-lib/pict/main.rkt
index 8b150cab4c..0a8539376c 100644
--- a/pkgs/pict-pkgs/pict-lib/pict/main.rkt
+++ b/pkgs/pict-pkgs/pict-lib/pict/main.rkt
@@ -157,6 +157,7 @@
  (contract-out
   [fade-pict (->* ((real-in 0.0 1.0) pict? pict?) (#:combine (-> pict? pict? pict?)) pict?)]
   [slide-pict (-> pict? pict? pict? pict? (real-in 0.0 1.0) pict?)]
+  [slide-pict/center (-> pict? pict? pict? pict? (real-in 0.0 1.0) pict?)]
   [fade-around-pict (-> (real-in 0.0 1.0) pict? (-> pict? pict?) pict?)]
   [sequence-animations (->* () #:rest (listof (-> (real-in 0.0 1.0) pict?))
                             (-> (real-in 0.0 1.0) pict?))]
diff --git a/pkgs/pict-pkgs/pict-lib/pict/private/play-pict.rkt b/pkgs/pict-pkgs/pict-lib/pict/private/play-pict.rkt
index 5546861dd9..4bddb4a04a 100644
--- a/pkgs/pict-pkgs/pict-lib/pict/private/play-pict.rkt
+++ b/pkgs/pict-pkgs/pict-lib/pict/private/play-pict.rkt
@@ -5,6 +5,7 @@
 
 (provide fade-pict
          slide-pict
+         slide-pict/center
          fade-around-pict
          sequence-animations
          reverse-animations
@@ -113,6 +114,14 @@
               (+ y1 (* (- y2 y1) n))
               p)))
 
+(define (slide-pict/center base p p-from p-to n)
+  (let-values ([(x1 y1) (fail-gracefully (lambda () (cc-find base p-from)))]
+               [(x2 y2) (fail-gracefully (lambda () (cc-find base p-to)))])
+    (pin-over base
+              (- (+ x1 (* (- x2 x1) n)) (/ (pict-width p) 2))
+              (- (+ y1 (* (- y2 y1) n)) (/ (pict-height p) 2))
+              p)))
+
 (define (fade-around-pict n base evolved)
   (define tg1 (launder (ghost base)))
   (define tg2 (launder (ghost base)))