LEFT | RIGHT |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 2002--2012 Jan Nieuwenhuizen <janneke@gnu.org> | 3 ;;;; Copyright (C) 2002--2012 Jan Nieuwenhuizen <janneke@gnu.org> |
4 ;;;; Patrick McCarty <pnorcks@gmail.com> | 4 ;;;; Patrick McCarty <pnorcks@gmail.com> |
5 ;;;; | 5 ;;;; |
6 ;;;; LilyPond is free software: you can redistribute it and/or modify | 6 ;;;; LilyPond is free software: you can redistribute it and/or modify |
7 ;;;; it under the terms of the GNU General Public License as published by | 7 ;;;; it under the terms of the GNU General Public License as published by |
8 ;;;; the Free Software Foundation, either version 3 of the License, or | 8 ;;;; the Free Software Foundation, either version 3 of the License, or |
9 ;;;; (at your option) any later version. | 9 ;;;; (at your option) any later version. |
10 ;;;; | 10 ;;;; |
(...skipping 310 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
321 font-smob-to-path woff-font-smob-to-text)) | 321 font-smob-to-path woff-font-smob-to-text)) |
322 | 322 |
323 (define (fontify font expr) | 323 (define (fontify font expr) |
324 (if (string? font) | 324 (if (string? font) |
325 (pango-description-to-text font expr) | 325 (pango-description-to-text font expr) |
326 (font-smob-to-text font expr))) | 326 (font-smob-to-text font expr))) |
327 | 327 |
328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 328 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
329 ;;; stencil outputters | 329 ;;; stencil outputters |
330 ;;; | 330 ;;; |
331 | |
332 (define (bezier-sandwich lst thick) | |
333 (let* ((first (list-tail lst 4)) | |
334 (second (list-head lst 4))) | |
335 (entity 'path "" | |
336 '(stroke-linejoin . "round") | |
337 '(stroke-linecap . "round") | |
338 '(stroke . "currentColor") | |
339 '(fill . "currentColor") | |
340 `(stroke-width . ,thick) | |
341 `(d . ,(string-append (svg-bezier first #f) | |
342 (svg-bezier second #t)))))) | |
343 | 331 |
344 (define (char font i) | 332 (define (char font i) |
345 (dispatch | 333 (dispatch |
346 `(fontify ,font ,(entity 'tspan (char->entity (integer->char i)))))) | 334 `(fontify ,font ,(entity 'tspan (char->entity (integer->char i)))))) |
347 | 335 |
348 (define (circle radius thick is-filled) | 336 (define (circle radius thick is-filled) |
349 (entity | 337 (entity |
350 'circle "" | 338 'circle "" |
351 '(stroke-linejoin . "round") | 339 '(stroke-linejoin . "round") |
352 '(stroke-linecap . "round") | 340 '(stroke-linecap . "round") |
(...skipping 80 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
433 (- (* end-radius (sin new-end-angle)))) | 421 (- (* end-radius (sin new-end-angle)))) |
434 (if connect | 422 (if connect |
435 (ly:format "L~4f,~4f" | 423 (ly:format "L~4f,~4f" |
436 (* start-radius (cos new-start-angle)) | 424 (* start-radius (cos new-start-angle)) |
437 (- (* start-radius (sin new-start-angle)))) | 425 (- (* start-radius (sin new-start-angle)))) |
438 ""))))))) | 426 ""))))))) |
439 | 427 |
440 (define (embedded-svg string) | 428 (define (embedded-svg string) |
441 string) | 429 string) |
442 | 430 |
443 (define (embedded-glyph-string font size cid glyphs) | 431 (define (embedded-glyph-string pango-font font size cid glyphs) |
444 (define path "") | 432 (define path "") |
445 (if (= 1 (length glyphs)) | 433 (if (= 1 (length glyphs)) |
446 (set! path (music-string-to-path font size (car glyphs))) | 434 (set! path (music-string-to-path font size (car glyphs))) |
447 (begin | 435 (begin |
448 (set! path | 436 (set! path |
449 (string-append (eo 'g) | 437 (string-append (eo 'g) |
450 (string-join | 438 (string-join |
451 (map (lambda (x) | 439 (map (lambda (x) |
452 (music-string-to-path font size x)) | 440 (music-string-to-path font size x)) |
453 glyphs) | 441 glyphs) |
454 "\n") | 442 "\n") |
455 (ec 'g))))) | 443 (ec 'g))))) |
456 (set! next-horiz-adv 0.0) | 444 (set! next-horiz-adv 0.0) |
457 path) | 445 path) |
458 | 446 |
459 (define (woff-glyph-string font-name size cid? w-h-x-y-named-glyphs) | 447 (define (woff-glyph-string pango-font font-name size cid? w-h-x-y-named-glyphs) |
460 (let* ((name-style (font-name-style font-name)) | 448 (let* ((name-style (font-name-style font-name)) |
461 (family-designsize (regexp-exec (make-regexp "(.*)-([0-9]*)") | 449 (family-designsize (regexp-exec (make-regexp "(.*)-([0-9]*)") |
462 font-name)) | 450 font-name)) |
463 (family (if (regexp-match? family-designsize) | 451 (family (if (regexp-match? family-designsize) |
464 (match:substring family-designsize 1) | 452 (match:substring family-designsize 1) |
465 font-name)) | 453 font-name)) |
466 (design-size (if (regexp-match? family-designsize) | 454 (design-size (if (regexp-match? family-designsize) |
467 (match:substring family-designsize 2) | 455 (match:substring family-designsize 2) |
468 #f)) | 456 #f)) |
469 (scaled-size (/ size lily-unit-length)) | 457 (scaled-size (/ size lily-unit-length)) |
(...skipping 26 matching lines...) Expand all Loading... |
496 | 484 |
497 (define (grob-cause offset grob) | 485 (define (grob-cause offset grob) |
498 "") | 486 "") |
499 | 487 |
500 (define (named-glyph font name) | 488 (define (named-glyph font name) |
501 (dispatch `(fontify ,font ,name))) | 489 (dispatch `(fontify ,font ,name))) |
502 | 490 |
503 (define (no-origin) | 491 (define (no-origin) |
504 "") | 492 "") |
505 | 493 |
506 (define (oval x-radius y-radius thick is-filled) | |
507 (let ((x-max x-radius) | |
508 (x-min (- x-radius)) | |
509 (y-max y-radius) | |
510 (y-min (- y-radius))) | |
511 (entity | |
512 'path "" | |
513 '(stroke-linejoin . "round") | |
514 '(stroke-linecap . "round") | |
515 `(fill . ,(if is-filled "currentColor" "none")) | |
516 `(stroke . "currentColor") | |
517 `(stroke-width . ,thick) | |
518 `(d . ,(ly:format "M~4f ~4fC~4f ~4f ~4f ~4f ~4f ~4fS~4f ~4f ~4f ~4fz" | |
519 x-max 0 | |
520 x-max y-max | |
521 x-min y-max | |
522 x-min 0 | |
523 x-max y-min | |
524 x-max 0))))) | |
525 | |
526 (define* (path thick commands #:optional (cap 'round) (join 'round) (fill? #f)) | 494 (define* (path thick commands #:optional (cap 'round) (join 'round) (fill? #f)) |
527 (define (convert-path-exps exps) | 495 (define (convert-path-exps exps) |
528 (if (pair? exps) | 496 (if (pair? exps) |
529 (let* | 497 (let* |
530 ((head (car exps)) | 498 ((head (car exps)) |
531 (rest (cdr exps)) | 499 (rest (cdr exps)) |
532 (arity | 500 (arity |
533 (cond ((memq head '(rmoveto rlineto lineto moveto)) 2) | 501 (cond ((memq head '(rmoveto rlineto lineto moveto)) 2) |
534 ((memq head '(rcurveto curveto)) 6) | 502 ((memq head '(rcurveto curveto)) 6) |
535 ((eq? head 'closepath) 0) | 503 ((eq? head 'closepath) 0) |
(...skipping 61 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
597 (entity | 565 (entity |
598 'polygon "" | 566 'polygon "" |
599 '(stroke-linejoin . "round") | 567 '(stroke-linejoin . "round") |
600 '(stroke-linecap . "round") | 568 '(stroke-linecap . "round") |
601 `(stroke-width . ,blot-diameter) | 569 `(stroke-width . ,blot-diameter) |
602 `(fill . ,(if is-filled "currentColor" "none")) | 570 `(fill . ,(if is-filled "currentColor" "none")) |
603 '(stroke . "currentColor") | 571 '(stroke . "currentColor") |
604 `(points . ,(string-join | 572 `(points . ,(string-join |
605 (map offset->point (ly:list->offsets '() coords)))))) | 573 (map offset->point (ly:list->offsets '() coords)))))) |
606 | 574 |
607 (define (repeat-slash width slope thickness) | |
608 (define (euclidean-length x y) | |
609 (sqrt (+ (* x x) (* y y)))) | |
610 (let* ((x-width (euclidean-length thickness (/ thickness slope))) | |
611 (height (* width slope))) | |
612 (entity | |
613 'path "" | |
614 '(fill . "currentColor") | |
615 `(d . ,(ly:format "M0 0l~4f 0 ~4f ~4f ~4f 0z" | |
616 x-width width (- height) (- x-width)))))) | |
617 | |
618 (define (resetcolor) | 575 (define (resetcolor) |
619 "</g>\n") | 576 "</g>\n") |
620 | 577 |
621 (define (resetrotation ang x y) | 578 (define (resetrotation ang x y) |
622 "</g>\n") | 579 "</g>\n") |
623 | 580 |
624 (define (resetscale) | 581 (define (resetscale) |
625 "</g>\n") | 582 "</g>\n") |
626 | 583 |
627 (define (round-filled-box breapth width depth height blot-diameter) | 584 (define (round-filled-box breapth width depth height blot-diameter) |
(...skipping 42 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
670 '(stroke . "none") | 627 '(stroke . "none") |
671 '(stroke-width . "0.0")) | 628 '(stroke-width . "0.0")) |
672 (ec 'a))) | 629 (ec 'a))) |
673 | 630 |
674 (define (utf-8-string pango-font-description string) | 631 (define (utf-8-string pango-font-description string) |
675 (let ((escaped-string (string-regexp-substitute | 632 (let ((escaped-string (string-regexp-substitute |
676 "<" "<" | 633 "<" "<" |
677 (string-regexp-substitute "&" "&" string)))) | 634 (string-regexp-substitute "&" "&" string)))) |
678 (dispatch `(fontify ,pango-font-description | 635 (dispatch `(fontify ,pango-font-description |
679 ,(entity 'tspan escaped-string))))) | 636 ,(entity 'tspan escaped-string))))) |
LEFT | RIGHT |