X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fframework-socket.scm;h=3eaf4710d1873bd38ab877897720cad06398fb5b;hb=a6a51abfd0195a3cf7d6ea095cf69808852f21ce;hp=ab612e59aa4e52c3c3d617f464e8bb183688dcbe;hpb=794dcbdb52faf4292036cd1b0270a956cf4316a3;p=lilypond.git diff --git a/scm/framework-socket.scm b/scm/framework-socket.scm index ab612e59aa..3eaf4710d1 100644 --- a/scm/framework-socket.scm +++ b/scm/framework-socket.scm @@ -5,32 +5,72 @@ ) (use-modules (ice-9 regex) - (ice-9 string-fun) - (scm paper-system) - (ice-9 format) - (guile) - (srfi srfi-1) - (ice-9 pretty-print) - (srfi srfi-13) - (lily)) + (ice-9 string-fun) + (scm paper-system) + (ice-9 format) + (guile) + (srfi srfi-1) + (ice-9 pretty-print) + (srfi srfi-13) + (lily)) -(define-public (output-framework channel book scopes fields ) - (let* - ((ctor-arg (if (string? channel) - (open-output-file (format "~a.socket" channel)) - channel)) - (outputter (ly:make-paper-outputter - ctor-arg - 'socket)) - (systems (ly:paper-book-systems book))) +(define (get-page-dimensions paper) + (let* ((landscape (ly:output-def-lookup paper 'landscape)) + (output-scale (ly:output-def-lookup paper 'output-scale)) + (paper-width (ly:output-def-lookup paper 'paper-width)) + (paper-height (ly:output-def-lookup paper 'paper-height)) + (indent (ly:output-def-lookup paper 'indent)) + (line-width (ly:output-def-lookup paper 'line-width)) + (plain-left-margin (ly:output-def-lookup paper 'left-margin)) + (top-margin (ly:output-def-lookup paper 'top-margin)) + (w (if landscape paper-height paper-width)) + (h (if landscape paper-width paper-height)) + (left-margin (if (null? plain-left-margin) + (/ (- w line-width) 2) + plain-left-margin)) + ;; (list w h left-margin top-margin indent line-width))) + ;; (convert (lambda (x) (* x output-scale (/ (ly:bp 1)))))) + (unit-length (ly:output-def-lookup paper 'output-scale)) + (convert (lambda (x) (* x lily-unit->mm-factor unit-length)))) + (map convert (list w h left-margin top-margin indent line-width)))) - (if (pair? systems) - (ly:outputter-dump-stencil outputter - (paper-system-stencil (car systems)))) - )) - -(define-public output-classic-framework output-framework) +(define-public (output-framework channel book scopes fields) + (let* ((ctor-arg (if (string? channel) + (open-output-file (format #f "~a.socket" channel)) + channel)) + (outputter (ly:make-paper-outputter + ctor-arg + 'socket)) + (systems (ly:paper-book-systems book)) + (paper (ly:paper-book-paper book)) + (pages (ly:paper-book-pages book))) + (for-each (lambda (x) + (let* ((system-stencil (paper-system-stencil x)) + (x-extent (ly:stencil-extent system-stencil X)) + (y-extent (ly:stencil-extent system-stencil Y))) + (display (ly:format "system ~4l ~4l ~4l ~4l\n" + (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg) + (ly:outputter-dump-stencil outputter system-stencil))) + systems))) +(define-public (output-classic-framework channel book scopes fields) + (let* ((ctor-arg (if (string? channel) + (open-output-file (format #f "~a.socket" channel)) + channel)) + (outputter (ly:make-paper-outputter + ctor-arg + 'socket)) + (systems (ly:paper-book-systems book)) + (paper (ly:paper-book-paper book))) + (display (ly:format "paper ~4l\n" (get-page-dimensions paper)) ctor-arg) + (for-each (lambda (x) + (let* ((system-stencil (paper-system-stencil x)) + (x-extent (ly:stencil-extent system-stencil X)) + (y-extent (ly:stencil-extent system-stencil Y))) + (display (ly:format "system ~4l ~4l ~4l ~4l\n" + (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg) + (ly:outputter-dump-stencil outputter system-stencil))) + systems))) (define-public (convert-to-ps . args) #t) (define-public (convert-to-pdf . args) #t)