;;; Beta quality code - use at own risk
;;; Copyright (C) 2010 Anders Waldenborg
;;; I'll add a GPL header or something like that here later...
; We handle the tranformation matrix (but let svg do the actual projection).
; So we need some stuff to handle matrices...
(defconst vrend-2pi (* 8.0 (atan 1.0)))
(defun vrend--mtx-col (mtx col)
"Get column col in matrix mtx"
(mapcar '(lambda (v) (aref v col)) mtx))
(defun vrend--mtx-row (mtx row)
"Get row row in matrix mtx"
(mapcar 'identity (aref mtx row)))
(defun vrend--mtx-ref (i j)
(aref (aref vrend--curr-mtx i) j))
(defun vrend--dotprod (l r)
"dot product of l and r"
(if (or l r)
(+ (* (car l) (car r)) (vrend--dotprod (cdr l) (cdr r)))
0))
(defun vrend--mtx-mul3x3 (l r)
`[[,(vrend--dotprod (vrend--mtx-row l 0) (vrend--mtx-col r 0)) ,(vrend--dotprod (vrend--mtx-row l 0) (vrend--mtx-col r 1)) ,(vrend--dotprod (vrend--mtx-row l 0) (vrend--mtx-col r 2))]
[,(vrend--dotprod (vrend--mtx-row l 1) (vrend--mtx-col r 0)) ,(vrend--dotprod (vrend--mtx-row l 1) (vrend--mtx-col r 1)) ,(vrend--dotprod (vrend--mtx-row l 1) (vrend--mtx-col r 2))]
[,(vrend--dotprod (vrend--mtx-row l 2) (vrend--mtx-col r 0)) ,(vrend--dotprod (vrend--mtx-row l 2) (vrend--mtx-col r 1)) ,(vrend--dotprod (vrend--mtx-row l 2) (vrend--mtx-col r 2))]])
(defun vrend--mtx-translate (dx dy)
"translationmatrix for dx dy"
`[[1.0 0.0 ,dx]
[0.0 1.0 ,dy]
[0.0 0.0 1.0]])
(defun vrend--mtx-rotate (rot)
""
`[[,(cos rot) ,(- (sin rot)) 0.0]
[,(sin rot) ,(cos rot) 0.0]
[ 0.0 0.0 1.0]])
(defun vrend--mtx-scale (sx sy)
""
`[[,sx 0.0 0.0]
[0.0 ,sy 0.0]
[0.0 0.0 1.0]])
(defun vrend--mtx-ident ()
""
[[1.0 0.0 0.0]
[0.0 1.0 0.0]
[0.0 0.0 1.0]])
(defun vrend-path-start (x y)
(setq vrend--curr-path nil)
(vrend-path-moveto x y))
(defun vrend-path-moveto (x y)
(add-to-list 'vrend--curr-path (list ?M x y)))
(defun vrend-path-lineto (x y)
(add-to-list 'vrend--curr-path (list ?L x y)))
(defun vrend-path-close ()
(add-to-list 'vrend--curr-path (list ?Z)))
(defun vrend-rotate (deg)
(setq vrend--curr-mtx (vrend--mtx-mul3x3 vrend--curr-mtx (vrend--mtx-rotate deg))))
(defun vrend-scale (sx sy)
(setq vrend--curr-mtx (vrend--mtx-mul3x3 vrend--curr-mtx (vrend--mtx-scale (float sx) (float sy)))))
(defun vrend-translate (dx dy)
(setq vrend--curr-mtx (vrend--mtx-mul3x3 vrend--curr-mtx (vrend--mtx-translate (float dx) (float dy)))))
(defun vrend--render-path-element (e)
(format "%c %s" (car e) (mapconcat '(lambda (x) (format "%f" x)) (cdr e) " ")))
(defun vrend--render-path ()
(insert " d=\"" (mapconcat 'vrend--render-path-element (reverse vrend--curr-path) " ") "\""))
(defun vrend--render-transform ()
(insert (format " transform=\"matrix(%f %f %f %f %f %f)\"" (vrend--mtx-ref 0 0) (vrend--mtx-ref 1 0) (vrend--mtx-ref 0 1) (vrend--mtx-ref 1 1) (vrend--mtx-ref 0 2) (vrend--mtx-ref 1 2))))
(defun vrend-path-stroke ()
(insert " \n"))
(defmacro vrend-with-saved-matrix (&rest body)
(declare (indent 0) (debug t))
`(let ((vrend-with-saved-matrix-saved-matrix vrend--curr-mtx))
(progn
,@body
(setq vrend--curr-mtx vrend-with-saved-matrix-saved-matrix))))
(defmacro vrend (width height coordinatetype &rest body)
(declare (indent 3) (debug t))
(let ((width (eval width))
(height (eval height)))
`(with-temp-buffer
(set (make-local-variable 'vrend--curr-mtx) (vrend--mtx-ident))
(set (make-local-variable 'vrend--curr-path) nil)
(set (make-local-variable 'vrend--curr-strokestyle) '("black" :width 1))
(set (make-local-variable 'vrend--curr-fillstyle) nil)
(insert "\n"
"\n"
(format "\n")
(create-image (buffer-string) nil t)
)))
(provide 'vrend)