Posts: 3,343
Threads: 83
Joined: Mar 2003
What a monumental time waster... I just lost 15 minutes of my life on a game made in 1992... can I host it?
Posts: 749
Threads: 4
Joined: Jun 2002
Not mine, as you noticed. Go ahead.
img]http://usuarios.vtr.net/~disaster/sigs/annoyizer.php[/img]
Posts: 3,343
Threads: 83
Joined: Mar 2003
Right... I got carried away and made one. It may be a little long, and there is a bug if you play 16 player and individually do every game with him, but other than that I think it's bug free. Tell me what you all think!
Code: ' ----- Sports Sim -----
' Oracle
' webmaster@qbnz.com
OPTION BASE 1
DIM numofpl AS INTEGER, skip(17) AS INTEGER
CLS
INPUT "Number of players? ", numofpl
IF numofpl > 16 THEN numofpl = 16
IF numofpl < 0 THEN numofpl = 0
CLS
DIM names(17) AS STRING, team(17) AS STRING, skpts(17) AS INTEGER, wins(17) AS INTEGER
DIM draws(17) AS INTEGER, losses(17) AS INTEGER, points(17) AS INTEGER, money(17) AS INTEGER
' Get player names
FOR i = 1 TO numofpl
PRINT "What is player"; i; "'s name?"
LOCATE i, 28
INPUT "", names(i)
IF names(i) = "" THEN names(i) = "Player" + STR$(i)
NEXT i
FOR i = 1 TO numofpl
CLS
money(i) = 5000
PRINT "What is "; names(i); "'s team?"
LOCATE 1, 18 + LEN(names(i))
INPUT "", team(i)
IF team(i) = "" THEN team(i) = "Team" + STR$(i)
RANDOMIZE TIMER
skpts(i) = 120 * (.5 + RND)
PRINT names(i); "'s team has"; skpts(i); "skill points."
WHILE INKEY$ = "": WEND
NEXT i
' Get computer player's data
CLS
FOR i = numofpl + 1 TO 16
money(i) = 5000
RANDOMIZE TIMER
skpts(i) = 160 * (.5 + RND)
READ n$
names(i) = n$
READ n$
team(i) = n$
LOCATE i - numofpl
IF i < 16 THEN COLOR i ELSE COLOR 15
PRINT team(i); " has"; skpts(i); "skill points."
NEXT i
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = "": WEND
CLS
COLOR 7
' Calculate wins etc
FOR team1 = 1 TO 16
FOR team2 = 1 TO 16
IF team1 = team2 THEN team2 = team2 + 1
IF team1 <= numofpl AND NOT (skip(team1)) AND team2 <> 16 THEN
DO
CLS
PRINT team(team1); " are up for round"; team1; ", game"; team2
PRINT team(team1); " have"; money(team1); "in the bank."
PRINT "What do you want to do?"
PRINT "(L)ight Training ($250)"
PRINT "(F)ull Training ($400)"
PRINT "(B)uy Skill Point ($150)"
PRINT "(P)urchase Star Player ($1500)"
PRINT "(G)amble ($100)"
PRINT "(S)kip to next player"
PRINT "(N)othing"
PRINT
INPUT "What is your choice? ", choice$
choice$ = LCASE$(LEFT$(choice$, 1))
PRINT "Your skill points were "; skpts(team1)
IF choice$ = "l" THEN
IF money(team1) >= 250 THEN
skpts(team1) = skpts(team1) + CINT(RND * 2)
money(team1) = money(team1) - 250
ELSE GOSUB notrich
END IF
ELSEIF choice$ = "f" THEN
IF money(team1) >= 400 THEN
skpts(team1) = skpts(team1) + CINT(RND * 4)
money(team1) = money(team1) - 400
ELSE GOSUB notrich
END IF
ELSEIF choice$ = "b" THEN
IF money(team1) >= 150 THEN
skpts(team1) = skpts(team1) + 1
money(team1) = money(team1) - 150
ELSE GOSUB notrich
END IF
ELSEIF choice$ = "p" THEN
IF money(team1) >= 1500 THEN
skpts(team1) = skpts(team1) + CINT(RND * 6) + 8
money(team1) = money(team1) - 1500
ELSE GOSUB notrich
END IF
ELSEIF choice$ = "g" THEN
IF money(team1) >= 100 THEN
skpts(team1) = (skpts(team1) * (.9 + (RND / 5)))
money(team1) = money(team1) - 100
ELSE GOSUB notrich
END IF
ELSEIF choice$ = "s" THEN skip(team1) = -1
END IF
PRINT "Your skill points now are "; skpts(team1)
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = "": WEND
LOOP UNTIL choice$ = "n" OR choice$ = "" OR choice$ = "s"
ELSE
skpts(team1) = skpts(team1) + INT(RND * 2) + 2
END IF
CLS
RANDOMIZE TIMER
t1 = skpts(team1) * (.75 + (RND / 2))
t2 = skpts(team2) * (.75 + (RND / 2))
IF team1 <= numofpl AND NOT (skip(team1)) THEN
PRINT "The Match"
PRINT team(team1); " vs "; team(team2)
SLEEP 3.5
END IF
IF t1 > t2 + 8 + team2 THEN ' Who is the winner? Change the +8 to
wins(team1) = wins(team1) + 1 ' alter the chance of a draw
losses(team2) = losses(team2) + 1
money(team1) = money(team1) + 400
IF team1 <= numofpl AND NOT (skip(team1)) THEN
PRINT "Congratulations, you won!"
PRINT "You gain 3 points and $400"
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = "": WEND
END IF
ELSEIF t2 + team2 > t1 + 8 THEN
wins(team2) = wins(team2) + 1
losses(team1) = losses(team1) + 1
money(team1) = money(team1) - 100
IF team1 <= numofpl AND NOT (skip(team1)) THEN
PRINT "Awwww... you lost!"
PRINT "You'll have to do better next time..."
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = "": WEND
END IF
ELSE
draws(team1) = draws(team1) + 1
draws(team2) = draws(team2) + 1
money(team1) = money(team1) + 150
IF team1 <= numofpl AND NOT (skip(team1)) THEN
PRINT "Well done, a draw. You could've won though..."
PRINT "You gain 1 point and $150"
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = "": WEND
END IF
END IF
NEXT team2
NEXT team1
' Work out the points for each team
FOR t = 1 TO 16
points(t) = wins(t) * 3 + draws(t)
NEXT t
' Sorting the results
FOR u = 1 TO 16
FOR r = 1 TO 16
IF points(r) < points(r + 1) THEN
SWAP points(r), points(r + 1)
SWAP wins(r), wins(r + 1)
SWAP draws(r), draws(r + 1)
SWAP losses(r), losses(r + 1)
SWAP skpts(r), skpts(r + 1)
SWAP team(r), team(r + 1)
SWAP names(r), names(r + 1)
SWAP money(r), money(r + 1)
IF r > 1 THEN r = r - 1 ELSE r = 1
END IF
NEXT r
NEXT u
' Results
CLS
COLOR 3
PRINT SPACE$(31) + "** League Table **"
LOCATE 2, 5
PRINT STRING$(70, "-")
PRINT " Team Wins Draws Losses Points SK.Pts Name"
PRINT " " + STRING$(70, "-")
COLOR 2
FOR y = 1 TO 16
LOCATE y + 4 + yinc, 5
PRINT team(y)
LOCATE y + 4 + yinc, 23
PRINT wins(y)
LOCATE y + 4 + yinc, 30
PRINT draws(y)
LOCATE y + 4 + yinc, 38
PRINT losses(y)
LOCATE y + 4 + yinc, 45
PRINT points(y)
LOCATE y + 4 + yinc, 52
PRINT skpts(y)
LOCATE y + 4 + yinc, 60
PRINT names(y)
IF y = 4 OR y = 12 THEN
LOCATE y + 5 + yinc, 5
COLOR 3
PRINT STRING$(70, "-")
yinc = yinc + 1
IF y = 4 THEN COLOR 6 ELSE COLOR 4
END IF
NEXT y
WHILE INKEY$ <> "": WEND
WHILE INKEY$ = "": WEND
CLS
PRINT "SOCCER.BAS by Oracle for the QBNews 1 hour game challenge"
PRINT "All opinions either to the QBNews challenge forum or webmaster@qbnz.com"
PRINT "I'm stuffed... I'm gonna watch TV now ;)"
END
notrich:
COLOR 4
PRINT "ERROR! You can't afford that!"
WHILE INKEY$ = "": WEND
COLOR 7
RETURN
DATA "Joe Smith","Manchester United"
DATA "Bobby Kane","Liverpool"
DATA "James Underhill","Chelsea"
DATA "Simon Giles","Spurs"
DATA "Tom Bates","Brighton"
DATA "Mr Smith","Agents"
DATA "Morpheus","Xions"
DATA "Luke Skywalker","Rebellians"
DATA "Darth Vader","Empireans"
DATA "Linus Torvalds","Linuxians"
DATA "Bill Gates","Microsoftians"
DATA "Soo Nee","Plastationites"
DATA "Nintendo","Gameboyites"
DATA "Tiger Woods","Golfians"
DATA "Serena Williams","Screamers"
DATA "Paul Gasgoine","Druggies"
I also think it gets harder the higher your player number, but I didn't have time for a complete desk check to prove it.
It may pull a funny line wrap (probably will), so expect a few errors, just correct those with your delete button. Cut&paste into notepad and enjoy!
Posts: 6,419
Threads: 74
Joined: Mar 2002
Nice additions. This was exaclty what I expected 
Posts: 3,343
Threads: 83
Joined: Mar 2003
Unfortunately I seem to have caused a no-word-wrap that makes this page larger than the screen... I'll try to fix it.
Posts: 115
Threads: 6
Joined: Feb 2003
Well Here's a snake clone, made this in about 15-20 mins, highest score i got was 94 
DEFINT A-Z
TYPE SnakeData
X AS INTEGER
Y AS INTEGER
END TYPE
DIM Snake(3744) AS SnakeData
Tail = 10
Delay = 3 ' Modify this if it runs to slow/fast
FOR I = 0 TO Tail - 1
Snake(I).X = 40
Snake(I).Y = 11
NEXT
Xa(1) = 1
Xa(2) = -1
Ya(3) = 1
Ya(4) = -1
SCREEN 0, 0, 1, 0
FOR I = 0 TO 15
PALETTE I, I
OUT 968, I
OUT 969, 0
OUT 969, I * 4
OUT 969, 0
NEXT
DO
RANDOMIZE TIMER + (Gx + Gy)
Gx = INT(RND * 20) + 2
Gy = INT(RND * 15) + 2
LOOP UNTIL Gx <> 5 AND Gy <> 5
Snke$ = "Programmed_By_BinaryShocK--" ' change this if ya want.
DO
M = 1
L = 15
Z = 1
xKey$ = RIGHT$(INKEY$, 1)
IF xKey$ <> "" THEN
SELECT CASE ASC(xKey$)
CASE 77: D = 1
CASE 75: D = 2
CASE 80: D = 3
CASE 72: D = 4
CASE 27: END
END SELECT
END IF
FOR I = Tail - 1 TO 0 STEP -1
SWAP Snake(I), Snake(I + 1)
NEXT
FOR I = 1 TO 80
LOCATE 1, I: PRINT "*"
LOCATE 23, I: PRINT "*"
NEXT
FOR I = 1 TO 23
LOCATE I, 1: PRINT "*"
LOCATE I, 80: PRINT "*"
NEXT
LOCATE Gy, Gx: COLOR 14: PRINT "÷"
Snake(0).X = Snake(1).X + Xa(D)
Snake(0).Y = Snake(1).Y + Ya(D)
IF Snake(0).X = Gx AND Snake(0).Y = Gy THEN
Tail = Tail + 1
Snke$ = Snke$ + STR$(INT(RND * 2))
DO
RANDOMIZE TIMER + (Gx + Gy)
Gx = INT(RND * 78) + 2
Gy = INT(RND * 21) + 2
LOOP UNTIL Gx <> 5 AND Gy <> 5
END IF
FOR I = 1 TO Tail
IF (Snake(I).X = Snake(0).X) AND (Snake(I).Y = Snake(0).Y) AND D THEN
SCREEN 0, 0, 0, 0
CLS
PRINT "Final Score:"; Tail - 10
A$ = INPUT$(1)
END
END IF
NEXT
IF Snake(0).X = 1 THEN Snake(0).X = 79
IF Snake(0).X = 80 THEN Snake(0).X = 2
IF Snake(0).Y = 1 THEN Snake(0).Y = 22
IF Snake(0).Y = 23 THEN Snake(0).Y = 2
FOR I = 1 TO Tail - 1
L = L - M
IF (L = 7) OR (L = 15) THEN M = -M
IF Snake(0).X > 0 AND Snake(0).X < 81 AND Snake(0).Y > 0 AND Snake(0).Y < 23 THEN
LOCATE Snake(I).Y, Snake(I).X: COLOR L: PRINT MID$(Snke$, Z, 1)
COLOR 7
END IF
Z = Z + 1
IF Z = LEN(Snke$) + 1 THEN Z = 1
NEXT
LOCATE 23, 2: PRINT (Tail - 10)
LOCATE Snake(0).Y, Snake(0).X: COLOR 15: PRINT CHR$(1)
PCOPY 1, 0
CLS
FOR I = 0 TO Delay - 1
WAIT 986, 8
WAIT 986, 8, 8
NEXT
LOOP
very F***ing song remains the same
To everyone who sucks-up for the fame
Out of strength you know we speak the truth
Every trend that dies is living proof
MasterMinds Software
Posts: 2,765
Threads: 138
Joined: Nov 2002
thats neat!
![[Image: KkatEek.txt]](http://www.geocities.com/edymnionii/KkatEek.txt)
![[Image: sig.php]](http://josh.whtiger.net/images/sig.php)
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 480
Threads: 24
Joined: Mar 2003
This took 1 hour and 19 minutes, so it doesn't count by the challenge specifications, but I thought you all might enjoy it.
Code: DECLARE SUB Capture.CheckPoss ()
DECLARE SUB Capture.EndTheGame ()
DECLARE SUB Capture.WillComputerPlay ()
DECLARE SUB Capture.ComputerMove ()
DECLARE SUB Capture.TakePieces ()
DECLARE SUB Capture.AutoMove ()
DECLARE SUB Capture.MovePiece ()
DECLARE SUB Capture.EndGame ()
DECLARE SUB Capture.GetMove ()
DECLARE SUB Capture.GetPiece ()
DECLARE SUB Capture.Initialize ()
DECLARE SUB Capture.StartScreen ()
DECLARE SUB Capture.StartGame ()
DECLARE SUB Capture.DrawBoard ()
'*** CAPTURE by Megan Berry ***
'*** written 2003 ***
COMMON SHARED PlayerTurn, piecex, piecey, movex, movey
COMMON SHARED TakeBack, GameOver, PieceChosen, MoveChosen, Bypass
COMMON SHARED ComputerPlay, P1Pieces, P2Pieces, ComputerLevel
DIM SHARED board(1 TO 8, 1 TO 8), LastMoveX(1 TO 2), LastMoveY(1 TO 2)
CALL Capture.Initialize
CALL Capture.WillComputerPlay
CALL Capture.StartScreen
CALL Capture.StartGame
SUB Capture.AutoMove
LegalMove = 0
FOR Temp1 = piecex - 1 TO piecex + 1
FOR Temp2 = piecey - 1 TO piecey + 1
IF LegalMove = 0 THEN
IF Temp1 > 0 AND Temp1 < 9 AND Temp2 > 0 AND Temp2 < 9 THEN
IF Temp1 <> piecex OR Temp2 <> piecey THEN
IF board(Temp1, Temp2) = PlayerTurn THEN
LegalMove = 1
temp3 = Temp1
temp4 = Temp2
END IF
END IF
END IF
END IF
NEXT Temp2
NEXT Temp1
IF LegalMove = 1 THEN
movex = piecex
movey = piecey
piecex = temp3
piecey = temp4
Bypass = 1
ELSE
FOR temp = 1 TO 200
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), 4, B
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), 12, B
NEXT temp
END IF
END SUB
SUB Capture.CheckPoss
CanMove = 0
FOR Temp1 = 1 TO 8
FOR Temp2 = 1 TO 8
IF board(Temp1, Temp2) = PlayerTurn THEN
FOR ChMvX = Temp1 - 2 TO Temp1 + 2
FOR ChMvY = Temp2 - 2 TO Temp2 + 2
IF ChMvX > 0 AND ChMvX < 9 AND ChMvY > 0 AND ChMvY < 9 THEN
IF ChMvX <> Temp1 OR ChMvY <> Temp2 THEN
IF board(ChMvX, ChMvY) = 0 THEN
CanMove = 1
END IF
END IF
END IF
NEXT ChMvY
NEXT ChMvX
END IF
NEXT Temp2
NEXT Temp1
IF CanMove = 0 THEN
PlayerTurn = PlayerTurn + 1
IF PlayerTurn = 3 THEN
PlayerTurn = 1
END IF
FOR Temp1 = 1 TO 8
FOR Temp2 = 1 TO 8
IF board(Temp1, Temp2) = 0 THEN
board(Temp1, Temp2) = PlayerTurn
END IF
NEXT Temp2
NEXT Temp1
CALL Capture.DrawBoard
END IF
END SUB
SUB Capture.ComputerMove
MostPieces = 0
FOR Temp1 = 1 TO 8
FOR Temp2 = 1 TO 8
IF board(Temp1, Temp2) = 2 THEN
FOR ChMvX = Temp1 - 2 TO Temp1 + 2
FOR ChMvY = Temp2 - 2 TO Temp2 + 2
IF ChMvX > 0 AND ChMvX < 9 AND ChMvY > 0 AND ChMvY < 9 THEN
IF ChMvX <> Temp1 OR ChMvY <> Temp2 THEN
IF board(ChMvX, ChMvY) = 0 THEN
PiecesGained = 0
IF ABS(ChMvX - Temp1) < 2 AND ABS(ChMvY - Temp2) < 2 THEN
PiecesGained = PiecesGained + ComputerLevel
END IF
FOR ChTkX = ChMvX - 1 TO ChMvX + 1
FOR ChTkY = ChMvY - 1 TO ChMvY + 1
IF ChTkX > 0 AND ChTkX < 9 AND ChTkY > 0 AND ChTkY < 9 THEN
IF ChTkX <> ChMvX OR ChTkY <> ChMvY THEN
IF board(ChTkX, ChTkY) = 1 THEN
PiecesGained = PiecesGained + 1
END IF
END IF
END IF
IF PiecesGained > MostPieces THEN
MostPieces = PiecesGained
piecex = Temp1
piecey = Temp2
movex = ChMvX
movey = ChMvY
Bypass = 1
END IF
NEXT ChTkY
NEXT ChTkX
END IF
END IF
END IF
NEXT ChMvY
NEXT ChMvX
END IF
NEXT Temp2
NEXT Temp1
END SUB
SUB Capture.DrawBoard
P1Pieces = 0
P2Pieces = 0
FOR XX = 1 TO 8
FOR YY = 1 TO 8
SELECT CASE board(XX, YY)
CASE 0
PAINT (XX * 20 - 10, YY * 20 - 10), 0, 15
CASE 1
CIRCLE (XX * 20 - 10, YY * 20 - 10), 7, 10
PAINT (XX * 20 - 10, YY * 20 - 10), 10
P1Pieces = P1Pieces + 1
CASE 2
CIRCLE (XX * 20 - 10, YY * 20 - 10), 7, 11
PAINT (XX * 20 - 10, YY * 20 - 10), 11
P2Pieces = P2Pieces + 1
END SELECT
NEXT YY
NEXT XX
LOCATE 4, 22: PRINT "Player 1:"; P1Pieces
LOCATE 5, 22: PRINT "Player 2:"; P2Pieces
IF P1Pieces + P2Pieces = 64 THEN
CALL Capture.EndTheGame
END IF
END SUB
SUB Capture.EndGame
CLS
PRINT "Thanks for playing CAPTURE"
PRINT "by Megan Berry."
PRINT
PRINT "See you again!"
END
END SUB
SUB Capture.EndTheGame
LOCATE 7, 22
IF P1Pieces > P2Pieces THEN
PRINT "Player 1 WINS!"
ELSEIF P2Pieces > P1Pieces THEN
PRINT "Player 2 WINS!"
ELSE
PRINT "TIE GAME!"
END IF
END
END SUB
SUB Capture.GetMove
TakeBack = 0
MoveChosen = 0
movex = piecex
movey = piecey
piecec = 16
pieced = .02 '***** CHANGE THIS DELAY TO FIT YOUR SYSTEM ****
DO
DO
piecec = piecec + pieced
IF piecec > 31 OR piecec < 16 THEN pieced = pieced * -1
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), piecec, B
C$ = UCASE$(INKEY$)
LOOP UNTIL C$ <> ""
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), 15, B
SELECT CASE C$
CASE "Q"
CALL Capture.EndGame
CASE CHR$(0) + "M"
movex = movex + 1
IF movex = 9 THEN movex = 1
CASE CHR$(0) + "K"
movex = movex - 1
IF movex = 0 THEN movex = 8
CASE CHR$(0) + "P"
movey = movey + 1
IF movey = 9 THEN movey = 1
CASE CHR$(0) + "H"
movey = movey - 1
IF movey = 0 THEN movey = 8
CASE CHR$(13)
IF movex = piecex AND movey = piecey THEN
TakeBack = 1
ELSE
IF board(movex, movey) = 0 AND ABS(movex - piecex) < 3 AND ABS(movey - piecey) < 3 THEN
MoveChosen = 1
ELSE
FOR temp = 1 TO 200
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), 4, B
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), 12, B
NEXT temp
END IF
END IF
END SELECT
LOOP UNTIL MoveChosen = 1 OR TakeBack = 1
END SUB
SUB Capture.GetPiece
PieceChosen = 0
piecex = LastMoveX(PlayerTurn)
piecey = LastMoveY(PlayerTurn)
piecec = 16
pieced = .02
DO
DO
piecec = piecec + pieced
IF piecec > 31 OR piecec < 16 THEN pieced = pieced * -1
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), piecec, B
C$ = UCASE$(INKEY$)
LOOP UNTIL C$ <> ""
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), 15, B
SELECT CASE C$
CASE "Q"
CALL Capture.EndGame
CASE CHR$(0) + "M"
piecex = piecex + 1
IF piecex = 9 THEN piecex = 1
CASE CHR$(0) + "K"
piecex = piecex - 1
IF piecex = 0 THEN piecex = 8
CASE CHR$(0) + "P"
piecey = piecey + 1
IF piecey = 9 THEN piecey = 1
CASE CHR$(0) + "H"
piecey = piecey - 1
IF piecey = 0 THEN piecey = 8
CASE CHR$(13)
IF board(piecex, piecey) = PlayerTurn THEN
PieceChosen = 1
ELSEIF board(piecex, piecey) = 0 THEN
CALL Capture.AutoMove
END IF
END SELECT
LOOP UNTIL PieceChosen = 1 OR GameOver = 1 OR Bypass = 1
END SUB
SUB Capture.Initialize
SCREEN 13
RANDOMIZE TIMER
END SUB
SUB Capture.MovePiece
FOR temp = 1 TO 150
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), 3, B
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), 11, B
NEXT temp
LINE (piecex * 20 - 20, piecey * 20 - 20)-(piecex * 20, piecey * 20), 15, B
FOR t = 1 TO 10000: NEXT t
FOR temp = 1 TO 150
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), 3, B
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), 11, B
NEXT temp
LINE (movex * 20 - 20, movey * 20 - 20)-(movex * 20, movey * 20), 15, B
IF ABS(piecex - movex) = 2 OR ABS(piecey - movey) = 2 THEN
Jump = 1
ELSE
Jump = 0
END IF
IF Jump = 1 THEN
board(movex, movey) = PlayerTurn
board(piecex, piecey) = 0
ELSE
board(movex, movey) = PlayerTurn
END IF
LastMoveX(PlayerTurn) = movex
LastMoveY(PlayerTurn) = movey
END SUB
SUB Capture.StartGame
board(1, 1) = 1
board(8, 8) = 1
board(1, 8) = 2
board(8, 1) = 2
LastMoveX(1) = 1
LastMoveY(1) = 1
LastMoveX(2) = 1
LastMoveY(2) = 8
GameOver = 0
PlayerTurn = 0
DO
Bypass = 0
PlayerTurn = PlayerTurn + 1
IF PlayerTurn = 3 THEN PlayerTurn = 1
CALL Capture.CheckPoss
CALL Capture.DrawBoard
DO
LOCATE 1, 22: PRINT "Player"; PlayerTurn
LOCATE 2, 22: PRINT "Choose your piece."
IF PlayerTurn = 2 AND ComputerPlay = 1 THEN
CALL Capture.ComputerMove
ELSE
CALL Capture.GetPiece
END IF
IF Bypass = 0 THEN
LOCATE 2, 22: PRINT "Make your move. "
CALL Capture.GetMove
END IF
LOOP UNTIL TakeBack = 0 OR Bypass = 1
CALL Capture.MovePiece
CALL Capture.TakePieces
LOOP UNTIL GameOver = 1
END SUB
SUB Capture.StartScreen
CLS
FOR temp = 0 TO 160 STEP 20
LINE (temp, 0)-(temp, 160)
LINE (0, temp)-(160, temp)
NEXT temp
END SUB
SUB Capture.TakePieces
FOR temp = movex - 1 TO movex + 1
FOR Temp2 = movey - 1 TO movey + 1
IF temp > 0 AND temp < 9 AND Temp2 > 0 AND Temp2 < 9 THEN
IF temp <> movex OR Temp2 <> movey THEN
IF board(temp, Temp2) <> 0 AND board(temp, Temp2) <> PlayerTurn THEN
board(temp, Temp2) = PlayerTurn
END IF
END IF
END IF
NEXT Temp2
NEXT temp
END SUB
SUB Capture.WillComputerPlay
CLS
PRINT "*** MODE ***"
PRINT
PRINT "1. Human vs. Computer"
PRINT "2. Human vs. Human"
PRINT
PRINT "Enter number of choice: "
DO
ComputerPlay = VAL(INKEY$)
LOOP UNTIL ComputerPlay = 1 OR ComputerPlay = 2
IF ComputerPlay = 1 THEN
PRINT
PRINT "*** DIFFICULTY ***"
PRINT
PRINT "1. Novice"
PRINT "2. Average"
PRINT "3. Expert"
PRINT
PRINT "Enter number of choice: "
DO
ComputerLevel = VAL(INKEY$)
LOOP UNTIL ComputerLevel > 0 AND ComputerLevel < 4
END IF
END SUB
*peace*
Meg.
Posts: 480
Threads: 24
Joined: Mar 2003
LOL I forgot to write instructions.
On your turn you have to first select a source piece, and then select a square to move to. You can move in two ways:
1. Clone a piece to any adjacent square (which leaves the source piece, diagonal moves included).
2. Jump a piece to any square up to two squares away (which removes the source piece, diagonal moves included).
Whatever enemy pieces are adjacent to the target square become yours.
This game's idea came from the Seventh Guest
*peace*
Meg.
Posts: 3,288
Threads: 167
Joined: Nov 2001
2 Hours. Half hours just to animate that darn bubble. ;*)
Setvideoseg by Plasma357
Code: '/////Bubble Fight!!!!///////
'June 2,2003
'Another stupid creation of Relsoft
'Coded in exactly 2 hours
'cuz the one-hour version's GFX sucked BIG.
'OBJECTIVE
'Stay away from mines and stay alive as long as you can
'CONTROLS:
'CTRL=Move left
'ALT=Move Right
'Right Shift= Add Height
'Left Shift=Toggle Vsynch
DECLARE SUB GFX (Size%, x1%, y1%, x2%, y2%)
DECLARE SUB ReInit ()
DECLARE SUB AF.Print (Xpos%, Ypos%, Text$, col%)
DECLARE FUNCTION DoCollision% ()
DECLARE FUNCTION Collide% (Frame%)
DECLARE SUB DoMines ()
DECLARE SUB AddMine ()
DECLARE SUB GenMask (Array%(), ArrayIndex%(), Mask%())
DECLARE SUB InitImageData (FileName$, ImageArray%())
DECLARE SUB MakeImageIndex (ImageArray%(), IndexArray%())
DECLARE SUB DoStars ()
DECLARE SUB INIT ()
DECLARE SUB SetVideoSeg (Segment%)
DEFINT A-Z
'$DYNAMIC
TYPE MineType
x AS SINGLE
y AS SINGLE
xv AS SINGLE
yv AS SINGLE
cx AS INTEGER
cy AS INTEGER
Hei AS INTEGER
Wid AS INTEGER
id AS INTEGER
angle AS INTEGER
Active AS INTEGER
Counter AS INTEGER
Frame AS INTEGER
END TYPE
TYPE BubbleType
x AS SINGLE
y AS SINGLE
xv AS SINGLE
yv AS SINGLE
Frame AS INTEGER
END TYPE
TYPE StarType
x AS SINGLE
y AS SINGLE
xv AS SINGLE
yv AS SINGLE
c AS INTEGER
END TYPE
CONST FALSE = 0, TRUE = NOT FALSE
CONST VIDEO = &HA000
CONST PI = 3.14151693#
CONST MAXMINES = 50
CONST MAXSTARS = 50
CONST xFRICTION = .008
CONST yFRICTION = .008
CONST GRAVITY = .012
CONST ACCEL = .02
DIM SHARED Mine(MAXMINES) AS MineType
DIM SHARED Stars(MAXSTARS) AS StarType
DIM SHARED LutCOS(359) AS SINGLE
DIM SHARED LutSIN(359) AS SINGLE
DIM SHARED VPAGE(32009) AS INTEGER 'SetVideoSeg Buffer
REDIM SHARED BubbleSpr(1 TO 1) AS INTEGER
REDIM SHARED BubbleIdx(1 TO 1) AS INTEGER
REDIM SHARED BubbleMask(1 TO 1) AS INTEGER
REDIM SHARED MineSpr(1 TO 1) AS INTEGER
REDIM SHARED MineIdx(1 TO 1) AS INTEGER
REDIM SHARED MineMask(1 TO 1) AS INTEGER
DIM SHARED Bubble AS BubbleType
DIM SHARED LAYER AS INTEGER
DIM SHARED Score&
DIM SHARED Lives
CLS
SCREEN 13
RANDOMIZE TIMER
INIT
WaitON = TRUE
DO
FINISHED = FALSE
ReInit
DO
Anicount = (Anicount AND 7) + 1
MineCount = (MineCount AND 127) + 1
IF MineCount = 1 THEN
AddMine
END IF
DEF SEG = 0
IF PEEK(1047) AND 4 THEN 'CTRL
Bubble.xv = Bubble.xv - ACCEL
END IF
IF PEEK(1047) AND 8 THEN 'ALT
Bubble.xv = Bubble.xv + ACCEL
END IF
IF PEEK(1047) AND 2 THEN 'LShift
WaitON = NOT WaitON
END IF
IF (PEEK(1047) AND 1) THEN 'RShift
Bubble.yv = Bubble.yv - ((ACCEL * 255) * yFRICTION)
END IF
IF Anicount = 1 THEN
Bubble.Frame = (Bubble.Frame AND 1) + 1
END IF
Bubble.xv = Bubble.xv - Bubble.xv * xFRICTION
Bubble.yv = Bubble.yv + GRAVITY
Bubble.yv = Bubble.yv - (Bubble.yv * yFRICTION)
Bubble.x = Bubble.x + Bubble.xv
Bubble.y = Bubble.y + Bubble.yv
IF Bubble.x < 8 THEN
Bubble.x = 8
ELSEIF Bubble.x > 291 THEN
Bubble.x = 291
END IF
IF Bubble.y < 8 THEN
Bubble.y = 8
ELSEIF Bubble.y > 171 THEN
Bubble.y = 171
END IF
cx% = Bubble.x
cy% = Bubble.y
cf% = Bubble.Frame
SetVideoSeg LAYER
LINE (0, 0)-(319, 199), 0, BF
DoStars
DoMines
IF DoCollision THEN
FINISHED = TRUE
Lives = Lives - 1
END IF
PUT (cx%, cy%), BubbleMask(BubbleIdx(cf%)), AND
PUT (cx%, cy%), BubbleSpr(BubbleIdx(cf%)), OR
'Erase stuff
LINE (0, 0)-(8, 199), 0, BF 'Left
LINE (0, 0)-(319, 8), 0, BF 'top
LINE (312, 0)-(319, 199), 0, BF 'right
LINE (0, 192)-(319, 199), 0, BF 'bottom
AF.Print 0, 0, "Score:" + LTRIM$(STR$(Score&)), 35
AF.Print 0, 10, "Lives:" + LTRIM$(STR$(Lives)), 67
'Calc FPS
FPS = FPS + 1
IF StartTime& + 1 < TIMER THEN
FPS2 = FPS
FPS = 0
StartTime& = TIMER
END IF
AF.Print 0, 192, "FPS:" + STR$(FPS2), 23
SetVideoSeg VIDEO
IF WaitON THEN
WAIT &H3DA, 8
END IF
PUT (0, 0), VPAGE(6), PSET
IF INKEY$ = CHR$(27) THEN END
LOOP UNTIL FINISHED
SetVideoSeg LAYER
FOR I = 0 TO 199 STEP 10
AF.Print 30, I + 0, "*****Y-O-U S-U-C-K !!!!!*****", 67
NEXT I
SetVideoSeg VIDEO
PUT (0, 0), VPAGE(6), PSET
c$ = INPUT$(1)
SetVideoSeg VIDEO
FOR I = 2 TO 9
GFX I + 0, 0, 0, 319, 199
WAIT &H3DA, 8
NEXT I
LOOP WHILE Lives >= 0
DEF SEG
CLS
SCREEN 0
WIDTH 80
END
BUBBLEDATA:
DATA 404
DATA 160,20,0,4352,5395,6166,6425,6425,5656,4885,17,0,0,5393,6424,5656,5397,5397,6166,6169
DATA 4373,0,4352,5909,5398,4627,5395,4371,4881,5653,5399,17,5393,5399,4369,5907,6938,4889,0,4352
DATA 5909,4373,6163,4374,5649,7451,6427,4888,0,0,5649,4888,6421,21,6931,7198,4630,4370,0,0
DATA 5376,5401,6166,4371,7447,5660,17,0,0,0,4864,5656,5656,4881,6938,4374,0,0,0,0
DATA 4352,6166,5401,5905,5915,17,0,0,0,0,0,6421,5401,6418,5403,0,0,0,0,0
DATA 0,6421,5401,5649,4888,0,0,0,0,0,0,6421,5401,4352,4370,0,0,0,0,4625
DATA 17,6421,5656,17,4352,4370,0,0,4352,6166,4371,6166,6166,19,4608,5398,17,0,5393,6425
DATA 4883,5656,6421,21,4352,5909,4373,0,5650,4886,5393,5401,6163,4374,0,5393,4630,0,4625,17
DATA 5649,4888,5393,5399,17,4352,4370,0,0,4352,5909,4373,4352,5909,5398,4371,0,0,4881,5653
DATA 5399,17,0,5393,6424,5656,5397,5397,6166,6169,4373,0,0,4352,5395,6166,6425,6425,5656,4885
DATA 17,0,160,20,0,0,0,4881,5397,5397,4371,0,0,0,0,0,4881,6166,6425,6425
DATA 5656,4371,0,0,0,4881,6166,5656,5397,5397,6166,5656,4371,0,0,6419,5657,5397,4885,17
DATA 4881,6422,4889,0,4352,6422,5399,6935,6685,19,0,5649,5657,17,4864,5656,6677,7709,6685,19
DATA 0,4352,6166,19,5649,5400,7447,7198,4887,17,0,0,6163,4374,6163,5398,7707,5660,17,0
DATA 0,0,5649,4888,6421,5397,7196,4374,0,0,0,0,5376,5401,6421,4885,5656,17,0,0
DATA 0,0,5376,5401,6421,4373,4370,0,0,0,0,4625,5393,5401,6421,21,4352,4370,0,0
DATA 0,5907,5395,5401,6163,4374,4608,5398,17,0,4352,6166,5653,4888,5649,4888,4352,5909,4373,0
DATA 0,5656,6165,4374,4864,5656,17,5393,4630,4352,0,5376,6166,19,4352,6422,4374,4352,4370,4608
DATA 0,5910,5657,17,0,6419,5657,4371,0,4352,5909,6423,4889,0,0,4881,6166,5656,5397,5397
DATA 6166,5656,4371,0,0,0,4881,6166,6425,6425,5656,4371,0,0,0,0,0,4881,5397,5397
DATA 4371,0,0,0
MINEDATA:
DATA 68
DATA 64,8,23808,12032,47,93,93,22297,6487,23808,6400,6426,6681,25,22365,23833,6495,23895,22365,24345
DATA 6493,23895,6400,6426,6681,25,93,22297,6487,23808,23808,12032,47,93,64,8,12032,26368,103,47
DATA 47,10047,16167,12032,16128,11831,14126,63,10087,16174,11833,26407,10087,14638,11839,26407,16128,11831,14126,63
DATA 47,10047,16167,12032,12032,26368,103,47
REM $STATIC
SUB AddMine
'id
'0=Static
'1=verical
'2=Horz
'3=Circular
FOR I = 0 TO MAXMINES
IF NOT Mine(I).Active THEN
Mine(I).id = INT(RND * 5)
Mine(I).x = 304
Mine(I).y = INT(RND * 184)
Mine(I).xv = .12 + (RND * 2) / 5
Mine(I).yv = .12 + (RND * 2) / 5
Mine(I).Hei = 10 + (Int20)
Mine(I).Wid = 10 + (20)
Mine(I).angle = INT(RND * 359)
Mine(I).Active = TRUE
Mine(I).Counter = 0
Mine(I).Frame = 1
SELECT CASE Mine(I).id
CASE 0
Score& = Score& + 10
CASE 1
Score& = Score& + 20
CASE 2
Score& = Score& + 30
CASE 3
Score& = Score& + 70
CASE 4
Score& = Score& + 100
CASE ELSE
END SELECT
EXIT FOR
END IF
NEXT I
END SUB
SUB AF.Print (Xpos%, Ypos%, Text$, col%)
'Prints the standard 8*8 CGA font
'Paramenters:
'Segment=the Layer to print to
'Xpos,Ypos=the coordinates of the text
'Text$=the string to print
'col= is the color to print(gradient)
x% = Xpos%
y% = Ypos%
Spacing% = 8
FOR I% = 0 TO LEN(Text$) - 1
x% = x% + Spacing%
Offset% = 8 * ASC(MID$(Text$, I% + 1, 1)) + 14
FOR J% = 0 TO 7
DEF SEG = &HFFA6
Bit% = PEEK(Offset% + J%)
IF Bit% AND 1 THEN PSET (x%, y% + J%), col% + J%
IF Bit% AND 2 THEN PSET (x% - 1, y% + J%), col% + J%
IF Bit% AND 4 THEN PSET (x% - 2, y% + J%), col% + J%
IF Bit% AND 8 THEN PSET (x% - 3, y% + J%), col% + J%
IF Bit% AND 16 THEN PSET (x% - 4, y% + J%), col% + J%
IF Bit% AND 32 THEN PSET (x% - 5, y% + J%), col% + J%
IF Bit% AND 64 THEN PSET (x% - 6, y% + J%), col% + J%
IF Bit% AND 128 THEN PSET (x% - 7, y% + J%), col% + J%
NEXT J%
NEXT I%
DEF SEG
END SUB
FUNCTION DoCollision
DoCollision = FALSE
bx% = Bubble.x
by% = Bubble.y
BR% = 9 * 9
db! = SQR(BR%)
bcx% = bx% + 10
bcy% = by% + 10
FOR I = 0 TO MAXMINES
IF Mine(I).Active THEN
cx% = Mine(I).cx
cy% = Mine(I).cy
IF cx% < bcx% + db! THEN
IF cx% > bcx% - db! THEN
IF cy% < bcy% + db! THEN
IF cy% > bcy% - db! THEN
DoCollision = TRUE
EXIT FOR
END IF
END IF
END IF
END IF
END IF
NEXT I
END FUNCTION
SUB DoMines
Anicount = (Anicount AND 64) + 1
FOR I = 0 TO MAXMINES
IF Mine(I).Active THEN
GOSUB Checkid
IF cx% >= 0 AND cy% >= 0 AND cx% < 305 AND cy% < 184 THEN
IF Anicount = 1 THEN
Mine(I).Frame = (Mine(I).Frame AND 1) + 1
cf% = Mine(I).Frame
END IF
PUT (cx%, cy%), MineMask(MineIdx(cf%)), AND
PUT (cx%, cy%), MineSpr(MineIdx(cf%)), OR
END IF
IF Mine(I).x < 0 THEN
Mine(I).Active = FALSE
END IF
END IF
NEXT I
EXIT SUB
Checkid:
'id
'0=Static
'1=vert
'2=Horz
'3=Circular
id = Mine(I).id
SELECT CASE id
CASE 0
Mine(I).x = Mine(I).x - Mine(I).xv
cx% = Mine(I).x
cy% = Mine(I).y
Mine(I).cx = cx%
Mine(I).cy = cy%
CASE 1
Mine(I).x = Mine(I).x - .55
Mine(I).angle = Mine(I).angle - 1
IF Mine(I).angle < 0 THEN Mine(I).angle = 360 + Mine(I).angle
Mine(I).yv = LutSIN(Mine(I).angle) * 50
cx% = Mine(I).x
cy% = Mine(I).y + Mine(I).yv
Mine(I).cx = cx%
Mine(I).cy = cy%
CASE 2
Mine(I).x = Mine(I).x - .55
Mine(I).angle = Mine(I).angle - 1
IF Mine(I).angle < 0 THEN Mine(I).angle = 360 + Mine(I).angle
Mine(I).xv = LutSIN(Mine(I).angle) * 50
cx% = Mine(I).x + Mine(I).xv
cy% = Mine(I).y
Mine(I).cx = cx%
Mine(I).cy = cy%
CASE 3
Mine(I).x = Mine(I).x - .55
Mine(I).angle = Mine(I).angle - 1
IF Mine(I).angle < 0 THEN Mine(I).angle = 360 + Mine(I).angle
Mine(I).xv = LutCOS(Mine(I).angle) * 50
Mine(I).yv = LutSIN(Mine(I).angle) * 50
cx% = Mine(I).x + Mine(I).xv
cy% = Mine(I).y + Mine(I).yv
Mine(I).cx = cx%
Mine(I).cy = cy%
CASE 4
Mine(I).x = Mine(I).x - .55
Mine(I).angle = (Mine(I).angle + 1) MOD 360
Mine(I).xv = LutCOS(Mine(I).angle) * 50
Mine(I).yv = LutSIN(Mine(I).angle) * 50
cx% = Mine(I).x + Mine(I).xv
cy% = Mine(I).y + Mine(I).yv
Mine(I).cx = cx%
Mine(I).cy = cy%
CASE ELSE
END SELECT
RETURN
END SUB
SUB DoStars
FOR S% = 0 TO MAXSTARS
Stars(S%).x = Stars(S%).x + Stars(S%).xv
Stars(S%).y = Stars(S%).y + Stars(S%).yv
IF Stars(S%).x < 0 OR Stars(S%).y > 180 THEN
Stars(S%).x = INT(RND * 520)
Stars(S%).y = 0
Stars(S%).xv = -(.001 + (RND * 1))
Stars(S%).yv = (.001 + (RND * 1))
Stars(S%).c = 16 + INT(RND * 16)
END IF
PSET (Stars(S%).x, Stars(S%).y), Stars(S%).c
NEXT S%
END SUB
SUB GenMask (Array(), ArrayIndex(), Mask())
'Creats masks for our sprites as we ain't using a LIB
'so we have to make use od masks for transparency
REDIM Mask(1 TO UBOUND(Array))
FOR I = 1 TO UBOUND(Array) 'Recopy values
Mask(I) = Array(I)
NEXT I
FOR I = 1 TO UBOUND(ArrayIndex) 'mask em. ;*)
W% = Array(ArrayIndex(I)) \ 8
H% = Array(ArrayIndex(I) + 1)
foo& = 0
FOR y = 0 TO H% - 1
FOR x = 0 TO W% - 1
DEF SEG = VARSEG(Array(1))
c% = PEEK(VARPTR(Array(ArrayIndex(I) + 2)) + foo&)
IF c <> 0 THEN
DEF SEG = VARSEG(Mask(1))
POKE VARPTR(Mask(ArrayIndex(I) + 2)) + foo&, 0
ELSE
DEF SEG = VARSEG(Mask(1))
POKE VARPTR(Mask(ArrayIndex(I) + 2)) + foo&, 255
END IF
foo& = foo& + 1
NEXT x
NEXT y
NEXT I
DEF SEG
END SUB
SUB GFX (Size%, x1, y1, x2, y2)
FOR Xsize = x1 TO x2 STEP Size%
FOR Ysize = y1 TO y2 STEP Size%
P = POINT(Xsize, Ysize)
LINE (Xsize - 1, Ysize - 1)-(Xsize + Size% - 1, Ysize + Size% - 1), P, BF
NEXT Ysize
NEXT Xsize
END SUB
SUB INIT
FOR A% = 0 TO 359
LutCOS(A%) = COS(A% * PI / 180)
LutSIN(A%) = SIN(A% * PI / 180)
NEXT A%
FOR S% = 0 TO MAXSTARS
Stars(S%).x = INT(RND * 520)
Stars(S%).y = INT(RND * 180)
Stars(S%).xv = -(.01 + (RND * 1))
Stars(S%).yv = (.01 + (RND * 1))
Stars(S%).c = 16 + INT(RND * 16)
NEXT S%
RESTORE BUBBLEDATA
InitImageData "", BubbleSpr()
MakeImageIndex BubbleSpr(), BubbleIdx()
GenMask BubbleSpr(), BubbleIdx(), BubbleMask()
RESTORE MINEDATA
InitImageData "", MineSpr()
MakeImageIndex MineSpr(), MineIdx()
GenMask MineSpr(), MineIdx(), MineMask()
VPAGE(6) = 2560 'Width 320*8
VPAGE(7) = 200 'Height
LAYER = VARSEG(VPAGE(0)) + 1 'Buffer Seg(Ask Plasma)
'======
Bubble.x = 150
Bubble.y = 90
Bubble.xv = 0
Bubble.yv = 0
Bubble.Frame = 1
Score& = 0
Lives = 2
END SUB
SUB InitImageData (FileName$, ImageArray())
IF FileName$ <> "" THEN
'***** Read image data from file *****
'Establish size of integer array required.
FileNo = FREEFILE
OPEN FileName$ FOR BINARY AS #FileNo
Ints = (LOF(FileNo) - 7) \ 2
CLOSE #FileNo
REDIM ImageArray(1 TO Ints)
'Load image data directly into array memory.
DEF SEG = VARSEG(ImageArray(1))
BLOAD FileName$, 0
DEF SEG
ELSE
'***** Read image data from DATA statements *****
'Establish size of integer array required.
READ IntCount
REDIM ImageArray(1 TO IntCount)
'READ image DATA into array.
FOR n = 1 TO IntCount
READ x
ImageArray(n) = x
NEXT n
END IF
END SUB
SUB MakeImageIndex (ImageArray(), IndexArray())
'The index will initially be built in a temporary array, allowing
'for the maximum 1000 images per file.
DIM Temp(1 TO 1000)
ptr& = 1: IndexNo = 1: LastInt = UBOUND(ImageArray)
DO
Temp(IndexNo) = ptr&
IndexNo = IndexNo + 1
'Evaluate descriptor of currently referenced image to
'calculate the beginning of the next image.
x& = (ImageArray(ptr&) \ 8) * (ImageArray(ptr& + 1)) + 4
IF x& MOD 2 THEN x& = x& + 1
ptr& = ptr& + (x& \ 2)
LOOP WHILE ptr& < LastInt
LastImage = IndexNo - 1
'Copy the image index values into the actual index array.
REDIM IndexArray(1 TO LastImage)
FOR n = 1 TO LastImage
IndexArray(n) = Temp(n)
NEXT n
END SUB
SUB ReInit
Bubble.x = 150
Bubble.y = 90
Bubble.xv = 0
Bubble.yv = 0
Bubble.Frame = 1
FOR I = 0 TO MAXMINES
Mine(I).id = 0
Mine(I).x = 0
Mine(I).y = 0
Mine(I).cx = 0
Mine(I).cy = 0
Mine(I).xv = 0
Mine(I).yv = 0
Mine(I).Hei = 0
Mine(I).Wid = 0
Mine(I).angle = 0
Mine(I).Active = FALSE
Mine(I).Counter = 0
Mine(I).Frame = 0
NEXT I
END SUB
SUB SetVideoSeg (Segment) STATIC
DEF SEG
IF VideoAddrOff& = 0 THEN ' First time the sub is called
' We need to find the location of b$AddrC, which holds the graphics
' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default
' segment, we can find it by setting it to a certain value, and then
' searching for that value.
SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)
FOR Offset& = 0 TO 32764 ' Search for b$AddrC, which is
IF PEEK(Offset&) = &HA0 THEN ' in the default segment and
IF PEEK(Offset& + 1) = &H7D THEN ' should have a value of
IF PEEK(Offset& + 2) = &H0 THEN ' A0 7D 00 A0.
IF PEEK(Offset& + 3) = &HA0 THEN
VideoAddrOff& = Offset& + 2 ' If we found it, record the
EXIT FOR ' offset of b$SegC and quit
END IF ' looking. (Oddly, changing
END IF ' the b$OffC doesn't seem to
END IF ' do anything, so this is why
END IF ' this sub only changes b$SegC)
NEXT
END IF
' Change b$SegC to the specified Segment
POKE VideoAddrOff&, Segment AND &HFF
POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100
END SUB
|
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)