;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2004--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-; for define-safe-public when byte-compiling using Guile V2
+;; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
(define-public (set-paper-dimension-variables mod)
(module-define! mod 'dimension-variables
- '(blot-diameter
- bottom-margin
- cm
- footnote-footer-padding
- footnote-padding
- horizontal-shift
- in
- indent
- inner-margin
- inner-margin-default-scaled
- ledger-line-thickness
- left-margin
+ '(binding-offset
+ blot-diameter
+ bottom-margin
+ cm
+ footnote-footer-padding
+ footnote-padding
+ horizontal-shift
+ in
+ incipit-width
+ indent
+ inner-margin
+ inner-margin-default-scaled
+ ledger-line-thickness
+ left-margin
left-margin-default-scaled
- line-thickness
- line-width
- mm
- outer-margin
- outer-margin-default-scaled
- paper-height
- paper-width
- pt
- right-margin
+ line-thickness
+ line-width
+ mm
+ outer-margin
+ outer-margin-default-scaled
+ paper-height
+ paper-width
+ pt
+ right-margin
right-margin-default-scaled
- short-indent
- staff-height
- staff-space
- top-margin)))
+ short-indent
+ staff-height
+ staff-space
+ top-margin)))
(define (calc-line-thickness staff-space pt)
;; linear interpolation.
(ss (/ staff-height 4))
(factor (/ staff-height (* 20 pt)))
(setm! (lambda (sym val)
- (module-define! module sym val))))
+ (module-define! module sym val))))
;; Synchronized with the `text-font-size'
;; binding in add-pango-fonts (see font.scm).
(setm! 'text-font-size (* 11 factor))
(setm! 'output-scale ss)
- (setm! 'fonts (make-century-schoolbook-tree factor))
+ (setm! 'fonts (make-default-fonts-tree factor))
(setm! 'staff-height staff-height)
(setm! 'staff-space ss)
(define-safe-public (set-global-staff-size sz)
"Set the default staff size, where SZ is thought to be in PT."
(let* ((current-mod (current-module))
- (parser (eval 'parser current-mod))
- (pap (ly:parser-lookup parser '$defaultpaper))
- (in-layout? (or (module-defined? current-mod 'is-paper)
- (module-defined? current-mod 'is-layout)))
+ (pap (ly:parser-lookup '$defaultpaper))
+ (in-layout? (or (module-defined? current-mod 'is-paper)
+ (module-defined? current-mod 'is-layout)))
- ;; maybe not necessary.
- ;; but let's be paranoid. Maybe someone still refers to the
- ;; old one.
- (new-paper (ly:output-def-clone pap))
+ ;; maybe not necessary.
+ ;; but let's be paranoid. Maybe someone still refers to the
+ ;; old one.
+ (new-paper (ly:output-def-clone pap))
- (new-scope (ly:output-def-scope new-paper)))
+ (new-scope (ly:output-def-scope new-paper)))
(if in-layout?
- (ly:warning (_ "set-global-staff-size: not in toplevel scope")))
+ (ly:warning (_ "set-global-staff-size: not in toplevel scope")))
(layout-set-absolute-staff-size-in-module new-scope
- (* sz (eval 'pt new-scope)))
+ (* sz (eval 'pt new-scope)))
(module-define! current-mod '$defaultpaper new-paper)))
(define-public paper-alist
))
;; todo: take dimension arguments.
-
-(define (set-paper-dimensions m w h)
+(define (lookup-paper-name module name landscape?)
+ "Look up @var{name} and return a number pair of width and height,
+where @var{landscape?} specifies whether the dimensions should be swapped
+unless explicitly overriden in the name."
+ (let* ((swapped?
+ (cond ((string-suffix? "landscape" name)
+ (set! name
+ (string-trim-right (string-drop-right name 9)))
+ #t)
+ ((string-suffix? "portrait" name)
+ (set! name
+ (string-trim-right (string-drop-right name 8)))
+ #f)
+ (else landscape?)))
+ (is-paper? (module-defined? module 'is-paper))
+ (entry (and is-paper?
+ (eval-carefully (assoc-get name paper-alist)
+ module
+ #f))))
+ (and entry is-paper?
+ (if swapped? (cons (cdr entry) (car entry)) entry))))
+
+(define (set-paper-dimensions m w h landscape?)
"M is a module (i.e. layout->scope_ )"
(let*
;; page layout - what to do with (printer specific!) margin settings?
- ((paper-default (eval-carefully
- (assoc-get
- (ly:get-option 'paper-size)
- paper-alist
- #f
- #t)
- m
- (cons w h)))
- ;; Horizontal margins, marked with 'preserve, are stored
+ ((paper-default (or (lookup-paper-name
+ m (ly:get-option 'paper-size) landscape?)
+ (cons w h)))
+ ;; Horizontal margins, marked with #t in the cddr, are stored
;; in renamed variables because they must not be overwritten.
+ ;; The cadr indicates whether a value is a vertical dimension.
;; Output_def::normalize () needs to know
;; whether the user set the value or not.
- (scaleable-values `((("left-margin" . ,w) . preserve)
- (("right-margin" . ,w) . preserve)
- (("inner-margin" . ,w) . preserve)
- (("outer-margin" . ,w) . preserve)
- (("binding-offset" . ,w) . '())
- (("top-margin" . ,h) . '())
- (("bottom-margin" . ,h) . '())
- (("indent" . ,w) . '())
- (("short-indent" . ,w) . '())))
+ (scaleable-values '(("left-margin" #f . #t)
+ ("right-margin" #f . #t)
+ ("inner-margin" #f . #t)
+ ("outer-margin" #f . #t)
+ ("binding-offset" #f . #f)
+ ("top-margin" #t . #f)
+ ("bottom-margin" #t . #f)
+ ("indent" #f . #f)
+ ("short-indent" #f . #f)))
(scaled-values
- (map
+ (map
(lambda (entry)
(let ((entry-symbol
- (string->symbol
- (string-append (caar entry) "-default")))
- (orientation (cdar entry)))
- (if paper-default
- (cons (if (eq? (cdr entry) 'preserve)
- (string-append (caar entry) "-default-scaled")
- (caar entry))
- (round (* orientation
- (/ (eval-carefully entry-symbol m 0)
- (if (= orientation w)
- (car paper-default)
- (cdr paper-default))))))
- entry)))
- scaleable-values)))
+ (string->symbol
+ (string-append (car entry) "-default")))
+ (vertical? (cadr entry)))
+ (cons (if (cddr entry)
+ (string-append (car entry) "-default-scaled")
+ (car entry))
+ (round (* (if vertical? h w)
+ (/ (eval-carefully entry-symbol m 0)
+ ((if vertical? cdr car)
+ paper-default)))))))
+ scaleable-values)))
(module-define! m 'paper-width w)
(module-define! m 'paper-height h)
(for-each
(lambda (value)
(let ((value-symbol (string->symbol (car value)))
- (number (cdr value)))
- (module-define! m value-symbol number)))
+ (number (cdr value)))
+ (module-define! m value-symbol number)))
scaled-values)))
(define (internal-set-paper-size module name landscape?)
- (let* ((entry-name name)
- (swapped?
- (cond ((string-suffix? "landscape" name)
- (set! entry-name
- (string-trim-right (string-drop-right name 9)))
- #t)
- ((string-suffix? "portrait" name)
- (set! entry-name
- (string-trim-right (string-drop-right name 8)))
- #f)
- (else landscape?)))
- (entry (assoc-get entry-name paper-alist))
- (is-paper? (module-defined? module 'is-paper))
- (mm (eval 'mm module)))
- (define (swap x)
- (cons (cdr x) (car x)))
-
+ (let* ((entry (lookup-paper-name module name landscape?))
+ (is-paper? (module-defined? module 'is-paper)))
(cond
((not is-paper?)
(ly:warning (_ "This is not a \\layout {} object, ~S") module))
(entry
- (set! entry (eval entry module))
- (if swapped?
- (set! entry (swap entry)))
- (set-paper-dimensions module (car entry) (cdr entry))
-
+ (set-paper-dimensions module (car entry) (cdr entry) landscape?)
+
(module-define! module 'papersizename name)
(module-define! module 'landscape
- (if landscape? #t #f)))
+ (if landscape? #t #f)))
(else
(ly:warning (_ "Unknown paper size: ~a") name)))))
(define-safe-public (set-default-paper-size name . rest)
- (internal-set-paper-size
- (ly:output-def-scope (eval '$defaultpaper (current-module)))
- name
- (memq 'landscape rest)))
+ (let* ((pap (module-ref (current-module) '$defaultpaper))
+ (new-paper (ly:output-def-clone pap))
+ (new-scope (ly:output-def-scope new-paper)))
+ (internal-set-paper-size
+ new-scope
+ name
+ (memq 'landscape rest))
+ (module-set! (current-module) '$defaultpaper new-paper)))
(define-public (set-paper-size name . rest)
(if (module-defined? (current-module) 'is-paper)
(internal-set-paper-size (current-module) name
- (memq 'landscape rest))
+ (memq 'landscape rest))
;;; TODO: should raise (generic) exception with throw, and catch
;;; that in parse-scm.cc
(define-public (scale-layout paper scale)
"Return a clone of the paper, scaled by the given scale factor."
(let* ((new-paper (ly:output-def-clone paper))
- (dim-vars (ly:output-def-lookup paper 'dimension-variables))
- (old-scope (ly:output-def-scope paper))
- (scope (ly:output-def-scope new-paper)))
+ (dim-vars (ly:output-def-lookup paper 'dimension-variables))
+ (old-scope (ly:output-def-scope paper))
+ (scope (ly:output-def-scope new-paper)))
(for-each
(lambda (v)
(let* ((var (module-variable old-scope v))
- (val (if (variable? var) (variable-ref var) #f)))
+ (val (if (variable? var) (variable-ref var) #f)))
- (if (number? val)
- (module-define! scope v (/ val scale))
- ;; Cannot warn for non-numbers, eg. for paper-width, paper-height.
- )))
+ (if (number? val)
+ (module-define! scope v (/ val scale))
+ ;; Cannot warn for non-numbers, eg. for paper-width, paper-height.
+ )))
dim-vars)
;; Mark the clone.
(ly:output-def-set-variable! new-paper 'cloned #t)
projects / lilypond.git / blobdiff