ppict-expanders.rkt

(define-expander-type ppict-ext)

(begin-for-syntax
  (define-syntax-class ppict-body
    #:datum-literals (splice)
    #:attributes ((flatten 1))
    (pattern (splice a:ppict-body ...)
             #:attr (flatten 1)
             (syntax->list #'(a.flatten ... ...)))
    (pattern a
             #:attr (flatten 1)
             (list #'a))))

(define-syntax (in:ppict-do* stx)
  (syntax-parse (expand-all-ppict-ext-expanders stx)
    [(_ body:ppict-body ...)
     #'(ppict-do* body.flatten ... ...)]))

(define-syntax in:ppict-do
  (syntax-parser
    [(_ . body)
     #'(let-values ([(p _) (in:ppict-do* . body)])
         p)]))

(define-syntax pslide/value
  (syntax-parser
    [(_ . body)
     #'(let-values ([(final progress)
                     (in:ppict-do* ((pslide-base-pict)) #:go (pslide-default-placer) . body)])
         (for-each slide progress)
         (slide final)
         final)]))

(define-syntax in:pslide
  (syntax-parser
    [(_ . body)
     #'(void (pslide/value . body))]))


(define-syntax (pslide/staged stx)
  (syntax-parse stx
    [(pslide/staged [name ...] arg ...)
     #'(staged [name ...] (in:pslide arg ...))]))

(define-ppict-ext-expander title
  (syntax-parser
    [(_ str)
     #'(splice
        #:go (coord 1/2 0 'ct)
        (t str)
        #:go (coord 1/2 1/2 'cc))]))

(define-ppict-ext-expander in
  (syntax-parser
    [(_ b body ...)
     #'(splice #:do [(define go? b)]
               (and go? body) ...)]))

(define-ppict-ext-expander def
  (syntax-parser
    [(_ . b)
     #'(splice #:do [(define . b)])]))