;;; Second version of my racetrack-plotting code. This version creates more readable plots, and
;;; it calls gnuplot to do them directly, so you don't have to call gnuplot afterward. It runs
;;; fine with Allegro Common Lisp on a Mac, and should work with Allegro on most other variants
;;; of unix (e.g., Linux and the solaris machines), if you have gnuplot installed.
;;; But I don't know whether it will work with other Lisps or on Windows machines.
;;; -- Dana Nau, May 11, 2010.

;;; This time, the default output type is png rather than gif.

;;; Each racetrack is an instance of the following structure.
(defstruct (track)
  name
  boundary
  start
  finish
  path)

(defvar *gnuplot-stream*)		; stream of commands from this program to gnuplot

(defvar *verbose* nil)			; for debugging

;;; ------------------------------------------------------------------------
;;; (PLOT-RACETRACK &KEY TRACKS TYPE PREFIX) uses gnuplot to create
;;; racetrack images.  Every argument is an optional keyword argument.
;;;
;;; TRACKS is either a single racetrack or a list of racetracks. It defaults
;;; to the global *RACETRACKS* list.
;;;
;;; TYPE is what to use as gnuplot's output format. It defaults to "png", which tells
;;; gnuplot to create a png image. If you want something else, you can use anything
;;; that gnuplot will take as an argument to its "terminal" command.
;;;
;;; PREFIX, which defaults to "track", is the filename prefix for gnuplot's output file.
;;; If TRACKS is a single racetrack, the image will go into a file named PREFIX.TYPE
;;; (e.g., "track.png"). If TRACKS is a list of racetracks, the i'th image will go
;;; into a file named PREFIX-i.TYPE (e.g., "tracks-1.png", "tracks-2.png", etc.).
;;; ------------------------------------------------------------------------
(require :osi)
(use-package :excl.osi)

(defun plot-racetrack (&key (racetracks *racetracks*) (type "png") (prefix "track"))
  (let (filename)
    (if (track-p racetracks)
	(with-command-io
	 ("gnuplot")
	 (:input (*gnuplot-stream*)
		 (setq filename (format nil "~a.~a" prefix type))
		 (plot-single-racetrack filename type racetracks)))
      (with-command-io
       ("gnuplot")
       (:input (*gnuplot-stream*)
	       (loop for r in racetracks
		     for i from 1 by 1
		     do
		     (setq filename (format nil "~a-~a.~a" prefix i type))
		     (plot-single-racetrack filename type r)))))))

(defun send-gnuplot (&rest args)
  (if *verbose*
      (apply #'format t args))
  (apply #'format *gnuplot-stream* args))

;;; PLOT-SINGLE-RACETRACK tells gnuplot to put an plot RACETRACK as an image of type TYPE
;;; and put the output into a file named FILENAME
(defun plot-single-racetrack (filename type racetrack)
  (let ((trackname (track-name racetrack))
	(boundary (track-boundary racetrack))
	(start (track-start racetrack))
	(finish (track-finish racetrack))
	(path (track-path racetrack)))
   (send-gnuplot "# gnuplot commands to plot racetrack ~s" trackname)
   (send-gnuplot "~%set xtics 1; set ytics 1; set border 0; set nokey")
   (send-gnuplot "~%set grid")
   ;; Improve the aspect ratio. It still isn't 1-to-1, but I don't know how to get that
   (send-gnuplot "~%set size square")
   (send-gnuplot "~%set autoscale")
   (send-gnuplot "~%set title ~s" trackname)
   (send-gnuplot "~%set terminal ~a; set output \"~a\"" type filename)
   
   ;; if there's a finish line, generate gnuplot code for it
   (cond (finish (send-gnuplot "~%# draw the finish line as a double-headed arrow")
		 (let ((p1 (first finish))
		       (p2 (second finish)))
		   (send-gnuplot "~%set arrow 1 lw 2 from ~a,~a to ~a,~a"
			   (first p1) (second p1) (first p2) (second p2))
		   (send-gnuplot "~%set arrow 2 lw 2 from ~a,~a to ~a,~a"
			   (first p2) (second p2) (first p1) (second p1)))))
   
   ;; generate the plot command to draw the boundary from inline data
   (send-gnuplot "~%plot '-' with lines lt 1 lw 2")
   ;; if there's a starting point or path, add them to the plot command
   (if finish (send-gnuplot ", '-' pt 5"))
   (if path (send-gnuplot ", '-' with linespoints 2"))
   
   ;; write inline data for the boundary
   (send-gnuplot "~%# draw the boundary")
   (dolist (edge boundary)
     (let ((p1 (first edge))
	   (p2 (second edge)))
       (send-gnuplot "~%~f ~f~%~f ~f~%"
	       (first p1) (second p1) (first p2) (second p2))))
   (send-gnuplot "e~%")		; tell gnuplot the inline data is finished
   ;; write inline data for the starting-point data, if there is one
   (cond (start (send-gnuplot "~%# plot the racecar's starting point")	    
		(let* ((p1 (first start))
		       (x (first p1))
		       (y (second p1)))
		  (if (not (and (integerp x) (integerp y)))
		      (format t "~%Warning: starting location ~s doesn't consist of integers" p1))
		  (send-gnuplot "~%~f ~f~%" x y))
		(send-gnuplot "e~%")))	; tell gnuplot the inline data is finished
   ;; write inline data for the racecar path, if there is one
   (cond (path
	  (send-gnuplot "~%# draw the racecar's path")
	  (dolist (state path)
	    (let* ((loc (first state))
		   (x (first loc))
		   (y (second loc))
		   (velocity (second state))
		   (v (first velocity))
		   (w (second velocity)))
	      (if (not (and (integerp x) (integerp y) (integerp v) (integerp w)))
		  (format t "~%Warning: state ~s doesn't consist of integers" state))		    
	      ;; the racecar went to (x,y) at velocity (u,v), so it came from (x-u, y-v)
	      (send-gnuplot "~%~f ~f~%~f ~f~%" (- x v) (- y w) x y)))
	  (send-gnuplot "e~%")))	; tell gnuplot the inline data is finished
   (format t "The plot of ~s will be in file ~s~%" trackname filename)))


;;; ------------------------------------------------------------------------
;;; Test suite
;;; ------------------------------------------------------------------------


(defvar *racetracks*)

(setq *racetracks* nil)

(push (make-track			; constructed by hand
       :name "Simple rectangular track"
       :boundary
       '(((0 0) (10 0)) ((10 0) (10 6)) ((10 6) (0 6)) ((0 6) (0 0)))
       :start '((2 2) (0 0))
       :finish '((8 1) (8 4)))
      *racetracks*)

(push (make-track			; constructed by hand
       :name "Simple L-shaped track"
       :boundary
       '(((0 0) (10 0)) ((10 0) (10 10)) ((10 10) (5 10)) ((5 10) (5 5)) ((5 5) (0 5)) ((0 5) (0 0)))
       :start '((2 2) (0 0))
       :finish '((9 8) (6 8)))
      *racetracks*)

(push (make-track			; constructed by hand
       :name "Simple U-shaped track"
       :boundary
       '(((0 0) (10 0)) ((10 0) (10 10)) ((10 10) (0 10)) ((0 10) (0 6)) ((0 6) (6 6)) ((6 6) (6 4))
	 ((6 4) (0 4)) ((0 4) (0 0)))
       :start '((2 2) (0 0))
       :finish '((2 10) (2 6)))
      *racetracks*)

(push (make-track			; constructed by hand
       :name "Simple circular track"
       :boundary
       '(((0 0) (10 0)) ((10 0) (10 10)) ((10 10) (0 10)) ((0 10) (0 0))
	 ((4 4) (6 4)) ((6 4) (6 6)) ((6 6) (4 6)) ((4 6) (4 4)) ((0 5) (5 5))
	 ((6 4) (0 4)) ((0 4) (0 0)))
       :start '((3 3) (0 0))
       :finish '((0 6) (4 6)))
      *racetracks*)


(push (make-track ; image26.gif closed
	      :name "closed P-shaped track"
	      :boundary
	      '(((2 2) (2 25)) ((2 2) (25 2))
		((45/10 4) (45/10 95/10))
		((45/10 4) (12 4))
		((12 4) (12 65/10))
		((45/10 95/10) (115/10 95/10))
		((115/10 95/10) (115/10 13))
		((5 13) (115/10 13))
		((5 13) (5 23))
		((5 23) (85/10 23))
		((85/10 23) (85/10 16))
		((85/10 16) (15 16))
		((15 16) (15 65/10))
		((75/10 65/10) (15 65/10)))
	      :start
	      '((6 6) (0 0))
	      :finish
	      '((55/10 22) (8 22)))
      *racetracks*)

(push (make-track			; track43.jpg
       :name "Tee-shaped track"
       :boundary
       '(((15/10 85/10) (85/10 14)) ((85/10 14) (105/10 12)) ((55/10 75/10) (105/10 12)) ((55/10 75/10) (6 6))
	 ((6 6) (95/10 6)) ((95/10 6) (125/10 85/10)) ((10 15) (125/10 85/10)) ((10 15) (115/10 165/10))
	 ((115/10 165/10) (15 14)) ((15 14) (185/10 145/10)) ((185/10 145/10) (205/10 175/10))
	 ((205/10 175/10) (225/10 175/10)) ((225/10 175/10) (245/10 15)) ((105/10 25/10) (245/10 15))
	 ((65/10 2) (105/10 25/10)) ((2 6) (65/10 2)) ((15/10 85/10) (2 6)))	      
       :start '((11 14) (0 0))
       :finish '((75/10 125/10) (9 11)))
      *racetracks*)

(push (make-track		 ; project2 example; given to students
       :name "Example in project2 description"
       :boundary
       '(((41/10 0) (14 0)) ((18 14) (14 18)) ((0 14) (0 4)) ((0 10) (4 10)) ((11 5) (11 10))
	 ((14 14) (41/10 14)) ((14 0) (18 39/10)) ((18 39/10) (18 14)) ((14 18)(42/10 18))
	 ((42/10 18) (0 14)) ((0 4) (41/10 0)) ((4 10) (4 5)) ((4 5) (14 5)) ((11 10) (9 11))
	 ((14 5) (14 14)) ((41/10 14) (8 7)))
       :start '((1 8) (0 0))
       :finish '((11 9) (14 9)))
      *racetracks*)

(push (make-track			; maze.gif; given to students
       :name "Maze racetrack from students' test data"
       :boundary
       '(((0 0) (32 0)) ((0 2) (30 2)) ((0 4) (10 4)) ((12 4) (30 4))
	 ((2 6) (6 6)) ((8 6) (18 6)) ((20 6) (30 6))
	 ((2 8) (12 8)) ((14 8) (30 8)) ((0 10) (6 10)) ((8 10) (30 10))
	 ((2 12) (32 12)) ((2 14) (10 14)) ((12 14) (30 14))
	 ((0 16) (26 16)) ((28 16) (30 16)) ((0 18) (4 18)) ((6 18) (28 18))
	 ((0 20) (10 20)) ((12 20) (30 20)) ((0 22) (8 22)) ((10 22) (16 22)) ((18 22) (32 22))
	 ((2 24) (12 24)) ((14 24) (24 24)) ((26 24) (32 24)) ((2 26) (10 26)) ((12 26) (32 26))
	 ((2 28) (10 28)) ((12 28) (20 28)) ((22 28) (30 28))
	 ((2 30) (10 30)) ((12 30) (26 30)) ((28 30) (32 30))
	 ((0 32) (32 32)) ((0 0) (0 32)) ((2 24) (2 26)) ((2 28) (2 30))
	 ((6 6) (6 8)) ((6 12) (6 14)) ((10 18) (10 20)) ((10 26) (10 28))
	 ((12 4) (12 6)) ((12 12) (12 14)) ((12 22) (12 24)) ((12 26) (12 28))
	 ((14 22) (14 24)) ((16 0) (16 2)) ((16 6) (16 8)) ((26 26) (26 30))
	 ((30 2) (30 4)) ((30 6) (30 8)) ((30 14) (30 20)) ((32 0) (32 32)))
       :start '((3 31) (0 0))
       :finish '((18 0) (18 2)))
      *racetracks*)

(push (make-track			; watkins glen; given to students
       :name "Watkins Glen track"
       :boundary 
       '(
	 ;; outer circuit
	 ((05/10 7) (13 23)) ((13 23) (195/10 18)) ((195/10 18) (26 225/10)) ((26 225/10) (16 26))
	 ((16 26) (285/10 39)) ((285/10 39) (335/10 39)) ((335/10 39) (34 345/10)) ((285/10 29) (34 345/10))
	 ((285/10 29) (295/10 28)) ((295/10 28) (365/10 29)) ((365/10 29) (395/10 27)) ((395/10 27) (405/10 25))
	 ((395/10 22) (405/10 25)) ((225/10 4) (395/10 22)) ((145/10 4) (225/10 4)) ((10 05/10) (145/10 4))
	 ((05/10 7) (10 05/10))
	 ;; bump
	 ((365/10 185/10) (365/10 20)) ((365/10 20) (375/10 21)) ((375/10 21) (385/10 21))
	 ;; inner circuit
	 ((4 7) (9 35/10)) ((9 35/10) (105/10 35/10)) ((105/10 35/10) (14 65/10)) ((14 65/10) (215/10 65/10))
	 ((215/10 65/10) (34 20)) ((34 20) (34 21)) ((34 21) (365/10 235/10)) ((365/10 235/10) (375/10 235/10))
	 ((375/10 235/10) (38 245/10)) ((38 245/10) (37 26)) ((37 26) (36 265/10)) ((285/10 25) (36 265/10))
	 ((285/10 25) (255/10 275/10)) ((255/10 275/10) (255/10 295/10)) ((255/10 295/10) (315/10 36))
	 ((315/10 36) (305/10 37)) ((305/10 37) (205/10 27)) ((205/10 27) (29 24)) ((29 24) (29 215/10))
	 ((29 215/10) (20 15)) ((20 15) (135/10 195/10)) ((135/10 195/10) (4 7)) ((55/10 135/10) (8 115/10)))
       :start '((6 12) (0 0))
       :finish '((6 145/10) (8 13)))
      *racetracks*)

(push (make-track			; Newtrack.gif
       :name "Checkered Flag track"
       :boundary
       '(((35/10 1) (10 1)) ((10 1) (12 15/10)) ((12 15/10) (135/10 35/10)) ((135/10 35/10) (13 16)) 
	 ((13 16) (14 17)) ((14 17) (165/10 175/10)) ((165/10 175/10) (175/10 185/10))
	 ((175/10 185/10) (175/10 245/10)) ((165/10 265/10) (175/10 245/10)) ((165/10 265/10) (145/10 28))
	 ((13 28) (145/10 28)) ((115/10 275/10) (13 28)) ((105/10 255/10) (115/10 275/10))
	 ((9 245/10) (105/10 255/10)) ((4 245/10) (9 245/10)) ((1 245/10) (4 245/10)) ((1 115/10) (1 265/10))
	 ((1 115/10) (15/10 105/10)) ((15/10 105/10) (25/10 95/10)) ((25/10 95/10) (35/10 95/10)) ((35/10 95/10) (6 11))
	 ((2 75/10) (6 11)) ((1 55/10) (2 75/10)) ((1 3) (1 55/10)) ((1 3) (2 15/10)) ((2 15/10) (35/10 1))
	 ((87/10 1) (87/10 45/10)) ((5 4) (9 45/10)) ((9 45/10) (95/10 5)) ((95/10 5) (95/10 17))
	 ((95/10 17) (10 185/10)) ((10 185/10) (115/10 19)) ((115/10 19) (125/10 195/10))
	 ((125/10 195/10) (135/10 21)) ((135/10 21) (135/10 235/10)) ((125/10 22) (135/10 235/10))
	 ((11 21) (125/10 22)) ((95/10 205/10) (11 21)) ((55/10 205/10) (95/10 205/10)) ((4 195/10) (55/10 205/10))
	 ((4 145/10) (4 195/10)) ((4 145/10) (45/10 145/10)) ((45/10 145/10) (6 155/10)) ((6 155/10) (8 15))
	 ((8 15) (9 13)) ((9 13) (95/10 115/10)) ((9 9) (95/10 115/10)) ((6 65/10) (9 9))
	 ((45/10 45/10) (6 65/10)) ((45/10 45/10) (5 4)))
       :start '((9 3) (0 0))
       :finish '((75/10 15/10) (75/10 4)))
      *racetracks*)

(push (make-track
       :name "P-shaped track, start at closed end"
       :boundary
       '(((45/10 4) (45/10 95/10)) ((45/10 95/10) (115/10 95/10)) ((115/10 95/10) (115/10 13)) ((5 13) (115/10 13))
	 ((5 13) (5 23)) ((5 23) (85/10 23)) ((85/10 23) (85/10 16)) ((85/10 16) (15 16))
	 ((15 16) (15 65/10)) ((75/10 65/10) (15 65/10)))
       :start '((6 22) (0 0))
       :finish '((5 55/10) (75/10 55/10)))
      *racetracks*)

(setq *racetracks* (reverse *racetracks*))