scm/molecule.scm

   1
   2 (define (stack-molecules axis dir padding mols)
   3   "Stack molecules MOLS in direction AXIS,DIR, using PADDING."
   4   (if (null? mols)
   5       '()
   6       (if (pair? mols)
   7           (ly-combine-molecule-at-edge (car mols) axis dir
   8                                        (stack-molecules axis dir padding (cdr mols))
   9                                        padding
  10                                        )
  11           )
  12   ))
  13
  14
  15
  16
  17 (define (fontify-text font-metric text)
  18   "Set TEXT with font FONT-METRIC, returning a molecule."
  19   (let* ((b  (ly-text-dimension font-metric text)))
  20     (ly-make-molecule
  21      (ly-fontify-atom font-metric `(text ,text)) (car b) (cdr b))
  22     ))
  23
  24 (define (other-axis a)
  25   (remainder (+ a 1) 2))
  26
  27 (define (bracketify-molecule mol axis thick protusion padding)
  28   "Add brackets around MOL, producing a new molecule."
  29
  30   (let* (
  31          (ext (ly-get-molecule-extent mol axis))
  32          (lb (ly-bracket axis ext -1 thick protusion))
  33          (rb (ly-bracket axis ext 1 thick protusion))
  34          )
  35     (set! mol (ly-combine-molecule-at-edge mol (other-axis  axis) 1 lb padding))
  36     (set! mol (ly-combine-molecule-at-edge mol (other-axis  axis) -1 rb padding))
  37     mol
  38   ))
  39
  40
  41
  42 (define (box-molecule xext yext)
  43   "Make a filled box."
  44
  45   (ly-make-molecule
  46       (list 'filledbox (- (car xext)) (cdr xext)
  47                        (- (car yext)) (cdr yext))
  48       xext yext)
  49 )
  50
  51 (define (widen-interval iv amount)
  52    (cons (- (car iv) amount)
  53          (+ (cdr iv) amount))
  54 )
  55
  56
  57 (define (box-grob-molecule grob)
  58   "Make a box of exactly the extents of the grob.  The box precisely
  59 encloses the contents.
  60 "
  61   (let* ((xext (ly-get-extent grob grob 0))
  62          (yext (ly-get-extent grob grob 1))
  63          (mol (ly-make-molecule '() '(10000 . -10000) '(10000 . -10000)))
  64          (thick 0.1)
  65          )
  66
  67     (set! mol (ly-add-molecule mol (box-molecule xext (cons (- (car yext) thick) (car yext) ))))
  68     (set! mol (ly-add-molecule mol (box-molecule xext (cons  (cdr yext) (+ (cdr yext) thick) ))))
  69     (set! mol (ly-add-molecule mol (box-molecule (cons (cdr xext) (+ (cdr xext) thick)) yext)))
  70     (set! mol (ly-add-molecule mol (box-molecule (cons (- (car xext) thick) (car xext)) yext)))
  71     mol
  72   ))