X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-socket.scm;h=3532fc97325728e0e843ccbd5667d429083ee14a;hb=HEAD;hp=28e22f72a3c3ba3733d290b443e8b1a47d804a91;hpb=54b02666750062788185bd3f99e644d621e348c2;p=lilypond.git diff --git a/scm/output-socket.scm b/scm/output-socket.scm index 28e22f72a3..3532fc9732 100644 --- a/scm/output-socket.scm +++ b/scm/output-socket.scm @@ -6,80 +6,70 @@ #:re-export (quote)) (use-modules (guile) - (srfi srfi-1) - (srfi srfi-13) - (lily)) + (srfi srfi-1) + (srfi srfi-13) + (lily)) (define format ergonomic-simple-format) (define (event-cause grob) (let* - ((cause (ly:grob-property grob 'cause))) + ((cause (ly:grob-property grob 'cause))) (if (ly:stream-event? cause) - cause - #f))) + cause + #f))) (define (grob-bbox grob offset) (let* - ((x-ext (ly:grob-extent grob grob X)) - (y-ext (ly:grob-extent grob grob Y)) - (x (car offset)) - (y (cdr offset))) + ((x-ext (ly:grob-extent grob grob X)) + (y-ext (ly:grob-extent grob grob Y)) + (x (car offset)) + (y (cdr offset))) (if (interval-empty? x-ext) - (set! x-ext '(0 . 0))) + (set! x-ext '(0 . 0))) (if (interval-empty? y-ext) - (set! y-ext '(0 . 0))) + (set! y-ext '(0 . 0))) (list (+ x (car x-ext)) - (+ y (car y-ext)) - (+ x (cdr x-ext)) - (+ y (cdr y-ext))))) + (+ y (car y-ext)) + (+ x (cdr x-ext)) + (+ y (cdr y-ext))))) (define (escape-string str) (string-regexp-substitute - " " "\\040" - (string-regexp-substitute "\"" "\\\"" str))) + " " "\\040" + (string-regexp-substitute "\"" "\\\"" str))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; stencil commands ;;; -(define (bezier-sandwich lst thick) - (format #f "bezier_sandwich ~a [~a]" - thick - (string-append - (string-join (map - (lambda (x) - (format #f "(~a,~a)" (car x) (cdr x))) - lst) - ",")))) - (define (draw-line thick x1 y1 x2 y2) (format #f "drawline ~a ~a ~a ~a ~a" - thick x1 y2 x2 y2)) + thick x1 y2 x2 y2)) (define (grob-cause offset grob) (let* - ((cause (event-cause grob)) - (tag (if (and cause (integer? (ly:event-property cause 'input-tag))) - (ly:event-property cause 'input-tag) - -1)) - (name (assoc-get 'name (ly:grob-property grob 'meta)))) + ((cause (event-cause grob)) + (tag (if (and cause (integer? (ly:event-property cause 'input-tag))) + (ly:event-property cause 'input-tag) + -1)) + (name (assoc-get 'name (ly:grob-property grob 'meta)))) (apply format #f - "cause ~a \"~a\" ~a ~a ~a ~a\n" tag name - (grob-bbox grob offset)))) + "cause ~a \"~a\" ~a ~a ~a ~a\n" tag name + (grob-bbox grob offset)))) (define (named-glyph font glyph) (format #f "glyphshow ~a \"~a\" ~a \"~a\"" - (ly:font-glyph-name-to-charcode font glyph) - (ly:font-name font) - (modified-font-metric-font-scaling font) - glyph)) + (ly:font-glyph-name-to-charcode font glyph) + (ly:font-name font) + (modified-font-metric-font-scaling font) + glyph)) (define (no-origin) "nocause\n") @@ -91,16 +81,16 @@ (define (polygon xy-coords blot do-fill) (format #f "polygon ~a ~a ~a" - blot - (if do-fill "True" "False") - (string-join (map number->string xy-coords)))) + blot + (if do-fill "True" "False") + (string-join (map number->string xy-coords)))) (define (round-filled-box breapth width depth height blot-diameter) (format #f "draw_round_box ~a ~a ~a ~a ~a" - breapth width depth height blot-diameter)) + breapth width depth height blot-diameter)) (define (utf-8-string descr string) (format #f "utf-8 \"~a\" \"~a\"" - (escape-string descr) - ;; don't want unescaped spaces. - (escape-string string))) + (escape-string descr) + ;; don't want unescaped spaces. + (escape-string string)))