scm/framework-socket.scm

   1 ;;;; framework-socket.scm
   2
   3 (define-module (scm framework-socket)
   4   #:export (output-framework)
   5   )
   6
   7 (use-modules (ice-9 regex)
   8              (ice-9 string-fun)
   9              (scm paper-system)
  10              (ice-9 format)
  11              (guile)
  12              (srfi srfi-1)
  13              (ice-9 pretty-print)
  14              (srfi srfi-13)
  15              (lily))
  16
  17 (define (get-page-dimensions paper)
  18   (let* ((landscape (ly:output-def-lookup paper 'landscape))
  19          (output-scale (ly:output-def-lookup paper 'output-scale))
  20          (paper-width (ly:output-def-lookup paper 'paper-width))
  21          (paper-height (ly:output-def-lookup paper 'paper-height))
  22          (indent (ly:output-def-lookup paper 'indent))
  23          (line-width (ly:output-def-lookup paper 'line-width))
  24          (plain-left-margin (ly:output-def-lookup paper 'left-margin))
  25          (top-margin (ly:output-def-lookup paper 'top-margin))
  26          (w (if landscape paper-height paper-width))
  27          (h (if landscape paper-width paper-height))
  28          (left-margin (if (null? plain-left-margin)
  29                           (/ (- w line-width) 2)
  30                           plain-left-margin))
  31          ;;      (list w h left-margin top-margin indent line-width)))
  32          ;;      (convert (lambda (x) (* x output-scale (/ (ly:bp 1))))))
  33          (unit-length (ly:output-def-lookup paper 'output-scale))
  34          (convert (lambda (x) (* x lily-unit->mm-factor unit-length))))
  35     (map convert (list w h left-margin top-margin indent line-width))))
  36
  37 (define-public (output-framework channel book scopes fields)
  38   (let* ((ctor-arg (if (string? channel)
  39                        (open-output-file (format #f "~a.socket" channel))
  40                        channel))
  41          (outputter (ly:make-paper-outputter
  42                      ctor-arg
  43                      'socket))
  44          (systems (ly:paper-book-systems book))
  45          (paper (ly:paper-book-paper book))
  46          (pages (ly:paper-book-pages book)))
  47     (for-each (lambda (x)
  48                 (let* ((system-stencil (paper-system-stencil x))
  49                        (x-extent (ly:stencil-extent system-stencil X))
  50                        (y-extent (ly:stencil-extent system-stencil Y)))
  51                   (display (ly:format "system ~4l ~4l ~4l ~4l\n"
  52                                       (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg)
  53                   (ly:outputter-dump-stencil outputter system-stencil)))
  54               systems)))
  55
  56 (define-public (output-classic-framework channel book scopes fields)
  57   (let* ((ctor-arg (if (string? channel)
  58                        (open-output-file (format #f "~a.socket" channel))
  59                        channel))
  60          (outputter (ly:make-paper-outputter
  61                      ctor-arg
  62                      'socket))
  63          (systems (ly:paper-book-systems book))
  64          (paper (ly:paper-book-paper book)))
  65     (display (ly:format "paper ~4l\n" (get-page-dimensions paper)) ctor-arg)
  66     (for-each (lambda (x)
  67                 (let* ((system-stencil (paper-system-stencil x))
  68                        (x-extent (ly:stencil-extent system-stencil X))
  69                        (y-extent (ly:stencil-extent system-stencil Y)))
  70                   (display (ly:format "system ~4l ~4l ~4l ~4l\n"
  71                                       (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg)
  72                   (ly:outputter-dump-stencil outputter system-stencil)))
  73               systems)))
  74
  75 (define-public (convert-to-ps . args) #t)
  76 (define-public (convert-to-pdf . args) #t)
  77 (define-public (convert-to-png . args) #t)