;;; outside of LilyPond
;;; - lilylib.
;;; * Release schedule and packaging of dependencies. This hack
-;;; depends on several CVS and TLA development sources.
+;;; depends on several CVS and TLA development sources. In the works.
+;;; * Maybe we need to have a unicode mapping somehow, we could
+;;; - use OpenType instead of Type1
+;;; http://lists.gnu.org/archive/html/lilypond-devel/2004-05/msg00098.html
+;;; - or fix the pangofc-afm-decoder and add it to Pango (no chance?)
+;;; or have fontconfig read AFM files
+;;; http://lists.gnu.org/archive/html/lilypond-devel/2004-05/msg00103.html
;;; You need:
;;;
-;;; * Rotty's g-wrap >= 1.9.1 (or TLA)
-;;; * guile-gnome-platform >= 2.5.992 (or TLA)
-;;; * pango >= 1.5.2 (or CVS)
+;;; * Rotty's g-wrap >= 1.9.3 (or TLA)
+;;; * guile-gnome-platform >= 2.7.95 (or TLA)
+;;; * pango >= 1.6.0
;;;
;;; See also: guile-gtk-general@gnu.org
(ice-9 regex)
(srfi srfi-13)
(lily)
- (gnome gtk))
-
-
-;; The name of the module will change to `canvas' rsn
-(if (resolve-module '(gnome gw canvas))
- (use-modules (gnome gw canvas))
- (use-modules (gnome gw libgnomecanvas)))
-
+ (gnome gtk)
+ (gnome gw canvas))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Wrappers from guile-gnome TLA
(force-output (current-error-port)))
(define (debugf string . rest)
- (if #f
+ (if #t
(apply stderr (cons string rest))))
(define (utf8 i)
(+ #x80 (modulo y #x40))))))
(else FIXME)))
-(define (custom-utf8 i)
- (if (< i #x80)
- (utf8 i)
- (utf8 (+ #xee00 i))))
-
-(define (string->utf8-string string)
- (list->string
- (apply append (map utf8 (map char->integer (string->list string))))))
-
-(define (char->utf8-string char)
- (list->string (utf8 (char->integer char))))
+(define (char->utf8-string font char)
+ (list->string (utf8 (char->unicode-index font char))))
+
+(define (string->utf8-string font string)
+ (apply
+ string-append
+ (map (lambda (x) (char->utf8-string font x)) (string->list string))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; stencil outputters
(set-path-def props def)
props))
-
;; two beziers
(define (bezier-sandwich lst thick)
(let* ((def (make <gnome-canvas-path-def>))
(define (placebox x y expr)
(debugf "item: ~S\n" expr)
+ (debugf "x,y: ~S,~S\n" x y)
+ ;; symbols enter visual
+ (set! x 10)
+ ;;(set! y -10)
+ ;;(set! y (/ y 10))
(let ((item expr))
;;(if item
;; FIXME ugly hack to skip #unspecified ...
(lineto def tx (- ty))
(set-path-def props def)
props))
-
(define (list->offsets accum coords)
(if (null? coords)
accum
(cons (cons (car coords) (cadr coords))
- (list->offsets accum (cddr coords))
- )))
+ (list->offsets accum (cddr coords)))))
+
+(define (named-glyph font name)
+ (debugf "glyph:~S\n" name)
+ (debugf "index:~S\n" (ly:font-get-glyph-index font name))
+ (text font (integer->char (ly:font-get-glyph-index font name))))
(define (polygon coords blotdiameter)
(let*
#:width-units blot-diameter
#:join-style 'round)))
-(define (text font string)
+(define (text font s)
(define (pango-font-name font)
- (let ((name (ly:font-name font)))
- (if name
- (regexp-substitute/global #f "^GNU-(.*)-[.0-9]*$" name 'pre 1 'post)
- (begin
- (stderr "font-name: ~S\n" (ly:font-name font))
- ;; TODO s/filename/file-name/
- (stderr "font-filename: ~S\n" (ly:font-filename font))
- (stderr "pango-font-size: ~S\n" (pango-font-size font))
- ;;"ecrm12"))))
- (ly:font-filename font)))))
+ (font-family font))
(define (pango-font-size font)
(let* ((designsize (ly:font-design-size font))
(magnification (* (ly:font-magnification font)))
-
;;font-name: "GNU-LilyPond-feta-20"
- ;;font-filename: "feta20"
+ ;;font-file-name: "feta20"
;;pango-font-name: "lilypond-feta, regular 32"
;;OPS:2.61
;;scaling:29.7046771653543
;;magnification:0.569055118110236
;;design:20.0
- ;; experimental sizing:
+ ;; ugh, experimental sizing
;; where does factor ops come from?
;; Hmm, design size: 26/20
(ops 2.60)
scaling))
- (make <gnome-canvas-text>
- #:parent (canvas-root)
-
- #:anchor 'west
- #:x 0.0 #:y 0.15
-
- #:font (pango-font-name font)
-
- #:size-points (pango-font-size font)
- ;;#:size ...
- #:size-set #t
-
- ;;apparently no effect :-(
- ;;#:scale 1.0
- ;;#:scale-set #t
-
- #:fill-color "black"
- #:text (if (string? string)
- (string->utf8-string string)
- (char->utf8-string string))))
-
+ (let ((encoding (ly:font-encoding font)))
+ (make <gnome-canvas-text>
+ #:parent (canvas-root)
+ ;; ugh, experimental placement corections
+ ;; #:x 0.0 #:y 0.0
+ #:x 0.0 #:y (if (memq encoding '(fetaMusic fetaBraces)) 0.15 0.69)
+
+ #:anchor (if (memq encoding '(fetaMusic fetaBraces)) 'west 'south-west)
+ #:font (pango-font-name font)
+ #:size-points (pango-font-size font)
+ #:size-set #t
+ #:text (if (char? s)
+ (char->utf8-string font s)
+ (string->utf8-string font s)))))
projects / lilypond.git / blobdiff