diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/guile/skribilo/package/eq.scm | 37 | ||||
| -rw-r--r-- | src/guile/skribilo/package/eq/lout.scm | 63 |
2 files changed, 73 insertions, 27 deletions
diff --git a/src/guile/skribilo/package/eq.scm b/src/guile/skribilo/package/eq.scm index 76bbf6c..cadc1ba 100644 --- a/src/guile/skribilo/package/eq.scm +++ b/src/guile/skribilo/package/eq.scm @@ -19,7 +19,7 @@ ;;; USA. (define-module (skribilo package eq) - :autoload (skribilo ast) (markup?) + :autoload (skribilo ast) (markup? find-up) :autoload (skribilo output) (output) :use-module (skribilo writer) :use-module (skribilo engine) @@ -117,6 +117,18 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (string-length str)))) #f)) +(define-public (inline-equation? m) + "Return @code{#t} if @var{m} is an equation that is to be displayed inline." + (and (is-markup? m 'eq) + (let ((i (markup-option m :inline?))) + (case i + ((auto) + (not (find-up (lambda (n) + (is-markup? n 'eq-display)) + m))) + ((#t) #t) + (else #f))))) + ;;; ;;; Operator precedence. @@ -190,20 +202,22 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (markup 'eq-display) (ident (or ident (symbol->string (gensym "eq-display")))) (class class) - (options (the-options opts :ident :class :div-style)) + (options (the-options opts :ident :class)) (body (the-body opts)))) (define-markup (eq :rest opts :key (ident #f) (class "eq") - (inline? #f) (align-with #f) - (renderer #f) (div-style 'over)) + (inline? 'auto) (align-with #f) + (renderer #f) (div-style 'over) + (mul-style 'space)) (new container (markup 'eq) (ident (or ident (symbol->string (gensym "eq")))) (class class) (options `((:div-style ,div-style) (:align-with ,align-with) + (:mul-style ,mul-style) ,@(the-options opts :ident :class - :div-style :align-with))) + :div-style :mul-style :align-with))) (body (let loop ((body (the-body opts)) (result '())) (if (null? body) @@ -224,10 +238,19 @@ a symbol representing the mathematical operator denoted by @var{m} (e.g., (ident (or ident (symbol->string (gensym "eq:/")))) (class #f) (options `((:div-style ,div-style) - ,@(the-options opts :ident :class :div-style))) + ,@(the-options opts :ident :div-style))) + (body (the-body opts)))) + +(define-markup (eq:* :rest opts :key (ident #f) (mul-style #f)) + ;; If no `:mul-style' is specified here, obey the top-level one. + (new markup + (markup 'eq:*) + (ident (or ident (symbol->string (gensym "eq:*")))) + (class #f) + (options `((:mul-style ,mul-style) + ,@(the-options opts :ident :mul-style))) (body (the-body opts)))) -(define-simple-markup eq:*) (define-simple-markup eq:+) (define-simple-markup eq:-) diff --git a/src/guile/skribilo/package/eq/lout.scm b/src/guile/skribilo/package/eq/lout.scm index b1ff7ae..e08e6d1 100644 --- a/src/guile/skribilo/package/eq/lout.scm +++ b/src/guile/skribilo/package/eq/lout.scm @@ -56,7 +56,7 @@ :after "\n@EndAlignedDisplays\n") (markup-writer 'eq (find-engine 'lout) - :options '(:inline? :align-with :div-style) + :options '(:inline? :align-with :div-style :mul-style) :before (lambda (node engine) (let* ((parent (ast-parent node)) (displayed? (is-markup? parent 'eq-display))) @@ -64,7 +64,7 @@ (if (and displayed? (not (*embedded-renderer*))) "\n@IAD " "")))) :action (lambda (node engine) - (display (if (markup-option node :inline?) + (display (if (inline-equation? node) "@E { " "@Eq { ")) (let ((eq (markup-body node))) @@ -73,6 +73,11 @@ :after " } }") +;; Scaled parenthesis. We could use `pmatrix' here but it precludes +;; line-breaking within equations. +(define %left-paren "{ Base @Font @VScale \"(\" }") +(define %right-paren "{ Base @Font @VScale \")\" }") + (define (div-style->lout style) (case style ((over) "over") @@ -82,6 +87,16 @@ (else (error "unsupported div style" style)))) +(define (mul-style->lout style) + (case style + ((space) "") + ((cross) "times") + ((asterisk) "*") + ((dot) "cdot") + (else + (error "unsupported mul style" style)))) + + (define-macro (simple-lout-markup-writer sym . args) (let* ((lout-name (if (null? args) (symbol->string sym) @@ -91,13 +106,11 @@ (cadr args))) (precedence (operator-precedence sym)) - ;; Note: We could use `pmatrix' here but it precludes line-breaking - ;; within equations. (open-par (if parentheses? - `(if need-paren? "{ @VScale ( }" "") + `(if need-paren? %left-paren "") "")) (close-par (if parentheses? - `(if need-paren? "{ @VScale ) }" "") + `(if need-paren? %right-paren "") ""))) `(markup-writer ',(symbol-append 'eq: sym) (find-engine 'lout) @@ -148,8 +161,18 @@ (simple-lout-markup-writer +) -(simple-lout-markup-writer * "times") (simple-lout-markup-writer - "-") + +(simple-lout-markup-writer * + (lambda (n e) + ;; Obey either the per-node `:mul-style' or the + ;; top-level one. + (or (markup-option n :mul-style) + (let* ((eq (ast-parent n)) + (mul-style + (markup-option eq :mul-style))) + (mul-style->lout mul-style))))) + (simple-lout-markup-writer / (lambda (n e) ;; Obey either the per-node `:div-style' or the @@ -175,9 +198,9 @@ (second (cadr body)) (parentheses? (equation-markup? first))) (display " { { ") - (if parentheses? (display "(")) + (if parentheses? (display %left-paren)) (output first engine) - (if parentheses? (display ")")) + (if parentheses? (display %right-paren)) (display ,(string-append " } " lout-name " { ")) (output second engine) (display " } } ")) @@ -185,15 +208,15 @@ "wrong number of arguments" body)))))) -(binary-lout-markup-writer expt "sup") -(binary-lout-markup-writer in "element") +(binary-lout-markup-writer expt "sup") +(binary-lout-markup-writer in "element") (binary-lout-markup-writer notin "notelement") (markup-writer 'eq:apply (find-engine 'lout) :action (lambda (node engine) (let ((func (car (markup-body node)))) (output func engine) - (display "(") + (display %left-paren) (let loop ((operands (cdr (markup-body node)))) (if (null? operands) #t @@ -202,7 +225,7 @@ (if (not (null? (cdr operands))) (display ", ")) (loop (cdr operands))))) - (display ")")))) + (display %right-paren)))) (markup-writer 'eq:limit (find-engine 'lout) @@ -210,24 +233,24 @@ (let ((body (markup-body node)) (var (markup-option node :var)) (limit (markup-option node :limit))) - (display "{ lim on { ") + (display "{ lim from { ") (output var engine) (display " --> ") (output limit engine) - (display " } } (") + (display (string-append " } } @VContract { " %left-paren)) (output body engine) - (display ") ")))) + (display (string-append %right-paren " } "))))) (markup-writer 'eq:combinations (find-engine 'lout) :action (lambda (node engine) (let ((of (markup-option node :of)) (among (markup-option node :among))) - (display " { matrix atleft { blpar } atright { brpar } { ") + (display " ` { matrix atleft { lpar } atright { rpar } { ") (display "row col { ") - (output among engine) - (display " } row col { ") (output of engine) - (display " } } }\n")))) + (display " } row col { ") + (output among engine) + (display " } } } `\n")))) ;;; |