X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpaper.scm;h=23ec05a70f25715225123160ae71a352d41d6140;hb=HEAD;hp=ccbfe50176a11866589e8ef5ab9a83fc7b1bfac2;hpb=2784264fda1124e0db8fb9b1385905e48e2650b9;p=lilypond.git diff --git a/scm/paper.scm b/scm/paper.scm index ccbfe50176..23ec05a70f 100644 --- a/scm/paper.scm +++ b/scm/paper.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2004--2012 Han-Wen Nienhuys +;;;; Copyright (C) 2004--2015 Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -15,38 +15,40 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -; 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. @@ -70,14 +72,14 @@ (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) @@ -104,23 +106,22 @@ (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 @@ -240,50 +241,64 @@ )) ;; 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) @@ -294,53 +309,39 @@ (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 @@ -349,19 +350,19 @@ (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)