« HTML + CSS で数式組版 (その14) | トップページ | HTML + CSS で数式組版 (その16) »

2009年3月29日 (日)

HTML + CSS で数式組版 (その15)

CSS の出力部分を作成します。

(defun gen-css-props (root ast)
  (let ((hs (get-elem-heights ast)))
    (gen-css-props1 root ast hs)))

(defun gen-css-props1 (root ast hs)
  (let ((mh (max-velem-n-height hs)))
    (gen-css-props2 root ast nil hs mh)))

(defun gen-css-props2 (root ast rest? hs mh)
  (cond ((atom ast) nil)
        ((atom (car ast))
         (let ((c1 (car ast))
               (c2 (cadr ast))
               (c3 (caddr ast)))
           (cond ((or (eq c1 'text) (eq c1 'argend)) nil)
                 ((eq c1 'frac)
                  (cons
                   (list (make-css-name root c1 c2)
                         (list 'float "left")
                         (list 'position "relative")
                         (list
                          'top
                          (format nil "~Aem"
                                  (* (- mh (cadr (caddr hs))) 1.1))))
                   (gen-frac-props root c3 hs)))
                 (t (cons
                     (list (make-css-name root c1 c2))
                     (gen-css-props1 root c3 hs))))))
        ((atom (caar ast))
         (let ((c1 (caar ast))
               (c2 (cadar ast)))
           (if (and (eq c1 'text) (not rest?))
               (cons
                (list (make-css-name root "b" c2)
                      (list 'padding-left "0.2em")
                      (list 'padding-right "0.2em")
                      (list 'float "left")
                      (list 'position "relative")
                      (list 'top (format nil "~Aem" (* mh 0.8))))
                (gen-css-props2 root (cdr ast) t (cdr hs) mh))
             (append (gen-css-props2 root (car ast) nil (car hs) mh)
                     (gen-css-props2 root (cdr ast) nil (cdr hs) mh)))))))

(defun gen-frac-props (root ast hs)
  (defun frac-arg (arg h pfn)
    (let ((c1 (car arg))
          (c2 (cadr arg))
          (c3 (caddr arg)))
      (cons
       (append
        (list (make-css-name root c1 c2)
              (list 'clear "left"))
        (funcall pfn))
       (gen-css-props1 root c3 h))))
  (let ((num (car ast))
        (den (cadr ast)))
    (append
     (frac-arg
      num
      (caddr (caddr hs))
      (lambda () nil))
     (frac-arg
      den
      (caddr (cadddr hs))
      (lambda ()
        (list (list 'border-top "solid 1pt")))))))

(defun output-css-classes (classes stm)
  (mapc
   (lambda (class)
     (let ((cn (car class))
           (ps (cdr class)))
       (format stm "~A {~%" cn)
       (mapc
        (lambda (p)
          (let ((n (car p))
                (v (cadr p)))
            (format stm "~A: ~A;~%" n v)))
        ps)
       (format stm "}~%")))
   classes))

(defun css-props-string (props)
  (with-output-to-string (out)
    (format out "~%")
    (output-css-classes props out)))

(defun math2html (str)
  (let ((ast (parse-string str 0)))
    (let ((elem
           `(html
             ((head
               ((style
                 (type "text/css")
                 (text
                  ,(css-props-string
                    (gen-css-props "math" ast))))))
              (body
               ((div (class "math")
                     ,(gen-html-elem ast))))))
           )
          (b (get-buffer-create *buffer-name*)))
      (erase-buffer b)
      (with-open-stream (stm (make-buffer-stream b))
        (output-html elem stm))
      b)))

|

« HTML + CSS で数式組版 (その14) | トップページ | HTML + CSS で数式組版 (その16) »

コメント

コメントを書く



(ウェブ上には掲載しません)


コメントは記事投稿者が公開するまで表示されません。



トラックバック

この記事のトラックバックURL:
http://app.f.cocolog-nifty.com/t/trackback/80472/28860147

この記事へのトラックバック一覧です: HTML + CSS で数式組版 (その15):

« HTML + CSS で数式組版 (その14) | トップページ | HTML + CSS で数式組版 (その16) »