DECLARE FUNCTION VGer% ()
DECLARE SUB McHelp ()
DECLARE SUB SleepWell (n AS INTEGER)
DECLARE SUB Force (c$)
DECLARE FUNCTION Get1$ ()
DECLARE FUNCTION GetOption$ (Prompt$)
CLS : LOCATE 10, 1: PRINT "# # # V'GER # # # Version 20060313"
PRINT : PRINT "Credits, history, forum at"
PRINT "http://www.network54.com/Hide/Forum/273951"
LOCATE 25, 1
LINE INPUT "Press Enter"; e$
DIM SHARED MyErr AS INTEGER
StartOver: ' As suggested by QBasic mennonote
CLEAR : WIDTH 80: CLS
CONST Vergo = "Running.Now": 'File to see if another version is running
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN Vergo FOR APPEND AS #5: CLOSE : KILL Vergo
OPEN Vergo FOR OUTPUT AS #5: PRINT #5, "Up": CLOSE
OPEN Vergo FOR INPUT AS #5
ON ERROR GOTO 0
IF MyErr > 0 THEN
CLOSE
PRINT "Cannot start - Perhaps another copy of V'GER is running"
PRINT "Press spacebar to exit now"
DO: LOOP WHILE INKEY$ <> " "
SYSTEM
END IF
CONST Skeep = "Skeep.dat"
DIM SHARED SKept AS INTEGER
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN Skeep FOR INPUT AS #1
ON ERROR GOTO 0: CLOSE
IF MyErr > 0 THEN
SKept = 0
ELSE
OPEN Skeep FOR BINARY AS #1: GET #1, 1, SKept: CLOSE
END IF
OPEN Skeep FOR BINARY AS #1: t% = 0: PUT #1, 1, t%: CLOSE
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN "Cheat" FOR INPUT AS #1
ON ERROR GOTO 0: CLOSE
IF MyErr = 0 THEN
KILL "Cheat"
SKept = 9999
END IF
Again% = VGer
CLOSE : OPEN Skeep FOR BINARY AS #1: PUT #1, 1, SKept: CLOSE
IF Again% THEN CLOSE : GOTO StartOver ELSE SYSTEM
GetMyErr:
MyErr = ERR
RESUME NEXT
SUB Force (c$)
x$ = UCASE$(c$)
DO: K$ = Get1$: LOOP WHILE K$ <> x$
END SUB
FUNCTION Get1$
DO: K$ = INKEY$: LOOP UNTIL LEN(K$) = 1
Get1$ = UCASE$(K$)
END FUNCTION
FUNCTION GetOption$ (Prompt$)
LOCATE , , 1: PRINT Prompt$; ": ";
DO: K$ = INKEY$: LOOP WHILE K$ = ""
PRINT K$
GetOption$ = K$
END FUNCTION
SUB McHelp
CLS
' Size of U() the User-supplied help data
DIM uMax AS INTEGER: uMax = 890: ' Adjust after U() is debugged
' User Data
DIM u(uMax) AS STRING
i = 0
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Intro"
i = i + 1: u(i) = "A 'big picture' introduction to V'GER"
i = i + 1: u(i) = "The menu says 'PHXRF'. You choose one"
i = i + 1: u(i) = "of these options:"
i = i + 1: u(i) = " P=Play"
i = i + 1: u(i) = " H=Help"
i = i + 1: u(i) = " X=exit"
i = i + 1: u(i) = " R=Recording"
i = i + 1: u(i) = " F=Free Game."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "The object is to play games (P) and"
i = i + 1: u(i) = "win them. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "You will also see your statistics:"
i = i + 1: u(i) = "Current Score is 0 High Score is 0"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Each time you win a game, your current"
i = i + 1: u(i) = "score is increased. There are levels"
i = i + 1: u(i) = "of praise depending on how far you get"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "But when you lose, your current score"
i = i + 1: u(i) = "is reset to zero! Only very careful"
i = i + 1: u(i) = "play will result in a high score. If"
i = i + 1: u(i) = "you are good enough, you should be"
i = i + 1: u(i) = "able to reach any given level. But it"
i = i + 1: u(i) = "will take hundreds of games before you"
i = i + 1: u(i) = "get that good. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Don't be discouraged. You get better"
i = i + 1: u(i) = "with time."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Play"
i = i + 1: u(i) = "How to play V'GER (the basics)"
i = i + 1: u(i) = "When you select 'P' in normal mode, a"
i = i + 1: u(i) = "screen comes up with obstructions and"
i = i + 1: u(i) = "two figures."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Use the numeric keypad to move the"
i = i + 1: u(i) = "smiley face (you) 8 directions. After"
i = i + 1: u(i) = "you make a move, the bad guy (heart)"
i = i + 1: u(i) = "will also move, attempting to get"
i = i + 1: u(i) = "closer to you. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "If the bad guy gets adjacent to you,"
i = i + 1: u(i) = "you lose! He just wants to give you"
i = i + 1: u(i) = "the kiss of death. Don't trust the"
i = i + 1: u(i) = "pleasant heart symbol!"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "You also will notice 10 diamonds."
i = i + 1: u(i) = "These are prizes you need to collect. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "If you collect all 10, you win the"
i = i + 1: u(i) = "game and your score is increased."
i = i + 1: u(i) = "Otherwise, your score goes to zero!"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "See Collecting Prizes for details."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Prizes"
i = i + 1: u(i) = "How you go about collecting prizes"
i = i + 1: u(i) = "In the case that all 10 prizes are"
i = i + 1: u(i) = "visible at the start of a game, this"
i = i + 1: u(i) = "is simple: simply move smiley face to"
i = i + 1: u(i) = "each of the prizes while ensuring you"
i = i + 1: u(i) = "don't unintentionally move the bad guy"
i = i + 1: u(i) = "to any of them."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "But if you see less than 10, you have"
i = i + 1: u(i) = "to do this: "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "1) Before starting, memorize or mark"
i = i + 1: u(i) = "with a post-it where the bad guy is."
i = i + 1: u(i) = "Why? Because a prize might be under"
i = i + 1: u(i) = "him. When he moves away, you must move"
i = i + 1: u(i) = "smiley face to that square sooner or"
i = i + 1: u(i) = "later to see if an invisible prize"
i = i + 1: u(i) = "was there."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "2) On your first move, just move one"
i = i + 1: u(i) = "away from where you started. On your"
i = i + 1: u(i) = "next move, move back to where you"
i = i + 1: u(i) = "started. Why? Because you might be"
i = i + 1: u(i) = "covering an invisible prize and you"
i = i + 1: u(i) = "only get prizes when you move into a"
i = i + 1: u(i) = "square where one is."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "3) Thereafter, every time you take a"
i = i + 1: u(i) = "prize, you must move away and then"
i = i + 1: u(i) = "move back. Of course, all that stops"
i = i + 1: u(i) = "as soon as the visible prizes plus the"
i = i + 1: u(i) = "prize count so far is equal to ten. As"
i = i + 1: u(i) = "soon as that happens, you can just"
i = i + 1: u(i) = "proceed as usual taking each prize"
i = i + 1: u(i) = "only once."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Warp"
i = i + 1: u(i) = "How to escape from the bad guy by warping"
i = i + 1: u(i) = "It you move your smiley face off the"
i = i + 1: u(i) = "edge of the board, you will warp to"
i = i + 1: u(i) = "some random other point."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "This leads to a good strategy. Tease"
i = i + 1: u(i) = "the bad guy and lead him over to an"
i = i + 1: u(i) = "empty part of the board. Then warp"
i = i + 1: u(i) = "away. With any luck, you will be on"
i = i + 1: u(i) = "the other side of the board next to"
i = i + 1: u(i) = "lots of prizes."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "But be careful. Before warping, look"
i = i + 1: u(i) = "around for all the dangerous places"
i = i + 1: u(i) = "you might warp to. Maybe put off"
i = i + 1: u(i) = "warping a few moves for a better"
i = i + 1: u(i) = "chance. For example, you might warp"
i = i + 1: u(i) = "next to the bad guy (you always warp"
i = i + 1: u(i) = "at least one square away so you don't"
i = i + 1: u(i) = "die immediately) and find that there"
i = i + 1: u(i) = "is no good move to escape because of"
i = i + 1: u(i) = "all the barriers. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Also, if barriers form a prison, you"
i = i + 1: u(i) = "might warp inside and thus lose"
i = i + 1: u(i) = "because you can never get out."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "SlowMode"
i = i + 1: u(i) = "Caps Lock ON puts you in slow mode"
i = i + 1: u(i) = "If the bad guy is very close to you"
i = i + 1: u(i) = "and you have just drank strong coffee,"
i = i + 1: u(i) = "maybe you are a bit shaky and might"
i = i + 1: u(i) = "accidentally hit an arrow key twice."
i = i + 1: u(i) = "That might result in a loss. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "The Caps Lock key controls your speed."
i = i + 1: u(i) = "If it is on, then if you hit the arrow"
i = i + 1: u(i) = "keys too fast, the extra hits are"
i = i + 1: u(i) = "ignored."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "ESC"
i = i + 1: u(i) = "Use the ESC key to skip doomed games."
i = i + 1: u(i) = "After your second move, you can press"
i = i + 1: u(i) = "ESC at any time to resign immediately"
i = i + 1: u(i) = "(and lose!)"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "(You might as well go ahead and do"
i = i + 1: u(i) = "that if the bad guy collects one of"
i = i + 1: u(i) = "your prizes.)"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "But BEFORE your second move, you can"
i = i + 1: u(i) = "press ESC to resign but only lose one"
i = i + 1: u(i) = "point. You want to do that to avoid"
i = i + 1: u(i) = "doomed games."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Before starting a game, ensure there"
i = i + 1: u(i) = "is no trap, i.e. an area completely"
i = i + 1: u(i) = "surrounded by barriers. If such an"
i = i + 1: u(i) = "area contains a prize, then you will"
i = i + 1: u(i) = "never be able to collect it. Even if"
i = i + 1: u(i) = "the surrounded space is empty, you run"
i = i + 1: u(i) = "the risk of warping there and being"
i = i + 1: u(i) = "stuck. That is a good time to use ESC."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Also you might start out in a position"
i = i + 1: u(i) = "where, if you don't warp, the bad guy"
i = i + 1: u(i) = "will surely collect a prize. So you"
i = i + 1: u(i) = "warp, but it turns out that the new"
i = i + 1: u(i) = "position is just as bad. That is"
i = i + 1: u(i) = "another good time to use ESC."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Q"
i = i + 1: u(i) = "You can see what would have happened otherwise!"
i = i + 1: u(i) = "OK, so you have decided to use ESC and"
i = i + 1: u(i) = "forfeit one point because of a bad"
i = i + 1: u(i) = "board position. But you are curious"
i = i + 1: u(i) = "what would have happened if you didn't"
i = i + 1: u(i) = "do that."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Instead of ESC, press 'Q' (Quit)."
i = i + 1: u(i) = "Smiley face changes color and you"
i = i + 1: u(i) = "proceed with the game."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "If you win or lose it is the same, you"
i = i + 1: u(i) = "lose one point. But it is sometimes"
i = i + 1: u(i) = "instructive to do anyway."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Points"
i = i + 1: u(i) = "You get extra points if there are less than 10 prizes."
i = i + 1: u(i) = "You count prizes at the beginning of a"
i = i + 1: u(i) = "game and see only 9. So you think why"
i = i + 1: u(i) = "should I risk messing up on all the"
i = i + 1: u(i) = "double-move stuff, I will just resign"
i = i + 1: u(i) = "and take my one-point penalty."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "To sweeten the pot and make that"
i = i + 1: u(i) = "decision harder, you get 4 points if"
i = i + 1: u(i) = "you win a game started with only 9"
i = i + 1: u(i) = "prizes. You get 3 if 8 prizes, etc."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Why less? Because you have less"
i = i + 1: u(i) = "squares to check."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Life"
i = i + 1: u(i) = "Pay attention to the number of tempos of life remaining"
i = i + 1: u(i) = "Careful not to run out of life. You"
i = i + 1: u(i) = "use one tempo every time you press an"
i = i + 1: u(i) = "arrow key. "
i = i + 1: u(i) = ""
i = i + 1: u(i) = "This is true, by the way, whether"
i = i + 1: u(i) = "smiley face is blocked by a barrier or"
i = i + 1: u(i) = "not. You can position yourself next to"
i = i + 1: u(i) = "a barrier and continually use the"
i = i + 1: u(i) = "arrow key to bang into the barrier in"
i = i + 1: u(i) = "order to bait the bad guy and make him"
i = i + 1: u(i) = "move toward you or into a trap."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "If LIFE=0, you will normally lose as"
i = i + 1: u(i) = "soon as you press any arrow key. One"
i = i + 1: u(i) = "exception: if you take the 10th prize"
i = i + 1: u(i) = "as a result of that move, you win."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "FreeGame"
i = i + 1: u(i) = "Playing a game with no points to win or lose"
i = i + 1: u(i) = "Suppose someone posts a challenge: I "
i = i + 1: u(i) = "won game 341543 with 63 tempos left,"
i = i + 1: u(i) = "see if you can do better!"
i = i + 1: u(i) = ""
i = i + 1: u(i) = "So you want to play that game. Just"
i = i + 1: u(i) = "hit 'F' and then enter 341543 and"
i = i + 1: u(i) = "start playing. It won't alter your"
i = i + 1: u(i) = "score."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "If you want to replay the last game"
i = i + 1: u(i) = "you just played, enter an equal mark"
i = i + 1: u(i) = "(=) instead of a game number."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "To see what your current game number"
i = i + 1: u(i) = "is, look in default.hst."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Recorder"
i = i + 1: u(i) = "Description of Recording Mode and publishing games."
i = i + 1: u(i) = "You just played a great (or horrible)"
i = i + 1: u(i) = "game and want to post it on the V'GER"
i = i + 1: u(i) = "forum so others can see."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "OK, as you havejust completed the"
i = i + 1: u(i) = "game, you will be looking at the PHXRF"
i = i + 1: u(i) = "menu prompt. Select R."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "As instructed, turn recording mode on."
i = i + 1: u(i) = "Now when you select P, it will ask"
i = i + 1: u(i) = "whether you want and old game or a new"
i = i + 1: u(i) = "one. Select old and select the default"
i = i + 1: u(i) = "game. Now you are in playback mode."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Press the spacebar to see your next"
i = i + 1: u(i) = "moves. At any time, enter C to enter"
i = i + 1: u(i) = "a comment. Then save the game."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "It can be posted and others can play"
i = i + 1: u(i) = "it and see your comments."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "Boss"
i = i + 1: u(i) = "Pressing B (Boss is coming)"
i = i + 1: u(i) = "At any time, you can press B (or X)"
i = i + 1: u(i) = "and terminate V'GER immediately."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "If a game is in progress, it will be"
i = i + 1: u(i) = "saved."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "This is useful in case you have to"
i = i + 1: u(i) = "turn your computer off quickly. Just"
i = i + 1: u(i) = "simply turning it off can result in"
i = i + 1: u(i) = "losing all your points."
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "History"
i = i + 1: u(i) = "HiScores.txt contains the history of your play"
i = i + 1: u(i) = "V'GER already displays the highest"
i = i + 1: u(i) = "score of all time. But suppose that"
i = i + 1: u(i) = "was 33 and you've worked hard and"
i = i + 1: u(i) = "gotten to 24 (on the way, you hope, of"
i = i + 1: u(i) = "beating the all-time high). But then"
i = i + 1: u(i) = "you goof and the score goes back to"
i = i + 1: u(i) = "zero."
i = i + 1: u(i) = ""
i = i + 1: u(i) = "Bummer! You lost all record of the"
i = i + 1: u(i) = "fact you got to 24? Not so!"
i = i + 1: u(i) = "HiScores.txt contains a record of all"
i = i + 1: u(i) = "of your intermediate high scores. "
' Final Delimiters
i = i + 1: u(i) = "#"
i = i + 1: u(i) = "#"
' Scan, edit the HelpFile
DIM temp AS INTEGER
DIM qMax AS INTEGER: ' Computed number of help topics
FOR i = 1 TO uMax - 1
IF LEN(u(i)) > 39 THEN STOP: 'No line can exceed 39 chars
IF u(i) = "#" THEN
l$ = u(i + 1)
IF l$ = "#" THEN qMax = temp: EXIT FOR
IF (LEN(l$) < 1) OR (LEN(l$) > 8) THEN
STOP: 'Bug in data. Topics must be 1-8 characters long
END IF
l$ = u(i + 2)
IF (LEN(l$) < 1) OR (LEN(l$) > 79) THEN
STOP: 'Bug in data. Descriptions must be 1-79 characters
END IF
i = i + 2
temp = temp + 1
END IF
NEXT i
IF qMax = 0 THEN STOP: ' There were no #'s detected
qMax = qMax + 2: ' Space for the standard Help start and end
DIM qLine(qMax): ' The line (1-3) the short prompt will be in
DIM qSlot(qMax): ' The slot (1-8), each 10 chars = 80 chars
DIM qPrompt(qMax) AS STRING * 9: ' The prompt
DIM qLong(qMax) AS STRING: ' The long prompt
DIM qStart(qMax) AS INTEGER: ' The start of text (if any)
DIM qEnd(qMax) AS INTEGER: ' The end of text
' Load arrays
DIM ux AS INTEGER: ux = 1: ' Index for U()
DIM qx AS INTEGER: qx = 1' Index for q-Arrays
DIM xLine AS INTEGER: ' The line of the Prompt displays
DIM xSlot AS INTEGER: ' The slot for a Prompt display
DIM Line1 AS INTEGER: Line1 = locPrompts: ' Start of display
qLine(1) = Line1: qSlot(1) = 1: qPrompt(1) = "Help"
qLong(1) = "How to use this Help menu"
qStart(1) = -1: qEnd(1) = -1
GOSUB LoadUserData
qPrompt(qx) = "Exit"
qLong(qx) = "Return to main program"
SCREEN 0: WIDTH 80
FOR i = 1 TO 3
FOR j = 1 TO 8
K = K + 1: IF K > qMax THEN i = 4: EXIT FOR
LOCATE qLine(K), qSlot(K)
COLOR 7, 14
PRINT qPrompt(K)
NEXT j
PRINT
NEXT i
IF K < qMax THEN STOP: 'Too much data: 22 user-supplied entries exceeded
GOSUB ClearHelp
OldQ = 1: 'Well, it has to have some value
NewQ = 1: 'Start at square 1
DO
' Reset old selection
LOCATE qLine(OldQ), qSlot(OldQ)
COLOR 7, 14: PRINT qPrompt(OldQ)
' Highlight new selection
LOCATE qLine(NewQ), qSlot(NewQ)
COLOR 15, 12: PRINT qPrompt(NewQ)
l$ = qLong(NewQ)
COLOR 7, 0
LOCATE locLong, 1: PRINT l$ + SPACE$(80 - LEN(l$))
OldQ = NewQ
GOSUB GetMyKey
SELECT CASE MyKey$
CASE "R": NewQ = NewQ + 1: IF NewQ > qMax THEN NewQ = 1
CASE "L": NewQ = NewQ - 1: IF NewQ < 1 THEN NewQ = qMax
CASE "U": IF NewQ > 8 THEN NewQ = NewQ - 8
CASE "D": NewQ = NewQ + 8: IF NewQ > qMax THEN NewQ = NewQ - 8
CASE "H": NewQ = 1
CASE "E": NewQ = qMax
END SELECT
GOSUB ClearHelp
IF MyKey$ = "Enter" THEN GOSUB GotEnter
LOOP
STOP: ' Never gets here (See below)
GotEnter:
IF DidIt = 0 THEN DIM hh(15) AS STRING: GOSUB DoIt
COLOR 7, 0
IF NewQ = qMax THEN CLS : EXIT SUB: ' <--- Exits from here
VIEW PRINT locView TO locView + sizView + 1
GOSUB PrintInView
VIEW PRINT
RETURN
PrintInView:
CLS
IF NewQ = 1 THEN
FOR i = 1 TO 15: LSET Work$ = hh(i): PRINT Work$; "|": NEXT i
ELSE
CLS
r1Start = qStart(NewQ)
r1End = qEnd(NewQ)
rCount = r1End - r1Start + 1
IF rCount = 0 THEN PRINT "No help details available": RETURN
IF rCount > (2 * sizView) THEN STOP: ' Too big
IF rCount < 0 THEN STOP: ' Too little
IF r1Start < 1 THEN STOP: ' Bug
IF rCount > sizView THEN
r2End = r1End + 1
r1End = r1Start + sizView
ELSE
r2End = 0
r1End = r1End + 1
END IF
FOR i = r1Start TO r1End - 1
LSET Work$ = u(i)
PRINT Work$; "| ";
IF i + sizView < r2End THEN
LSET Work$ = u(i + sizView)
PRINT Work$
ELSE
PRINT ""
END IF
NEXT i
END IF
RETURN
ClearHelp:
VIEW PRINT locView TO locView + sizView + 1
COLOR 7, 0
CLS
IF (qStart(NewQ) = 1) AND (qEnd(NewQ) = 0) THEN
PRINT "No details available"
ELSE
PRINT "Press Enter"
END IF
VIEW PRINT
RETURN
LoadUserData:
ss = 2
FOR xLine = 1 TO 3
FOR xSlot = ss TO 8
IF u(ux) = "#" THEN GOSUB DoEntry ELSE STOP: 'Bug
NEXT xSlot
ss = 1
NEXT xLine
RETURN
DoEntry:
qx = qx + 1: IF qx > qMax THEN STOP: 'Bug
qLine(qx) = xLine + Line1 - 1
qSlot(qx) = 1 + ((xSlot - 1) * 10)
ux = ux + 1: IF ux > uMax THEN STOP: 'Bug
IF u(ux) = "#" THEN xLine = 4: xSlot = 9: RETURN: ' End of data
'We have a Help prompt to enter
qPrompt(qx) = u(ux)
ux = ux + 1: IF ux > uMax THEN STOP: 'Bug
qLong(qx) = u(ux)
ux = ux + 1: IF ux > uMax THEN STOP: 'Bug
IF u(ux) = "#" THEN
qStart(qx) = 1: qEnd = 0: 'No details for this help
ELSE
qStart(qx) = ux
DO WHILE u(ux) <> "#"
ux = ux + 1: IF ux > uMax THEN STOP: 'Bug
LOOP
qEnd(qx) = ux - 1
END IF
RETURN
GetMyKey:
KeyD$ = CHR$(0) + CHR$(80)
KeyU$ = CHR$(0) + CHR$(72)
KeyR$ = CHR$(0) + CHR$(77)
KeyL$ = CHR$(0) + CHR$(75)
KeyH$ = CHR$(0) + CHR$(71)
KeyE$ = CHR$(0) + CHR$(79)
MyKey$ = ""
DO
LOCATE , , 0
K$ = INKEY$
SELECT CASE K$
CASE KeyD$: MyKey$ = "D"
CASE KeyU$: MyKey$ = "U"
CASE KeyR$: MyKey$ = "R"
CASE KeyL$: MyKey$ = "L"
CASE KeyH$: MyKey$ = "H"
CASE KeyE$: MyKey$ = "E"
CASE CHR$(13): MyKey$ = "Enter"
CASE CHR$(27): NewQ = qMax: MyKey$ = "Enter"
END SELECT
LOOP WHILE MyKey$ = ""
RETURN
DoIt:
DidIt = 1
Work$ = SPACE$(39)
hh(1) = "To navigate the prompts:"
hh(2) = " Use the arrow keys to select a prompt"
hh(3) = " (Home and End also work)"
hh(5) = "Whenever a topic is selected, you will"
hh(6) = "see a one-line description of the topic"
hh(8) = "You will also see at the bottom"
hh(9) = "the words 'Press Enter'"
hh(11) = "Do that and you will see more details."
hh(12) = "if there are any."
hh(14) = "To continue, simply use the arrow keys."
hh(15) = "To exit help, ESC or navigate to EXIT."
RETURN
END SUB
SUB SleepWell (n AS INTEGER)
' To avoid case that user is holding down a key
' and thus won't see message
tt = TIMER
DO
K$ = INKEY$
IF LEN(K$) = 1 THEN
cc = cc + 1
K$ = UCASE$(K$)
IF K$ = "A" THEN EXIT DO
END IF
LOOP WHILE TIMER - tt < n
IF (cc < 3) OR (UCASE$(K$) = "A") THEN EXIT SUB: 'Not holding it down
LOCATE 21, 1: PRINT "Press 'A' to acknowledge";
Force ("A")
END SUB
FUNCTION VGer%
DIM Place%(9, 3)
DIM Life AS INTEGER: Life = 150
CONST HSTsuffix$ = ".HST"
CONST HSTprefix$ = "DEFAULT"
fleDefault$ = HSTprefix$ + HSTsuffix$: ' Log of last game played
CONST LastGame$ = "Game.xxx"
CONST GameDat$ = "Game.dat"
CONST GameBoss$ = "Game.bos"
CONST GameHist$ = "HiScores.txt"
DIM Comments(64) AS STRING
DIM CommentX AS INTEGER
CONST GMax = 6
DIM Game(GMax) AS DOUBLE
DIM Save(GMax) AS DOUBLE
DIM Abort(GMax) AS DOUBLE
CONST Seed = 1
CONST CurScore = 2
CONST HiScore = 3
CONST Test = 4
CONST Status = 5
CONST Mulligan = 6
DIM Bonus AS INTEGER
DIM FreeGame AS LONG
DIM SpeedCur AS STRING
DIM SpeedTmp AS STRING
DIM SpeedOld AS STRING
DIM p%(10, 2): 'Prizes
DIM WonPrize AS INTEGER: ' Number of prizes won
'=================== Start program =====================
GOSUB ScoreRead: 'Read in scores, randomizer seed, etc.
FF = FREEFILE
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN GameBoss$ FOR INPUT AS #FF: CLOSE #FF
ON ERROR GOTO 0
IF MyErr = 0 THEN
KILL GameBoss$
ON ERROR GOTO GetMyErr
OPEN fleDefault$ FOR INPUT AS #FF: CLOSE #FF
ON ERROR GOTO 0
IF MyErr > 0 THEN
Game(CurScore) = 0
GOSUB PutGame
CLOSE
PRINT "You had earlier interrupted a game with the Boss key, but"
PRINT "you have erased "; fleDefault$; " so the game can't be restored."
PRINT
PRINT "Sorry, you lost all points. Press spacebar to continue."
WHILE INKEY$ <> " ": WEND
VGer = -1: EXIT FUNCTION
END IF
RestoreGame = 1
END IF
CLS
DO: GOSUB Main: LOOP UNTIL K$ = "X"
VGer = 0
EXIT FUNCTION
ScoreRead:
OPEN GameDat$ FOR RANDOM AS #1 LEN = LEN(Game(0))
GET #1, Test, Game(Test)
IF Game(Test) <> 20031002 THEN
PRINT "New Player detected. Press spacebar"
WHILE INKEY$ <> " ": WEND
CLOSE #1: KILL GameDat$: 'Reset
GOSUB NewSeed: ' Set Game(Seed)
Game(CurScore) = 0
Game(HiScore) = 0
Game(Test) = 20031002
Game(Status) = 0
Game(Mulligan) = 0
OPEN GameDat$ FOR RANDOM AS #1 LEN = LEN(Game(0))
GOSUB ScoreWrite
ELSE
FOR i = 1 TO GMax: GET #1, i, Game(i): NEXT i
END IF
IF SKept = 9999 THEN Game(Mulligan) = 0: PUT #1, Mulligan, Game(Mulligan)
FOR i = 1 TO GMax: Abort(i) = Game(i): NEXT i
IF Game(CurScore) > 0 THEN GOSUB NewSeed
IF SKept < Game(CurScore) THEN Game(CurScore) = SKept
IF SKept = 9999 THEN
INPUT "Cheat or Fix"; SKept
END IF
Game(CurScore) = SKept
RETURN
ScoreWrite:
IF FreeGame > 0 THEN RETURN
SKept = Game(CurScore)
IF (Aborted = 1) OR (Boss > 0) THEN
FOR i = 1 TO 4: PUT #1, i, Abort(i): NEXT i
PUT #1, Status, Game(Status)
ELSEIF (Face$ = QuitFace$) OR (swPlayBack = 1) THEN
FOR i = 1 TO GMax: PUT #1, i, Save(i): NEXT i
ELSE
GOSUB PutGame
END IF
RETURN
PutGame:
IF FreeGame > 0 THEN RETURN
FOR i = 1 TO GMax: PUT #1, i, Game(i): NEXT i
CONST Header1$ = "Score Date and Time"
CONST Header2$ = "----- ----------------"
FF = FREEFILE
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN GameHist$ FOR INPUT AS #FF
LINE INPUT #FF, l$: IF l$ <> Header1$ THEN MyErr = 1
LINE INPUT #FF, l$: IF l$ <> Header2$ THEN MyErr = 1
ON ERROR GOTO 0
CLOSE #FF
ShoScore$ = SPACE$(5)
RSET ShoScore$ = STR$(Game(CurScore))
ShoDate$ = SPACE$(10)
RSET ShoDate$ = DATE$
ShoTime$ = SPACE$(5)
LSET ShoTime$ = TIME$
ShoAll$ = ShoScore$ + " " + ShoDate$ + " " + ShoTime$
IF MyErr > 0 THEN
OPEN GameHist$ FOR OUTPUT AS #FF
PRINT #FF, Header1$
PRINT #FF, Header2$
PRINT #FF, ShoAll$
ELSEIF Game(CurScore) = 0 THEN
OPEN GameHist$ FOR APPEND AS #FF
PRINT #FF, ShoAll$
ELSE
OPEN GameHist$ FOR BINARY AS #FF
PUT #FF, LOF(FF) - 1 - LEN(ShoAll$), ShoAll$
END IF
CLOSE #FF
RETURN
Main: '=====================================================
IF RestoreGame = 0 THEN
LOCATE 21, 1: PRINT "Current Score is";
IF Game(CurScore) < 0 THEN PRINT " ";
PRINT Game(CurScore); " High Score is"; Game(HiScore)
PRINT
PRINT "P=Play H=Help X=";
PRINT "exit R=Recording F=Free Game"
Options$ = "PHXRF"
DO
K$ = GetOption$(Options$)
IF LEN(K$) = 1 THEN K$ = UCASE$(K$) ELSE K$ = "?"
LOOP WHILE INSTR(Options$ + "B", K$) = 0
IF K$ = "B" THEN K$ = "X"
IF K$ = "X" THEN RETURN
IF K$ = "F" THEN GOSUB FreeGameSub: IF FreeGame = 0 THEN RETURN
IF DidIt = 0 THEN DidIt = 1: SCREEN 12: SCREEN 0
IF K$ = "H" THEN CALL McHelp: RETURN
IF K$ = "R" THEN GOSUB Recording: RETURN
IF Game(Status) = 101 THEN GOSUB RCMode
ELSE
OPEN fleDefault$ FOR INPUT AS #2
INPUT #2, AutoSeed#: Game(Seed) = AutoSeed#
INPUT #2, AutoGame$
CLOSE #2
AutoGameX = 1
swPlayBack = 1
IF DidIt = 0 THEN DidIt = 1: SCREEN 12: SCREEN 0
END IF
AutoSeed# = Game(Seed): y = RND(-AutoSeed#)
FOR i = 1 TO GMax: Save(i) = Game(i): NEXT i
WIDTH 40
FF = FREEFILE
OPEN LastGame$ FOR OUTPUT AS #FF
PRINT #FF, STR$(Game(Seed))
CLOSE #FF
GOSUB CreateVariables
DIM MazeLine$(1 TO 22): GOSUB SetWorld
DIM WLife AS INTEGER: WLife = 999
GOSUB InitPrizes
GOSUB StartSmileAtTop
GOSUB StartBadGuy
SELECT CASE Bonus
CASE 2: Bonus = 4
CASE 3: Bonus = 3
CASE 4: Bonus = 2
CASE ELSE: Bonus = 1
END SELECT
GOSUB PrintStats
GOSUB PlayGame
GOSUB ScoreWrite
CLOSE
IF Boss = 0 THEN VGer = -1: EXIT FUNCTION
OPEN GameBoss$ FOR OUTPUT AS #1: CLOSE
IF Boss = 1 THEN VGer = 0: EXIT FUNCTION
CALL McHelp
VGer = -1: EXIT FUNCTION
FreeGameSub:
FreeGame = 0
PRINT "You will play with no score or history"
PRINT "Enter a game number in the range 1-16777216."
PRINT "(Null means you don't want to play a free game)"
PRINT "(" + CHR$(34) + "=" + CHR$(34) + " means play last game)"
DO
LINE INPUT "Game Number: "; K$
IF K$ = "" THEN RETURN
IF K$ = "=" THEN
K$ = ""
FF = FREEFILE
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN LastGame$ FOR INPUT AS #FF
INPUT #FF, K$
ON ERROR GOTO 0
CLOSE #FF
IF MyErr = 0 THEN
FreeGame = VAL(K$): Game(Seed) = FreeGame
ELSE
PRINT "Sorry, there is no 'last game'"
PRINT "Press spacebar"
DO: LOOP WHILE INKEY$ <> " "
END IF
RETURN
END IF
OK = -1
IF LEN(K$) > 8 THEN OK = 0
FOR i = 1 TO LEN(K$)
IF INSTR("0123456789", MID$(K$, i, 1)) = 0 THEN OK = 0
NEXT i
IF OK THEN FreeGame = VAL(K$): Game(Seed) = FreeGame
IF FreeGame > 16777216 THEN FreeGame = 0
LOOP WHILE FreeGame = 0
RETURN
RCMode:
IF FreeGame > 0 THEN RETURN
CLS : PRINT "You are in Recording/Playback Mode": PRINT
PRINT "That simply means that you will get this screen prior to each game. If you are "
PRINT "tired of seeing this screen, then before starting the next game, you should"
PRINT "select the option R and toggle this mode off."
PRINT : PRINT : PRINT "M E N U"
PRINT " 0 No playback - I want to start a NEW GAME"
PRINT " 1 Yes playback - I want to see what I did in an OLD GAME"
PRINT " 2 Yes playback - But I want to enter the game now"
PRINT " 3 ### Just get me out of this menu!"
DO
PRINT
x$ = GetOption$("Option")
LOOP WHILE INSTR("0123", x$) = 0
IF x$ = "2" THEN
PRINT "You enter a 1-8 character game name"
PRINT "Then V'GER will minimize and NOTEPAD will appear"
PRINT "Save your game and close NOTEPAD"
PRINT "You will wonder what happened. V'GER is minimized. Remember?"
PRINT "Click on it and continue...."
GOSUB GetL
IF l$ = "" THEN
x$ = "3": n$ = "": RETURN
ELSE
SHELL "notepad " + x$
NoDefault$ = x$
x$ = "1"
END IF
END IF
IF x$ = "3" THEN Aborted = 1: GOSUB ScoreWrite: VGer = -1: EXIT FUNCTION
swPlayBack = VAL(x$): IF swPlayBack = 0 THEN RETURN
DIM tfile$(100)
SHELL "dir *" + HSTsuffix$ + ">temp.dir"
OPEN "temp.dir" FOR INPUT AS #3
tfileX = 0
Lookfor$ = " " + RIGHT$(UCASE$(HSTsuffix$), 3) + " "
DO WHILE NOT EOF(3)
LINE INPUT #3, l$
IF UCASE$(MID$(l$, 9, 5)) = Lookfor$ THEN
fle$ = UCASE$(RTRIM$(LEFT$(l$, 8)))
IF fle$ = UCASE$(HSTprefix$) THEN GOSUB Default
tfileX = tfileX + 1
tfile$(tfileX) = fle$
END IF
LOOP
CLOSE #3
CLS
PRINT : PRINT : PRINT "M E N U"
PRINT " 0 Never mind, I don't want any game"
FOR i = 1 TO tfileX
si$ = RIGHT$(" " + STR$(i), 4)
PRINT si$; " "; tfile$(i)
NEXT i
PRINT : PRINT "Enter the game you want to run"
DO
LINE INPUT "Game #: "; x$
i = VAL(x$)
IF i = 0 THEN IF x$ <> "0" THEN i = 999
LOOP WHILE i > tfileX
IF i = 0 THEN GOSUB RCMode: RETURN
fleHST$ = tfile$(i) + HSTsuffix$
OPEN fleHST$ FOR INPUT AS #2
LINE INPUT #2, l$
DIM Header$(25)
HeaderX = 0
IF l$ = "#=#" THEN
LINE INPUT #2, l$
DO WHILE l$ <> "#=#"
HeaderX = HeaderX + 1
Header$(HeaderX) = l$
LINE INPUT #2, l$
LOOP
ELSE
CLOSE #2
OPEN fleHST$ FOR INPUT AS #2
END IF
INPUT #2, AutoSeed#: Game(Seed) = AutoSeed#
INPUT #2, AutoGame$
CommentX = 0
DO WHILE NOT EOF(2)
CommentX = CommentX + 1
LINE INPUT #2, Comments(CommentX)
LOOP
CLOSE #2
AutoGameX = 1
CLS : PRINT "Preparing to play "; fleHST$
PRINT
PRINT "Game Header:"
IF HeaderX > 0 THEN
FOR i = 1 TO HeaderX
PRINT SPACE$(10); Header$(i)
NEXT i
ELSE
PRINT SPACE$(10); "There is no header for this game"
PRINT SPACE$(10); "You will be be given a chance to add one later"
END IF
PRINT : PRINT : PRINT "M E N U"
PRINT " 1 OK - Start playback of "; fleHST$
PRINT " 2 Never mind"
DO
PRINT
x$ = GetOption$("Option")
LOOP WHILE (x$ <> "1") AND (x$ <> "2")
IF x$ = "2" THEN GOSUB RCMode
RETURN
Default:
IF NoDefault$ <> "" THEN RETURN
PRINT "The results of last game are in "; fleDefault$: PRINT
PRINT "If you want to rename this, enter a new name at the prompt"
PRINT "Else just enter nothing"
GOSUB GetL
IF l$ = "" THEN RETURN
NAME fleDefault$ AS x$
fle$ = LTRIM$(l$)
RETURN
GetL:
DO
LINE INPUT "New Name: ", l$
IF l$ = "" THEN RETURN
x$ = LTRIM$(l$) + HSTsuffix$
l = 1: 'In case of bad file name
MyErr = 0: ON ERROR GOTO GetMyErr
OPEN x$ FOR BINARY AS #4: l = LOF(4): CLOSE #4
ON ERROR GOTO 0
IF MyErr > 0 THEN
PRINT "Error: Bad filename"
ELSEIF l > 0 THEN
PRINT "There is already such a file!"
MyErr = 1
ELSE
KILL x$
END IF
LOOP WHILE MyErr > 0
RETURN
Recording:
CLS : x$ = "Recording/Playback Mode (RP-Mode)"
LOCATE 5, 20: PRINT x$: LOCATE 6, 20: PRINT STRING$(LEN(x$), "=")
PRINT : PRINT
PRINT "When you are in RP-Mode, you will be prompted at the start of"
PRINT "each game to decide which recording or playback options apply."
PRINT : PRINT
SELECT CASE Game(Status)
CASE 101:
PRINT "RP-Mode is ON"
PRINT " 1 - Leave it ON"
PRINT " 2 - Turn it OFF"
CASE ELSE:
PRINT "RP-Mode is OFF"
PRINT " 1 - Turn it ON"
PRINT " 2 - Leave it OFF"
PRINT
END SELECT
LOCATE , , 1: PRINT "Press 1(ON) or 2(OFF): ";
DO: K$ = Get1$: LOOP WHILE INSTR("12", K$) = 0
IF K$ = "2" THEN Game(Status) = 0 ELSE Game(Status) = 101
Save(Status) = Game(Status)
RETURN
SetWorld:
FOR l = 1 TO 22
FOR c = 1 TO 40
x = RND * 10
IF x < 2 THEN
MazeLine$(l) = MazeLine$(l) + "±"
ELSE
MazeLine$(l) = MazeLine$(l) + " "
END IF
NEXT c
NEXT l
FOR l = 1 TO 22
PRINT MazeLine$(l)
NEXT l
RETURN
InitPrizes:
cnt = 0
DO
l = 1 + FIX(22 * RND)
c = 1 + FIX(40 * RND)
IF MID$(MazeLine$(l), c, 1) = " " THEN
cnt = cnt + 1
p%(cnt, 1) = l: p%(cnt, 2) = c
LOCATE l, c: PRINT CHR$(4);
END IF
LOOP UNTIL cnt > 9
FOR i = 1 TO 9
FOR j = i TO 10
IF p%(i, 1) > p%(j, 1) THEN
SWAP p%(i, 1), p%(j, 1)
SWAP p%(i, 2), p%(j, 2)
END IF
NEXT j
NEXT i
FOR i = 1 TO 9
FOR j = i TO 10
IF p%(i, 1) = p%(j, 1) THEN
IF p%(i, 2) > p%(j, 2) THEN
SWAP p%(i, 1), p%(j, 1)
SWAP p%(i, 2), p%(j, 2)
END IF
END IF
NEXT j
NEXT i
Bonus = 1
FOR i = 2 TO 10
IF (p%(i, 1) = p%(i - 1, 1)) THEN
IF (p%(i, 2) = p%(i - 1, 2)) THEN
Bonus = Bonus + 1
END IF
END IF
NEXT i
RETURN
InsertComment:
SCREEN , , 1, 1
CLS
PRINT "Enter a one-line comment. This comment"
PRINT "will appear at the bottom of the screen"
PRINT "whenever you are doing future playbacks"
PRINT
PRINT "(Just hit enter if you want no comment)"
DO
PRINT : PRINT "Enter one-line comment below:"
PRINT
LINE INPUT "", c$
LOOP WHILE LEN(c$) > 39
SCREEN , , 0, 0
IF c$ = "" THEN RETURN
CommentX = CommentX + 1
Comments(CommentX) = c$
c$ = CHR$(CommentX + 96)
IF AutoGameX = 1 THEN
AutoGame$ = c$ + AutoGame$
ELSE
x$ = LEFT$(AutoGame$, AutoGameX - 1)
AutoGame$ = x$ + c$ + RIGHT$(AutoGame$, LEN(AutoGame$) - AutoGameX + 1)
END IF
AutoGameX = AutoGameX + 1
RETURN
ShowComment:
LOCATE 25, 1
PRINT Comments$(ASC(x$) - 96);
'Rest of routine is to ensure user has time to see the comment
'as verified by user entering 'R'
'First, give the user a chance to enter 'R'
mt = TIMER
DO
K$ = INKEY$
IF UCASE$(K$) = "R" THEN EXIT DO
LOOP WHILE TIMER - mt < 2
IF K$ = "" THEN K$ = Get1$
'OK, either user entered 'R' or time's up, he needs a prompt
IF UCASE$(K$) <> "R" THEN
LOCATE 24, 1: PRINT "Press 'R' to resume";
DO: K$ = Get1$: LOOP WHILE K$ <> "R"
END IF
LOCATE 24, 1: PRINT SPACE$(20);
LOCATE 25, 1: PRINT SPACE$(39);
StackSpace = 1
RETURN
GetXSub:
IF (swPlayBack = 1) AND (RestoreGame = 1) AND (AutoGameX > LEN(AutoGame$)) THEN swPlayBack = 0
IF swPlayBack = 1 THEN
DO
IF RestoreGame = 1 THEN
K$ = " "
ELSE
IF StackSpace = 1 THEN
StackSpace = 0: K$ = " "
ELSE
K$ = Get1$
END IF
END IF
IF UCASE$(K$) = "R" THEN K$ = " "
SELECT CASE K$
CASE " ":
IF AutoGameX > LEN(AutoGame$) THEN x$ = ESC$: RETURN
x$ = MID$(AutoGame$, AutoGameX, 1)
IF x$ = "Z" THEN
Face$ = QuitFace$
LOCATE FaceLine, FaceCol, 0: PRINT Face$;
AutoGameX = AutoGameX + 1
RETURN
END IF
IF ASC(x$) > 90 THEN
GOSUB ShowComment
x$ = " "
ELSE
x$ = CHR$(0) + x$
END IF
AutoGameX = AutoGameX + 1
RETURN
CASE ESC$: x$ = K$: RETURN
CASE "c": GOSUB InsertComment
CASE "C": GOSUB InsertComment
END SELECT
LOOP
END IF
DO
DO
IF swPlayBack = 0 THEN
DEF SEG = &H40
p% = PEEK(&H17) AND 64
DEF SEG
IF p% = 64 THEN SpeedTmp = "Slow" ELSE SpeedTmp = "Fast"
IF SpeedTmp <> SpeedOld THEN
SpeedCur = SpeedTmp
SpeedOld = SpeedTmp
LOCATE 24, 10: PRINT SpeedCur;
END IF
END IF
x$ = UCASE$(INKEY$)
LOOP WHILE x$ = ""
IF x$ = "X" THEN x$ = "B"
IF FreeGame > 0 THEN
IF (x$ = "B") OR (x$ = "Q") THEN x$ = ESC$
IF x$ = ESC$ THEN RETURN
END IF
IF x$ = "B" THEN Boss = 1: x$ = ESC$: RETURN
IF x$ = "H" THEN Boss = 2: x$ = ESC$: RETURN
IF x$ = ESC$ THEN
IF (xCnt < 2) OR (Face$ = QuitFace$) THEN
cc$ = "1 point"
ELSE
cc$ = "all your points"
END IF
SCREEN , , 1, 1
CLS
PRINT "1 = Exit now and get a new game."
PRINT " You will lose "; cc$
PRINT
PRINT "2 = Return to game."
PRINT " (You hit ESC by accident)"
PRINT
PRINT "3 = Boss is coming"
PRINT " (In the future, just hit 'B')"
PRINT
DO
x$ = GetOption$("Option")
LOOP WHILE INSTR("123", x$) = 0
IF x$ = "3" THEN x$ = "1": Boss = 1 ELSE SCREEN , , 0, 0
IF x$ = "2" THEN x$ = "?" ELSE x$ = ESC$
END IF
IF (x$ = "Q") THEN
IF xCnt < 2 THEN
Face$ = QuitFace$
quitmark = 1
LOCATE FaceLine, FaceCol, 0: PRINT Face$;
x$ = ""
ELSE
LOCATE 24, 1: PRINT "Q only valid on first two moves";
LOCATE 25, 1: PRINT "Hit spacebar";
WHILE INKEY$ <> " ": WEND
LOCATE 24, 1: PRINT SPACE$(39);
LOCATE 25, 1: PRINT SPACE$(39);
END IF
END IF
LOOP WHILE x$ = ""
RETURN
GetX:
IF Delay1 THEN
Delay1 = 0
IF tt = 0 THEN tt = TIMER
DO: x$ = INKEY$: LOOP WHILE TIMER - tt < .5
tt = TIMER
END IF
GOSUB GetXSub
IF x$ = ESC$ THEN RETURN
DEF SEG = &H40
IF PEEK(&H17) AND 32 = 32 THEN
SELECT CASE x$
CASE "7": x$ = CHR$(0) + CHR$(MoveUL)
CASE "8": x$ = CHR$(0) + CHR$(MoveUp)
CASE "9": x$ = CHR$(0) + CHR$(MoveUR)
CASE "4": x$ = CHR$(0) + CHR$(MoveLt)
CASE "6": x$ = CHR$(0) + CHR$(MoveRt)
CASE "1": x$ = CHR$(0) + CHR$(MoveDL)
CASE "2": x$ = CHR$(0) + CHR$(MoveDn)
CASE "3": x$ = CHR$(0) + CHR$(MoveDR)
END SELECT
END IF
DEF SEG
IF SpeedCur = "Slow" THEN Delay1 = -1
RETURN
PlayGame:
HistNew$ = ""
DO
GOSUB GetX
IF x$ = ESC$ THEN GOSUB ProcessESC ELSE GOSUB ProcessX
LOOP UNTIL Zapped = 1 OR x$ = ESC$
IF (swPlayBack = 0) OR (Boss > 0) THEN
OPEN fleDefault$ FOR OUTPUT AS #2
WRITE #2, AutoSeed#
PRINT #2, HistNew$
ELSE
IF HeaderX = 0 THEN GOSUB NewHeader
OPEN fleHST$ FOR OUTPUT AS #2
IF HeaderX > 0 THEN
PRINT #2, "#=#"
FOR i = 1 TO HeaderX
PRINT #2, Header$(i)
NEXT i
PRINT #2, "#=#"
END IF
WRITE #2, AutoSeed#
PRINT #2, AutoGame$
FOR i = 1 TO CommentX
PRINT #2, Comments(i)
NEXT i
END IF
CLOSE #2
IF WonPrize < 10 THEN RETURN
IF Face$ = NormalFace$ THEN
GOSUB UpdateScore
SELECT CASE Game(CurScore)
CASE IS < 5: p$ = "You won"
CASE IS < 10: p$ = "Doing good"
CASE IS < 20: p$ = "Doing great"
CASE IS < 100: p$ = "Master"
CASE IS < 200: p$ = "Grand Master"
CASE IS < 300: p$ = "Master Emeritus"
CASE IS < 400: p$ = "Guru"
CASE ELSE: p$ = "Unbelievable"
END SELECT
p$ = "*** " + p$ + "! ***"
q$ = STRING$(LEN(p$), "*")
BadGuyCol = BadGuyCol - (LEN(p$) / 2)
IF BadGuyCol > Right - LEN(p$) THEN BadGuyCol = Right - LEN(p$) + 1
IF BadGuyCol < 1 THEN BadGuyCol = 1
BadGuyLine = BadGuyLine - 1
IF BadGuyLine > Bottom - 2 THEN BadGuyLine = Bottom - 2
IF BadGuyLine < 1 THEN BadGuyLine = 1
LOCATE BadGuyLine, BadGuyCol: PRINT q$
LOCATE , BadGuyCol: PRINT p$: LOCATE , BadGuyCol: PRINT q$
ELSE
LOCATE 1, 1: PRINT "Too bad you Quit - You lose 1 point"
END IF
IF Playback = 0 THEN SleepWell 2
RETURN
UpdateScore:
IF swPlayBack = 1 THEN RETURN
IF Bonus = 0 THEN RETURN
IF Face$ = NormalFace$ THEN
Game(CurScore) = Game(CurScore) + Bonus
IF Game(CurScore) > Game(HiScore) THEN Game(HiScore) = Game(CurScore)
ELSE
Game(CurScore) = Game(CurScore) - 1
END IF
Bonus = 0
RETURN
NewHeader:
COLOR 7
LOCATE 25, 1: PRINT "Press 'H' to continue";
Force "H"
SCREEN , , 1, 1
CLS
PRINT "There is no Header for this game"
PRINT : PRINT "Please provide one now, if you want"
PRINT : PRINT "An empty line will terminate your input"
PRINT
LINE INPUT "", l$
DO WHILE l$ <> ""
HeaderX = HeaderX + 1
Header$(HeaderX) = l$
LINE INPUT "", l$
LOOP
SCREEN , , 0, 0
RETURN
ProcessESC:
IF Boss > 0 THEN Zapped = 1: RETURN
IF (xCnt > 2) AND (Face$ = NormalFace$) THEN
LSET Stats$ = "YOU RESIGNED, SO YOU LOSE!"
GOSUB NoMoScore
RETURN
END IF
LSET Stats$ = "Game reset at cost of 1 game"
Game(CurScore) = Game(CurScore) - 1
GOSUB NewSeed
GOSUB Adios
RETURN
NewSeed:
IF GotTime = 0 THEN GotTime = 1: RANDOMIZE TIMER
Game(Seed) = RND * 16777216
RETURN
NoMoScore:
IF swPlayBack = 0 AND Game(CurScore) > 0 THEN
IF Game(Mulligan) <> 1 THEN ZappedScore = Game(CurScore)
Game(CurScore) = 0
Game(Mulligan) = 0: Save(Mulligan) = 0: Abort(Mulligan) = 0
END IF
Adios:
LOCATE 23, 1: PRINT Stats$;
IF Playback = 0 THEN SleepWell 3
IF Life < 1 THEN GOSUB PrintBlob
Zapped = 1
IF ZappedScore > 0 THEN
CLS
LOCATE 5, 15: PRINT "Mulligan": LOCATE 10, 10
LOCATE 8, 1
PRINT "You can keep your score this time, but "
PRINT "next time it goes to zero!"
LOCATE 11, 1
PRINT "(Or, if you want, you can just take your"
PRINT "zero now and get it over with.)"
LOCATE 18, 2
PRINT "Do you want to take your Mulligan?"
DO
LINE INPUT "Y/N: "; a$: IF LEN(a$) <> 1 THEN a$ = "x"
LOOP WHILE INSTR("yYnN", a$) = 0
IF UCASE$(a$) = "Y" THEN
Game(CurScore) = ZappedScore
Game(Mulligan) = 1: Save(Mulligan) = 1: Abort(Mulligan) = 1
END IF
END IF
RETURN
ProcessX:
l = ASC(LEFT$(x$, 1))
R = ASC(RIGHT$(x$, 1))
IF l = 0 THEN
IF quitmark = 1 THEN quitmark = 0: HistNew$ = HistNew$ + "Z"
HistNew$ = HistNew$ + RIGHT$(x$, 1)
OldFaceLine = FaceLine
OldFaceCol = FaceCol
SELECT CASE R
CASE MoveUL: GOSUB CheckMoveUL
CASE MoveUp: GOSUB CheckMoveUp
CASE MoveUR: GOSUB CheckMoveUR
CASE MoveLt: GOSUB CheckMoveLt
CASE MoveRt: GOSUB CheckMoveRt
CASE MoveDL: GOSUB CheckMoveDL
CASE MoveDn: GOSUB CheckMoveDn
CASE MoveDR: GOSUB CheckMoveDR
CASE ELSE: RETURN
END SELECT
GOSUB MoveBadGuy
GOSUB GOTCHA
IF WonPrize < 10 THEN Life = Life - 1
GOSUB PrintStats
END IF
RETURN
MoveBadGuy:
IF WonPrize = 10 THEN GOSUB BadGuyDies: RETURN
xCnt = xCnt + 1
IF FaceLine > BadGuyLine THEN
TempBadGuyLine = BadGuyLine + 1
ELSEIF FaceLine < BadGuyLine THEN
TempBadGuyLine = BadGuyLine - 1
ELSE
TempBadGuyLine = BadGuyLine
END IF
IF FaceCol > BadGuyCol THEN
TempBadGuyCol = BadGuyCol + 1
ELSEIF FaceCol < BadGuyCol THEN
TempBadGuyCol = BadGuyCol - 1
ELSE
TempBadGuyCol = BadGuyCol
END IF
IF MID$(MazeLine$(TempBadGuyLine), TempBadGuyCol, 1) = " " THEN
GOSUB MoveNow
ELSE
GOSUB TryOtherPlaces
END IF
RETURN
BadGuyDies:
IF (WLife < 10) AND (Life < 10) THEN
l$ = "": FOR i = 1 TO 7: l$ = l$ + "Lucky! ": NEXT i
COLOR 5, 3
FOR i = 39 TO 1 STEP -1
LOCATE 25, i
PRINT LEFT$(l$, 40 - i);
t = TIMER + .4: WHILE t > TIMER: WEND
NEXT i
COLOR 7, 0
LOCATE 25, 1: PRINT SPACE$(39);
LOCATE 25, 5: PRINT "Yep, Luck is better than skill!";
t = TIMER + 2: WHILE t > TIMER: WEND
LOCATE 25, 1: PRINT SPACE$(39);
END IF
GOSUB UpdateScore
GOSUB PrintStats
COLOR 3, 4
B$ = "X": GOSUB BlinkB
t = TIMER + 1: WHILE t > TIMER: WEND
FOR i = 1 TO 10
COLOR 3, 4
B$ = CHR$(15): GOSUB BlinkB
COLOR 7, 14
B$ = CHR$(21): GOSUB BlinkB
NEXT i
COLOR 7, 0
LOCATE FaceLine, FaceCol: PRINT " ";
B$ = " ": GOSUB BlinkB
RETURN
BlinkB:
LOCATE BadGuyLine, BadGuyCol
PRINT B$;
t = TIMER: WHILE t = TIMER: WEND
RETURN
TryOtherPlaces: 'Compute all places BadGuy can move and pick one
w% = 0: kMin = 999
FOR i = BadGuyLine - 1 TO BadGuyLine + 1
IF (i > 0) AND (i < 23) THEN
FOR j = BadGuyCol - 1 TO BadGuyCol + 1
IF (j > 0) AND (j < 41) THEN GOSUB Save1
NEXT j
END IF
NEXT i
IF w% = 0 THEN RETURN: ' Bad guy is surrounded. You win!
FOR i = 1 TO w%
IF kMin = Place%(i, 3) THEN
TempBadGuyLine = Place%(i, 1)
TempBadGuyCol = Place%(i, 2)
GOSUB MoveNow
RETURN
END IF
NEXT i
STOP: 'Should never get here
Save1:
IF MID$(MazeLine$(i), j, 1) <> " " THEN RETURN
IF (i + j = 0) THEN RETURN
IF (i = BadGuyLine) AND (j = BadGuyCol) THEN RETURN
w% = w% + 1
Place%(w%, 1) = i
Place%(w%, 2) = j
K = ABS(FaceLine - i) + ABS(FaceCol - j)
IF K < kMin THEN kMin = K
Place%(w%, 3) = K
RETURN
ComputePrizeGone:
PrizeGone = 0
FOR i = 1 TO 10
IF (p%(i, 1) = l) AND (p%(i, 2) = c) THEN
p%(i, 1) = 0: p%(i, 2) = 0
PrizeGone = 1
EXIT FOR
END IF
NEXT i
RETURN
MoveFace:
LOCATE OldFaceLine, OldFaceCol: PRINT " ";
GOSUB ComputePrizeGone
WonPrize = WonPrize + PrizeGone
IF WonPrize = 10 THEN COLOR 15, 3
LOCATE l, c: PRINT Face$
COLOR 7, 0
FaceLine = l
FaceCol = c
RETURN
Warp:
DO
DO
l = INT(RND * (Bottom - 1)) + 2
c = INT(RND * (Right - 1)) + 2
LOOP UNTIL MID$(MazeLine$(l), c, 1) = " "
LOOP UNTIL NOT ((ABS(l - BadGuyLine) < 3) AND (ABS(c - BadGuyCol) < 3))
GOSUB MoveFace
WLife = Life
RETURN
GOTCHA:
IF WonPrize = 10 THEN Zapped = 1: RETURN
IF Life < 1 THEN
LSET Stats$ = "UH, OH! NO MORE LIFE. BYE, BYE!"
GOSUB NoMoScore
ELSEIF ABS(FaceLine - BadGuyLine) < 2 AND ABS(FaceCol - BadGuyCol) < 2 THEN
Life = 0: LSET Stats$ = SPACE$(20) + "GOTCHA !!!!!!"
GOSUB NoMoScore
END IF
RETURN
CheckMoveUL:
IF FaceLine > Top AND FaceCol > Left THEN
IF MID$(MazeLine$(FaceLine - 1), FaceCol - 1, 1) = " " THEN
l = FaceLine - 1: c = FaceCol - 1: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveUp:
IF FaceLine > Top THEN
IF MID$(MazeLine$(FaceLine - 1), FaceCol, 1) = " " THEN
l = FaceLine - 1: c = FaceCol: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveUR:
IF FaceLine > Top AND FaceCol < Right THEN
IF MID$(MazeLine$(FaceLine - 1), FaceCol + 1, 1) = " " THEN
l = FaceLine - 1: c = FaceCol + 1: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveLt:
IF FaceCol > Left THEN
IF MID$(MazeLine$(FaceLine), FaceCol - 1, 1) = " " THEN
l = FaceLine: c = FaceCol - 1: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveRt:
IF FaceCol < Right THEN
IF MID$(MazeLine$(FaceLine), FaceCol + 1, 1) = " " THEN
l = FaceLine: c = FaceCol + 1: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveDL:
IF FaceLine < Bottom AND FaceCol > Left THEN
IF MID$(MazeLine$(FaceLine + 1), FaceCol - 1, 1) = " " THEN
l = FaceLine + 1: c = FaceCol - 1: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveDn:
IF FaceLine < Bottom THEN
IF MID$(MazeLine$(FaceLine + 1), FaceCol, 1) = " " THEN
l = FaceLine + 1: c = FaceCol: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
CheckMoveDR:
IF FaceLine < Bottom AND FaceCol < Right THEN
IF MID$(MazeLine$(FaceLine + 1), FaceCol + 1, 1) = " " THEN
l = FaceLine + 1: c = FaceCol + 1: GOSUB MoveFace
END IF
ELSE
GOSUB Warp
END IF
RETURN
END FUNCTION
This message has been edited by iorr5t on Mar 13, 2006 4:04 PM This message has been edited by iorr5t on Mar 13, 2006 4:02 PM This message has been edited by iorr5t on Aug 28, 2005 10:05 AM This message has been edited by iorr5t on Jul 15, 2005 9:49 AM This message has been edited by iorr5t on Jul 15, 2005 9:48 AM This message has been edited by iorr5t on Jun 21, 2005 9:12 AM This message has been edited by iorr5t on Jun 21, 2005 9:11 AM This message has been edited by iorr5t on May 11, 2005 10:09 AM This message has been edited by iorr5t on May 10, 2005 10:23 AM This message has been edited by iorr5t on Apr 27, 2005 7:27 AM This message has been edited by iorr5t on Apr 27, 2005 7:26 AM This message has been edited by iorr5t on Apr 27, 2005 7:25 AM This message has been edited by iorr5t on Feb 2, 2005 8:19 AM This message has been edited by iorr5t on Nov 30, 2004 6:07 AM This message has been edited by iorr5t on Nov 22, 2004 4:45 PM This message has been edited by iorr5t on Nov 14, 2004 7:46 AM This message has been edited by iorr5t on Sep 12, 2004 8:59 AM This message has been edited by iorr5t on Aug 22, 2004 3:07 PM This message has been edited by iorr5t on May 30, 2004 7:39 AM This message has been edited by iorr5t on Mar 28, 2004 9:14 AM This message has been edited by iorr5t on Mar 16, 2004 9:33 AM This message has been edited by iorr5t on Mar 16, 2004 9:21 AM This message has been edited by iorr5t on Mar 13, 2004 9:40 AM This message has been edited by iorr5t on Mar 10, 2004 8:55 AM This message has been edited by iorr5t on Feb 7, 2004 2:11 AM This message has been edited by iorr5t on Jan 22, 2004 11:37 AM This message has been edited by iorr5t on Jan 5, 2004 6:05 AM