add slide-pict/center

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}

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?))]

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)))