;------------------------------------------------
; SPACEWARS in AutoLISP Version 2.0
; Bill Kramer April 1992 CADENCE
; Updated May 1995 for AutoCAD R13 Operations
; AUTOCAD TECH JOURNAL
; Updated Dec 95 by CAD Studio CB
;
; PUBLIC DOMAIN SOFTWARE
;
; This program is meant to be further hacked for
; the shear pleasure of it.
;
; No tech support, if it doesn't work on your
; system, well, sorry. But it has been tested
; on the following platforms:
;
; MS-DOS R12 VGA w/MS-Mouse Works ok
; MS-DOS R13 VGA w/MS-Mouse Works ok
; Windows R13 VGA w/MS-Mouse Did not work
; Windows R12 VGA w/MS-Mouse Did not work
;------------------------------------------------
; These activities and settings take place while
; the program is loading.
;
(setq Turn_ANG1 (/ PI 20)
Turn_ANG2 (/ PI 20)
TURN_TIME 0.000005787 ; increase for 386's
;;
;;Ship List defines ship abilities
;; Nam String name of ship type
;; MxV Maximum Velocity
;; TT Torpedoes range
;; TC Torpedoes available
;; TDP Torpedo destructive power
;; DFP Defensive field power
;; SIZ Size of ship [radius]
;; ACC Accel factor [lower is faster]
;; Turn Angular turn per command
;;
SHIPS (list
;Nam MxV TT TC TDP DFP SIZ ACC Turn speed
(list "1" 3.0 35 25 0.6 1.0 1.0 4.0 (/ PI 20))
(list "2" 2.0 70 25 0.8 2.0 1.5 10.0 (/ PI 30))
(list "3" 1.5 100 100 1.1 5.0 2.5 25.0 (/ PI 60))
(list "4" 1.0 100 500 2.1 12.0 5.0 50.0 (/ PI 80))
))
(setvar "CMDECHO" 0)
(setvar "BLIPMODE" 0)
;;
;;Now load the block SPACE which contains
;;definitions for the space ship blocks
;;used in the game. Blocks S1 through
;;S4 are expected to be defined in
;;block SPACE. A copy of SPACE.DWG is
;;included in the download ZIP file.
;;
(if (null (tblsearch "BLOCK" "SPACE"))
(if (findfile "SPACE.DWG")
(command "_INSERT"
"SPACE"
(list 0 0 0)
1 1 0
"_ERASE"
(entlast)
""
)
(alert "Could not find SPACE.DWG seed file!")
)
)
;
;------------------------------------------------
; Main Program
;------------------------------------------------
(defun C:SW ()
(SetUpVars) ;;Prepare global variables
;;
(setq GAME_OVER nil ;;'T when game is done
GAME_ON 'T ;;toggle flag
)
(prompt "\nBattle start")
(setvar "COORDS" 0)
(grtext -2 " SPACE WARS - Bill Kramer")
;;
;; Main Event Loop
(while (null GAME_OVER)
(grtext -1 ;;display ship settings
(strcat
"T1= " (itoa S1_AMMO)
" D1= " (rtos S1_DEF 2 2)
" T2= " (itoa S2_AMMO)
" D2= " (rtos S2_DEF 2 2)))
;;
;; Get the user keystroke
(setq KEY (grread 'T))
;;
;; React to keystroke
(if KEY (key_action KEY))
;;
;; Update objects
(if (null GAME_OVER) (move_action))
)
;;Game Over, clean up the mess...
;;
(command "_REDRAW")
;;Get rid of running torpedoes
(if (and T1_OBJ (entget (last T1_OBJ)))
(entdel (last T1_OBJ)))
(if (and T2_OBJ (entget (last T2_OBJ)))
(entdel (last T2_OBJ)))
(setq T1_OBJ nil T2_OBJ nil
T1_LIFE -1 T2_LIFE -1)
;;
;;Get rid of existing ships
(entdel (last S1_OBJ))
(entdel (last S2_OBJ))
;;
;;Report Game Results
(cond
((and (minusp S1_DEF) (minusp S2_DEF))
(prompt "\nBoth ships destroyed.")
)
((minusp S1_DEF)
(prompt "\nShip 2 is victorious!")
)
((minusp S2_DEF)
(prompt "\nShip 1 is victorious!")
)
)
(princ)
)
;
;------------------------------------------------
; Prepare global variables.
;
(defun SETUPVARS ( / P1 P2)
(prompt "\n\nSPACE WARS! Bill Kramer 1995")
(prompt " Version 2.0 AutoCAD Tech Journal")
(setq USCALE (/ (getvar "VIEWSIZE") 100.0)
T1_LIFE -1 ;;No torpedoes running
T2_LIFE -1 ;;initially.
T1_OBJ nil
T2_OBJ nil
)
;;
;; Get screen limits from operator
;;
(if (or (null UMIN) (null UMAX))
(setq
UMIN
(getpoint
"\nLower left corner of battle area: ")
UMAX
(getpoint
"\nUpper right corner of battle area: ")
)
)
(textscr)
;;
;;How many users? Game will auto
;;play ship 2 for single user.
;;
(setq N_USERS
(getint
"\nEnter # of players <1> or 2: ")
)
(if (null N_USERS) (setq N_USERS 1))
(if (or (> N_USERS 2) (< N_USERS 1))
(setq N_USERS 1))
;;
(prompt "\nSPACE WARS!\n\nKeyboard Usage:")
(prompt "\n\nShip 1: (A) turn to the left")
(prompt "\n (S) Thruster burst")
(prompt "\n (D) turn to the right")
(prompt "\n (F) fire torpedo")
(if (= N_USERS 2) (progn
(prompt "\n\nShip 2: (J) turn to the left")
(prompt "\n (K) Thruster burst")
(prompt "\n (L) turn to the right")
(prompt "\n (;) fire torpedo")
))
(prompt "\n\nBasic Ship Types:")
(prompt "\n 1 Quick fighter")
(prompt "\n 2 Slow fighter")
(prompt "\n 3 Battle Station")
(prompt "\n 4 Super Battle Station")
(initget 0 "1 2 3 4")
(setq TMP
(getkword
"\nPick ship 1 type [1..4] <1>: "))
(if (null TMP) (setq TMP "1"))
(setq S1_TYP TMP)
;;
(initget 0 "1 2 3 4")
(setq TMP
(getkword
"\nPick ship 2 type [1..4] <3>: "))
(if (null TMP) (setq TMP "3"))
(setq S2_TYP TMP)
;;
(graphscr)
(setq P1 (getpoint "\nShip 1 Location: ")
P2 (getpoint P1 "\n Orientation: ")
)
;; Define Ship 1 object list containing
;; current point, velocity, facing, size
(setq S1_OBJ
(list
P1
(/
(* USCALE
(cadr (assoc S1_TYP SHIPS)))
4.0)
(angle P1 P2)
(* USCALE (nth 6 (assoc S1_TYP SHIPS)))
))
;;
;; Insert graphic object for ship
(command "_INSERT"
(strcat "S" S1_TYP)
(car S1_OBJ)
USCALE ""
(angtos (caddr S1_OBJ)))
;; Save entity name on Object list
(setq S1_OBJ (append S1_OBJ (list (entlast)))
;;
;;Define ship 1's globals from
;;ship list.
;;
;;Torpedo duration
TORP1_LIFE (nth 2 (assoc S1_TYP SHIPS))
;;Torpedo damage
TORP1_DMG (nth 4 (assoc S1_TYP SHIPS))
;;Defense rating
S1_DEF (nth 5 (assoc S1_TYP SHIPS))
;;Max velocity
S1_MAXV (* USCALE
(nth 1 (assoc S1_TYP SHIPS)))
;;Avaialable ammo
S1_AMMO (nth 3 (assoc S1_TYP SHIPS))
;;Accel factor
S1_ACC (nth 7 (assoc S1_TYP SHIPS))
;;Helm response factor
Turn_ANG1 (nth 8 (assoc S1_TYP SHIPS))
;;Ship type code
S1_TYP (atoi S1_TYP)
)
;;
(setq P1 (getpoint "\nShip 2 Location: ")
P2 (getpoint P1 "\n Orientation: ")
)
;;
;;build Ship 2 object and globals as
;;in ship 1.
;;
(setq S2_OBJ (list
P1
(/ (* USCALE
(cadr
(assoc S2_TYP SHIPS)))
4.0)
(angle P1 P2)
(* USCALE
(nth 6 (assoc S2_TYP SHIPS)))
))
(command "_INSERT"
(strcat "S" S2_TYP)
(car S2_OBJ)
USCALE ""
(angtos (caddr S2_OBJ)))
(setq S2_OBJ (append S2_OBJ (list (entlast)))
TORP2_LIFE (nth 2 (assoc S2_TYP SHIPS))
TORP2_DMG (nth 4 (assoc S2_TYP SHIPS))
S2_DEF (nth 5 (assoc S2_TYP SHIPS))
S2_MAXV (* USCALE
(nth 1 (assoc S2_TYP SHIPS)))
S2_AMMO (nth 3 (assoc S2_TYP SHIPS))
S2_ACC (nth 7 (assoc S2_TYP SHIPS))
Turn_ANG2 (nth 8 (assoc S2_TYP SHIPS))
S2_TYP (atoi S2_TYP)
)
(getstring "\n\nPress Enter when ready")
(graphscr)
)
;------------------------------------------------
; Do what the operator has requested.
;
(defun KEY_ACTION (KEY)
;;check to see if auto user input needed.
(if (and (= N_USERS 1)
(/= (car KEY) 2)
)
;;Yes it is, do automatic move
(setq KEY (AUTO_USER KEY))
)
;;Respond to key board input only
(if (= (car KEY) 2)
(progn
;;convert ASCII code into string
;;Note: for speed improvement, do all
;; the tests with integer codes.
(setq KEY (strcase (chr (cadr KEY))))
(cond
((= KEY "S")
(Tell_It "\nShip 1: Thruster fire")
(setq S1_OBJ
(Thrust S1_OBJ S1_MAXV S1_ACC)))
((= KEY "A")
(Tell_It "\nShip 1: Turn left")
(Turn S1_OBJ Turn_ANG1))
((= KEY "D")
(Tell_It "\nShip 1: Turn right")
(Turn S1_OBJ (* -1 Turn_ANG1)))
((= KEY "F")
(Tell_It "\nShip 1: Fire request")
(if (and (null T1_OBJ) (> S1_AMMO 0))
(setq T1_OBJ (fire S1_OBJ 0 4)
S1_AMMO (1- S1_AMMO)
T1_LIFE TORP1_LIFE)
))
((= KEY "K")
(Tell_It "\nShip 2: Thruster fire")
(setq S2_OBJ
(Thrust S2_OBJ S2_MAXV S2_ACC)))
((= KEY "J")
(Tell_It "\nShip 2: Turn left")
(Turn S2_OBJ Turn_ANG2))
((= KEY "L")
(Tell_It "\nShip 2: Turn right")
(Turn S2_OBJ (* -1 Turn_ANG2)))
((= KEY ";")
(Tell_It "\nShip 2: Fire request")
(if (and (null T2_OBJ) (> S2_AMMO 0))
(setq T2_OBJ
(fire S2_OBJ
(if (= 1 N_USERS)
S2_TYP
0)
2)
S2_AMMO (1- S2_AMMO)
T2_LIFE TORP2_LIFE)
))
((= KEY "P")
(Laser_Fire)
)
);;end COND
)
)
)
;------------------------------------------------
;
; MOVE_ACTION Updates objects on the screen
;
(defun MOVE_ACTION ()
(setq VMAX (list (cadr S1_OBJ) (cadr S2_OBJ)))
(if T1_OBJ
(setq VMAX (cons (cadr T1_OBJ) VMAX)))
(if T2_OBJ
(setq VMAX (cons (cadr T2_OBJ) VMAX)))
(setq VMAX (apply 'max VMAX)
TT (/ VMAX USCALE)
RTC (getvar "DATE")
CNT 0
)
(if (not (zerop TT))
(while (< CNT (1+ (fix TT)))
(setq S1_OBJ
(move_obj S1_OBJ
(/ (cadr S1_OBJ) TT))
S2_OBJ
(move_obj S2_OBJ
(/ (cadr S2_OBJ) TT))
GAME_ON (hit_miss S1_OBJ S2_OBJ))
(if (null GAME_ON)
(progn
(prompt "\nCollision!")
(setq S1_DEF -1.0
S2_DEF -1.0
GAME_OVER 'T)
)
)
(if (and T1_OBJ
(> T1_LIFE 0)
(null GAME_OVER))
(progn
(setq T1_OBJ
(move_obj T1_OBJ
(/ (cadr T1_OBJ)
TT))
T1_LIFE (1- T1_LIFE)
GAME_ON
(hit_miss T1_OBJ S2_OBJ))
(if (null GAME_ON)
(progn
(entdel (last T1_OBJ))
(prompt "\nTopedo hit on Ship 2!")
(setq S2_DEF (- S2_DEF TORP1_DMG)
T1_OBJ nil
Turn_ANG2
(- Turn_ANG2
(/ Turn_ANG2 4))
S2_ACC (- S2_ACC
(/ S2_ACC 4))
T1_LIFE -1)
(if (minusp S2_DEF) (progn
(prompt " DESTROYED!")
(setq GAME_OVER 'T)
)
(setq GAME_ON 'T)
)
)
)
)
)
(if (and T2_OBJ
(> T2_LIFE 0)
(null GAME_OVER))
(progn
(setq T2_OBJ
(move_obj T2_OBJ
(/ (cadr T2_OBJ)
TT))
T2_LIFE (1- T2_LIFE)
GAME_ON
(hit_miss T2_OBJ S1_OBJ))
(if (null GAME_ON)
(progn
(entdel (last T2_OBJ))
(prompt "\nShip 1 hit!")
(setq S1_DEF (- S1_DEF TORP2_DMG)
T2_OBJ nil
Turn_ANG1
(- Turn_ANG1
(/ Turn_ANG1 4))
S1_ACC (- S1_ACC
(/ S1_ACC 4))
T1_LIFE -1)
(if (minusp S1_DEF) (progn
(prompt " DESTROYED!")
(setq GAME_OVER 'T)
)
(setq GAME_ON 'T)
)
)
)
)
)
(if (and GAME_ON T1_OBJ T2_OBJ)
(if (null (hit_miss T1_OBJ T2_OBJ))
(setq T1_OBJ (entdel (last T1_OBJ))
T2_OBJ (entdel (last T2_OBJ))
T1_OBJ nil
T2_OBJ nil
T1_LIFE -1
T2_LIFE -1
)
)
)
(setq CNT (1+ CNT))
(if (null GAME_ON) (setq CNT (1+ TT)))
(if (null GAME_OVER) (progn
(setq KEY (grread 'T))
(if KEY (key_action KEY))
))
)
)
(while (< (- (getvar "DATE") RTC) TURN_TIME))
(if (zerop S1_AMMO)
(Tell_It "\nShip 1 out of ammunition."))
(if (zerop S2_AMMO)
(Tell_It "\nShip 2 out of ammunition."))
(if (zerop T1_LIFE)
(progn
(entdel (last T1_OBJ))
(torp_expl T1_OBJ)
(Tell_It "\nTorpedo 1 detonation")
(setq T1_OBJ nil T1_LIFE -1)
)
)
(if (zerop T2_LIFE)
(progn
(entdel (last T2_OBJ))
(torp_expl T2_OBJ)
(Tell_It "\nTorpedo 2 detonation")
(setq T2_OBJ nil T2_LIFE -1)
)
)
)
;------------------------------------------------
;
; Update Thrust vectors for object
;
(defun Thrust (OBJ MAXV VINC)
(setq V1 (polar (list 0 0)
(caddr OBJ)
(cadr OBJ))
V2 (polar (list 0 0)
(cdr
(assoc 50
(entget
(last OBJ))))
(/ USCALE VINC))
V1 (mapcar '+ V1 V2)
)
(if (> (distance (list 0 0) V1) MAXV)
(setq V1 (polar (list 0 0)
(angle (list 0 0) V1)
MAXV)))
(list (car OBJ)
(distance (list 0 0) V1)
(angle (list 0 0) V1)
(cadddr OBJ)
(last OBJ)
)
)
;------------------------------------------------
;
; TURN an object
;
(defun TURN (OBJ ANG)
(setq EL (entget (last OBJ))
EL (subst (cons 50
(+ (cdr (assoc 50 EL))
ANG))
(assoc 50 EL)
EL)
)
(entmod EL)
)
;------------------------------------------------
; Fire Control
;
(defun FIRE (OBJ TYP CLR)
(entmake (list
(cons 0 "CIRCLE")
(cons 8 "0")
(cons 62 CLR)
(cons 10 (car OBJ))
(cons 40 (/ USCALE 2))
))
(setq EL (entget (entlast)))
(list (cdr (assoc 10 EL))
(* USCALE 5)
(if (< TYP 3)
;;user control and smaller ships
;;support front fire only.
(cdr (assoc 50 (entget (last OBJ))))
;;auto-ship classes 3 & 4 support
;;omni-directional firing.
(angle (car S2_OBJ) (car S1_OBJ))
)
USCALE
(entlast)
)
)
;------------------------------------------------
;
; hit_miss determination
; return 'T if miss, nil if hit.
;
(defun HIT_MISS (M_OBJ T_OBJ)
(setq DD (distance (car M_OBJ) (car T_OBJ)))
(if (and (> DD
(+ (cadddr M_OBJ)
(cadddr T_OBJ)))
GAME_ON
)
'T ;; No hit
(explosion M_OBJ) ;;hit
)
)
;------------------------------------------------
;
(defun EXPLOSION (OBJ / CNT)
(setq CNT 0.5)
(repeat 10
(entmake (list
(cons 0 "CIRCLE")
(cons 8 "0")
(cons 62 1)
(cons 10 (car OBJ))
(cons 40 (* CNT USCALE))
))
(setq EN (entlast))
(repeat 11
(entdel EN))
(setq CNT (+ CNT 0.5))
)
nil
)
;------------------------------------------------
(defun TORP_EXPL (OBJ / CNT)
(setq CNT 0.5)
(repeat 2
(entmake (list
(cons 0 "CIRCLE")
(cons 8 "0")
(cons 62 1)
(cons 10 (car OBJ))
(cons 40 (* CNT USCALE))
))
(setq EN (entlast))
(repeat 5
(entdel EN))
(setq CNT (+ CNT 0.5))
)
nil
)
;------------------------------------------------
;
(defun MOVE_OBJ (OBJ FAR / P1 EL)
(setq P1 (polar (car OBJ) (caddr OBJ) FAR))
(if (< (car P1) (car UMIN))
(setq P1 (list (car UMAX) (cadr P1) 0.0)))
(if (< (cadr P1) (cadr UMIN))
(setq P1 (list (car P1) (cadr UMAX) 0.0)))
(if (> (car P1) (car UMAX))
(setq P1 (list (car UMIN) (cadr P1) 0.0)))
(if (> (cadr P1) (cadr UMAX))
(setq P1 (list (car P1) (cadr UMIN) 0.0)))
(if (or (= (length P1) 2)
(/= (caddr P1) 0.000))
(setq P1 (list (car P1) (cadr P1) 0.0)))
(setq EL (entget (last OBJ))
EL (subst (cons 10 P1) (assoc 10 EL) EL)
)
(entmod EL)
(cons P1 (cdr OBJ))
)
;------------------------------------------------
; Laser Fire
;
(defun LASER_FIRE ()
(grdraw (car S2_OBJ) (car S1_OBJ) 1)
(prompt "\nShip 2: Laser Fire - power=")
(setq AA (angle (car S2_OBJ)
(car S1_OBJ))
DD (/
(distance
(car S2_OBJ)
(car S1_OBJ))
USCALE)
DD (/ S2_TYP (* DD DD))
S1_DEF (- S1_DEF DD)
)
(princ DD)
(if (< S1_DEF 0.0) (progn
(prompt "\nShip 1 destroyed!")
(setq GAME_OVER 'T
GAME_ON nil
)
))
(grdraw (car S2_OBJ) (car S1_OBJ) 0)
)
;------------------------------------------------
(defun AUTO_USER (KEY / RAND AA)
(setq RAND (rtos (getvar "CDATE") 2 8)
RAND (atoi (substr RAND (strlen RAND)))
AA (cdr
(assoc 50 ;;get facing direction
(entget
(last S2_OBJ))))
)
(cond
((and (> S2_TYP 2) (< RAND 1)) ;;long range lasers
(list 2 (ascii "P"))
)
((and (< RAND 4)
(null T2_OBJ)
(equal (angle (car S2_OBJ)
(car S1_OBJ))
AA
;;fuzz factor varies based
;;on ship type.
(cond ((= S2_TYP 4) (* PI 2.0))
((= S2_TYP 3) PI)
((= S2_TYP 2) (/ PI 2))
((= S2_TYP 1) (/ PI 4))
)
)
(< (distance (car S1_OBJ) (car S2_OBJ))
(* 0.75 USCALE TORP2_LIFE))
)
(list 2 (ascii ";"))
)
((< RAND 6) ;;rotate towards enemy
(if (< (angle (car S2_OBJ) (car S1_OBJ))
AA)
(list 2 (ascii "L"))
(list 2 (ascii "J"))
)
)
((< RAND 8) ;;fire Thrusters
(list 2 (ascii "K"))
)
(t KEY) ;;otherwise do nothing
)
)
;------------------------------------------------
; Set Game_Tacer to 'T to have prompts appear for
; each keystroke command entered into the system.
;
(defun Tell_It (P)
(if GAME_TRACER (prompt P))
)
;------------------------------------------------
;
(prompt "\nTurn OFF UNDO system before playing!")
(prompt "\nEnter SW to start battle....")
(princ)
(
geocities.com/wpsmoke/acadalisptrng) (
geocities.com/wpsmoke)