;;; $Revision: 1.4 $

;;; Revised 2001 06 26 to improve the "Latex settings...: dialog
;;; Revised 2000 06 19 to handle "_" and "^" more gracefully
;;; Bug fixed on vertical axis label locations.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Describe a graph using LaTeX commands on a file                 ;;;
;;; Bret Musser, 1995, Revised S. Weisberg, 1997, 1998              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmeth graph-overlay-proto :visible () t)

(defmeth graph-overlay-proto :location-latex ()
  (let* ((ans (send self :location))
         (margin (send (send self :graph) :margin)))
    (if ans (list (- (first ans) 5)
                  (- (second (send (send self :graph) :size)) 
                  (+ (second margin)) (second ans)))
            nil)))

(defmeth graph-proto :save-as-latex (&optional (filename "tmp/a.tex")
                 &key (self-contained t)
                 (unitlength .65) (sliderwidth 100)
                 (fontsize "\\small") (symlen 3)
                 (use-color t) (verbose nil)
                 (texthtmult 3)
                 (gap 5))
  "Args: &optional (filename \"test.tex\")
       &key (self-contained t)
       (unitlength .65)
Reconstructs an image of the plot into a latex file.  If
SELF-CONTAINED is NIL, does not add latex headers which would
make the document self-enclosed.  UNITLENGTH is a latex
parameter to control the scaling.  If unit length = 1, then 1 
unit equals 1/72.27 inches."

 (let ((output (open filename :direction :output)))
  (when output
   (send self :start-latex-document output self-contained)
   (send self :initialize-latex-picture output 
               :unitlength unitlength :fontsize fontsize 
               :symlen symlen :sliderwidth sliderwidth)
   (send self :draw-axes-latex output :gap gap :texthtmult texthtmult)
   (send self :redraw-latex output :use-color use-color)
   (when (> (send self :num-points) 0)
         (send self :draw-points-latex output :use-color use-color))
   (send self :draw-lines-latex output :use-color use-color)
   (when (slot-value 'overlays)
         (mapcar #'(lambda (overlay)
          (when (send overlay :visible)
           (if verbose (format t "~a~%" overlay))
           (send overlay :redraw-latex output)))
            (slot-value 'overlays)))
   (send self :close-latex-document output self-contained)
   (close output))))

;; start:  writes a header to the file

(defmeth graph-proto :start-latex-document (output self-contained)
"Args: (OUTPUT SELF-CONTAINED)
Prints the headers to the output stream OUTPUT.  If
SELF-CONTAINED, also add the headers to make a standalone
LaTeX document."
 (let ((a (if self-contained "" "%")))
   (format output "~a\\documentclass{article}~%" a)
   (format output "~a\\usepackage{arc} %~%" a)
   (format output "~a\\begin{document}~%" a)
   (format output "~a\\pagestyle{empty}~%" a)
   (format output "% If this file is called a.tex, to create an eps file~%")
   (format output "%        latex a~%")
   (format output "%        dvips -E -o a.eps a~%")))
   
; initialize picture environment

(defmeth graph-proto :initialize-latex-picture (output 
   &key unitlength fontsize symlen sliderwidth 
   (use-fbox (match-arg :use-fbox *latex-file-defaults*)))
  "Args: (PLOT OUTPUT &key (UNITLENGTH .65) (GAP 5))
Initializes the latex picture environment (printing to the
output stream OUTPUT) for the PLOT specified.  The default
UNITLENGTH is .65pt, which controls the spacing in latex.
The GAP is 5 units (where is unit is a single UNITLENGTH)
and puts space inbetween the axes and the framing fbox."
  (let* ((textheight (+ (send self :text-ascent) (send self :text-descent)))
         (size (send self :size)))
   (format output "\\renewcommand{\\sliderwidth}{~a} % Sets slider width~%"
      sliderwidth)
   (format output "\\renewcommand{\\sliderheight}{10} % Sets slider height~%")
   (format output "\\renewcommand{\\symlen}{~a} % Plotting symbol size~%"
      symlen)
   (format output "\\setcounter{circlesize}{\\symlen+2} % Circle size~%")
   (format output "~a % set the global fontsize  ~%" fontsize)
   (format output "\\setlength{\\unitlength}{~apt} % larger = bigger content~%" 
           unitlength)
   (format output "\\settoheight{\\textht}{My}~%")
   (format output "\\thinlines~%")
;; supply a framing box.  The parameters in the picture environment define
;; the size to be reserved in the tex document and the contents of the origin
;; inside that reserved area.
   (format output "~a{\\begin{picture}(~a,~a)(0,0)% Begin picture~%"
       (if use-fbox "\\fbox" "")
       (first size) (second size))
   (format output "%\\times %  alternative font ~%")
   (format output "\\sffamily %  use sans-serif font family ~%")))

; close

(defmeth graph-proto :close-latex-document (output self-contained)
  (format output "\\end{picture}} % end of picture ~%")
  (format output "\\normalsize % restore font to normal size ~%")
  (format output "~a\\end{document}~%" (if self-contained "" "%")))

; draw-points

(defun latex-make-symbol-box (output sym color)
"Function args: (output sym color)
Writes to file output the LaTeX code necessary to to put a symbol in a
box."
  (format output 
   "\\sbox{~a}{\\color{~a}\\putsymbol{\\~anorm}\\color{black}}% make a box~%"
     "\\normbox" (string-downcase (if color color "black")) 
     (latex-assoc-sym sym)) 
  (format output 
   "\\sbox{~a}{\\color{~a}\\putsymbol{\\~asel}\\color{black}}% make a box~%"
     "\\selbox" (string-downcase (if color color "black")) 
     (latex-assoc-sym sym))) 

(defun latex-assoc-sym (sym)
"Functions args: (sym)
Converts the name of Xlisp-Stat plot symbols to LaTeX symbol names."
  (case sym
    (wedge1 'WEDGER)
    (wedge2 'WEDGEL)
    (dot1 'DOT)
    (dot2 'DOT)
    (dot3 'DOT)
    (dot4 'DOT)
    (t sym)))

(defun latex-draw-symbol 
 (output x y sym &optional missing (showing t) sel size)
"Function args: (output x y sym &optional missing showing sel size)
Outputs to file output the symbol sim at location x y in color color if
use-color is t.  The missing, showing and sel keywords are also used."
 (unless missing
  (let ((comment (if showing (int-char 32) (int-char 37))))
   (if size
    (format output "~a\\put(~a,~a){\\putsymbol{\\~a~a[~a]}}~%"
       comment x y (latex-assoc-sym sym) (if sel "sel" "norm") size)
    (format output "~a\\put(~a,~a){\\putsymbol{\\~a~a}}~%"
       comment x y (latex-assoc-sym sym) (if sel "sel" "norm"))))))
;;;
;;;
;;;

(defmeth graph-proto :draw-points-latex (output &key (use-color t))
  "Args: (PLOT OUTPUT)
Writes the visible points from the PLOT to the latex file in OUTPUT."
  (let* ((plot self)
         (size (send plot :size))
         (c (send self :content-rect))
         (o (send self :content-origin-latex))
         (showlabels (send self :showing-labels))
         (numpoints (send plot :num-points))
         (color (send self :point-color (iseq numpoints)))
         (colors (remove-duplicates color :test #'equal))
         (symbol (send self :point-symbol (iseq numpoints)))
         (symbols (remove-duplicates symbol :test #'equal)))
  (format output "\\put(~a,~a){\\begin{picture}(~a,~a)(0,0) % points~%"
          (first o) (second o) (third c) (fourth c))
  (mapcar #'(lambda (col)
   (mapcar #'(lambda (sym) 
    (let ((selection (which (mapcar #'(lambda (c s) 
                 (and (equal s sym) (equal c col))) color symbol))))
     (when selection  
      (latex-make-symbol-box output sym (if use-color col nil))
       (mapcar #'(lambda (x y missing showing sel label)
       (unless missing
        (format output "~a\\put(~a,~a){\\usebox{~a}} % draw symbol~%"
           (if showing (int-char 32) (int-char 37))
           x y (if sel "\\selbox" "\\normbox"))
        (if (and sel showlabels)
         (format output "~a\\put(~a,~a){\\makebox(0,0)[lb]{~a}} % point label~%"
           (if showing (int-char 32) (int-char 37))
           (+ x 4) (+ y 4) (stl label)))))
             (send self :point-canvas-coordinate 0 selection)
             (send self :point-canvas-coordinate 1 selection)
             (send plot :point-missing  selection)
             (send plot :point-showing selection)
             (send plot :point-selected selection)
             (send plot :point-label selection)))))
       symbols)) colors)
  (if use-color (format output "\\color{black}~%"))
  (format output "\\end{picture}} % end points~%")))

; draw-lines-latex

(defmeth graph-proto :draw-lines-latex (output &key use-color)
 (when (and (> (send self :num-lines) 0)
         (= 1 (max (if-else (send self :linestart-masked 
                (iseq (send self :num-lines))) 0 1))))
  (let* ((o (send self :content-origin-latex))
         (r (send self :content-rect))
         (w (select r 2))
         (h (select r 3))
         (numlines (send self :num-lines))
         (line-indicies (iseq numlines))
         (l-x (send self :linestart-canvas-coordinate 0 line-indicies))
         (l-y (send self :linestart-canvas-coordinate 1 line-indicies))
         (l-color (mapcar #'(lambda (a) (if (equal a 'white) nil a))
                          (send self :linestart-color line-indicies)))
         (l-mask (send self :linestart-masked line-indicies))
         (l-type (send self :linestart-type line-indicies))
         (l-next (send self :linestart-next line-indicies))
         (restart t))
 (format output "\\put(~a,~a){\\begin{picture}(~a,~a)(~a,~a) % Visible lines~%"
     (first o) (second o) w h 0 0)
  (dotimes (i numlines)
   (when (null (select l-mask i))  ; skip masked lines
     (if (null (select l-next i))  ; l-next is nil if last point on a line
         (if (= i (1- numlines))   ; this is the very last line on graph?
             (let ((ans use-color)); yes
                 (format output "(~a,~a)~%" (select l-x i) (select l-y i))
                 (if ans (format output "\\color{black} % Restore Color~%")))
             (block foo            ; no
                 (unless restart
                  (format output "(~a,~a)" (select l-x i) (select l-y i)))
                 (setf restart t)))
          (let ((x (select l-x i)) ; line segment within a line
                (y (select l-y i)))
            (if restart            ; this is the start of a line?
                (block foo
                 (if (and use-color (select l-color i))
                     (format output "\\color{~a} % Change Color"
                        (string-downcase (select l-color i))))
                 (if (eq (select l-type i) 'solid)
                     (format output "~%\\path(~a,~a)" x y)
                     (format output "~%\\dashline{10}(~a,~a)" x y))
                 (setf restart nil))
                (block bar 
                 (if (= (mod i 50) 49) (format output "~%"))
                 (format output "(~a,~a)" x y))))) ))
    (format output "\\end{picture}} % End of visible lines ~%"))))

(defmeth graph-proto :redraw-latex (output &rest args)
"In this method would go additional features of a plot not
normally drawn."
  (when (send self :has-slot 'shade-info)
        (send self :draw-shading-latex output args))
  nil)

;;; draw-axes  is a direct translation from the IVIEW C code

(defmeth graph-proto :draw-axes-latex (output &key (gap 5) (texthtmult 3))
"Args: (PLOT OUTPUT &key GAP textthtmult)
Writes the axes from the PLOT to the latex file in OUTPUT.
GAP adds a little extra space between the text and the axes."
  (let* ((plot self)
         (o (send self :content-origin-latex))
         (content-rect (send plot :content-rect))
         (left (first content-rect))
         (top (second content-rect))
         (width (third content-rect))
         (height (fourth content-rect))
         (numxticks (third (send plot :x-axis)))
         (numyticks (third (send plot :y-axis)))
         (yvaluewidth 0)
         (textheight (+ (send plot :text-ascent) (send plot :text-descent))))

    (format output "\\put(~a,~a){\\line(1,0){~a}} % horizontal axis ~%"
       (- (first o) 5) (- (second o) 5) (+ width 5))

   (unless (= (send self :num-point-variables) 1)
    (format output "\\put(~a,~a){\\line(0,1){~a}} % vertical axis ~%"
       (- (first o) 5) (- (second o) 5) (+ height 5)))

    (when (second (send plot :x-axis))
     (format output "\\setcounter{tempa}{~a-16-2*\\ratio{\\textht}{\\unitlength}}% Locate label~%" (- (second o) 5))
     (format output "\\put(~a,\\value{tempa}){\\makebox(~a,~a)[b]{~a}} % X axis label ~%"
        (first o)  width 0
        (stl (send plot :variable-label 0))))

    (when (second (send plot :y-axis))
     (format output "\\setcounter{tempb}{~a-14-2*\\ratio{\\textht}{\\unitlength}}% Locate label~%" (- (first o) 5))
     (format output
        "\\put(\\value{tempb},~a){\\makebox(0,0)[r]{\\begin{sideways}~a\\end{sideways}}} % Y label~%"
;       (- (first o) gap (* 2 textheight)) 
        (+ (second o) (/ height 2))
        (stl (send plot :variable-label 1))))

    (dotimes (i numxticks)
        (let* ((tick (+ (first o) (/ (* i width) (- numxticks 1))))
               (value (+ (first (send plot :range 0))
                         (/ (* i (abs (apply #'- (send plot :range 0))))
                         (- numxticks 1)))))
         (send self :draw-tick-latex 0 tick (second o) value output :gap gap)))

    (dotimes (i numyticks)
       (setf yvaluewidth (max yvaluewidth (send self :text-width (optfmt0
           (+ (first (send plot :range 1))
              (/ (* i (abs (apply #'- (send plot :range 1))))
                 (- numyticks 1))))))))

    (dotimes (i numyticks)
        (let* ((tick (+ (second o) (/ (* i height) (- numyticks 1))))
               (value (+ (first (send plot :range 1))
                         (/ (* i (abs (apply #'- (send plot :range 1))))
                            (- numyticks 1)))))
          (send self :draw-tick-latex 1 (+ 1 (first o)) tick value output 
               :gap gap :yvaluewidth yvaluewidth)))))

;;; draw-tick-latex is a direct translation of tierney's code
;;; from the IVIEW package

(defmeth graph-proto :draw-tick-latex (axis x y value output &key (gap 5)
  (float 5) (ticklen 4)
  (yvaluewidth (send self :text-width (optfmt0 value))))
  (let* ((plot self)
         (width yvaluewidth)
         (height (+ (send plot :text-ascent) (send plot :text-descent))))
  (if (= axis 0)
      (progn
   (format output "\\put(~a,~a){\\line(~a,~a){~a}} % X axis tick mark ~%"
      x (- y float) 0 -1 ticklen)
   (format output "\\put(~a,~a){\\makebox(0,0)[t]{~a}} % X axis tick mark label ~%"
      x (- y float ticklen 4) (optfmt0 value)))
    (progn
      (format output "\\put(~a,~a){\\line(~a,~a){~a}} % Y axis tick mark ~%" (- x float 1) y -1 0 ticklen)
      (format output "\\put(~a,~a){\\makebox(0,0)[r]{\\begin{sideways}~a\\end{sideways}}} % Y axis tick mark label ~%"
         (- x height 3) y (optfmt0 value)))))) ;<--set gap = 3 pixels
;        (- x (/ width 2) 1) y (optfmt0 value)))))) ;<--set gap = 1

(defmeth graph-proto :content-origin-latex ()
"Method args: ()
Returns the content origin in latex coordinates"
  (let* ((r (send self :content-rect))
;        (c (send self :content-origin))
         (s (send self :size)))
   (list (first r) (- (second s) (second r) (fourth r)))))

(defmeth graph-proto :content-origin-latex ()
"Method args: ()
Returns the content origin in latex coordinates"
  (let* ((c (send self :content-origin))
         (s (send self :size)))
   (list (first c) (- (second s) (second c)))))

(defmeth graph-proto :real-to-canvas-latex (x y)
  (let* ((a (send self :real-to-canvas x y)))
   (list (first a) (- (second (send self :size)) (second a)))))

;;;
;;; shading, added 97/09/17
;;;
(defmeth scatterplot-proto :draw-shading-latex (output &rest args)
"Method args: ()
Draws shaded parallelograms."
 (when (slot-value 'shade-info)
  (mapcar #'(lambda (a) (apply #'send self :shade-region-latex output a))
       (slot-value 'shade-info))))

(defmeth scatterplot-proto :shade-region-latex (output
        x lo up &optional (color 'yellow))
"THIS METHOD DOESN'T WORK VERY WELL!"
  (format output "\\color{~a} % change color for shading~%" 
     (string-downcase color))
  (mapcar #'(lambda (j)
   (let* ((ll (send self :real-to-canvas-latex (select x j) (select up j)))
          (height (/ (* (- (select lo j) (select up j))
                        (fourth (send self :content-rect)))
                     (apply #'- (reverse (send self :range 1)))))
          (width  (/ (* (- (select x (1+ j)) (select x j))
                        (third (send self :content-rect)))
                     (apply #'- (reverse (send self :range 0))))))
    (format output "\\put(~a,~a){\\rule{~a\\unitlength}{~a\\unitlength}} % Shaded region~%"
        (first ll) (second ll) width height)))
   (iseq (- (length x) 1)))
  (format output "\\color{black} % reset color~%")
  nil)

;;; histogram-proto

(defmeth histogram-proto :draw-points-latex (&rest args))

(defmeth histogram-proto :draw-axes-latex (output &key (gap 5) (texthtmult 3))
"Args: (PLOT OUTPUT &key GAP textthtmult)
Writes the axes from the PLOT to the latex file in OUTPUT.
GAP adds a little extra space between the text and the axes."
  (let* ((plot self)
         (o (send self :content-origin-latex))
         (content-rect (send plot :content-rect))
         (left (first content-rect))
         (top (second content-rect))
         (width (third content-rect))
         (height (fourth content-rect))
         (baseline (second o))
         (numxticks (third (send plot :x-axis)))
         (textheight (+ (send plot :text-ascent) (send plot :text-descent))))

    (format output "\\put(~a,~a){\\line(1,0){~a}} % horizontal axis ~%"
       (- left 5) baseline
       (+ width 5))
    (when (second (send plot :x-axis))
     (format output "\\put(~a,~a){\\makebox(0,0){~a}} % X axis label ~%"
        (+ left  (/ (+ width 10) 2))
        (- baseline gap (* texthtmult textheight)) 
        (stl (send plot :variable-label 0))))

    (dotimes (i numxticks)
        (let* ((tick (+ left (/ (* i width) (- numxticks 1))))
          (value (+ (first (send plot :range 0))
               (/ (* i (abs (apply #'- (send plot :range 0))))
             (- numxticks 1)))))
       (send self :draw-tick-latex 0 tick baseline value output 
        :ticklen 6 :float 0)))))

(defmeth histogram-proto :redraw-latex (output &rest args)
  (let* ((pts (iseq (send self :num-points)))
         (sel (which (mapcar #'(lambda (m v) (and v (null m)))
                      (send self :point-missing pts)
                      (send self :point-visible pts))))
         (d (sort-data (send self :point-coordinate 0 sel)))
         (n (length d))
         (bins (send self :num-bins))
         (range (send self :range 0))
         (bin-width (/ (- (second range) (first range)) bins))
         (bin-boundaries (+ (first range) (* (iseq 0 bins) bin-width)))
         (pos (mapcar #'(lambda (b) (let ((a (position b d :test #'<=)))
                 (if a a n))) (rest bin-boundaries)))
         (counts (- pos (combine 0 (butlast pos))))
         (content (send self :content-rect))
         (originx (first content)) 
         (originy (- (second (send self :size)) (second content)
                     (fourth content)))
         (barwidth (/ (third content) bins))
         (barheight (mapcar #'(lambda (c) (- (second
      (send self :real-to-canvas-latex 
            0 (/ c (* (length d) bin-width)))) originy)) counts)))
  (mapcar #'(lambda (j)
   (format output "\\put(~a,~a){\\framebox(~a,~a){}}%histogram bar~%"
       (+ originx (* j barwidth)) originy
       barwidth (select barheight j)))
   (iseq bins))))
                 

;;; spin-proto

(defmeth spin-proto :point-screen-coord-latex (axis points)
  (let* ((origin (send self :content-origin))
         (points-canvas (send self :point-canvas-coordinate axis points)))
    (if (= axis 0)
        (+ points-canvas (select origin axis))
        (- (select origin axis) points-canvas))))

(defmeth spin-proto :draw-axes-latex (output &key (gap 5) )
  (let* ((corigin (send self :content-origin))
         (xorig (first corigin))
         (yorig (second corigin))
         (crect (send self :content-rect))
         (size (third crect))
         (vars 3)
         (atmp (send self :transformation))
         (a (if atmp atmp (diagonal '(1 1 1))))
         (unit (/ size 2))
         (axis-fraction 0.5)
         (h (second (send self :size)))
         (x 0)
         (y 1))
    (dotimes (i vars)
        (let* ((xend (+ xorig (* (aref a x i) axis-fraction unit)))
          (yend (- yorig (* (aref a y i) axis-fraction unit))))
          (format output "\\path(~a,~a)(~a,~a) % 3d plot axis ~%"
             xorig (- h yorig) xend (- h yend))
   (format output "\\put(~a,~a){\\makebox(0,0)[l]{~a}} % 3d plot axis label~%"
             (+ xend gap) (- h yend gap) (send self :variable-label i))))))

;;;
;;; boxplot proto
;;;

(defmeth boxplot-proto :draw-axes-latex (output &rest args )
 (apply #'call-next-method output (append (list :texthtmult 3.5) args)))

;;; bug-fix, 9/26/2000
(defmeth boxplot-proto :redraw-latex (output &rest args)
  (let* ((ans (call-next-method output))
;        (g (send self :point-coordinate 0 (iseq (send self :num-points))))
         (g (send self :point-coordinate 0 (send self :points-showing)))
         (m (select (send self :range 1) 0))
         (v (sort-data (remove-duplicates g)))
         (stagger (+ 3 (send self :text-ascent) (send self :text-descent)))
         (offset (repeat 3 (length v)))
         (h (second (send self :size)))
         (category-labels (send self :category-labels)))
   (when category-labels
    (if (> (length v) 3)
        (setf (select offset (+ (* 2  (iseq (floor (/ (length v) 2)))) 1))
              (repeat stagger (length (iseq (floor (/ (length v) 2)))))))
    (mapcar #'(lambda (c v offset)
          (let* ((w (+ (send self :real-to-canvas v m) (list 0 offset))))
       (format output "\\put(~a,~a){\\makebox(0,0)[b]{~a}} % boxplot labels ~%"
          (first w) (- h 15 (second w) ) (stl c))))
      category-labels v offset))
   nil))
   
(defmeth boxplot-proto :display-anova-latex (output text)
  (let* ((s (+ (send self :text-ascent) (send self :text-descent) 3))
         (start (- (second (send self :size)) 5 (* 3 s)))
         (h (second (send self :size))))
    (when text
     (mapcar #'(lambda (text j)
          (format output "\\put(~a,~a){\\makebox(0,0)[l]{~a}} % anova text ~%"
             *plotcontrol-margin* (- h (+ start (* j s))) text))
        text (iseq 4)))))

(defmeth anova-control-proto :redraw-latex (output)
;(when (> (length (send (send self :graph) :slot-value 'category-labels)) 1)
  (call-next-method output)
  (when (send self :selected) 
        (send (send self :graph) 
                        :display-anova-latex output (slot-value 'text))))
;)


;;;
;;;  overlay methods
;;;

(defmeth graph-proto :latex-y-origin () (second (send self :size)))
(defmeth graph-proto :latex-x-origin () 0)

(defmeth graph-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph))
         (loc (send self :location-latex))
         (loc-x (first loc))
         (loc-y (second loc))
         (title (send self :title))
         (h (send graph :latex-y-origin)))
    (format output "\\put(~a,~a){\\makebox(0,0)[l]{~a}} % graph-control-proto frame-rect"
         (+ 15 loc-x) (- h (+ 14 loc-y)) title)
    (format output "\\put(~a,~a){\\framebox(~a,~a){}} % graph-control-proto box~%"
        loc-x (- h (+ 5 loc-y)) 10 10)))

(defmeth slider-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph))
         (loc (send self :location-latex))
         (popup (send self :popup))
         (loc-x (- (first loc) (if popup 14 0)))
         (loc-y (second loc))
         (index (send self :index))
         (dlen (length (send self :display))))
    (format output "\\put(~a,~a){\\putslider~a{~a}{~a}{~a}} % slider~%"
            loc-x loc-y
            (if popup "popup" "")
            (stl (send self :title))
            (stl (select (send self :display) index))
            (/ index (- dlen 1)))))
            
(defmeth symbol-button-overlay-proto :redraw-latex (output)
  (let* ((plot (send self :graph))
         (s-x (first (send self :location-latex)))
         (s-y (second (send self :location-latex)))
        ;(x-loc (+ s-x '(2  9 17 26 2  9 17 26)))
         (x-loc (+ s-x '(2 11 19 26 4 11 19 26)))
         (y-loc (- s-y -8 (+ '(-4 -4 -4 -4 4 4 4 4 4)))))
  (mapcar #'(lambda (sym x y) (latex-draw-symbol output x y sym nil t nil 2))
    (select *plot-symbols* (iseq 4 11))
    (- x-loc 1) y-loc)
  (format output "\\put(~a,~a){\\framebox(~a,~a){}} % symbol buttons~%"
    s-x s-y 30 17)))

(defmeth color-button-overlay-proto :redraw-latex (output)
  (let* ((plot (send self :graph))
         (s-x (first (send self :location-latex)))
         (s-y (second (send self :location-latex)))
         (x-loc (+ s-x 1 '(0 8 16 24 0 8 16 24)))
         (y-loc (- s-y -2 (+ '(-7 -7 -7 -7 1 1 1 1))))
         (color (send plot :draw-color)))
  (mapcar #'(lambda (color x y)
     (unless (eq color 'white)
       (format output "\\put(~a,~a){\\color{~a}\\fillrect{7}{7}\\color{black}}% Color palette~%" x y color)))
     (mapcar #'string-downcase (select *colors* (iseq 8))) x-loc y-loc)
  (format output "\\color{black}~%")
  (format output "\\put(~a,~a){\\framebox(~a,~a){}} % color buttons~%"
    s-x s-y 33 17)))

(defmeth checkbox-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph))
         (loc (send self :location-latex))
         (loc-x (first loc))
         (loc-y (second loc))
         (title (send self :title))
         (h (send graph :latex-y-origin)))
  (format output "\\put(~a,~a){\\putcheckbox~a{~a}} % Checkbox control~%"
        loc-x loc-y
        (if (slot-value 'selected) "sel" "") (stl title))))
    
(defmeth popup-menu-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph))
         (loc (send self :location-latex))
         (loc-x (first loc))
         (loc-y (second loc))
         (title (send self :title)))
     (format output "\\put(~a,~a){\\putpopupmenu{~a}} % popup menu ~%"
            loc-x loc-y title)))

(defmeth label-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph))
         (loc (send self :location-latex))
         (loc-x (first loc))
         (loc-y (second loc))
         (title (stl (send self :title))))
    (format output "\\put(~a,~a){\\makebox(0,0)[l]{~a}} % label ~%"
      loc-x loc-y (format nil "~a: ~a" (slot-value 'axis) title))))

(defmeth popup-dialog-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph))
         (loc (send self :location-latex))
         (loc-x (first loc))
         (loc-y (second loc))
         (title (send self :title)))
    (format output "\\put(~a,~a){\\putpopupdialog{~a}} % Popup dialog~%"
       loc-x  loc-y
       title)))

(defmeth text-control-proto :redraw-latex (output)
  (let* ((graph (send self :graph)))
    (when (slot-value 'text)
      (format output "\\put(~a,~a){\\makebox(0,0){~a}} % text on graph ~%"
          (* .5 (first (send graph :size)))
          (- (second (send graph :size)) 6)
          (stl (slot-value 'text))))))

(defmeth hetero-control-proto :redraw-latex (output)
  (call-next-method output)   
  (let* ((graph (send self :graph)))
    (when (slot-value 'text)
      (format output "\\put(~a,~a){\\makebox(0,0){~a}} % Hetero. score ~%"
          (* .5 (first (send graph :size)))
          (- (second (send graph :size)) 6)
          (slot-value 'text)))))

(defmeth zoom-control-proto :redraw-latex (output)
 (let* ((location (send self :location-latex))
        (loc-x (first location))
        (loc-y (second location)))
  (format output "\\put(~a,~a){\\makebox(0,0){\\putzoomcontrol}} % Zoom Control~%"
    loc-x (+ loc-y 7))))

(defmeth margin-text-proto :redraw-latex (output)
  (let ((graph (send self :graph))
        (title (send self :title)))
   (when title
      (format output "\\put(~a,~a){\\makebox(0,0){~a}} % Plot title ~%"
          (* .5 (first (send graph :size)))
          (- (second (send graph :size)) 6)
          title))))

(defun stl (str)
"Function args: (str)
Fixes a string for use with save-as-latex:  \"_\" becomes \" \";
| becomes $|$ and H^2 becomes H\^{}2 unless the the string includes
a $."
 (let* ((ans "")
        (str (string-trim " " (format nil "~a" str)))
        (n (length str))
        skip)
 (cond ((position #\$ str :test #'equal) str)
       (t (dotimes (j n)
            (cond 
             (skip (setf skip nil))
             ((equal (select str j) #\|)
              (setf ans (format nil "~a$|$" ans)))
             ((equal (select str j) #\_)
              (setf ans (format nil "~a " ans)))
             ((equal (select str j) #\%)
              (setf ans (format nil "~a\\%" ans)))
             ((equal (select str j) #\^)
              (setf ans (format nil "~a\\^{}" ans)))
             ((and (equal (select str j) #\+)
                   (equal (select str (1+ j)) #\-))
              (setf ans (format nil "~a$\\pm$" ans))
              (setf skip t))
             (t (setf ans (format nil "~a~a" ans (select str j))))))
            ans))))


(defmeth graph-proto :mark-legend-y ()
 (+ 5 (select (send self :margin) 3)
        (- (+ (send self :text-ascent) (send self :text-descent)))))
(defmeth histogram-proto :mark-legend-y () 7)
(defmeth scatmat-proto :mark-legend-y () 7)
(defmeth spin-proto :mark-legend-y () 7)

(defmeth mark-legend-proto :redraw-latex (output)
 (let* ((graph (send self :graph))
        (x0 (- *plotcontrol-margin* 5))
        (y0 (send graph :mark-legend-y))
        (title (send self :title))
        (title1 (format nil "Marked by ~a:" (stl (first title))))
        (vals (mapcar #'(lambda (a) (format nil "~a" a)) (second title)))
        (sym (mapcar #'(lambda (s) 
             (format nil "\\putsymbol{\\~anorm}" (latex-assoc-sym s)))
             (select title 4)))
        (col (select title 3))
        (n (length vals))
        (y (combine y0 (transpose (list (repeat y0 n) (+ (repeat y0 n) 4)))))
        (items (combine title1 (transpose (list vals sym))))
        (last-items (butlast
           (combine "" (format nil "~al" title1) (transpose (list 
             (mapcar #'(lambda (a o) (format nil "~a~a" a o)) 
                       vals (combine "M" (repeat "l" (1- (length vals)))))
             (repeat "l" n))))))
        (colors (combine nil (transpose (list col col)))))
 (format output "\\put(~a,~a){\\begin{picture}(~a,20) % Begin mark by~%"
         x0 y0 (third (send graph :content-rect)))
 (format output "\\setlength{\\tempc}{0pt}  % Set tempc to 0 ~%")
 (format output "\\setlength{\\markby}{0pt} % Set markby to 0 ~%")
 (mapcar #'(lambda (item color last-item y)
  (format output "\\settowidth{\\tempc}{~a} % tempc is width of last item~%" 
          last-item)
  (format output "\\addtolength{\\markby}{\\tempc} % add tempc to markby~%")
  (if color (format output "\\color{~a}~%" (string-downcase color)))
  (format output "\\put(\\markby\\unitlength,0){\\makebox(0,0)[l]{~a}}~%" 
      item)
  (if color (format output "\\color{black}~%" )))
  items colors last-items y)
 (format output "\\end{picture}}~%")))
  
(defmeth spin-control-overlay-proto :redraw-latex (output)
  (let* ((graph (slot-value 'graph))
         (top (slot-value 'top))
         (lefts (slot-value 'lefts))
         (gap (slot-value 'gap))
         (side (slot-value 'side))
         (text-base (slot-value 'text-base))
         (box-top (slot-value 'box-top))
         (h (send graph :latex-y-origin)))
    (format output "\\path(~a,~a)(~a,~a) % spin control line ~%"
        0 (- h top) (send graph :canvas-width) (- h top))
    (mapcar #'(lambda (x) (format output "\\put(~a,~a){\\framebox(~a,~a){}} % spin control box ~%"
                  x (- h text-base) side side))
            lefts)
    (mapcar #'(lambda (xval label)
     (format output "\\put(~a,~a){\\makebox(0,0)[lb]{~a}}~%"
         xval (- h text-base) label)) (+ (select lefts '(0 2 4 6)) gap side)
            '("Rock" "Pitch" "Roll" "Yaw"))))

(defmeth frame-control-proto :redraw-latex (output) )
(defmeth frame-control-proto :location () nil )

;;
;;  Scatterplot Matrix Stuff
;;

(defmeth graph-proto :latex-axis-range (axis)
  (let* ((pts (iseq (send self :num-points)))
         (v (send self :point-coordinate axis pts))
         (mask (send self :point-missing pts))
         (visible (send self :point-visible pts))
         (sel (which  (mapcar #'(lambda (m v) (and v (null m))) 
                        mask visible))))
    (range (select v sel))))

(defmeth graph-proto :latex-point-coord (axis &optional range)
"Method args: (axis)
Returns the point coordinates for axis scaled to the interval (0,1),
along with the minimum and maximum for that axis."
  (let* ((pts (iseq (send self :num-points)))
         (v (send self :point-coordinate axis pts))
         (r (if range range (send self :latex-axis-range axis)))
         (b (if (apply #'= r) 
                (/ (first r))
                (/ .90 (- (second r) (first r)))))
         (a (if (apply #'= r)
                0
                (- 0.05 (* (first r) b)))))
   (+ a (* b v))))


(defmeth graph-proto :latex-cell (output dim x y &key use-color)
"Args:  (output dim xaxis yaxis)
Creates LaTeX output to draw a dim by dim scatterplot."
  (format output "\\begin{picture}(~a,~a)(-2,-2) % Begin cell~%" dim dim)
  (format output "\\put(0,0){\\framebox(~a,~a){}}~%" (- dim 4) (- dim 4))
  (let* ((pts (iseq (send self :num-points)))
         (color (if use-color (send self :point-color pts)
                (repeat nil (send self :num-points))))
         (colors (remove-duplicates color :test #'equal))
         (symbol (send self :point-symbol pts))
         (symbols (remove-duplicates symbol :test #'equal))) 
   (mapcar #'(lambda (col)
    (mapcar #'(lambda (sym)
     (let ((selection (which (mapcar #'(lambda (c s) 
                  (and (equal s sym) (equal c col))) color symbol))))
      (when selection
       (latex-make-symbol-box output sym (if use-color col nil))
        (mapcar #'(lambda (x y missing showing sel)
        (unless missing
         (format output "~a\\put(~a,~a){\\usebox{~a}} % draw symbol~%"
            (if showing (int-char 32) (int-char 37))
            x y (if sel "\\selbox" "\\normbox"))))
               (select x selection) (select y selection)
               (send self :point-missing selection)
               (send self :point-visible selection)
               (send self :point-selected selection)))))
       symbols)) colors)
  (if use-color (format output "\\color{black}~%"))
  (format output "\\end{picture}~%")))

(defmeth scatmat-proto :draw-points-latex (&rest args))
(defmeth scatmat-proto :draw-axes-latex (&rest args))
(defmeth scatmat-proto :draw-lines-latex (&rest args))
(defmeth scatmat-proto :redraw-latex (output &key use-color)
"Method args: (output &key use-color)
Draws the whole scatterplot matrix in latex."
  (let* ((p (send self :num-point-variables))
         (size (send self :size))
         (margin (send self :margin))
         (plot-width (- (first size) (first margin) (max 6 (third margin))))
         (plot-ht (- (second size) (second margin) (fourth margin)))
         (dim (/ (min plot-width plot-ht) p)) 
         (xorigin (first margin))
         (yorigin (fourth margin))
         x y xrange)
    (dotimes (xaxis p) ;subtract 6 pixels from dim for spacing
     (setf xrange (send self :latex-axis-range xaxis))
     (setf x (* (- dim 6) (send self :latex-point-coord xaxis xrange)))
     (dotimes (yaxis p) 
      (setf y (* (- dim 6) (send self :latex-point-coord yaxis)))
        (cond ((= xaxis yaxis)
               (format output "\\put(~a,~a){\\framebox(~a,~a){~a}}~%"
                 (+ 6 xorigin (* xaxis dim))
                 (+ 2 yorigin (* yaxis dim))
                 (- dim 4) (- dim 4) (stl (send self :variable-label xaxis)))
               (format output "\\put(~a,~a){\\makebox(~a,~a)[lb]{~a}}~%"
                 (+ 6 3 xorigin (* xaxis dim))
                 (+ 2 3 yorigin (* yaxis dim))
                 (- dim 4 3) (- dim 4 3) (optfmt0 (first xrange)))
               (format output "\\put(~a,~a){\\makebox(~a,~a)[rt]{~a}}~%"
                 (+ 6 xorigin (* xaxis dim))
                 (+ 2 yorigin (* yaxis dim))
                 (- dim 4 3) (- dim 4 3) (optfmt0 (second xrange)))
               ) 
              (t (format output "\\put(~a,~a){ % Location of cell~%"
                    (+ xorigin (* xaxis dim))
                    (+ yorigin (* yaxis dim)))
                 (send self :latex-cell output dim x y :use-color use-color)
                 (format output "}~%")))))))
       
(defmeth sel-plot-control-proto :redraw-latex (&rest args))

;;;
;;;  Dialog stuff
;;;

(defmeth graph-proto :plot-controls-showing ()
  (if (null (send self :has-slot 'ovl))
      (send self :add-slot 'ovl (list nil nil)))
  (let* ((not-show (second (send self :slot-value 'ovl))))
   (if not-show nil t)))

(defmeth graph-proto :latex-size-dialog ()
  (let* ((args (latex-size-dialog)))
   (when args (apply #'send self :latex-size args))))

(defmeth graph-proto :latex-file-dialog ()
  (let* ((ans1 (send self :latex-args))
         (ans2 (if ans1 (bjm-file-dialog "Save LaTeX in..." 
                  :mode 'create))))
   (when (and ans1 ans2) (apply #'send self :latex-file ans2 ans1))))

(defmeth graph-proto :latex-size 
  (&rest args &key (plotwidth 4.5) (unitlength .65)
                   (square t) (plotcontrols nil))
  (let* ((size (send self :size))
         (width (round (* 72.27 plotwidth (/ unitlength))))
         (newsize (if square (list width width)
                             (round (* (/ width (first size)) size)))))
   (send self :add-slot 'unitlength unitlength)
   (if (and (null plotcontrols) (send self :plot-controls-showing))
       (send self :remove-plot-controls))
   (send self :add-slot 'latex-args args)
   (apply #'send self :size newsize)))

(defmeth graph-proto :latex-args ()
 (cond ((send self :has-slot 'latex-args) (slot-value 'latex-args))
       (t '(:FONTSIZE "\\small" :SELF-CONTAINED T :USE-COLOR T))))

(defmeth graph-proto :latex-file (file &rest args
  &key (unitlength .75) (plotwidth 4.5) (plotcontrols t))
  (let* ((size (copy-seq (send self :size)))
         (pc (and (null plotcontrols) (send self :plot-controls-showing)))
         (unitlength (if (send self :has-slot 'unitlength)
                         (send self :slot-value 'unitlength) .65)))
   (if pc (send self :remove-plot-controls))
;  (apply #'send self :latex-size args)
;  (send self :content-rect-latex)
    (apply #'send self :save-as-latex file :unitlength unitlength args)
    (if pc (send self :restore-plot-controls))
    (apply #'send self :size size)
    (format t "File ~a...written.~%" file)))

(defmeth graph-proto :content-rect-latex ()
  (let* ((margin (send self :margin))
         (size (send self :size))
         (ascent (send self :text-ascent))
         (descent (send self :text-descent))
         (ht (* 3 (+ ascent descent)))
         (x (select (send self :x-axis) '(0 1)))
         (y (select (send self :y-axis) '(0 1)))
         (left (cond ((and (null (first x)) (null (first y))) 0)
                     ((and (null (first x)) (first y)) (- ht -4))
                     ((and (first y) (second y)) (+ ht ascent))
                     (t ht)))
         (top (if (first x) ht 0))
         (right (if (first y) ht 0))
         (bottom (cond ((and (null (first x)) (null (first y))) 0)
                       ((and (first x) (null (first y))) (- ht 4))
                       ((and (first x) (second x)) (+ ht ascent))
                       (t ht))))
   (send self :content-rect
         (+ (first margin) left)
         (+ (second margin) top)
         (- (first size) right left (first margin) (third margin))
         (- (second size) bottom top (second margin) (fourth margin)))))

(defun size-help ()
  (message-dialog
"The plot width in inches sets the exact width of the printed plot.
The unitlength is such that 1 pixel = \\unitlength*pts.  Small values
mean smaller elements in the graph.  The other controls are self-
explanatory.")
  (latex-size-dialog))


;;;
;;; menu item
;;;

(defparameter *latex-menu-item* t)

(defmeth graph-proto :latex-menu-item ()
  (let* ((graph self)
         (item1 (send menu-item-proto :new "LaTeX settings"
           :action #'(lambda () (send self :latex-size-dialog)))) 
         (item2 (send menu-item-proto :new "Save LaTeX file..."
           :action #'(lambda () (send self :latex-file-dialog)))))
   (send (send self :menu) :append-items item1 item2)))

(defmeth graph-proto :plot-controls () 
  (let* ((margin (send self :margin))
         (left (send self :plot-control-left-margin))
         (top (+ (send self :text-descent) 1 (send self :text-ascent)))
         (n (+ margin (list left top 0 0))))
    (apply #'send self :margin n)
    (send self :add-slot 'overlay-loc (list *plotcontrol-margin* top))
    (apply #'send self :size (+ (send self :size) (list left top)))
    (when *latex-menu-item* (send self :latex-menu-item))
    (send self :toggle-plot-controls)
    (send self :default-size)))

(defparameter *latex-file-defaults* 
   (list :plotwidth 4.5 :unitlength .65
         :square nil :plotcontrols t
	 :use-color t :self-contained t
	 :use-fbox t
	 :fontsize "\\small"))

(defun match-arg (arg arg-list)
"Function args: (arg arg-list)
arg-list is a list of the form (list :a value1 :b value2).  arg is of the
form :a or :b.  If the arg exists in arg-list, the corresponding value is
returned."
  (let* ((pos (position arg arg-list)))
   (if pos (select arg-list (1+ pos)) nil)))

(defun latex-size-dialog ()
"Function args: ()
LaTeX options dialog."
  (let* ((plotwidth (match-arg :plotwidth *latex-file-defaults*))
         (unitlength (match-arg :unitlength *latex-file-defaults*))
	 (square (match-arg :square *latex-file-defaults*))
	 (plotcontrols (match-arg :plotcontrols *latex-file-defaults*))
         (use-color (match-arg :use-color *latex-file-defaults*))
         (use-fbox (match-arg :use-fbox *latex-file-defaults*))
	 (self-contained (match-arg :self-contained *latex-file-defaults*))
         (fontsize (position (match-arg :fontsize *latex-file-defaults*)
                  '("\\tiny" "\\small" "\\large") :test #'equal))
         (title (send text-item-proto :new
                             "Settings for LaTeX file"))
         (unitlength-l (send edit-text-item-proto :new 
                             (format nil "~a" unitlength)
                             :text-length 10))
         (unitlength-n (send text-item-proto :new "Unit length (pts)"))
         (plotwidth-l (send edit-text-item-proto :new 
                            (format nil "~a" plotwidth) :text-length 10))
         (plotwidth-n (send text-item-proto :new "Plot width (in)"))
         (square (send toggle-item-proto :new "Make plot square" 
	                 :value square))
         (fbox (send toggle-item-proto :new "Add framing box" 
	                 :value use-fbox))
         (rempc (send toggle-item-proto :new "Remove Plot Controls" 
                          :value (null plotcontrols)))
         (fontsize-l (send choice-item-proto :new 
            (list "Small text" "Normal text" "Large text") :value 1))
         (selfcontained-n (send toggle-item-proto :new "Stand-alone file" 
                            :value self-contained))
         (use-color-n (send toggle-item-proto :new "Use color" 
                            :value use-color))
         (get-answer #'(lambda () 
	   (let ((ans (list 
                 :unitlength   (send unitlength-l :value)
                 :plotwidth    (send plotwidth-l  :value)
                 :square       (send square :value)
                 :use-fbox     (send fbox :value)
                 :plotcontrols (null (send rempc :value))
                 :fontsize (select '("\\tiny" "\\small" 
                      "\\large") (send fontsize-l :value))
                 :self-contained (send selfcontained-n :value)
                 :use-color (send use-color-n :value))))
	     (defparameter *latex-file-defaults* ans)
	     ans)))
         (cancel (send modal-button-proto :new "Cancel"))
         (help  (send modal-button-proto :new "Help" :action #'size-help))
         (done (send modal-button-proto :new "OK" :action 
                     #'(lambda () (funcall get-answer))))
         (dialog (send modal-dialog-proto :new
                       (list (list title)
                             (list (list plotwidth-n
                                   unitlength-n
                                   square
                                   rempc use-color-n selfcontained-n
				   fbox
                                   fontsize-l)
                                   (list plotwidth-l
                                         unitlength-l))
                             (list done cancel help)))))
        (send dialog :default-button done)
        (send dialog :modal-dialog) ))