-(define (make-title port)
- (if header-stencil
- (let ((x-ext (ly:stencil-get-extent header-stencil Y))
- (y-ext (ly:stencil-get-extent header-stencil X)))
- ;;(display (start-system (interval-length x-ext) (interval-length y-ext))
- (display (start-system
- ;; output-scale trouble?
- (/ (interval-length x-ext) 2)
- (/ (interval-length y-ext) 2))
- port)
- (output-stencil port (ly:stencil-get-expr header-stencil) '(0 . 0))
- (display (stop-system) port)))
- "")
-
-(define (no-origin) "")
-
-;; FIXME: duplictates output-scopes, duplicated in other backends
-;; FIXME: silly interface name
-(define (output-paper-def pd)
- (let ((prefix "lilypondpaper"))
-
- (define (scope-entry->string key var)
- (let ((val (variable-ref var)))
- (cond
- ((string? val) (ps-string-def prefix key val))
- ((number? val) (ps-number-def prefix key val))
- (else ""))))
-
- (apply
- string-append
- (module-map scope-entry->string (ly:output-def-scope pd)))))
-
-;; FIXME: duplicated in other output backends
-;; FIXME: silly interface name
-(define (output-scopes paper scopes fields basename)
-
- ;; FIXME: customise/generate these
- (let ((props '(((font-family . roman)
- (word-space . 1)
- (baseline-skip . 2)
- (font-series . medium)
- (font-style . roman)
- (font-shape . upright)
- (font-size . 0))))
- (prefix "lilypond")
- (stencils '())
- (baseline-skip 2))
-
- (define (scope-entry->string key var)
- (let ((val (variable-ref var)))
-
- (if (memq key fields)
- (header-to-file basename key val))
-
- (cond
- ((eq? key 'font)
- BARF
- (format (current-error-port) "PROPS:~S\n" val)
- (set! props (cons val props))
- "")
-
- ;; define strings, for /make-lilypond-title to pick up
- ((string? val) (ps-string-def prefix key val))
-
- ;; generate stencil from markup
- ((markup? val) (set! stencils
- (append
- stencils
- (list
- (interpret-markup paper props val))))
- "")
- ((number? val) (ps-number-def prefix key val))
- (else ""))))
-
- (define (output-scope scope)
- (apply string-append (module-map scope-entry->string scope)))
-
- (let ((s (string-append (apply string-append (map output-scope scopes)))))
- (set! header-stencil (stack-lines DOWN 0 baseline-skip stencils))
-
- ;; trigger font load
- (ly:stencil-get-expr header-stencil)
- s)))
-
-;; hmm, looks like recursing call is always last statement, does guile
-;; think so too?
-(define (output-stencil port expr offset)
- (if (pair? expr)
- (let ((head (car expr)))
- (cond
- ((ly:input-location? head)
- (display (apply define-origin (ly:input-location head)) port)
- (output-stencil port (cadr expr) offset))
- ((eq? head 'no-origin)
- (display (expression->string head) port)
- (output-stencil port (cadr expr) offset))
- ((eq? head 'translate-stencil)
- (output-stencil port (caddr expr) (offset-add offset (cadr expr))))
- ((eq? head 'combine-stencil)
- (output-stencil port (cadr expr) offset)
- (output-stencil port (caddr expr) offset))
- (else
- (display (placebox (car offset) (cdr offset)
- (expression->string expr)) port))))))
-