Created
October 19, 2011 23:25
-
-
Save arantius/1299983 to your computer and use it in GitHub Desktop.
A single player "Battleship!" clone, with an AI opponent. Made for a local computer club competition.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment