Game on Cad

Tháng 9 1, 2008

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

; Program Name: Troy.lsp [Troy R5] - Asteroids AutoLISP game

; Created By: phamtuan (Email: tuanngph@hpc.org.vn)

; Date Created: 1-20-06

; Notes: Troy is an Asteroids AutoLISP game driven by the grread function.

; It can be run inside of an existing drawing. When it's finished,

; it purges all entities, styles and layers it created. You have

; three ships to use to shoot down as many Troys as possible. If

; a Troy runs into your ship, it blows up your ship and you loose

; 10 points. Each Troy you blow up, you gain its value in points.

; Use the mouse to keep the game moving. Pick the mouse to fire

; at Troys. Each fire cost you 1 point. Press P to pause the game.

; Press Q to quit the game before it ends, in order to purge all

; entities, styles and layers it created. If you press the escape

; key to abort the game, simply rerun Troy again and select the

; Clear option. So do not press the escape key to abort the game.

; Disclaimer: This program is free to download and share and learn from. It

; contains many useful functions that may be applied else where.

; Every effort on my part has been to create a grread game that

; will run in most versions of AutoCAD, and when finished it will

; return to the environment before it started. Troy is now yours

; to tweak, debug, add to, rename, use parts of, or create another

; grread game from. It is now your responsibility when, and within

; what drawings you should run it. If you are unsure of how it may

; affect certain drawing environments, do a saveas before running

; it. Do not save a drawing without running the Troy Clear option.

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

; Revision History

; Rev By Date Description

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

; 1 TM 1-20-06 Initial version.

; 2 TM 6-20-06 Revised PurgeGroups function.

; 3 TM 6-24-06 Revised program to switch to the Model tab if there are

; viewports on the current Layout tab.

; 4 TM 6-26-06 Added Settings option to adjust number of Troys, speed of

; Troys and Color Scheme.

; 5 TM 1-1-07 The *_nth list functions were revised for maximum speed.

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

; c:Troy - Asteroids AutoLISP game

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

(defun c:Troy (/ Colors$ Loop Option$ Settings$)

(initget "Intro Clear Settings Play")

(if (not (setq Option$ (getkword "\nTroy options [intro/Clear/Settings/<Play>]: ")))

(setq Option$ "Play")

);if

(cond

((= Option$ "Clear")(TroyClear)(princ "\nTroy objects Cleared."))

((= Option$ "Settings")

(initget "Troys Speed Colors Defaults")

(if (not (setq Settings$ (getkword "\nSettings [Troys/Speed/Colors/<Defaults>]: ")))

(setq Settings$ "Defaults")

);if

(cond

((= Settings$ "Troys")

(setq Loop t)

(while Loop

(if (not (setq *MinTroys#* (getint "\nMinimum number of Troys <5>: ")))

(setq *MinTroys#* 5)

);if

(if (not (setq *MaxTroys#* (getint "\nMaximum number of Troys <10>: ")))

(setq *MaxTroys#* 10)

);if

(if (or (< *MinTroys#* 1) (<= *MaxTroys#* *MinTroys#*))

(princ "\nThe maximum number must be greater than the minimum number,\nand the minimum number must be greater than 0.")

(setq Loop nil)

);if

);while

(if (> *MaxTroys#* 20)

(princ "\nIncreasing the maximum number of Troys may slow down the game.")

);if

);case

((= Settings$ "Speed")

(setq Loop t)

(while Loop

(if (not (setq *TroySpeed~* (getreal "\nAdjust speed of Troys\nEnter a number between 0.5 and 5.0 <1.0>: ")))

(setq *TroySpeed~* 1.0)

);if

(if (or (< *TroySpeed~* 0.5)(> *TroySpeed~* 5.0))

(princ "\nThe number must in the range of 0.5 to 5.0.\nThe larger the number the faster the Troys move.")

(setq Loop nil)

);if

);while

);case

((= Settings$ "Colors")

(initget "Bright Dim Ghost")

(if (not (setq Colors$ (getkword "\nColor Scheme [<Bright>/Dim/Ghost]: ")))

(setq Colors$ "Bright")

);if

(setq *ColorScheme#*

(cond

((= Colors$ "Bright") 1)

((= Colors$ "Dim") 2)

((= Colors$ "Ghost") 3)

);cond

);setq

);case

((= Settings$ "Defaults")

(setq *MinTroys#* 5 *MaxTroys#* 10 *TroySpeed~* 1.0 *ColorScheme#* 1)

);case

);cond

(c:Troy)

);case

(t (Troy Option$))

);if

(princ)

);defun c:Troy

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

; Troy - Troy main function

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

(defun Troy (Option$ / AddArray: Ang~ AxisPt BuildShip: CenPt ChangeArray: CirAng~

CirEnt^ CirLimits~ CirPt1 CirPt2 Color1 Color1_5 Color2 Color3 Color4 Color5

Color6 Color7 Color8 Cnt# Code# Counter# CreateArray: Dia1~ Dia2~ Direction#

Dist~ Ent^ Ent1^ Ent2^ Flame$ Flame^ FlameArray@ HalfStep~ Inc# Inc1~ Inc2~

Increase~ Item Limit# Loop MainEnt^ MainList@ MainNum# NorthEast NorthWest

Nth# Nths@ Num# NumSteps# Offset~ OldDirection# Option$ Passed Pnts# Points#

Previous@ Pt Pt1 Pt2 Pt3 Pt4 Pt5 Pt6 Pt7 Pt8 Pt9 Pt10 Pt11 Pt12 Radius~ Read@

Refresh: Rotate~ ShipName$ SouthEast SouthWest SS& StepDist~ SubList@ TextEnt^

Total# TroyArray@ Unit~ Value ViewExtents@ ViewSize~ Xmin~ Xmax~ Ymin~ Ymax~)

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

; AddArray: - Add new Troy entity specs to the TroyArray@ list

; Arguments: 1

; StartPt = Specify starting point or nil

; Returns: A list of a new random Troy specs to be added to TroyArray@ list

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

(defun AddArray: (StartPt / Ang~ Num#)

(if StartPt

(setq CirPt1 StartPt)

(setq CirPt1 (polar CenPt (* (GetRnd 6283) 0.001) CirLimits~))

);if

(setq Num# (GetRnd 8))

(setq StepDist~;Determines Troys Speed

(cond; Points Dia Units

((= Num# 0)(* Unit~ 0.100 *TroySpeed~*));50 2.0

((= Num# 1)(* Unit~ 0.125 *TroySpeed~*));75 2.5

((= Num# 2)(* Unit~ 0.150 *TroySpeed~*));100 3.0

((= Num# 3)(* Unit~ 0.175 *TroySpeed~*));125 3.5

((= Num# 4)(* Unit~ 0.200 *TroySpeed~*));150 4.0

((= Num# 5)(* Unit~ 0.225 *TroySpeed~*));175 4.5

((= Num# 6)(* Unit~ 0.250 *TroySpeed~*));200 5.0

((= Num# 7)(* Unit~ 0.275 *TroySpeed~*));225 5.5

((= Num# 8)(* Unit~ 0.300 *TroySpeed~*));250 6.0

);cond

);setq

(setq HalfStep~ (/ StepDist~ 2.0))

(setq Points# (+ (* Num# 25) 50));50 to 250

(setq Radius~ (/ (* Unit~ (* 0.1 (+ (+ (* Num# 5) 10) 10))) 2.0))

(command "_CIRCLE" CirPt1 Radius~)

(setq Ent1^ (entlast))

(command "_CHPROP" Ent1^ "" "_C" Color8 "")

(command "_HATCH" "AR-CONC" (* (getvar "VIEWSIZE") 0.0045) "" Ent1^ "")

(setq Ent2^ (entlast))

(command "_CHPROP" Ent2^ "" "_C" Color8 "")

(command "_-GROUP" "_C" (UniqueName) "" Ent1^ Ent2^ "")

(setq CirEnt^ (entlast))

(setq CirAng~ (+ (- (angle CirPt1 CenPt) (dtr 30)) (* (GetRnd 1047) 0.001)))

(setq CirPt2 (polar CirPt1 CirAng~ StepDist~))

(setq Offset~ (+ (* Radius~ 2)(* Radius~ (GetRnd 10))))

(setq Ang~ (atan (/ HalfStep~ Offset~)))

(setq Pt (polar CirPt1 CirAng~ HalfStep~))

(if (< CirAng~ (angle CirPt1 CenPt))

(setq AxisPt (polar Pt (+ CirAng~ (dtr 90)) Offset~) Direction# 1)

(setq AxisPt (polar Pt (- CirAng~ (dtr 90)) Offset~) Direction# -1)

);if

(setq NumSteps# (+ (GetRnd 10) 2))

(list CirEnt^ CirPt1 CirPt2 AxisPt Radius~ Direction# NumSteps# Points#)

);defun AddArray:

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

; ChangeArray: - Change or Move entity in the TroyArray@ list

; Arguments: 1

; List@ = A sublist within the TroyArray@ list

; Returns: Changes or Moves Troy entities in the TroyArray@ list

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

(defun ChangeArray: (List@ / Ang~ Num#)

(setq CirEnt^ (nth 0 List@)

CirPt1 (nth 1 List@)

CirPt2 (nth 2 List@)

AxisPt (nth 3 List@)

Radius~ (nth 4 List@)

Direction# (nth 5 List@)

NumSteps# (nth 6 List@)

Points# (nth 7 List@)

StepDist~ (distance CirPt1 CirPt2)

HalfStep~ (/ StepDist~ 2.0)

Ang~ (- (* pi 0.5)(acos (/ HalfStep~ (distance AxisPt CirPt2))))

);setq

(command "_MOVE" CirEnt^ "" CirPt1 CirPt2)

(setq NumSteps# (1- NumSteps#))

(if (= NumSteps# 0)

(progn

(setq NumSteps# (+ (GetRnd 10) 2))

(setq OldDirection# Direction#)

(setq Num# (GetRnd 10))

(if (> Num# 5)

(setq Direction# 1);ccw

(setq Direction# -1);cw

);if

(setq Offset~ (+ (* Radius~ 2)(* Radius~ (GetRnd 10))))

(if (= OldDirection# 1);ccw

(if (= Direction# 1);ccw

(setq AxisPt (polar CirPt2 (angle CirPt2 AxisPt) Offset~))

(setq AxisPt (polar CirPt2 (angle AxisPt CirPt2) Offset~))

);if

(if (= Direction# -1);cw

(setq AxisPt (polar CirPt2 (angle CirPt2 AxisPt) Offset~))

(setq AxisPt (polar CirPt2 (angle AxisPt CirPt2) Offset~))

);if

(setq Ang~ (- (* pi 0.5)(acos (/ HalfStep~ Offset~))))

(if (= Direction# 1);ccw

(setq Pt (polar AxisPt (+ (angle AxisPt CirPt2) (* Ang~ 2)) (distance AxisPt CirPt2)))

(setq Pt (polar AxisPt (- (angle AxisPt CirPt2) (* Ang~ 2)) (distance AxisPt CirPt2)))

);if

(setq CirPt1 CirPt2 CirPt2 Pt)

);progn

(if (= Direction# 1);ccw

(progn

(setq Pt (polar AxisPt (+ (angle AxisPt CirPt2) (* Ang~ 2)) (distance AxisPt CirPt2)))

(setq CirPt1 CirPt2 CirPt2 Pt)

);progn

(progn

(setq Pt (polar AxisPt (- (angle AxisPt CirPt2) (* Ang~ 2)) (distance AxisPt CirPt2)))

(setq CirPt1 CirPt2 CirPt2 Pt)

);progn

);if

;(command "LINE" AxisPt CirPt1 ""); Uncomment to see Troys paths while debuging

;If you're tweaking or debugging this code, you've got to uncommend the above line

;at least once to see these patterns. Run Troy in the Intro or Play mode for about

;10 seconds then press the escape key to abruptly abort the game. Then turn off

;all layers except for the Troy layer, and do a zoom extents and print it.

(list CirEnt^ CirPt1 CirPt2 AxisPt Radius~ Direction# NumSteps# Points#)

);defun ChangeArray:

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

; CreateArray: - Creates the initial TroyArray@ list

; Arguments: 1

; TowardCenter = 1 for toward center, else away from center

; Returns: Creates the initial TroyArray@ list moving in direction specified.

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

(defun CreateArray: (TowardCenter)

(setq TroyArray@ nil)

(if (= TowardCenter 1)

(progn

(setq Rotate~ (* (GetRnd 6283) 0.001))

(repeat 10

(setq TroyArray@ (append TroyArray@ (list (AddArray: (polar CenPt Rotate~ CirLimits~)))))

(setq Rotate~ (+ Rotate~ (/ pi 5.0)))

);repeat

);progn

(progn

(setq Rotate~ (* (GetRnd 6283) 0.001)

Dist~ (/ (distance NorthWest NorthEast) 7)

Increase~ (/ (* Dist~ 3) 20.0)

);setq

(repeat 10

(setq Pt (polar CenPt Rotate~ Dist~))

(setq List@ (AddArray: Pt))

(setq List@ (Switch_nth 1 2 List@))

(setq List@ (Change_nth 5 (* (nth 5 List@) -1) List@))

(setq TroyArray@ (append TroyArray@ (list List@)))

(setq Rotate~ (+ Rotate~ 0.897 (* (GetRnd 359) 0.001))

Dist~ (+ Dist~ Increase~)

);setq

);repeat

);progn

);if

);defun CreateArray:

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

; BuildShip: - Draws Ships

; Arguments: 2

; Num# = The number of ship created in the function BuildShip:

; InsPt = Insertion base point of the ship

; Returns: Draws and makes a block of ship at the insertion point specified.

; Also creates the variables MainEnt^ and MainList@ of the ships specs.

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

(defun BuildShip: (Num# InsPt / SS&)

(if (not (member Num# (list 0 1 2 3)))(setq Num# 1))

(cond

((= Num# 0);Red Ship in Intro

(setq Pt1 (polar InsPt (dtr 90) (* Unit~ 0.5))

Pt1 (polar Pt1 pi (* Unit~ 0.875))

Pt2 (polar Pt1 pi (* Unit~ 0.375))

Pt2 (polar Pt2 (dtr 270) (* Unit~ 0.125))

Pt3 (polar Pt2 pi (* Unit~ 0.25))

Pt3 (polar Pt3 (dtr 270) (* Unit~ 0.125))

Pt4 (polar Pt3 (dtr 270) (* Unit~ 0.75))

Pt4 (polar Pt4 0 (* Unit~ 0.5))

Pt5 (polar Pt4 0 (* Unit~ 1.25))

Pt5 (polar Pt5 (dtr 270) (* Unit~ 0.5))

Pt6 (polar InsPt 0 (* Unit~ 2.5))

Pt7 (polar Pt6 (dtr 90) (* Unit~ 0.5))

Pt7 (polar Pt7 pi Unit~)

Pt8 (polar Pt7 pi (* Unit~ 0.5))

Pt8 (polar Pt8 (dtr 90) (* Unit~ 0.125))

Pt9 (polar Pt3 0 (* Unit~ 0.5))

Pt10 (polar InsPt (dtr 270) (* Unit~ 0.25))

Pt11 (polar Pt9 0 (* Unit~ 2.25))

Pt12 (polar InsPt (dtr 90) Unit~)

);setq

(setq SS& (ssadd))

(command "_COLOR" Color1);Red

(command "_ARC" Pt1 Pt2 Pt3)(ssadd (entlast) SS&)

(command "_ARC" Pt3 Pt4 Pt5)(ssadd (entlast) SS&)

(command "_ARC" "" Pt6)(ssadd (entlast) SS&)

(command "_ARC" Pt6 Pt7 Pt8)(ssadd (entlast) SS&)

(command "_COLOR" Color4);Cyan

(command "_ARC" Pt9 Pt10 Pt11)(ssadd (entlast) SS&)

(command "_ARC" Pt11 Pt12 Pt9)(ssadd (entlast) SS&)

(command "_COLOR" "_BYLAYER")

(setq ShipName$ (UniqueName))

(command "_BLOCK" ShipName$ InsPt SS& "")

(command "_INSERT" ShipName$ InsPt 1 1 0)

(setq MainEnt^ (entlast))

(setq MainList@ (entget MainEnt^))

);case

((= Num# 1);Green Ship

(setq Pt (polar InsPt pi Unit~) Pt (polar Pt (dtr 90) (* Unit~ 0.5)))

(command "_PLINE" Pt (polar Pt (dtr 270) Unit~) (polar InsPt 0 (* Unit~ 2)) "_C")

(command "_CHPROP" "_L" "" "_C" Color3 "");Green

(setq ShipName$ (UniqueName))

(command "_BLOCK" ShipName$ InsPt "_L" "")

(command "_INSERT" ShipName$ InsPt 1 1 0)

(setq MainEnt^ (entlast))

(setq MainList@ (entget MainEnt^))

);case

((= Num# 2);Cyan Ship

(setq Pt (polar InsPt pi Unit~) Pt1 (polar Pt (dtr 270) Unit~)

Pt4 (polar Pt1 (dtr 90) (* Unit~ 2)) Pt (polar InsPt 0 Unit~)

Pt2 (polar Pt (dtr 270) (* Unit~ 0.5)) Pt3 (polar Pt2 (dtr 90) Unit~)

);setq

(command "_PLINE" (polar InsPt pi (* Unit~ 0.5)) Pt1 (polar InsPt (dtr 270) (* Unit~ 0.5))

Pt2 (polar InsPt 0 (* Unit~ 2)) Pt3 (polar InsPt (dtr 90) (* Unit~ 0.5)) Pt4 "_C"

);command

(command "_CHPROP" "_L" "" "_C" Color4 "");Cyan

(setq ShipName$ (UniqueName))

(command "_BLOCK" ShipName$ InsPt "_L" "")

(command "_INSERT" ShipName$ InsPt 1 1 0)

(setq MainEnt^ (entlast))

(setq MainList@ (entget MainEnt^))

);case

((= Num# 3);Magenta Ship

(setq Pt (polar InsPt pi Unit~) Pt1 (polar Pt (dtr 270) (* Unit~ 0.5))

Pt4 (polar Pt1 (dtr 90) Unit~) Pt2 (polar Pt1 0 (* Unit~ 1.5))

Pt3 (polar Pt4 0 (* Unit~ 1.5))

);setq

(command "_PLINE" InsPt Pt1 (polar InsPt (dtr 270) Unit~) Pt2

(polar InsPt 0 (* Unit~ 2)) Pt3 (polar InsPt (dtr 90) Unit~) Pt4 "_C"

);command

(command "_CHPROP" "_L" "" "_C" Color6 "");Magenta

(setq ShipName$ (UniqueName))

(command "_BLOCK" ShipName$ InsPt "_L" "")

(command "_INSERT" ShipName$ InsPt 1 1 0)

(setq MainEnt^ (entlast))

(setq MainList@ (entget MainEnt^))

);case

);cond

(princ)

);defun BuildShip:

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

; Refresh: - Erases Troy entities and creates a new TroyArray@ list

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

(defun Refresh: ()

(setq SS& (ssget "_x" (list '(8 . "Troy"))))

(command "_ERASE" SS& "")

(setq FlameArray@ nil TroyArray@ nil Counter# 0 MainNum# (1+ MainNum#))

(CreateArray: (GetRnd 1))

(princ)

);defun Refresh:

;=============================================================================

; Start of Main Function

;=============================================================================

(if (not *MinTroys#*) (setq *MinTroys#* 5))

(if (not *MaxTroys#*) (setq *MaxTroys#* 10))

(if (not *TroySpeed~*) (setq *TroySpeed~* 1.0))

(if (not *ColorScheme#*) (setq *ColorScheme#* 1))

(if (not *Speed#) (Speed))

(if (not *Clayer$*) (setq *Clayer$* (getvar "CLAYER")))

(if (not *Osmode#*) (setq *Osmode#* (getvar "OSMODE")))

(if (not *TextStyle$*) (setq *TextStyle$* (getvar "TEXTSTYLE")))

(if (not *TextSize~*) (setq *TextSize~* (getvar "TEXTSIZE")))

(setvar "BLIPMODE" 0)(setvar "CMDECHO" 0)

(setvar "OSMODE" 0)(setvar "GRIDMODE" 0)(graphscr)

(if (>= (atoi (getvar "ACADVER")) 15)

(progn

(if (not *CTab$*) (setq *CTab$* (getvar "CTAB")))

(if (/= (getvar "CTAB") "Model")

(progn

(command "_PSPACE")

(if (setq SS& (ssget "_x" (list '(-4 . "<AND")'(0 . "VIEWPORT")(cons 410 (getvar "CTAB"))'(-4 . "AND>"))))

(if (> (sslength SS&) 1)

(command "_LAYOUT" "_S" "Model")

);if

);progn

);if

(setq *TroyTab$* (getvar "CTAB"))

);progn

);if

(if (tblsearch "LAYER" "Troy")

(command "_LAYER" "_T" "Troy" "_U" "Troy" "_ON" "Troy" "_M" "Troy" "")

(command "_LAYER" "_M" "Troy" "")

);if

(if (setq SS& (ssget "_x" (list '(8 . "Troy"))))

(command "_ERASE" SS& "")

);if

(setq ViewExtents@ (ViewExtents))

(command "_ZOOM" "_W" (car ViewExtents@)(cadr ViewExtents@))

(setq Xmin~ (car (nth 0 ViewExtents@))

Ymax~ (cadr (nth 0 ViewExtents@))

Xmax~ (car (nth 1 ViewExtents@))

Ymin~ (cadr (nth 1 ViewExtents@))

NorthWest (car ViewExtents@)

SouthEast (cadr ViewExtents@)

SouthWest (list Xmin~ Ymin~)

NorthEast (list Xmax~ Ymax~)

CenPt (getvar "VIEWCTR")

ViewSize~ (getvar "VIEWSIZE")

Unit~ (/ (getvar "VIEWSIZE") 50.0)

Limit# (1+ (fix (/ (distance CenPt (car ViewExtents@)) Unit~)))

CirLimits~ (* (+ Limit# 3) Unit~)

North (polar CenPt (dtr 90) (+ (* Unit~ 3) (/ (getvar "VIEWSIZE") 2.0)))

South (polar CenPt (dtr 270) (+ (* Unit~ 3) (/ (getvar "VIEWSIZE") 2.0)))

East (polar CenPt 0 (+ (* Unit~ 3) (/ (distance NorthWest NorthEast) 2.0)))

West (polar CenPt pi (+ (* Unit~ 3) (/ (distance NorthWest NorthEast) 2.0)))

);setq

; Customize Color Schemes as desired and add to top menu in c:Troy

(cond

((= *ColorScheme#* 1); Bright colors

(setq Color1 1 ;Red Red ship

Color1_5 30 ;Orange Exploding Troys

Color2 2 ;Yellow Bonus points

Color3 3 ;Green 1st ship

Color4 4 ;Cyan 2nd ship

Color5 5 ;Blue Letter O in TroyIntro

Color6 6 ;Magenta 3rd ship

Color7 7 ;White Not used

Color8 33 ;Grey Troys

);setq

);case

((= *ColorScheme#* 2); Dim colors

(setq Color1 12 ;Red Red ship

Color1_5 32 ;Orange Exploding Troys

Color2 52 ;Yellow Bonus points

Color3 86 ;Green 1st ship

Color4 152 ;Cyan 2nd ship

Color5 162 ;Blue Letter O in TroyIntro

Color6 192 ;Magenta 3rd ship

Color7 7 ;White Not used

Color8 250 ;Grey Troys

);setq

);case

((= *ColorScheme#* 3); Ghost colors

(setq Color1 250 ;Red Red ship

Color1_5 250 ;Orange Exploding Troys

Color2 250 ;Yellow Bonus points

Color3 250 ;Green 1st ship

Color4 250 ;Cyan 2nd ship

Color5 250 ;Blue Letter O in TroyIntro

Color6 250 ;Magenta 3rd ship

Color7 250 ;White Not used

Color8 250 ;Grey Troys

);setq

);case

);cond

; Create Flame$ block

(setq SS& (ssadd))(setq Pt SouthEast)

(command "_COLOR" Color2);Yellow

(command "_LINE" Pt (setq Pt (polar Pt 0 Unit~)) "")(ssadd (entlast) SS&)

(command "_COLOR" Color1);Red

(command "_LINE" Pt (setq Pt (polar Pt 0 Unit~)) "")(ssadd (entlast) SS&)

(command "_COLOR" "_BYLAYER")(setq Flame$ (UniqueName))

(command "_BLOCK" Flame$ SouthEast SS& "")

(if (= Option$ "Intro")(TroyIntro))

;(command "RECTANG" (car ViewExtents@)(cadr ViewExtents@)); Uncomment while debuging

;(command "CIRCLE" CenPt CirLimits~); Uncomment while debuging

; Build Ship 1

(BuildShip: 1 CenPt)

; Create first Troys

(CreateArray: (GetRnd 1))

(command "_STYLE" "Troy" "ROMANS" "0.0" "0.75" "" "" "" "")

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

; Start of grread Loop

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

(setq Loop t Counter# 0 Total# 100 MainNum# 1)

(setq Previous@ (list 5 (polar CenPt 0 Unit~)));Start the Loop moving

(princ (strcat "\nCommand:\nTotal: " (itoa Total#) "\n"))

(while Loop

; Read the mouse movements and picks

(if (not (setq Read@ (grread t 8)))

(setq Read@ Previous@)

);if

(setq Code# (nth 0 Read@))

(setq Value (nth 1 Read@))

(cond

((= Code# 3); Fire if picked

(setq Ang~ (angle CenPt Value)

Pt1 (polar CenPt Ang~ (* Unit~ 2))

Pt2 (polar Pt1 Ang~ Unit~)

);setq

(command "_INSERT" Flame$ Pt1 1 1 (rtd Ang~))

(setq FlameArray@ (append FlameArray@ (list (list (entlast) Pt1 Pt2 Ang~))))

(setq Total# (1- Total#))

(princ (strcat "\nCommand:\nTotal: " (itoa Total#) "\n"))

);case

((= Code# 5); Rotate if moved

(setq Previous@ Read@)

(setq Ang~ (angle CenPt Value))

(setq MainList@ (entmod (subst (cons 50 Ang~) (assoc 50 MainList@) MainList@)))

);case

((= Code# 2); Key was pressed

(cond

((or (= Value 80)(= Value 112));P or p then pause

(getpoint "\nTroy paused. Pick mouse to continue. ")

(princ (strcat "\nCommand:\nTotal: " (itoa Total#) "\n"))

);case

((or (= Value 81)(= Value 113));Q or q then quit

(setq Loop nil)

);case

(t (princ "\nMove mouse to rotate ship, pick mouse to fire, press P to Pause, or Q to quit.")

(princ (strcat "\nTotal: " (itoa Total#) "\n"))

);case

);cond

; Move flame objects

(if FlameArray@

(progn

(setq Cnt# 0 Nths@ nil)

(foreach List@ FlameArray@

(setq Flame^ (nth 0 List@)

Pt1 (nth 1 List@)

Pt2 (nth 2 List@)

Ang~ (nth 3 List@)

);setq

(if (or (and (> (car Pt2)(car East))(> (car Pt2)(car Pt1)))

(and (< (car Pt2)(car West))(< (car Pt2)(car Pt1)))

(and (> (cadr Pt2)(cadr North))(> (cadr Pt2)(cadr Pt1)))

(and (< (cadr Pt2)(cadr South))(< (cadr Pt2)(cadr Pt1)))

);or

(progn

(command "_ERASE" Flame^ "")

(setq Nths@ (append Nths@ (list Cnt#)))

);progn

(progn

(command "_MOVE" Flame^ "" Pt1 Pt2)

(setq Pt1 Pt2 Pt2 (polar Pt2 Ang~ Unit~))

(setq List@ (list Flame^ Pt1 Pt2 Ang~))

(setq FlameArray@ (Change_nth Cnt# List@ FlameArray@))

);progn

);if

(setq Cnt# (1+ Cnt#))

);foreach

(if Nths@

(setq FlameArray@ (Remove_nths Nths@ FlameArray@))

);if

);progn

);if

; Check if Troys are hit

(setq Cnt# 0 Nths@ nil)

(foreach List@ TroyArray@ ; Troy list

(if FlameArray@ ; Flame list

(progn

(setq CirEnt^ (nth 0 List@)

CirPt1 (nth 1 List@)

Radius~ (nth 4 List@)

Points# (nth 7 List@)

);setq

(setq Num# 0 Num@ nil)

(foreach SubList@ FlameArray@

(setq Flame^ (nth 0 SubList@)

Pt2 (nth 2 SubList@)

);setq

(if (and (> (car Pt2) (+ Xmin~ Radius~))(< (car Pt2) (- Xmax~ Radius~))

(> (cadr Pt2) (+ Ymin~ Radius~))(< (cadr Pt2) (- Ymax~ Radius~)))

(if (<= (distance Pt2 CirPt1) Radius~)

(progn

(command "_ERASE" CirEnt^ Flame^ "")

(setq Num@ (append Num@ (list Num#)))

(setq Nths@ (append Nths@ (list Cnt#)))

(command "_TEXT" "_M" CirPt1 Unit~ 0 (itoa Points#))

(command "_CHPROP" "_L" "" "_C" Color2 "")

(setq TextEnt^ (entlast))

(setq Total# (+ Total# Points#))

(princ (strcat "\nCommand:\nTotal: " (itoa Total#) "\n"))

(command "_COLOR" Color1_5)

(setq Dia1~ (* Radius~ 2) Dia2~ (* Radius~ 3) Ang~ (dtr 270) Pnts# 7)

(repeat 3

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3.5) Ang~ (+ Ang~ (/ (* pi 2) (* Pnts# 3))))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3) Ang~ (dtr 90))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3.5) Ang~ (- Ang~ (/ (* pi 2) (* Pnts# 3))))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3) Ang~ (dtr 270))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3.5) Ang~ (- Ang~ (/ (* pi 2) (* Pnts# 3))))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3) Ang~ (dtr 90))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3.5) Ang~ (+ Ang~ (/ (* pi 2) (* Pnts# 3))))

(command "_ERASE" (entlast) "")

(StarBurst CirPt1 Dia1~ Dia2~ Pnts# Ang~)(delay 0.125)

(setq Dia2~ (* Radius~ 3) Ang~ (dtr 270))

(command "_ERASE" (entlast) "")

);repeat

(command "_COLOR" "_BYLAYER")

(command "_ERASE" TextEnt^"")

);progn

);if

(setq Num# (1+ Num#))

);foreach

(if Num@

(setq FlameArray@ (Remove_nths Num@ FlameArray@))

);if

);progn

);if

(if TroyArray@

(setq TroyArray@ (Change_nth Cnt# (ChangeArray: List@) TroyArray@))

(CreateArray: 1)

);if

(setq Cnt# (1+ Cnt#))

);foreach

(if Nths@

(setq TroyArray@ (Remove_nths Nths@ TroyArray@))

);if

(if (not TroyArray@)

(CreateArray: 1)

);if

; Erase Troys that are out of limits

(setq Cnt# 0)

(foreach List@ TroyArray@

(setq CirEnt^ (nth 0 List@)

CirPt1 (nth 1 List@)

CirPt2 (nth 2 List@)

);setq

(if (or (and (> (car CirPt1)(car East))(> (car CirPt2)(car CirPt1)))

(and (< (car CirPt1)(car West))(< (car CirPt2)(car CirPt1)))

(and (> (cadr CirPt1)(cadr North))(> (cadr CirPt2)(cadr CirPt1)))

(and (< (cadr CirPt1)(cadr South))(< (cadr CirPt2)(cadr CirPt1)))

);or

(progn

(command "_ERASE" CirEnt^ "")

(setq TroyArray@ (Change_nth Cnt# (AddArray: nil) TroyArray@))

(setq Counter# (1+ Counter#))

(if (= Counter# 3);Add Troys per Counter#

(progn

(setq Counter# 0)

(if (< (length TroyArray@) *MaxTroys#*)

(setq TroyArray@ (append TroyArray@ (list (AddArray: nil))))

);if

);progn

);if

);progn

);if

(setq Cnt# (1+ Cnt#))

);foreach

; Check if Troys ran into Ship or total points is <= 0

(setq Cnt# 0 Passed t)

(while Passed

(setq List@ (nth Cnt# TroyArray@)

CirEnt^ (nth 0 List@)

CirPt1 (nth 1 List@)

Radius~ (nth 4 List@)

);setq

(if (or (< (distance CenPt CirPt1) (+ Radius~ (* Unit~ 2.5))) (<= Total# 0))

(progn

(command "_ERASE" MainEnt^ "")

(cond

((= MainNum# 1)(setq Color# Color3));Green

((= MainNum# 2)(setq Color# Color4));Cyan

((= MainNum# 3)(setq Color# Color6));Magenta

);cond

(command "_COLOR" Color#)

(setq Dia1~ 1 Dia2~ 4 Ang~ (dtr 270) Inc# 0 Inc1~ 0.125 Inc2~ 0.375)

(repeat 20

(if (= Inc# 11)(setq Inc1~ -0.125 Inc2~ -0.375))

(StarBurst CenPt (* Unit~ Dia1~) (* Unit~ Dia2~) 5 Ang~)(delay 0.5)

(setq Dia1~ (+ Dia1~ Inc1~) Dia2~ (+ Dia2~ Inc2~))

(setq Ang~ (+ Ang~ (/ (* pi 2) 3)))

(command "_ERASE" (entlast) "")

(setq Inc# (1+ Inc#))

);repeat

(command "_COLOR" "_BYLAYER")

(setq Total# (- Total# 10))

(if (<= Total# 0)

(progn

(setq MainNum# 3)

(princ "\nCommand:\nTotal: 0")

);progn

(princ (strcat "\nCommand:\nTotal: " (itoa Total#) "\n"))

);if

(cond

((= MainNum# 1); Build Ship 2

(Refresh:)

(BuildShip: 2 CenPt)

);case

((= MainNum# 2); Build Ship 3

(Refresh:)

(BuildShip: 3 CenPt)

);case

((= MainNum# 3); Finished!

(setq Passed nil Loop nil)

);case

);cond

(setq Passed nil)

);progn

);if

(setq Cnt# (1+ Cnt#))

(if (> Cnt# (1- (length TroyArray@)))

(setq Passed nil)

);if

);while

(if (< (length TroyArray@) *MinTroys#*)

(setq TroyArray@ (append TroyArray@ (list (AddArray: nil))))

);if

(if (or (/= (getvar "VIEWCTR") CenPt)(/= (getvar "VIEWSIZE") ViewSize~))

(command "_ZOOM" "_W" (car ViewExtents@)(cadr ViewExtents@))

);if

);while

(TroyClear)

(princ (strcat "\nCommand:\nTotal: " (itoa Total#) " Finished!"))

(princ)

);defun Troy

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

; TroyIntro - Introduction

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

(defun TroyIntro (/ Color# Divisions# Fire# Fourth# Inc~ Increase~ Ltr# Move#

O-Ang~ O-Cnt# O-Ent^ O-Ins O-List@ O-Pt O-Pts@ O-Size~ Path# Path@ Path1@

Path2@ Path3@ Path4@ R-Ang~ R-Cen R-Cnt# R-Ent^ R-Ins R-List@ R-Pt R-Pts@

R-Size~ Rotate~ Rnd# RndLtr@ Sevenths Step~ T-Ang~ T-Cen T-Cnt# T-Ent^ T-Ins

T-List@ T-Pt T-Pts@ T-Size~ Tl-Ang~ TxSize~ TxSizeInc~ TxSizeMax~ TxSizeMin~

Y-Ang~ Y-Cnt# Y-Ent^ Y-Ins Y-List@ Y-Pt Y-Pts@ Y-Size~)

(princ "\nTroy Intro.\n")

(command "_STYLE" "Troy" "ROMAND" "0.0" "1" "" "" "" "")

(setq T-Pt (polar CenPt pi (* Unit~ 4.5))

R-Pt (polar CenPt pi (* Unit~ 1.5))

O-Pt (polar CenPt 0 (* Unit~ 1.5))

Y-Pt (polar CenPt 0 (* Unit~ 4.5))

TxSizeMax~ (* Unit~ 3)

TxSizeMin~ (* Unit~ 0.5)

Inc~ (* Unit~ 2);Speed of letters

Pt0 (polar R-Pt (- (angle R-Pt SouthWest) 0.009) (distance R-Pt SouthWest))

Pt (polar R-Pt (angle R-Pt Pt0) (/ (distance R-Pt Pt0) 2.0))

Pt (polar Pt (+ (angle R-Pt Pt0) (* pi 0.5)) (/ (distance R-Pt Pt0) 7.0))

R-Cen (Center3Pt R-Pt Pt Pt0)

Radius~ (distance R-Pt R-Cen)

Ang~ (* (- (* pi 0.5) (acos (/ (/ Inc~ 2.0) Radius~))) 2)

Inc# (fix (/ (- (angle R-Cen R-Pt) (angle R-Cen SouthWest)) Ang~))

Pt0 (polar T-Pt (- (angle T-Pt NorthWest) 0.043) (distance R-Pt SouthWest))

Pt (polar T-Pt (angle T-Pt Pt0) (/ (distance R-Pt Pt0) 2.0))

Pt (polar Pt (+ (angle T-Pt Pt0) (* pi 0.5)) (/ (distance R-Pt Pt0) 7.0))

T-Cen (Center3Pt T-Pt Pt Pt0)

TxSizeInc~ (/ (- TxSizeMax~ TxSizeMin~) (float Inc#))

TxSize~ TxSizeMax~

T-Pts@ (list T-Pt)

R-Pts@ (list R-Pt)

O-Pts@ (list O-Pt)

Y-Pts@ (list Y-Pt)

T-Ang~ 0

);setq

(repeat Inc#

(setq T-Pt (polar T-Cen (- (angle T-Cen T-Pt) Ang~) Radius~)

T-Pts@ (append T-Pts@ (list T-Pt))

R-Pt (polar R-Cen (- (angle R-Cen R-Pt) Ang~) Radius~)

R-Pts@ (append R-Pts@ (list R-Pt))

O-Pt (polar CenPt (angle R-Pt CenPt) (distance R-Pt CenPt))

O-Pts@ (append O-Pts@ (list O-Pt))

Y-Pt (polar CenPt (angle T-Pt CenPt) (distance T-Pt CenPt))

Y-Pts@ (append Y-Pts@ (list Y-Pt))

T-Ang~ (- T-Ang~ (dtr 30))

TxSize~ (- TxSize~ TxSizeInc~)

);setq

);repeat

(setq T-Pts@ (reverse T-Pts@)

R-Pts@ (reverse R-Pts@)

O-Pts@ (reverse O-Pts@)

Y-Pts@ (reverse Y-Pts@)

R-Ang~ T-Ang~ O-Ang~ T-Ang~ Y-Ang~ T-Ang~

T-Size~ TxSize~ R-Size~ TxSize~ O-Size~ TxSize~ Y-Size~ TxSize~

T-Cnt# 0 R-Cnt# 0 O-Cnt# 0 Y-Cnt# 0 Fourth# (/ Inc# 4)

);setq

(setq T-Pt (last T-Pts@) R-Pt (last R-Pts@) O-Pt (last O-Pts@) Y-Pt (last Y-Pts@) RndLtr@ (list 0))

(while (/= (length RndLtr@) 5)

(setq Rnd# (1+ (GetRnd 3)))

(cond

((= Rnd# 1)(setq Pt T-Pt))

((= Rnd# 2)(setq Pt R-Pt))

((= Rnd# 3)(setq Pt O-Pt))

((= Rnd# 4)(setq Pt Y-Pt))

);cond

(if (not (member Pt RndLtr@))

(setq RndLtr@ (append RndLtr@ (list Pt)))

);if

);while

(setq Rotate~ (* (GetRnd 6283) 0.001)

Dist~ (/ (distance NorthWest NorthEast) 10)

Increase~ (/ (* Dist~ 3) 20.0)

);setq

(repeat 20

(setq Pt (polar CenPt Rotate~ Dist~))

(setq List@ (AddArray: Pt))

(setq List@ (Switch_nth 1 2 List@))

(setq List@ (Change_nth 5 (* (nth 5 List@) -1) List@))

(setq TroyArray@ (append TroyArray@ (list List@)))

(setq Rotate~ (+ Rotate~ 0.897 (* (GetRnd 359) 0.001))

Dist~ (+ Dist~ Increase~)

);setq

);repeat

(setq Step~ (* Unit~ 1.5);Speed of red ship

Pt1 (polar SouthWest (dtr 90) (/ (distance SouthWest NorthWest) 6.0))

Pt2 (polar Pt1 0 (/ (distance SouthWest SouthEast) 3.0))

Pt (polar Pt1 0 (/ (distance Pt1 Pt2) 2.0))

Pt (polar Pt (dtr 90) (* Unit~ 2))

Pt (Center3Pt Pt1 Pt Pt2)

Radius~ (distance Pt Pt1)

Tl-Ang~ (- (angle Pt Pt1) (angle Pt Pt2))

Ang~ (* 2 (- (* pi 0.5) (acos (/ (* Step~ 0.5) Radius~))))

Divisions# (fix (1+ (/ Tl-Ang~ Ang~)))

Pt2 (polar Pt (- (angle Pt Pt1) (* Ang~ Divisions#)) Radius~)

);setq

(setq Path1@ (list Pt1))

(repeat Divisions#

(setq Pt1 (polar Pt (- (angle Pt Pt1) Ang~) Radius~))

(setq Path1@ (append Path1@ (list Pt1)))

);repeat

(setq Pt (polar Pt (angle Pt Pt2) (* Radius~ 2)))

(repeat (fix (1+ (/ Divisions# 2.0)))

(setq Pt1 (polar Pt (+ (angle Pt Pt1) Ang~) Radius~))

(if (< (angle Pt Pt1) (dtr 270))

(setq Path1@ (append Path1@ (list Pt1)))

);if

);repeat

(setq Pt1 (last Path1@)

Pt2 (inters Pt1 (polar Pt1 0 Unit~) NorthEast SouthEast nil)

Ang~ (atan (/ 1 2.0))

Radius~ (* (distance Pt1 Pt2) (tan Ang~))

Pt (polar Pt1 (dtr 90) Radius~)

Tl-Ang~ (atan (/ (distance Pt1 Pt2) Radius~))

Ang~ (* 2 (- (* pi 0.5) (acos (/ (* Step~ 0.5) Radius~))))

Divisions# (fix (1+ (/ Tl-Ang~ Ang~)))

);setq

(repeat Divisions#

(setq Pt1 (polar Pt (+ (angle Pt Pt1) Ang~) Radius~))

(setq Path1@ (append Path1@ (list Pt1)))

);repeat

(setq Pt Pt2

Radius~ (distance Pt Pt1)

Ang~ (* 2 (- (* pi 0.5) (acos (/ (* Step~ 0.5) Radius~))))

Tl-Ang~ (- (angle Pt Pt1) (* pi 0.5))

Divisions# (fix (1+ (/ Tl-Ang~ Ang~)))

);setq

(repeat Divisions#

(setq Pt2 Pt1)

(setq Pt1 (polar Pt (- (angle Pt Pt1) Ang~) Radius~))

(if (> (angle Pt Pt1) (* pi 0.5))

(setq Path1@ (append Path1@ (list Pt1)))

);if

);repeat

(setq Ang~ (angle Pt2 Pt1))

(repeat 5

(setq Pt1 (polar Pt1 Ang~ Step~))

(setq Path1@ (append Path1@ (list Pt1)))

);repeat

(setq Ang~ (angle (nth 1 Path1@) (nth 0 Path1@)))

(repeat 5

(setq Pt (polar (nth 0 Path1@) Ang~ Step~))

(setq Path1@ (Insert_nth 0 Pt Path1@))

);repeat

(foreach Item Path1@

(setq Pt2 (MirrorPt Item CenPt 0))

(setq Path2@ (append Path2@ (list Pt2)))

(setq Pt3 (MirrorPt Item CenPt (dtr 90)))

(setq Path3@ (append Path3@ (list Pt3)))

(setq Pt4 (MirrorPt Pt3 CenPt 0))

(setq Path4@ (append Path4@ (list Pt4)))

);foreach

(setq Path# (1+ (GetRnd 3)))

(cond

((= Path# 1)(setq Path@ Path1@))

((= Path# 2)(setq Path@ Path2@))

((= Path# 3)(setq Path@ Path3@))

((= Path# 4)(setq Path@ Path4@))

);cond

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

; First Loop

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

(setq Loop t)

(while Loop

(if (<= T-Cnt# Inc#)

(if (= T-Cnt# 0)

(progn

(command "_TEXT" "_M" (nth T-Cnt# T-Pts@) T-Size~ (rtd T-Ang~) "T")

(setq T-Ent^ (entlast))

(command "_CHPROP" T-Ent^ "" "_C" Color3 "");Green

(setq T-List@ (entget T-Ent^)

T-Size~ (+ T-Size~ TxSizeInc~)

T-Ang~ (+ T-Ang~ (dtr 30))

T-Cnt# (1+ T-Cnt#)

T-Ins (nth T-Cnt# T-Pts@)

);setq

);progn

(progn

(setq T-List@ (entmod (subst (cons 50 T-Ang~) (assoc 50 T-List@) T-List@)))

(setq T-List@ (entmod (subst (cons 11 T-Ins) (assoc 11 T-List@) T-List@)))

(setq T-List@ (entmod (subst (cons 40 T-Size~) (assoc 40 T-List@) T-List@)))

(setq T-Size~ (+ T-Size~ TxSizeInc~)

T-Ang~ (+ T-Ang~ (dtr 30))

T-Cnt# (1+ T-Cnt#)

);setq

(if (<= T-Cnt# Inc#) (setq T-Ins (nth T-Cnt# T-Pts@)))

);progn

);if

(if (>= T-Cnt# Fourth#)

(if (<= R-Cnt# Inc#)

(if (= R-Cnt# 0)

(progn

(command "_TEXT" "_M" (nth R-Cnt# R-Pts@) R-Size~ (rtd R-Ang~) "R")

(setq R-Ent^ (entlast))

(command "_CHPROP" R-Ent^ "" "_C" Color4 "");Cyan

(setq R-List@ (entget R-Ent^)

R-Size~ (+ R-Size~ TxSizeInc~)

R-Ang~ (+ R-Ang~ (dtr 30))

R-Cnt# (1+ R-Cnt#)

R-Ins (nth R-Cnt# R-Pts@)

);setq

);progn

(progn

(setq R-List@ (entmod (subst (cons 50 R-Ang~) (assoc 50 R-List@) R-List@)))

(setq R-List@ (entmod (subst (cons 11 R-Ins) (assoc 11 R-List@) R-List@)))

(setq R-List@ (entmod (subst (cons 40 R-Size~) (assoc 40 R-List@) R-List@)))

(setq R-Size~ (+ R-Size~ TxSizeInc~)

R-Ang~ (+ R-Ang~ (dtr 30))

R-Cnt# (1+ R-Cnt#)

);setq

(if (<= R-Cnt# Inc#) (setq R-Ins (nth R-Cnt# R-Pts@)))

);progn

);if

(if (>= R-Cnt# Fourth#)

(if (<= O-Cnt# Inc#)

(if (= O-Cnt# 0)

(progn

(command "_TEXT" "_M" (nth O-Cnt# O-Pts@) O-Size~ (rtd O-Ang~) "O")

(setq O-Ent^ (entlast))

(command "_CHPROP" O-Ent^ "" "_C" Color5 "");Blue

(setq O-List@ (entget O-Ent^)

O-Size~ (+ O-Size~ TxSizeInc~)

O-Ang~ (+ O-Ang~ (dtr 30))

O-Cnt# (1+ O-Cnt#)

O-Ins (nth O-Cnt# O-Pts@)

);setq

);progn

(progn

(setq O-List@ (entmod (subst (cons 50 O-Ang~) (assoc 50 O-List@) O-List@)))

(setq O-List@ (entmod (subst (cons 11 O-Ins) (assoc 11 O-List@) O-List@)))

(setq O-List@ (entmod (subst (cons 40 O-Size~) (assoc 40 O-List@) O-List@)))

(setq O-Size~ (+ O-Size~ TxSizeInc~)

O-Ang~ (+ O-Ang~ (dtr 30))

O-Cnt# (1+ O-Cnt#)

);setq

(if (<= O-Cnt# Inc#) (setq O-Ins (nth O-Cnt# O-Pts@)))

);progn

);if

(if (>= O-Cnt# Fourth#)

(if (<= Y-Cnt# Inc#)

(if (= Y-Cnt# 0)

(progn

(command "_TEXT" "_M" (nth Y-Cnt# Y-Pts@) Y-Size~ (rtd Y-Ang~) "Y")

(setq Y-Ent^ (entlast))

(command "_CHPROP" Y-Ent^ "" "_C" Color6 "");Magenta

(setq Y-List@ (entget Y-Ent^)

Y-Size~ (+ Y-Size~ TxSizeInc~)

Y-Ang~ (+ Y-Ang~ (dtr 30))

Y-Cnt# (1+ Y-Cnt#)

Y-Ins (nth Y-Cnt# Y-Pts@)

);setq

);progn

(progn

(setq Y-List@ (entmod (subst (cons 50 Y-Ang~) (assoc 50 Y-List@) Y-List@)))

(setq Y-List@ (entmod (subst (cons 11 Y-Ins) (assoc 11 Y-List@) Y-List@)))

(setq Y-List@ (entmod (subst (cons 40 Y-Size~) (assoc 40 Y-List@) Y-List@)))

(setq Y-Size~ (+ Y-Size~ TxSizeInc~)

Y-Ang~ (+ Y-Ang~ (dtr 30))

Y-Cnt# (1+ Y-Cnt#)

);setq

(if (<= Y-Cnt# Inc#) (setq Y-Ins (nth Y-Cnt# Y-Pts@)))

);progn

);if

; Erase Troys that are out of limits

(setq Cnt# 0)

(foreach List@ TroyArray@

(setq CirEnt^ (nth 0 List@)

CirPt1 (nth 1 List@)

Radius~ (nth 4 List@)

);setq

(if (> (distance CenPt CirPt1) CirLimits~)

(progn

(command "_ERASE" CirEnt^ "")

(setq TroyArray@ (Change_nth Cnt# (AddArray: nil) TroyArray@))

);progn

(setq TroyArray@ (Change_nth Cnt# (ChangeArray: List@) TroyArray@))

);if

(setq Cnt# (1+ Cnt#))

);foreach

(delay 0.15);Speed of Loop

(if (> Y-Cnt# Inc#)(setq Loop nil))

(if (or (/= (getvar "VIEWCTR") CenPt)(/= (getvar "VIEWSIZE") ViewSize~))

(command "_ZOOM" "_W" (car ViewExtents@)(cadr ViewExtents@))

);if

);while

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

; Second Loop

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

(setq Loop t Move# 0 Ltr# 0 Sevenths# (/ (length Path@) 7) Fire# (1+ Sevenths#))

(BuildShip: 0 (nth 0 Path@))

(if (> Path# 2)

(setq MainList@ (entmod (subst (cons 42 -1.0) (assoc 42 MainList@) MainList@)))

);if

(while Loop

; Move Ship

(setq Pt1 (nth Move# Path@)

Pt2 (nth (1+ Move#) Path@)

Ang~ (angle Pt1 Pt2)

);setq

;(command "LINE" Pt1 Pt2 "");Uncomment while debuging

(setq MainList@ (entmod (subst (cons 50 Ang~) (assoc 50 MainList@) MainList@)))

(setq MainList@ (entmod (subst (cons 10 Pt1) (assoc 10 MainList@) MainList@)))

; Fire at Troy Letters

(setq Fire# (1+ Fire#))

(if (= Fire# (fix (* Sevenths# 2.5)))(setq Fire# Sevenths#));First time

(if (= Fire# Sevenths#);Fire in these intervals

(progn

(setq Fire# 0 Ltr# (1+ Ltr#))

(if (member Ltr# (list 1 2 3 4))

(progn

(setq Pt (nth Ltr# RndLtr@)

Ang~ (angle Pt1 Pt)

Pt1 (polar Pt1 Ang~ (* Unit~ 2))

Pt2 (polar Pt1 Ang~ Unit~)

);setq

(command "_INSERT" Flame$ Pt1 1 1 (rtd Ang~))

(setq FlameArray@ (append FlameArray@ (list (list (entlast) Pt1 Pt2 Ang~))))

);progn

);if

);progn

);if

; Move flame objects

(if FlameArray@

(progn

(setq Cnt# 0 Nth# nil)

(foreach List@ FlameArray@

(setq Flame^ (nth 0 List@)

Pt1 (nth 1 List@)

Pt2 (nth 2 List@)

Ang~ (nth 3 List@)

);setq

(if (or (and (> (car Pt2)(car East))(> (car Pt2)(car Pt1)))

(and (< (car Pt2)(car West))(< (car Pt2)(car Pt1)))

(and (> (cadr Pt2)(cadr North))(> (cadr Pt2)(cadr Pt1)))

(and (< (cadr Pt2)(cadr South))(< (cadr Pt2)(cadr Pt1)))

);or

(progn

(command "_ERASE" Flame^ "")

(setq Nth# Cnt#)

);progn

(progn

(command "_MOVE" Flame^ "" Pt1 Pt2)

(setq Pt1 Pt2 Pt2 (polar Pt2 Ang~ Unit~))

(setq List@ (list Flame^ Pt1 Pt2 Ang~))

(setq FlameArray@ (Change_nth Cnt# List@ FlameArray@))

);progn

);if

(setq Cnt# (1+ Cnt#))

);foreach

(if Nth#

(setq FlameArray@ (Delete_nth Nth# FlameArray@))

);if

);progn

);if

; Check to see if Troy Letters are hit

(if FlameArray@

(progn

(setq Num# 0)

(foreach List@ FlameArray@

(setq Ent^ (nth 0 List@)

Pt2 (nth 2 List@)

Pt nil

);setq

(cond

((<= (distance Pt2 T-Pt) Unit~)

(command "_ERASE" T-Ent^ Ent^ "")

(setq FlameArray@ (Delete_nth Num# FlameArray@))

(setq Pt T-Pt T-Pt SouthWest Color# Color3);Green

);case

((<= (distance Pt2 R-Pt) Unit~)

(command "_ERASE" R-Ent^ Ent^ "")

(setq FlameArray@ (Delete_nth Num# FlameArray@))

(setq Pt R-Pt R-Pt SouthWest Color# Color4);Cyan

);case

((<= (distance Pt2 O-Pt) Unit~)

(command "_ERASE" O-Ent^ Ent^ "")

(setq FlameArray@ (Delete_nth Num# FlameArray@))

(setq Pt O-Pt O-Pt SouthWest Color# Color5);Blue

);case

((<= (distance Pt2 Y-Pt) Unit~)

(command "_ERASE" Y-Ent^ Ent^ "")

(setq FlameArray@ (Delete_nth Num# FlameArray@))

(setq Pt Y-Pt Y-Pt SouthWest Color# Color6);Magenta

);case

);cond

; Explode Letter

(if Pt

(progn

(command "_COLOR" Color#)

(setq Dia1~ 0.5 Dia2~ 3 Ang~ (* (GetRnd 6283) 0.001) Inc# 0 Inc1~ 0.125 Inc2~ 0.375)

(repeat 10

(if (= Inc# 6)(setq Inc1~ -0.125 Inc2~ -0.375))

(StarBurst Pt (* Unit~ Dia1~) (* Unit~ Dia2~) (+ (GetRnd 5) 5) Ang~)(delay 0.125)

(setq Dia1~ (+ Dia1~ Inc1~) Dia2~ (+ Dia2~ Inc2~))

(setq Ang~ (* (GetRnd 6283) 0.001))

(command "_ERASE" (entlast) "")

(setq Inc# (1+ Inc#))

);repeat

(command "_COLOR" "_BYLAYER")

);progn

);if

(setq Num# (1+ Num#))

);foreach

);progn

);if

; Erase Troys that are out of limits

(setq Cnt# 0)

(foreach List@ TroyArray@

(setq CirEnt^ (nth 0 List@)

CirPt1 (nth 1 List@)

Radius~ (nth 4 List@)

);setq

(if (> (distance CenPt CirPt1) CirLimits~)

(progn

(command "_ERASE" CirEnt^ "")

(setq TroyArray@ (Change_nth Cnt# (AddArray: nil) TroyArray@))

);progn

(setq TroyArray@ (Change_nth Cnt# (ChangeArray: List@) TroyArray@))

);if

(setq Cnt# (1+ Cnt#))

);foreach

(delay 0.15);Speed of Loop

(setq Move# (1+ Move#))

(if (= Move# (1- (length Path@)))(setq Loop nil))

(if (or (/= (getvar "VIEWCTR") CenPt)(/= (getvar "VIEWSIZE") ViewSize~))

(command "_ZOOM" "_W" (car ViewExtents@)(cadr ViewExtents@))

);if

);while

(setq SS& (ssget "x" (list '(8 . "Troy"))))

(command "_ERASE" SS& "")

(princ)

);defun TroyIntro

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

; TroyClear - Troy clear function

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

(defun TroyClear (/ Block$ Passed SS&)

(if *TroyTab$* (command "_LAYOUT" "_S" *TroyTab$*))

(if *Clayer$* (setvar "CLAYER" *Clayer$*))

(if *Osmode#* (setvar "OSMODE" *Osmode#*))

(if *TextStyle$* (setvar "TEXTSTYLE" *TextStyle$*))

(if *TextSize~* (setvar "TEXTSIZE" *TextSize~*))

(command "_COLOR" "_BYLAYER")

(if (setq SS& (ssget "_x" (list '(8 . "Troy"))))

(command "_ERASE" SS& "")

);if

(setq Block$ (strcat (substr (UniqueName) 1 5) "*"))

(foreach Item (GetBlockList)

(if (wcmatch Item Block$) (setq Passed t))

);foreach

(if Passed (command "_PURGE" "_BL" Block$ "_N"))

(if (tblsearch "LAYER" "Troy") (command "_PURGE" "_LA" "Troy" "_N"))

(if (tblsearch "STYLE" "Troy") (command "_PURGE" "_ST" "Troy" "_N"))

(setq *Clayer$* nil *Osmode#* nil *TextStyle$* nil *TextSize~* nil)

(PurgeGroups)

(if *CTab$*

(progn (command "_LAYOUT" "_S" *CTab$*)(setq *CTab$* nil *TroyTab$* nil))

);if

(repeat 45 (princ (strcat "\n" (chr 160))))

(princ)

);defun TroyClear

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

; Start of Troy Support Utility Functions

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

; acos

; Arguments: 1

; x = real number between 0 and 1. May be passed as the sum of dividing two

; sides of a right triangle.

; Returns: acos of x, the radian degrees between sides of a right triangle

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

(defun acos (x)

(atan (/ (sqrt (- 1 (* x x))) x))

);defun acos

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

; asin

; Arguments: 1

; sine = real number between -1 to 1

; Returns: arcsin of sine

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

(defun asin (sine / cosine)

(setq cosine (sqrt (- 1.0 (expt sine 2))))

(if (zerop cosine)

(setq cosine 0.000000000000000000000000000001)

);if

(atan (/ sine cosine))

);defun asin

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

; Center3Pt - Center point of 3 points on a circle

; Arguments: 3

; Pt1 = First point

; Pt2 = Second point

; Pt3 = Third point

; Returns: Center point of 3 points on a circle

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

(defun Center3Pt (Pt1 Pt2 Pt3 / Pt Pt4 Pt5 Pt6 Pt7)

(setq Pt4 (polar Pt1 (angle Pt1 Pt2) (/ (distance Pt1 Pt2) 2.0))

Pt5 (polar Pt4 (+ (angle Pt1 Pt2) (* pi 0.5)) 1)

Pt6 (polar Pt2 (angle Pt2 Pt3) (/ (distance Pt2 Pt3) 2.0))

Pt7 (polar Pt6 (+ (angle Pt2 Pt3) (* pi 0.5)) 1)

Pt (inters Pt4 Pt5 Pt6 Pt7 nil)

);setq

);defun Center3Pt

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

; Change_nth - Changes the nth item in a list with a new item value.

; Arguments: 3

; Num# = Nth number in list to change

; Value = New item value to change to

; OldList@ = List to change item value

; Returns: A list with the nth item value changed.

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

(defun Change_nth (Num# Value OldList@)

(if (<= 0 Num# (1- (length OldList@)))

(if (> Num# 0)

(cons (car OldList@) (Change_nth (1- Num#) Value (cdr OldList@)))

(cons Value (cdr OldList@))

);if

OldList@

);if

);defun Change_nth

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

; delay - time delay function

; Arguments: 1

; Percent~ - Percentage of *Speed# variable

; Returns: time delay

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

(defun delay (Percent~ / Number~)

(if (not *Speed#) (Speed))

(repeat (fix (* *Speed# Percent~)) (setq Number~ pi))

(princ)

);defun delay

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

; Delete_nth - Deletes the nth item from a list.

; Arguments: 2

; Num# = Nth number in list to delete

; OldList@ = List to delete the nth item

; Returns: A list with the nth item deleted.

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

(defun Delete_nth (Num# OldList@)

(setq Num# (1+ Num#))

(vl-remove-if '(lambda (x) (zerop (setq Num# (1- Num#)))) OldList@)

);defun Delete_nth

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

; dtr - Degrees to Radians.

; Arguments: 1

; Deg~ = Degrees

; Syntax: (dtr Deg~)

; Returns: Value in radians.

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

(defun dtr (Deg~)

(* pi (/ Deg~ 180.0))

);defun dtr

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

; GetBlockList

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

(defun GetBlockList (/ BlockList@ Block$ List@)

(if (setq List@ (tblnext "BLOCK" 't))

(while List@

(setq Block$ (cdr (assoc 2 List@)))

(if (/= (substr Block$ 1 1) "*")

(setq BlockList@ (append BlockList@ (list Block$)))

);if

(setq List@ (tblnext "BLOCK"))

);while

);if

(if BlockList@

(setq BlockList@ (Acad_StrlSort BlockList@))

);if

BlockList@

);defun GetBlockList

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

; GetRnd - Generates a random number

; Arguments: 1

; Num# = Maximum random integer number range greater than or less than 0.

; Returns: Random integer number between 0 and Num#.

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

(defun GetRnd (Num# / MaxNum# PiDate$ RndNum# Minus Loop)

(if (or (/= (type Num#) 'INT)(= Num# 0))

(progn

(princ "\nSyntax: (GetRnd Num#) Num# = Maximum random integer number range\ngreater than or less than 0.")

(exit)

);progn

);if

(if (< Num# 0)

(setq MaxNum# (abs (1- Num#)) Minus t)

(setq MaxNum# (1+ Num#))

);if

(if (not *RndNum*) (setq *RndNum* 10000))

(setq Loop t)

(while Loop

(if (or (null *int*)(> *int* 100))

(setq *int* 1)

(setq *int* (1+ *int*))

);if

(setq PiDate$ (rtos (* (getvar "cdate") (* pi *int*)) 2 8 ))

(cond

((>= MaxNum# 10000)

(setq RndNum# (fix (* (atof (substr PiDate$ 13 5)) (* MaxNum# 0.00001))))

)

((>= MaxNum# 1000)

(setq RndNum# (fix (* (atof (substr PiDate$ 14 4)) (* MaxNum# 0.0001))))

)

((>= MaxNum# 100)

(setq RndNum# (fix (* (atof (substr PiDate$ 15 3)) (* MaxNum# 0.001))))

)

((>= MaxNum# 10)

(setq RndNum# (fix (* (atof (substr PiDate$ 16 2)) (* MaxNum# 0.01))))

)

((>= MaxNum# 1)

(setq RndNum# (fix (* (atof (substr PiDate$ 17 1)) (* MaxNum# 0.1))))

)

(t (setq RndNum# 0))

);cond

(if (/= RndNum# *RndNum*)

(setq Loop nil)

);if

);while

(setq *RndNum* RndNum#)

(if Minus

(setq RndNum# (* RndNum# -1))

);if

RndNum#

);defun GetRnd

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

; Insert_nth - Inserts a new item value into the nth number in list.

; Arguments: 3

; Num# = Nth number in list to insert item value

; Value = Item value to insert

; OldList@ = List to insert item value

; Returns: A list with the new item value inserted.

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

(defun Insert_nth (Num# Value OldList@ / Temp@)

(if (< -1 Num# (1+ (length OldList@)))

(progn

(repeat Num#

(setq Temp@ (cons (car OldList@) Temp@)

OldList@ (cdr OldList@)

);setq

);repeat

(append (reverse Temp@) (list Value) OldList@)

);progn

OldList@

);if

);defun Insert_nth

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

; MirrorPt - Mirror point

; Arguments: 3

; Pt = Point to mirror

; BasePt = Base point

; Angle~ = Mirror angle in radians

; Returns: Returns location of mirrored point

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

(defun MirrorPt (Pt BasePt Angle~ / Pt1)

(if (> Angle~ pi)

(setq Angle~ (- Angle~ pi))

);if

(setq Pt1 (inters Pt (polar Pt (+ Angle~ (* pi 0.5)) 1)

BasePt (polar BasePt Angle~ 1) nil)

Pt1 (polar Pt1 (angle Pt Pt1) (distance Pt Pt1))

);setq

);defun MirrorPt

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

; Move_nth - Moves the nth Num1# item value to the nth Num2# location in a list.

; Arguments: 3

; Num1# = Nth number in list to move item value

; Num2# = Nth number in list to move item value of nth Num1# into

; OldList@ = List to move item values

; Returns: A list with nth item value moved.

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

(defun Move_nth (Num1# Num2# OldList@ / Move_nth:)

(defun Move_nth: (Num1# Num2# OldList@ Nth# Item)

(cond

((and (> Nth# Num1#) (> Nth# Num2#))

OldList@

);case

((= Nth# Num1#)

(Move_nth: Num1# (1+ Num2#) (cdr OldList@) (1+ Nth#) Item)

);case

((= Nth# Num2#)

(cons Item (Move_nth: (1+ Num1#) Num2# OldList@ (1+ Nth#) Item))

);case

((cons (car OldList@)

(Move_nth: Num1# Num2# (cdr OldList@) (1+ Nth#) Item))

);case

);cond

);defun Move_nth:

(if (and (/= Num1# Num2#) (<= 0 Num1# (1- (length OldList@))) (<= 0 Num2# (1- (length OldList@))))

(Move_nth: Num1# Num2# OldList@ 0 (nth Num1# OldList@))

OldList@

);if

);defun Move_nth

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

; PurgeGroups - Purge Unused Groups

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

(defun PurgeGroups (/ AllGroups@ Cnt# Dictionary^ EntFirst^ EntList@ FirstGroup$

Group^ GroupName$ Item Previous$ Pt SS& UsedGroups@)

(setq Pt (polar (getvar "VIEWCTR") (* pi 1.5)(/ (getvar "VIEWSIZE") 2.0)))

(command "_LINE" Pt (polar Pt (* pi 1.5) 0.00000001) "")

(setq EntFirst^ (entlast))

(setq FirstGroup$ (UniqueName))

(command "_-GROUP" "_C" FirstGroup$ "" EntFirst^ "")

(setq EntList@ (entget EntFirst^))

(setq Group^ (cdr (assoc 330 EntList@)))

(setq EntList@ (entget Group^))

(setq Dictionary^ (cdr (assoc 330 EntList@)))

(setq EntList@ (entget Dictionary^))

(foreach Item EntList@

(if (= (car Item) 3)

(if (not (member (cdr Item) AllGroups@))

(setq AllGroups@ (append AllGroups@ (list (cdr Item))))

);if

);foreach

(setq SS& (ssget "_X"))

(setq Cnt# 0)

(repeat (sslength SS&)

(setq EntList@ (entget (ssname SS& Cnt#)))

(if (= (cdr (assoc 102 EntList@)) "{ACAD_REACTORS")

(progn

(setq Group^ (cdr (assoc 330 EntList@)))

(setq EntList@ (entget Group^))

(if (setq Dictionary^ (cdr (assoc 330 EntList@)))

(progn

(setq EntList@ (entget Dictionary^))

(setq Previous$ "")

(foreach Item EntList@

(setq Item (cdr Item))

(if (equal Item Group^)

(setq GroupName$ Previous$)

);if

(setq Previous$ Item)

);foreach

(if (not (member GroupName$ UsedGroups@))

(setq UsedGroups@ (append UsedGroups@ (list GroupName$)))

);if

);progn

);if

);progn

);if

(setq Cnt# (1+ Cnt#))

);repeat

(foreach GroupName$ AllGroups@

(if (not (member GroupName$ UsedGroups@))

(command "_-GROUP" "_E" GroupName$)

);if

);foreach

(command "_-GROUP" "_E" FirstGroup$)

(command "_ERASE" EntFirst^ "")

(princ)

);defun PurgeGroups

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

; Remove_nths - Removes the RemoveList@ of nths from a list.

; Arguments: 2

; RemoveList@ = List of nths to remove

; OldList@ = List to remove the list of nths from

; Returns: A list with the list of nths removed.

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

(defun Remove_nths (RemoveList@ OldList@)

(if (and RemoveList@ OldList@)

(if (zerop (car RemoveList@))

(Remove_nths (mapcar '1- (cdr RemoveList@)) (cdr OldList@))

(cons (car OldList@) (Remove_nths (mapcar '1- RemoveList@) (cdr OldList@)))

);if

OldList@

);if

);defun Remove_nths

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

; rtd - Radians to degrees

; Arguments: 1

; Rad~ = radians

; Syntax: (rtd R)

; Returns: value in degrees.

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

(defun rtd (Rad~)

(* 180.0 (/ Rad~ pi))

);defun rtd

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

; Speed - Determines the computer processing speed and sets the global variable

; *speed# which may be used in delay loops.

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

(defun Speed (/ Cdate~ Cnt# NewSecond# OldSecond#)

(setq Cdate~ (getvar "CDATE"))

(setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10)))

(repeat 2

(setq Cnt# 0)

(setq OldSecond# NewSecond#)

(while (= NewSecond# OldSecond#)

(setq Cdate~ (getvar "CDATE"))

(setq NewSecond# (fix (* (- (* (- Cdate~ (fix Cdate~)) 100000)(fix (* (- Cdate~ (fix Cdate~)) 100000))) 10)))

(setq Cnt# (1+ Cnt#))

);while

);repeat

(setq *Speed# Cnt#)

(princ)

);defun Speed

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

; StarBurst - Draws a starburst shape

; Arguments: 5

; CenPt = Center of starburst

; Dia1~ = Inside diameter

; Dia2~ = Outside diameter

; Sides# = Number of points

; StartAng~ = Radian angle of first point

; Returns: Draws a starburst shape

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

(defun StarBurst (CenPt Dia1~ Dia2~ Sides# StartAng~ / Ang~ Ang1~ List@ List1@

List2@ List3@ Cnt1# Cnt2# Pt)

(setq Ang~ (/ pi Sides#))

(setq Ang1~ (+ StartAng~ (/ Ang~ 2.0)))

(repeat (* Sides# 2)

(setq Pt (polar CenPt Ang1~ (/ Dia1~ 2.0)))

(setq List1@ (append List1@ (list Pt)))

(setq Ang1~ (+ Ang1~ Ang~))

);repeat

(setq Ang1~ (+ StartAng~ Ang~))

(repeat Sides#

(setq Pt (polar CenPt Ang1~ (/ (+ Dia1~ Dia2~) 4.0)))

(setq List2@ (append List2@ (list Pt)))

(setq Ang1~ (+ Ang1~ (* Ang~ 2)))

);repeat

(setq Ang1~ StartAng~)

(repeat Sides#

(setq Pt (polar CenPt Ang1~ (/ Dia2~ 2.0)))

(setq List3@ (append List3@ (list Pt)))

(setq Ang1~ (+ Ang1~ (* Ang~ 2)))

);repeat

(setq Cnt1# 0 Cnt2# 0)

(repeat Sides#

(setq List@ (append List@ (list (nth Cnt1# List3@))))

(setq List@ (append List@ (list (nth Cnt2# List1@))))

(setq Cnt2# (1+ Cnt2#))

(setq List@ (append List@ (list (nth Cnt1# List2@))))

(setq List@ (append List@ (list (nth Cnt2# List1@))))

(setq Cnt2# (1+ Cnt2#))

(setq Cnt1# (1+ Cnt1#))

);repeat

(setq List@ (append List@ (list (nth 0 List3@))))

(command "_PLINE" (foreach Pt List@ (command Pt)))

(princ)

);defun StarBurst

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

; Switch_nth - Switches the nth Num1# and Num2# item values in a list.

; Arguments: 3

; Num1# = nth number in list to switch with nth Num2#

; Num2# = nth number in list to switch with nth Num1#

; OldList@ = List to switch item values

; Returns: A list with two item values switched.

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

(defun Switch_nth (Num1# Num2# OldList@ / Index#)

(setq Index# -1)

(if (and (< -1 Num1# (length OldList@)) (< -1 Num2# (length OldList@)))

(mapcar '(lambda (x) (setq Index# (1+ Index#))

(cond

((= Index# Num2#) (nth Num1# OldList@))

((= Index# Num1#) (nth Num2# OldList@))

(x)

)) OldList@

);mapcar

OldList@

);if

);defun Switch_nth

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

; tan - Tangent of radian degrees

; Arguments: 1

; radians = Radian degrees

; Returns: Tangent of radian degrees

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

(defun tan (radians)

(/ (sin radians) (cos radians))

);defun tan

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

; UniqueName - Creates a unique name for temp blocks and groups

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

(defun UniqueName (/ Loop Name$)

(setq Loop t)

(while Loop

(setq Name$ (rtos (getvar "CDATE") 2 8))

(setq Name$ (strcat (substr Name$ 4 5)(substr Name$ 10 8)))

(if (/= Name$ *UniqueName$)

(setq *UniqueName$ Name$ Loop nil)

);if

);while

*UniqueName$

);defun UniqueName

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

; ViewExtents

; Returns: List of upper left and lower right points of current view

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

(defun ViewExtents (/ A B C D X)

(setq B (getvar "VIEWSIZE")

A (* B (/ (car (getvar "SCREENSIZE")) (cadr (getvar "SCREENSIZE"))))

X (trans (getvar "VIEWCTR") 1 2)

C (trans (list (- (car X) (/ A 2.0)) (+ (cadr X) (/ B 2.0))) 2 1)

D (trans (list (+ (car X) (/ A 2.0)) (- (cadr X) (/ B 2.0))) 2 1)

);setq

(list C D)

);defun ViewExtents

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

(princ)

Anh em chơi thư nghe

Tháng 9 1, 2008

Cái này chơi thế nào ấy nhỉ?

Tháng 9 1, 2008

Có ai chơi thử chưa? Hướng dẫn sơ bộ thử xem. :lol:

Tháng 9 1, 2008

Có ai chơi thử chưa? Hướng dẫn sơ bộ thử xem. :lol:

LENH LÀ TROY

BẮN PHÁ LUNG TUNG BEN LÊN

Tháng 9 1, 2008

;-------------------------------------------------------------------------------
; Program Name: Troy.lsp [Troy R5] - Asteroids AutoLISP game

; Created By: phamtuan (Email: tuanngph@hpc.org.vn)

; Date Created: 1-20-06

Mình chưa chơi, nhưng mình biết email gốc là terrycadd@yahoo.com chứ không phải là tuanngph@hpc.org.vn.

Nhân tiện cũng giới thiệu với mọi người về tác giả terrycadd, mọi người vào trang web của ông ta để xem thêm, nhiều thứ khá thú vị: http://web2.airmail.net/terrycad

Tháng 9 1, 2008

Mình chưa chơi, nhưng mình biết email gốc là terrycadd@yahoo.com chứ không phải là tuanngph@hpc.org.vn.

Bắn phá lung tung mỗi lần di chuyển chuột, nhưng chả có hành tinh nào bị bể hết

:lol:

Tháng 9 1, 2008

Bắn phá lung tung mỗi lần di chuyển chuột, nhưng chả có hành tinh nào bị bể hết
:lol:

Em vào chơi thử rùi, giám đốc nhìn thấy khoái lém, cho cả công ty ngồi chơi luôn

Tháng 9 1, 2008

Mình chưa chơi, nhưng mình biết email gốc là terrycadd@yahoo.com chứ không phải là tuanngph@hpc.org.vn.

Vụ này có phải là "Bắt giò truyện ngắn" ở báo Mực tím không nhẩy(?!)

Tháng 9 1, 2008

Em vào chơi thử rùi, giám đốc nhìn thấy khoái lém, cho cả công ty ngồi chơi luôn

cHƠI THÌ CHƠI, XONG RỒI NẾU MÀ CẢM THẤY CÁI LISP NÀY HAY THÌ ẤN NÚT THANK NHÉ

http://www.cadviet.com/upfiles/LAYER.lsp

LỆNH LÀ ELA enter

gõ troy

Tháng 9 1, 2008

Vụ này có phải là "Bắt giò truyện ngắn" ở báo Mực tím không nhẩy(?!)

bác duongsat chỉ đưọc cái thâm thuý

Tháng 9 1, 2008

Mình chưa chơi, nhưng mình biết email gốc là terrycadd@yahoo.com chứ không phải là tuanngph@hpc.org.vn.
Nhân tiện cũng giới thiệu với mọi người về tác giả terrycadd, mọi người vào trang web của ông ta để xem thêm, nhiều thứ khá thú vị: http://web2.airmail.net/terrycad

Trước đây có bạn nào đó đã dưa lên rồi. Nhiều lắm chứ không phải nhiêu đâu. Chơi cũng được nhưng hể mình sửa qua tiếng việt là nó hông chạy nửa. dài quá nên không dò ra là nó kiểm tra chổ nào nửa.

Tháng 9 1, 2008

cHƠI THÌ CHƠI, XONG RỒI NẾU MÀ CẢM THẤY CÁI LISP NÀY HAY THÌ ẤN NÚT THANK NHÉ
http://www.cadviet.com/upfiles/LAYER.lsp

LỆNH LÀ ELA enter

gõ troy

KO hiểu lish cảu Bác nên chưa thấy hay nên chưa cám ơn đc :lol:

Bác giải thích đi

Tháng 9 1, 2008

KO hiểu lish cảu Bác nên chưa thấy hay nên chưa cám ơn đc :lol:
Bác giải thích đi

CHưa chơi à?

KHi đang vẽ 1 bản vẽ mà bạn chơi trò này thi khi chơi xong, các đối tượng vẫn còn hiện thì đè lện bản vẽ

LỆnh kia giúp xoá đối twợng có layer TROY

đến lưọt bạn rồi đó, ..............

Tháng 9 1, 2008

CHưa chơi à?
KHi đang vẽ 1 bản vẽ mà bạn chơi trò này thi khi chơi xong, các đối tượng vẫn còn hiện thì đè lện bản vẽ

LỆnh kia giúp xoá đối twợng có layer TROY

đến lưọt bạn rồi đó, ..............

Thôi cả nhà cứ đợi bác Phamtuan. Vì bác ấy là "create By....mà" . Không có cái phím nào có thể cho nó bắn cả.Mà em cũng chẳng biết cái phím nào để thoát game. Toàn dùng Task Manage. Chuối thế.

Tháng 9 1, 2008

Game này có gì hay hơn so với các game đang có trên thị trường không?

Tháng 9 1, 2008

Game này có gì hay hơn so với các game đang có trên thị trường không?

cốt là nó chơi trên cad, lỡ xếp có nhìn thấy cũng.......

(như kiểu là rửa tiền ấy bác..)

Tháng 9 1, 2008

Thôi cả nhà cứ đợi bác Phamtuan. Vì bác ấy là "create By....mà" . Không có cái phím nào có thể cho nó bắn cả.Mà em cũng chẳng biết cái phím nào để thoát game. Toàn dùng Task Manage. Chuối thế.

Click chuột ngay mũi tên là nó bắn ra 1 viên đạn mảnh tật mảnh, trúng hành tinh náo là nó nổ và ăn điểm. Nếu không chơi nữa thì ESC

:lol:

Tháng 9 2, 2008

Kaka, mở quan kinh doanh game đc rồi, tôi chỉ dày công sưu tập trên mạng rồi chia sẽ cho anh em thôi. Có cần bới móc như vậy không.

Còn khá nhiều game trên cad anh em xem nếu cần cứ PM tôi, keke, vui rồi

Tháng 9 3, 2008

cốt là nó chơi trên cad, lỡ xếp có nhìn thấy cũng.......
(như kiểu là rửa tiền ấy bác..)

he hé

Hùng ơi

ở cơ quan tớ

quýnh Game online thỏa mái-sếp còn quýnh hơn cả mình nữa

he hé

-------------

ờ mà cái Game này ai cải tiến bắn đạn nhiều nhiều tý - chứ thế này chả gọi là xả Sờ trét tý nào cả :lol:

Tháng 9 3, 2008

he hé
Hùng ơi

ở cơ quan tớ

quýnh Game online thỏa mái-sếp còn quýnh hơn cả mình nữa

he hé

-------------

ờ mà cái Game này ai cải tiến bắn đạn nhiều nhiều tý - chứ thế này chả gọi là xả Sờ trét tý nào cả :lol:

vanduong chơi game online gì thế? volam, ongame, hay cái gì. Nêúa chơi volam thì dụng hàng rồi. keke :lol:

Tháng 9 3, 2008

vanduong chơi game online gì thế? volam, ongame, hay cái gì. Nêúa chơi volam thì dụng hàng rồi. keke :lol:

he hé

nhiều lắm - nhiều lắm

nhưng mà chơi vui thôi

ko ham lắm - giải trí ấy mà

Chơi cái này cũng hay hay nhẩy

http://flashfabrica.com/f_learning/brain/brain.html

Tháng 9 3, 2008

Thêm một game nữa, mọi người chơi thử nhé

;;;--- BSHIP.lsp
;;;
;;;--- Battle Ship game
;;;

;;;
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;
;;;								   N O T E S
;;;
;;;
;;;--- Grids:
;;;
;;;	There are two grids.  The one on the left is where the computer's ships are
;;;	located.  The one on the right is where your ships are located.
;;;	Each grid has 10 rows and 10 columns. The bottom left cell is cell number 1.
;;;	The top right cell is cell number 100.  [Cell 100 is not used]
;;;
;;;
;;;
;;;
;;;
;;;--- Ship maps:
;;;
;;;		MAP1 = A list of cell numbers locating your ships on the grid.
;;;		MAP2 = A list of cell numbers location the computer's ships on the grid.
;;;
;;;		A ship map consist of: (2) minesweepers  [A mine sweeper has 2 cell numbers]
;;;							   (2) frigates	  [A frigate has 3 cell numbers]
;;;							   (1) cruiser	   [A cruiser has 4 cell numbers]
;;;							   (1) battleship	[A battleship has 5 cell numbers]
;;;
;;;
;;;		Example of a ship map:
;;;
;;;		( 12 13	20 30	34 35 36   50 60 70  1 2 3 4   48 58 68 78 88 )
;;;
;;;		 [12 13]		  Represent the cell numbers to make mine sweeper #1  [ship1]
;;;		 [20 30]		  Represent the cell numbers to make mine sweeper #2  [ship2]
;;;		 [34 35 36]	   Represent the cell numbers to make frigate #1	   [ship3]
;;;		 [50 60 70]	   Represent the cell numbers to make frigate #2	   [ship4]
;;;		 [1 2 3 4]		Represent the cell numbers to make the cruiser	  [ship5]
;;;		 [48 58 68 78 88] Represent the cell numbers to make the battleship   [ship6]
;;;
;;;
;;;
;;;--- Other maps:
;;;
;;;
;;;	   MAP3 = A list of all cells available for the user to choose from.
;;;	   MAP4 = A list of all cells available for the computer to choose from.
;;;
;;;	   They are simply used to keep up with which cells have already been chosen.
;;;
;;;	   
;;;	   OLDMAP1 - Copy of original map MAP1 
;;;	   OLDMAP2 - Copy of original map MAP2
;;;
;;;	   These are used because MAP1 and MAP2 get modified when a ship is hit or sunk.
;;;	   The cell numbers inside MAP1 and MAP2 get changed to zero or -1 when this occurs.
;;;	   After a ship is sunk I need to draw it on the grid.  If I didn't have a copy
;;;	   of the original map, I wouldn't know where the ship was originally located.
;;;
;;;
;;;
;;;
;;;
;;;
;;;--- Drawing a ship:
;;;
;;;	A horizontal or vertical ship can consist of three parts:
;;;
;;;	   The front of the ship, the middle of the ship, and the back of the ship.
;;;
;;;	   In order to do this I had to create 6 functions:
;;;
;;;	   Three for horizontal: drawF drawM drawE
;;;	   Three for vertical  : drawT drawC drawB
;;;
;;;	   F = Front   M = Middle   E = End
;;;	   T = Top	 C = Center   B = Bottom  
;;;
;;;	   To draw a horizontal minesweeper:  (drawF)(drawE)
;;;	   To draw a vertical minesweeper  :  (drawT)(drawB)
;;;
;;;	   To draw a horizontal cruiser:  (drawF)(drawM)(drawM)(drawE)
;;;	   To draw a vertical cruiser  :  (drawT)(drawC)(drawC)(drawB)	   
;;;
;;;
;;;
;;;
;;;
;;;
;;;--- Other important variable names:
;;;
;;;	LBL - Lower left corner of the left grid
;;;	RBL - Lower left corner of the right grid
;;;	RW  - Height of a row and width of a column
;;;	ANS - The users answer.  Usually a point selected on the grid.
;;;	CELLNUM - The number of a cell [1-99]
;;;	CELLPT  - The X,Y location of a cell's lower left hand corner.
;;;
;;;
;;;
;;;
;;;
;;;
;;;
;;;
;;;
;;;
;;;--- There is a lot of code unremarked below.  Most of this code is simply for drawing
;;;	the ships, grid, and text to the screen.  Don't let this concern you.
;;;



(defun C:BSHIP();/ vc vs rw lbl rbl ans ruleStr a b c cellPt cellNum
			;hitShip map1 map2 map3 map4 oldmap1 oldmap2 bombList num)





;;;--- Set up the grid and find all of the points used on the grid
(defun setUpGrid(bl / bmp tmp blpt brpt tlpt trpt tpt dpt mcpt ccpt rcpt lcpt xs ys pt1 pt2 pt3 pt4 cw gap nrw)

;;;--- Find the corners of the grid
 (setq bmp(polar bl 0 (* rw 5.0)))
 (setq tmp(polar (polar bl (* pi 0.5) (* rw 10.0)) 0 (* rw 5.0)))
 (setq blpt(polar bmp pi (* rw 5.0)))
 (setq brpt(polar bmp 0  (* rw 5.0)))
 (setq tlpt(polar tmp pi (* rw 5.0)))
 (setq trpt(polar tmp 0  (* rw 5.0)))

;;;--- Fill in the background area for the grid
 (setq tpt blpt)
 (while (<= (cadr tpt)(cadr tlpt))
(grdraw tpt (polar tpt 0 (* rw 10.0)) 142)
(setq tpt(polar tpt (* pi 0.5) (/ rw (* vs 2.0))))
 )

;;;--- Draw the cells
 (setq xs (car blpt) ys (cadr blpt))
 (while(<= ys (- (cadr trpt)rw))

(while (<= xs (- (car trpt)rw))
  (setq pt1 (list xs ys))
  (setq pt2(polar pt1 (* pi 0.5) rw))
  (setq pt3(polar pt2 0 rw))
  (setq pt4(polar pt1 0 rw))
  (grdraw pt1 pt4 252)
  (grdraw pt4 pt3 252)
  (grdraw pt3 pt2 254)
  (grdraw pt2 pt1 254)
  (setq xs(+ xs rw))  
)

(setq xs(car blpt))
(setq ys(+ ys rw))
 )  

;;;--- Draw JPS
 (drawJPS 
 (polar (polar vc (* pi 1.5) (* rw 7.0)) pi (* rw 10.0))
 (polar (polar vc (* pi 1.5) (* rw 7.0)) 0  (* rw 10.0))
 )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;--- Draw the headings

;;;--- Draw YOUR SHIPS
 (setq dpt(polar rbl (* pi 0.5) (* 10.125 rw)))
 (setq cw(/ rw 4.0))
 (setq gap(/ rw 8.0))
 (setq nrw(/ rw 2.0))

;;;--- Y
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq mcpt(polar dpt 0 (/ cw 2.0)))
 (setq ccpt(polar mcpt (* pi 0.5) (/ nrw 2.0)))
 (grdraw mcpt ccpt 2)
 (grdraw ccpt tlpt 2)
 (grdraw ccpt trpt 2)
;;;--- O
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (grdraw dpt tlpt 2)
 (grdraw tlpt trpt 2)
 (grdraw trpt brpt 2)
 (grdraw brpt dpt 2)
;;;--- U
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (grdraw tlpt dpt 2)
 (grdraw dpt brpt 2)
 (grdraw brpt trpt 2)
;;;--- R
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq mcpt(polar dpt 0 (/ cw 2.0)))
 (setq ccpt(polar mcpt (* pi 0.5) (/ nrw 2.0)))
 (grdraw dpt tlpt 2)
 (grdraw tlpt trpt 2)
 (grdraw trpt (polar ccpt 0 (/ cw 2.0)) 2)
 (grdraw (polar dpt (* pi 0.5) (/ nrw 2.0)) (polar ccpt 0 (/ cw 2.0)) 2)
 (grdraw (polar ccpt 0 (* cw 0.35)) brpt 2)
;;;--- Space and S
 (setq dpt(polar brpt 0 cw))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt brpt 2)
 (grdraw brpt rcpt 2)
 (grdraw rcpt lcpt 2)
 (grdraw lcpt tlpt 2)
 (grdraw tlpt trpt 2)
;;;--- H
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt tlpt 2)
 (grdraw brpt trpt 2)
 (grdraw lcpt rcpt 2)
;;;--- I
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq mcpt(polar dpt 0 (/ cw 2.0)))
 (grdraw dpt brpt 2)
 (grdraw tlpt trpt 2)
 (grdraw mcpt (polar mcpt (* pi 0.5) nrw) 2)
;;;--- P
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt tlpt 2)
 (grdraw tlpt trpt 2)
 (grdraw trpt (polar trpt (* pi 1.5) cw) 2)
 (grdraw (polar dpt (* pi 0.5) cw)(polar trpt (* pi 1.5) cw) 2)
;;;--- S
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt brpt 2)
 (grdraw brpt rcpt 2)
 (grdraw rcpt lcpt 2)
 (grdraw lcpt tlpt 2)
 (grdraw tlpt trpt 2)

;;;--- Draw MY SHIPS
 (setq dpt(polar lbl (* pi 0.5) (* 10.125 rw)))
 (setq cw(/ nrw 2.0))
 (setq gap(/ nrw 4.0))

;;;--- M
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq mcpt(polar dpt 0 (/ cw 2.0)))
 (setq ccpt(polar mcpt (* pi 0.5) (/ nrw 2.0)))
 (grdraw dpt tlpt 2)
 (grdraw tlpt ccpt 2)
 (grdraw ccpt trpt 2)
 (grdraw trpt brpt 2)
;;;--- Y
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq mcpt(polar dpt 0 (/ cw 2.0)))
 (setq ccpt(polar mcpt (* pi 0.5) (/ nrw 2.0)))
 (grdraw mcpt ccpt 2)
 (grdraw ccpt tlpt 2)
 (grdraw ccpt trpt 2)
;;;--- Space and S
 (setq dpt(polar brpt 0 cw))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt brpt 2)
 (grdraw brpt rcpt 2)
 (grdraw rcpt lcpt 2)
 (grdraw lcpt tlpt 2)
 (grdraw tlpt trpt 2)
;;;--- H
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt tlpt 2)
 (grdraw brpt trpt 2)
 (grdraw lcpt rcpt 2)
;;;--- I
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq mcpt(polar dpt 0 (/ cw 2.0)))
 (grdraw dpt brpt 2)
 (grdraw tlpt trpt 2)
 (grdraw mcpt (polar mcpt (* pi 0.5) nrw) 2)
;;;--- P
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt tlpt 2)
 (grdraw tlpt trpt 2)
 (grdraw trpt (polar trpt (* pi 1.5) cw) 2)
 (grdraw (polar dpt (* pi 0.5) cw)(polar trpt (* pi 1.5) cw) 2)
;;;--- S
 (setq dpt(polar brpt 0 gap))
 (setq tlpt(polar dpt(* pi 0.5) nrw))
 (setq trpt(polar tlpt 0 cw))
 (setq brpt(polar dpt 0 cw))
 (setq lcpt(polar dpt (* pi 0.5) (/ nrw 2.0)))
 (setq rcpt(polar lcpt 0 cw))
 (grdraw dpt brpt 2)
 (grdraw brpt rcpt 2)
 (grdraw rcpt lcpt 2)
 (grdraw lcpt tlpt 2)
 (grdraw tlpt trpt 2)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)


;;--- Draw JPS
(defun drawJPS(spt ept / tpt spt chwd chgp chht fpt blp trp)
 (setq tpt spt)
 (setq chwd(/ (distance spt ept) 26.0)) 
 (setq chgp(/ (* 7.0 chwd)20.0))		
 (setq chht(* chwd 2.0))				
 (setq fpt(polar spt 0 chgp))		   
;j
 (setq blp(polar fpt (* pi 1.5) chht))
 (setq trp(polar fpt 0 chwd))		 
 (grdraw (polar blp (* pi 0.5) (/ chht 4.0)) blp 5)
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw trp (polar blp 0 chwd) 5)
;e
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
;f
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
;f
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
;e
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
;r
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
 (grdraw trp (polar trp (* pi 1.5) (/ chht 2.0)) 5)
 (grdraw (polar (polar trp (* pi 1.5) (/ chht 2.0)) pi (/ chwd 3.0)) (polar blp 0 chwd) 5)
;y
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (setq cpt(polar (polar blp 0 (/ chwd 2.0)) (* pi 0.5) (/ chht 2.0)))
 (grdraw cpt (polar cpt (* pi 1.5) (/ chht 2.0)) 5)
 (grdraw cpt (polar cpt 0 (/ chwd 2.0)) 5)
 (grdraw cpt (polar cpt pi(/ chwd 2.0)) 5)
 (grdraw trp (polar trp (* pi 1.5) (/ chht 2.0)) 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0))(polar trp pi chwd) 5)
;p
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
 (grdraw trp (polar trp (* pi 1.5) (/ chht 2.0)) 5)
;s
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw (polar blp 0 chwd) (polar (polar blp 0 chwd) (* pi 0.5) (/ chht 2.0)) 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar trp (* pi 1.5) (/ chht 2.0)) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) (* pi 0.5) (/ chht 2.0)) 5) 
;a
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
 (grdraw trp (polar trp (* pi 1.5) chht) 5)
;n
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) (polar trp (* pi 1.5) chht) 5)
 (grdraw (polar trp (* pi 1.5) chht) trp 5)
;d
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (setq tlp(polar blp (* pi 0.5) chht))
 (setq brp(polar blp 0 chwd))
 (grdraw blp tlp 5)
 (grdraw blp (setq tpt(polar brp pi (/ chwd 4.0))) 5)
 (grdraw tpt (setq tpt(polar brp (* pi 0.5) (/ chht 4.0))) 5)
 (grdraw tpt (setq tpt(polar trp (* pi 1.5) (/ chht 4.0))) 5)
 (grdraw (setq npt(polar trp pi (/ chwd 4.0))) tlp 5) 
 (grdraw npt tpt 5)
;e
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
;r
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) 0 chwd) 5) 
 (grdraw trp (polar trp (* pi 1.5) (/ chht 2.0)) 5)
 (grdraw (polar (polar trp (* pi 1.5) (/ chht 2.0)) pi (/ chwd 3.0)) (polar blp 0 chwd) 5)
;s
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw (polar blp 0 chwd) (polar (polar blp 0 chwd) (* pi 0.5) (/ chht 2.0)) 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar trp (* pi 1.5) (/ chht 2.0)) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp (* pi 0.5) (/ chht 2.0)) (polar(polar blp (* pi 0.5) (/ chht 2.0)) (* pi 0.5) (/ chht 2.0)) 5) 
;.
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (setq bmp(polar blp 0 (/ chwd 2.0)))
 (setq bds(/ chwd 2.0))
 (grdraw bmp (setq tpt(polar bmp 0 (/ bds 2.0))) 5)
 (grdraw tpt (setq tpt(polar tpt (* pi 0.5) bds)) 5)
 (grdraw tpt (setq tpt(polar tpt pi bds)) 5)
 (grdraw tpt (setq tpt(polar tpt (* pi 1.5) bds)) 5)
 (grdraw tpt bmp 5)
;c
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
;o
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq trp(polar trp 0 (+ chwd chgp)))
 (grdraw blp (polar blp 0 chwd) 5)
 (grdraw blp (polar blp (* pi 0.5) chht) 5)
 (grdraw (polar blp (* pi 0.5) chht) trp 5)
 (grdraw (polar blp 0 chwd) trp 5)
;m
 (setq blp(polar blp 0 (+ chwd chgp)))
 (setq chw(* chwd 1.5))
 (setq trp(polar trp 0 (+ chw chgp)))
 (setq bmp(polar blp 0 (/ chw 2.0)))
 (grdraw blp (setq tpt(polar blp (* pi 0.5) chht)) 5)
 (grdraw tpt bmp 5)
 (grdraw bmp trp 5)
 (grdraw trp (polar blp 0 chw) 5)
)


;;;--- Draw a bomb
;;;	pt = lower left corner of cell  r = row height
(defun drawBomb(pt r / tpt cpt a)

;;;--- Make a copy of the start point [lower left corner of cell]
 (setq tpt pt)

;;;--- Find the center point of the cell
 (setq cpt(list (+ (car pt)(/ r 2.0)) (+ (cadr pt) (/ r 2.0))))

;;;--- Start with angle zero
 (setq a 0)

;;;--- Draw lines from the center of the cell on every degree to create a circle
 (repeat 360 
 (grdraw cpt (polar cpt a (/ r 5.0)) 1)
 (setq a(+ a (/ (* pi 2.0) 360.0)))
 )  

;;;--- Start with angle zero
 (setq a 0)

;;;--- Draw lines from the center of the cell to create the mine's spikes
 (repeat 8
(grdraw cpt (polar cpt a (/ r 3.0)) 1)
(setq a(+ a (/ (* pi 2.0) 8.0)))
 )

;;;--- Start with angle 1.7 radians
 (setq a 1.7)

;;;--- Draw a white spot on the mine for a small shiny reflection
 (while (< a 2.35)
(grdraw (polar cpt a (/ r 7.0))(polar cpt a (/ r 6.0)) 7)
(setq a(+ a 0.1))
 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;
;;;--- Draw a ship  
;;;	shipNum = ship number   hv	 = horizontal or vertical ship orientation
;;;	map	 = ship map	  gridpt = bottom left point of grid
;;;	  r	 = row height		bc = background color  fc = foreground color

(defun drawShip(shipNum hv map gridpt r bc fc)

;;;--- Draw ship number 1
 (if(= shipNum 1)
(progn

 ;;;--- Draw it horizontal
  (if (= hv "H")
	(progn
	  (drawE (nth 0 map) gridpt r bc fc)
	  (drawF (nth 1 map) gridpt r bc fc)
	)

   ;;;--- Or draw it vertical
	(progn
	  (drawB (nth 0 map) gridpt r bc fc)
	  (drawT (nth 1 map) gridpt r bc fc)
	)
  )
)
 )

;;;--- Draw ship number 2
 (if(= shipNum 2)
(progn

 ;;;--- Draw it horizontal
  (if (= hv "H")
	(progn
	  (drawE (nth 2 map) gridpt r bc fc)
	  (drawF (nth 3 map) gridpt r bc fc)
	)

   ;;;--- Or draw it vertical
	(progn
	  (drawB (nth 2 map) gridpt r bc fc)
	  (drawT (nth 3 map) gridpt r bc fc)
	)
  )
)
 )

;;;--- Draw ship number 3
 (if(= shipNum 3)
(progn

 ;;;--- Draw it horizontal
  (if (= hv "H")
	(progn
	  (drawE (nth 4 map) gridpt r bc fc)
	  (drawM (nth 5 map) gridpt r bc fc)
	  (drawF (nth 6 map) gridpt r bc fc)
	)

   ;;;--- Or draw it vertical
	(progn
	  (drawB (nth 4 map) gridpt r bc fc)
	  (drawC (nth 5 map) gridpt r bc fc)
	  (drawT (nth 6 map) gridpt r bc fc)
	)
  )
)
 )

;;;--- Draw ship number 4
 (if(= shipNum 4)
(progn

 ;;;--- Draw it horizontal
  (if (= hv "H")
	(progn
	  (drawE (nth 7 map) gridpt r bc fc)
	  (drawM (nth 8 map) gridpt r bc fc)
	  (drawF (nth 9 map) gridpt r bc fc)
	)

   ;;;--- Or draw it vertical
	(progn
	  (drawB (nth 7 map) gridpt r bc fc)
	  (drawC (nth 8 map) gridpt r bc fc)
	  (drawT (nth 9 map) gridpt r bc fc)
	)
  )
)
 )

;;;--- Draw ship number 5
 (if(= shipNum 5)
(progn

 ;;;--- Draw it horizontal
  (if (= hv "H")
	(progn
	  (drawE (nth 10 map) gridpt r bc fc)
	  (drawM (nth 11 map) gridpt r bc fc)
	  (drawM (nth 12 map) gridpt r bc fc)
	  (drawF (nth 13 map) gridpt r bc fc)
	)

   ;;;--- Or draw it vertical
	(progn
	  (drawB (nth 10 map) gridpt r bc fc)
	  (drawC (nth 11 map) gridpt r bc fc)
	  (drawC (nth 12 map) gridpt r bc fc)
	  (drawT (nth 13 map) gridpt r bc fc)
	)
  )
)
 )

;;;--- Draw ship number 6
 (if(= shipNum 6)
(progn

 ;;;--- Draw it horizontal
  (if (= hv "H")
	(progn
	  (drawE (nth 14 map) gridpt r bc fc)
	  (drawM (nth 15 map) gridpt r bc fc)
	  (drawM (nth 16 map) gridpt r bc fc)
	  (drawM (nth 17 map) gridpt r bc fc)
	  (drawF (nth 18 map) gridpt r bc fc)
	)

   ;;;--- Or draw it vertical
	(progn
	  (drawB (nth 14 map) gridpt r bc fc)
	  (drawC (nth 15 map) gridpt r bc fc)
	  (drawC (nth 16 map) gridpt r bc fc)
	  (drawC (nth 17 map) gridpt r bc fc)
	  (drawT (nth 18 map) gridpt r bc fc)
	)
  )
)
 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;--- Draw all ships in a map
;;;	shipMap = ship map
;;;	 gridpt = lower left corner of grid
;;;		  r = row height

(defun drawShips(shipMap gridpt r)

;;;--- Check to see if ship number 1 is horizontal
 (if(= (+ (nth 0 shipMap) 1)(nth 1 shipMap))

  ;;;--- If it is horizontal
(drawShip 1 "H" shipMap gridpt r c1 c2)

  ;;;--- Else, it is vertical
(drawShip 1 "V" shipMap gridpt r c1 c2)
 )

;;;--- Check to see if ship number 2 is horizontal
 (if(= (+ (nth 2 shipMap) 1)(nth 3 shipMap))

  ;;;--- If it is horizontal
(drawShip 2 "H" shipMap gridpt r c1 c2)

  ;;;--- Else, it is vertical
(drawShip 2 "V" shipMap gridpt r c1 c2)
 )

;;;--- Check to see if ship number 3 is horizontal
 (if(= (+ (nth 4 shipMap) 1)(nth 5 shipMap))

  ;;;--- If it is horizontal
(drawShip 3 "H" shipMap gridpt r c1 c2)

  ;;;--- Else, it is vertical
(drawShip 3 "V" shipMap gridpt r c1 c2)
 )

;;;--- Check to see if ship number 4 is horizontal
 (if(= (+ (nth 7 shipMap) 1)(nth 8 shipMap))

  ;;;--- If it is horizontal
(drawShip 4 "H" shipMap gridpt r c1 c2)

  ;;;--- Else, it is vertical
(drawShip 4 "V" shipMap gridpt r c1 c2)
 )

;;;--- Check to see if ship number 5 is horizontal
 (if(= (+ (nth 10 shipMap) 1)(nth 11 shipMap))

  ;;;--- If it is horizontal
(drawShip 5 "H" shipMap gridpt r c1 c2)

  ;;;--- Else, it is vertical
(drawShip 5 "V" shipMap gridpt r c1 c2)
 )

;;;--- Check to see if ship number 6 is horizontal
 (if(= (+ (nth 14 shipMap) 1)(nth 15 shipMap))

  ;;;--- If it is horizontal
(drawShip 6 "H" shipMap gridpt r c1 c2)

  ;;;--- Else, it is vertical
(drawShip 6 "V" shipMap gridpt r c1 c2)
 )
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;--- For all ship drawing functions below
;;;	a = cell number   
;;;	b = bottom left corner of grid
;;;	r = row height
;;;	bc = background color
;;;	fc = foreground color

;;;--- Draw the Front section of a horizontal ship
(defun drawF(a b r bc fc / c d e f g h)

;;;--- Convert the cell number to a cell's bottom left point
 (setq c(CN2CPT a b r))

;;;--- Get the center point of the cell
 (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))


;;;--- Fill the ship in
 (setq e 0)
 (setq f(polar c (* pi 0.5)(/ r 4.0)))
 (setq g(polar d (* pi 1.5)(/ r 4.0)))
 (while(< e (/ r 4.0))
(grdraw f (polar g 0 e) bc)
(setq f(polar f (* pi 0.5)(/ r 40.0)))
(setq g(polar g (* pi 0.5)(/ r 40.0)))
(setq e(+ e (/ r 40.0)))
 )
 (while(> e 0)
(grdraw f (polar g 0 e) bc)
(setq f(polar f (* pi 0.5)(/ r 40.0)))
(setq g(polar g (* pi 0.5)(/ r 40.0)))
(setq e(- e (/ r 40.0)))  
 )  
;;;--- Draw the gun
 (setq f(polar d pi (/ r 8.0)))
 (setq f(polar f (* pi 1.5) (/ r 8.0)))
 (while(< (cadr f) (+ (cadr d)(/ r 8.0)))
(grdraw f (polar f 0 (/ r 8.0)) fc)
(setq f(polar f (* pi 0.5) (/ r 40.0)))
 )
 (setq f(polar d (* pi 0.5)(/ r 14.0)))
 (grdraw f (polar f 0 (/ r 14.0)) fc)
 (setq f(polar d (* pi 1.5)(/ r 14.0)))
 (grdraw f (polar f 0 (/ r 14.0)) fc)

 (setq e(polar c (* pi 0.5) (* r 0.35)))
 (setq g(polar c (* pi 0.5) (* r 0.65)))
 (setq f(polar e 0 (* r 0.25)))
 (setq h(polar g 0 (* r 0.25)))
 (grdraw e f fc)
 (grdraw f h fc)
 (grdraw g h fc)


;;;--- Draw the outline of horizontal ship Front section
 (grdraw (polar c (* pi 0.5) (/ r 4.0)) (polar d (* pi 1.5) (/ r 4.0)) fc)  
 (grdraw (polar c (* pi 0.5) (* r 0.75))(polar d (* pi 0.5) (/ r 4.0)) fc)
 (grdraw (polar d (* pi 0.5) (/ r 4.0)) (polar d 0 (/ r 4.0)) fc)
 (grdraw (polar d (* pi 1.5) (/ r 4.0)) (polar d 0 (/ r 4.0)) fc)
)

;;;--- Draw the Middle section of a horizontal ship
(defun drawM(a b r bc fc / c d e f g h)

;;;--- Convert the cell number to a cell's bottom left point
 (setq c(CN2CPT a b r))

;;;--- Get the center point of the cell
 (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))  

;;;--- Fill in the ship
 (setq f (polar c (* pi 0.5) (/ r 4.0)))
 (setq g (polar c (* pi 0.5) (* r 0.75)))
 (while (< (cadr f)(cadr g))
(grdraw f (polar f 0 r) bc)
(setq f(polar f (* pi 0.5) (/ r 40.0)))
 )

 (setq e(polar c (* pi 0.5) (* r 0.35)))
 (setq f(polar c (* pi 0.5) (* r 0.65)))
 (setq g(polar e 0 (* r 0.25)))
 (setq h(polar f 0 (* r 0.25)))
 (grdraw e g fc)
 (grdraw g h fc)
 (grdraw f h fc)
 (setq e(polar e 0 (* r 0.75)))
 (setq f(polar f 0 (* r 0.75)))
 (setq g(polar e 0 (* r 0.25)))
 (setq h(polar f 0 (* r 0.25)))
 (grdraw f h fc)
 (grdraw f e fc)
 (grdraw e g fc)

;;;--- Start with 45 degrees
 (setq f (/ pi 8.0))

;;;--- Draw lines from the center of the cell to create a circle
 (setq pt1(polar d 0 (/ r 8.0)))
 (repeat 16 
 (setq f(+ f (/ pi 8.0)))
 (grdraw pt1 (setq pt1(polar d f (/ r 8.0))) fc)
 )  


;;;--- Get the right bottom corner of the cell
 (setq e(polar c 0 r))

;;;--- Draw the outline of a horzontal ship Middle section
 (grdraw (polar c (* pi 0.5) (/ r 4.0))  (polar e (* pi 0.5) (/ r 4.0))  fc)
 (grdraw (polar c (* pi 0.5) (* r 0.75)) (polar e (* pi 0.5) (* r 0.75)) fc)
)

;;;--- Draw the End section of a horizontal ship
(defun drawE(a b r bc fc / c e f g h)


;;;--- Convert the cell number to a cell's bottom left point
 (setq c(CN2CPT a b r))

;;;--- Get the center point of the cell
 (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))

;;;--- Fill the ship in
 (setq f(polar c (* pi 0.5)(* r 0.25)))
 (setq f(polar f 0 (/ r 4.0)))
 (setq g(polar c (* pi 0.5)(* r 0.75)))
 (setq g(polar g 0 (/ r 4.0)))
 (while(< (cadr f)(cadr g))
(grdraw f (polar f 0 (* r 0.75)) bc)
(setq f(polar f (* pi 0.5)(/ r 40.0)))
 )
;;;--- Draw the gun
 (setq f(polar d pi (/ r 8.0)))
 (setq f(polar f (* pi 1.5) (/ r 8.0)))
 (while(< (cadr f) (+ (cadr d)(/ r 8.0)))
(grdraw f (polar f 0 (/ r 8.0)) fc)
(setq f(polar f (* pi 0.5) (/ r 40.0)))
 )
 (setq f(polar d (* pi 0.5)(/ r 14.0)))
 (grdraw f (polar f pi (/ r 6.0)) fc)
 (setq f(polar d (* pi 1.5)(/ r 14.0)))
 (grdraw f (polar f pi (/ r 6.0)) fc)

 (setq e(polar d (* pi 0.5) (* r 0.15)))
 (setq e(polar e 0 (* r 0.15)))
 (setq g(polar d (* pi 1.5) (* r 0.15)))
 (setq g(polar g 0 (* r 0.15)))
 (setq f(polar e 0 (* r 0.35)))
 (setq h(polar g 0 (* r 0.35)))
 (grdraw e f fc)
 (grdraw g h fc)
 (grdraw e g fc)

;;;--- Get the right bottom corner of the cell
 (setq e(polar c 0 r))

;;;--- Get the point on the cell a 1/4 of the way horizontally
 (setq f(polar c 0 (/ r 4.0)))

;;;--- Draw the outline of horizontal ship End section
 (grdraw (polar e (* pi 0.5) (/ r 4.0)) (polar f (* pi 0.5) (/ r 4.0))  fc)  
 (grdraw (polar f (* pi 0.5) (/ r 4.0)) (polar f (* pi 0.5) (* r 0.75)) fc)
 (grdraw (polar f (* pi 0.5) (* r 0.75))(polar e (* pi 0.5) (* r 0.75)) fc)
)
;;;--- Draw the Top section of a vertical ship
(defun drawT(a b r bc fc / c d e f g h)

;;;--- Convert the cell number to a cell's bottom left point
 (setq c(CN2CPT a b r))

;;;--- Get the center point of the cell
 (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))

;;;--- Fill the ship in
 (setq e 0)
 (setq f(polar c 0 (/ r 4.0)))
 (setq g(polar f (* pi 0.5) (* r 0.5)))
 (while(< e (/ r 4.0))
(grdraw f (polar g (* pi 0.5) e) bc)
(setq f(polar f 0 (/ r 40.0)))
(setq g(polar g 0 (/ r 40.0)))
(setq e(+ e (/ r 40.0)))
 )
 (while(> e 0)
(grdraw f (polar g (* pi 0.5) e) bc)
(setq f(polar f 0 (/ r 40.0)))
(setq g(polar g 0 (/ r 40.0)))
(setq e(- e (/ r 40.0)))  
 )  

;;;--- Draw the gun
 (setq f(polar d pi (* r 0.15)))
 (while(> (cadr f)(- (cadr d) (/ r 8.0)))
(grdraw f (polar f 0 (* r 0.3)) fc)
(setq f(polar f (* pi 1.5) (/ r 40.0)))
 )
 (setq f(polar d pi(/ r 14.0)))
 (grdraw f (polar f (* pi 0.5) (/ r 14.0)) fc)
 (setq f(polar d 0(/ r 14.0)))
 (grdraw f (polar f (* pi 0.5)(/ r 14.0)) fc)

 (setq e(polar c 0 (* r 0.35)))
 (setq f(polar c 0 (* r 0.65)))
 (setq g(polar e (* pi 0.5) (* r 0.25)))
 (setq h(polar f (* pi 0.5) (* r 0.25)))
 (grdraw e g fc)
 (grdraw g h fc)
 (grdraw h f fc)


;;;--- Draw the outline of the vertical ship Top section
 (grdraw (polar c 0 (/ r 4.0)) (polar d pi (/ r 4.0)) fc)
 (grdraw (polar c 0 (* r 0.75))(polar d 0  (/ r 4.0)) fc)
 (grdraw (polar d 0 (/ r 4.0)) (polar d (* pi 0.5) (/ r 4.0)) fc)
 (grdraw (polar d pi(/ r 4.0)) (polar d (* pi 0.5) (/ r 4.0)) fc)
)
;;;--- Draw the Center section of a vertical ship
(defun drawC(a b r bc fc / c d e f g h)

;;;--- Convert the cell number to a cell's bottom left point
 (setq c(CN2CPT a b r))

;;;--- Fill in the ship
 (setq f (polar c 0 (/ r 4.0)))
 (setq g (polar c 0 (* r 0.75)))
 (while (< (car f)(car g))
(grdraw f (polar f (* pi 0.5) r) bc)
(setq f(polar f 0 (/ r 40.0)))
 )

 (setq e(polar c 0 (* r 0.35)))
 (setq f(polar c 0 (* r 0.65)))
 (setq g(polar e (* pi 0.5) (* r 0.25)))
 (setq h(polar f (* pi 0.5) (* r 0.25)))
 (grdraw e g fc)
 (grdraw g h fc)
 (grdraw f h fc)
 (setq e(polar e (* pi 0.5) (* r 0.75)))
 (setq f(polar f (* pi 0.5) (* r 0.75)))
 (setq g(polar e (* pi 0.5) (* r 0.25)))
 (setq h(polar f (* pi 0.5) (* r 0.25)))
 (grdraw f h fc)
 (grdraw f e fc)
 (grdraw e g fc)

;;;--- Get the center point of the cell
 (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))

;;;--- Start with 45 degrees
 (setq f (/ pi 8.0))

;;;--- Draw lines from the center of the cell to create a circle
 (setq pt1(polar d 0 (/ r 8.0)))
 (repeat 16 
 (setq f(+ f (/ pi 8.0)))
 (grdraw pt1 (setq pt1(polar d f (/ r 8.0))) fc)
 )  


;;;--- Get the top left corner of the cell
 (setq f(polar c (* pi 0.5) r))

;;;--- Draw the outline of a vertical ship Center section
 (grdraw (polar c 0 (/ r 4.0))  (polar f 0 (/ r 4.0))  fc)
 (grdraw (polar c 0 (* r 0.75)) (polar f 0 (* r 0.75)) fc)
)
;;;--- Draw the Bottom section of a vertical ship
(defun drawB(a b r bc fc / c d e f g h)

;;;--- Convert the cell number to a cell's bottom left point
 (setq c(CN2CPT a b r))

;;;--- Get the center point of the cell
 (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))

;;;--- Fill in the ship
 (setq e(polar c (* pi 0.5) r))
 (setq f(polar e 0 (/ r 4.0)))
 (setq g(polar e 0 (* r 0.75)))
 (while(< (car f)(car g))
(grdraw f (polar f (* pi 1.5) (* r 0.75)) bc)
(setq f(polar f 0 (/ r 40.0)))
 )

;;;--- Draw the guns
 (setq e (polar d (* pi 1.5) (/ r 8.0)))
 (setq e (polar e pi (* r 0.15)))
 (while (< (cadr e) (cadr d))
(grdraw e (polar e 0 (* r 0.3)) fc)
(setq e(polar e (* pi 0.5) (/ r 40.0)))
 )
 (setq e (polar d (* pi 1.5) (/ r 8.0)))
 (setq f (polar e pi (/ r 16.0)))
 (grdraw f (polar f (* pi 1.5) (/ r 16.0)) fc)  
 (setq f (polar e 0 (/ r 16.0)))
 (grdraw f (polar f (* pi 1.5) (/ r 16.0)) fc)	  

 (setq e(polar c 0 (* r 0.35)))
 (setq f(polar c 0 (* r 0.65)))
 (setq g(polar e (* pi 0.5) (* r 0.25)))
 (setq h(polar f (* pi 0.5) (* r 0.25)))
 (setq e(polar e (* pi 0.5) (* r 0.75)))
 (setq f(polar f (* pi 0.5) (* r 0.75)))
 (setq g(polar e (* pi 0.5) (* r 0.25)))
 (setq h(polar f (* pi 0.5) (* r 0.25)))
 (grdraw f h fc)
 (grdraw f e fc)
 (grdraw e g fc)



;;;--- Get the point on the cell a 1/4 of the way vertically
 (setq d(polar c (* pi 0.5) (/ r 4.0)))

;;;--- Get the top left corner of the cell
 (setq f(polar c (* pi 0.5) r))

;;;--- Draw the outline of the vertical ship Bottom section
 (grdraw (polar f 0 (/ r 4.0)) (polar d 0 (/ r 4.0))  fc)  
 (grdraw (polar d 0 (/ r 4.0)) (polar d 0 (* r 0.75)) fc)
 (grdraw (polar d 0 (* r 0.75))(polar f 0 (* r 0.75)) fc)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;--- Draw a miss [non-hit]
;;;
;;;	a = cell number
;;;	b = lower left corner of grid
;;;	h = hit map
;;;	r = row height

(defun drawMiss(a b h r / c d di ang pt1 pt2)

;;;--- If the cell hasn't been chosen before
 (if(or (member a h) (= a 100))
(progn

 ;;;--- Convert the cell number to a cell point
  (setq c (CN2CPT a b r))

 ;;;--- Find the center point of the cell
  (setq d(polar (polar c 0 (/ r 2.0)) (* pi 0.5) (/ r 2.0)))

 ;;;--- Set a starting diameter to draw circles
  (setq di(/ r 4.0))

 ;;;--- Draw three circles
  (repeat 3

   ;;;--- Start at angle zero
	(setq ang 0)

   ;;;--- Repeat one time for every degree
	(repeat 360

	 ;;;--- Find the start point of a line segment to create an arc
	  (setq pt1(polar d ang (/ di 2.0)))

	 ;;;--- Find the end of the line segment
	  (setq pt2(polar d (+ ang (/ pi 180.0)) (/ di 2.0)))

	 ;;;--- Draw the line
	  (grdraw pt1 pt2 146)

	 ;;;--- Add a degree to the angle
	  (setq ang(+ ang (/ pi 180.0)))
	)

   ;;;--- Increase the diameter for the next circle
	(setq di(+ di (/ r 4.0)))
  )

 ;;;--- Start with angle zero
  (setq ang 0.0)

 ;;;--- Draw eight lines from the center at 45 degree increments
  (repeat 8

   ;;;--- Draw the line
	(grdraw d (polar d ang (/ r 8.0)) 7)

   ;;;--- Add 45 degrees to the angle
	(setq ang(+ ang (/ pi 4.0)))
  )
)
 )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;--- Check for a sunken ship
;;;
;;;	s = ship map
;;;   os = original ship map [oldmap]
;;;	b = botton left corner of grid
;;;	r = row height
;;;	f = Computer or User ["C" = computer "U" = user]

(defun chkSunken(s os b r f / horVer sunk)

;;;
;;;
;;;	Notes:
;;;
;;;	When a ship is hit, the cell number in that ship's map is replaced
;;;	with -1.  When all cell numbers for that ship equal -1 that ship
;;;	is sunk.  Remember to replace the -1's with zeros afterwards so you
;;;	will not sink that ship again.
;;;
;;;

;;;--- Set up a return variable
 (setq sunk 0)

;;;--- If the first ship in the ship map adds up to -2, it is sunk...
 (if (= -2 (+ (nth 0 s) (nth 1 s)))
(progn

 ;;;--- See if the ship was horizontal or vertical
  (if(= (+ 1 (nth 0 os))(nth 1 os))(setq horVer "H")(setq horVer "V"))

 ;;;--- Draw sunken ship number 1
  (drawShip 1 horVer os b r c3 c4)

 ;;;--- Set the return variable to ship 1
  (setq sunk 1)

  (setq rnum(atoi(substr (rtos (getvar "cdate") 2 18)17)))

 ;;;--- Alert the user
  (if (= f "U")
	(alert "Computer says: You sank my MineSweeper!")
	(alert "Computer says: I sank your MineSweeper!")
  )

)
 )

;;;--- If the second ship in the ship map adds up to -2, it is sunk...
 (if (= -2 (+ (nth 2 s) (nth 3 s)))
(progn

 ;;;--- See if the ship was horizontal or vertical
  (if(= (+ 1 (nth 2 os))(nth 3 os))(setq horVer "H")(setq horVer "V"))

 ;;;--- Draw sunken ship number 2
  (drawShip 2 horVer os b r c3 c4)

 ;;;--- Set the return variable to ship 1
  (setq sunk 2)

 ;;;--- Alert the user
  (if (= f "U")
	(alert "Computer says: You sank my MineSweeper!")
	(alert "Computer says: I sank your MineSweeper!")
  )
)
 )

;;;--- If the third ship in the ship map adds up to -3, it is sunk...
 (if (= -3 (+ (nth 4 s) (nth 5 s)(nth 6 s)))
(progn

 ;;;--- See if the ship was horizontal or vertical
  (if(= (+ 1 (nth 4 os))(nth 5 os))(setq horVer "H")(setq horVer "V"))

 ;;;--- Draw sunken ship number 3
  (drawShip 3 horVer os b r c3 c4)

 ;;;--- Set the return variable to ship 1
  (setq sunk 3)

 ;;;--- Alert the user
  (if(= f "U")
	(alert "Computer says: You sank my Frigate!")
	(alert "Computer says: I sank your Frigate!")
  )
)
 )

;;;--- If the fourth ship in the ship map adds up to -3, it is sunk...
 (if (= -3 (+ (nth 7 s) (nth 8 s)(nth 9 s)))
(progn

 ;;;--- See if the ship was horizontal or vertical
  (if(= (+ 1 (nth 7 os))(nth 8 os))(setq horVer "H")(setq horVer "V"))

 ;;;--- Draw the computer's sunken ship number 4
  (drawShip 4 horVer os b r c3 c4)

 ;;;--- Set the return variable to ship 1
  (setq sunk 4)

 ;;;--- Alert the user
  (if(= f "U")
	(alert "Computer says: You sank my Frigate!")
	(alert "Computer says: I sank your Frigate!")
  )
)
 )

;;;--- If the fifth ship in the ship map adds up to -4, it is sunk...
 (if (= -4 (+ (nth 10 s) (nth 11 s)(nth 12 s)(nth 13 s)))
(progn

 ;;;--- See if the ship was horizontal or vertical
  (if(= (+ 1 (nth 10 os))(nth 11 os))(setq horVer "H")(setq horVer "V"))

 ;;;--- Draw sunken ship number 5
  (drawShip 5 horVer os b r c3 c4)

 ;;;--- Set the return variable to ship 1
  (setq sunk 5)

 ;;;--- Alert the user
  (if(= f "U")
	(alert "Computer says: You sank my Cruiser!")
	(alert "Computer says: I sank your Cruiser!")
  )
)
 )

;;;--- If the sixth ship in the ship map adds up to -5, it is sunk...
 (if (= -5 (+ (nth 14 s)(nth 15 s)(nth 16 s)(nth 17 s)(nth 18 s)))
(progn

 ;;;--- See if the ship was horizontal or vertical
  (if(= (+ 1 (nth 14 os))(nth 15 os))(setq horVer "H")(setq horVer "V"))

 ;;;--- Draw sunken ship number 6
  (drawShip 6 horVer os b r c3 c4)

 ;;;--- Set the return variable to ship 1
  (setq sunk 6)

 ;;;--- Alert the user
  (if(= f "U")
	(alert "Computer says: You sank my Battle Ship!")
	(alert "Computer says: I sank your Battle Ship!")
  )
)
 )

;;;--- Return the ship number that was sunk
 sunk
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;--- Functions


;;;--- Convert the cell number to a cell's bottom left point
;;;	a = cellnumber   b = Bottom left point of grid   r = row height
(defun CN2CPT(a b r / x y c)
 (setq y(* (/ (- a 1) 10) r))
 (setq x(* r(-(- a(* (/ (- a 1)10)10))1)))
 (setq c(polar b 0 x))
 (setq c(polar c (* pi 0.5) y))
)

;;;--- Convert the bottom left cell point to a cell number
;;;	a = bottom left cell point  b = bottom left point of grid  r = row height
(defun CPT2CN(a b r / x y)
 (setq x(- (car a)(car B)))
 (setq y(- (cadr a)(cadr B)))
 (setq x(+(fix(/ x r))1))
 (setq y(fix(/ y r)))
 (setq y(* y 10))
 (+ x y)
)

;;;--- Convert the selected point to a cell number
;;;	a = selected point  b = bottom left point of grid  r=row height
(defun SPT2CN(a b r / x y)
 (setq x(- (car a)(car B)))
 (setq y(- (cadr a)(cadr B)))
 (setq x(+(fix(/ x r))1))
 (setq y(fix(/ y r)))
 (setq y(* y 10))
 (+ x y)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;


(defun setUpMaps(/ rnum)
 (setq rnum(atoi(substr (rtos (getvar "cdate") 2 18)17)))
 (setq map1
(cond
  ((= rnum 0)(list 13 23 53 54 45 46 47 84 85 86 26 27 28 29 48 58 68 78 88))
  ((= rnum 1)(list 14 24 16 17 25 26 27 62 72 82 18 28 38 48  4  5  6  7  8)) 
  ((= rnum 2)(list 38 48 76 77  4  5  6 97 98 99 10 20 30 40 32 42 52 62 72))
  ((= rnum 3)(list 70 80 87 97 38 39 40 42 43 44 47 57 67 77 58 68 78 88 98))
  ((= rnum 4)(list 13 23 52 53 18 19 20 44 45 46 48 58 68 78 71 72 73 74 75))
  ((= rnum 5)(list  1  2 60 70  7  8  9 30 40 50 24 34 44 54 94 95 96 97 98))
  ((= rnum 6)(list 23 33 42 43 58 59 60 75 85 95 61 71 81 91 12 13 14 15 16))
  ((= rnum 7)(list 51 52 88 89 46 56 66 82 83 84  4 14 24 34  9 19 29 39 49))
  ((= rnum 8)(list  6  7 44 45 28 38 48 65 75 85 21 22 23 24 52 62 72 82 92))
  ((= rnum 9)(list 53 63 71 81 11 12 13 76 77 78 27 37 47 57 50 60 70 80 90))
)
 )
 (setq map2
(cond
  ((= rnum 0)(list 70 80 87 97 38 39 40 42 43 44 47 57 67 77 58 68 78 88 98))
  ((= rnum 1)(list 23 33 42 43 58 59 60 75 85 95 61 71 81 91 12 13 14 15 16))
  ((= rnum 2)(list 13 23 53 54 45 46 47 84 85 86 26 27 28 29 48 58 68 78 88))
  ((= rnum 3)(list 38 48 76 77  4  5  6 97 98 99 10 20 30 40 32 42 52 62 72))
  ((= rnum 4)(list 14 24 16 17 25 26 27 62 72 82 18 28 38 48  4  5  6  7  8)) 
  ((= rnum 5)(list 53 63 71 81 11 12 13 76 77 78 27 37 47 57 50 60 70 80 90))
  ((= rnum 6)(list  1  2 60 70  7  8  9 30 40 50 24 34 44 54 94 95 96 97 98))
  ((= rnum 7)(list  6  7 44 45 28 38 48 65 75 85 21 22 23 24 52 62 72 82 92))
  ((= rnum 8)(list 13 23 52 53 18 19 20 44 45 46 48 58 68 78 71 72 73 74 75))
  ((= rnum 9)(list 51 52 88 89 46 56 66 82 83 84  4 14 24 34  9 19 29 39 49))
)
 )
 (setq map3
(list 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 
	  26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
	  51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
	  76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
)
 )
 (setq map4 map3)
 (setq oldmap1 map1)
 (setq oldmap2 map2)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;; Artificial Intelligence;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;--- Return the horizontal unused cells next to this cell number [hn]
(defun addHorVer(hn / tList nnum)

;;;--- Build an empty list to hold the cell numbers
 (setq tList(list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;  Note:  Taking the following map....										
;;;
;;;		-------------------------------------
;;;		|   |   |   | F |   |   |   |   |   |
;;;		-------------------------------------
;;;		|   |   |   | C |   |   |   |   |   |
;;;		-------------------------------------
;;;		|   | H | A | X | B | G |   |   |   |
;;;		-------------------------------------
;;;		|   |   |   | D |   |   |   |   |   |
;;;		-------------------------------------
;;;		|   |   |   | E |   |   |   |   |   |
;;;		-------------------------------------
;;;
;;;  If X marks the spot where the computer dropped a bomb and hit something,
;;;  we want to check the cells located around it to find the ship.  We will
;;;  tell the computer to check cell A first, B second, C third, D fourth,
;;;  E fifth, F sixth, G seventh, and H last.  These cell numbers will be
;;;  stored in a list called TLIST.  This list will be returned to a variable
;;;  named BOMBLIST.  BOMBLIST will be erased when a ship sinks or another hit
;;;  occurs.  If another hit occurs, a new BOMBLIST will be generated.  The 
;;;  BOMBLIST should never contain a cell number that has already been chosen.  
;;;  
;;;  Ideally, I would like to keep up with the cell numbers that contain bombs,
;;;  then revise the BOMBLIST to remove vertical or horizontal cells if I find
;;;  two locations on a ship.  For example, if I find a ship at Cells X and A,
;;;  then I would remove cells C,D,E & F from the list.  No reason to check them
;;;  since I know the ship is horizontal.  This would make the computer much
;;;  more efficient on destroying ships.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;--- If X is greater than 10, there is a cell D
 (if(> hn 10)
(progn

 ;;;--- Add cell D to the beginning of the list if it has not been selected before
  (if(member (- hn 10) map4)(setq tList(append (list (- hn 10))tList)))

 ;;;--- If X is greater than 20 then there is a cell E
  (if(> hn 20)

   ;;;--- Add cell E to the end of the list if it has not been selected before
	(if(member (- hn 20) map4)(setq tList(append tList(list (- hn 20)))))	 
  )
)
 )

;;;--- If X is greater than 91 then cell C exist
 (if(< hn 91)
(progn

 ;;;--- Add cell C to the beginning of the list if it has not been selected before
  (if(member (+ hn 10) map4)(setq tList(append (list (+ hn 10))tList)))

 ;;;--- If X is less than 81 then cell F exist
  (if(< hn 81)

   ;;;--- Add cell F to the end of the list if it has not been selected before		 
	(if(member (+ hn 20) map4)(setq tList(append tList(list (+ hn 20)))))
  )
)
 )

;;;--- If X is not one of these numbers then cell B exist
 (if(and(/= hn 10)(/= hn 20)(/= hn 30)(/= hn 40)(/= hn 50)(/= hn 60)(/= hn 70)(/= hn 80)(/= hn 90))
(progn

 ;;;--- Add cell B to the beginning of the list if it has not been selected before
  (if(member (+ hn 1) map4)(setq tList(append (list (+ hn 1))tList)))

 ;;;--- If X is not one of these numbers then cell G exist
  (if(and(/= hn 9)(/= hn 19)(/= hn 29)(/= hn 39)(/= hn 49)(/= hn 59)(/= hn 69)(/= hn 79)(/= hn 89)(/= hn 99))

   ;;;--- Add cell G to the end of the list if it has not been selected before
	(if(member (+ hn 2) map4)(setq tList(append tList(list (+ hn 2)))))
  )
)
 )

;;;--- If X is not one of these cell numbers then there is a cell A
 (if(and(/= hn 1)(/= hn 11)(/= hn 21)(/= hn 31)(/= hn 41)(/= hn 51)(/= hn 61)(/= hn 71)(/= hn 81)(/= hn 91))
(progn

 ;;;--- Add cell A to the beginning of the list if it hasn't been selected before
  (if(member (- hn 1) map4)(setq tList(append (list (- hn 1))tList)))

 ;;;--- If X is not one of these numbers then cell H exist
  (if(and (/= hn 2)(/= hn 12)(/= hn 22)(/= hn 32)(/= hn 42)(/= hn 52)(/= hn 62)(/= hn 72)(/= hn 82)(/= hn 92))

   ;;;--- Add cell H to the end of the list if it hasn't been selected 
	(if(member (- hn 2) map4)(setq tList(append tList(list (- hn 2)))))
  )
)
 )

;;;--- Return the list of cell numbers to bomb next
 tList
)




;;;--- Set up a new BOMBLIST
;;;	cn = cell number of last bombed cell

(defun setupBombNextList(cn / x y num)

;;;--- Get the horizontal and vertical cells next to this cell
 (if (setq nnum(addHorVer cn))

  ;;;--- Save the returned list [tList] to BOMBLIST 
(setq bombList(append bombList nnum))
 )
)

;;;--- Function to replace a member in the bomblist
(defun replBomb(b chk / a c d f g h i j k l m)
 (setq d chk)
 (setq f(- d 1) g(+ d 1) h(- d 2) i(+ d 2) j(+ d 10) k(- d 10) l(+ d 20) m(- d 20))
 (if(member d B)(setq b(subst 0 d B)))
 (if(member f B)(setq b(subst 0 f B)))
 (if(member g B)(setq b(subst 0 g B)))
 (if(member h B)(setq b(subst 0 h B)))
 (if(member i B)(setq b(subst 0 i B)))
 (if(member j B)(setq b(subst 0 j B)))
 (if(member k B)(setq b(subst 0 k B)))
 (if(member l B)(setq b(subst 0 l B)))
 (if(member m B)(setq b(subst 0 m B)))
 (setq c B)
 (setq b(list))
 (foreach a c
 (if(/= a 0)
   (setq b(append b (list a)))
 )
 )
 b
)

;;;--- Function to remove Bomb locations after a ship sinks
;;;	b = bomblist   s = ship number
(defun fixBombList(b s / a c d)

;;;--- Check ship 1
 (if(= s 1)
(progn
  (setq b(replBomb b (nth 0 oldmap2)))
  (setq b(replBomb b (nth 1 oldmap2)))
)
 )
;;;--- Check ship 2
 (if(= s 2)
(progn
  (setq b(replBomb b (nth 2 oldmap2)))
  (setq b(replBomb b (nth 3 oldmap2)))
)
 )
;;;--- Check ship 3
 (if(= s 3)
(progn
  (setq b(replBomb b (nth 4 oldmap2)))
  (setq b(replBomb b (nth 5 oldmap2)))
  (setq b(replBomb b (nth 6 oldmap2)))
)
 )
;;;--- Check ship 4
 (if(= s 4)
(progn
  (setq b(replBomb b (nth 7 oldmap2)))
  (setq b(replBomb b (nth 8 oldmap2)))
  (setq b(replBomb b (nth 9 oldmap2)))
)
 )
;;;--- Check ship 5
 (if(= s 5)
(progn
  (setq b(replBomb b (nth 10 oldmap2)))
  (setq b(replBomb b (nth 11 oldmap2)))
  (setq b(replBomb b (nth 12 oldmap2)))
  (setq b(replBomb b (nth 13 oldmap2)))
)
 )
;;;--- Check ship 6
 (if(= s 6)
(progn
  (setq b(replBomb b (nth 14 oldmap2)))
  (setq b(replBomb b (nth 15 oldmap2)))
  (setq b(replBomb b (nth 16 oldmap2)))
  (setq b(replBomb b (nth 17 oldmap2)))
  (setq b(replBomb b (nth 18 oldmap2)))
)
 )
 b
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;; End of Artificial Intelligence;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;

;;;--- Function to let the user select a cell
;;;	r = row height

(defun getAnswer( r / a p c)

;;;--- Ask the user to pick a cell
 (princ (strcat "\n.\n.\n Pick a Cell : "))

;;;--- Use grread to get a point
 (setq a(grread nil 4 2))

;;;--- If it was a mouse click...
 (if(= (type (cadr a)) 'LIST)
(progn

 ;;;--- Get the selected point
  (setq p(cadr a))

 ;;;--- Check to make sure the user selected a cell on the grid
  (setq xdis(- (car p)(car lbl)))
  (setq ydis(- (cadr p)(cadr lbl)))
  (if(and (< xdis (* r 10.0)) (> xdis 0) (< ydis (* r 10.0)) (> ydis 0))

   ;;;--- Convert the selected point to a cell number
	(setq c(SPT2CN p lbl r))

	(progn		 

	 ;;;--- Check to see if the user selected a cell on the wrong grid
	  (setq xdis(- (car p)(car rbl)))
	  (setq ydis(- (cadr p)(cadr rbl)))
	  (if(and (< xdis (* r 10.0)) (> xdis 0) (< ydis (* r 10.0)) (> ydis 0))
		(progn

		 ;;;--- Alert the user
		  (alert "You are not allowed to bomb your own ships! \nSelect a cell in the other grid.")

		  (setq c 101)

		)
		(setq c 0)
	  )
	)
  )
)
(setq c 0)
 )

;;;--- Return the cell number selected
 c

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;

;;;--- Replace the -1's indicating a ship sunk with zeros
;;;	map = ship map	  s = ship number  
(defun fixMap(map s)

 (cond
( (= s 1) (setq map(append (list 0 0) (cddr map))) )
( (= s 2) (setq map(append(list (car map) (cadr map) 0 0) (cddddr map))) )
( (= s 3) 
  (setq map
	(append (list (nth 0 map)(nth 1 map)(nth 2 map)(nth 3 map) 0 0 0) (cdddr(cddddr map)))
  )		
)
( (= s 4) 
  (setq map
	(list (nth 0 map)(nth 1 map)(nth 2 map)(nth 3 map)(nth 4 map)(nth 5 map)(nth 6 map)
	  0 0 0 
	  (nth 10 map)(nth 11 map)(nth 12 map)(nth 13 map)
	  (nth 14 map)(nth 15 map)(nth 16 map)(nth 17 map)(nth 18 map)
	)
  )
)
( (= s 5) 
  (setq map
	(list (nth 0 map)(nth 1 map)(nth 2 map)(nth 3 map)(nth 4 map)(nth 5 map)(nth 6 map)
	   (nth 7 map)(nth 8 map)(nth 9 map)
	   0 0 0 0
	   (nth 14 map)(nth 15 map)(nth 16 map)(nth 17 map)(nth 18 map)
	)
  )
)
( (= s 6) 
  (setq map
	(list (nth 0 map)(nth 1 map)(nth 2 map)(nth 3 map)(nth 4 map)(nth 5 map)(nth 6 map)
	   (nth 7 map)(nth 8 map)(nth 9 map)
	   (nth 10 map)(nth 11 map)(nth 12 map)(nth 13 map)
	   0 0 0 0 0
	)
  )
)
 )
 map
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;888;;;;;;;888;;;;;;;;;;888;;;;;;;;;;;8888888;;;;;;8888;;;888;;;;;;;;;;;;

;;;;;;;;8888;;;;;8888;;;;;;;;;88888;;;;;;;;;;;;888;;;;;;;;88888;;888;;;;;;;;;;;;

;;;;;;;;88888;;;88888;;;;;;;;888;888;;;;;;;;;;;888;;;;;;;;888888;888;;;;;;;;;;;;

;;;;;;;;888888;888888;;;;;;;888;;;888;;;;;;;;;;888;;;;;;;;888;888888;;;;;;;;;;;;

;;;;;;;;888;88888;888;;;;;;88888888888;;;;;;;;;888;;;;;;;;888;;88888;;;;;;;;;;;;

;;;;;;;;888;;888;;888;;;;;888;;;;;;;888;;;;;;8888888;;;;;;888;;;8888;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;888;;;;;;;;;;;;888888888;;;;;;;;888888888;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;88888;;;;;;;;;;;888;;;888;;;;;;;;888;;;888;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;888;888;;;;;;;;;;888;;;888;;;;;;;;888;;;888;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;888;;;888;;;;;;;;;888888888;;;;;;;;888888888;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;88888888888;;;;;;;;888;;;;;;;;;;;;;;888;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;888;;;;;;;888;;;;;;;888;;;;;;;;;;;;;;888;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;--- Zoom to a small area
 (command "_zoom" "_window" (list 0 0) (list 35 24))

;;;--- Clear the command Line.
 (princ "\n.\n.\n Starting BSHIP.lsp [ Battleship by JefferyPSanders.com  11/8/03 ]")

;;;--- Set the colors for the ships
 (setq c1 252 c2 250 c3 30 c4 1)

;;;--- Get the center of the screen
 (setq vc(getvar "viewctr"))

;;;--- Get the screen size [y coordinate]
 (setq vs(getvar "viewsize"))

;;;--- Find the cell width and height
 (setq rw(/ vs 20.0))

;;;--- Find the bottom left point on the left grid
 (setq lbl(polar (polar vc pi (* rw 11.0)) (* pi 1.5) (* rw 5.0)) )

;;;--- Find the bottom left point on the right grid
 (setq rbl(polar (polar vc 0 rw) (* pi 1.5) (* rw 5.0)) )

;;;--- Set up the grid
 (setUpGrid lbl)

;;;--- Set up grid
 (setUpGrid rbl)

;;;--- Set up the map
 (setUpMaps)

;;;--- Print your ships on the computers bombing area
 (drawShips map2 rbl rw)

;;;--- Preset an answer variable
 (setq ans "Y")

;;;--- Alert the user of the rules...
 (setq ruleStr
(strcat
  "					 BattleShip Rules"
  "\n------------------------------------------------------------"
  "\n1. Your ships are on the right grid."
  "\n2. The computer's ships are hidden on the left grid."
  "\n3. Select a cell on the left grid to drop a bomb."
  "\n4. Select anywhere off of the grid to end."
  "\n5. You have 2-MineSweepers 2-Frigates 1-Cruiser 1-Battleship"
  "\n6. The computer has the same number of ships."
  "\n7. Sink all ships to win."
  "\n8. You go first then the computer immediately takes a turn."
  "\n "
  "\n   Good luck!"
)
 )
 (alert ruleStr)

;;;--- Set up a list for Artificial Intelligence
 (setq bombList(list))

;;;--- Set up a check
 (setq b 0 c 0 lastBomb nil)

;;;--- While the user selects a point and doesn't hit a key
 (while(and(>(foreach a map1(setq b(+ b a)))0)(>(foreach a map2(setq c(+ c a)))0)(= ans "Y"))

  ;;;--- Let the user select a point
(setq cellAns(getAnswer rw))

(if(and(< cellAns 101)(> cellAns 0))
  (progn

   ;;;--- Convert the cell number to a cell point
	(setq cellPt(CN2CPT cellAns lbl rw))

   ;;;--- See if that cell number lands on a ship 
	(if(setq hitShip(member cellAns map1))
	  (progn

	   ;;;--- Draw a bomb
		(drawBomb cellPt rw)

	   ;;;--- Replace the cell number with -1
		(setq map1(subst -1 cellAns map1))

	   ;;;--- See if the ship needs to be sunk
		(setq sunk(chkSunken map1 oldmap1 lbl rw "U"))

	   ;;;--- Remove the -1's where the ship sunk
		(setq map1(fixMap map1 sunk))

	  )			  

	 ;;;--- Else it is a miss, draw a splash
	  (drawMiss cellAns lbl map3 rw)
	)

   ;;;--- Remove the selected cell number from the available cell list
	(setq map3(subst -1 cellAns map3))

  )

  (if(= cellAns 101)(setq ans "I")(setq ans "N"))

)

  ;;;--- Set p some temporary variables for a check
(setq b 0 c 0)

  ;;;;;;;;;;;;;;;;;;;;;;;; COMPUTER'S TURN;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  ;;;--- Computers turn if not exiting and there are ships left to bomb
(if(and (> (foreach a map1(setq b(+ b a))) 0)(> (foreach a map2(setq c(+ c a))) 0)(= ans "Y"))
  (progn

   ;;;--- Let the user know it is the computer's turn
	(princ "\n.\n.\n Computer's Turn!  Please wait...")

   ;;;--- If Artificial Intelligence does not have a bomb-next list then
	(if (not bombList)
	  (progn

	   ;;;--- Get a random number between 1 and 99 that is in the map4 list [not chosen yet]	  
		(while(not(member (setq cCellNum(atoi(substr(rtos (getvar "cdate") 2 18)16 2))) map4))
		  (princ ".")
		)
	  )
	  (progn

	   ;;;--- Get the next cell to bomb from the Artificial Intelligence bomb list
		(setq cCellNum(car bombList))

	   ;;;--- Remove the cell number from the BOMBLIST so we don't use it again
		(setq bombList(cdr bombList))

	  )
	)

   ;;;--- Convert the cell number to a cell's bottom left point
	(setq cCellPt(CN2CPT cCellNum rbl rw))

   ;;;--- Check to see if it is a hit or a miss
	(if(setq hitShip(member cCellNum map2))
	  (progn

	   ;;;--- It is a hit, so draw a bomb
		(drawBomb cCellPt rw)

	   ;;;--- We have a hit, use Artificial Intelligence to find the rest of the ship
		(setupBombNextList cCellNum)

	   ;;;--- Mark it as a hit!
		(setq map2(subst -1 (car hitShip) map2))

	   ;;;--- See if the ship needs to be sunk
		(setq sunk2(chkSunken map2 oldmap2 rbl rw "C"))

	   ;;;--- Remove the -1's where the ship sunk
		(setq map2(fixMap map2 sunk2))

	   ;;;--- Remove possible bomb locations from the BOMBLIST
		(setq bombList(fixBombList bombList sunk2))

	  )

	 ;;;--- Else, it is a miss
	  (drawMiss cCellNum rbl map4 rw)
	)

   ;;;--- Replace the number from the map4 list
	(setq map4(subst -1 cCellNum map4))

  )
)

  ;;;--- If the user clicked the wrong grid, don't exit
(if(= cellAns 101)(setq ans "Y"))

  ;;;--- Set some checks to zero before entering the while statement again
(setq b 0 c 0)
 )

;;;--- Print the computers ships on the computers bombing area
 (drawShips oldmap1 lbl rw)  

;;;--- Set up a temp variable to check
 (setq b 0)

;;;--- If all cell numbers in map1 add up to be less than one, You won.
 (if(< (foreach a map1(setq b(+ b a))) 1)
(progn
  (alert "You Won!")
  (princ "\n.\n.\n. Press any key to exit...")
  (grread nil)
)
 )

;;;--- Set up a temp variable to check
 (setq b 0)

;;;--- If all cell numbers in map2 add up to be less than one, the Computer won.
 (if(< (foreach a map2(setq b(+ b a))) 1)
(progn
  (alert "You Lost!")
  (princ "\n.\n.\n Press any key to exit...")
  (grread nil)
)
 )

;;;--- Erase the grid
 (command "_redraw")

;;;--- Clear the command line
 (princ "\n.\n.\n.")

;;;--- Suppress the last echo for a clean exit.
 (princ)
)

Tháng 9 3, 2008

Phiền anh tuấn chỉ dẫn cụ thể làm như nào thì chơi được, em vốn gà mấy cái này :lol:

Tháng 9 3, 2008

Kaka, mở quan kinh doanh game đc rồi, tôi chỉ dày công sưu tập trên mạng rồi chia sẽ cho anh em thôi. Có cần bới móc như vậy không.
Còn khá nhiều game trên cad anh em xem nếu cần cứ PM tôi, keke, vui rồi

Chào bác Phamtuan,

Em là thành viên của Cadviet, cách nay hơn hai mươi năm, em có quen một thằng em ở trong quân ngũ có cái mặt giống y chang cái ảnh avartar của bác. Chả hay bác có quen biết nó không (À, mà hơi khác một tí, ngày ấy nó chửa có cái kính dâm bự tổ chảng như trong cái avartar này). Nếu có bác cho em nhắn bảo nó rằng chơi ít thôi còn phải cày không vợ nó đánh cho thì khổ. À mà thằng đó tên Nguyễn Trọng Hải bác ạ.

Còn bác đã có lòng chỉ bảo cho anh em cái chỗ chơi thì bác nên chỉ cho hết chứ ai lại thò ra có tí xíu như vậy, lỡ có bác nào chơi chưa đã tức quá tự tử có phải là tội nghiệp lắm không ạ.

Bác đã có công sưu tầm, ắt là bác cũng rành rẽ lắm. Mong bác chỉ thêm nhiều chiêu quái lạ hơn để anh em được mở rộng cái sự ngu dốt của mình.

Chúc bác khỏe và luôn đạt được cái ý ..... đồ của bác

Tháng 9 7, 2008

Bác Bình có óc khôi hài thiệt.

Đăng nhập

Game on Cad

Các bài được khuyến nghị

phamtuan 222

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

pikeman286 244

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ghost8.3 163

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

MANHHUNGXDA 458

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Nguyen Hoanh 4.663

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ghost8.3 163

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ph168xd 313

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duongsatdn 763

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

MANHHUNGXDA 458

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

MANHHUNGXDA 458

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

duy782006 1.545

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ph168xd 313

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

MANHHUNGXDA 458

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

pikeman286 244

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

vndesperados 254

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

MANHHUNGXDA 458

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ghost8.3 163

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

phamtuan 222

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

vanduong 536

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

ghost8.3 163