This is the mail archive of the
guile@sources.redhat.com
mailing list for the Guile project.
Re: graphics in scheme?
- To: Guile Mailing List <guile at sourceware dot cygnus dot com>
- Subject: Re: graphics in scheme?
- From: Eric Marsden <emarsden at mail dot dotcom dot fr>
- Date: 21 Jul 2000 18:11:34 +0200
- Cc: Olin Shivers <shivers at ai dot mit dot edu>
- Organization: LAAS-CNRS http://www.laas.fr/
- References: <Pine.LNX.4.21.0007201649440.15961-100000@marvin.ida.ing.tu-bs.de>
>>>>> "dh" == Dirk Herrmann <dirk@ida.ing.tu-bs.de> writes:
dh> I'm having problems with fps-1.0 in combination with scsh-0.5.2
dh> when I try to use fonts. Immediately after starting scsh and
dh> loading the fps package I do:
>> (font "Helvetica" 12)
dh> Error: exception
dh> (cdr '())
FPS needs some some minor changes given the move to SREs and the new
list-lib in scsh 0.5.2. With the following patch it seems to work.
diff -uwr fps-1.0/fps-examples.scm fps-1.1/fps-examples.scm
--- fps-1.0/fps-examples.scm Thu Oct 31 20:07:18 1996
+++ fps-1.1/fps-examples.scm Fri Jul 21 18:10:11 2000
@@ -305,9 +305,9 @@
(single-angle (lambda (g n) (let ((w (pt:x (end-pt g))))
(* 2 (tan (/ (/ (+ w (* space-w n)) 2)
radius))))))
- (top-angle (reduce (lambda (g angle) (+ (single-angle g n-top) angle))
+ (top-angle (fold-right (lambda (g angle) (+ (single-angle g n-top) angle))
0 top-lst))
- (bot-angle (reduce (lambda (g angle) (+ (single-angle g n-bot) angle))
+ (bot-angle (fold-right (lambda (g angle) (+ (single-angle g n-bot) angle))
0 bot-lst)))
(translate
300 400
diff -uwr fps-1.0/fps.afm.scm fps-1.1/fps.afm.scm
--- fps-1.0/fps.afm.scm Thu Oct 31 20:07:18 1996
+++ fps-1.1/fps.afm.scm Fri Jul 21 18:10:14 2000
@@ -64,7 +64,7 @@
(define construct-afm
- (let ((split-line (infix-splitter "[ \t]+")))
+ (let ((split-line (infix-splitter (rx white))))
(lambda (fontname)
(let* (;; check the FPS_AFM_PATH env var to look for the .afm file
@@ -157,8 +157,9 @@
;; out of a line entry (converted to a list) in the .afm file.
(define extract-glyph
- (let ((split-kv (suffix-splitter "[ \t]*;[ \t]*"))
- (split-fields (field-splitter "[^ \t]+")))
+ (let* ((opt-ws (rx (* (| "\t" #\space))))
+ (split-kv (suffix-splitter (rx (seq ,opt-ws ";" ,opt-ws))))
+ (split-fields (field-splitter (rx (+ (~ (| "\t" #\space)))))))
(lambda (line)
(let ((glyph (make-glyph #f #f #f 0 0 0 0)))
diff -uwr fps-1.0/fps.glyph.scm fps-1.1/fps.glyph.scm
--- fps-1.0/fps.glyph.scm Thu Oct 31 20:07:18 1996
+++ fps-1.1/fps.glyph.scm Fri Jul 21 18:10:17 2000
@@ -116,7 +116,7 @@
;; with '%' and ':'. Returns a glyphpath.
(define string->glyphpath
- (let ((splitter (field-splitter "%%|%[^:]*:|[^%]+")))
+ (let ((splitter (field-splitter (rx (| "%%" (seq "%" (* (~ ":"))) (+ (~ "%")))))))
(lambda (font str . user-error-tag)
(let ((error-tag (:optional user-error-tag 'empty))
(lst (reverse (splitter str))))
@@ -162,8 +162,11 @@
(update-tmp-lst #f chars tmp-lst))))
(define process-escape-str
- (let ((splitter (field-splitter
- "\\[[0-9A-Fa-f]*\\]|\\([0-9A-Fa-f]*\\)|[^[( ]+")))
+ (let* ((name (rx (* (/ "09AFaf"))))
+ (re (rx (| (seq "[" ,name "]")
+ (seq "(" ,name ")")
+ (+ (~ (| "[" "(" #\space))))))
+ (splitter (field-splitter re)))
(lambda (font str tmp-lst error-tag)
(string-set! str 0 #\space)
(string-set! str (- (string-length str) 1) #\space)
diff -uwr fps-1.0/fps.scm fps-1.1/fps.scm
--- fps-1.0/fps.scm Thu Oct 31 20:07:18 1996
+++ fps-1.1/fps.scm Fri Jul 21 12:58:51 2000
@@ -53,7 +53,7 @@
;; (afm-directory-list) would return ("/mydir" "/yourdir")
(define afm-directory-list
- (let ((splitter (infix-splitter ":")))
+ (let ((splitter (infix-splitter (rx ":"))))
(lambda ()
(cond ((getenv "FPS_AFM_PATH") => splitter)
(else default-afm-dir-path)))))
--
Eric Marsden <URL:http://www.laas.fr/~emarsden>