A single player "Battleship!" clone, with an AI opponent. Made for a local computer club competition.

kaboom.bas

'Ka-Boom! by Tony Lieuallen   Started: April 29, 1995

COMMON LenShip, NowSpotX, NowSpotY, StilShoot
DEFINT A-Z
DECLARE SUB PlaySound (HorM$)
DECLARE SUB Instructions ()
DECLARE SUB FontNotFound ()
DECLARE SUB GraphColor (Colr)
DECLARE SUB PutShips ()
DECLARE SUB DrawGrid ()
DECLARE SUB Test (HitFlag, Direction$)
DECLARE SUB MakeOld ()
DECLARE SUB Rotate (LenShip)
DECLARE SUB GetPlace ()
DECLARE SUB IsYoursAHit ()
DECLARE SUB CpuPutShips ()
DECLARE SUB IsShipGone ()
DECLARE SUB ShowMessage (Text$)
DECLARE SUB IsGameOver ()
DECLARE SUB CpuShoot ()

DECLARE SUB BLOADFont (FlName$, FontArray(), RetCode)
DECLARE SUB FastString (Text$, FClr, x, Y, FontArray())
DECLARE SUB Delay (Ticks)
DECLARE FUNCTION Exist (FilName$)

ProgStart:
SCREEN 12
CLS
RANDOMIZE TIMER
LOCATE , , 0, 0
GraphColor 47
CONST NumHdrElem = 11
DIM SHARED HisGrid(9, 9, 2) AS INTEGER
DIM SHARED YourGrid(9, 9, 2) AS INTEGER
DIM SHARED HisHits(5) AS INTEGER
DIM SHARED YourHits(5) AS INTEGER

IF NOT Exist("DOSAPP.BIN") THEN BadFnt = BadFnt + 1
IF NOT Exist("DTCH_REG.BIN") THEN BadFnt = BadFnt + 1
IF NOT Exist("courf.BIN") THEN BadFnt = BadFnt + 1
IF NOT Exist("8514sys.BIN") THEN BadFnt = BadFnt + 1
IF NOT Exist("sseriff.BIN") THEN BadFnt = BadFnt + 1
IF BadFnt THEN FontNotFound
REDIM SHARED DosApp(1)
REDIM SHARED DtchFont(1)
REDIM SHARED CourfFont(1)
REDIM SHARED Sys8514font(1)
REDIM SHARED SseriffFont(1)
CALL BLOADFont("DOSAPP.BIN", DosApp(), RetCode)
CALL BLOADFont("DTCH_REG.BIN", DtchFont(), RetCode)
CALL BLOADFont("Courf.BIN", CourfFont(), RetCode)
CALL BLOADFont("8514sys.BIN", Sys8514font(), RetCode)
CALL BLOADFont("Sseriff.BIN", SseriffFont(), RetCode)

ERASE HisGrid, YourGrid

LINE (10, 20)-(12, 290), 1, BF: LINE (10, 20)-(282, 22), 1, BF
LINE (300, 150)-(302, 420), 1, BF: LINE (300, 150)-(572, 152), 1, BF
LINE (280, 20)-(282, 290), 1, BF: LINE (10, 290)-(282, 292), 1, BF
LINE (570, 150)-(572, 420), 1, BF: LINE (300, 420)-(572, 422), 1, BF
PAINT (40, 40), 9, 1
PAINT (340, 340), 9, 1

FOR Box = 1 TO 8
   LINE (10 + (Box * 30), 20)-(12 + (Box * 30), 290), 1, BF
   LINE (10, 20 + (Box * 30))-(282, 22 + (Box * 30)), 1, BF
   LINE (300 + (Box * 30), 150)-(302 + (Box * 30), 420), 1, BF
   LINE (300, 150 + (Box * 30))-(572, 152 + (Box * 30)), 1, BF
NEXT

PAINT (1, 1), 2, 1
FastString "My Grid", 15, 105, 300, CourfFont()
LINE (180, 300)-(180, 315), 15
LINE (180, 300)-(175, 305), 15
LINE (180, 300)-(185, 305), 15
FastString "YOUR Grid", 15, 385, 130, CourfFont()
LINE (475, 130)-(475, 145)
LINE (475, 145)-(470, 140)
LINE (475, 145)-(480, 140)
FastString "KA-Boom!!, By Tony Lieuallen", 14, 188, 435, Sys8514font()

FastString "Your Damage:", 15, 10, 325, CourfFont()
LINE (24, 344)-(194, 356), 1, B
PAINT (30, 350), 10, 1
FOR Div = 1 TO 16
   LINE (24 + (Div * 10), 344)-(24 + (Div * 10), 356), 1
NEXT
FOR count = 1 TO 9
   FastString STR$(count), 0, 13 + (count * 10), 348, DosApp()
NEXT
FOR count = 10 TO 17
   FastString STR$(count), 0, 11 + (count * 10), 348, DosApp()
NEXT

FastString "My Damage:", 15, 10, 365, CourfFont()
LINE (24, 384)-(194, 396), 1, B
PAINT (30, 390), 10, 1
FOR Div = 1 TO 16
   LINE (24 + (Div * 10), 384)-(24 + (Div * 10), 396), 1
NEXT
FOR count = 1 TO 9
   FastString STR$(count), 0, 13 + (count * 10), 388, DosApp()
NEXT
FOR count = 10 TO 17
   FastString STR$(count), 0, 11 + (count * 10), 388, DosApp()
NEXT

Instructions

FastString "Place your ships...", 15, 340, 50, DtchFont()
PutShips
LINE (330, 45)-(475, 70), 2, BF

MakeOld
DrawGrid

NowSpotX = 1
NowSpotY = 1
CpuPutShips
PAINT (30, 30), 4, 1

FastString "Choose where to fire...", 15, 340, 50, DtchFont()
FastString "Use the keypad as before,", 15, 340, 63, DtchFont()
FastString "and press enter to fire!", 15, 340, 76, DtchFont()
Key$ = ""
DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
IF Key$ = CHR$(27) THEN SYSTEM
LINE (330, 65)-(500, 95), 2, BF

DO UNTIL GameOver
   GetPlace
   IF PutFlag THEN
       PutFlag = 0
       LINE (330, 45)-(500, 65), 2, BF
       IsYoursAHit
       CpuShoot
       FastString "Choose where to fire...", 15, 340, 50, DtchFont()
       PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 4, 1
   END IF
LOOP

IF GameOver = 10 THEN CLEAR : GOTO ProgStart

SUB BLOADFont (FlName$, FontArray(), RetCode)
   
   FileNum = FREEFILE
   OPEN FlName$ FOR BINARY AS FileNum
       SizeInBytes& = LOF(FileNum)
   CLOSE FileNum
   IF (SizeInBytes& = 0) THEN RetCode = -1: EXIT SUB
   SizeInBytes& = SizeInBytes& - 7
   REDIM FontArray((SizeInBytes& - 1) \ 2)
   DEF SEG = VARSEG(FontArray(0))
   BLOAD FlName$, VARPTR(FontArray(0))
   DEF SEG
   RetCode = 0

END SUB

SUB CpuPutShips

   NotThreeYet = 1
StartCput:
   SELECT CASE LenCShip
       CASE 0
         LenCShip = 2
       CASE 2
         LenCShip = 3
       CASE 3
         IF CThreeB4 = 1 THEN
           CThreeB4 = 0
           LenCShip = 4
         ELSE
           NotThreeYet = 0
           CThreeB4 = 1
         END IF
       CASE 5
         LINE (335, 65)-(630, 90), 2, BF
         EXIT SUB
       CASE 4
         LenCShip = 5
   END SELECT

   DO UNTIL PPut
       HOrV = INT(2 * RND + 1)
       PutX = 0
       PutY = 0
       IF HOrV = 1 THEN
         PutX = INT((9 - LenCShip) * RND + 1)
         PutY = INT(9 * RND + 1)
       ELSE
         PutX = INT(9 * RND + 1)
         PutY = INT((9 - LenCShip) * RND + 1)
       END IF
       IF HOrV = 1 THEN
         PutOk = 0
         FOR Check = 0 TO LenCShip - 1
           IF HisGrid(PutX + Check, PutY, 2) = 0 THEN PutOk = PutOk + 1
         NEXT
         IF PutOk = LenCShip THEN
           FOR PutShip = 0 TO LenCShip - 1
             HisGrid(PutX + PutShip, PutY, 2) = LenCShip - NotThreeYet
           NEXT
           PPut = 1
         END IF
       ELSE
         PutOk = 0
         FOR Check = 0 TO LenCShip - 1
           IF HisGrid(PutX, PutY + Check, 2) = 0 THEN PutOk = PutOk + 1
         NEXT
         IF PutOk = LenCShip THEN
           FOR PutShip = 0 TO LenCShip - 1
             HisGrid(PutX, PutY + PutShip, 2) = LenCShip - NotThreeYet
           NEXT
           PPut = 1
         END IF
       END IF
   LOOP
   PPut = 0

   GOTO StartCput
  
END SUB

SUB CpuShoot
SHARED StilShoot
STATIC LastWasHit, LastShootX, LastShootY, ShootDir, NoChangeShootDir
STATIC HitSpotX, HitSpotY, CHits

   ShowMessage "Computer is shooting... "
   IF StilShoot = 0 THEN
ChooseSpot:
       ShootDir = 1
       NoChangeShootDir = 0
       ShootX = INT(9 * RND + 1)
       ShootY = INT(9 * RND + 1)
       IF YourGrid(ShootX, ShootY, 1) <> 0 THEN GOTO ChooseSpot
       IF YourGrid(ShootX, ShootY, 2) > 0 THEN
         ShootDir = INT(RND * 3)
         HitSpotX = ShootX
         HitSpotY = ShootY
       END IF
   ELSE
GenSpot:
       IF NoChangeShootDir = 0 THEN
         ShootDir = ShootDir + 1
         IF ShootDir = 5 THEN ShootDir = 1
         LastShootX = HitSpotX
         LastShootY = HitSpotY
       END IF
       SELECT CASE ShootDir
         CASE 1
           ShootY = LastShootY
           ShootX = LastShootX + 1
         CASE 2
           ShootY = LastShootY
           ShootX = LastShootX - 1
         CASE 3
           ShootY = LastShootY + 1
           ShootX = LastShootX
         CASE 4
           ShootY = LastShootY - 1
           ShootX = LastShootX
       END SELECT
       BadShot = 0
       IF ShootX > 9 THEN BadShot = BadShot + 1: NoChangeShootDir = 0
       IF ShootX < 1 THEN BadShot = BadShot + 1: NoChangeShootDir = 0
       IF ShootY > 9 THEN BadShot = BadShot + 1: NoChangeShootDir = 0
       IF ShootY < 1 THEN BadShot = BadShot + 1: NoChangeShootDir = 0
       IF BadShot > 0 THEN
         BadShot = 0
         GOTO GenSpot
       END IF
       IF YourGrid(ShootX, ShootY, 1) = -1 THEN BadShot = BadShot + 1: NoChangeShootDir = 0
       IF YourGrid(ShootX, ShootY, 1) = 5 THEN BadShot = BadShot + 1: NoChangeShootDir = 1
       IF BadShot > 0 THEN
         BadShot = 0
         LastShootX = ShootX
         LastShootY = ShootY
         GOTO GenSpot
       END IF
       IF YourGrid(ShootX, ShootY, 1) = -1 AND StilShoot = 1 THEN
         NoChangeShootDir = 2
         SELECT CASE ShootDir
           CASE 1
             ShootDir = 2
           CASE 2
             ShootDir = 3
           CASE 3
             ShootDir = 4
           CASE 4
             ShootDir = 1
         END SELECT
       END IF
   END IF

   SELECT CASE YourGrid(ShootX, ShootY, 2)
       CASE 0
         PAINT (305 + (ShootX - 1) * 30, 167 + (ShootY - 1) * 30), 3, 1
         PlaySound ("M")
         ShowMessage "MISS!!!                "
         YourGrid(ShootX, ShootY, 1) = -1
         DrawGrid
         SELECT CASE NoChangeShootDir
           CASE 1
             NoChangeShootDir = 0
           CASE 2
             NoChangeShootDir = 1
         END SELECT
       CASE IS > 0
         PAINT (305 + (ShootX - 1) * 30, 167 + (ShootY - 1) * 30), 15, 1
         PlaySound ("H")
         ShowMessage "HIT!!!                "
         YourHits(YourGrid(ShootX, ShootY, 2)) = YourHits(YourGrid(ShootX, ShootY, 2)) + 1
         YourGrid(ShootX, ShootY, 1) = 5
         CHits = CHits + 1
         PAINT (20 + (CHits * 10), 350), 12, 1
         DrawGrid
         StilShoot = 1
         IF ShootDir > 0 THEN NoChangeShootDir = 1
   END SELECT
   IsShipGone
   LastShootX = ShootX
   LastShootY = ShootY

END SUB

SUB DrawGrid
 
   FOR Y = 1 TO 9
       FOR x = 1 TO 9
         SELECT CASE HisGrid(x, Y, 1)
           CASE 0
             IF POINT(25 + (x - 1) * 30, 37 + (Y - 1) * 30) <> 9 THEN
               PAINT (25 + (x - 1) * 30, 37 + (Y - 1) * 30), 9, 1
             END IF
           CASE -1
             IF POINT(25 + (x - 1) * 30, 37 + (Y - 1) * 30) <> 7 THEN
               PAINT (25 + (x - 1) * 30, 37 + (Y - 1) * 30), 7, 1
             END IF
           CASE IS > 0
             IF POINT(25 + (x - 1) * 30, 37 + (Y - 1) * 30) <> 2 THEN
               CIRCLE (26 + (x - 1) * 30, 36 + (Y - 1) * 30), 10, 1
               PAINT (25 + (x - 1) * 30, 37 + (Y - 1) * 30), 14, 1
               PAINT (14 + (x - 1) * 30, 37 + (Y - 1) * 30), 12, 1
             END IF
         END SELECT
         SELECT CASE YourGrid(x, Y, 2)
           CASE -10
             IF POINT(305 + (x - 1) * 30, 167 + (Y - 1) * 30) <> 13 THEN
               PAINT (305 + (x - 1) * 30, 167 + (Y - 1) * 30), 13, 1
             END IF
           CASE 0
             IF YourGrid(x, Y, 1) <> -1 THEN
               PAINT (305 + (x - 1) * 30, 167 + (Y - 1) * 30), 9, 1
             END IF
           CASE IS > 0
             IF YourGrid(x, Y, 1) <> 5 THEN
               PAINT (305 + (x - 1) * 30, 167 + (Y - 1) * 30), 14, 1
             END IF
         END SELECT
         SELECT CASE YourGrid(x, Y, 1)
           CASE -1
             IF POINT(305 + (x - 1) * 30, 167 + (Y - 1) * 30) <> 7 THEN
               PAINT (305 + (x - 1) * 30, 167 + (Y - 1) * 30), 7, 1
             END IF
           CASE 5
             IF POINT(305 + (x - 1) * 30, 167 + (Y - 1) * 30) <> 12 THEN
               CIRCLE (316 + (x - 1) * 30, 166 + (Y - 1) * 30), 10, 1
               PAINT (325 + (x - 1) * 30, 167 + (Y - 1) * 30), 14, 1
               PAINT (304 + (x - 1) * 30, 167 + (Y - 1) * 30), 12, 1
             END IF
         END SELECT
       NEXT
   NEXT

END SUB

SUB FastString (Text$, FClr, x, Y, FontArray())

   CONST NumHdrElem = 11

   xchar = x
   NumChars = FontArray(1)
   FontHeight = FontArray(0)
   DEF SEG = VARSEG(FontArray(0))
   FOR k = 1 TO LEN(Text$)
       RelChar = ASC(MID$(Text$, k, 1)) - FontArray(2)
       IF ((RelChar < 0) OR (RelChar > NumChars - 1)) THEN RelChar = FontArray(4)
       PWidth = FontArray(NumHdrElem + RelChar)
       Ptr& = FontArray(NumHdrElem + NumChars + RelChar)
       IF (Ptr& < 0) THEN Ptr& = 65536 + Ptr&
       Ptr& = Ptr& + VARPTR(FontArray(0))
       BytesPerRow = 1 + (PWidth - 1) \ 8
       XLocn = xchar - 8
       FOR j = 1 TO BytesPerRow
         YLocn = Y
         FOR I = 1 TO FontHeight
           LINE (XLocn, YLocn)-STEP(15, 0), FClr, , PEEK(Ptr&)
           Ptr& = Ptr& + 1
           YLocn = YLocn + 1
         NEXT I
         XLocn = XLocn + 8
       NEXT j
   xchar = xchar + PWidth + FontArray(9)
   NEXT k
   DEF SEG
   x = xchar

END SUB

SUB FontNotFound

   CLS
   PRINT "Sorry, I could not find the font files.  Please"
   PRINT "change to the driectory which contains the original"
   PRINT "Ka-Boom Files.  Thank you."
   SYSTEM

END SUB

SUB GetPlace
SHARED NowSpotX, NowSpotY, PutFlag

Start:
   Key$ = ""
   DO UNTIL Key$ <> ""
       Key$ = INKEY$
   LOOP
   IF Key$ = CHR$(27) THEN SYSTEM

   SELECT CASE Key$
       CASE CHR$(13)
         IF HisGrid(NowSpotX, NowSpotY, 1) <> 0 THEN
         ShowMessage "You already tried there!!!"
         ELSE
           PutFlag = 1
         END IF
       CASE "4"
         IF NowSpotX = 1 THEN
           SOUND 32000, 2
           EXIT SUB
         ELSE
           SELECT CASE HisGrid(NowSpotX, NowSpotY, 1)
             CASE 0
               PClr = 9
             CASE -1
               PClr = 7
             CASE IS > 0
               PClr = 12
           END SELECT
           PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), PClr, 1
           NowSpotX = NowSpotX - 1
         END IF
         PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 4, 1
     CASE "6"
         IF NowSpotX = 9 THEN
           SOUND 32000, 2
           EXIT SUB
         ELSE
           SELECT CASE HisGrid(NowSpotX, NowSpotY, 1)
             CASE 0
               PClr = 9
             CASE -1
               PClr = 7
             CASE IS > 0
               PClr = 12
           END SELECT
           PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), PClr, 1
           NowSpotX = NowSpotX + 1
         END IF
         PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 4, 1
       CASE "8"
         IF NowSpotY = 1 THEN
           SOUND 32000, 2
           EXIT SUB
         ELSE
           SELECT CASE HisGrid(NowSpotX, NowSpotY, 1)
             CASE 0
               PClr = 9
             CASE -1
               PClr = 7
             CASE IS > 0
               PClr = 12
           END SELECT
           PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), PClr, 1
           NowSpotY = NowSpotY - 1
         END IF
         PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 4, 1
       CASE "2"
         IF NowSpotY = 9 THEN
           SOUND 32000, 2
           EXIT SUB
         ELSE
           SELECT CASE HisGrid(NowSpotX, NowSpotY, 1)
             CASE 0
               PClr = 9
             CASE -1
               PClr = 7
             CASE IS > 0
               PClr = 12
           END SELECT
           PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), PClr, 1
           NowSpotY = NowSpotY + 1
         END IF
         PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 4, 1
       CASE ELSE
         GOTO Start
   END SELECT

END SUB

SUB Instructions
   
   FastString "Would you like instructions?", 15, 340, 50, DtchFont()
   DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
   LINE (330, 45)-(555, 120), 2, BF
   IF Key$ = CHR$(27) THEN SYSTEM
   IF UCASE$(Key$) <> "Y" THEN EXIT SUB

   FastString "First, I will tell you how to", 15, 340, 50, DtchFont()
   FastString "place your ships.  You must use", 15, 340, 63, DtchFont()
   FastString "the number keypad to move the", 15, 340, 76, DtchFont()
   FastString "ship around.  Then, pushing the", 15, 340, 89, DtchFont()
   FastString "spacebar will rotate.", 15, 340, 102, DtchFont()
   Key$ = ""
   DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
   IF Key$ = CHR$(27) THEN SYSTEM
   LINE (330, 45)-(555, 120), 2, BF
   FastString "You must press the enter key to", 15, 340, 37, DtchFont()
   FastString "place the ship, and you cannot", 15, 340, 50, DtchFont()
   FastString "move a ship through another.  You", 15, 340, 63, DtchFont()
   FastString "cannot rotate, if it would put your", 15, 340, 76, DtchFont()
   FastString "ship out of the playing field, or", 15, 340, 89, DtchFont()
   FastString "on top of another ship.", 15, 340, 102, DtchFont()
   Key$ = ""
   DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
   IF Key$ = CHR$(27) THEN SYSTEM
   LINE (330, 30)-(555, 120), 2, BF
   FastString "GOOD LUCK!!", 12, 380, 70, Sys8514font()
   Key$ = ""
   DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
   LINE (350, 60)-(500, 90), 2, BF

END SUB

SUB IsGameOver
SHARED GameOver
  
   FOR GameOvr = 1 TO 5
       IF HisHits(GameOvr) >= 10 THEN YouWin = YouWin + 1
   NEXT
   IF YouWin = 5 THEN
       LINE (285, 20)-(600, 120), 2, BF
       FastString "YOU win!?  How can that be? I will", 15, 322, 50, Sys8514font()
       FastString "crush you next time, puny human!!!", 15, 320, 70, Sys8514font()
       FastString "And I won't let you play again! HA!", 15, 302, 90, CourfFont()
       DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
       SYSTEM
   END IF

   FOR GameOvr = 1 TO 5
       IF YourHits(GameOvr) >= 10 THEN HeWins = HeWins + 1
   NEXT
   IF HeWins = 5 THEN
       LINE (285, 20)-(600, 120), 2, BF
       FastString "I win!!!, my superior intelect", 15, 325, 50, Sys8514font()
       FastString "crushes your puny human brain!!!", 15, 315, 70, Sys8514font()
       FastString "Wanna play again? (I don't see why.)", 15, 305, 90, CourfFont()
       DO UNTIL Key$ <> "": Key$ = INKEY$: LOOP
       IF UCASE$(Key$) = "Y" THEN GameOver = 10: EXIT SUB
       SYSTEM
   END IF

END SUB

SUB IsShipGone
SHARED StilShoot
  
   FOR Check = 1 TO 5
       TempCheckC = 0
       SELECT CASE Check
         CASE IS < 2
           TempCheckC = 2
         CASE IS > 2
           TempCheckC = Check
         CASE 2
           TempCheckC = 3
       END SELECT
    
       IF HisHits(Check) = TempCheckC THEN
         ShowMessage "You sunk one of my ships!!!"
         HisHits(Check) = 10
         IsGameOver
       END IF
     
       TempCheck = 0
       TempCheck = Check
       IF TempCheck < 3 THEN TempCheck = TempCheck + 1
     
       IF YourHits(Check) = TempCheck THEN
         ShowMessage "I sunk one of your ships!!!"
         StilShoot = 0
         YourHits(Check) = 10
         IsGameOver
       END IF
   NEXT

END SUB

SUB IsYoursAHit
SHARED NowSpotX, NowSpotY
STATIC YHits

   SELECT CASE HisGrid(NowSpotX, NowSpotY, 2)
       CASE 0
         PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 7, 1
         FastString "MISS!!!", 15, 340, 70, SseriffFont()
         PlaySound ("M")
         Delay 5
         LINE (335, 65)-(400, 90), 2, BF
         HisGrid(NowSpotX, NowSpotY, 1) = -1
       CASE IS > 0
         HisGrid(NowSpotX, NowSpotY, 1) = 1
         HisHits(HisGrid(NowSpotX, NowSpotY, 2)) = HisHits(HisGrid(NowSpotX, NowSpotY, 2)) + 1
         DrawGrid
         PAINT (15 + (NowSpotX - 1) * 30, 35 + (NowSpotY - 1) * 30), 4, 1
         YHits = YHits + 1
         PAINT (16 + (YHits * 10), 386), 12, 1
         FastString "HIT!!!", 15, 340, 70, SseriffFont()
         PlaySound ("H")
         LINE (335, 65)-(400, 90), 2, BF
         IsShipGone
         IsGameOver
   END SELECT
  
END SUB

SUB MakeOld
SHARED LenShip, ThreeB4

   FOR Y = 1 TO 9
       FOR x = 1 TO 9
         IF YourGrid(x, Y, 2) = -10 THEN
           YourGrid(x, Y, 2) = LenShip + 1 - ThreeB4
         END IF
       NEXT
   NEXT

END SUB

SUB PlaySound (HorM$)

   IF UCASE$(HorM$) = "M" THEN
       PLAY "T255L64O4CDEFGABO3CDEFGABO2CDEFGAB"
   ELSE
       FOR I = 1 TO 20
         SOUND I * 50, .1
         SOUND I * 100, .1
         SOUND I * 150, .1
       NEXT
   END IF

END SUB

SUB PutShips
SHARED LenShip, ThreeB4

LenShip = 5
NextShip:
   MakeOld
   DrawGrid
   NextFlag = 0
   Xp = 0
   GoodFlag = 0
   Top = 0
   DO UNTIL GoodFlag
       Ok4Now = 0
       Xp = Xp + 1
       IF Xp = 10 THEN
         Top = Top + 1
         Xp = 1
       END IF
       FOR Yp = Top + 1 TO LenShip + Top
         IF YourGrid(Xp, Yp, 2) = 0 THEN Ok4Now = Ok4Now + 1
       NEXT
       IF Ok4Now >= LenShip THEN GoodFlag = 1
   LOOP
   FOR Y = 1 TO LenShip
       YourGrid(Xp, Y + Top, 2) = -10
   NEXT
   DrawGrid
  
MoveShip:
   Key$ = ""
   DO UNTIL Key$ <> ""
       Key$ = INKEY$
   LOOP
   IF Key$ = CHR$(27) THEN SYSTEM
  
   SELECT CASE Key$
       CASE CHR$(13)
         IF LenShip = 3 THEN
           IF ThreeB4 THEN
             LenShip = LenShip - 1
           ELSE
             ThreeB4 = 1
           END IF
         ELSE
           LenShip = LenShip - 1
         END IF
         NextFlag = LenShip
         GOTO Edge
       CASE " "
         Rotate LenShip
       CASE "4"
         FOR e = 1 TO 9
           IF YourGrid(1, e, 2) = -10 THEN SOUND 32000, 2: GOTO Edge
         NEXT
         HitFlag = 0
         Test HitFlag, "left"
         IF HitFlag THEN GOTO Edge
         FOR Y = 1 TO 9
           FOR x = 1 TO 9
             IF YourGrid(x, Y, 2) = -10 THEN
               YourGrid(x - 1, Y, 2) = YourGrid(x, Y, 2)
               YourGrid(x, Y, 2) = 0
             END IF
           NEXT
         NEXT
       CASE "6"
         FOR e = 1 TO 9
           IF YourGrid(9, e, 2) = -10 THEN SOUND 32000, 2: GOTO Edge
         NEXT
         HitFlag = 0
         Test HitFlag, "right"
         IF HitFlag THEN GOTO Edge
         FOR Y = 1 TO 9
           FOR x = 9 TO 1 STEP -1
             IF YourGrid(x, Y, 2) = -10 THEN
               YourGrid(x + 1, Y, 2) = YourGrid(x, Y, 2)
               YourGrid(x, Y, 2) = 0
             END IF
           NEXT
         NEXT
       CASE "8"
         FOR e = 1 TO 9
           IF YourGrid(e, 1, 2) = -10 THEN SOUND 32000, 2: GOTO Edge
         NEXT
         HitFlag = 0
         Test HitFlag, "up"
         IF HitFlag THEN GOTO Edge
         X2 = 0: Y2 = 0
         FOR Y = 1 TO 9
           FOR x = 1 TO 9
             IF YourGrid(x, Y, 2) = -10 THEN
               YourGrid(x, Y - 1, 2) = YourGrid(x, Y, 2)
               YourGrid(x, Y, 2) = 0
             END IF
           NEXT
         NEXT
       CASE "2"
         FOR e = 1 TO 9
           IF YourGrid(e, 9, 2) = -10 THEN SOUND 32000, 2: GOTO Edge
         NEXT
         HitFlag = 0
         Test HitFlag, "down"
         IF HitFlag THEN GOTO Edge
         FOR Y = 9 TO 1 STEP -1
           FOR x = 1 TO 9
             IF YourGrid(x, Y, 2) = -10 THEN
               YourGrid(x, Y + 1, 2) = YourGrid(x, Y, 2)
               YourGrid(x, Y, 2) = 0
             END IF
           NEXT
         NEXT
   END SELECT
DrawGrid
Edge:
IF NextFlag = LenShip AND LenShip = 1 THEN EXIT SUB
IF NextFlag = LenShip THEN GOTO NextShip
GOTO MoveShip
END SUB

SUB Rotate (LenShip)

   FOR Y = 0 TO 8
       FOR x = 0 TO 8
         IF YourGrid(x, Y, 2) = -10 THEN
           IF YourGrid(x + 1, Y, 2) = -10 THEN
             IF Y > (10 - LenShip) THEN EXIT SUB
             FOR yc = Y + 1 TO (LenShip - 1 + Y)
               IF YourGrid(x, yc, 2) > 0 THEN EXIT SUB
             NEXT
             FOR X2 = x TO (LenShip - 1 + x)
               YourGrid(X2, Y, 2) = 0
             NEXT
             FOR Y2 = Y TO (LenShip - 1 + Y)
               YourGrid(x, Y2, 2) = -10
             NEXT
             EXIT SUB
           ELSE
             IF x > (10 - LenShip) THEN EXIT SUB
             FOR xc = x + 1 TO (LenShip - 1 + x)
               IF YourGrid(xc, Y, 2) > 0 THEN EXIT SUB
             NEXT
             FOR Y2 = Y TO (LenShip - 1 + Y)
               YourGrid(x, Y2, 2) = 0
             NEXT
             FOR X2 = x TO (LenShip - 1 + x)
               YourGrid(X2, Y, 2) = -10
             NEXT
             EXIT SUB
           END IF
         END IF
       NEXT
   NEXT

END SUB

SUB ShowMessage (Text$)

   FastString Text$, 15, 340, 70, SseriffFont()
   Delay INT(LEN(Text$))
   LINE (335, 65)-(335 + (10 * LEN(Text$)), 90), 2, BF

END SUB

SUB Test (HitFlag, Direction$)

   SELECT CASE Direction$
       CASE "up"
         FOR x = 1 TO 9
           FOR Y = 9 TO 1 STEP -1
             IF YourGrid(x, Y - 1, 2) > 0 AND YourGrid(x, Y, 2) = -10 THEN
               HitFlag = 1
               EXIT SUB
             END IF
           NEXT
         NEXT
       CASE "down"
         FOR x = 1 TO 9
           FOR Y = 8 TO 1 STEP -1
             IF YourGrid(x, Y + 1, 2) > 0 AND YourGrid(x, Y, 2) = -10 THEN
               HitFlag = 1
               EXIT SUB
             END IF
           NEXT
         NEXT
       CASE "left"
         FOR x = 1 TO 8
           FOR Y = 1 TO 9
             IF YourGrid(x - 1, Y, 2) > 0 AND YourGrid(x, Y, 2) = -10 THEN
               HitFlag = 1
               EXIT SUB
             END IF
           NEXT
         NEXT
       CASE "right"
         FOR x = 8 TO 1 STEP -1
           FOR Y = 1 TO 9
             IF YourGrid(x + 1, Y, 2) > 0 AND YourGrid(x, Y, 2) = -10 THEN
               HitFlag = 1
               EXIT SUB
             END IF
           NEXT
         NEXT
   END SELECT

END SUB