;;;---	HSIM >		-*- package: user; mode: lisp; base: 10. -*-

; This file is for the robot simulation programs.
; Free-body rods with enforced constraint of equal position, velocity, and
;  accelerations of all points pinned together on different rods.


; GENERAL SIMULATOR FUNCTION DEFINITIONS:

; The PROGRAM'S MAIN LOOP:

(defun run (&optional (ROBOT-FRAME ROBOT-FRAME) (CONTROL-FRAME CONTROL-FRAME))
  (runfun #'NORMAL-RUN-FUNCTION))
  

(defun runfun (run-function &optional arglist &aux MOUSE-VERT MOUSE-HORIZ MOUSELIST-PTR
	       MOUSELIST-COUNT GPOS POWER ENERGY GRAPH-SIZE HCENTER STEPPING? JUMP-FLAG)
  (setq tv:MOUSE-X 761. tv:MOUSE-Y 883.) ;BASE 10. IBASE 10. *NOPOINT nil
  (setq RUN-NUMBER (1+ RUN-NUMBER))
  (*catch ':DONE
    (tv:with-mouse-usurped
      (do ( )
	  (( ))
	(*catch ':REPEAT
	  (apply run-function arglist)))))
  (cond ((eq MOUSELIST-MODE 'STORE)
	 (write-to-mouselist 0. MOUSELIST-COUNT)
	 (write-to-mouselist 0. MOUSELIST-COUNT)))
  (setq DEFAULT-CONS-AREA WORKING-STORAGE-AREA tv:MOUSE-X 761. tv:MOUSE-Y 883.)
  (print-line 0. 0. run-function " done:") (show-misc)
  DONE)


(defun normal-run-function ( )
  (clear) (cursorset 62. 95.)
  (initialize-body)
  (do ((rod-array-list (get-frame ROBOT-FRAME 'ROD-ARRAY-LIST))
       (SIM-TIME 0. (+ SIM-TIME TIMESTEP))
       (dtfloat (* 0.001s0 TIMESTEP))
       (windcount 2.) (temp) (windforce)
       (wtemp 0.0s0 (cond ((<= windcount 0.) (setq windcount 50.) (random-number))
			  (t (setq windcount (1- windcount)) wtemp)))
       (wtemp2 0.0s0 (+ (* 0.02s0 wtemp) (* 0.995s0 wtemp2))))
      (( ))
    (setq windforce (cond ((minusp WIND) (- (small-float WIND)))
			  (t (* WIND wtemp2))))
    (do ((rod-arrays rod-array-list (cdr rod-arrays)))
	((null rod-arrays))
      (run-1 (car rod-arrays) windforce))
    (get-interaction-forces rod-array-list)
    (and (fixp DISPLAY-TIME)
	 (zerop (\ SIM-TIME DISPLAY-TIME))
	 (or DEBUGGING? (screen-display-body rod-array-list windforce))
	 (cond (STEPPING? (user-break (message-tyi "STEPPING")))
	       ((numberp (setq temp (listen2))) (user-break temp))))
    (do ((rod-arrays rod-array-list (cdr rod-arrays)))
	((null rod-arrays))
      (run-2 (car rod-arrays) dtfloat))))


(defun run-1 (rod windforce &aux lxf lyf uxf uyf angle-veloc cm-x cm-x-veloc
	      cm-y cm-y-veloc lcm ucm cos-angle sin-angle lower-x lower-x-veloc mass
	      lower-y lower-y-veloc upper-x upper-x-veloc upper-y upper-y-veloc moi)
  
  (setq lcm (LCM rod)
	ucm (UCM rod)
	mass (MASS rod)
	moi (MOI rod)
	angle-veloc (ANGLE-VELOC rod)
	cos-angle (COSANGLE rod)
	sin-angle (SINANGLE rod))
  
  (setq cm-x (CM-X rod)
	cm-y (CM-Y rod)
	cm-x-veloc (CM-X-VELOC rod)
	cm-y-veloc (CM-Y-VELOC rod)
	lower-x (- cm-x (* lcm cos-angle))
	lower-y (- cm-y (* lcm sin-angle))
	upper-x (+ cm-x (* ucm cos-angle))
	upper-y (+ cm-y (* ucm sin-angle))
	lower-x-veloc (+ cm-x-veloc (* lcm sin-angle angle-veloc))
	lower-y-veloc (- cm-y-veloc (* lcm cos-angle angle-veloc))
	upper-x-veloc (- cm-x-veloc (* ucm sin-angle angle-veloc))
	upper-y-veloc (+ cm-y-veloc (* ucm cos-angle angle-veloc)))

  (setf-all (LOWER-X rod) lower-x
	    (LOWER-Y rod) lower-y
	    (UPPER-X rod) upper-x
	    (UPPER-Y rod) upper-y
	    (LOWER-X-VELOC rod) lower-x-veloc
	    (LOWER-Y-VELOC rod) lower-y-veloc
	    (UPPER-X-VELOC rod) upper-x-veloc
	    (UPPER-Y-VELOC rod) upper-y-veloc)
  
  (setq windforce (* windforce (- (max lower-y upper-y) (min lower-y upper-y))))
  
  (cond ((> lower-y 0.0s0) (setq lxf windforce lyf 0.0s0))
	(t (setq lyf (- (+ (* lower-y-veloc FLOOR-DAMPING)
			   (* lower-y FLOOR-ELASTICITY)))
		 lxf (friction lower-x-veloc lyf))))
  
  (cond ((> upper-y 0.0s0) (setq uxf windforce uyf 0.0s0))
	(t (setq uyf (- (+ (* upper-y-veloc FLOOR-DAMPING)
			   (* upper-y FLOOR-ELASTICITY)))
		 uxf (friction upper-x-veloc uyf))))
  
  (setf-all (LXF rod) lxf (LYF rod) lyf
	    (UXF rod) uxf (UYF rod) uyf))


(defun get-interaction-forces (rod-array-list &aux at emass sangle1 cangle1 r1 imass1
			       csm1 ccm1 ssm1 xf1 oxf1 yf1 oyf1 sangle2 cangle2 r2 av2
			       imass2 csm2 ccm2 ssm2 xf2 oxf2 yf2 oyf2 solution (iflag t)
			       x-correction y-correction lcm ucm lxf lyf uxf uyf angle-accel
			       cm-x-accel cm-y-accel ltot mass cos-angle sin-angle
			       (DEFAULT-CONS-AREA TEMPORARY-AREA))
  (si:reset-temporary-area TEMPORARY-AREA)
  (setq r1 (first rod-array-list)
	imass1 (// 1.0s0 (MASS r1))
	emass (// 1.0s0 (M3 r1))
	sangle1 (SINANGLE r1)
	cangle1 (COSANGLE r1)
	csm1 (* emass cangle1 sangle1)
	ccm1 (* emass cangle1 cangle1)
	ssm1 (* emass sangle1 sangle1)
	xf1 (UXF r1)
	yf1 (UYF r1)
	oxf1 (LXF r1)
	oyf1 (LYF r1))
  (setq r2 (second rod-array-list)
	imass2 (// 1.0s0 (MASS r2))
	emass (// 1.0s0 (M1 r2))
	sangle2 (SINANGLE r2)
	cangle2 (COSANGLE r2)
	csm2 (* emass cangle2 sangle2)
	ccm2 (* emass cangle2 cangle2)
	ssm2 (* emass sangle2 sangle2)
	xf2 (LXF r2)
	yf2 (LYF r2)
	oxf2 (UXF r2)
	oyf2 (UYF r2))
  (setq at (funcall SERVO r1 r2)
	x-correction (+ (* JOINT-ELASTICITY (- (LOWER-X r2) (UPPER-X r1)))
			(* JOINT-DAMPING (- (LOWER-X-VELOC r2) (UPPER-X-VELOC r1))))
	y-correction (+ (* JOINT-ELASTICITY (- (LOWER-Y r2) (UPPER-Y r1)))
			(* JOINT-DAMPING (- (LOWER-Y-VELOC r2) (UPPER-Y-VELOC r1)))))
  (setq X1 x-correction Y1 y-correction)
  (setf-all (APPLIED-TORQUE r1) (- at)
	    (APPLIED-TORQUE r2) at)
  (*catch 'INCONSISTENT
    (progn
      (setq solution
	    (simq (list (list 1.0s0 0.0s0 1.0s0 0.0s0 0.0s0)
			(list 0.0s0 1.0s0 0.0s0 1.0s0 0.0s0)
			(list (+ imass1 ssm1)
			      (- csm1)
			      (- (+ imass2 ssm2))
			      csm2
			      (+ x-correction
				 (* imass2 (+ xf2 oxf2))
				 (- (* imass1 (+ xf1 oxf1)))
				 (* csm1 (- yf1 oyf1))
				 (* csm2 (- oyf2 yf2))
				 (* ssm2 (- xf2 oxf2))
				 (* ssm1 (- oxf1 xf1))
				 (* (UCM r1) cangle1 (square (ANGLE-VELOC r1)))
				 (* (LCM r2) cangle2 (square (ANGLE-VELOC r2)))
				 (// (* (UCM r1) sangle1 (- at)) (MOI r1))
				 (// (* (LCM r2) sangle2 at) (MOI r2))))
			(list (- csm1)
			      (+ imass1 ccm1)
			      csm2
			      (- (+ imass2 ccm2))
			      (+ y-correction
				 (* imass2 (+ yf2 oyf2))
				 (- (* imass1 (+ yf1 oyf1)))
				 (* csm1 (- xf1 oxf1))
				 (* csm2 (- oxf2 xf2))
				 (* ccm2 (- yf2 oyf2))
				 (* ccm1 (- oyf1 yf1))
				 (* (UCM r1) sangle1 (square (ANGLE-VELOC r1)))
				 (* (LCM r2) sangle2 (square (ANGLE-VELOC r2)))
				 (- (// (* (LCM r2) cangle2 at) (MOI r2)))
				 (- (// (* (UCM r1) cangle1 (- at)) (MOI r1))))))))
      (setq iflag nil)))
  (and iflag (setq solution '(0.0s0 0.0s0 0.0s0 0.0s0)))
  (and iflag (beep-tune 1667.))
  (setq F1 (first solution) F2 (second solution)
	F3 (third solution) F4 (fourth solution))
  (setf-all (UXF r1) (+ xf1 F1)
	    (UYF r1) (+ yf1 F2)
	    (LXF r2) (+ xf2 F3)
	    (LYF r2) (+ yf2 F4))
  (do ((rods rod-array-list (cdr rods)) (rod))
      ((null rods))
    (setq rod (car rods)
	  mass (MASS rod)
	  ltot (LTOT rod)
	  lxf (LXF rod) lyf (LYF rod)
	  uxf (UXF rod) uyf (UYF rod)
	  lcm (LCM rod) ucm (UCM rod)
	  av2 (square (ANGLE-VELOC rod))
	  cos-angle (COSANGLE rod) sin-angle (SINANGLE rod)
	  cm-x-accel (// (+ lxf uxf) mass)
	  cm-y-accel (- (// (+ lyf uyf) mass) GRAVITY)
	  angle-accel (// (+ (* (- uyf lyf) ltot cos-angle)
			     (* (- lxf uxf) ltot sin-angle)
			     (APPLIED-TORQUE rod))
			  (MOI rod)))
    (setf-all (LOWER-X-ACCEL rod) (+ cm-x-accel
				     (* lcm sin-angle angle-accel)
				     (* lcm cos-angle av2))
	      (LOWER-Y-ACCEL rod) (+ cm-y-accel
				     (- (* lcm cos-angle angle-accel))
				     (* lcm sin-angle av2))
	      (UPPER-X-ACCEL rod) (- cm-x-accel
				     (* ucm sin-angle angle-accel)
				     (* ucm cos-angle av2))
	      (UPPER-Y-ACCEL rod) (+ cm-y-accel
				     (* ucm cos-angle angle-accel)
				     (- (* ucm sin-angle av2)))
	      (CM-X-ACCEL rod) cm-x-accel
	      (CM-Y-ACCEL rod) cm-y-accel
	      (ANGLE-ACCEL rod) angle-accel)))


(defun run-2 (rod dtfloat &aux angle)

  (setf (CM-X rod)
	(+ (CM-X rod)
	   (* dtfloat 0.5s0
	      (+ (CM-X-VELOC rod)
		 (setf (CM-X-VELOC rod)
		       (+ (CM-X-VELOC rod)
			  (* dtfloat (CM-X-ACCEL rod))))))))
  
  (setf (CM-Y rod)
	(+ (CM-Y rod)
	   (* dtfloat 0.5s0
	      (+ (CM-Y-VELOC rod)
		 (setf (CM-Y-VELOC rod)
		       (+ (CM-Y-VELOC rod)
			  (* dtfloat (CM-Y-ACCEL rod))))))))

  (setq angle
	(mod (+ (ANGLE rod)
		(* dtfloat 0.5s0
		   (+ (ANGLE-VELOC rod)
		      (setf (ANGLE-VELOC rod)
			    (+ (ANGLE-VELOC rod)
			       (* dtfloat (ANGLE-ACCEL rod)))))))
	     TWOPI))

  (setf-all (ANGLE rod) angle
	    (COSANGLE rod) (cosine angle)
	    (SINANGLE rod) (sine angle)
	    ENERGY (+ ENERGY
		      (setq POWER (* dtfloat
				     (power-fcn (ANGLE-VELOC rod)
						(APPLIED-TORQUE rod)))))))


(defun power-fcn (veloc torque &aux product)
  (setq product (* veloc torque))
  (cond ((>= product 0.0s0) product)
	(t (* product 0.5s0))))


(defun friction (velocity normal-force)
  (setq normal-force (max normal-force 0.0s0))
  (cond ((> velocity 1.0s0) (- (* FRICTION normal-force)))
	((< velocity -1.0s0) (* FRICTION normal-force))
	(t (- (* velocity FRICTION normal-force)))))


(defun initialize-body (&aux r-frame)
  (or (listp MOUSELIST)
      (setq MOUSELIST (make-list SIGNAL-AREA 4.)))
  (setq HCENTER 0. POWER 0.0s0 ENERGY 0.0s0
	MOUSE-VERT 0.0s0 MOUSE-HORIZ 0.0s0 MOUSELIST-COUNT 0.
	MOUSELIST-PTR MOUSELIST)
  (do ((rod-frame-list (get-frame ROBOT-FRAME 'ROD-FRAME-LIST) (cdr rod-frame-list)))
      ((null rod-frame-list))
    (initialize-rod (setq r-frame (car rod-frame-list))
		    (get-frame r-frame 'ROD-ARRAY)))
  (tv:mouse-input nil)
  t)


(defun initialize-rod (r-frame rod &aux cos-angle sin-angle temp)
  (setf-all (LTOT rod) (get-frame r-frame 'LTOT)
	    (M1 rod) (get-frame r-frame 'M1)
	    (M2 rod) (get-frame r-frame 'M2)
	    (M3 rod) (get-frame r-frame 'M3)
	    temp (// (LTOT rod) (+ (M1 rod) (M3 rod)))
	    (LCM rod) (* (M3 rod) temp)
	    (UCM rod) (* (M1 rod) temp)
	    (MASS rod) (+ (M1 rod) (M2 rod) (M3 rod))
	    (MOI rod) (+ (* (M1 rod) (square (LCM rod)))
			 (* (M3 rod) (square (UCM rod))))
	    (ANGLE rod) (get-frame r-frame 'SAVE-ANGLE)
	    (ANGLE-VELOC rod) 0.0s0
	    cos-angle (cosine (ANGLE rod))
	    sin-angle (sine (ANGLE rod))
	    (COSANGLE rod) cos-angle
	    (SINANGLE rod) sin-angle
	    (CM-X rod) (+ (get-frame r-frame 'SAVE-LOWER-X)
			  (* (LCM rod) cos-angle))
	    (CM-Y rod) (+ (get-frame r-frame 'SAVE-LOWER-Y)
			  (* (LCM rod) sin-angle))
	    (CM-X-VELOC rod) 0.0s0
	    (CM-Y-VELOC rod) 0.0s0
	    (ROBOT-FRAME rod) ROBOT-FRAME
	    (ROD-FRAME rod) r-frame)
  t)

	   
; MOUSE CONTROL:

(defun mouse-read (&aux (horizontal 0.) (vertical 0.))
  (cond ((eq MOUSELIST-MODE 'REPLAY)
	 (values (setq MOUSE-HORIZ (+ (* MOUSE-SCALE (data-save t)) MOUSE-HORIZ))
		 (setq MOUSE-VERT (+ (* MOUSE-SCALE (data-save t)) MOUSE-VERT))))
	(t (multiple-value (horizontal vertical) (tv:mouse-input nil))
	   (setq vertical (- vertical))
	   (cond ((eq MOUSELIST-MODE 'STORE)
		  (data-save horizontal) (data-save vertical)))
	   (values (setq MOUSE-HORIZ (+ (* MOUSE-SCALE horizontal) MOUSE-HORIZ))
		   (setq MOUSE-VERT (+ (* MOUSE-SCALE vertical) MOUSE-VERT))))))


; AUTOMATIC OPERATION FROM FILE COMMANDS:

; Arg:  Integer value to save generated by mouse (when STORING)
;       T to check for a mouse input and return it (when REPLAYing)

(defun data-save (mouse &aux next count)
  (cond ((eq mouse 't)
	 (setq next (check-next (car MOUSELIST-PTR)))
	 (cond ((null next) 0.)
	       ((> next 40000.) (bump) (setq MOUSELIST-COUNT 0.) (- next 50000.))
	       (t (setq count MOUSELIST-COUNT)
		  (cond ((>= count next) (bump) (data-save t))
			(t (setq MOUSELIST-COUNT (1+ count)) 0.)))))
	((fixp mouse)
	 (setq count MOUSELIST-COUNT)
	 (cond ((zerop mouse)
		(cond ((>= count 39500.) (write-to-mouselist mouse count))
		      (t (setq MOUSELIST-COUNT (1+ count)))))
	       (t (write-to-mouselist mouse count)))
	 mouse)
	(t (break-error "DATA-SAVE -- Incorrect args." mouse))))


(defun write-to-mouselist (mouse count)
  (cond ((> count 0.) (rplaca MOUSELIST-PTR count) (bump)))
  (setq MOUSELIST-COUNT 0.)
  (rplaca MOUSELIST-PTR (+ mouse 50000.))
  (bump) (rplaca MOUSELIST-PTR nil))


(defun check-next (next)
  (cond ((null next) nil)
	((and (fixp next) (> next 0.) (< next 60000.)) next)
	(t (break-error "CHECK-NEXT -- Incorrect next list element." next))))


(defun bump ( )
  (setq MOUSELIST-PTR (cond ((cdr MOUSELIST-PTR))
			    (t (extend 'MOUSELIST MOUSELIST-PTR 200. SIGNAL-AREA)))))


; INPUT-OUTPUT TO FILES

(defun writeout (mouselist &optional (filename "THIRD: RSG; DATA >") &aux file line col)
  (setq line (linenum) col (+ (charpos) 2.)
	file (open filename '(:WRITE :FIXNUM)))
  (skip-this
    (close file)
    (do ((next mouselist (cdr next))
	 (count 0. (1+ count)))
	((or (null next) (null (car next)))
	 (funcall file ':TYO 0.) (funcall file ':TYO 0.))
      (and (zerop (\ count 200.)) (print-line line col count))
      (funcall file ':TYO (car next))))
  (beep-tune)
  "WRITEOUT done.")


(defun readin (mouselist &optional (filename "THIRD: RSG; DATA >") &aux file next line col)
  (setq line (linenum) col (+ (charpos) 2.)
	file (open filename '(:READ :FIXNUM))
	next mouselist)
  (skip-this
    (close file)
    (do ((count 0. (1+ count))
	 (number (tyi file) (tyi file)))
	((<= number 0.))
      (rplaca next number)
      (setq next (cond ((cdr next))
		       (t (extend 'MOUSELIST next 200. SIGNAL-AREA))))
      (and (zerop (\ count 200.)) (print-line line col count))))
  (beep-tune)
  "READIN done.")


; USER CONTROL OF SYSTEM STATUS:

(defun speed (&optional n)
  (cond ((and (numberp n) (not (zerop n)))
	 (cond ((< n 0.)
		(setq GRATE (max 1. (round (- n))) DISPLAY-TIME TIMESTEP))
	       (t (setq GRATE 1. DISPLAY-TIME (* n TIMESTEP))))))
  (terpri) (princ "Horizontal rate:  ")
  (time-display (// (* 100. DISPLAY-TIME) GRATE) t)
  (princ " Seconds per inch.")
  `(DISPLAY-TIME ,DISPLAY-TIME -- GRATE ,GRATE -- TIMESTEP ,TIMESTEP))


(defun user-break (ch &optional skip-space? negative? &aux temp throw-tag clear?)
  (cond ((boundp 'DRIBBLE-FILE) (terpri DRIBBLE-FILE)
	 (format DRIBBLE-FILE "** User-Break:  ~:@C" ch) (terpri DRIBBLE-FILE)))
  (clear-input2) (tv:mouse-input nil) (beep-tune)
  (cond
    ((= ch #\SPACE)
     (or STEPPING? skip-space? (user-break (message-tyi "Choice" nil) t nil)))
    ((= ch #\RUBOUT) (setq throw-tag ':DONE))
    ((= ch #/-) (user-break (message-tyi "Next Key" nil) nil t))
    ((or (= ch #/[) (= ch #/()) (setq HCENTER (1+ HCENTER)) (label-axis))
    ((or (= ch #/]) (= ch #/))) (setq HCENTER (1- HCENTER)) (label-axis))

    ((= ch #/b) (clear) (break-loop) (setq clear? t))
    
    ((= ch #/d) (setq PRINT-VAL? (not negative?) clear? t))
    ((= ch #/e) (print-line 58. 0. "    Eval:  ")
     (let ((DEFAULT-CONS-AREA WORKING-STORAGE-AREA))
       (setq temp (eval (read-clear))))
     (cursorset (1+ (linenum)) 0.)
     (princ "Returned:  ") (funcall PRIN1 temp)
     (and (>= (linenum) 58.) (tv:sheet-clear-eof TERMINAL-IO))
     (cursorset 62. 95.))
    
    ((= ch #/g) (setq STATE-SPACE-GRAPH-LIST
		      (nthcdr (cond (negative? (1- STATE-SPACE-GRAPH-LIST-LEN)) (t 1.))
			      STATE-SPACE-GRAPH-LIST)
		      clear? t))
    ((= ch #/g) (setq STATE-SPACE-GRAPH-LIST
		       (nthcdr (cond (negative? (- STATE-SPACE-GRAPH-LIST-LEN 6.)) (t 6.))
			       STATE-SPACE-GRAPH-LIST)
		       clear? t))
    ((= ch #/g) (setq STATE-SPACE-GRAPH-LIST
		       (nthcdr (cond (negative? (- STATE-SPACE-GRAPH-LIST-LEN 12.)) (t 12.))
			       STATE-SPACE-GRAPH-LIST)
		       clear? t))
    ((= ch #/g) (setq STATE-SPACE-GRAPH-LIST
		       (nthcdr (cond (negative? (- STATE-SPACE-GRAPH-LIST-LEN 24.)) (t 24.))
			       STATE-SPACE-GRAPH-LIST)
		       clear? t))
    
    ((= ch #/j) (setq JUMP-FLAG t))
    ((= ch #/l) (setq clear? t))
    ((= ch #/m) (setq DISPLAY-MODE (mod (+ DISPLAY-MODE (cond (negative? -1.) (t 1.))) 5.)
		      clear? t))
    ((= ch #/n) (set-normalization negative?) (setq clear? t))
    
    ((= ch #/r) (and negative? (save-starting-configuration)) (setq throw-tag ':REPEAT))
    ((= ch #/s) (setq STEPPING? (not negative?)))
    ((= ch #/v) (show) (break-loop) (setq clear? t))
    ((= ch #/z) (setq MOUSE-HORIZ 0.0s0 MOUSE-VERT 0.0s0))

    ((= ch #/0) (print-and-eval 'ZERO 0. negative?))
    ((= ch #/1) (print-and-eval 'ONE 1. negative?))
    ((= ch #/2) (print-and-eval 'TWO 2. negative?))
    ((= ch #/3) (print-and-eval 'THREE 3. negative?))
    ((= ch #/4) (print-and-eval 'FOUR 4. negative?))
    ((= ch #/5) (print-and-eval 'FIVE 5. negative?))
    ((= ch #/6) (print-and-eval 'SIX 6. negative?))
    ((= ch #/7) (print-and-eval 'SEVEN 7. negative?))
    ((= ch #/8) (print-and-eval 'EIGHT 8. negative?))
    ((= ch #/9) (print-and-eval 'NINE 9. negative?))
    
    (t (clear) (princ "	Choices are:

      ?  --  Print this information.
      -  --  Provide Negative argument to next key command.
 ( or [  --  Move robot to LEFT.
 ) or ]  --  Move robot to RIGHT.
 <space> --  Halt momentarily, then Continue.
<rubout> --  Quit to top-level.

    C-b  --  BREAKLOOP.
      d  --  Set DIGITAL readout mode (- arg Clears it).
      e  --  EVALUATE single lisp expression.
						___________
      g  --  Advance State-Space Graphs by ONE.		   |
    C-g  --  Advance State-Space Graphs by SIX.    - arg rotates in
    M-g  --  Advance State-Space Graphs by 12.    opposite direction
  C-M-g  --  Advance State-Space Graphs by 24.  ___________|

      j  --  JUMP.
      l  --  Clear Screen.
      m  --  Rotate graphical display modes (- arg rotates in opposite direction).
      n  --  Normalize all Auto-normalizing displays.
		(With - arg, all displays reset to maximum sensitivity.)

      r  --  RESTART current run from beginning.
	        (With - arg, store current start values into ROBOT-FRAME.)
      s  --  Set SINGLE-STEP mode (- arg Clears it).

      v  --  Values shown for System Parameters (then Break-loop).
      z  --  Zero Mouse-control.

 <digit> --  Evaluate /"ZERO/" ... /"NINE/".
             With - arg switches between lists of digit commands.

  SPACE or one of above to continue: ")
       (clear-input2) (user-break (message-tyi "Choice" nil) t nil)
       (setq clear? t)))
  
  (and throw-tag (*throw throw-tag nil))
  (and clear? (clear))
  (clear-input2) (tv:mouse-input nil) (message "" nil) ch)


(defun save-starting-configuration ( )
  (do ((rod-frame-list (get-frame ROBOT-FRAME 'ROD-FRAME-LIST) (cdr rod-frame-list))
       (rod-array-list (get-frame ROBOT-FRAME 'ROD-ARRAY-LIST) (cdr rod-array-list)))
      ((null rod-frame-list))
    (set-frame (ANGLE (car rod-array-list)) (car rod-frame-list) 'SAVE-ANGLE)
    (set-frame (LOWER-X (car rod-array-list)) (car rod-frame-list) 'SAVE-LOWER-X)
    (set-frame (LOWER-Y (car rod-array-list)) (car rod-frame-list) 'SAVE-LOWER-Y))
  (print-line 58. 0. "Current configuration saved.")
  (sleep 1.))


(defun print-and-eval (item number negative? &aux temp)
  (print-line 58. 0. "Eval " item ":  ")
  (setq item (cond ((not negative?) (symeval item))
		   (t (nth (1- number) NUMBER-SET-LIST))))
  (let ((G-PRINENDLINE 3.)
	(DEFAULT-CONS-AREA WORKING-STORAGE-AREA))
    (funcall PRIN1 item)
    (setq temp (eval item))
    (cond (SHOW-EVAL?
	   (cursorset (1+ (linenum)) 0.)
	   (princ "Returned:  ") (funcall PRIN1 temp)
	   (and (>= (linenum) 58.) (tv:sheet-clear-eof TERMINAL-IO))
	   (cursorset 62. 95.))))
  (cursorset (+ 2. (// (+ GRAPHICS-SCREEN-HEIGHT 4.) 14.)) 15. 14. 'CHARS)
  (time-display (// (* 100. DISPLAY-TIME) GRATE) t)
  (princ " sec//in" TERMINAL-IO)
  (cursorset 62. 95.))


;;; End.