diff options
Diffstat (limited to 'Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl')
-rw-r--r-- | Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl | 1346 |
1 files changed, 1346 insertions, 0 deletions
diff --git a/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl b/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl new file mode 100644 index 00000000000..595531b3057 --- /dev/null +++ b/Master/texmf-dist/doc/latex/latex-web-companion/latex2xml/mathml.dsl @@ -0,0 +1,1346 @@ + +<!-- DSSSL Stylesheet fragment mathml.dsl + (included as an entity into mathmlx.dsl) + --> + +;;; +;;; David Carlisle +;;; davidc@nag.co.uk +;;; +;;; Copyright 1998 Nag Ltd, The OpenMath Consortium. Esprit Project 24.969. +;;; + + + + +;;; COLOUR +;;; +;;; Just RGB colour supported currentlly + +(define (rgb-color r g b) + (color (color-space + "ISO/IEC 10179:1996//Color-Space Family::Device RGB") r g b)) + + + +;;; CONTENT MathML +;;; +;;; Content MathML is mainly implemented directly with element +;;; declarations, and process-children. there is not too much +;;; need for node list processing. +;;; +;;; Currently many attributes for font changes and spacing are silently +;;; ignored. +;;; +;;; The mo element goes to some trouble to get its attributes as specified +;;; in the MathML recomendation, but currently doesn't do much with them. + + +;;; mrow +;;; should check attributes (this comment applies to most elements +;;; but won't be repeated + +(element mrow + (process-children-trim)) + + +;;; mi +;;; Math Identifier Defaults to italic. +;;; Ought to switch between math italic and text italic +;;; for multi letter identifiers (or just in tex backend?) + +(element mi + (make math-sequence + font-posture: + (let ((fnt + (if(attribute-string "fontstyle") + (attribute-string "fontstyle") + "italic"))) + (if (equal? "normal" fnt) + 'upright + (if (equal? "italic" fnt) + 'italic + #f))) + (process-children-trim))) + + + +;;; mn +;;; Same for numbers. + +(element mn + (make math-sequence + font-posture: + (let ((fnt + (if(attribute-string "fontstyle") + (attribute-string "fontstyle") + "normal"))) + (if (equal? "normal" fnt) + 'upright + (if (equal? "italic" fnt) + 'italic + #f))) + (process-children-trim))) + +;;; mtext +;;; Bits of non-math + +(element mtext + (make unmath + (process-children-trim))) + +;;; mspace +;;; Grumble grumble it seems extraordinarily complicated to copy +;;; a length from an attribute on the element to a keyword to a make +;;; function. Also the rtf backend doesn't really support line-field +;;; I couldn't get inline-space characters to work either. + +(element mspace + (make line-field field-width: + (let ((x (attribute-value "width" (current-node)))) + (measurement-to-length (if (attribute-string "width") + (attribute-string "width") + "0pt"))))) + +;;; ms +;;; Doesn't work right in tex backend: How do you specify mono space font +;;; without specifying what font to use. + +(element ms + (make unmath + font-posture: 'upright + font-family-name: "iso-monospace" + (literal "\"") + (process-children-trim) + (literal "\""))) + + +;;; mfrac +;;; fractions. + +(element mfrac + (make fraction + (let ((nl (children(current-node)))) + (sosofo-append + (make math-sequence + label: 'numerator + (process-node-list (node-list-first nl))) + (make math-sequence + label: 'denominator + (process-node-list (node-list-rest nl))))))) + +;;; msqrt mroot +;;; Radicals + +(element msqrt + (make radical + (process-children-trim))) + + +(element mroot + (make radical + (let ((nl (children(current-node)))) + (sosofo-append + (make math-sequence + (process-node-list (node-list-first nl))) + (make math-sequence + label: 'degree + (process-node-list (node-list-rest nl))))))) + + +;;; mstyle +;;; Style, what style? + +(element mstyle + (make math-sequence + (process-children-trim))) + +;;; merror +;;; Ignore this, for now + +(element merror + (make math-sequence + (process-children-trim))) + +;;; mpadded +;;; Hmmm +(element mpadded + (make math-sequence + (process-children-trim))) + + +;;; mphantom +;; do it in white: not really the same as invisible +;; but not sure if there is an easy general way to access +;; background colour. + +(element mphantom + (make math-sequence + color: (rgb-color 1 1 1) + (process-children-trim))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; mfenced +;;; Doesn't do separators for now. + +(element mfenced + (make fence + (if (attribute-string "open") + (make math-sequence + label: 'open + (literal (attribute-string "open"))) + (empty-sosofo)) + (if (attribute-string "close") + (make math-sequence + label: 'close + (literal (attribute-string "close"))) + (empty-sosofo)) + (make math-sequence + (process-children-trim)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Superscripts and subscripts + +;;; msup + +(element msup + (make script + (let ((nl (children(current-node)))) + (sosofo-append + (make math-sequence + (process-node-list (node-list-first nl))) + (make math-sequence + label: 'post-sup + (process-node-list (node-list-rest nl))))))) + +;;; msub + +(element msub + (make script + (let ((nl (children(current-node)))) + (sosofo-append + (make math-sequence + (process-node-list (node-list-first nl))) + (make math-sequence + label: 'post-sub + (process-node-list (node-list-rest nl))))))) + +;;; msubsup + +(element msubsup + (make script + (let* ((nl (children(current-node))) + (nlr (node-list-rest nl))) + (sosofo-append + (make math-sequence + (process-node-list (node-list-first nl))) + (make math-sequence + label: 'post-sub + (process-node-list (node-list-first nlr))) + (make math-sequence + label: 'post-sup + (process-node-list (node-list-rest nlr))))))) + +;;; mmultiscripts +;;; In order to get the scripts aligning with each other +;;; they all script an empty element (so ignore th esize of the base +;;; I wish I could measure things in DSSSL.... + +(element mmultiscripts + (let* ((nl (children(current-node))) + (base (node-list-first nl)) + (nlr (node-list-rest nl))) + (process-multi-scripts base nlr #t (empty-sosofo) (empty-sosofo)))) + + +;;; while flag is true scoop up the scripts into the fourth argument +;;; then when you see multiscripts switch the flag so then start collecting +;;; in the third argument. Finally when rest is empty, stuff the scripts +;;; around the base. + +(define (process-multi-scripts base rest flag left right ) + (if (node-list-empty? rest) + (sosofo-append + left + (make math-sequence + (process-node-list base)) + right) +; else + (if (equal? "mprescripts" (gi (node-list-first rest))) + (process-multi-scripts base (node-list-rest rest) #f left right) + (if flag + (process-multi-scripts + base + (node-list-rest (node-list-rest rest)) + flag + left + (sosofo-append + right + (make script + (make math-sequence + label: 'post-sub + (process-node-list (node-list-first rest))) + (make math-sequence + label: 'post-sup + (process-node-list (node-list-first (node-list-rest rest))))))) + ; else + (process-multi-scripts + base + (node-list-rest (node-list-rest rest)) + flag + (sosofo-append + left + (make script + (make math-sequence + label: 'post-sub + (process-node-list (node-list-first rest))) + (make math-sequence + label: 'post-sup + (process-node-list (node-list-first (node-list-rest rest)))))) + right))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; none/ +;;; Not the hardest thing to implement + +(element none + (empty-sosofo)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Under and over bars. +;;; These don't work yet. + +(element munder + (make math-sequence + (process-children-trim))) + +(element mover + (make math-sequence + (process-children-trim))) + +(element munderover + (make math-sequence + (process-children-trim))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Operator dictionary + +;;; This is just a small version, while I test various implementations. + + +;;; First put back the indirection that TeX as but that MathML omitted. +;;; Need the default lengths to refer to variables rather than explicit +;;; lengths, so that you can change them all together. +;;; Apart from the fact that it isn't implemented, there arelots of other +;;; problems with this operator dictionay concept. + +;;; (mathml problem) As noted above the recommendation gives explicit lengths. +;;; (mathml problem) As the recommendation gives fixed (as opposed to +;;; variable/stretchy) lengths. +;;; (dsssl problem) Full support of stretch operators would require an +;;; extended dsssl flow object (or extended semantics +;;; for the stretchy character characteristic) to support +;;; `mid' fences. +;;; +(define %zskip 0em) +(define %smallskip .05555em) +(define %medskip .16666em) +(define %bigskip .16666em) + +(define mathml-op-dict +'( + ("+" + ("prefix". ((lspace . %zskip) (rspace . %bigskip))) + ("infix" . ((lspace . %medskip) (rspace . %medskip)))) + ("*=" + ("infix" . ((lspace . %bigskip)(rspace . %bigskip)))) + ("(" + ("prefix" . ((fence . #t )(stretchy . #t)(lspace . %zskip)(rspace . %zskip)))) + (")" + ("postfix" .((fence . #t )(stretchy . #t)(lspace . %zskip)(rspace . %zskip)))) + +)) + + +;;; Helper function, just trims spaces from strings, actually +;;; zaps all space. needed as mo doesn't use process-children-trim. + +(define (string-nospace s) + (let ((l (string-length s))) + (let loop ((i 0)) + (if (= i l) + "" + (let (( x (string-ref s i))) + (if (equal? #\space x) + (loop (+ i 1)) + (string-append (string x) + (loop (+ i 1))))))))) + +;;; mo +;;; This current version tries to implement the defaulting +;;; of the various attributes. Although currently +;;; It doesn't actually use th eattributes once it has got the +;;; values. + +(element mo + (let* +;; First get the name of the operator +;; and the surrounding node list which will be dealt with specially +;; if it is mrow (or more correctly should be mrow-like) + ((nm (string-append(string-nospace (data (current-node))))) + (pnt (parent)) +;; An explicit form attribute (or #f) + (form1 (attribute-string "form")) +;; Look up the name in the operator dictionary, which will return +;; another association list, for looking up the form [if the operator +;; is in the dictionary]. + (p (assoc nm mathml-op-dict)) + (form + (if form1 + (if p +;; If a form was specified, and the operator is in the dictionary +;; look up the list of defaults. If it isn't in the dictionary +;; with this form just make up a list just consisting of the form. + (or (assoc form1 (cdr p)) + (list form1)) + (list form1 )) +;; Otherwise if a form was not specified, look up how many entries +;; in the operator dictionary for this operator. + (let* ((dict-entries (if p + (length (cdr p)) + 0))) + (if (= 0 dict-entries) +;; If there are none, the operator is infix. + (list "infix" ) + (if (= 1 dict-entries) +;; If there is one, return that. + (car (cdr p)) +;; If there is more than one, look where we are in the parent list +;; to decide which one to use. + (let ((d (assoc (if (string=? "mrow" (gi pnt)) + (let ((l (node-list-length (children pnt))) + (n (absolute-child-number (current-node)))) + (if (> l 1) + (if (= n 1) + "prefix" + (if (= n l) + "postfix" + "infix")) + "infix")) + "infix") + (cdr p)))) + (if d + d + (car (cdr p)))) + ))) ; let* + )) ; form +;; Fence, from an attribute or out of the dictionary + (fence1 (attribute-string "fence")) + (fence (&my-debug(if fence1 + (string=? fence1 "true") + (cdr (or (assoc 'fence (cdr form)) + '( #t . #f)))))) + ) ; end of let* settings +;; Having done all that work, ignore all the attributes and just process +;; the children. + (make math-sequence + (process-children-trim)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Helper function that just sticks a number of copies of a sosofo +;;; on to the current sosofo. Used to pad out grids. + +(define (repeat-sosofo n sos) + (if (equal? n 0) + (empty-sosofo) + (sosofo-append sos (repeat-sosofo (- n 1) sos)))) + +;;; mtable +;;; Spanning cells not supported as I need to use dsssl grid flow objects +;;; which don't span. Dsssl table flow objects do support spanning but they +;;; are display objects and can't be inlined so are no good for this. + +(element mtable +;; Preliminary pass through the table to count the number of columns + (let ((cols (&my-debug(node-list-reduce + (children(current-node)) + (lambda (a b) + (if (string=? "mtr" (gi b)) + (max a (node-list-length (children b))) + a)) + 0)))) + (make grid + grid-n-columns: cols +;; Now main pass, making grid-cell flow object specifications. + (node-list-reduce + (children(current-node)) + (lambda (a b) + (if (string=? "mtr" (gi b)) + (sosofo-append + a + (node-list-reduce + (children b) + (lambda (x y) + (sosofo-append + x + (make grid-cell (process-node-list y)))) + (empty-sosofo)) + (repeat-sosofo + (- cols (node-list-length (children b))) + (make grid-cell (empty-sosofo)))) + (sosofo-append + a + (make grid-cell (process-node-list b)) + (repeat-sosofo (- cols 1) (make grid-cell (empty-sosofo)))))) + (empty-sosofo))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; semantics + +;;; Helper function to dig out a MathML-Presentation child +;;; if it exists. + +(define (get-presentation nl) + (if (node-list-empty? nl) + #f + (if (and + (string=? "annotation-xml" (gi (node-list-first nl))) + (string=? "MathML-Presentation" + (or (attribute-string "encoding" (node-list-first nl)) ""))) + (children (node-list-first nl)) + (get-presentation (node-list-rest nl))))) + +;;; Typeset the body and ignore all annotations, unless there +;;; is an annotation-xml giving MathML-Presentation +;;; in which case use that and ignore everything else. + +(element semantics + (let* ((nl (children (current-node)))) + (process-node-list (or + (get-presentation (node-list-rest nl)) + (node-list-first nl))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;; Content MathML + +;;; In contrast to Presentation forms, Content MathML has vary few +;;; elements defined in the dsssl, instead the apply element explitly +;;; processes its children and calls [allegedly] suitable functions. + +;;; It would be nice to use the dsssl transformation language to explicitly +;;; map content forms to presentation, +;;; but the style language isn't available, so... + + +;;; Helper function dealing with bound variables on sums and products +;;; Checks for lowlimit child. + +(define (dobvar product-char-sosofo equal-char-sosofo b r) + (let ((first (gi (node-list-first r)))) + (cond ((string=? "lowlimit" first) + (bvarl product-char-sosofo + (sosofo-append + b + equal-char-sosofo + (process-node-list (node-list-first r))) + (node-list-rest r))) + ((string=? "condition" first) + (bvarl + product-char-sosofo + (process-node-list (node-list-first r)) + (node-list-rest r))) + (else (bvarl product-char-sosofo (empty-sosofo) r))))) + + +;; Second function, checks for uplimit + +(define (bvarl product-char-sosofo low r) + (if (string=? "uplimit" (gi (node-list-first r))) + (bvaru + product-char-sosofo + low + (process-node-list (node-list-first r)) + (node-list-rest r)) + (bvaru + product-char-sosofo + low + (empty-sosofo) + r))) + +;; third function, add the found limits to the sum or product character + +(define (bvaru product-char-sosofo low high r) + (sosofo-append + (make script + (make math-sequence label: 'post-sub low) + (make math-sequence label: 'post-sup high) + product-char-sosofo) + (process-node-list r))) + +;;; General function to typeset a function with braced arguments. + +(define (apply-braced-fn fn args) + (make math-sequence + (sosofo-append + (literal fn) + (make fence + (make math-sequence label: 'open + (literal "(")) + (make math-sequence label: 'close + (literal ")")) + (make math-sequence + (process-node-list args)))))) + + +;;; product/ sum/ +;;; Look for bound vars, then call above helper function. + +(define (apply-product product-char-sosofo equal-char-sosofo args) + (make math-sequence + (let ((b (node-list-first args))) + (if (string=? (gi b) "bvar") + (dobvar + product-char-sosofo + equal-char-sosofo + (process-node-list b) + (node-list-rest args)) + (sosofo-append + product-char-sosofo + (process-node-list b)))))) + +;;; log/ +;;; Just needs to check for logbase/ + +(define (apply-log args) + (make math-sequence + (if (equal? "logbase" (gi (node-list-first args))) + (sosofo-append + (make script + (sosofo-append + (literal "log") + (make math-sequence + label: 'post-sub + (process-node-list (node-list-first args))))) + (apply-braced-fn "" (node-list-rest args))) + (apply-braced-fn "log" args)))) + +;;; root/ sqrt/ +;;; Checks for degree/ + +(define (apply-root args) + (make radical + (if (equal? "degree" (gi (node-list-first args))) + (sosofo-append + (make math-sequence + (process-node-list (node-list-rest args))) + (make math-sequence + label: 'degree + (process-node-list (node-list-first args)))) + (make math-sequence + (process-node-list args))))) + + +;;; forall/ exists/ +;;; Typeset any bound variables and conditions, +;;; separated by commas, then do a full stop and finally +;;; the body. + +(define (apply-forall op c) +(make math-sequence + (sosofo-append + op + (process-node-list (node-list-first c)) + (node-list-reduce + (node-list-rest c) + (lambda (result n) + (sosofo-append + result + (literal + (if (or (equal? "bvar" (gi n)) (equal? "condition" (gi n))) + "," + ".")) + (process-node-list n))) + (empty-sosofo))))) + + +;;; int/ + +(define (apply-int args) + (make math-sequence + (let ((b (node-list-first args))) + (if (string=? (gi b) "bvar") + (dobvar + (literal "\integral") + (empty-sosofo) + (empty-sosofo) + (node-list-rest args)) + (sosofo-append + (literal "\integral") + (process-node-list b)))))) + +;;; power/ + +(define (apply-power args) + (make script + (sosofo-append + (make math-sequence + (process-node-list (node-list-first args))) + (make math-sequence + label: 'post-sup + (process-node-list (node-list-rest args)))))) + +;;; inverse/ + +(define (apply-inverse fname args) + (make script + (sosofo-append + (make math-sequence + (process-node-list args)) + (make math-sequence + label: 'post-sup + (case fname + (("inverse") (literal "-1")) + (("transpose") (literal "t"))))))) + +;;; over bars (don't work) +(define (apply-over args) + (make math-sequence + (process-node-list args))) ;; fix! + +;;; max/ and min/ + +(define (apply-max fname args) + (make math-sequence + (sosofo-append + (make unmath (literal fname)) + (do-set "{" "}" args)))) + +;;; gcd/ + +(define (apply-gcd fname args) + (make math-sequence + (sosofo-append + (make unmath (literal fname)) + (do-set "(" ")" args)))) + +;;; abs/ + +(define (apply-abs args) + (make fence + (make math-sequence label: 'open + (literal "|")) + (make math-sequence label: 'close + (literal "|")) + (make math-sequence + (process-node-list args)))) + +;;; diff/ +;;; Trick is to get hold of the degree. +;;; Recommendation is for +;;; d f +;;; --- (x) +;;; d x +;;; +;;; but I don't currently test for special functions which are +;;; just a single identifier like that, so currently you get +;;; d d^3 +;;; --- f(x) and --- f(x) +;;; d x d x^3 + +(define (apply-diff args) + (sosofo-append + (let* ((f (node-list-first (&my-debug2 args)))) + (if (equal? "bvar" (gi f)) + (let ((d (&my-debug2 (node-list-filter + (lambda (n) (equal? "degree" (gi n))) + (children f))))) + (make fraction + (sosofo-append + (make math-sequence + label: 'numerator + (make script + (sosofo-append + (literal "d") + (make math-sequence + label: 'post-sup + (process-node-list d)))))) + (make math-sequence + label: 'denominator + (sosofo-append + (literal "d") + (make script + (sosofo-append + (process-node-list + (node-list-filter + (lambda (n) (not (equal? "degree" (gi n)))) + (children f))) + (make math-sequence + label: 'post-sup + (process-node-list d)))))))) + (make fraction + (sosofo-append + (make math-sequence + label: 'numerator + (literal "d")) + (make math-sequence + label: 'denominator + (sosofo-append + (literal "d") + (process-node-list f))))))) + (process-node-list (node-list-rest args)))) + + +;;; partial differentiation +;;; +;;; Trick here is to amalgamate the degrees +;;; in the numerator: +;;; d^3 +;;; ---------- f(x) +;;; d^2 x d y +;;; + +;; helper function that sets the bit of the denominator +;; corresponding to one bound variable. + +(define (do-one-partial nl) + (let ((d (&my-debug2 (node-list-filter + (lambda (n) (equal? "degree" (gi n))) + (children nl))))) + (make math-sequence + label: 'denominator + (sosofo-append + (literal "d") + (make script + (sosofo-append + (process-node-list + (node-list-filter + (lambda (n) (not (equal? "degree" (gi n)))) + (children nl))) + (make math-sequence + label: 'post-sup + (process-node-list d)))))))) + + +;;; partialdiff +;;; I suspect that I could make use of node-list-filter-by-gi +;;; from dblib here, but I only just noticed that function... + +(define (apply-partialdiff args) + (sosofo-append + (let* ((bvars + (node-list-filter + (lambda (n) (equal? "bvar" (gi n))) + args)) +;; totald is the sum of all the degrees [with 1 being supplied +;; as a default in each case] There may be an easier way to get that. + (totald + (node-list-reduce + bvars + (lambda (result n) + (+ result + (or + (string->number + (string-nospace + (data + (node-list-filter + (lambda (nn) (equal? "degree" (gi nn))) + (children n))))) + 1))) + 0))) +;; Now it is easy, set a fraction with the partial and the bound vars +;; then put out the body. + (make fraction + (sosofo-append + (make math-sequence + label: 'numerator + (make script + (sosofo-append + (literal "\partial-differential") + (make math-sequence + label: 'post-sup + (literal (number->string totald)))))) + (make math-sequence + label: 'denominator + (node-list-reduce + bvars + (lambda (result n) + (sosofo-append +;; something is reversing the args, so I'll reverse them back + (do-one-partial n) + result)) + (empty-sosofo)))))) + (process-node-list (node-list-filter + (lambda (n) (not (equal? "bvar" (gi n)))) + args)))) + + + + + +;;; apply +;;; This is the main switch for Content MathNL +;;; Mainly just a case statement on th egi of the first child +;;; with some fall back code in case the function argument isn't known. +(element apply + (let* ((nl (children (current-node))) + (f (node-list-first nl)) + (fname (&my-debug (gi f))) + (args (&my-debug (node-list-rest nl)))) + (case fname + (("product") + (apply-product (literal "\n-ary-product") (literal "=") args)) + (("sum") + (apply-product (literal "\n-ary-summation") (literal "=") args)) + (("limit") + (apply-product (literal "lim") (literal "\rightwards-arrow") args)) + (("int") + (apply-int args)) + (("inverse" "transpose") + (apply-inverse fname args)) + (("power") + (apply-power args)) + (("forall") + (apply-forall (literal "\for-all") args)) + (("exists") + (apply-forall (literal "\there-exists") args)) + (("plus" "times" "minus" "union" "intersect" "compose" "divide" "rem") + (do-nary-binop fname args)) + (("mean" "conjugate") + (apply-over args)) + (("factorial") + (sosofo-append (process-node-list args) (literal "!"))) + (("root") + (apply-root args)) + (("sdev") + (apply-braced-fn "\greek-small-letter-sigma" args)) + (("median" "mode") + (apply-braced-fn fname args)) + (("max" "min") + (apply-max fname args)) + (("gcd") + (apply-gcd fname args)) + (("log") + (apply-log args)) + (("abs") + (apply-abs args)) + (("diff") + (apply-diff args)) + (("partialdiff") + (apply-partialdiff args)) + (("var") + (make script + (make math-sequence + label: 'post-sup (literal "2")) + (apply-braced-fn "\greek-small-letter-sigma" args))) + (("transpose") + (make script + (make math-sequence + label: 'post-sup (literal "t")) + (process-node-list args))) + (else + (make math-sequence + (sosofo-append + (process-node-list f) + (if (and (equal? + 1 (&my-debug (node-list-length args))) + (equal? "ci" (gi args))) + (make math-sequence (process-node-list args)) + (make fence + (make math-sequence label: 'open + (literal "(")) + (make math-sequence label: 'close + (literal ")")) + (make math-sequence + (process-node-list args)))))))))) + + +;;; reln +;;; relations are similar to apply. +;;; Currently there is a double test as this top level +;;; function bunches all binops together, then do-binary-reln +;;; tests again to separate them, perhaps not the best idea. + +(element reln + (let* ((r (gi (node-list-first (children (current-node))))) + (c(&my-debug (node-list-rest(children (current-node)))))) + (case r + (("neq" "implies" "in" "notin" "notsubset" "notprsubset" "tendsto") + (do-binary-reln r c)) + (("eq" "leq" "lt" "geq" "gt" "subset" "prsubset") + (do-nary-reln r c))))) + + +;;; Typeset a binary infix relation + +(define (do-binary-reln r c) + (sosofo-append + (process-node-list (node-list-first c)) + (literal (case r + (("neq") "\not-equal-to") + (("implies") "\leftwards-double-arrow") + (("in") "\element-of") + (("notin") "\not-an-element-of") + (("notsubset") "\not-a-subset-of") + (("notprsubset") "PR\not-a-subset-of"); fix! + (("tendsto") "\rightwards-arrow"))); fix for type attribute + (process-node-list (node-list-rest c)))) + +;;; Typeset a nary infix relation +;;; repeating the operator as many times as needed. + +(define (do-nary-reln r c) + (let ((rs (literal + (case r + (("eq") "\equals-sign") + (("leq") "\less-than-or-equal-to") + (("lt") "\less-than-sign") + (("geq") "\greater-than-or-equal-to") + (("gt") "\greater-than-sign") + (("subset") "\subset-of") + (("prsubset") "PR\subset-of")))));fix! + (sosofo-append + (process-node-list (node-list-first c)) + (node-list-reduce + (node-list-rest c) + (lambda (result n) + (sosofo-append + result + rs + (process-node-list n))) + (empty-sosofo))))) + +;;; typeset an nary operator, as for relations. + +(define (do-nary-binop op c) + (let ((ops (literal + (case op + ((",") ",") + (("plus") "\plus-sign") + (("times") "") + (("union") "\union") + (("intersect") "\intersection") + (("minus") "\minus-sign") + (("divide") "\division-slash") + (("rem") "mod") ;fix + (("compose") "\U-2218") )))) + (sosofo-append + (process-node-list (node-list-first c)) + (node-list-reduce + (node-list-rest c) + (lambda (result n) + (sosofo-append + result + ops + (process-node-list n))) + (empty-sosofo))))) + + +;;;;;;;;;;;;;;;; + +;;;; ident + +(element ident + (make math-sequence + (literal "id"))) + + + +;;; trig +;;; Currently these done with th eelement declarations +;;; and the fallback case of apply typesetting the arguments. +;;; may need to change that. + +(define (do-sin sin) + (make unmath + font-posture: 'upright + (literal sin))) + +(element sin + (do-sin "sin")) + +(element cos + (do-sin "cos")) + +(element tan + (do-sin "tan")) + +(element sec + (do-sin "sec")) + +(element csc + (do-sin "csc")) + +(element cot + (do-sin "cot")) + +(element sinh + (do-sin "sinh")) + +(element cosh + (do-sin "cosh")) + +(element tanh + (do-sin "tanh")) + +(element sech + (do-sin "sech")) + +(element csch + (do-sin "csch")) + +(element coth + (do-sin "coth")) + +(element arcsin + (do-sin "arcsin")) + +(element arccos + (do-sin "arccos")) + +(element arctan + (do-sin "arctan")) + +;;;; + +;;; natural log and determinant are honourary trig functions. +;;; I should make det applied to an explicit table use | | rather +;;; than det ( ) I think. + +(element ln + (do-sin "ln")) + + +(element determinant + (do-sin "det")) + +;;;;;;;;;;; + +;;; sets and lists + +(element set + (do-set "{" "}" (children (current-node)))) + +(element list + (do-set "[" "]" (children (current-node)))) + +(element vector + (do-set "(" ")" (children (current-node)))) + +(element interval + (case (attribute-string "closure" (current-node)) + (("closed") + (do-set "[" "]" (children (current-node)))) + (("open") + (do-set "(" ")" (children (current-node)))) + (("open-closed") + (do-set "(" "]" (children (current-node)))) + (("closed-open") + (do-set "[" ")" (children (current-node)))))) + + +;;; helper function for sets. +;;; Checks for two styles, comma separated explicit, +;;; or via conditions and bound vars. + +(define (do-set left right args) + (make fence + (make math-sequence label: 'open + (literal left)) + (make math-sequence label: 'close + (literal right)) + (make math-sequence + (if (equal? "bvar" (gi (node-list-first (&my-debug2 args)))) + (if (equal? 2 (node-list-length args)) +;; typeset bvar + (sosofo-append + (process-node-list (children (node-list-first args))) + (literal "|") + (process-node-list (children (node-list-rest args)))) +;; else dont + (sosofo-append + (process-node-list (node-list-rest(node-list-rest args))) + (literal "|") + (process-node-list (children (node-list-first (node-list-rest args)))))) +;; else stick in some commas + (do-nary-binop "," args) )))) + + +;;;;;;; + +;;; lambda [lamda according to Jade ?] + +(element lambda + (sosofo-append + (make math-sequence (literal "\greek-small-letter-lamda")) + (do-nary-binop "," + (node-list-filter + (lambda (n) (equal? "bvar" (gi n))) + (children (current-node)))) + (literal ".") + (process-node-list + (&my-debug2(node-list-filter + (lambda (n) (not (equal? "bvar" (gi n)))) + (children (current-node))))))) + + +;;;;;;;;;;;;;;; + +;;; cn + +;;; what to do if you see a sep element for rationals.. + +(define (sep-rational top bottom) + (make fraction + (sosofo-append + (make math-sequence + label: 'numerator + (process-node-list top)) + (make math-sequence + label: 'denominator + (process-node-list bottom))))) + + +;;; and for complex cartesian + +(define (sep-complex-cartesian top bottom) + (make math-sequence + (sosofo-append + (make math-sequence + (process-node-list top)) + (make math-sequence (literal "+")) + (make math-sequence + (process-node-list bottom)) + (make math-sequence (literal "i"))))) + + +;;; and polar + +(define (sep-complex-polar top bottom) + (make math-sequence + (sosofo-append + (make math-sequence (literal "Polar")) + (make fence + (sosofo-append + (make math-sequence + label: 'open + (literal "(")) + (make math-sequence + label: 'close + (literal ")")) + (sosofo-append + (make math-sequence + (process-node-list top)) + (make math-sequence (literal ",")) + (make math-sequence + (process-node-list bottom)))))))) + +;;; Function to collect node list before and after sep element +;;; then finally call one of the above functions to typeset the +;;; two halves of the number. + +(define (do-sep fn flag top bottom args) + (if (equal? 0 (node-list-length args)); why can't I use null + (fn top bottom) + (if (equal? "sep" (gi (node-list-first args))) + (do-sep fn #f top bottom (node-list-rest args)) + (if flag + (do-sep fn flag + (node-list + top + (node-list-first args)) + bottom + (node-list-rest args)) + (do-sep fn flag + top + (node-list + bottom + (node-list-first args)) + (node-list-rest args)))))) + + +;;; cn +;;; subscript with the base unless it is 10, or call one of the above functions +;;; to start looking for sep element. + +(element cn + (case (or (attribute-string "type" (current-node)) + "real") + (("real" "constant") + (make math-sequence (process-node-list (children (current-node))))) + (("integer") + (if (equal? "10" (attribute-string "base" (current-node))) + (make math-sequence + (process-node-list (children (current-node)))) + (make script + (sosofo-append + (make math-sequence + (process-node-list (children (current-node)))) + (make math-sequence + label: 'post-sub + (literal + (attribute-string "base" (current-node)))))))) + (("rational") + (do-sep sep-rational + #t + (empty-node-list) + (empty-node-list) + (children (current-node)))) + (("complex-cartesian") + (do-sep sep-complex-cartesian + #t + (empty-node-list) + (empty-node-list) + (children + (current-node)))) + (("complex-polar") + (do-sep sep-complex-polar + #t + (empty-node-list) + (empty-node-list) + (children (current-node)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +; ought to share code with mtable, probably + +(element matrix + (let* ((c (&my-debug (children (current-node)))) + (n (&my-debug (node-list-length (children (node-list-first c)))))) + (make fence + (make math-sequence label: 'open + (literal "(")) + (make math-sequence label: 'close + (literal ")")) + (make grid + grid-n-columns: n + (node-list-reduce + c + (lambda (a b) + (sosofo-append + a + (node-list-reduce + (children b) + (lambda (x y) + (sosofo-append + x + (make grid-cell + (process-node-list y)))) + (empty-sosofo)))) + (empty-sosofo)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |