Code

This is a huge environment that contains all TEX definitions. It is implemented as a separate environment so

A few special variables are included in this environment. They all contain an underscore (|_|) so they cannot be accessed from |Out-hershey| by the user.

draw_it
A boolean telling us whether we're actually drawing, or just measuring.
font_sibling
An association list describing the ``cut-down'' versions of fonts: |RM2B| can be reduced to |RM10|, for instance.
raw_handler
A procedure displaying its first argument as ``raw''. This is used by the main routine to display text without it having a special TEX meaning.
font_0
The default font.
size_0
The default size for the default font.
direction_0
The default direction for the default font.

Next comes the real drawing recursive routine. It will display string |str| with the specified font, direction and size, while |mode| describes how much information it must handle before return. possible values are |'char| (get only a character), |'raw| (no TEX interpretation), |'single| (only one pass) or a combination of these values. When no mode argument is provided, |TeX-out| will call itself tail-recursively until it has displayed the whole string.

(define TeX-environment (let ((out-char (lambda (cnum cfont args) (let* ((str (car args)) (font (cadr args)) (direction (caddr args)) (size (cadddr args))) ((access TeX-out TeX-environment) (list->string (list (integer->char cnum))) cfont direction size) str))) ) (make-environment (define draw_it #t) ; shall we draw, or measure ? (define font_siblings '((gr2b . gr10) (gr2l . gr10) (rm2b . rm10) (rm2l . rm10) (sl2b . sl10) (sl2l . sl10) (ss2b . ss10) (ss2l . ss10) (sy20 . sy10))) (define font_0 'RM10) (define size_0 2) (define direction_0 'HORIZ) (define (o_sym n) (lambda (s . a) (out-char n (if (member (cadr a) '(SY10 SS10 RM10 GR10 SL10)) 'SY10 'SY20) a))) (define (o_svar fif felse) (lambda (s . a) (out-char (if (member (cadr a) (cdr fif)) (car fif) felse) (if (member (cadr a) '(SY10 SS10 RM10 GR10 SL10)) 'SY10 'SY20) a))) (define (o_s10 n) (lambda (s . a) (out-char n 'SY10 a))) (define (o_s20 n) (lambda (s . a) (out-char n 'SY20 a))) (define (o_grk n) (lambda (s . a) (out-char n (case (cadr a) ((SY10 SS10 RM10 GR10 SL10) 'GR10) ((SS2L RM2L GR2L SL2L) 'GR2L) (else 'GR2B)) a))) (define (o_lig n) (lambda (s . a) (out-char n (cadr a) a)))

(define Font-Composite? pair?) (define Font-X car) (define Font-Y cadr) (define Font-Make cons) (define (Font- size) (if (Font-Composite? size) (Font-Make (max 1 (- (Font-X size) 2)) (max 1 (- (Font-Y size) 2))) (max 1 (- size 2)))) (define (Font+ size) (if (Font-Composite? size) (Font-Make (+ (Font-X size) 2) (+ (Font-Y size) 2)) (+ size 2))) (define (Font* size) (if (Font-Composite? size) (Font-Make (+ (Font-X size) 1) (+ (Font-Y size) 1)) (+ size 1))) (define (Font-Big? size) (if (Font-Composite? size) (> (max (Font-X size) (Font-Y size)) 2) (> size 2))) (define |small| (lambda (s str font direction size) (TeX-out str font direction (Font- size)))) (define |large| (lambda (s str font direction size) (TeX-out str font direction (Font+ size)))) (define |horiz| (lambda (s str font direction size) (TeX-out str font 'horiz size))) (define |vert| (lambda (s str font direction size) (TeX-out str font 'vert size))) (define |raw_handler| (lambda (s str font direction size) (cond ((equal? s "_") (|underscore| str font direction size)) (else (TeX-out s font direction size 'single 'raw) str)))) (define TeX-codes '((|langle| . (sym 1)) (|rangle| . (sym 2)) (|(| . (sym 3)) (|)| . (sym 4)) (|[| . (sym 5)) (|]| . (sym 6)) (|| . (sym 7)) (|| . (sym 8)) (|rw| . (sym 9)) (|wr| . (sym 10)) (|parallel| . (sym 11)) (|pm| . (sym 12)) (|mp| . (sym 13)) (|times| . (svar '(14 SS2L GR2L EN2L SS10) 15)) (|cdot| . (svar '(16 SS2L GR2L EN2L SS10) 17)) (|div| . (sym 18)) (|neq| . (sym 19)) (|equiv| . (sym 20)) (|leq| . (sym 21)) (|geq| . (sym 22)) (|propto| . (sym 23)) (|subset| . (sym 24)) (|cup| . (sym 25)) (|supset| . (sym 26)) (|cap| . (sym 27)) (|in| . (sym 28)) (|nabla| . (svar '(29 SS2L GR2L EN2L) 30)) (|varsurd| . (sym 31)) (|surd| . (sym 32)) (|varint| . (sym 33)) (|int| . (sym 34)) (|oint| . (sym 35)) (|sum| . (sym 36)) (|prod| . (sym 37)) (|infty| . (sym 38)) (|exists| . (sym 39)) (|otimes| . (s20 40)) (|perp| . (s20 42)) (|angle| . (s20 43)) (|thatis| . (s20 44)) (|angstrom| . (s20 46)) (|hbar| . (s20 47)) (|'| . (sym 64)) (|`| . (sym 65)) (|u| . (sym 66)) (|''| . (sym 67)) (|``| . (sym 68)) (|`|̈ . (sym 69)) (|'|̈ . (sym 70)) (|rightarrow| . (svar '(71 SS2L GR2L RM2L SS10) 72)) (|uparrow| . (sym 73)) (|leftarrow| . (sym 74)) (|downarrow| . (sym 75)) (|S| . (sym 76)) (|dagger| . (sym 77)) (|ddagger| . (sym 78)) (|box| . (sym 79)) (|odot| . (sym 80)) (|sun| . (sym 80)) (|mercury| . (sym 81)) (|venus| . (sym 82)) (|oplus| . (sym 83)) (|earth| . (sym 83)) (|mars| . (sym 84)) (|jupiter| . (sym 85)) (|saturn| . (sym 86)) (|uranus| . (sym 87)) (|neptune| . (sym 88)) (|pluto| . (sym 89)) (|moon| . (sym 90)) (|comet| . (sym 91)) (|asteroid| . (sym 92)) (|ver| . (sym 93)) (|autumnis| . (sym 94)) (|bullet| . (s10 95)) (|spadesuit| . (s20 95)) (|heartsuit| . (s20 96)) (|dash| . (s10 97)) (|diamondsuit| . (s20 97)) (|sqcap| . (s10 98)) (|clubsuit| . (s20 98)) (|wedge| . (s10 99)) (|varclub| . (s20 99)) (|underscore| . (sym 48)) (|wp| . (s20 50)) (|scout| . (s20 100)) (|bigtriangledown| . (s10 101)) (|circle| . (s10 160)) (|square| . (s10 161)) (|triangle| . (s10 162)) (|diamond| . (s10 163)) (|star| . (s10 164)) (|smash| . (s10 167)) (|CIRCLE| . (s10 168)) (|SQUARE| . (s10 169)) (|UTRIANGLE| . (s10 170)) (|LTRIANGLE| . (s10 171)) (|DTRIANGLE| . (s10 172)) (|RTRIANGLE| . (s10 173)) (|STAR| . (s10 174)) (|FLAG| . (s10 175)) (|anchor| . (s10 176)) (|plane| . (s10 177)) (|work| . (s10 178)) (|oil| . (s10 179)) (|boat| . (s10 180)) (|skew| . (s10 181)) (|christ| . (s10 182)) (|muslim| . (s10 183)) (|jew| . (s10 184)) (|bell| . (s10 185)) (|palmtree| . (s10 186)) (|firtree| . (s10 187)) (|oaktree| . (s10 188)) (|tree| . (s10 189)) (|sun| . (s10 190)) (|county| . (s20 147)) (|district| . (s20 148)) (|aries| . (s20 149)) (|taurus| . (s20 150)) (|gemini| . (s20 151)) (|cancer| . (s20 152)) (|leo| . (s20 153)) (|virgo| . (s20 154)) (|libra| . (s20 155)) (|scorpio| . (s20 156)) (|sagittarius| . (s20 157)) (|capricorn| . (s20 158)) (|aquarius| . (s20 159)) (|pisces| . (s20 160)) (|steer| . (s20 161)) (|cent| . (s20 162)) (|verb*| . (s20 163)) (|mdot| . (s20 192)) (|m`| . (s20 193)) (|m'| . (s20 194)) (|full| . (s20 195)) (|half| . (s20 196)) (|quarter| . (s20 197)) (|sharp| . (s20 198)) (|natural| . (s20 199)) (|flat| . (s20 200)) (|rest| . (s20 201)) (|hrest| . (s20 202)) (|qrest| . (s20 203)) (|erest| . (s20 204)) (|Gclef| . (s20 205)) (|Fclef| . (s20 206)) (|tenorclef| . (s20 207)) (|aleph| . (s20 49)) (|Alpha| . (grk 65)) (|Beta| . (grk 66)) (|Gamma| . (grk 67)) (|Delta| . (grk 68)) (|Epsilon| . (grk 69)) (|Zeta| . (grk 70)) (|Eta| . (grk 71)) (|Theta| . (grk 72)) (|Iota| . (grk 73)) (|Kappa| . (grk 74)) (|Lambda| . (grk 75)) (|Mu| . (grk 76)) (|Nu| . (grk 77)) (|Xi| . (grk 78)) (|Omicron| . (grk 79)) (|Pi| . (grk 80)) (|Rho| . (grk 81)) (|Sigma| . (grk 82)) (|Tau| . (grk 83)) (|Upsilon| . (grk 84)) (|Phi| . (grk 85)) (|Khi| . (grk 86)) (|Psi| . (grk 87)) (|Omega| . (grk 88)) (|alpha| . (grk 97)) (|beta| . (grk 98)) (|gamma| . (grk 99)) (|delta| . (grk 100)) (|epsilon| . (grk 101)) (|zeta| . (grk 102)) (|eta| . (grk 103)) (|theta| . (grk 104)) (|iota| . (grk 105)) (|kappa| . (grk 106)) (|lambda| . (grk 107)) (|mu| . (grk 108)) (|nu| . (grk 109)) (|xi| . (grk 110)) (|omicron| . (grk 111)) (|pi| . (grk 112)) (|rho| . (grk 113)) (|sigma| . (grk 114)) (|tau| . (grk 115)) (|upsilon| . (grk 116)) (|phi| . (grk 117)) (|khi| . (grk 118)) (|psi| . (grk 119)) (|omega| . (grk 120)) (|vardelta| . (grk 1)) (|varepsilon| . (grk 2)) (|vartheta| . (grk 3)) (|varphi| . (grk 4)) (|varsigma| . (grk 5)) (|ff| . (lig 1)) (|fi| . (lig 2)) (|fl| . (lig 3)) (|ffi| . (lig 4)) (|ffl| . (lig 5)) (|i| . (lig 6)) ))

(define (TeX-out str font direction size . mode) (define (TeX-token str mode) (define TeX-lookup (let ((code (compile `(access XXX ,TeX-environment)))) (lambda (name) (set-car! (member 'XXX (cadddr code)) name) ((define (TeX-font name) (lambda (s str font direction size) (TeX-out str (string->symbol (list->string (map char-upcase (string->list name)))) direction (if s s size)))) (define (TeX-raise amount) (lambda (str font direction size) (set-font font direction size) (let* ((delta (* (cdr (text-size "I")) amount)) (move (if (equal? direction 'vert) (cons (- delta) 0) (cons 0 (- delta)))) (back (if (equal? direction 'vert) (cons delta 0) (cons 0 delta)))) (move-rel move) (let* ((newfont (if (Font-Big? size) font (let ((try (assoc font font_siblings))) (if try (cdr try) font)))) (newsize (if (equal? newfont font) (Font- size) (Font* size))) (tail (TeX-out str newfont direction newsize 'single 'char))) (move-rel back) tail)))) (define (TeX-begin str font direction size) (TeX-out str font direction size)) (define (TeX-end str font direction size) (list str)) (letrec ((len (string-length str)) (first-separator (substring-find-next-char-in-set str 0 len (if (member 'intoken mode) "
^_ " "
^_"))) (first-len (cond ((member 'char mode) 1) (first-separator first-separator) (else len))) (trim (lambda (str) (cond ((string-null? str) str) ((char-whitespace? (string-ref str 0)) (trim (substring str 1 (string-length str)))) (else str))))) (if (equal? first-separator 0) (let ((tail (substring str 1 len))) (case (string-ref str 0) ((#)̂ (cons (TeX-raise .6) tail)) ((#_) (cons (TeX-raise -.5) tail)) ((#{) (cons TeX-begin tail)) ((#}) (cons TeX-end tail)) ((#
) (if (and (not (string-null? tail)) (member (string-ref tail 0) '(#
##̂_))) (cons (lambda args (apply |raw_handler| (cons (substring tail 0 1) args))) (substring tail 1 (string-length tail))) (let* ((next (TeX-token tail '(intoken))) (first-token (car next)) (first-len (string-length first-token)) (double (substring-find-next-char-in-set first-token 0 first-len "@")) (first-atom (if double (substring first-token 0 double) first-token)) (first-symbol (string->symbol first-atom)) (arg-string (if double (substring first-token (1+ double) first-len) " ")) (argument (if (equal? (string-ref arg-string 0) # )(begin(string - set!arg - string(substring - find - next - char - in - setarg - string0(- first - lendouble1)",")# )(read (open - input - stringarg - string)))(string - > numberarg - string)))(TeX - cmd (assocfirst - symbolTeX - codes))(handler(ifTeX - cmd (apply(case(cadrTeX - cmd )(SYMosym)(SVARosvar)(S10os10)(S20os20)(LIGolig)(GRKogrk))(cddrTeX - cmd ))(TeX - lookup(string - > symbolfirst - atom)))))(cons(lambdaargs(apply(if (equal?handler#!unassigned )(TeX - fontfirst - atom)handler)(consargumentargs)))(trim(cdrnext))))))))(cons(substringstr0first - len)(substringstrfirst - lenlen)))))(define(set - fontfontdirectionsize)(if (not(assocfont(accessfont - lbgi - environment)))(install - user - font(symbol - > stringfont)))(if (Font - Composite?size)(begin(set - text - stylefontdirection0)(set - user - char - size(cons(Font - Xsize)1)(cons(Font - Ysize)1)))(set - text - stylefontdirectionsize)))

(let((next(if (member'rawmode)(consstr"")(TeX - tokenstrmode))))(if (string?(carnext))(when(not(string - null?(carnext)))(set - fontfontdirectionsize)(set - text - justify(if (equal?direction'vert)'right'left)'bottom);(writeln"out`"(carnext)"'in"font"at"size)(ifdrawit(out - text(carnext))(move - rel (cons(car(text - size(carnext)))0)))(if (equal?direction'vert)(move - rel (cons0(- (car(text - size(carnext)))))))(if (member'singlemode)(cdrnext)(TeX - out(cdrnext)fontdirectionsize)))(let((tail ((carnext)(cdrnext)fontdirectionsize)))(if (not(string?tail ))(cartail )(if (member'singlemode)tail (TeX - outtailfontdirectionsize))))))))))

This routine is the only one intended to be called by the user. It can receive one or two arguments, the first one being the string to display, and the second optional one being the starting position. It can be understood as a replacement for both |out-text| and |out-text-xy|.

(define (out-hershey str . position) (case (length position) ((0) ()) ((1) (move-to (car position))) (else (error "Invalid arguments" position))) (if (string? str) ((access TeX-out TeX-environment) str (access font_0 TeX-environment) (access direction_0 TeX-environment) (access size_0 TeX-environment)) (error "String expected" str)))

This routine returns the space taken to display |str|. It does not perform any output, and is a replacement for |text-size|.

(define (size-hershey str) (set! (access draw_it TeX-environment) #f) (let ((here (get-xy))) ((access TeX-out TeX-environment) str (access font_0 TeX-environment) (access direction_0 TeX-environment) (access size_0 TeX-environment)) (let ((there (get-xy))) (begin0 (cons (- (car there) (car here)) (- (cdr there) (cdr here))) (set! (access draw_it TeX-environment) #t) (move-to here)))))