NoteHead \override #'font-relative-size = #-2
NoteHead \override #'font-relative-size = #-2
- Stem \override #'flag-style = ##f
+ Stem \override #'flag-style = #""
% The following determines the length of stems without beams
% default is between 2.8 and 4.0 depending on the number of flags
Stem \override #'length = #6
}
\translator { \StaffContext
- TimeSignature \override #'style = #"C4/4"
- TimeSignature \override #'visibility-function = #begin-of-line-visible
+ TimeSignature \override #'style = #'C4/4
+% TimeSignature \override #'visibility-function = #begin-of-line-visible
+ TimeSignature \override #'visibility-lambda = #begin-of-line-visible
}
}
Molecule
System_start_delimiter::staff_brace (Grob*me,Real y)
{
+
+ /*
+ FIXME: should look at afm/tfm file for dimensions.
+
+ (This breaks ascii-art output: it hasn't got 255 symbols)
+ */
+
+ // ugrhn
int lo = 0;
int hi = 255;
+
Font_metric *fm = Font_interface::get_default_font (me);
Box b;
paperAsFive = \paper {
staffheight = 5.\char;
- %% aiai only have these:
-%{
- mf/as5.af
- mf/as9.af
- mf/as-braces5.af
- mf/as-braces9.af
- mf/as-dummy1.af
- mf/as-dummy.af
- mf/as-number1.af
- mf/as-number4.af
-%}
+
+ \stylesheet #(as-make-style-sheet 'as5)
- \stylesheet #(make-style-sheet 'paper16)
+ \translator { \StaffContext barSize = \staffheight; }
+ % no beam-slope
+ %\translator { \VoiceContext beamHeight = #0; }
\include "params-as.ly";
}
paperAsNine = \paper {
staffheight = 9.\char;
- %% aiai only have these:
-%{
- mf/as5.af
- mf/as9.af
- mf/as-braces5.af
- mf/as-braces9.af
- mf/as-dummy1.af
- mf/as-dummy.af
- mf/as-number1.af
- mf/as-number4.af
-%}
- \stylesheet #(make-style-sheet 'paper16)
-
+
+ %\translator { \StaffContext barSize = \staffheight; }
+
+ \stylesheet #(as-make-style-sheet 'as9)
\include "params-as.ly";
+
}
\paper { \paperAsNine }
% params-as.ly
% generic paper parameters
-%%paperfile = \papersize + ".ly";
-%%% paperfile = "a4.ly";
-%%\include \paperfile;
-%hsize = 60.0\char;
-%vsize = 60.0\char; %?
+outputscale = \staffheight / 4.0;
-%%\include "paper.ly";
-linewidth = 60.0\char;
-textheight = 60.0\char;
+linewidth = 60.0 \char;
+textheight = 60.0 \char;
indent = 8.0\char;
staffspace = (\staffheight - 1.0 ) / 4.0;
stafflinethickness = \staffspace / 2.0;
-% paperfile = "a4.ly";
-%\include \paperfile;
-%\include "paper.ly";
-
-%staffspace = \staffheight / 4.0;
-%stafflinethickness = \staffspace / 10.0;
-
-outputscale = \staffheight / 4.0;
-
\translator { \NoteNamesContext }
\translator { \ScoreContext }
\translator { \ChoirStaffContext }
4
\f C 53; WX 1; N Numeral-5; B 0 0 1000 1000;
5
-\f C 53; WX 1; N Numeral-6; B 0 0 1000 1000;
+\f C 54; WX 1; N Numeral-6; B 0 0 1000 1000;
6
-\f C 53; WX 1; N Numeral-7; B 0 0 1000 1000;
+\f C 55; WX 1; N Numeral-7; B 0 0 1000 1000;
7
-\f C 53; WX 1; N Numeral-8; B 0 0 1000 1000;
+\f C 56; WX 1; N Numeral-8; B 0 0 1000 1000;
8
-\f C 53; WX 1; N Numeral-9; B 0 0 1000 1000;
+\f C 57; WX 1; N Numeral-9; B 0 0 1000 1000;
9
EndCharMetrics
EndFontMetrics %d
(___
\
.___/
-\f C 53; WX 1; N Numeral-6; B 0 1000 5000 5000;
+\f C 54; WX 1; N Numeral-6; B 0 1000 5000 5000;
___
/__
/ \
\___/
-\f C 53; WX 1; N Numeral-7; B 0 1000 5000 5000;
+\f C 55; WX 1; N Numeral-7; B 0 1000 5000 5000;
____
/
-/-
/
-\f C 53; WX 1; N Numeral-8; B 0 1000 5000 5000;
+\f C 56; WX 1; N Numeral-8; B 0 1000 5000 5000;
__
(__)
/ \
\____/
-\f C 53; WX 1; N Numeral-9; B 0 1000 5000 5000;
+\f C 57; WX 1; N Numeral-9; B 0 1000 5000 5000;
___
/ \
\___/
(debug-enable 'backtrace)
-;;;; AsciiScript as
+; (define cmr-alist
+; '(("bold" . "as-dummy")
+; ("brace" . "as-braces")
+; ("dynamic" . "as-dummy")
+; ("default" . "as-dummy")
+; ("feta" . "feta")
+; ("feta-1" . "feta")
+; ("feta-2" . "feta")
+; ("finger" . "as-number")
+; ("typewriter" . "as-dummy")
+; ("italic" . "as-dummy")
+; ("roman" . "as-dummy")
+; ("script" . "as-dummy")
+; ("large" . "as-dummy")
+; ("Large" . "as-dummy")
+; ("mark" . "as-number")
+; ("number" . "as-number")
+; ("timesig" . "as-number")
+; ("volta" . "as-number"))
+; )
+
+
+(define as-font-alist-alist
+ '(
+ (as5 .
+ (
+ (feta16 . as5)
+ (feta20 . as5)
+ (feta-nummer6 . as-number1)
+ (feta-nummer8 . as-number1)
+ (feta-braces16 . as-braces9)
+ (cmr7 . as-dummy)
+ (cmr8 . as-dummy)
+ (cmr10 . as-dummy)
+ ))
+ (as9 .
+ (
+ (feta16 . as9)
+ (feta20 . as9)
+ (feta-nummer4 . as-number1)
+ (feta-nummer8 . as-number4)
+ (feta-braces16 . as-braces9)
+ (cmr7 . as-dummy)
+ (cmr8 . as-dummy)
+ (cmr10 . as-dummy)
+ (cmr12 . as-dummy)
+ ))
+ ))
+
+(define (as-properties-to-font-name size fonts properties-alist-list)
+ (let* ((feta-name (properties-to-font-name fonts properties-alist-list))
+ (as-font-alist (cdr (assoc size as-font-alist-alist)))
+ (font (assoc (string->symbol feta-name) as-font-alist)))
+ (if font (symbol->string (cdr font))
+ (let ((e (current-error-port)))
+ (newline e)
+ (display "can't find font: " e)
+ (write feta-name e)
+ ;;(symbol->string size)
+ "as-dummy"
+ ))))
+
+;; FIXME: making a full style-sheet is a pain, so we parasite on
+;; paper16 and translate the result.
+;;
+(define (as-make-style-sheet size)
+ (let ((sheet (make-style-sheet 'paper16)))
+ (assoc-set! sheet 'properties-to-font
+ (lambda (x y) (as-properties-to-font-name size x y)))
+ sheet))
+
+;;;; AsciiScript as -- ascii art output
(define (as-scm action-name)
(define (beam width slope thick)
(func "rmove-to" (- dx 1) (if (< 0 dir) -1 0))
(func "put" (if (< 0 dir) "\\\\" "/"))))))
- (define (bracket arch_angle arch_width arch_height width height arch_thick thick)
+
+ (define (bracket arch_angle arch_width arch_height height arch_thick thick)
+ ;; width now fixed?
+ (let ((width 1))
(string-append
(func "rmove-to" (+ width 1) (- (/ height -2) 1))
(func "put" "\\\\")
(func "v-line" (+ height 1))
(func "rmove-to" 0 (+ height 1))
(func "put" "/")
- ))
+ )))
(define (char i)
(func "char" i))
(func "h-line" dx))))))
(define (font-load-command name-mag command)
+ ;; (display "name-mag: ")
+ ;; (write name-mag)
+ ;; (display "command: ")
+ ;; (write command)
(func "load-font" (car name-mag) (cdr name-mag)))
(define (header creator generate)
(string-append "(define " key " " (arg->string val) ")\n"))
(define (lily-def key val)
- (if
- (or (equal? key "lilypondpaperlinewidth")
- (equal? key "lilypondpaperstaffheight"))
- (string-append "(define " key " " (arg->string val) ")\n")
- ""))
+ (if
+ ;; let's not have all bloody definitions
+ (or (equal? key "lilypondpaperlinewidth")
+ (equal? key "lilypondpaperstaffheight")
+ (equal? key "lilypondpaperoutputscale"))
+ (string-append "(define " key " " (arg->string val) ")\n")
+ ""))
(define (no-origin) "")
;; (also tried to vary the order of this list, with little effect)
(define paper20-style-sheet-alist
'(
+ ;; why are font-names strings, not symbols?
((3 medium upright number feta-nummer 13) . "feta-nummer13")
((2 medium upright number feta-nummer 13) . "feta-nummer13")
((1 medium upright number feta-nummer 11) . "feta-nummer11")
)
))
+(define (wild-eq? x y)
+ (or (eq? x y)
+ (eq? x '*)
+ (eq? y '*)))
+
(define (font-qualifies? qualifiers font-desc)
"does FONT-DESC satisfy QUALIFIERS?"
(if (null? qualifiers) #t
- (if (eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers))
+ (if (wild-eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers))
(font-qualifies? (cdr qualifiers) font-desc)
- #f
- )
- )
- )
+ #f)))
(define (find-first-font qualifiers fonts)
(if (null? fonts)
(define (chain-assoc x alist-list)
(if (null? alist-list)
#f
- (let* (
- (handle (assoc x (car alist-list)))
- )
+ (let* ((handle (assoc x (car alist-list))))
(if (pair? handle)
handle
- (chain-assoc x (cdr alist-list))
- )
- )
- )
- )
+ (chain-assoc x (cdr alist-list))))))
;; TODO
;; the C++ version in font-interface.cc is usually used.
+;;
+;; FIXME: this has silently been broken by the introduction
+;; of wildcards in the font list.
(define (properties-to-font-name fonts properties-alist-list)
(let* (
;; change order to change priorities of qualifiers.
- (q-order '(font-name font-family font-series font-shape font-design-size font-relative-size))
- (rawqualifiers (map (lambda (x) (chain-assoc x properties-alist-list))
+ (q-order '(font-name font-family font-series font-shape
+ font-design-size font-relative-size))
+ (rawqualifiers (map (lambda (x)
+ (chain-assoc x properties-alist-list))
q-order))
(qualifiers (filter-list pair? rawqualifiers))
- (selected (find-first-font qualifiers fonts))
- (err (current-error-port))
- )
+ (selected (find-first-font qualifiers fonts))
+ (err (current-error-port)))
(if (equal? selected "")
(begin
;;; Un-assorted stuff
-;; URG guile-1.3/1.4 compatibility
+;; URG guile-1.4/1.4.x compatibility
(define (ly-eval x) (eval2 x #f))
(define (sign x)
(if (< x 0) -1 1)))
-;;(define major-scale
-;; '(
-;; (0 . 0)
-;; (1 . 0)
-;; (2 . 0)
-;; (3 . 0)
-;; (4 . 0)
-;; (5 . 0)
-;; (6 . 0)
-;; ))
-
-
(map (lambda (x) (eval-string (ly-gulp-file x)))
'("output-lib.scm"
"tex.scm"
(define first-line #t)
+(define scaling 1)
+
;; cursor
(define cur-x 0)
(define cur-y 0)
(cond ((equal? new " ") old)
(else new)))
-(define (plot x y c)
- (let ((ny (- (* -1 y) 1)))
- (if (array-in-bounds? canvas ny x)
- (array-set! canvas (merge-chars (array-ref canvas ny x) c) ny x)
- (display (string-append "ouch: " (number->string x) ","
- (number->string ny) "\n")))))
+(define (plot-raw x y c)
+ (if (array-in-bounds? canvas y x)
+ (array-set! canvas (merge-chars (array-ref canvas y x) c) y x)
+ (display (string-append "ouch: " (number->string x) ","
+ (number->string y) "\n")
+ (current-error-port))))
+
+(define (plot x neg-y c)
+ (let ((y (- (* -1 neg-y) 1)))
+ (plot-raw (inexact->exact x) (inexact->exact y) c)))
(define (plot-char c)
(let ((bbox (car c))
- (glyph (cadr c)))
- ;; BBox: (llx lly urx ury) * 1000
- (let ((dx (inexact->exact (* .001 (car bbox))))
- ;(dy (inexact->exact (* .001 (cadr bbox))))
- (dy (inexact->exact (- (* .001 (cadddr bbox)) 1)))
- (len (length glyph)))
- ;;(display "Bbox: ") (display bbox) (newline)
- ;;(display "dy: ") (display dy) (newline)
- (do ((line glyph (cdr line))
- (i 0 (+ i 1)))
- ((= i len))
- (plot-string (+ cur-x dx) (+ (- cur-y i) dy) (car line))))))
-
+ (glyph (cadr c))
+ (scur-x (* scaling cur-x))
+ (scur-y (* scaling cur-y)))
+ ;; BBox: (llx lly urx ury) * 1000
+ (let ((dx (inexact->exact (* .001 (car bbox))))
+ ;;(dy (inexact->exact (* .001 (cadr bbox))))
+ (dy (inexact->exact (- (* .001 (cadddr bbox)) 1)))
+ (len (length glyph)))
+ ;;(display "Bbox: ") (display bbox) (newline)
+ ;;(display "dy: ") (display dy) (newline)
+ (do ((line glyph (cdr line))
+ (i 0 (+ i 1)))
+ ((= i len))
+ (plot-string (+ scur-x dx) (+ (- scur-y i) dy) (car line))))))
+
(define (plot-string x y s)
(do ((i 0 (+ i 1)))
((= i (string-length s)))
- (plot (+ x i) y (substring s i (+ i 1)))))
+ (plot (+ x i) y (substring s i (+ i 1)))))
(define (show-char char)
(display char))
(assoc (+ n 0.5) font))
(get-char font (+ n 0.5))
(get-char font n))))
- (if c
+ (if (pair? c)
(plot-char c))))
(define (end-output)
(close cur-output-file)
(set! cur-output-file '()))
+;; use plot-string
(define (h-line len)
- (let ((step (sign len)))
- (do ((i 0 (+ i step)))
- ((= i len))
- (plot (+ cur-x i) cur-y line-char))))
+ (let ((scur-x (* scaling cur-x))
+ (scur-y (* scaling cur-y))
+ (slen (* scaling len)))
+ (let ((step (sign len)))
+ (do ((i 0 (+ i step)))
+ ((= i slen))
+ (plot (+ scur-x i) scur-y line-char)))))
(define (v-line len)
- (let ((step (sign len)))
- (do ((i 0 (+ i step)))
- ((= i len)) (plot cur-x (+ cur-y i) line-char))))
+ (let ((scur-x (* scaling cur-x))
+ (scur-y (* scaling cur-y))
+ (slen (* scaling len)))
+ (let ((step (sign len)))
+ (do ((i 0 (+ i step)))
+ ((= i len))
+ (plot scur-x (+ scur-y i) line-char)))))
(define (header x y)
;(display (string-append x y "\n") (current-error-port))
(define (header-end) "")
+;; FIXME: scale
(define (rline-to dx dy)
(plot (inexact->exact cur-x) (inexact->exact cur-y) line-char)
(plot (inexact->exact (+ cur-x dx)) (inexact->exact (+ cur-y dy)) line-char)
(begin
(set! fonts (cons (cons "default" (generate-default-font)) fonts))
(display "\n" (current-error-port))
- (if (and (defined? 'lilypondpaperlinewidth)
- (> (string->number lilypondpaperlinewidth) 0))
- (set! canvas-width
- (inexact->exact (string->number lilypondpaperlinewidth))))))
- (set! canvas-height height)
+ (if (defined? 'lilypondpaperoutputscale)
+ (set! scaling (inexact->exact (string->number lilypondpaperoutputscale))))
+ (if (defined? 'lilypondpaperlinewidth)
+ (let ((width (inexact->exact
+ (string->number lilypondpaperlinewidth))))
+ (if (> width 0)
+ (set! canvas-width width)
+ ;; need long line...
+ ;;(set! canvas-width 200)
+ (set! canvas-width 80)
+ )))
+ ))
+ (set! canvas-height (inexact->exact (* scaling height)))
(set! canvas (make-array " " canvas-height canvas-width)))
(define (stop-line)
((= i n))
(let* ((n (char->integer (string-ref s i)))
(c (get-char font n)))
- (plot-char c)
+ (if (pair? c) (plot-char c))
(rmove-to (char-width c) 0)))))
projects / lilypond.git / commitdiff