+
;;; sketch.scm -- implement Scheme output routines for Sketch
;;;
;;; source file of the GNU LilyPond music typesetter
;; ))
+;;
+;; All functions have the signature
+;;
+;; NAME X Y ARGUMENTS-PASSED-BY-LILYPOND
+;;
+
+;; guile <= 1.4.x compatibility for eval
+(if (or (equal? (minor-version) "4.1")
+ (equal? (minor-version) "4")
+ (equal? (minor-version) "3.4"))
+ (define (ly-eval e m)
+ (eval-in-module e m))
+ (define (ly-eval e m)
+ (eval e m)))
-(define-module (scm sketch)
- :export (sketch-output-expression)
- :no-backtrace)
+(define-module (scm sketch))
+(debug-enable 'backtrace)
(define this-module (current-module))
-(define (sketch-output-expression expr port)
+(define-public (sketch-output-expression expr port)
(display (dispatch expr) port))
(use-modules
- (guile)
- (guile-user))
+ (guile))
(use-modules (ice-9 format))
((eq? keyword 'placebox)
(dispatch-x-y (cadr expr) (+ 150 (caddr expr)) (cadddr expr)))
(else
- (apply (eval keyword this-module) (cdr expr))))))
+ (apply (ly-eval keyword this-module) (cdr expr))))))
(define (dispatch-x-y x y expr)
- (apply (eval (car expr) this-module) (append (list x y) (cdr expr))))
-
-
-
+ (apply (ly-eval (car expr) this-module) (append (list x y) (cdr expr))))
(define (ascii->string i) (make-string 1 (integer->char i)))
(sketch-numbers->string (map mul-scale (list width dy dx height x y)))
")\n"))
+
+(define (roundfilledbox x y dx dy w h b)
+ (filled-rectangle w 0 0 h x y))
+
(define (sketch-bezier x y l)
(let* ((c0 (car (list-tail l 3)))
(c123 (list-head l 3))
"bc(" (sketch-numbers->string (map mul-scale control)) ",2)\n")))
+
(define (sketch-beziers x y l thick)
(let* ((first (list-tail l 4))
(second (list-head l 4)))
(define (fontify x y name-mag-pair exp)
(string-append (select-font name-mag-pair)
- (apply (eval (car exp) this-module)
+ (apply (ly-eval (car exp) this-module)
(append (list x y) (cdr exp)))))
;; (if (string? exp) exp "")))
(sketch-numbers->string (map mul-scale (list x y)))
"))\n"))
-(define (hairpin x y thick width starth endh )
- (string-append
- "#"
- (numbers->string (list width starth endh thick))
- " draw_hairpin"))
;; what the heck is this interface ?
(define (dashed-slur thick dash l)
(define (invoke-char s i)
"")
-(define (invoke-dim1 s d)
- (string-append
- (ly-number->string (* d (/ 72.27 72))) " " s ))
+;; TODO: bezier-ending, see ps.scm
+(define (bezier-bow x y l thick)
+ (bezier-sandwich x y l thick))
(define (bezier-sandwich x y l thick)
(apply
sketch-beziers (list x y (primitive-eval l) thick)))
; TODO: use HEIGHT argument
-(define (start-line height)
+(define (start-system height)
"G()\n"
)
(define (stem x y z w) (filledbox x y z w))
-(define (stop-line)
+(define (stop-system)
"G_()\n")
;; huh?
-(define (stop-last-line)
- (stop-line))
+(define (stop-last-system)
+ (stop-system))
(define (text x y s)
(string-append "txt('" s "',(" (sketch-numbers->string
(map mul-scale (list x y))) "))\n"))
-(define (volta x y h w thick vert_start vert_end)
- (string-append "#"
- (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end)))
- " draw_volta"))
-
-(define (tuplet x y ht gap dx dy thick dir)
- (string-append "#"
- (numbers->string (list ht gap dx dy thick (inexact->exact dir)))
- " draw_tuplet"))
-
-
(define (unknown)
"\n unknown\n")