(declare (standard-bindings) (extended-bindings) (block))
;;; Some code to generate TeX output. Hopefully useful for debugging.
;;; Texdraw is a system for drawing diagrams inside tex. ->texdraw
;;; returns a drawing command, which I define as follows:
;;; 1. a string, or 2. a number, or 3. a list of drawing commands.
;;; This is output easily with with texdraw-out; see below
(define-generic (->texdraw (p))
(if (Point? p)
;; This just outputs the coordinates of a point in texdraw format: (x y)
;; It works for either representation of a Point.
(list "(" (printable (Point-x p)) #\space (printable (Point-y p)) ")")
(error "->texdraw is not defined on this object " p)))
;;; This prints a number with (exactly) three decimal places. No
;;; exponential notation, etc.
(define (printable x)
(let ((thousand-x (inexact->exact (round (* 1000.0 x)))))
(let ((abs-x (abs thousand-x))
(sign (negative? thousand-x)))
(let ((fraction (modulo abs-x 1000))
(integral (quotient abs-x 1000)))
(let ((fraction-string (number->string fraction)))
(list (if sign "-" "") integral "." (make-string (- 3 (string-length fraction-string)) #\0) fraction-string))))))
;;; the texdraw commands to draw an edge
(define-method (->texdraw (e Edge))
(list "\\move " (->texdraw (Vertex-point (Edge-vertex-1 e))) "\n"
"\\lvec " (->texdraw (Vertex-point (Edge-vertex-2 e))) "\n"))
(define-method (->texdraw (e Curved-edge))
(let ((parameterization (Curved-edge-parametrization e)))
(do ((i 0 (+ i 1))
(result
(list "\\move " (->texdraw (parameterization 0.)) "\n")
(cons (list "\\lvec " (->texdraw (parameterization (* (exact->inexact i) 0.25))) "\n")
result)))
((= i 5) result))))
;; goto location and output some text
(define (texdraw-text text location) ; for now, location is a point
(list "\\htext" (->texdraw location) " {" text "}\n"))
;;; this draws a triangulation and labels the vertices of each edge
(define (Triangulation-edges->texdraw t)
(let ((drawing-commands '()))
(define (add-to-drawing-commands x)
(set! drawing-commands (cons x drawing-commands)))
(Triangulation-for-each-edge (lambda (e)
(let ((point-1 (Vertex-point (Edge-vertex-1 e)))
(point-2 (Vertex-point (Edge-vertex-2 e))))
;; draw the edge
(add-to-drawing-commands (->texdraw e))
;; put labels for the vertices near each vertex
'(add-to-drawing-commands
(texdraw-text 1 (Point-add point-1
(Point-scale 0.25
(Point-subtract point-2 point-1)))))
'(add-to-drawing-commands
(texdraw-text 2 (Point-add point-2
(Point-scale 0.25 (Point-subtract point-1 point-2)))))))
t)
drawing-commands))
;;; this draws a triangulation and optionally labels the vertices and edges of each triangle
;;; (so label-vertices? is a misnomer; it should be something like just label?)
(define (Triangulation-triangles->texdraw t #!optional (label-vertices? #t))
(let ((drawing-commands '()))
(define (add-to-drawing-commands x)
(set! drawing-commands (cons x drawing-commands)))
(Triangulation-for-each-triangle (lambda (t)
(let ((point-1 (Vertex-point (Triangle-vertex-1 t)))
(point-2 (Vertex-point (Triangle-vertex-2 t)))
(point-3 (Vertex-point (Triangle-vertex-3 t)))
(edge-1 (Triangle-edge-1 t))
(edge-2 (Triangle-edge-2 t))
(edge-3 (Triangle-edge-3 t)))
;; draw the edges of a triangle
(Triangle-for-each-edge (lambda (e)
(add-to-drawing-commands (->texdraw e)))
t)
(if label-vertices?
(begin
;; label each vertex by moving 1/4 of the way from the vertex to the
;; midpoint of the opposite side
(for-each (lambda (corner noncorner-1 noncorner-2 text)
(add-to-drawing-commands
(texdraw-text text (let ((midpoint (Point-scale 0.5
(Point-add noncorner-1
noncorner-2))))
(Point-add corner
(Point-scale 0.25
(Point-subtract midpoint
corner)))))))
(list point-1 point-2 point-3)
(list point-2 point-3 point-1)
(list point-3 point-1 point-2)
'(1 2 3))
;; label each edge by moving 1/8 the way from the midpoint of the edge
;; to the opposite vertex
(for-each (lambda (edge corner text)
(add-to-drawing-commands
(texdraw-text text (let ((midpoint (Point-scale 0.5
(Point-add (Vertex-point (Edge-vertex-1 edge))
(Vertex-point (Edge-vertex-2 edge))))))
(Point-add midpoint (Point-scale 0.125
(Point-subtract corner midpoint)))))))
(list edge-1 edge-2 edge-3)
(list point-3 point-1 point-2)
'(a b c))))))
t)
drawing-commands))
(define (draw-triangulation-debug-diagram t name)
(with-output-to-file name
(lambda ()
(define (texdraw-out o)
(if (list? o)
(for-each texdraw-out o)
(display o)))
;; I don't know why I just used the maximum values of x and y to
;; scale the figure? Did i assume that everything was in the
;; first quadrant?
(let ((max-x (apply max (map (lambda (v)
(Point-x (Vertex-point v)))
(Triangulation-vertices->list (Triangulation-vertices t)))))
(min-x (apply min (map (lambda (v)
(Point-x (Vertex-point v)))
(Triangulation-vertices->list (Triangulation-vertices t)))))
(max-y (apply max (map (lambda (v)
(Point-y (Vertex-point v)))
(Triangulation-vertices->list (Triangulation-vertices t)))))
(min-y (apply min (map (lambda (v)
(Point-y (Vertex-point v)))
(Triangulation-vertices->list (Triangulation-vertices t))))))
(let ((scale (/ 4.0 (max (- max-x min-x) (- max-y min-y)))))
;; the heading of an amstex document, magstep1 (magnified 20%) using
;; imappt as the style file.
(texdraw-out (list "\\magnification=\\magstep1\n"
"\\input amstex\n"
"\\documentstyle{imappt}\n"
"\\input texdraw\n"
"\\document\n"))
;; draw the triangles
(texdraw-out (list "\\centertexdraw{\n\\setunitscale " scale "\n"))
(texdraw-out (Triangulation-triangles->texdraw t))
(texdraw-out (list "}\n\\centertexdraw{\n\\setunitscale " scale "\n"))
(texdraw-out (Triangulation-edges->texdraw t))
(texdraw-out (list "}\n"
"\\enddocument")))))))
;;; based on the previous routine, but doesn't seem to quite work yet.
(define (draw-linear-finite-element-vector-debug-diagram v name)
(with-output-to-file name
(lambda ()
(define (texdraw-out o)
(if (list? o)
(for-each texdraw-out o)
(display o)))
(let ((t (Finite-element-space-triangulation (Linear-finite-element-vector-space v)))
(data (Linear-finite-element-vector-data v)))
(let ((max-x (apply max (map (lambda (v)
(Point-x (Vertex-point v)))
(Triangulation-vertices->list (Triangulation-vertices t)))))
(max-y (apply max (map (lambda (v)
(Point-y (Vertex-point v)))
(Triangulation-vertices->list (Triangulation-vertices t))))))
(let ((scale (/ 4.0 (max max-x max-y))))
(texdraw-out (list "\\magnification=\\magstep1\n"
"\\input amstex\n"
"\\documentstyle{imappt}\n"
"\\input texdraw\n"
"\\document\n"))
(texdraw-out (list "\\centertexdraw{\n\\setunitscale " scale "\n"))
(texdraw-out (Triangulation-triangles->texdraw t #f))
(let ((drawing-commands '()))
(define (add-to-drawing-commands x)
(set! drawing-commands (cons x drawing-commands)))
(Triangulation-for-each-vertex (lambda (v)
(let ((index (Vertex-index v)))
(add-to-drawing-commands (texdraw-text (printable (f64vector-ref data index))
(Vertex-point v)))))
t)
(texdraw-out drawing-commands))
(texdraw-out (list "}\n"
"\\enddocument"))))))))