;;; ********************************************************************
;;; writer.ss
;;; Susan Fox
;;; January 1, 2001

;;; Contains code for writing messages to the requisite file.  This
;;; is actually half of the Message ADT, the rest of which is in the
;;; file message.ss.  


;;; Requires message.ss  to be loaded
(if (not (top-level-bound? 'MESSAGE.SSLOADED))
    (load "message.ss"))
;;; Requires the map in order to talk about locations
(if (not (top-level-bound? 'MAP.SSLOADED))
    (load "map.ss"))

(define WRITER.SSLOADED #t)



;;; ********************************************************************

;;; The following program interacts with the user to create messages
;;; and write them to the appropriate file.

;;; message-generator (or mg) takes no arguments, and prompts the
;;; user to enter messages to be given to the robot.
;;;
(define message-generator
  (lambda ()
    (print-instrs)
    (do-outer-menu  old-messages)))

(define mg message-generator)

;;; does the actual outermost menu, keeping track of all messages
;;; that have been sent thus far.  A message can always be re-used
;;; at a later point
;;; first menu asks whether they want to enter their own
;;; message or use a pre-defined one, or quit.  They enter
;;; 0 1 or 2, or q or quit, or n for "new" message or o for "old"
;;;
(define do-outer-menu
  (lambda (messages)
    (print-menu1)
    (case (choose-menu1)
      [(q quit 0)  (printf "Quitting.~n")]
      [(1 n new)
       (let ([new-mess (get-new-message)])
         (send-message new-mess)
         (do-outer-menu (cons new-mess messages)))]
      [(2 o old)
       (send-message (select-old-message messages))
       (do-outer-menu messages)]
      [else (error 'do-outer-menu "Something wrong with choose-menu1")])))


(define print-instrs
  (lambda ()
    (printf "You will be prompted to send a message, either an old one or~n")
    (printf "a new one.  You may quit at any time.~n")))


(define print-menu1
  (lambda ()
    (printf "Please enter:~n")
    (printf "[0 q quit]   To quit this program~n")
    (printf "[1 n new]    To create and send a new message~n")
    (printf "[2 o old]    To select and send an old message~n")
    (newline)))


;;; choose-menu1 asks the user to enter a value and error-checks
;;; their input until they get it right!
;;;
(define choose-menu1
  (lambda ()
    (display "Enter your choice: ")
    (let ([input (read)])
      (if (member input '(0 1 2 q quit o old n new))
	  input
          (begin
	    (printf "Enter one of the options above!~n")
	    (choose-menu1))))))

;;; -------------------------------------------------------------------

;;; get-new-message prompts the user to enter the values for the
;;; new message, and returns the message once done
;;;
(define get-new-message
  (lambda ()
    (letrec ([get-each
	       (lambda (body loc urge deadline)
		 (cond
		   [(or (not body) (not (string? body)))
		    (display "Enter, as a string, the message to send: ")
		    (get-each (read) loc urge deadline)]
		   [(not loc) 
		    (display "Enter the location to send the message to: ")
		    (get-each body (read-loc) urge deadline)]
		   [(or (not urge) (not (urgency? urge)))
		    (display "Enter the urgency of the message (0 to 100): ")
		    (get-each body loc (read) deadline)]
		   [(or (not deadline) (not (deadline? deadline)))
		    (display "Enter the deadline of the message (0 to 100): ")
		    (get-each body loc urge (read))]
		   [else
		     (printf "Constructing a new message:~n")
		     (let ([new-mess (make-message body loc urge deadline)])
                       (print-message new-mess)
                       new-mess)]))])
      (get-each #f #f #f #f))))


;;; urgency? just checks if its value is appropriate: an integer
;;; between 0 and 100
;;;
(define urgency?
  (lambda (value)
    (and (integer? value)
	 (<= 0 value 100))))

;;; deadline? is for now exactly the same
(define deadline? urgency?)


;;; -------------------------------------------------------------------
;;; read-loc asks the user what kind of location they want to enter,
;;; and then prompts them appropriately, error-checking their input
;;;
(define read-loc
  (lambda ()
    (newline)
    (printf "Do you want to enter a coordinate, a block, or a named location?~n")
    (display "Enter coord, block, or named: ")
    (case (read)
      [(block b bl) (read-block)]
      [(coord c co) (read-coord)]
      [(named n na) (read-named)]
      [else (read-loc)])))


;;; read-block asks for four values to be read in and then makes a block
;;;
(define read-block
  (lambda ()
    (letrec ([read-each
	       (lambda (lx hx ly hy)
		 (cond
		   [(or (not lx) (not (integer? lx)))
		    (display "Enter an integer for the low x value: ")
		    (read-each (read) hx ly hy)]
		   [(or (not hx) (not (integer? hx)))
		    (display "Enter an integer for the high x value: ")
		    (read-each lx (read) ly hy)]
		   [(or (not ly) (not (integer? ly)))
		    (display "Enter an integer for the low y value: ")
		    (read-each lx hx (read) hy)]
		   [(or (not hy) (not (integer? hy)))
		    (display "Enter an integer for the high y value: ")
		    (read-each lx hx ly (read))]
		   [else (make-block lx hx ly hy)]))])
      (read-each #f #f #f #f))))


;;; read-coord reads in two values for the coordinate location
;;;
(define read-coord
  (lambda ()
    (letrec ([read-each
	       (lambda (x y)
		 (cond
		   [(or (not x) (not (integer? x)))
		    (display "Enter an integer for the x value: ")
		    (read-each (read) y)]
		   [(or (not y) (not (integer? y)))
		    (display "Enter an integer for the y value: ")
		    (read-each x (read))]
		   [else (make-coord x y)]))])
      (read-each #f #f))))


;;; read-named reads in a symbol and checks to see if it is a valid
;;; named location
;;;
(define read-named
  (lambda ()
    (display "Enter a symbol for a named location, or ? to see the list: ")
    (let ([choice (read)])
      (if (eq? choice '?)
	  (begin
	    (print-named-locations)
	    (read-named))
	  (if (named? choice)
	      choice
	      (read-named))))))
		


;;; -------------------------------------------------------------------

;;; select-old-message prints the list of messages, along with a number
;;; for each, and asks the user to select a number in the proper range
;;;
(define select-old-message
  (lambda (mess-list)
    (print-message-list mess-list 0)
    (printf "Enter the number of the message you want.~n")
    (printf "Between 0 and ~s: " (sub1 (length mess-list)))
    (let ([choice (read)])
      (if (and (integer? choice)
	       (<= 0 choice (sub1 (length mess-list))))
	  (list-ref mess-list choice)
	  (select-old-message mess-list)))))


;;; print-message-list takes a list of messages and prints them,
;;; along with a number for each one
;;;
(define print-message-list
  (lambda (lst num)
    (if (null? lst)
	(newline)
	(begin
	  (printf "---------------------------------------~n")
	  (printf "Number ~s:~n" num)
	  (print-message (car lst))
	  (print-message-list (cdr lst) (add1 num))))))


;;; -------------------------------------------------------------------

;;; Here is the initial message list, with a couple standard message
;;; types in it

(define old-messages
  (list
    (make-message "Go to OLRI 245" 'olri-245 20 50)
    (make-message "Go to atrium" 'atrium 50 30)
    (make-message "Go to east Olin urgently" 'east-olin-hallway 75 100)
    (make-message "Go to OLRI 241 urgently" 'olri-241 80 50)
    (make-message "Go to Susan's office quickly" 'olri-230 20 20)))


;;; -------------------------------------------------------------------
	 
;;; actually writes a message, printing verbose messages to the
;;; screen so we know how things go
;;;
(define send-message
    (lambda (message)
      (printf "Sending message ~s~n" (mess-descrip message))
      (write-message message)
      (printf "Message sent~n")))


;;; ********************************************************************

;;; This is a test program that starts with a given number and just
;;; keeps sending messages until interrupted
;;;
(define test-writing
  (lambda (num)
    (if (not (peek-char))
	(begin
	  (printf "Sending message ~s~n" num)
	  (write-message num)
	  (printf "Message sent~n")
	  (test-writing (add1 num)))
	'done)))

;;; ********************************************************************

;;; This program tests the log file created in reading and writing
;;; to see if any values are missing, or out of order.
;;;
(define test-log-file
  (letrec ([test-list
	     (lambda (lst num)
	       (if (null? lst)
		   #t
		   (if (equal? num (car lst))
		       (test-list (cdr lst) (add1 num))
		       (list num (car lst)))))])
    (lambda ()
      (let* ([ip (open-input-file log-file)]
	     [lists (read-all (read ip) ip)])
	(close-input-port ip)
	(test-list (apply append lists) 0)))))