X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-socket.scm;h=083d5a081be223493612e8be276aa4f366de2664;hb=38c30df0ef4153793a253adcd8e9eb93926da82d;hp=f55cf93bf9238500ad8be4ba60e8dc600c20e27c;hpb=4e510ab3b12fc000637638b42ed4ee548fae5694;p=lilypond.git diff --git a/scm/output-socket.scm b/scm/output-socket.scm index f55cf93bf9..083d5a081b 100644 --- a/scm/output-socket.scm +++ b/scm/output-socket.scm @@ -11,6 +11,7 @@ (define (dummy . rest) "") +(display (ly:all-stencil-expressions)) (for-each (lambda (x) (module-define! (current-module) @@ -48,13 +49,12 @@ breapth width depth height blot-diameter )) -(define (music-cause grob) +(define (event-cause grob) (let* ((cause (ly:grob-property grob 'cause))) (cond - ((ly:music? cause) cause) - ((ly:grob? cause) (music-cause cause)) + ((ly:stream-event? cause) cause) (else #f)))) @@ -63,26 +63,28 @@ ((x-ext (ly:grob-extent grob grob X)) (y-ext (ly:grob-extent grob grob Y)) (x (car offset)) - (y (cdr offset)) - ) + (y (cdr offset))) + + (if (interval-empty? x-ext) + (set! x-ext '(0 . 0))) - (map (lambda (x) - (if (inf? x) 0.0 x)) - - (list (+ x (car x-ext)) - (+ y (car y-ext)) - (+ x (cdr x-ext)) - (+ y (cdr y-ext))) - ))) + (if (interval-empty? y-ext) + (set! y-ext '(0 . 0))) + + (list (+ x (car x-ext)) + (+ y (car y-ext)) + (+ x (cdr x-ext)) + (+ y (cdr y-ext)) + ))) (define-public (no-origin) "nocause\n") (define-public (grob-cause offset grob) (let* - ((cause (music-cause grob)) - (tag (if (and cause (integer? (ly:music-property cause 'input-tag))) - (ly:music-property cause 'input-tag) + ((cause (event-cause grob)) + (tag (if (and cause (integer? (ly:event-property cause 'input-tag))) + (ly:event-property cause 'input-tag) -1)) (name (cdr (assoc 'name (ly:grob-property grob 'meta)))) ) @@ -95,12 +97,28 @@ ))) +(define (escape-string str) + (string-regexp-substitute + " " "\\040" + (string-regexp-substitute "\"" "\\\"" str))) + (define-public (utf-8-string descr string) - (format "utf-8 \"~a\" \"~a\"" descr + (format "utf-8 \"~a\" \"~a\"" + (escape-string descr) ;; don't want unescaped spaces. - (string-regexp-substitute " " "\\040" string))) + (escape-string string) + )) + +(define (bezier-sandwich lst thick) + (format + #f + "bezier_sandwich ~a [~a]" + thick + (string-append + (string-join (map (lambda (x) (format "(~a,~a)" (car x) (cdr x))) + lst) ","))))