a34821ea4f
added #:set, #:alt to ppict-do added ppict-do-state added at-find-pict added tag-pict updated to slideshow changes changed placer rep, added merge-refpoints
53 lines
1.4 KiB
Racket
53 lines
1.4 KiB
Racket
#lang racket/base
|
|
(require (for-syntax racket/base
|
|
syntax/parse
|
|
syntax/parse/experimental/contract
|
|
"private/ppict-syntax.rkt")
|
|
racket/list
|
|
racket/contract
|
|
racket/gui/base
|
|
slideshow/base
|
|
slideshow/pict
|
|
"private/ppict.rkt")
|
|
|
|
;; ============================================================
|
|
;; Progressive Slides
|
|
|
|
(define pslide-base-pict
|
|
(make-parameter (lambda () (blank client-w client-h))))
|
|
|
|
(define pslide-default-placer
|
|
(make-parameter (coord 1/2 1/2 'cc)))
|
|
|
|
;; pslide* : symbol (pict -> (values pict (listof pict)) -> void
|
|
(define (pslide* who proc)
|
|
(let* ([init-pict ((pslide-base-pict))]
|
|
[init-placer (pslide-default-placer)])
|
|
(let-values ([(final picts)
|
|
(proc (ppict-go init-pict init-placer))])
|
|
(for-each slide picts)
|
|
(slide final)
|
|
(void))))
|
|
|
|
;; ----
|
|
|
|
(define-syntax (pslide stx)
|
|
(syntax-parse stx
|
|
[(_ . fs)
|
|
#:declare fs (fragment-sequence 'pslide #'xp #'rpss)
|
|
#'(pslide* 'pslide
|
|
(lambda (xp)
|
|
(let ([rpss null])
|
|
fs.code)))]))
|
|
|
|
;; ============================================================
|
|
;; Exports
|
|
|
|
(provide/contract
|
|
[pslide-base-pict
|
|
(parameter/c (-> pict?))]
|
|
[pslide-default-placer
|
|
(parameter/c placer?)])
|
|
|
|
(provide pslide)
|