;-*-Mode:Lisp; Package:Spacewar-*-

;; These two constants relate the program's units to dots and seconds.
;; All of the parameters are set using these two so that their effective
;; values can be independent of changes of the quantization.
(DEFVAR CPS 10.)     ;; Cycles per second
(DEFVAR UPD 1000.)   ;; units per dot.
(DEFVAR HALF-UPD 500.)

;; Here are the parameters you might want to change.

;; Acceleration of ships' engines, in units per cycle per cycle.
(DEFVAR SHIP-ACCELERATION (// (* 20. UPD) CPS CPS))
;; Angular velocity of ships' turning.
(DEFVAR SHIP-TURNING-RATE .30)

;; Number of torps each ship has.
;; Takes effect only at the start of a game.
(DEFVAR SHIP-TORP-SUPPLY 40.)
;; Number of cycles between firings
(DEFVAR TORP-RELOAD-TIME (FIX (* .6 CPS)))
;; Velocity of torp relative to ship that fires it, in units per cycle.
(DEFVAR TORP-VELOCITY (// (* 100. UPD) CPS))
;; Collision radius of a torpedo.
(DEFVAR TORP-RADIUS (* 3 UPD))
;; Collision radius of a ship.
(DEFVAR SHIP-RADIUS (* 9 UPD))
;; Time a torp can travel before exploding, in cycles.
(DEFVAR TORP-LIFETIME (* 6 CPS))
;; Distance for torp-torp collisions (or 0, to use twice the torp radius).
;; The reason for making torp-torp collisions use a larger distance
;; is to make defending with torps relatively easier.
;; Actually, this collision distance applies to any two objects
;; whose radii add up to less than this minimum.
(DEFVAR TORP-TORP-COLLISION-DISTANCE (* 10. UPD))

;; Beep frequencies for the two ships' death knells.
(DEFVAR SHIP-FREQ-ALIST '((FOO 1000) (BAR 2000)))

;; T => bounce off walls, NIL => warp to opposite edge.
(DEFVAR WALL-BOUNCE NIL)

;; Time between death of ship and end of game, in cycles.
(DEFVAR DEATH-DELAY (* 3 CPS))

;; Number of cycles during which a ship can be thrusting before it runs out of fuel.
;; Takes effect only at the start of a game.
(DEFVAR SHIP-FUEL-SUPPLY (* 50. CPS))

;; T => there should be a sun.
;; Takes effect only at the start of a game.
(DEFVAR SUN-FLAG T)
;; T => collision with a sun is fatal.  NIL => it has no effect.
;; :CORNER => it sends you to the corner of the universe.
(DEFVAR SUN-COLLISION-FLAG ':CORNER)
;; Acceleration due to the sun at 10 units away,
;; in units per cycle per cycle.
;; The numeric parameter is the acceleration at 10 dots in dots per second per second.
(DEFVAR MASS-OF-SUN (// (* 1000. UPD UPD UPD) CPS CPS))

;; Radius of sun for collision purposes, in units
(DEFVAR SUN-RADIUS (* 8 UPD))

;; Time delay after leaving hyperspace before you can enter it again.
(DEFVAR HYPERSPACE-RELOAD-TIME (* 5 CPS))
;; Time ship spends in hyperspace.
(DEFVAR HYPERSPACE-DELAY (* 3 CPS))
;; Probability of death on return from hyperspace.
(DEFVAR HYPERSPACE-DEATH-PROBABILITY .12)
;; Magnitude of velocity which ships have on return from hyperspace.
;; The direction of the velocity is random, but its magnitude is this parameter.
(DEFVAR HYPERSPACE-VELOCITY (// (* 150. UPD) CPS))

;; These variables are not interesting for the user to set.

;; This is a list of all the objects visible and moving on the screen.
;; Both ships and torps are on this list.
(DEFVAR OBJECTS)

;; List of all suns.
(DEFVAR SUNS NIL)

;; List of all ships
(DEFVAR SHIPS NIL)

;; List of torpedos which were used and freed up, for re-use.
(DEFVAR FREE-TORPS NIL)

;; Schedule of when to return ships from hyperspace.
;; Each element is a list (time ship) where time is the cycle count.
(DEFVAR HYPERSPACE-RETURN-SCHEDULE)

;; Number of cycles the game has lasted.
;; Used for timing torp and hyperspace reloads.
(DEFVAR CURRENT-CYCLE-NUMBER)

;; Time in cycles until game should end.
;; Normally nil meaning end not scheduled yet.
(DEFVAR TIME-TILL-GAME-END NIL)

;; These are the offsets in DOTS from the official position of a blinker
;; to the center of the blinker's character, using the font SHIP.
(DEFVAR HOFFSET 10.)
(DEFVAR VOFFSET 10.)

(DECLARE (SPECIAL FONTS:SHIP))

;; An object is a list (type mass hvel vvel hpos vpos blinker)
;; where type is nil for a torpedo and t for a ship.
;; The type is used to tell whether the object's direction of facing
;; is visible.  If it is, rotation of that direction causes the blinker's
;; character to be changed.
;; Position is always measured in units, and time in cycles.
;; The length of a cycle is determined by the function MOVE-LOOP.
(DEFSTRUCT (OBJECT :ARRAY :NAMED)
  OBJECT-NAME
  OBJECT-TYPE		;SHIP, TORP or SUN
  OBJECT-BASE-CHAR
  OBJECT-RADIUS		;Symbol whose value is radius of object in units.
  OBJECT-HPOS		;Horizontal position in units.
  OBJECT-VPOS		;Vertical position in units.
  OBJECT-HVEL		;Horizontal velocity in units per cycle.
  OBJECT-VVEL		;Vertical "
  OBJECT-ACCELERATION	;Magnitude only, in units per cycle per cycle.
  OBJECT-HPROJ		;horiz projection of unit vector aligned with object.
  OBJECT-VPROJ		;vert projection of that unit vector.
  OBJECT-ANGLE		;Angle of pointing of object, in radians from rightward past downward.
  OBJECT-ANGULAR-VEL	;Rate of change of angle, in rads per cycle.
  OBJECT-COLLISION-FUNCTION	;Function to call if this collides.  Gets obj as arg.
  OBJECT-IMMOVABLE-FLAG	;T => this object should't gravitate.
  OBJECT-TORP-SUPPLY	;Number of torps left to be fired.
  OBJECT-FUEL-SUPPLY	;Time left of having acceleration, in cycles.
  OBJECT-LAST-FIRING-TIME	;Time at which torp was last fired by this ship.  OR
				;Time at which this torp should die.
  OBJECT-LAST-HYPERSPACE-TIME	;Time at which this ship last entered hyperspace.
  OBJECT-BLINKER		;The blinker which displays the position of the object.
  OBJECT-DEAD-FLAG)		;T for a ship which has been killed,
				;HYPERSPACE for a ship which is in hyperspace.

;; Coordinates of the walls.  Note that MAXHPOS and MAXVPOS are INCLUSIVE!
(DEFVAR MINHPOS 0)
(DEFVAR MAXHPOS (* UPD 1377))
(DEFVAR MINVPOS 0)
(DEFVAR MAXVPOS (* UPD 1530))

;; Move each object whose velocity is nonzero.
(DEFUN MOVE-OBJECTS ()
  (DO ((OBJECTS-LEFT OBJECTS (CDR OBJECTS-LEFT)))
      ((NULL OBJECTS-LEFT))
    (PROG* ((OBJECT (CAR OBJECTS-LEFT))
	    (HVEL (OBJECT-HVEL OBJECT)) (VVEL (OBJECT-VVEL OBJECT))
	    (HPOS (OBJECT-HPOS OBJECT)) (VPOS (OBJECT-VPOS OBJECT))
	    (BLINKER (OBJECT-BLINKER OBJECT))
	    (NEWHPOS (+ HPOS HVEL))
	    (NEWVPOS (+ VPOS VVEL)))
       KEEP-BOUNCING
       (COND (WALL-BOUNCE
	       ;; Bounce off walls.
	       (COND ((> NEWVPOS MAXVPOS)
		      (SETQ NEWVPOS (- MAXVPOS (- NEWVPOS MAXVPOS)))
		      (SETF (OBJECT-VVEL OBJECT)
			    (- (OBJECT-VVEL OBJECT)))
		      (GO KEEP-BOUNCING)))
	       (COND ((> NEWHPOS MAXHPOS)
		      (SETQ NEWHPOS (- MAXHPOS (- NEWHPOS MAXHPOS)))
		      (SETF (OBJECT-HVEL OBJECT)
			    (- (OBJECT-HVEL OBJECT)))
		      (GO KEEP-BOUNCING)))
	       (COND ((< NEWVPOS MINVPOS)
		      (SETQ NEWVPOS (+ MINVPOS (- MINVPOS NEWVPOS)))
		      (SETF (OBJECT-VVEL OBJECT)
			    (- (OBJECT-VVEL OBJECT)))
		      (GO KEEP-BOUNCING)))
	       (COND ((< NEWHPOS MINHPOS)
		      (SETQ NEWHPOS (+ MINHPOS (- MINHPOS NEWHPOS)))
		      (SETF (OBJECT-HVEL OBJECT)
			    (- (OBJECT-HVEL OBJECT)))
		      (GO KEEP-BOUNCING))))
	     (T
	       ;; warp from one edge to the opposite edge.
	       (COND ((> NEWHPOS MAXHPOS)
		      (SETQ NEWHPOS (- NEWHPOS (- MAXHPOS MINHPOS -1)))))
	       (COND ((> NEWVPOS MAXVPOS)
		      (SETQ NEWVPOS (- NEWVPOS (- MAXVPOS MINVPOS -1)))))
	       (COND ((< NEWHPOS MINHPOS)
		      (SETQ NEWHPOS (+ NEWHPOS (- MAXHPOS MINHPOS -1)))))
	       (COND ((< NEWVPOS MINVPOS)
		      (SETQ NEWVPOS (+ NEWVPOS (- MAXVPOS MINVPOS -1)))))))
       (SETF (OBJECT-HPOS OBJECT) NEWHPOS)
       (SETF (OBJECT-VPOS OBJECT) NEWVPOS)
       (SET-BLINKER-CURSORPOS BLINKER HPOS VPOS))))

;;; Set the cursor position of a blinker.  The position is specified in units.
(DEFUN SET-BLINKER-CURSORPOS (BLINKER X Y)
  (SETQ X (- (// (+ X HALF-UPD) UPD) HOFFSET)
	Y (- (// (+ Y HALF-UPD) UPD) VOFFSET))
  (WITHOUT-INTERRUPTS
    (LET ((OLD-PHASE (TV-BLINKER-PHASE BLINKER))
	  (TIME (TV-BLINKER-TIME-UNTIL-BLINK BLINKER)))
      (COND ((AND (= X (TV-BLINKER-X-POS BLINKER))	;Don't blink if not really moving
		  (= Y (TV-BLINKER-Y-POS BLINKER)))) 
	    (T (TV-OPEN-BLINKER BLINKER)
	       (SETF (TV-BLINKER-X-POS BLINKER) X)
	       (SETF (TV-BLINKER-Y-POS BLINKER) Y)
	       (AND (TV-BLINKER-VISIBILITY BLINKER)
		    OLD-PHASE				;Don't disappear for a long time.
		    (TV-BLINK BLINKER OLD-PHASE))
	       (SETF (TV-BLINKER-TIME-UNTIL-BLINK BLINKER) TIME))))))

;; Rotate each object a step of size specified by the object's angular velocity.
(DEFUN ROTATE-OBJECTS (&AUX (PI 3.14159) (TWOPI (* 2 PI)) TEM)
  (DOLIST (OBJECT OBJECTS)
    (OR (ZEROP (SETQ TEM (OBJECT-ANGULAR-VEL OBJECT)))
	(LET ((ANGLE (+ TEM (OBJECT-ANGLE OBJECT))))
	  (AND ( ANGLE TWOPI) (SETQ ANGLE (- ANGLE TWOPI)))
	  (AND (< ANGLE 0) (SETQ ANGLE (+ ANGLE TWOPI)))
	  (SETF (OBJECT-HPROJ OBJECT) (COS ANGLE))
	  (SETF (OBJECT-VPROJ OBJECT) (SIN ANGLE))
	  (SETF (OBJECT-ANGLE OBJECT) ANGLE)
	  (LET ((BLINKER (OBJECT-BLINKER OBJECT)))
	    (TV-SET-BLINKER-FUNCTION BLINKER
		(TV-BLINKER-FUNCTION BLINKER)
		(TV-BLINKER-WIDTH BLINKER)
		(+ (OBJECT-BASE-CHAR OBJECT)
		   (\ (FIXR (// (* ANGLE 32.) TWOPI)) 32.))))))))

(DEFUN SET-DIRECTION (OBJECT ANGLE &AUX (PI 3.14159) (TWOPI (* 2 PI)))
  (SETF (OBJECT-HPROJ OBJECT) (COS ANGLE))
  (SETF (OBJECT-VPROJ OBJECT) (SIN ANGLE))
  (SETF (OBJECT-ANGLE OBJECT) ANGLE)
  (LET ((BLINKER (OBJECT-BLINKER OBJECT)))
       (TV-SET-BLINKER-FUNCTION BLINKER
	   (TV-BLINKER-FUNCTION BLINKER)
	   (TV-BLINKER-WIDTH BLINKER)
	   (+ (OBJECT-BASE-CHAR OBJECT)
	      (\ (FIXR (// (* ANGLE 32.) TWOPI)) 32.)))))

;; Accelerate each object.  The magnitude of the acceleration
;; is specified explicitly in the object.
;; The direction of acceleration is the way the object is facing.
(DEFUN ACCELERATE-OBJECTS (&AUX TEM)
  (DOLIST (OBJECT OBJECTS)
    (OR (ZEROP (SETQ TEM (OBJECT-ACCELERATION OBJECT)))
	(PROGN (SETF (OBJECT-HVEL OBJECT)
		     (+ (OBJECT-HVEL OBJECT)
			(FIXR (* TEM (OBJECT-HPROJ OBJECT)))))
	       (SETF (OBJECT-VVEL OBJECT)
		     (+ (OBJECT-VVEL OBJECT)
			(FIXR (* TEM (OBJECT-VPROJ OBJECT)))))))))

;; Fire a torpedo from a specified ship.
(DEFUN FIRE-TORP (SHIP)
  (AND (> (OBJECT-TORP-SUPPLY SHIP) 0)
       (LET ((TORP)
	     (HPOS (+ (OBJECT-HPOS SHIP)
		      (FIXR (* (+ 2 (SYMEVAL (OBJECT-RADIUS SHIP)) TORP-RADIUS)
			       (OBJECT-HPROJ SHIP)))))
	     (VPOS (+ (OBJECT-VPOS SHIP)
		      (FIXR (* (+ 2 (SYMEVAL (OBJECT-RADIUS SHIP)) TORP-RADIUS)
			       (OBJECT-VPROJ SHIP)))))
	     (HVEL (+ (OBJECT-HVEL SHIP)
		      (FIXR (* TORP-VELOCITY
			       (OBJECT-HPROJ SHIP)))))
	     (VVEL (+ (OBJECT-VVEL SHIP)
		      (FIXR (* TORP-VELOCITY
			       (OBJECT-VPROJ SHIP))))))
	 (SETF (OBJECT-TORP-SUPPLY SHIP) (1- (OBJECT-TORP-SUPPLY SHIP)))
	 (SETF (OBJECT-LAST-FIRING-TIME SHIP) CURRENT-CYCLE-NUMBER)
	 (OR (AND FREE-TORPS (POP FREE-TORPS TORP))
	     (LET ((BLINKER (TV-DEFINE-BLINKER NIL ':ROVING-P T)))
	       (TV-SET-BLINKER-FUNCTION BLINKER 'SI:TV-CHARACTER-BLINKER FONTS:SHIP 0)
	       (SETQ TORP
		     (MAKE-OBJECT
		       OBJECT-NAME NIL OBJECT-BASE-CHAR NIL
		       OBJECT-TYPE 'TORP
		       OBJECT-RADIUS 'TORP-RADIUS
		       OBJECT-ACCELERATION 0
		       OBJECT-ANGLE 0
		       OBJECT-ANGULAR-VEL 0
		       OBJECT-HPROJ 1.0
		       OBJECT-VPROJ 0.0
		       OBJECT-COLLISION-FUNCTION 'TORP-COLLISION-FUNCTION
		       OBJECT-IMMOVABLE-FLAG NIL
		       OBJECT-BLINKER BLINKER))))
	 (LET ((BLINKER (OBJECT-BLINKER TORP)))
	   (SETF (OBJECT-HPOS TORP) HPOS)
	   (SETF (OBJECT-VPOS TORP) VPOS)
	   (SETF (OBJECT-HVEL TORP) HVEL)
	   (SETF (OBJECT-VVEL TORP) VVEL)
	   (SETF (OBJECT-LAST-FIRING-TIME TORP)
		 (+ CURRENT-CYCLE-NUMBER TORP-LIFETIME))
	   (SET-BLINKER-CURSORPOS BLINKER HPOS VPOS)
	   (TV-SET-BLINKER-VISIBILITY BLINKER T)
	   (PUSH TORP OBJECTS)))))

;; Detect collisions.
;; To make our work linear instead of quadratic,
;; we sort the list of objects by horizontal position.
;; Then, starting with each object, we need only check for collisions
;; with other objects until we find one that's too far away in
;; horizontal position.  All following objects must be even farther away.
;; However, this cannot be done for an object that's close to the left edge
;; since it might collide around the edge with an object far to the right.
(DEFUN COLLIDE-OBJECTS ()
  (SETQ OBJECTS (SORT OBJECTS #'(LAMBDA (O1 O2) ( (OBJECT-HPOS O1) (OBJECT-HPOS O2)))))
  (DO ((OBJECTS-REMAINING OBJECTS (CDR OBJECTS-REMAINING))) 
      ((NULL OBJECTS-REMAINING))
    (LET ((OBJECT (CAR OBJECTS-REMAINING)))
      (DOLIST (OBJECT1 (CDR OBJECTS-REMAINING))
	(AND (> (MIN (- (OBJECT-HPOS OBJECT1) (OBJECT-HPOS OBJECT))
		     (- (OBJECT-HPOS OBJECT) MINHPOS))
		(MAX (+ (SYMEVAL (OBJECT-RADIUS OBJECT)) SHIP-RADIUS)
		     TORP-TORP-COLLISION-DISTANCE))
	     (RETURN NIL))
	(AND (< (FIX (SQRT (+ (^ (FLOAT (- (OBJECT-HPOS OBJECT)
					   (OBJECT-HPOS OBJECT1)))
				 2)
			      (^ (FLOAT (- (OBJECT-VPOS OBJECT)
					   (OBJECT-VPOS OBJECT1)))
				 2))))
		(MAX (+ (SYMEVAL (OBJECT-RADIUS OBJECT)) (SYMEVAL (OBJECT-RADIUS OBJECT1)))
		     TORP-TORP-COLLISION-DISTANCE))
	     (PROGN (FUNCALL (COND ((EQ (OBJECT-TYPE OBJECT1) 'SUN) 'COLLIDE-WITH-SUN)
				   (T (OBJECT-COLLISION-FUNCTION OBJECT)))
			     OBJECT)
		    (FUNCALL (COND ((EQ (OBJECT-TYPE OBJECT) 'SUN) 'COLLIDE-WITH-SUN)
				   (T (OBJECT-COLLISION-FUNCTION OBJECT1)))
			     OBJECT1)))))))

;; Call this function on an object which collides with a sun.
(DEFUN COLLIDE-WITH-SUN (OBJECT)
  (COND ((EQ SUN-COLLISION-FLAG T)
	 ;; If the collision flag is T, colliding with a sun
	 ;; is like colliding with a ship or torp.
	 (FUNCALL (OBJECT-COLLISION-FUNCTION OBJECT) OBJECT))
	((EQ SUN-COLLISION-FLAG ':CORNER)
	 ;; If the collision flag is ':CORNER, colliding with a sun
	 ;; sends everything to the corner of the universe with no velocity.
	 (SETF (OBJECT-HVEL OBJECT) 0)
	 (SETF (OBJECT-VVEL OBJECT) 0)
	 (SETF (OBJECT-HPOS OBJECT) MINHPOS)
	 (SETF (OBJECT-VPOS OBJECT) MINVPOS))))

;; Colliding with something other than a sun
;; calls the colliding object's collision function.

;; When a ship collides, make it stop dead and blink.
(DEFUN SHIP-COLLISION-FUNCTION (SHIP)
  (COND ((NULL (OBJECT-DEAD-FLAG SHIP))
	 (SETF (OBJECT-ACCELERATION SHIP) 0)
	 (SETF (OBJECT-ANGULAR-VEL SHIP) 0)
	 (TV-SET-BLINKER-VISIBILITY (OBJECT-BLINKER SHIP) ':BLINK)
	 (SI:%BEEP (OR (CADR (ASSQ (OBJECT-NAME SHIP) SHIP-FREQ-ALIST))
		       TV-BEEP-WAVELENGTH)
		   100000)
	 (SETF (OBJECT-DEAD-FLAG SHIP) T)
	 (SETQ TIME-TILL-GAME-END DEATH-DELAY))))

;; When a torp collides, it disappears (and becomes free for re-use).
(DEFUN TORP-COLLISION-FUNCTION (TORP)
  (TV-SET-BLINKER-VISIBILITY (OBJECT-BLINKER TORP) NIL)
  (SETQ OBJECTS (DELQ TORP OBJECTS))
  (PUSH TORP FREE-TORPS))

;; Suns don't get hurt by collisions.
(DEFUN SUN-COLLISION-FUNCTION (SUN) SUN NIL)

;; Get rid of torps that have lived out their spans.
(DEFUN TORP-EXPIRE ()
  (DOLIST (TORP OBJECTS)
    (AND (EQ (OBJECT-TYPE TORP) 'TORP)
	 (< (OBJECT-LAST-FIRING-TIME TORP) CURRENT-CYCLE-NUMBER)
	 (TORP-COLLISION-FUNCTION TORP))))

;; Check for everyone out of torps and fuel and no torps on the screen.
(DEFUN GAME-EXPIRE ()
   (PROG NOT-OVER ()
	 (AND TIME-TILL-GAME-END (RETURN NIL))
	 (DOLIST (SHIP SHIPS)
	   (AND (OR (NOT (ZEROP (OBJECT-TORP-SUPPLY SHIP)))
		    (NOT (ZEROP (OBJECT-FUEL-SUPPLY SHIP))))
		(RETURN-FROM NOT-OVER NIL)))
	 (DOLIST (OBJ OBJECTS)
	   (AND (EQ (OBJECT-TYPE OBJ) 'TORP)
		(RETURN-FROM NOT-OVER NIL)))
	 (TV-BEEP)
	 (SETQ TIME-TILL-GAME-END DEATH-DELAY)))

;; Gravity and suns.

(DEFUN MAKE-SUN (HPOS VPOS)
  (LET ((BLINKER (TV-DEFINE-BLINKER NIL ':ROVING-P T)))
    (TV-SET-BLINKER-FUNCTION BLINKER 'SI:TV-CHARACTER-BLINKER FONTS:SHIP 1)
    (SET-BLINKER-CURSORPOS BLINKER HPOS VPOS)
    (TV-SET-BLINKER-VISIBILITY BLINKER T)
    (PUSH (MAKE-OBJECT
	    OBJECT-NAME 'SUN OBJECT-BASE-CHAR NIL
	    OBJECT-TYPE 'SUN
	    OBJECT-RADIUS 'SUN-RADIUS
	    OBJECT-HPOS HPOS OBJECT-VPOS VPOS
	    OBJECT-HVEL 0 OBJECT-VVEL 0
	    OBJECT-ACCELERATION 0
	    OBJECT-ANGLE 0
	    OBJECT-ANGULAR-VEL 0
	    OBJECT-HPROJ 1.0
	    OBJECT-VPROJ 0.0
	    OBJECT-COLLISION-FUNCTION 'SUN-COLLISION-FUNCTION
	    OBJECT-IMMOVABLE-FLAG T
	    OBJECT-BLINKER BLINKER)
	  SUNS))
  (PUSH (CAR SUNS) OBJECTS))

(DEFUN GRAVITATE-OBJECTS ()
  (DOLIST (SUN SUNS)
    (LET ((SHPOS (OBJECT-HPOS SUN))
	  (SVPOS (OBJECT-VPOS SUN)))
      (DOLIST (OBJECT OBJECTS)
	(OR (OBJECT-IMMOVABLE-FLAG OBJECT)
	    (PROG* ((RHPOS (- SHPOS (OBJECT-HPOS OBJECT)))	;H component of vector from
		    (RVPOS (- SVPOS (OBJECT-VPOS OBJECT)))	;obj to sun, and v component.
		    (RSQR (FLOAT (+ (* RHPOS RHPOS) (* RVPOS RVPOS))))	;Distance squared.
		    (DISTANCE (SQRT RSQR))
		    (ACCEL (* MASS-OF-SUN (// 100.0S0 RSQR))))
	      (SETF (OBJECT-HVEL OBJECT)
		    (+ (OBJECT-HVEL OBJECT)
		       (FIXR (* ACCEL (// RHPOS DISTANCE)))))
	      (SETF (OBJECT-VVEL OBJECT)
		    (+ (OBJECT-VVEL OBJECT)
		       (FIXR (* ACCEL (// RVPOS DISTANCE)))))))))))

;; Hyperspace, entering and returning.

(DEFUN HYPERSPACE (SHIP)
  (PUSH (LIST (+ CURRENT-CYCLE-NUMBER HYPERSPACE-DELAY) SHIP)
	HYPERSPACE-RETURN-SCHEDULE)
  ;; While in hyperspace, the ship is not visible,
  ;; does not move, accelerate or rotate, and can't collide or fire.
  (TV-SET-BLINKER-VISIBILITY (OBJECT-BLINKER SHIP) NIL)
  (SETF (OBJECT-DEAD-FLAG SHIP) 'HYPERSPACE)
  (SETQ OBJECTS (DELQ SHIP OBJECTS)))

(DEFUN RETURN-OBJECTS-FROM-HYPERSPACE (&AUX (PI 3.14159) (TWOPI (* 2 PI)))
  (DOLIST (ENTRY HYPERSPACE-RETURN-SCHEDULE)
    (AND (< (CAR ENTRY) CURRENT-CYCLE-NUMBER)
	 (LET ((OBJECT (CADR ENTRY))
	       ;; Random angle of orientation
	       (ANGLE (RANDOM-IN-RANGE 0 TWOPI))
	       ;; Random direction to move in.
	       (VELOCITY-ANGLE (RANDOM-IN-RANGE 0 TWOPI)))
	   (SETF (OBJECT-LAST-HYPERSPACE-TIME OBJECT) CURRENT-CYCLE-NUMBER)
	   ;; Give the ship a random position.
	   (SETF (OBJECT-HPOS OBJECT) (FIX (RANDOM-IN-RANGE MINHPOS MAXHPOS)))
	   (SETF (OBJECT-VPOS OBJECT) (FIX (RANDOM-IN-RANGE MINVPOS MAXVPOS)))
	   (SET-BLINKER-CURSORPOS (OBJECT-BLINKER OBJECT)
				  (OBJECT-HPOS OBJECT) (OBJECT-VPOS OBJECT))
	   ;; Give it a standard velocity in a random direction.
	   (SETF (OBJECT-HVEL OBJECT) (FIX (* (COS VELOCITY-ANGLE) HYPERSPACE-VELOCITY)))
	   (SETF (OBJECT-VVEL OBJECT) (FIX (* (SIN VELOCITY-ANGLE) HYPERSPACE-VELOCITY)))
	   ;; Give it a random orientation.
	   (SET-DIRECTION OBJECT ANGLE)
	   ;; Turn the ship "back on".
	   (SETF (OBJECT-DEAD-FLAG OBJECT) NIL)
	   (PUSH OBJECT OBJECTS)
	   (TV-SET-BLINKER-VISIBILITY (OBJECT-BLINKER OBJECT) T)
	   ;; The object has a certain chance of dying on return.
	   (AND (< (RANDOM-IN-RANGE 0 1.0) HYPERSPACE-DEATH-PROBABILITY)
		(FUNCALL (OBJECT-COLLISION-FUNCTION OBJECT) OBJECT))
	   ;; Now remove this entry from the hyperspace return schedule.
	   (SETQ HYPERSPACE-RETURN-SCHEDULE (DELQ ENTRY HYPERSPACE-RETURN-SCHEDULE))))))

(DEFUN RANDOM-IN-RANGE (LOW HIGH)
  (PROG ((R (RANDOM))
	 (RNORM (// (LOGAND R 777777) (FLOAT 1000000))))
	(RETURN (+ LOW (* RNORM (- HIGH LOW))))))

;; Top-level and process hackery.

(DEFUN SPACEWAR-GAME ()
  (INIT)
  (MOVE-LOOP))

(DEFUN SPACEWAR-TOP-LEVEL ()
  (DO () (())
    (SPACEWAR-GAME)))

(DEFVAR SPACEWAR-PROCESS (PROCESS-CREATE "Spacewar" "Spacewar"))

;; Start playing spacewar.
(DEFUN SPACEWAR ()
  (PROCESS-PRESET SPACEWAR-PROCESS 'SPACEWAR-TOP-LEVEL)
  (PROCESS-ENABLE SPACEWAR-PROCESS))

;; Stop playing spacewar.  Take the blinkers off the screen and stop the process.
(DEFUN STOP-SPACEWAR ()
  (AND (BOUNDP 'OBJECTS)
       (DOLIST (OBJECT OBJECTS)
	 (TV-SET-BLINKER-VISIBILITY (OBJECT-BLINKER OBJECT) NIL)))
  (MAPC #'(LAMBDA (REASON) (<- SPACEWAR-PROCESS ':REVOKE-RUN-REASON REASON))
	(<- SPACEWAR-PROCESS ':RUN-REASONS)))

;; This is the main loop while a game is in progress.
(DEFUN MOVE-LOOP ()
  (DO ((CURRENT-CYCLE-NUMBER 0 (1+ CURRENT-CYCLE-NUMBER))
       (NEXT-CYCLE (TIME)))
      (())
    (AND TIME-TILL-GAME-END
	 (OR (> (SETQ TIME-TILL-GAME-END (1- TIME-TILL-GAME-END)) 0)
	     (RETURN NIL)))
    (PROCESS-ALLOW-SCHEDULE)
    (PROCESS-WAIT "SLEEP" #'(LAMBDA (TIME1)
			      (TIME-LESSP TIME1 (TIME)))
		  NEXT-CYCLE)
    (SETQ NEXT-CYCLE (+ (TIME) (// 60. CPS)))
    (DECODE-BITS)
    (AND HYPERSPACE-RETURN-SCHEDULE
	 (RETURN-OBJECTS-FROM-HYPERSPACE))
    (TORP-EXPIRE)
    (GAME-EXPIRE)  ;Check for everyone out of torps and fuel.
    (COLLIDE-OBJECTS)
    (MOVE-OBJECTS)
    (ACCELERATE-OBJECTS)
    (ROTATE-OBJECTS)
    (GRAVITATE-OBJECTS)))

;; Set up for a new game.
(DEFUN INIT ()
  (AND (BOUNDP 'OBJECTS)
       (DOLIST (OBJECT OBJECTS)
	 (AND (EQ (OBJECT-TYPE OBJECT) 'TORP)
	      (NOT (MEMQ OBJECT FREE-TORPS))
	      (PUSH OBJECT FREE-TORPS))
	 (TV-SET-BLINKER-VISIBILITY (OBJECT-BLINKER OBJECT) NIL)))
  (SETQ OBJECTS NIL SUNS NIL SHIPS NIL HYPERSPACE-RETURN-SCHEDULE NIL)
  (SETQ TIME-TILL-GAME-END NIL)
  (AND SUN-FLAG (MAKE-SUN (* 300. UPD) (* 300. UPD)))
  (MAKE-SHIP 'FOO #/@ (* 100. UPD) (* 100. UPD) 0.0)
  (MAKE-SHIP 'BAR #/` (* 500. UPD) (* 500. UPD) 3.14159))

;; Create a ship, and put it on the list of objects.
;; The ship name should be a symbol.  The ship becomes the value of that symbol.
;; The base-char is the ascii code for the character which is the first
;; of the 32 character codes used for displaying this model of ship.
;; DIRECTION is which way the ship should face.  Typical values are 0 and 3.14159.
(DEFUN MAKE-SHIP (NAME BASE-CHAR HPOS VPOS DIRECTION)
  (LET ((BLINKER (TV-DEFINE-BLINKER NIL ':ROVING-P T)))
    (TV-SET-BLINKER-FUNCTION BLINKER 'SI:TV-CHARACTER-BLINKER FONTS:SHIP BASE-CHAR)
    (SET-BLINKER-CURSORPOS BLINKER HPOS VPOS)
    (PUSH (SET NAME
	       (MAKE-OBJECT
		 OBJECT-NAME NAME OBJECT-BASE-CHAR BASE-CHAR
		 OBJECT-TYPE 'SHIP
		 OBJECT-RADIUS 'SHIP-RADIUS
		 OBJECT-HPOS HPOS OBJECT-VPOS VPOS
		 OBJECT-HVEL 0 OBJECT-VVEL 0
		 OBJECT-ACCELERATION 0
		 OBJECT-ANGULAR-VEL 0
		 OBJECT-COLLISION-FUNCTION 'SHIP-COLLISION-FUNCTION
		 OBJECT-IMMOVABLE-FLAG NIL
		 OBJECT-TORP-SUPPLY SHIP-TORP-SUPPLY
		 OBJECT-FUEL-SUPPLY SHIP-FUEL-SUPPLY
		 OBJECT-LAST-FIRING-TIME -1000
		 OBJECT-LAST-HYPERSPACE-TIME -1000
		 OBJECT-BLINKER BLINKER))
	  OBJECTS)
    (SET-DIRECTION (CAR OBJECTS) DIRECTION)
    (TV-SET-BLINKER-VISIBILITY BLINKER T))
  (PUSH (CAR OBJECTS) SHIPS)
  (CAR OBJECTS))

;; Decoding the control switches

;; Each element of BIT-LIST looks like
;; (ship-name accel-bit turn-right-bit turn-left-bit fire-bit hyperspace-bit)
(DEFVAR BIT-LIST
	'((FOO 2 40 20 4 10)
	  (BAR 200 4000 2000 400 1000)))

;; Unibus address of the register of bits.
(DEFVAR BITS-ADDRESS 764126)

;; If this is not NIL, its value is used instead of the register of bits.
(DEFVAR DEBUGGING-BITS NIL)

(DEFUN RB () (%UNIBUS-READ BITS-ADDRESS))

(DEFUN DB (BITS) (SETQ DEBUGGING-BITS BITS))

(DEFUN DECODE-BITS (&AUX (BITS (OR DEBUGGING-BITS
				   (LOGXOR 177777 (SI:%UNIBUS-READ BITS-ADDRESS)))))
  (DOLIST (SHIP-BITS BIT-LIST)
    (LET ((SHIP (SYMEVAL (CAR SHIP-BITS))))
      (COND ((NULL (OBJECT-DEAD-FLAG SHIP)) 
	     (COND ((AND (BIT-TEST (SECOND SHIP-BITS) BITS)
			 (NOT (ZEROP (OBJECT-FUEL-SUPPLY SHIP))))
		    (SETF (OBJECT-FUEL-SUPPLY SHIP)
			  (1- (OBJECT-FUEL-SUPPLY SHIP)))
		    (SETF (OBJECT-ACCELERATION SHIP) SHIP-ACCELERATION))
		   (T (SETF (OBJECT-ACCELERATION SHIP) 0)))
	     (COND ((BIT-TEST (THIRD SHIP-BITS) BITS)
		    (SETF (OBJECT-ANGULAR-VEL SHIP) SHIP-TURNING-RATE))
		   ((BIT-TEST (FOURTH SHIP-BITS) BITS)
		    (SETF (OBJECT-ANGULAR-VEL SHIP) (- SHIP-TURNING-RATE)))
		   (T (SETF (OBJECT-ANGULAR-VEL SHIP) 0)))
	     (COND ((BIT-TEST (FIFTH SHIP-BITS) BITS)
		    (TRY-TO-FIRE SHIP)))
	     (COND ((BIT-TEST (SIXTH SHIP-BITS) BITS)
		    (TRY-TO-HYPERSPACE SHIP))))))))

(DEFUN TRY-TO-FIRE (SHIP)
  (AND (< (+ TORP-RELOAD-TIME (OBJECT-LAST-FIRING-TIME SHIP))
	  CURRENT-CYCLE-NUMBER)
       (FIRE-TORP SHIP)))

(DEFUN TRY-TO-HYPERSPACE (SHIP)
  (AND (< (+ HYPERSPACE-RELOAD-TIME (OBJECT-LAST-HYPERSPACE-TIME SHIP))
	  CURRENT-CYCLE-NUMBER)
       (HYPERSPACE SHIP)))