Hello, everyone.

I am Michael Calkins. I am currently 18 years old, but almost 19. I live in a rural area of South Texas about 30 miles south of San Antonio.

My interests include computer usage, repair, maintenence, and programming; firearms, especially semi-automatic rifles; hunting feral hogs; recreational bicycling; baseball; etc. As you can tell from the Distractions subforum, I am one of Jehovah's Witnesses, and am therefore deeply interested in the Bible.

When I was about 7 or 8, (I can't remember when exactly, but I was pretty young) my family bought a 286 with MS-DOS 5. It had a MDA with an amber monitor, Word Perfect 5.1, and several old DOS games. That computer's harddrive eventually failed, and all the data on it, except a few of my text files that I had backed up. I only have a few files left from those days.

Our family eventually got more PCs. I remember playing Nibbles fairly early. I remember liking to play Gorrilas on my Dad's 286, because it was the only one with a CGA.

Most of my computer usage involved playing MS-DOS games, or writing dozens and dozens of plain text files for many purposes, from schoolwork to documents for an imaginary club of mine.

Early on, I developed an interest in MS-DOS Batch programs. It wasn't until later that I actually tried doing anything in QBASIC.

I also remember our first Windows computer. It was a Packerd Bell 486 running Windows 3.11 (Workgroups.) It had fun games, like Rodent's Revenge, Ski Free, etc. Ah, those were the days!

Well, so much for rambling about my early expirience.

Anyway. I have been using QBASIC for about 7 or 8 years. I have been using assembly for less than a year.

Some info about my programming history can be found here:

http://www.network54.com/Forum/message?forumid=13959&messageid=1119588506

Regards,
Michael

There was an old DOS game called Chase, where you are in a dirt filled room. You start out right next to a square that has an assortment of bad guys. You are given a period of time to dig your way away from them before they start moving. You dig in certain patterns to confuse specific types of bad guys. If they touch you, you are dead. If you caused the screen to scroll, all the bad guys missed their turn. That game worked well on my 286, and I had fun playing it. Unfortuanetly, that game has serious timing problems on faster computers, even 486s. So what do I do? I write my own. :-)

My game has several advantages over the one it is based on. It gives you an initial option, for example, to have a certain percentage of the squares already cleared. This makes it much easier to create tunnels that can confuse the bad guys.

The old game had several types of bad guys. I have written my own bad guys, some of which do not at all resemble the ones in that other game. For example, in my game, you drag a trail behind you that will lead the hound characters right to you, if they stumble onto it. The other game had no such trails. I also added specific characters that cling to the walls.

Each type of the bad guys has certain characteristics. These are determined by what some of you might call "artificial intelligence".

I have the option to save and restore games.

It has been several years since I have made any changes to this game. I can't even remember when I really played it last, except for today. I haven't even looked at the code. I am sure that there are a million improvements possible. There are no doubt many areas that should be optimized. With my current knowledge of assembly, it could be made color without sacrificing speed, but I'm not going to mess with it.

Well, here it is. I don't know if it has bugs. I don't even remember all the characters. It is freeware, and you can modify it and/or copy parts of it. Please include credit to me if you use any substantial part of it, or if you redistribute the game. Enjoy.

P.S. Just because I don't really plan on modifying it now doesn't mean I wouldn't appreciate bug reports. As always, if you find any bugs, please let me know. Thanks.

Regards,
Michael

'Written by Michael Calkins. "mcalkins0@hotmail.com"
' $DYNAMIC
DECLARE SUB getpath ()
DECLARE SUB upd ()
DECLARE SUB ld ()
DECLARE FUNCTION choice$ (pr$, c1$, c2$, c3$, c4$, c5$, c6$, c7$, c8$, c9$, c10$)
DECLARE SUB relocate (x%, y%, i%)
DECLARE SUB viewf ()
DECLARE FUNCTION wt% (x%, y%)
DECLARE FUNCTION exist% (efile$)
DECLARE FUNCTION ads% (n%, s%)
DECLARE FUNCTION ss% (n%, s%)
DECLARE SUB comp ()
DECLARE FUNCTION sit% (i%)
DECLARE FUNCTION getd$ (x%, y%)
DECLARE SUB assign (x%, y%, n$)
DECLARE SUB make ()
DECLARE SUB drwscr ()
RANDOMIZE TIMER
ON ERROR GOTO term
DIM SHARED sizex%
DIM SHARED sizey%
DIM SHARED delay&
DIM SHARED snd%
DIM SHARED tl%
DIM SHARED fgc%, bgc%
DIM SHARED trans%(0 TO 1)
DIM SHARED start%(0 TO 3)
DIM SHARED quan%(0 TO 2)
DIM SHARED path$
sizex% = 130
sizey% = 50
delay& = 0
snd% = 0
tl% = 40
fgc% = 7
bgc% = 0
start%(0) = 10
start%(1) = 12
start%(2) = 11
start%(3) = 12
trans%(0) = 1
trans%(1) = 500
quan%(0) = 5
quan%(1) = 30
quan%(2) = 5
getpath
IF exist%(path$ + "chase2.dat") = 0 THEN
 upd
ELSE
 ld
END IF
DIM SHARED nexis%
DIM SHARED hx%
DIM SHARED hy%
DIM SHARED over%
DIM SHARED map$
DIM SHARED offx%
DIM SHARED offy%
TYPE enemytype
 x AS INTEGER
 y AS INTEGER
 px AS INTEGER
 py AS INTEGER
 dat AS INTEGER
 smart AS INTEGER
END TYPE
DIM SHARED enemy(0 TO 80) AS enemytype
DIM SHARED counter%
DIM SHARED first%
TYPE tt
 x AS INTEGER
 y AS INTEGER
 dat AS INTEGER
END TYPE
DIM SHARED trail(1 TO tl%) AS tt
DIM SHARED tm%
DIM SHARED per%
when% = 60
bt% = tl%
bw% = when%
COLOR fgc%, bgc%: CLS
10 over% = 0
WHILE INKEY$ <> "": WEND
PRINT "During game play, 'ESC' quits, 'P' pauses, 'T' toggles trail mode, and 'S'"
PRINT "toggles sound."
PRINT "--- Chase ---"
PRINT "1 - New game"
PRINT "2 - Load saved game"
PRINT "3 - Options"
PRINT "4 - Exit"
SELECT CASE choice$("Your choice", "1", "2", "3", "4", "", "", "", "", "", "")
CASE "2": LINE INPUT "('' for main menu.) Load saved game: "; f$
 IF f$ = "" THEN CLS : GOTO 10
 GOSUB loadg
CASE "3"
 DO
  CLS
  PRINT "--- Options ---"
  PRINT "1 - Colors"
  PRINT "2 - Sound"
  PRINT "3 - Field size"
  PRINT "4 - Time delay"
  PRINT "5 - Trail legnth"
  PRINT "6 - Transporter mode"
  PRINT "7 - Enemy quantities"
  PRINT "8 - Restore defaults"
  PRINT "9 - Return to main menu"
  SELECT CASE choice$("Your choice", "1", "2", "3", "4", "5", "6", "7", "8", "9", "")
  CASE "1": COLOR 7, 0: CLS
   FOR i% = 0 TO 15
    COLOR 7: LOCATE 1, 1 + i% * 5: PRINT i%
    COLOR i%: LOCATE 2, 1 + i% * 5: PRINT "ÛÛÛÛÛ";
   NEXT i%
   COLOR 7
   PRINT "Select a foreground color from 0 to 15 and a background color from 0 to 7."
   PRINT "Example: '7,0' is white and black."
   INPUT "Foreground color, background color"; fgc%, bgc%
   COLOR fgc%, bgc%
  CASE "2": PRINT : PRINT "Current sound status:"; snd%
   snd% = VAL(choice$("(0 for off, 1 for on.) Sound", "0", "1", "", "", "", "", "", "", "", ""))
  CASE "3": PRINT : PRINT "Current field size:  X:"; sizex%; " Y:"; sizey%
   INPUT "x,y"; sizex%, sizey%
   PRINT "Current enemy start:  X:"; start%(0); " Y:"; start%(1)
   PRINT "Current human start:  X:"; start%(2); " Y:"; start%(3)
   DO
    PRINT "Both starts must be contained in the field and be contiguous to each other."
    INPUT "(x,y) Enemy start"; start%(0), start%(1)
    INPUT "(x,y) Human start"; start%(2), start%(3)
    IF start%(0) <= sizex% AND start%(1) <= sizey% AND start%(2) <= sizex% AND start%(3) <= sizey% AND ABS(start%(0) - start%(2)) < 2 AND ABS(start%(1) - start%(3)) < 2 AND (start%(0) <> start%(2) OR start%(1) <> start%(3)) THEN EXIT DO
   LOOP
  CASE "4": PRINT : PRINT "Current delay:"; delay&: PRINT "The larger the number, the longer the delay."
   INPUT "Time delay"; delay&
  CASE "5": PRINT : PRINT "In the game, the 'þ' enemies can follow a trail left by you when you move"
   PRINT "through the field. The longer this trail is, the harder the game and the slower"
   PRINT "the game play (Longer trails take longer to process.)."
   PRINT "Current trail legnth:"; tl%
   INPUT "(Trail length subject to rounding.) Trail length"; tl%
   tl% = INT(tl% / 5 + .5) * 5
   IF tl% < 20 THEN tl% = 20
   bt% = tl%
   REDIM SHARED trail(1 TO tl%) AS tt
   PRINT "New trail legnth:"; tl%
   SLEEP: WHILE INKEY$ <> "": WEND
  CASE "6": PRINT : PRINT "The transporter ('') is an enemy that periodicly moves to mostly random"
   PRINT "positions and can transport the '
' enemies. When it moves it can land on both"
   PRINT "blank spaces (' ') or edible walls ('°'). The transporter has two modes. In"
   PRINT "mode 0, when it moves off a space that was '°', it restores that space to '°'."
   PRINT "In mode 1, when it moves off a space, that space will become blank regardless"
   PRINT "of it's previous status."
   PRINT "Current transporter mode:"; trans%(0)
   trans%(0) = VAL(choice$("New mode", "0", "1", "", "", "", "", "", "", "", ""))
   PRINT
   PRINT "How often the transporter moves is set by a ratio of transporter moves to"
   PRINT "speeder ('¯') moves."
   PRINT "Current ratio is"; trans%(1); "to 1, a quotient of"; trans%(1)
   INPUT "New quotient"; trans%(1)
   IF trans%(0) <> 0 THEN trans%(0) = 1
   IF trans%(1) < 1 THEN trans%(1) = 1
  CASE "7": PRINT : PRINT "You can change the quantity of three types of enemies."
   PRINT "Speeder ('¯'). This enemy moves quickly and completely randomly."
   PRINT "Current speeder quanity:"; quan%(0)
   INPUT "(Choose 2 to 10) New quanity"; quan%(0)
   PRINT
   PRINT "Happy guy ('
'). This enemy moves slowly and semi-randomly."
   PRINT "Current happy guy quanity:"; quan%(1)
   INPUT "(Choose 10 to 50) New quanity"; quan%(1)
   PRINT
   PRINT "Hound ('þ'). This enemy moves fairly quickly and semi-randomly until on you"
   PRINT "trail."
   PRINT "Current hound quanity:"; quan%(2)
   INPUT "(Choose 2 to 10) New quanity"; quan%(2)
   IF quan%(0) < 2 THEN quan%(0) = 2
   IF quan%(0) > 10 THEN quan%(0) = 10
   IF quan%(1) < 10 THEN quan%(1) = 10
   IF quan%(1) > 50 THEN quan%(1) = 50
   IF quan%(2) < 2 THEN quan%(2) = 2
   IF quan%(2) > 10 THEN quan%(2) = 10
  CASE "8": PRINT
   IF choice$("Are you sure you want to restore the default settings", "Y", "N", "", "", "", "", "", "", "", "") = "Y" THEN
    sizex% = 130
    sizey% = 50
    delay& = 0
    snd% = 0
    tl% = 40
    fgc% = 7
    bgc% = 0
    start%(0) = 10
    start%(1) = 12
    start%(2) = 11
    start%(3) = 12
    trans%(0) = 1
    trans%(1) = 500
    quan%(0) = 5
    quan%(1) = 30
    quan%(2) = 5
    upd
    COLOR fgc%, bgc%: CLS
   END IF
  CASE "9": CLS : GOTO 10
  END SELECT
  upd
 LOOP
CASE "4": COLOR 7, 0: CLS : PRINT "Goodbye, and thanks for playing.": SYSTEM
END SELECT
tl% = bt%
when% = bw%
map$ = SPACE$(sizex% * sizey%)
PRINT "("; LTRIM$(STR$(per%)); ") ";
LINE INPUT "Percent random clearing? "; a$
IF a$ = "" THEN a$ = STR$(per%)
per% = VAL(a$)
PRINT "("; LTRIM$(STR$(when%)); ") ";
LINE INPUT "Head start? "; a$
IF a$ = "" THEN a$ = STR$(when%)
when% = VAL(a$)
bw% = when%
make
CLS
x% = start%(2)
y% = start%(3)
px% = x%
py% = y%
s! = TIMER
counter% = 0
begin% = 0
offx% = 0
offy% = 0
FOR i% = 1 TO tl%: trail(i%).x = 0: trail(i%).y = 0: trail(i%).dat = 0: NEXT i%
drwscr
DO
 IF counter% MOD 2 = 0 THEN
  k$ = INKEY$
5 skp% = 0
  IF k$ <> "" THEN
   px% = x%: py% = y%
   SELECT CASE UCASE$(k$)
   CASE CHR$(0) + CHR$(72): dat% = 0: y% = y% - 1: IF y% < 1 THEN y% = 1
   CASE CHR$(0) + CHR$(75): dat% = 1: x% = x% - 1: IF x% < 1 THEN x% = 1
   CASE CHR$(0) + CHR$(80): dat% = 2: y% = y% + 1: IF y% > sizey% THEN y% = sizey%
   CASE CHR$(0) + CHR$(77): dat% = 3: x% = x% + 1: IF x% > sizex% THEN x% = sizex%
   CASE CHR$(27): LOCATE 1, 1: PRINT "Quit game? (Y/N)"
    DO
     k$ = UCASE$(INKEY$)
     IF k$ = "Y" THEN EXIT DO
     IF k$ = "N" THEN k$ = "": drwscr: GOTO 5
    LOOP
   EXIT DO
   CASE "T": tm% = 1 - tm%
    IF tm% = 0 THEN
     FOR i% = 1 TO tl%
      IF trail(i%).x > 0 THEN assign trail(i%).x, trail(i%).y, " "
     NEXT i%
     IF trail(1).x > 0 THEN assign trail(1).x, trail(1).y, "ù"
     FOR i% = 6 TO tl% - 4 STEP 5
      IF trail(i%).x > 0 THEN assign trail(i%).x, trail(i%).y, "ú"
     NEXT i%
    ELSE
     FOR i% = 1 TO tl%
      IF trail(i%).x > 0 THEN
       SELECT CASE trail(i%).dat
       CASE 0: a$ = ""
       CASE 1: a$ = ""
       CASE 2: a$ = ""
       CASE 3: a$ = ""
       END SELECT
       assign trail(i%).x, trail(i%).y, a$
      END IF
     NEXT i%
    END IF
    assign hx%, hy%, ""
    drwscr
   CASE "P", "p"
    at! = TIMER - s!
7   drwscr
    LOCATE 1, 1: PRINT "---Game paused. 'A': save game, 'D': MS-DOS Prompt, 'V': view field.---";
    k$ = ""
    WHILE k$ = "": k$ = INKEY$: WEND
    IF UCASE$(k$) = "A" THEN GOSUB saveg
    IF UCASE$(k$) = "V" THEN viewf: GOTO 7
    IF UCASE$(k$) = "P" THEN GOTO 7
    IF UCASE$(k$) = "D" THEN
     CLS
     PRINT "Remember, CHASE2 is still in memory. If you reboot, you will loose any unsaved"
     PRINT "game. 'Exit' to return to the game."
     SHELL
     WHILE INKEY$ <> "": WEND
     CLS
     GOTO 7
    END IF
    drwscr
    s! = TIMER - at!
    IF k$ = CHR$(27) THEN k$ = ""
    GOTO 5
   CASE "S", "s": snd% = 1 - snd%
   END SELECT
   IF px% <> x% OR py% <> y% THEN
    SELECT CASE getd$(x%, y%)
    CASE "", "", "", ""
     IF tm% = 1 THEN GOTO 11
     GOTO 12
    CASE " ", "°", "ù", "ú"
11   assign px%, py%, " "
     IF tm% = 0 THEN
      FOR i% = 1 TO tl% - 4 STEP 5
       IF trail(i%).x > 0 THEN assign trail(i%).x, trail(i%).y, " "
      NEXT i%
     ELSE
      FOR i% = 1 TO tl% - 4
       IF trail(i%).x > 0 THEN assign trail(i%).x, trail(i%).y, " "
      NEXT i%
     END IF
     a% = wt%(px%, py%)
     b% = 2
     IF a% > -1 THEN b% = a% + 1
     FOR i% = b% TO tl%
      trail(i% - 1).x = trail(i%).x
      trail(i% - 1).y = trail(i%).y
      trail(i% - 1).dat = trail(i%).dat
     NEXT i%
     trail(tl%).x = px%
     trail(tl%).y = py%
     trail(tl%).dat = dat%
     IF begin% = 0 OR skp% = 1 THEN
      IF tm% = 0 THEN
       IF trail(1).x > 0 THEN assign trail(1).x, trail(1).y, "ù"
       FOR i% = 6 TO tl% - 4 STEP 5
        IF trail(i%).x > 0 THEN assign trail(i%).x, trail(i%).y, "ú"
       NEXT i%
      ELSE
       FOR i% = 1 TO tl%
        IF trail(i%).x > 0 THEN
         SELECT CASE trail(i%).dat
         CASE 0: a$ = ""
         CASE 1: a$ = ""
         CASE 2: a$ = ""
         CASE 3: a$ = ""
         END SELECT
         assign trail(i%).x, trail(i%).y, a$
        END IF
       NEXT i%
      END IF
     END IF
     assign x%, y%, ""
     IF x% - offx% <= 6 AND offx% > 0 THEN offx% = offx% - 1: skp% = 1
     IF offx% + 80 - x% <= 5 AND offx% < sizex% - 80 THEN offx% = offx% + 1: skp% = 1
     IF y% - offy% <= 5 AND offy% > 0 THEN offy% = offy% - 1: skp% = 1
     IF offy% + 24 - y% <= 4 AND offy% < sizey% - 24 THEN offy% = offy% + 1: skp% = 1
     IF begin% = 0 OR skp% = 1 THEN drwscr
    CASE "Û": x% = px%: y% = py%: WHILE INKEY$ <> "": WEND
    CASE ELSE
12   CLS : PRINT "You lose."
     IF snd% = 1 THEN PLAY "mbo1l4b-l8b-l2gmf"
     GOTO 10
    END SELECT
   END IF
  END IF
 END IF
 hx% = x%: hy% = y%
 IF begin% = 1 AND skp% = 0 THEN comp: first% = 0
 IF over% = 1 THEN GOTO 10
 IF begin% = 0 THEN LOCATE 1, 1: PRINT when% - INT(TIMER - s!)
 counter% = counter% + 1
 IF counter% = 8191 THEN counter% = 0
 IF begin% = 0 AND TIMER - s! >= when% THEN
  begin% = 1: first% = 1
  IF snd% = 1 THEN PLAY "mbmso0l8aaal16aaaal8mnamf"
 END IF
 FOR i& = 1 TO delay&: NEXT i&
LOOP
CLS : GOTO 10
saveg:
CLS
8 LINE INPUT "File? "; f$
IF f$ = "" THEN RETURN 7
IF exist%(f$) = 1 THEN PRINT "'"; f$; "' already exists.": GOTO 8
OPEN f$ FOR OUTPUT AS 1
PRINT #1, "Saved Chase game. "; DATE$; "  "; TIME$
PRINT #1, sizex%
PRINT #1, sizey%
PRINT #1, when%
PRINT #1, counter%
PRINT #1, at!
PRINT #1, x%
PRINT #1, y%
PRINT #1, px%
PRINT #1, py%
PRINT #1, offx%
PRINT #1, offy%
PRINT #1, begin%
PRINT #1, map$
FOR i% = 0 TO 2
 PRINT #1, quan%(i%)
NEXT i%
FOR i% = 0 TO 80
 IF i% > 69 OR i% < quan%(0) OR (i% > 9 AND i% < 10 + quan%(1)) OR (i% > 59 AND i% < 60 + quan%(2)) THEN
  PRINT #1, enemy(i%).x
  PRINT #1, enemy(i%).y
  PRINT #1, enemy(i%).px
  PRINT #1, enemy(i%).py
  PRINT #1, enemy(i%).dat
  PRINT #1, enemy(i%).smart
 END IF
NEXT i%
PRINT #1, tl%
FOR i% = 1 TO tl%
 PRINT #1, trail(i%).x
 PRINT #1, trail(i%).y
 PRINT #1, trail(i%).dat
NEXT i%
CLOSE
PRINT "---Saved---": SLEEP 1
RETURN 7

loadg:
IF exist%(f$) = 0 THEN PRINT "'"; f$; "' does not exists.": RETURN 10
OPEN f$ FOR INPUT AS 1
LINE INPUT #1, a$
IF LEFT$(a$, 18) <> "Saved Chase game. " THEN PRINT "Invalid game file.": RETURN 10
PRINT "File saved "; RIGHT$(a$, 20); "."
LINE INPUT #1, a$
sizex% = VAL(a$)
LINE INPUT #1, a$
sizey% = VAL(a$)
LINE INPUT #1, a$
when% = VAL(a$)
LINE INPUT #1, a$
counter% = VAL(a$)
LINE INPUT #1, a$
at! = VAL(a$)
LINE INPUT #1, a$
x% = VAL(a$)
LINE INPUT #1, a$
y% = VAL(a$)
LINE INPUT #1, a$
px% = VAL(a$)
LINE INPUT #1, a$
py% = VAL(a$)
LINE INPUT #1, a$
offx% = VAL(a$)
LINE INPUT #1, a$
offy% = VAL(a$)
LINE INPUT #1, a$
begin% = VAL(a$)
LINE INPUT #1, map$
FOR i% = 0 TO 2
 LINE INPUT #1, a$
 quan%(i%) = VAL(a$)
NEXT i%
FOR i% = 0 TO 80
 IF i% > 69 OR i% < quan%(0) OR (i% > 9 AND i% < 10 + quan%(1)) OR (i% > 59 AND i% < 60 + quan%(2)) THEN
  LINE INPUT #1, a$
  enemy(i%).x = VAL(a$)
  LINE INPUT #1, a$
  enemy(i%).y = VAL(a$)
  LINE INPUT #1, a$
  enemy(i%).px = VAL(a$)
  LINE INPUT #1, a$
  enemy(i%).py = VAL(a$)
  LINE INPUT #1, a$
  enemy(i%).dat = VAL(a$)
  LINE INPUT #1, a$
  enemy(i%).smart = VAL(a$)
 ELSE
  enemy(i%).x = -1
 END IF
NEXT i%
LINE INPUT #1, a$
tl% = VAL(a$)
FOR i% = 1 TO tl%
 LINE INPUT #1, a$
 trail(i%).x = VAL(a$)
 LINE INPUT #1, a$
 trail(i%).y = VAL(a$)
 LINE INPUT #1, a$
 trail(i%).dat = VAL(a$)
NEXT i%
CLOSE
s! = TIMER - at!
drwscr
RETURN 7

term:
PRINT "Error"; ERR; "at"; ERL
IF transfer$ <> "" THEN RUN transfer$
SYSTEM
exis:
nexis% = 0
RESUME NEXT

REM $STATIC
FUNCTION ads% (n%, s%)
 a% = n% + s%
 IF a% > 3 THEN a% = -4 + a%
 ads% = a%
END FUNCTION

SUB assign (x%, y%, n$)
 MID$(map$, sizex% * (y% - 1) + x%, 1) = n$
END SUB

FUNCTION choice$ (pr$, c1$, c2$, c3$, c4$, c5$, c6$, c7$, c8$, c9$, c10$)
 IF c2$ = "" THEN c2$ = c1$
 IF c3$ = "" THEN c3$ = c1$
 IF c4$ = "" THEN c4$ = c1$
 IF c5$ = "" THEN c5$ = c1$
 IF c6$ = "" THEN c6$ = c1$
 IF c7$ = "" THEN c7$ = c1$
 IF c8$ = "" THEN c8$ = c1$
 IF c9$ = "" THEN c9$ = c1$
 IF c10$ = "" THEN c10$ = c1$
 c1$ = UCASE$(c1$)
 c2$ = UCASE$(c2$)
 c3$ = UCASE$(c3$)
 c4$ = UCASE$(c4$)
 c5$ = UCASE$(c5$)
 c6$ = UCASE$(c6$)
 c7$ = UCASE$(c7$)
 c8$ = UCASE$(c8$)
 c9$ = UCASE$(c9$)
 c10$ = UCASE$(c10$)
 COLOR fgc%, bgc%
 'IF mon$ = "C" THEN COLOR 15, 1
 PRINT pr$; "? ";
 LOCATE CSRLIN, POS(0), 1
 DO
  key$ = UCASE$(INKEY$)
  IF key$ = c1$ OR key$ = c2$ OR key$ = c3$ OR key$ = c4$ OR key$ = c5$ OR key$ = c6$ OR key$ = c7$ OR key$ = c8$ OR key$ = c9$ OR key$ = c10$ THEN sl$ = key$: EXIT DO
  IF key$ <> "" THEN
   IF snd$ = "Y" THEN BEEP
  END IF
 LOOP
 LOCATE CSRLIN, POS(0), 0
 PRINT sl$
 'COLOR 7, 0
 WHILE INKEY$ <> "": WEND
 choice$ = sl$
END FUNCTION

SUB comp
 FOR i% = 0 TO 80
  SELECT CASE i%
  CASE 0 TO quan%(0) - 1' speeder
   enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
   a% = enemy(i%).dat: c% = 0: b% = sit%(i%)
1  SELECT CASE a%
   CASE 0: enemy(i%).y = enemy(i%).y - 1: IF enemy(i%).y < 1 THEN enemy(i%).y = 1
   CASE 1: enemy(i%).x = enemy(i%).x - 1: IF enemy(i%).x < 1 THEN enemy(i%).x = 1
   CASE 2: enemy(i%).y = enemy(i%).y + 1: IF enemy(i%).y > sizey% THEN enemy(i%).y = sizey%
   CASE 3: enemy(i%).x = enemy(i%).x + 1: IF enemy(i%).x > sizex% THEN enemy(i%).x = sizex%
   END SELECT
   IF ABS(b%) > 2 AND c% = 0 THEN c% = 1: enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 1
   SELECT CASE getd$(enemy(i%).x, enemy(i%).y)
   CASE "Û", "°": enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 1
   CASE "": CLS : PRINT "You lose."
    IF snd% = 1 THEN PLAY "mbo1l4b-l8b-l2gmf"
    over% = 1: EXIT SUB
   END SELECT
   enemy(i%).dat = a%
  CASE 10 TO 9 + quan%(1) ' happy guy
   IF counter% MOD 6 = 0 THEN
    enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
    a% = enemy(i%).dat: c% = 0: b% = sit%(i%)
2   IF (ABS(b%) > 1 AND ss%(enemy(i%).dat, 2) = a% AND first% = 0 AND INT(RND * 10) < 8) OR (ABS(b%) > 2 AND a% = enemy(i%).dat AND enemy(i%).smart = 1 AND INT(RND * 5) < 3) THEN a% = INT(RND * 4): GOTO 2
    SELECT CASE a%
    CASE 0: enemy(i%).y = enemy(i%).y - 1: IF enemy(i%).y < 1 THEN enemy(i%).y = 1
    CASE 1: enemy(i%).x = enemy(i%).x - 1: IF enemy(i%).x < 1 THEN enemy(i%).x = 1
    CASE 2: enemy(i%).y = enemy(i%).y + 1: IF enemy(i%).y > sizey% THEN enemy(i%).y = sizey%
    CASE 3: enemy(i%).x = enemy(i%).x + 1: IF enemy(i%).x > sizex% THEN enemy(i%).x = sizex%
    END SELECT
    IF (b% > 2 OR (b% < -2 AND enemy(i%).smart = 1)) AND c% = 0 THEN c% = 1: enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 2
    IF c% = 0 AND INT(RND * 5) < 3 AND ABS(b%) > 2 THEN c% = 1: enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 2
    SELECT CASE getd$(enemy(i%).x, enemy(i%).y)
    CASE "Û", "°": IF b% <> 0 THEN enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 2
    CASE "": x% = enemy(i%).x: y% = enemy(i%).y: relocate x%, y%, i%
    CASE "": CLS : PRINT "You lose."
     IF snd% = 1 THEN PLAY "mbo1l4b-l8b-l2gmf"
     over% = 1: EXIT SUB
    END SELECT
    IF b% = 1 AND first% = 0 THEN
     enemy(i%).smart = 1
    END IF
    IF ABS(b%) > 2 THEN
     enemy(i%).smart = 0
    END IF
    enemy(i%).dat = a%
   END IF
  CASE 60 TO 59 + quan%(2)' hound
   IF (counter% * 2) MOD 3 <> 0 THEN
    enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
    d% = 0
    IF enemy(i%).smart AND 2 THEN d% = 1
    a% = wt%(enemy(i%).x, enemy(i%).y)
    IF a% > -1 THEN a% = trail(a%).dat
    enemy(i%).smart = enemy(i%).smart OR 2
    IF a% = -1 THEN
     enemy(i%).smart = enemy(i%).smart XOR 2
     IF d% = 1 AND snd% = 1 THEN PLAY "mbmsl16o2dmnbmf"
    ELSE
     IF d% = 0 AND snd% = 1 THEN PLAY "mbl16o2ccmf"
    END IF
    IF (enemy(i%).smart AND 2) <> 2 THEN a% = enemy(i%).dat: c% = 0: b% = sit%(i%)
6   IF (enemy(i%).smart AND 2) <> 2 AND ((ABS(b%) > 1 AND ss%(enemy(i%).dat, 2) = a% AND first% = 0 AND INT(RND * 10) < 8) OR (ABS(b%) > 2 AND a% = enemy(i%).dat AND enemy(i%).smart = 1 AND INT(RND * 5) < 3)) THEN a% = INT(RND * 4): GOTO 6
    SELECT CASE a%
    CASE 0: enemy(i%).y = enemy(i%).y - 1: IF enemy(i%).y < 1 THEN enemy(i%).y = 1
    CASE 1: enemy(i%).x = enemy(i%).x - 1: IF enemy(i%).x < 1 THEN enemy(i%).x = 1
    CASE 2: enemy(i%).y = enemy(i%).y + 1: IF enemy(i%).y > sizey% THEN enemy(i%).y = sizey%
    CASE 3: enemy(i%).x = enemy(i%).x + 1: IF enemy(i%).x > sizex% THEN enemy(i%).x = sizex%
    END SELECT
    IF (enemy(i%).smart AND 2) <> 2 AND (b% > 2 OR (b% < -2 AND enemy(i%).smart AND 1)) AND c% = 0 THEN c% = 1: enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 6
    IF (enemy(i%).smart AND 2) <> 2 AND c% = 0 AND INT(RND * 5) < 3 AND ABS(b%) > 2 THEN c% = 1: enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 6
    SELECT CASE getd$(enemy(i%).x, enemy(i%).y)
    CASE "Û", "°": enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: a% = INT(RND * 4): GOTO 6
    CASE "": CLS : PRINT "You lose."
     IF snd% = 1 THEN PLAY "mbo1l4b-l8b-l2gmf"
     over% = 1: EXIT SUB
    END SELECT
    IF b% = 1 AND first% = 0 THEN
     enemy(i%).smart = enemy(i%).smart OR 1
    END IF
    IF ABS(b%) > 2 THEN
     enemy(i%).smart = enemy(i%).smart XOR (enemy(i%).smart AND 1)
    END IF
    enemy(i%).dat = a%
    IF wt%(enemy(i%).x, enemy(i%).y) = -1 AND enemy(i%).smart AND 2 THEN
     enemy(i%).smart = enemy(i%).smart XOR (enemy(i%).smart AND 2)
    END IF
   END IF
  CASE 70 TO 74 ' counter-clockwise wall-clingers
   IF counter% * 2 MOD (i% - 68.75) * 2 = 0 THEN
    enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
    b% = sit%(i%)
    a% = ss%(enemy(i%).dat, 2)
3   a% = ads%(a%, 1)
    IF enemy(i%).smart >= 4 AND b% < 0 THEN a% = INT(RND * 4)
    SELECT CASE a%
    CASE 0: enemy(i%).y = enemy(i%).y - 1: IF enemy(i%).y < 1 THEN enemy(i%).y = 1
    CASE 1: enemy(i%).x = enemy(i%).x - 1: IF enemy(i%).x < 1 THEN enemy(i%).x = 1
    CASE 2: enemy(i%).y = enemy(i%).y + 1: IF enemy(i%).y > sizey% THEN enemy(i%).y = sizey%
    CASE 3: enemy(i%).x = enemy(i%).x + 1: IF enemy(i%).x > sizex% THEN enemy(i%).x = sizex%
    END SELECT
    SELECT CASE getd$(enemy(i%).x, enemy(i%).y)
    CASE "Û", "°": enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: GOTO 3
    CASE "": CLS : PRINT "You lose."
     IF snd% = 1 THEN PLAY "mbo1l4b-l8b-l2gmf"
     over% = 1: EXIT SUB
    END SELECT
    IF a% <> enemy(i%).dat THEN
     IF a% = ss%(enemy(i%).dat, 1) THEN
      enemy(i%).smart = enemy(i%).smart + 1
     ELSE
      enemy(i%).smart = enemy(i%).smart = 0
     END IF
    END IF
    enemy(i%).dat = a%
   END IF
  CASE 75 TO 79  ' clockwise wall-clingers
   IF counter% * 2 MOD (i% - 73.75) * 2 = 0 THEN
    enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
    b% = sit%(i%)
    a% = ads%(enemy(i%).dat, 2)
4   a% = ss%(a%, 1)
    IF enemy(i%).smart >= 4 AND b% < 0 THEN a% = INT(RND * 4)
    SELECT CASE a%
    CASE 0: enemy(i%).y = enemy(i%).y - 1: IF enemy(i%).y < 1 THEN enemy(i%).y = 1
    CASE 1: enemy(i%).x = enemy(i%).x - 1: IF enemy(i%).x < 1 THEN enemy(i%).x = 1
    CASE 2: enemy(i%).y = enemy(i%).y + 1: IF enemy(i%).y > sizey% THEN enemy(i%).y = sizey%
    CASE 3: enemy(i%).x = enemy(i%).x + 1: IF enemy(i%).x > sizex% THEN enemy(i%).x = sizex%
    END SELECT
    SELECT CASE getd$(enemy(i%).x, enemy(i%).y)
    CASE "Û", "°": enemy(i%).x = enemy(i%).px: enemy(i%).y = enemy(i%).py: GOTO 4
    CASE "": CLS : PRINT "You lose."
     IF snd% = 1 THEN PLAY "mbo1l4b-l8b-l2gmf"
     over% = 1: EXIT SUB
    END SELECT
    IF a% <> enemy(i%).dat THEN
     IF a% = ads%(enemy(i%).dat, 1) THEN
      enemy(i%).smart = enemy(i%).smart + 1
     ELSE
      enemy(i%).smart = enemy(i%).smart = 0
     END IF
    END IF
    enemy(i%).dat = a%
   END IF
  CASE 80
   IF counter% MOD trans%(1) = 0 OR first% = 1 THEN
    IF snd% = 1 THEN PLAY "o1mbl32de-.b-.mf"
    enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
13  enemy(i%).x = INT(RND * (sizex% - 2)) + 2: enemy(i%).y = INT(RND * (sizey% - 2)) + 2
    IF ABS(enemy(i%).x - hx%) < 8 AND ABS(enemy(i%).y - hy%) < 8 THEN GOTO 13
    enemy(i%).smart = 0
    SELECT CASE getd$(enemy(i%).x, enemy(i%).y)
    CASE "Û": GOTO 13
    CASE "°": enemy(i%).smart = 1
    CASE "
": relocate enemy(i%).x, enemy(i%).y, -1
    END SELECT
   END IF
  END SELECT
 NEXT i%
 FOR i% = 0 TO 80
  IF enemy(i%).x > -1 THEN assign enemy(i%).px, enemy(i%).py, " "
  IF i% = 80 AND enemy(i%).smart% = 1 AND trans%(0) = 0 THEN assign enemy(i%).px, enemy(i%).py, "°"
 NEXT i%
 IF tm% = 0 THEN
  IF trail(1).x > 0 THEN assign trail(1).x, trail(1).y, "ù"
  FOR i% = 6 TO tl% - 4 STEP 5
   IF trail(i%).x > 0 THEN assign trail(i%).x, trail(i%).y, "ú"
  NEXT i%
 ELSE
  FOR i% = 1 TO tl%
   IF trail(i%).x > 0 THEN
    SELECT CASE trail(i%).dat
    CASE 0: a$ = ""
    CASE 1: a$ = ""
    CASE 2: a$ = ""
    CASE 3: a$ = ""
    END SELECT
    assign trail(i%).x, trail(i%).y, a$
   END IF
  NEXT i%
 END IF
 FOR i% = 0 TO quan%(0) - 1
  IF enemy(i%).x > -1 THEN assign enemy(i%).x, enemy(i%).y, "¯"
 NEXT i%
 FOR i% = 10 TO 9 + quan%(1)
  IF enemy(i%).x > -1 THEN assign enemy(i%).x, enemy(i%).y, "
"
 NEXT i%
 FOR i% = 60 TO 59 + quan%(2)
  IF enemy(i%).x > -1 THEN
   a$ = "þ"
   IF wt%(enemy(i%).x, enemy(i%).y) > -1 AND tm% = 0 THEN
    SELECT CASE trail(wt%(enemy(i%).x, enemy(i%).y)).dat
    CASE 0: a$ = ""
    CASE 1: a$ = ""
    CASE 2: a$ = ""
    CASE 3: a$ = ""
    END SELECT
   END IF
   assign enemy(i%).x, enemy(i%).y, a$
  END IF
 NEXT i%
 FOR i% = 70 TO 74
  assign enemy(i%).x, enemy(i%).y, ">"
 NEXT i%
 FOR i% = 75 TO 79
  assign enemy(i%).x, enemy(i%).y, "<"
 NEXT i%
 assign enemy(80).x, enemy(80).y, ""
 assign hx%, hy%, ""
 drwscr
END SUB

SUB drwscr
 w% = sizex%
 IF w% > 80 THEN w% = 80
 FOR l% = 0 TO 23
  LOCATE l% + 1, 1: PRINT MID$(map$, offx% + 1 + (l% + offy%) * sizex%, w%);
 NEXT l%
END SUB

FUNCTION exist% (efile$)
 nexis% = 1
 op% = FREEFILE
 ON ERROR GOTO exis
 OPEN efile$ FOR INPUT AS op%
 ON ERROR GOTO term
 IF nexis% = 1 THEN CLOSE op%
 exist% = nexis%
END FUNCTION

FUNCTION getd$ (x%, y%)
 getd$ = MID$(map$, sizex% * (y% - 1) + x%, 1)
END FUNCTION

SUB getpath
 SHELL "cd > " + ENVIRON$("TEMP") + "\chase2.tmp"
 OPEN ENVIRON$("TEMP") + "\chase2.tmp" FOR INPUT AS 1
 LINE INPUT #1, path$
 CLOSE
 KILL ENVIRON$("TEMP") + "\chase2.tmp"
 IF RIGHT$(path$, 1) <> "\" THEN path$ = path$ + "\"
END SUB

SUB ld
 OPEN path$ + "chase2.dat" FOR INPUT AS 1
 INPUT #1, sizex%
 INPUT #1, sizey%
 INPUT #1, delay&
 INPUT #1, snd%
 INPUT #1, tl%
 INPUT #1, fgc%
 INPUT #1, bgc%
 FOR i% = 0 TO 3
  INPUT #1, start%(i%)
 NEXT i%
 INPUT #1, trans%(0)
 INPUT #1, trans%(1)
 FOR i% = 0 TO 2
  INPUT #1, quan%(i%)
 NEXT i%
 CLOSE
END SUB

SUB make
 IF per% > 100 THEN per% = 100
 IF per% < 0 THEN per% = 0
 FOR y% = 1 TO sizey%
  FOR x% = 1 TO sizex%
   IF x% = 1 OR x% = sizex% OR y% = 1 OR y% = sizey% THEN
    assign x%, y%, "Û"
   ELSE
    IF per% <= 50 THEN
     assign x%, y%, "°"
    ELSE
     assign x%, y%, " "
    END IF
   END IF
  NEXT x%
 NEXT y%
 ns& = (sizex% - 2) * (sizey% - 2)
 IF per% > 50 THEN nd& = ns&
 DO
  IF (per% <= 50 AND per% / 100 <= nd& / ns&) OR (per% > 50 AND per% / 100 >= nd& / ns&) THEN EXIT DO
  x% = INT(RND * (sizex% - 2)) + 2
  y% = INT(RND * (sizey% - 2)) + 2
  IF (getd$(x%, y%) = "°" AND per% <= 50) OR (getd$(x%, y%) = " " AND per% > 50) THEN
   IF per% <= 50 THEN
    assign x%, y%, " "
    nd& = nd& + 1
   ELSE
    assign x%, y%, "°"
    nd& = nd& - 1
   END IF
   LOCATE CSRLIN, 1: PRINT LTRIM$(STR$(nd&)); "/"; ns&; "="; STR$(INT((nd& / ns&) * 100)); "%";
  END IF
 LOOP
 assign start%(2), start%(3), ""
 FOR i% = 0 TO 80
  IF i% > 69 OR i% < quan%(0) OR (i% > 9 AND i% < 10 + quan%(1)) OR (i% > 59 AND i% < 60 + quan%(2)) THEN
   enemy(i%).x = start%(0)
   enemy(i%).y = start%(1)
   enemy(i%).px = start%(0)
   enemy(i%).py = start%(1)
   enemy(i%).dat = INT(RND * 4)
  ELSE
   enemy(i%).x = -1
  END IF
 NEXT i%
 assign start%(0), start%(1), "
"
END SUB

SUB relocate (x%, y%, i%)
 IF snd% = 1 THEN PLAY "o2mbl32e-.b-.<b-.>e-mf"
 IF i% = -1 THEN
  FOR a% = 10 TO 9 + quan%(1)
   IF enemy(a%).x = x% AND enemy(a%).y = y% THEN i% = a%: EXIT FOR
  NEXT a%
  enemy(i%).px = enemy(i%).x: enemy(i%).py = enemy(i%).y
 END IF
9 enemy(i%).x = INT(RND * (sizex% - 2)) + 2: enemy(i%).y = INT(RND * (sizey% - 2)) + 2
 IF ABS(enemy(i%).x - hx%) < 8 AND ABS(enemy(i%).y - hy%) < 8 THEN GOTO 9
 a$ = getd$(enemy(i%).x, enemy(i%).y)
 IF a$ = "Û" OR a$ = "°" THEN GOTO 9
 enemy(i%).smart = 0
 enemy(i%).dat = INT(RND * 4)
END SUB

FUNCTION sit% (i%)
 FOR d% = 0 TO 3
  x% = enemy(i%).x: y% = enemy(i%).y
  SELECT CASE d%
   CASE 0: y% = y% - 1: IF y% < 1 THEN y% = 1
   CASE 1: x% = x% - 1: IF x% < 1 THEN x% = 1
   CASE 2: y% = y% + 1: IF y% > sizey% THEN y% = sizey%
   CASE 3: x% = x% + 1: IF x% > sizex% THEN x% = sizex%
  END SELECT
  a$ = getd$(x%, y%)
  IF a$ <> "Û" AND a$ <> "°" THEN
   a% = a% + 1
   IF d% = enemy(i%).dat THEN b% = 1
  END IF
 NEXT d%
 IF b% = 1 THEN a% = 0 - a%
 sit% = a%
END FUNCTION

FUNCTION ss% (n%, s%)
 a% = n% - s%
 IF a% < 0 THEN a% = 4 + a%
 ss% = a%
END FUNCTION

SUB upd
 OPEN path$ + "chase2.dat" FOR OUTPUT AS 1
 PRINT #1, sizex%
 PRINT #1, sizey%
 PRINT #1, delay&
 PRINT #1, snd%
 PRINT #1, tl%
 PRINT #1, fgc%
 PRINT #1, bgc%
 FOR i% = 0 TO 3
  PRINT #1, start%(i%)
 NEXT i%
 PRINT #1, trans%(0)
 PRINT #1, trans%(1)
 FOR i% = 0 TO 2
  PRINT #1, quan%(i%)
 NEXT i%
 CLOSE
END SUB

SUB viewf
 box% = offx%
 boy% = offy%
 WHILE INKEY$ <> "": WEND
 drwscr
 LOCATE 1, 1: PRINT "---Paused (V)---"
 DO
  k$ = INKEY$
  IF k$ <> "" THEN
   SELECT CASE UCASE$(k$)
   CASE CHR$(0) + CHR$(72): offy% = offy% - 1: IF offy% < 0 THEN offy% = 0
   CASE CHR$(0) + CHR$(75): offx% = offx% - 1: IF offx% < 0 THEN offx% = 0
   CASE CHR$(0) + CHR$(80): offy% = offy% + 1: IF offy% > sizey% - 24 THEN offy% = sizey% - 24
   CASE CHR$(0) + CHR$(77): offx% = offx% + 1: IF offx% > sizex% - 80 THEN offx% = sizex% - 80
   CASE "T": tm% = 1 - tm%
    IF tm% = 0 THEN
     FOR i% = 1 TO tl%
      IF trail(i%).x > 0 THEN
       a$ = getd$(trail(i%).x, trail(i%).y)
       IF a$ = "" OR a$ = "" OR a$ = "" OR a$ = "" THEN assign trail(i%).x, trail(i%).y, " "
      END IF
     NEXT i%
     IF trail(1).x > 0 THEN
      IF getd$(trail(1).x, trail(1).y) = " " THEN assign trail(1).x, trail(1).y, "ù"
     END IF
     FOR i% = 6 TO tl% - 4 STEP 5
      IF trail(i%).x > 0 THEN
       IF getd$(trail(i%).x, trail(i%).y) = " " THEN assign trail(i%).x, trail(i%).y, "ú"
      END IF
     NEXT i%
    ELSE
     FOR i% = 1 TO tl%
      IF trail(i%).x > 0 THEN
       a$ = getd$(trail(i%).x, trail(i%).y)
       IF a$ = "ù" OR a$ = "ú" OR a$ = " " THEN
        SELECT CASE trail(i%).dat
        CASE 0: a$ = ""
        CASE 1: a$ = ""
        CASE 2: a$ = ""
        CASE 3: a$ = ""
        END SELECT
        assign trail(i%).x, trail(i%).y, a$
       END IF
      END IF
     NEXT i%
    END IF
   CASE ELSE: EXIT DO
   END SELECT
   drwscr
   LOCATE 1, 1: PRINT "---Paused (V)---"
  END IF
 LOOP
 IF k$ = CHR$(27) THEN
  offx% = box%
  offy% = boy%
 ELSE
  IF hx% - offx% <= 6 AND offx% > 0 THEN offx% = hx% - 7 * ABS(hx% - 7 > -1)
  IF offx% + 80 - hx% <= 5 AND offx% < sizex% - 80 THEN offx% = hx% - 74 + (hx% + 6 > sizex%) * ((hx% + 6) - sizex%)
  IF hy% - offy% <= 5 AND offy% > 0 THEN offy% = hy% - 6 * ABS(hy% - 6 > -1)
  IF offy% + 24 - hy% <= 4 AND offy% < sizey% - 24 THEN offy% = hy% - 19 + (hy% + 5 > sizey%) * ((hy% + 5) - sizey%)
 END IF
 drwscr
END SUB

FUNCTION wt% (x%, y%)
 a% = -1
 FOR i% = 1 TO tl%
  IF trail(i%).x = x% AND trail(i%).y = y% THEN a% = i%
 NEXT i%
 wt% = a%
END FUNCTION

'Instructions for Michael's semi-scientific calculator.
'By Michael Calkins.

'Written in QBASIC, using DOUBLE numbers for the math. Even though I use the
'terms ax and dx in the program, no assembly is involved. This is a pure
'QBASIC program.

'Please report any bug or mistake.

'This is not a traditional calculator, and is not meant to function in the
'same way.

'Pressing "q":
'exits the program.

'Pressing "c":
'clears the accumulator, the entry, and any pending operation, but does not
'clear the memory.

'Pressing ESC:
'cancels any pending operation, and clears the entry.

'Pressing "=" or ENTER:
'If an operation is in progress, it completes the operation, the way pressing
'"=" on a calculator does, performing the opperation using the accumulator
'and the entry, storing the result in the accumulator, and clearing the
'entry. If no operation was in progress, and there is text in the entry, it
'copies the entry to the accumulator, overwriting any previous value, then
'clearing the entry.

'Pressing "p" or "e":
'loads pi or e, respectively, into the entry, overwriting any previous value.
'It does not perform any operation.

'Pressing "0","1","2","3","4","5","6","7","8","9","."
'adds the character to the entry. "." may only occur once. If pi or e is
'already present in the entry, it will be overwritten.

'Pressing BKSP:
'erases one character from the entry, or erases pi or e if they are there.

'Pressing "+":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes addition
'the pending operation.

'Pressing "-":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes
'subtraction the pending operation.

'Pressing "*":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes
'multiplication the pending operation.

'Pressing "/":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes division
'the pending operation.

'Pressing "\":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes integer
'division the pending operation.

'Pressing "m":
'Starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes modulus
'the pending operation.

'Pressing "^":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes
'exponentation the pending operation.

'Pressing F7:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes reverse
'exponentation the pending operation. The difference is that op results in
'entry to the power of accumulator.

'Pressing "r":
'makes the accumulator its own reciprical, with no other effect.

'Pressing F1:
'inverts the sign of the accumulator, with no other effect.

'Pressing F2:
'inverts the sign of the entry, with no other effect.

'Pressing F3:
'subtracts the accumulator from the memory, with no other effect.

'Pressing F4:
'adds the accumulator to the memory, with no other effect.

'Pressing F5:
'clears the memory.

'Pressing F6:
'If there is a value in the memory, it copies it to the entry, overwriting
'any previous value. It then executes as if "=" or ENTER had been pressed.

'Pressing F8:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a LOG()
'function on the accumulator, storing the result in the accumulator.

'Pressing INS:
'toggles between degrees and radians as a measurement of angle.

'Pressing F9:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a SIN()
'function on the accumulator, storing the result in the accumulator.

'Pressing F10:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a COS()
'function on the accumulator, storing the result in the accumulator.

'Pressing F11:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a TAN()
'function on the accumulator, storing the result in the accumulator.

'Pressing F12:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a ATN()
'function on the accumulator, storing the result in the accumulator.

'Other notes:

'The number on line 1 is the memory, if it isn't 0.

'The indicator at the end of line 1 indicates angle mode, either degrees or
'radians.

'The number on line 3 is the accumulator.

'The indicator at the beginning of line 4 indicates the type of pending
'operation, if there is one.

'The number on line 4 is the entry.

'Enjoy! This program is freeware.

'Regards,
'Michael

DEFINT A-Z 'I use INTEGERs by default in most programs.

SCREEN 0: WIDTH 80, 25: VIEW PRINT 1 TO 25
COLOR 7, 1: CLS

DIM ops(0 TO 8) AS STRING * 7   'pending op indicators
DIM dxd AS STRING       'display string
DIM ax AS DOUBLE        'accumulator
DIM axd AS STRING       'display string
DIM dx AS DOUBLE        'entry data (numeric form), after processing
DIM memory AS DOUBLE    'memory
DIM entry AS STRING     'actual entry string for the prompt
DIM pstate      '0=rest,1=add,2=subtract,3=multiply,4=divide,5=intdiv,6=modulus,7=exp,8=revexp
DIM pi AS DOUBLE        'pi
DIM e AS DOUBLE         'e
DIM md                  'angle mode
DIM k AS STRING         'keyboard input
DIM over                'override enable

ax = 0
memory = 0
entry = ""
pstate = 0
md = 0
pi = 4 * ATN(1)
e = EXP(1)
over = 0
ops(0) = ""
ops(1) = "+"
ops(2) = "-"
ops(3) = "*"
ops(4) = "/"
ops(5) = "\"
ops(6) = "MOD"
ops(7) = "^"
ops(8) = "y^x"

LOCATE 9, 1
PRINT "Quit: 'q'"; TAB(40); "Toggle angles: INS"
PRINT "Clear: 'c'"; TAB(40); "Cancel pending operation: ESC"
PRINT "Accept: '=', ENTER"; TAB(40); "Entry: '0' TO '9', '.', BKSP"
PRINT "Load pi: 'p'"; TAB(40); "Load e: 'e'"
COLOR 11: PRINT "Dual operrand math:": COLOR 7
PRINT "Addition: '+'"; TAB(26); "Subtraction: '-'"; TAB(53); "Multiplication: '*', 'x'";
PRINT "Division: '/'"; TAB(26); "Integer division: '\'"; TAB(53); "Modulus: 'm'"
PRINT "Exponentation: '^'"; TAB(40); "Reverse exponentation: F7"
COLOR 11: PRINT "Functions:": COLOR 7
PRINT "LOG(): F8"; TAB(16); "SIN(): F9"; TAB(32); "COS(): F10"; TAB(48); "TAN(): F11"; TAB(64); "ATN(): F12"
COLOR 11: PRINT "Memory:": COLOR 7
PRINT "Memory -: F3"; TAB(26); "Memory +: F4"; TAB(53); "Clear memory: F5"
PRINT "Load memory into entry and execute the pending operation: F6"
COLOR 11: PRINT "Miscellaneous:": COLOR 7
PRINT "Accumulator becomes reciprical: 'r'"
PRINT "Invert accumulator: F1"; TAB(40); "Invert entry: F2"
COLOR 15, 6: PRINT "PeanutWare"; : COLOR 15, 1: PRINT " Written by Michael Calkins.";
COLOR 15, 1

DO              'program loop
 IF memory <> 0 THEN    'memory display
  dxd = LTRIM$(STR$(memory))
  LOCATE 1, 8: PRINT SPACE$(40 - LEN(dxd)); dxd; " <--memory";
 ELSE
  LOCATE 1, 8: PRINT SPACE$(50);
 END IF
 LOCATE 1, 78
 IF md THEN PRINT "DEG";  ELSE PRINT "RAD";     'angle indicator
 dxd = LTRIM$(STR$(ax))
 LOCATE 3, 8: PRINT SPACE$(40 - LEN(dxd)); dxd; " <--accumulator"
 PRINT ops(pstate); SPACE$(40 - LEN(entry)); entry; " <--entry";
 DO                     'keyboard loop
  k$ = INKEY$
 LOOP UNTIL k$ <> ""
 'don't use lcase$() on the input, so as not to interfere with the scan codes.
 SELECT CASE k$         'case branching for keyboard input
 CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"  'digit entry
  IF (RIGHT$(entry, 2) = "pi") OR (RIGHT$(entry, 1) = "e") THEN entry = "" 'clear if pi or e
  IF LEN(entry) < 40 THEN entry = entry + k$
 CASE "."       'decimal point, only one allowed
  IF (RIGHT$(entry, 2) = "pi") OR (RIGHT$(entry, 1) = "e") THEN entry = "" 'clear if pi or e
  IF (INSTR(entry, ".") = 0) AND (LEN(entry) < 40) THEN entry = entry + "."
 CASE CHR$(8)   'backspace
  IF (RIGHT$(entry, 2) = "pi") OR (RIGHT$(entry, 1) = "e") THEN entry = "" 'clear if pi or e
  IF LEN(entry) THEN entry = LEFT$(entry, LEN(entry) - 1)
 CASE "q", "Q": EXIT DO         'quit program
 CASE CHR$(13), "=": GOSUB doop: pstate = 0     'accept
 CASE "c", "C": ax = 0: entry = "": pstate = 0  'clear
 CASE CHR$(27): entry = "": pstate = 0          'cancel pending op
 CASE "+": GOSUB doop: pstate = 1       'make addition pending
 CASE "-": GOSUB doop: pstate = 2       'make subtraction pending
 CASE "*", "x", "X": GOSUB doop: pstate = 3     'make multiplication pending
 CASE "/": GOSUB doop: pstate = 4       'make division pending
 CASE "\": GOSUB doop: pstate = 5       'make integer division pending
 CASE "m", "M": GOSUB doop: pstate = 6  'make modulus pending
 CASE "^": GOSUB doop: pstate = 7       'make exponentation pending
 CASE "r", "R": IF ax > 0 THEN ax = 1# / ax     'reciprical of ax
 CASE "p", "P": entry = "pi"            'pi in entry
 CASE "e", "E": entry = "e"             'e in entry
 CASE CHR$(0) + CHR$(82): md = NOT md   'toggle angle mode
 CASE CHR$(0) + CHR$(59): ax = 0 - ax   'invert ax
 CASE CHR$(0) + CHR$(60)                'invert entry
  IF LEFT$(entry, 1) = "-" THEN
   entry = MID$(entry, 2)
  ELSE
   entry = "-" + entry
  END IF
 CASE CHR$(0) + CHR$(61): memory = memory - ax  'memory -
 CASE CHR$(0) + CHR$(62): memory = memory + ax  'memory +
 CASE CHR$(0) + CHR$(63): memory = 0            'clear memory
 CASE CHR$(0) + CHR$(64)        'use memory as entry, and carry out pending operation
   IF memory <> 0 THEN entry = "0": over = -1: dx = memory: GOSUB doop: pstate = 0
 CASE CHR$(0) + CHR$(65): GOSUB doop: pstate = 8'make reverse exponentaion the pending operation
 CASE CHR$(0) + CHR$(66): GOSUB doop: pstate = 0: ax = LOG(ax)  'perform LOG
 CASE CHR$(0) + CHR$(67)        'perform SIN
  GOSUB doop: pstate = 0
  IF md THEN
   ax = SIN(ax * (pi / 180#))   'radian conversion
  ELSE
   ax = SIN(ax)
  END IF
 CASE CHR$(0) + CHR$(68)        'perform COS
  GOSUB doop: pstate = 0
  IF md THEN
   ax = COS(ax * (pi / 180#))   'radian conversion
  ELSE
   ax = COS(ax)
  END IF
 CASE CHR$(0) + CHR$(133)       'perform TAN
  GOSUB doop: pstate = 0
  IF md THEN
   ax = TAN(ax * (pi / 180#))   'radian conversion
  ELSE
   ax = TAN(ax)
  END IF
 CASE CHR$(0) + CHR$(134)       'perform ATN
  GOSUB doop: pstate = 0
  IF md THEN
   ax = ATN(ax) / (pi / 180#)   'radian conversion
  ELSE
   ax = ATN(ax)
  END IF
 END SELECT
LOOP

COLOR 7, 0: CLS
SYSTEM          'program termination

doop:           'subroutine to complete a pending operation, or move the entry
                'to the accumulator
 IF NOT over THEN       'presses F6 overrides this part, making the memory the dx instead.
  IF RIGHT$(entry, 2) = "pi" THEN       'handle pi
   IF entry = "pi" THEN dx = pi ELSE dx = 0 - pi
  ELSE
   IF RIGHT$(entry, 1) = "e" THEN       'handle e
    IF entry = "e" THEN dx = e ELSE dx = 0 - e
   ELSE                                 'handle normal entry
    IF entry <> "" THEN dx = VAL(entry + "#") ELSE dx = 0
   END IF
  END IF
 END IF
 SELECT CASE pstate     'perform pending operation
 CASE 0: IF entry <> "" THEN ax = dx    'if there is entry, move it to ax
 CASE 1: ax = ax + dx   'addition
 CASE 2: ax = ax - dx   'subtraction
 CASE 3: ax = ax * dx   'multiplication
 CASE 4: IF dx > 0 THEN ax = ax / dx    'division
 CASE 5: IF dx > 0 THEN ax = ax \ dx    'integer division
 CASE 6: IF dx > 0 THEN ax = ax MOD dx  'modulus
 CASE 7: ax = ax ^ dx   'exponentation
 CASE 8: ax = dx ^ ax   'reverse exponentation
 END SELECT
 entry = ""     'reset entry
 over = 0       'reset override
RETURN          'subroutine RETURN

*

...since I'm not familiar with the use of "E" and other scientific notation. For my purposes, however, it seems to work quite well. Nice job.

Since the instructions are so important for the use of the program, I recommend that they be remmed and wrapped and left as a permanent part of the code. Since I've already done it on my version of your program, I'll post the lines here if you want to use them.

-Bob


'Written in QBASIC, using DOUBLE numbers for the math. Even though I use
'the terms ax and dx in the program, no assembly is involved. This is a
'pure QBASIC program.

'Please report any bug or mistake.

'This is not a traditional calculator, and is not meant to function in the
'same way.

'Pressing "q":
'exits the program.

'Pressing "c":
'clears the accumulator, the entry, and any pending operation, but does
'not clear the memory.

'Pressing "=" OR ENTER:
'If an operation is in progress, it completes the operation, the way
'pressing "=" on a calculator does, performing the opperation using
'the accumulator and the entry, storing the result in the accumulator,
'and clearing the entry. If no operation was in progress, and there is
'text in the entry, it copies the entry to the accumulator, overwriting
'any previous value, then clearing the entry.

'pressing "p" OR "e":
'loads pi or e, respectively, into the entry, overwriting any previous
'value. It does not perform any operation.

'pressing "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
'adds the character to the entry. "." may only occur once. If pi or
'e is already present in the entry, it will be overwritten.

'pressing BKSP:
'erases one character from the entry, or erases pi or e if they are there.

'pressing "+":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes addition
'the pending operation.

'pressing "-":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes
'subtraction the pending operation.

'pressing "*":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes
'multiplication the pending operation.

'pressing "/":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes division
'the pending operation.

'pressing "\":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes integer
'division the pending operation.

'pressing "m":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes modulus
'the pending operation.

'pressing "^":
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes
'exponentation the pending operation.

'pressing F7:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then makes reverse
'exponentation the pending operation. The difference is that op results in
'entry to the power of accumulator.

'pressing "r":
'makes the accumulator its own reciprical, with no other effect.

'pressing F1:
'inverts the sign of the accumulator, with no other effect.

'pressing F2:
'inverts the sign of the entry, with no other effect.

'pressing F3:
'subtracts the accumulator from the memory, with no other effect.

'pressing F4:
'adds the accumulator to the memory, with no other effect.

'pressing F5:
'clears the memory.

'pressing F6:
'If there is a value in the memory, it copies it to the entry, overwriting
'any previous value. It then executes as if "=" or ENTER had been pressed.

'pressing F8:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a
'LOG() function on the accumulator, storing the result in the accumulator.

'pressing INS:
'toggles between degrees and radians as a measurement of angle.

'pressing F9:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a
'SIN() function on the accumulator, storing the result in the accumulator.

'pressing F10:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a
'COS() function on the accumulator, storing the result in the accumulator.

'pressing F11:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a
'TAN() function on the accumulator, storing the result in the accumulator.

'pressing F12:
'starts out by acting as if "=" had been pressed, to complete any pending
'operation, or to move the entry to the accumulator. It then performs a
'ATN() function on the accumulator, storing the result in the accumulator.

'Other notes:
'The number on line 1 is the memory, if it isn't 0.
'The indicator at the end of line 1 indicates angle mode, either degrees
'or radians.
'The number on line 3 is the accumulator.
'The indicator at the beginning of line 4 indicates the type of pending
'operation, if there is one.
'The number on line 4 is the entry.

'Enjoy!

'Regards,
'Michael

Try .01+.01+.01+.01+.01+.01+.01

Answer = 7.000000000000001D-02

I hate that about QB, but similar problems exist in other languages, too. In any case, I don't know what your intentions are here. If you want to make it practical to use, you have about the same amount of work to do in a conversion sub to eradicate that darn floating point bug. (BTW - this bug includes more than just the one example I gave. There will be *-/ errors, as well.)

I think I stumbled on this, years ago, without ever hearing about it. I did pretty much what you did. I needed an accounting program and when I beta tested it, well, I nearly freaked out. I think I came up with a numeric fix and a string conversion fix, but that was 10 years ago. Anyway, at least it can be fixed.

The memory routine is a kick. I love it. Very nice 'addition.'

My guess is that you will want to clean up the layout a bit, if you intend to develop it more. It was a bit hard to read, because the columns overlap. I really hate tiny print in Windows programs, but the DOS 80 columns I too enjoy, can make layout a pain.

LOG, SINE, COS, TAN, ATN(); wow, you managed to incorporate a whole lot of functions into a small amount of code. That's great.

Awaiting your comments,

Pete

>...since I'm not familiar with the use of "E" and other scientific notation.

"e" in my program is the base of the natural system of logarithms. Something like 2.71. not really sure why it works, but it is possible to do exponents and stuff by maniplating logarithms.

>For my purposes, however, it seems to work quite well. >Nice job.

Thanks.

>Since the instructions are so important for the use of the program, I recommend that they be remmed and wrapped and left as a permanent part of the code.

Yes, thanks. I will do that in my next revision. After posting, I saw an ommision in the documentation. While I'm at it, I'll probably make a small change in the program, and add comments. But that will be tomorrow at the earliest. Probably Tuesday or Wednesday.

>Answer = 7.000000000000001D-02

Yes, I have long been aware of this type of problem. This is why I rarely use floating point. But, for a calculator like this, it shouldn't really be a problem. It's only a problem in critical stuff, or in areas that could actually cause a program to malfunction. This isn't that type of problem. The user can correct for it himself.

>bug

it's not really a bug in QBASIC or the other languages. It's just inherint in floating point. The number is no doubt rounded to binary for storage, then back to decimal for the STR$(). It's bound to happen, unless you stick with numbers that are round when converted to binary, ie, powers of 2...

>string conversion fix

I have a converter in QB Tricks and Techniques, but I don't know if I want to implememnt it here. Probably better to leave the scientific notation

>The memory routine is a kick. I love it. Very nice 'addition.'

Thanks.

>My guess is that you will want to clean up the layout a bit, if you intend to develop it more. It was a bit hard to read, because the columns overlap. I really hate tiny print in Windows programs, but the DOS 80 columns I too enjoy, can make layout a pain.

yeah, I threw that together in a hurry. I just wanted it to be spaced far enough that people could distinguish the keys, and far enough away from the readout that it wouldn't distract. I may have to rework that.

>LOG, SINE, COS, TAN, ATN(); wow, you managed to incorporate a whole lot of functions into a small amount of code. That's great.

Yes. :-) Thanks. I don't use LOG much, but those trig functions are neat.

Regards,
Michael

added what I forgot in the documentation.

discovered and removed several unused variables. (I wrote the original Saturday night, and finished debugging somewhere around 3 AM, so I didn't see that I was leaving unused variables. I even had one SHARED even though I have no procedures...)

moved 1 subroutine inline, because it was only called in one spot.

cleaned up the onscreen help a little.

added excessive comments.

The visible behavior of the program, other than the onscreen help, is unchanged.

Regards,
Michael

'Please report bugs. My own testing was marginal.

DEFINT A-Z
DIM n(0 TO 2), flags, dword(0 TO 2) AS LONG, opn(0 TO 7) AS STRING * 4
DIM i, curp, curd, cop, ocop, dop, x
DIM hxn AS STRING * 4, t AS STRING, fln(0 TO 7) AS STRING, k AS STRING

fln(7) = "Overflow"
'fln(6) = "Direction"
'fln(5) = "Interrupt"
fln(4) = "Sign"
fln(3) = "Zero"
fln(2) = "Adjust"
fln(1) = "Parity"
fln(0) = "Carry"
flags = &H20            'Enable Interrupt

opn(0) = "NOT"
opn(1) = "AND"
opn(2) = "OR"
opn(3) = "XOR"
opn(4) = "EQV"
opn(5) = "IMP"
opn(6) = "ADD"
opn(7) = "SUB"

COLOR 7, 1: CLS
PALETTE 3, 11 + 16      'If you use Win NT/2000/XP, run in fullscreen mode.
RANDOMIZE TIMER

PRINT "First input:"
PRINT "Operator:", ;
COLOR 13, 1: FOR i = 0 TO 7: PRINT opn(i); " "; : NEXT i: LOCATE 3, 1
COLOR 7, 1
PRINT "Second input:"
LOCATE 5, 1: PRINT "Result: "
LOCATE 9, 1: PRINT STRING$(80, &HCD);
PRINT "Carry:    Indicates an unsigned overflow."
PRINT "Parity:   Indicates an even number of '1' bits in the low byte."
PRINT "Adjust:   Indicates an overflow in the low nibble."
PRINT "Zero:     Indicates zero."
PRINT "Sign:     Indicates that the high bit is '1'."
PRINT "Overflow: Indicates a signed overflow."
PRINT STRING$(80, &HCD);
PRINT "  NOT³          AND³01         OR³01        XOR³01        EQV³01        IMP³01";
PRINT "  ÄÄÄÅÄÄ        ÄÄÄÅÄÄ        ÄÄÄÅÄÄ        ÄÄÄÅÄÄ        ÄÄÄÅÄÄ        ÄÄÄÅÄÄ";
PRINT "    0³1           0³00          0³01          0³01          0³10          0³10";
PRINT "    1³0           1³01          1³11          1³10          1³01          1³11";
PRINT STRING$(80, &HCD);
PRINT "ESC-Quit, arrows-Navigate, 0 thru F-Input, F1 thru F8-Select operator. F12-Rnd."
PRINT "If Scroll Lock is on, the cursor doesn't advance with input."
LOCATE 25, 1: COLOR 15, 6: PRINT "PeanutWare"; : COLOR 7, 1: PRINT " Written by Michael Calkins. Please report bugs.";
COLOR 2, 1: PRINT " mcalkins0" + "@" + "hotmail.com";

dop = -1
curd = 3
ocop = 1
LOCATE , , 0
DO
 IF dop THEN GOSUB doop         'does operation when needed
 IF ocop <> cop THEN            'indicate current op
  LOCATE 2, 15 + ocop * 5: COLOR 13, 1: PRINT opn(ocop)
  LOCATE 2, 15 + cop * 5: COLOR 14, 1: PRINT opn(cop)
  ocop = cop
 END IF
 LOCATE 1 + (curp * 2), 18 - curd, 1, 30, 31    'show hardware cursor
 
 DO
  k = INKEY$
 LOOP UNTIL LEN(k) > 0
 LOCATE , , 0
 IF LEN(k) > 1 THEN             'extended keys
  SELECT CASE ASC(RIGHT$(k, 1))
  CASE &H3B TO &H42: dop = -1: cop = ASC(RIGHT$(k, 1)) - &H3B
  CASE &H48, &H50: curp = 1 - curp
  CASE &H4B: curd = curd + 1: IF curd > 3 THEN curd = 0
  CASE &H4D: curd = curd - 1: IF curd < 0 THEN curd = 3
  CASE &H86: dop = -1: n(0) = INT(RND * &H10000) + &H8000: n(1) = INT(RND * &H10000) + &H8000
  END SELECT
 ELSE                           'regular keys
  k = UCASE$(k)
  SELECT CASE k
  CASE CHR$(&H1B): EXIT DO
  CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "A", "B", "C", "D", "E", "F"
   dop = -1
   t = HEX$(n(curp))
   hxn = STRING$(4 - LEN(t), &H30) + t
   MID$(hxn, 4 - curd, 1) = k           'text substitution
   n(curp) = VAL("&h" + hxn)
   DEF SEG = 0
   IF (NOT PEEK(&H417)) AND &H10 THEN   'detect scroll lock
    curd = curd - 1: IF curd < 0 THEN curd = 3
   END IF
   DEF SEG
  END SELECT
 END IF
LOOP
COLOR 7, 0: CLS
SYSTEM

doop:
 flags = flags AND &HFF60               'clear arithmatic/logic flags
 SELECT CASE cop
 CASE 0: n(2) = NOT n(0)
 CASE 1: n(2) = n(0) AND n(1)
 CASE 2: n(2) = n(0) OR n(1)
 CASE 3: n(2) = n(0) XOR n(1)
 CASE 4: n(2) = n(0) EQV n(1)
 CASE 5: n(2) = n(0) IMP n(1)
 CASE 6
  ON ERROR GOTO ovr
  n(2) = n(0) + n(1)    'just to determine Overflow
  ON ERROR GOTO 0
  'convert to unsigned
  dword(0) = n(0): IF n(0) < 0 THEN dword(0) = dword(0) + &H10000
  dword(1) = n(1): IF n(1) < 0 THEN dword(1) = dword(1) + &H10000
  dword(2) = dword(0) + dword(1)
  IF dword(2) AND &H10000 THEN flags = flags OR 1       'Carry
  WHILE dword(2) > &H7FFF       'convert to signed
   dword(2) = dword(2) - &H10000
  WEND
  n(2) = dword(2)
  IF (n(2) AND &H10) XOR ((n(0) AND &H10) XOR (n(1) AND &H10)) THEN flags = flags OR 4 'Adjust
 CASE 7
  ON ERROR GOTO ovr
  n(2) = n(0) - n(1)    'just to determine Overflow
  ON ERROR GOTO 0
  'convert to unsigned
  dword(0) = n(0): IF n(0) < 0 THEN dword(0) = dword(0) + &H10000
  dword(1) = n(1): IF n(1) < 0 THEN dword(1) = dword(1) + &H10000
  dword(2) = dword(0) - dword(1)
  IF dword(2) AND &H10000 THEN flags = flags OR 1       'Carry
  IF dword(2) > &H7FFF THEN dword(2) = dword(2) - &H10000 'convert to INTEGER
  IF dword(2) < &H8000 THEN dword(2) = dword(2) + &H10000
  n(2) = dword(2)
  IF (n(2) AND &H10) XOR ((n(0) AND &H10) XOR (n(1) AND &H10)) THEN flags = flags OR 4 'Adjust
 END SELECT
 IF (cop < 4) OR (cop > 5) THEN
  IF n(2) = 0 THEN flags = flags OR 8   'Zero
  IF n(2) < 0 THEN flags = flags OR &H10        'Sign
  x = 0
  FOR i = 0 TO 7
   IF n(2) AND (2 ^ i) THEN x = x + 1
  NEXT i
  IF (NOT x) AND 1 THEN flags = flags OR 2      'Parity

  FOR i = 7 TO 0 STEP -1
   IF flags AND (2 ^ i) THEN COLOR 1, 3 ELSE COLOR 13, 1
   LOCATE 7, (10 * (7 - i)) + 1: PRINT fln(i);
  NEXT i
 ELSE
  COLOR 7, 1: LOCATE 7, 1: PRINT SPACE$(80);
 END IF

'---The following commented info was copied from the NASM documentation.
'      CF - Carry flag.

'      Set if an arithmetic operation generates a carry or a borrow out of
'      the most-significant bit of the result; cleared otherwise. This flag
'      indicates an overflow condition for unsigned-integer arithmetic. It
'      is also used in multiple-precision arithmetic.

'      PF - Parity flag.

'      Set if the least-significant byte of the result contains an even
'      number of 1 bits; cleared otherwise.

'      AF - Adjust flag.

'      Set if an arithmetic operation generates a carry or a borrow out of
'      bit 3 of the result; cleared otherwise. This flag is used in binary-
'      coded decimal (BCD) arithmetic.

'      ZF - Zero flag.

'      Set if the result is zero; cleared otherwise.

'      SF - Sign flag.

'      Set equal to the most-significant bit of the result, which is the
'      sign bit of a signed integer. (0 indicates a positive value and 1
'      indicates a negative value.)

'      OF - Overflow flag.

'      Set if the integer result is too large a positive number or too
'      small a negative number (excluding the sign-bit) to fit in the
'      destination operand; cleared otherwise. This flag indicates an
'      overflow condition for signed-integer (two's complement) arithmetic.

 FOR i = 0 TO 2
  t = HEX$(n(i))
  hxn = STRING$(4 - LEN(t), &H30) + t
  IF (cop = 0) AND (i = 1) THEN COLOR 0, 1 ELSE COLOR 15, 1
  LOCATE 1 + (i * 2), 15: PRINT hxn, ;
  IF (cop = 0) AND (i = 1) THEN 'black ghost
   COLOR 0: t = ""
   FOR x = 15 TO 0 STEP -1
    t = t + CHR$(&H30 + (1 AND (0 <> (n(i) AND (2 ^ x)))))
   NEXT x
   PRINT t, n(i); SPACE$(4);
  ELSE
   FOR x = 15 TO 0 STEP -1      'colored nibbles
    IF (x AND 3) = 3 THEN t = "": COLOR 10 + (1 AND ((x AND 4) <> 4))
    t = t + CHR$(&H30 + (1 AND (0 <> (n(i) AND (2 ^ x)))))
    IF (x AND 3) = 0 THEN PRINT t;
   NEXT x
   COLOR 15, 1: PRINT , ; n(i); SPACE$(4);
  END IF
 NEXT i
 dop = 0
RETURN

ovr:
 flags = flags OR &H80  'Set Overflow flag.
RESUME NEXT

ESC - quit
S - toggle sound
F2 - new game
F10 - select level and start new game
SPACE / left-click - uncover square
ENTER / right-click - toggle normal/flag/'?'
Arrows / mouse motion - move cursor

Begginer, Intermediate, and Expert levels conform to Minesweeper. Limits for custom levels also conform.
The keyboard alone can be used to play, or the mouse in addition to it. This game is in color, and uses both 80x25 and 40x25 color text modes. Sound is optional.

Thanks to Solitaire's recommendation, this game has a redo feature to retry a lost level. However, such a retry is not timed, and is not eligable for a high score.

To track high scores, a 96 byte binary file is used. This is currently "mines.dat" in the current directory.

This game, in the development stages (with mouse routines), has been tested using QBASIC 1.1 on MS-DOS 7.1, Win 95b, Win98SE, and using QBASIC 1.0 on IBM OS/2 Warp 3. I will further test the finished version on the same configurations. There is no known reason why this game would fail on normal configurations of the above mentioned OSes.

Possible NTVDM conflicts:
I use WIDTH 80, 25 and WIDTH 40, 25. I'm not sure how NTVDM will handle this, but DOS, 9x, and Warp handle it correctly.
Mouse access. Solitaire has reported failure with my mouse routine on Windows XP. I have included 2 mouse routines: my own, as well as one donated by The PhyloGenesis (thanks), who says it works with XP. Phylo's is used by default. Both routines work on all my test configurations, including Warp.

I made a point of avoiding SUB procedures and FUNCTIONs, not that there is anything wrong with them. This game makes extensive, efficient, and well organized use of GOSUB. I consider this program to be a model of effective GOSUB usage. RETURN is always used, except in cases of SYSTEM termination inside a routine.

I have tested it fairly well, but I did some late tweaking, so I will be testing it further, but I don't expect to find any bugs. If so, I will modify this post.

I hope you enjoy this freeware game. Please report all bugs and mistakes. I am curious as to how well the NTVDM systems will handle it, but I think the WIDTH thing will be trouble even if the mouse isn't.

Regards,
Michael

'The first 3 constants are meant to be user-changable.
'the following file will act as the high score data file:
CONST file = "mines.dat"

'the following line chooses between two mouse access routines.
CONST mouseoption = 2
'0 is disable mouse
'1 is my own routine, which definitely works with DOS 7.1, Win 9x, and OS/2 Warp
'2 is the routine donated by The PhyloGenesis, which is said to work with
'Windows NT/2000/XP, in addition to the other Operating Systems.

CONST enableq = 0       '"?" marks: 0=disable, non-zero=enable

DEFINT A-Z      'You knew I was going to do this, didn't you?
RANDOMIZE TIMER
CONST maxx = 30         'limits conform to Minesweeper's limits.
CONST maxy = 24
CONST maxmines = 667
CONST minx = 8
CONST miny = 8
CONST minmines = 10
'This routine has been donated by The PhyloGenesis:
CONST PhyloGenesis = "5589E58B5E0C8B07508B5E0A8B07508B5E088B0F8B5E068B175B581E07CD33538B5E0C8907588B5E0A89078B5E08890F8B5E0689175DCA0800"
TYPE codet      'user defined type for mouse access
 axv AS INTEGER
 cxv AS INTEGER
 dxv AS INTEGER
 bxv AS INTEGER
 code AS STRING * 21    'my routine goes here
 PG AS STRING * 57      'Phylo's routine goes here
 s AS INTEGER
END TYPE
DIM SHARED cd AS codet  'main variable for mouse access
DIM mousepref, obx, ocx, odx, visible, ovis     'misc mouse variables
'main variables
DIM xd, yd, nmines, nmarks, start AS SINGLE, tsing AS SINGLE, game
DIM x, y, i, sx, sy, elap, oelap, cx, cy, tx, ty, bx, by, ex, ey
DIM nlef, k AS STRING, t AS STRING, level, snd
GOSUB initmousecode             'init mouse routines
mousepref = mouseoption
GOSUB resetmouse                'reset mouse
TYPE scoret             'record type for high score file
 nam AS STRING * 28
 sec AS INTEGER
 rai AS INTEGER
END TYPE
TYPE st         'main field
 id AS STRING * 1       '&hf, " " to "8",
 st AS INTEGER      '0=hidden, 1=mark, 2=?, 4=revealed
END TYPE
TYPE cot        'for storing location of mines
 x AS INTEGER
 y AS INTEGER
END TYPE
DIM s(0 TO maxx - 1, 0 TO maxy - 1) AS st       'squares of main field
DIM upd(0 TO maxx - 1, 0 TO maxy - 1)   'update enable
DIM bak(0 TO maxx - 1, 0 TO maxy - 1) AS STRING * 1     'backup for redo
DIM mloc(0 TO maxmines) AS cot  'location of mines
DIM score(0 TO 2) AS scoret     'high scores

FOR i = 0 TO 2  'defaults
 score(i).nam = "---None---": score(i).sec = 999: score(i).rai = 0
NEXT i
n = 0   'read
GOSUB fileio    'file I/O

level = 0: snd = 0      'defaults

GOSUB initlevel         'in turn calls newgame
PLAY "mbt200l64o1"      'init music
DO      'main loop
 LOCATE yd - cy, cx + 1, 1, 30, 31      'hardware cursor visible
 IF ovis THEN GOSUB showmouse
 DO     'primary input poll loop
  IF (game = 1) AND (elap <> 999) THEN
   tsing = TIMER
   IF tsing < start THEN start = start - 86400  'crossed midnight
   elap = INT(tsing - start)
  END IF
  IF elap <> oelap THEN GOSUB drwclock: oelap = elap: LOCATE yd - cy, cx + 1, 1, 30, 31
  IF mousepref THEN             'Beginning of mouse poll section
   cd.axv = 3        'get status
   GOSUB accessmouse
   cd.bxv = cd.bxv AND 3 'button mask
   cd.dxv = (cd.dxv \ 8): cd.cxv = cd.cxv \ 16  '40x25 grid
   n = cd.bxv   'backup button data incase of intervening mouse access
   IF (cd.dxv < yd) AND (cd.cxv < xd) THEN      'is inside area?
    IF (ocx <> cd.cxv) OR (odx <> cd.dxv) THEN  'did it move?
     cx = cd.cxv: cy = (yd - 1) - cd.dxv        'move cursor
     LOCATE yd - cy, cx + 1, 1, 30, 31  'display hardware cursor
    END IF
    ocx = cd.cxv: odx = cd.dxv  'save mouse pos to detect motion next time
    IF visible THEN GOSUB hidemouse     'mouse off
   ELSE
    ocx = cd.cxv: odx = cd.dxv  'save mouse pos to detect motion next time
    IF NOT visible THEN GOSUB showmouse 'mouse on
   END IF
   IF (obx AND 1) < (n AND 1) THEN      'left click
    LOCATE , , 0        'hide hardware cursor
    GOSUB reveal        'same as space bar
    LOCATE yd - cy, cx + 1, 1, 30, 31   'hardware cursor visible
   ELSEIF (obx AND 2) < (n AND 2) THEN  'right click
    LOCATE , , 0         'hide hardware cursor
    GOSUB togglemark    'same as enter
    LOCATE yd - cy, cx + 1, 1, 30, 31   'hardware cursor visible
   END IF
   obx = n      'save button state to detect change next time
  END IF        'End of mouse poll section
  k$ = INKEY$
 LOOP UNTIL LEN(k$)
 ovis = visible
 IF visible THEN GOSUB hidemouse        'to prevent graphical corruption
 LOCATE , , 0           'hide hardware cursor
 IF LEN(k$) < 2 THEN
  SELECT CASE ASC(k$)
  CASE &H1B: EXIT DO    'ESC exits
  CASE &HD: GOSUB togglemark    'enter triggers togglemark, same as right click
  CASE &H20: GOSUB reveal       'space triggers reveal, same as left click
  CASE &H53, &H73: snd = NOT snd: GOSUB drwsnd
  CASE ELSE: GOSUB help
  END SELECT
 ELSE
  SELECT CASE ASC(RIGHT$(k$, 1))
  CASE &H3C: GOSUB newgame      'F2 = new game
  CASE &H44: GOSUB clevel       'F10 = new level
  CASE &H48: cy = cy + 1: IF cy = yd THEN cy = 0
  CASE &H4B: cx = cx - 1: IF cx = -1 THEN cx = cx + xd
  CASE &H4D: cx = cx + 1: IF cx = xd THEN cx = 0
  CASE &H50: cy = cy - 1: IF cy = -1 THEN cy = cy + yd
  CASE ELSE: GOSUB help
  END SELECT
 END IF
LOOP
GOSUB thechamps
SYSTEM          'termination

togglemark:     'toggles normal, flag, "?". Right click mouse event.
 IF s(cx, cy).st XOR 4 THEN     'must not be already visible
  IF enableq THEN       'allow "?"
   s(cx, cy).st = s(cx, cy).st + 1
   IF s(cx, cy).st = 3 THEN s(cx, cy).st = 0
  ELSE                  'disallow "?"
   s(cx, cy).st = s(cx, cy).st XOR 1
   IF s(cx, cy).st = 0 THEN nmarks = nmarks + 1
  END IF
  LOCATE yd - cy, cx + 1
  SELECT CASE s(cx, cy).st
  CASE 0: COLOR 3, 0: PRINT CHR$(&HFA); : IF snd THEN PLAY "g"
  CASE 1: COLOR 4, 0: PRINT CHR$(&HB8); : nmarks = nmarks - 1: IF snd THEN PLAY "e"
  CASE 2: COLOR 1, 5: PRINT "?"; : nmarks = nmarks + 1: IF snd THEN PLAY "a"
  END SELECT
  GOSUB drwminen        'update the number display
 END IF
RETURN

reveal: 'reveals a square or series of squares. Left click mouse event.
 IF (s(cx, cy).st AND 5) = 0 THEN       'not flagged or already revealed
  IF sx = -1 THEN sx = cx: sy = C: GOSUB setfld 'is it the start of the game?
  SELECT CASE ASC(s(cx, cy).id)
  CASE &HF      'You are dead!!!
   IF snd THEN PLAY "l16e.c<a.>l64"
   s(cx, cy).st = 4
   upd(cx, cy) = -1
   GOSUB updscr
   COLOR 15, 1: LOCATE 25, 32: PRINT "Redo?";   'Solitaire's recommendation.
   DO
    k$ = LCASE$(INKEY$)
    SELECT CASE k$
    CASE CHR$(&H1B): GOSUB thechamps: SYSTEM    'ESC, termination
    CASE "y": GOSUB redo: EXIT DO       'redo game
    CASE "n", MKI$(&H3C00)      '"N" or F2
     LOCATE 25, 32: PRINT SPACE$(5);
     FOR x = 0 TO xd - 1        'check for incorrect flags
      FOR y = 0 TO yd - 1
       IF (s(x, y).st = 1) AND (s(x, y).id <> CHR$(&HF)) THEN
        COLOR 28, 0: LOCATE yd - y, x + 1: PRINT "X"; 'what's wrong with you?
       END IF
      NEXT y
     NEXT x
     FOR i = 0 TO nmines - 1    'reveal flags
      IF s(mloc(i).x, mloc(i).y).st <> 1 THEN
       COLOR 31, 0: LOCATE yd - mloc(i).y, mloc(i).x + 1: PRINT CHR$(&HF);
      END IF
     NEXT i
     SLEEP: WHILE INKEY$ <> "": WEND    'pause
     GOSUB newgame: EXIT DO     'new game
    END SELECT
   LOOP
  CASE &H20     'blank squares cascade to nearby squares
   IF snd THEN PLAY "ce"
   s(cx, cy).st = 8     'temporary mark
   bx = cx: by = cy: ex = cx: ey = cy   'start the work here
   DO
    n = 0       'assume done
    FOR x = bx TO ex    'progressively larger bounderies for efficient looping
     FOR y = by TO ey
      IF s(x, y).st AND 8 THEN  'this blank was found in previous loop or is first square
       s(x, y).st = 4: nlef = nlef - 1: upd(x, y) = -1  'finalize previous finds
       FOR i = 0 TO 7   'loop through adjacent possibilities
        SELECT CASE i
        CASE 0: tx = x - 1: ty = y
        CASE 1: tx = x + 1: ty = y
        CASE 2: tx = x: ty = y - 1
        CASE 3: tx = x: ty = y + 1
        CASE 4: tx = x - 1: ty = y - 1
        CASE 5: tx = x + 1: ty = y + 1
        CASE 6: tx = x + 1: ty = y - 1
        CASE 7: tx = x - 1: ty = y + 1
        END SELECT
        IF (tx >= 0) AND (ty >= 0) AND (tx < xd) AND (ty < yd) THEN 'bounds
         IF (s(tx, ty).st AND &HD) = 0 THEN 'check if already revealed, marked, flagged
          IF s(tx, ty).id = " " THEN    'is blank?
           s(tx, ty).st = 8: n = -1     'cascade some more, temp mark, will be finilized in next loop
           IF (tx < bx) AND (bx > 0) THEN bx = bx - 1   'broaden scope
           IF (ty < by) AND (by > 0) THEN by = by - 1
           IF (tx > ex) AND (ex < (xd - 1)) THEN ex = ex + 1
           IF (ty > ey) AND (ey < (yd - 1)) THEN ey = ey + 1
          ELSE  'not blank
           s(tx, ty).st = 4: nlef = nlef - 1: upd(tx, ty) = -1  'border, finilize now
          END IF
         END IF
        END IF
       NEXT i   'end of adjacent possibility loop
      END IF
     NEXT y
    NEXT x      'end of marked square handler loops
   LOOP WHILE n 'loop until done. end of multiple-pass loop
  CASE ELSE     'regular numbered square
   IF snd THEN PLAY "c"
   s(cx, cy).st = 4: upd(cx, cy) = -1: nlef = nlef - 1  'regular
  END SELECT
  GOSUB updscr  'update predetermined squares
  GOSUB drwlef
  IF nlef = 0 THEN      'victory condition
   IF snd THEN PLAY "l16a.>df.<l64"
   COLOR 15, 1: LOCATE 25, 32: PRINT "VICTORY!";
   SLEEP: WHILE INKEY$ <> "": WEND
   IF level <= 2 THEN
    IF elap < score(level).sec THEN     'high score condition
     IF snd THEN PLAY "p1l4a.a>e.<l64"
     COLOR 15, 1: CLS
     PRINT "High score!"
     PRINT "Previous champion:"
     PRINT "'"; score(level).nam; "',"
     PRINT "with"; score(level).sec; "seconds."
     PRINT
     PRINT "You won in"; elap; "seconds."
     PRINT "Num of broken records in this level now:";
     IF score(level).rai < &H7FFF THEN score(level).rai = score(level).rai + 1
     PRINT score(level).rai
     PRINT
     PRINT "(28 chars) Enter your name."
     LINE INPUT "? "; score(level).nam
     score(level).sec = elap
     n = -1     'write
     GOSUB fileio       'file I/O
    END IF
   END IF
   GOSUB newgame        'new game
  END IF
 END IF
RETURN

redo:   'Restart this game. calls initscr and reveal
 FOR x = 0 TO xd - 1
  FOR y = 0 TO yd - 1
   s(x, y).id = bak(x, y)       'restore from backup
   s(x, y).st = 0       'clear status
   upd(x, y) = 0
  NEXT y
 NEXT x
 nlef = (xd * yd) - nmines
 nmarks = nmines
 cx = sx: cy = sy
 GOSUB initscr  'initialize screen
 GOSUB reveal           'reveal initial square, same square as on first attempt
 elap = 999     'second attempts are not timed and never get a high score.
 game = 2
RETURN

updscr:         'updates predetermined squares. Not to be used for flags or "?"s
 FOR x = 0 TO xd - 1
  FOR y = 0 TO yd - 1
   IF upd(x, y) THEN    'has it been marked for an update?
    LOCATE yd - y, x + 1
    IF s(x, y).st AND 4 THEN
     SELECT CASE ASC(s(x, y).id)
     CASE &H20: COLOR 3, 0
     CASE &H31: COLOR 9, 0
     CASE &H32: COLOR 10, 0
     CASE &H33: COLOR 12, 0
     CASE &H34: COLOR 11, 0
     CASE &H35: COLOR 14, 0
     CASE &H36: COLOR 11, 0
     CASE &H37: COLOR 13, 0
     CASE &H38: COLOR 15, 0
     CASE &HF: COLOR 31, 0
     END SELECT
     PRINT s(x, y).id;
    ELSE
     COLOR 3, 0: PRINT CHR$(&HFA);      'unrevealed square
    END IF
    upd(x, y) = 0       'unmark
   END IF
  NEXT y
 NEXT x
RETURN

newgame:        'starts a new game, calls initscr
 IF snd THEN PLAY "l64<ado6ado1l64"
 cx = 0: cy = 0
 nlef = (xd * yd) - nmines      'number of good squares left
 nmarks = nmines        'number of unused flags
 game = 0        '0=reset; 1=in play; 2=redo
 elap = 0
 oelap = 999
 sx = -1        'starting square yet unchosen, game is not in play
 GOSUB initscr  'initialize screen
 FOR x = 0 TO xd - 1
  FOR y = 0 TO yd - 1
   s(x, y).st = 0       'clear status
  NEXT y
 NEXT x
 'the board is not set yet. That will happen when user chooses first square.
RETURN

initscr: 'this is resposible for setting up the initial screen
 WIDTH 40, 25: COLOR 7, 1: CLS
 VIEW PRINT 1 TO 25
 COLOR 3, 0
 LOCATE 1, 1
 FOR y = yd TO 1 STEP -1
  PRINT STRING$(xd, &HFA);
  IF yd - y < 24 THEN PRINT
  FOR x = 0 TO xd - 1
   upd(x, y - 1) = 0
  NEXT x
 NEXT y
 GOSUB drwclock
 GOSUB drwminen
 GOSUB drwsnd
 GOSUB drwlef
 LOCATE 4, 39: COLOR 14, 1: PRINT CHR$(2);      'decorative happy face
 LOCATE 10, 39: COLOR 7, 1
 SELECT CASE level
 CASE 0: PRINT "B";
 CASE 1: PRINT "I";
 CASE 2: PRINT "E";
 CASE 3: PRINT "C";
 END SELECT
RETURN

drwsnd:         'draws sound status indicator
 LOCATE 8, 39: COLOR 7, 1: IF snd THEN PRINT CHR$(&HE);  ELSE PRINT ; " ";
RETURN

drwlef:         'draws number of non-mine squares remaining. victory is when # reaches 0
 LOCATE 12, 38: COLOR 9, 1
 t = LTRIM$(STR$(nlef))
 t = STRING$(3 - LEN(t), "0") + t
 PRINT t;
RETURN

drwclock:       'draws the clock. this may be called while mouse is visible
 ovis = visible
 IF visible THEN GOSUB hidemouse        'to prevent graphical corruption
 LOCATE 2, 37, 0
 COLOR 12, 0
 t = LTRIM$(STR$(elap))
 t = STRING$(3 - LEN(t), "0") + t
 PRINT t;
 IF ovis THEN GOSUB showmouse
RETURN

drwminen:       'draws number of mines - flags used
 COLOR 12, 0
 t = LTRIM$(STR$(ABS(nmarks)))
 t = STRING$(3 - LEN(t), "0") + t
 IF nmarks < 0 THEN t = "-" + t ELSE t = " " + t
 LOCATE 6, 36: PRINT t;
RETURN

setfld: 'this is responsible for initing the playing field for new game
 'this is called when the user chooses his first square on a blank board. The
 'mines are laid and the clock starts after the first square has been chosen.
 sx = cx: sy = cy       'save start position for redo
 FOR x = 0 TO xd - 1    'clear board
  FOR y = 0 TO yd - 1
   s(x, y).id = " "
   s(x, y).st = 0
  NEXT y
 NEXT x
 FOR i = 0 TO nmines - 1        'place mines
  DO
   x = INT(RND * xd): y = INT(RND * yd)
  LOOP UNTIL (s(x, y).id = " ") AND ((sx <> x) OR (sy <> y))
  s(x, y).id = CHR$(&HF)
  mloc(i).x = x: mloc(i).y = y  'store location
 NEXT i
 FOR i = 0 TO nmines - 1        'mines affect adjacent squares
  FOR x = mloc(i).x - 1 TO mloc(i).x + 1
   FOR y = mloc(i).y - 1 TO mloc(i).y + 1
    IF (x >= 0) AND (x < xd) THEN
     IF (y >= 0) AND (y < yd) THEN      'bounds
      SELECT CASE ASC(s(x, y).id)       'increment #
      CASE &H20: s(x, y).id = "1"
      CASE &H30 TO &H37: s(x, y).id = CHR$(ASC(s(x, y).id) + 1)
      END SELECT
     END IF
    END IF
   NEXT y
  NEXT x
 NEXT i
 FOR x = 0 TO xd - 1    'backup field for redo
  FOR y = 0 TO yd - 1
   bak(x, y) = s(x, y).id
  NEXT y
 NEXT x
 game = 1       'game is in play
 start = TIMER  'mark start time
RETURN

initlevel:      'default values for standard levels. Conforms to Minesweeper.
 SELECT CASE level
 CASE 0: xd = 8: yd = 8: nmines = 10    'begginer
 CASE 1: xd = 16: yd = 16: nmines = 40  'intermediate
 CASE 2: xd = 30: yd = 16: nmines = 99  'expert
 END SELECT
 GOSUB newgame          'start newgame
RETURN

fileio:         'reads/writes the high score file
 PRINT "Opening score file: '"; file; "'."
 OPEN file FOR BINARY AS 1
 i = LOF(1)
 IF (i > 0) AND (i <> 96) THEN
  PRINT "Important file overwrite protection feature:"
  PRINT "File size is not 96 bytes. Please verify that file is not critical."
  PRINT "If not, erase the file. If so, change either the current directory, or the"
  PRINT "'file' constant within the program."
  PRINT "Size:"; i; "Expected: 96."
  CLOSE
  SYSTEM
 END IF
 IF (i = 0) OR n THEN
  PRINT "Creating new score file."
  FOR i = 0 TO 2: PUT 1, (i * 32) + 1, score(i): NEXT i
 ELSE
  PRINT "Reading score data."
  FOR i = 0 TO 2: GET 1, (i * 32) + 1, score(i): NEXT i
 END IF
 CLOSE
 PRINT "Done."
RETURN

clevel:         'user chooses a level
 WIDTH 80, 25
 COLOR 7, 1: CLS
 PRINT "Level:", "X dim:", "Y dim:", "Mines:"
 PRINT "Begginer", "8", "8", "10"
 PRINT "Intermediate", "16", "16", "40"
 PRINT "Expert", "30", "16", "99"
 PRINT "Custom", "?", "?", "?"
 PRINT
 PRINT "B/I/E/C ? ";
 DO
  k$ = UCASE$(INKEY$)
  SELECT CASE k$
  CASE CHR$(&H1B): GOSUB thechamps: SYSTEM
  CASE "B": level = 0
  CASE "I": level = 1
  CASE "E": level = 2
  CASE "C": level = 3
  CASE ELSE: k$ = ""
  END SELECT
 LOOP UNTIL LEN(k$)
 PRINT k$
 IF level <= 2 THEN GOSUB initlevel: RETURN     'premature exit
        'level is 3
 PRINT
 INPUT "X"; xd
 INPUT "Y"; yd
 INPUT "Mines"; nmines
 IF xd < minx THEN xd = minx    'limits
 IF xd > maxx THEN xd = maxx
 IF yd < miny THEN yd = miny
 IF yd > maxy THEN yd = maxy
 IF nmines < minmines THEN nmines = minmines
 IF nmines > maxmines THEN nmines = maxmines
 GOSUB newgame          'starts a newgame
RETURN

help:   'also acts as a pause
 SCREEN , , 1, 1        'use video page 1
 COLOR 11, 1: CLS
 IF game = 1 THEN PRINT "Game paused.": PRINT
 PRINT "ESC - quit"
 PRINT "S - toggle sound"
 PRINT "F2 - new game"
 PRINT "F10 - select level and start new game"
 PRINT "SPACE / left-click - uncover square"
 PRINT "ENTER / right-click - toggle normal/flag/'?'"
 PRINT "Arrows / mouse motion - move cursor"
 PRINT
 PRINT
 PRINT "Need more help? Found a bug? Want to"
 PRINT "comment? Please contact me via the"
 PRINT "'Classic' forum at:"
 PRINT "http://www.qbasic.com/"
 PRINT ", or email me at:"
 PRINT "mcalkins0"; "@"; "hotmail.com"
 SLEEP: WHILE INKEY$ <> "": WEND
 SCREEN , , 0, 0        'use page 0
 start = TIMER - elap   'unpause. The user may gain a fraction of a second, but
 'it will take him that long to orient himself.
RETURN

thechamps:      'displayed before normal (non-error) termination.
 WIDTH 80, 25: COLOR 7, 0: CLS
 COLOR 15, 6: PRINT "PeanutWare"; : COLOR 11, 0
 PRINT " mcalkins0"; "@"; "hotmail.com": COLOR 7, 0
 PRINT "Programming by Michael Calkins. Thank you for playing this freeware game."
 PRINT "Win NT/2000/XP compatible mouse routine donated by The PhyloGenesis. Thanks."
 PRINT
 PRINT "If you use Windows NT/2000/XP and have trouble with the mouse, try setting the"
 PRINT "'mouseoption' constant to 2."
 PRINT
 PRINT "This game was tested using QBASIC 1.1 on MS-DOS 7.1, Win 95b, and Win 98SE."
 PRINT "This game was tested using QBASIC 1.0 on IBM OS/2 Warp 3."
 PRINT
 COLOR 10, 1
 PRINT "---The Champions---"
 n = CSRLIN
 COLOR 11, 0
 PRINT "Beginner:": PRINT "Intermediate:": PRINT "Expert"
 FOR i = 0 TO 2
  LOCATE i + n, 16: COLOR 15, 1: PRINT score(i).nam, ; : COLOR 11, 1
  t = STR$(score(i).sec): t = SPACE$(4 - LEN(t)) + t
  PRINT t; " seconds."; : COLOR 9, 0: PRINT score(i).rai
 NEXT i
 COLOR 7, 0
 PRINT
RETURN

accessmouse:    'accesses the mouse, using either of the routines
 IF NOT cd.s THEN WIDTH 80, 25: COLOR 7, 0: CLS : PRINT "ERR with codeinit": SYSTEM
 SELECT CASE mousepref
 CASE 1: DEF SEG = VARSEG(cd.code): CALL Absolute(VARPTR(cd.code))      'mine
 CASE 2
  cd.bxv = 0: cd.cxv = 0: cd.dxv = 0: DEF SEG = VARSEG(cd.PG)   'Phylo's
  CALL Absolute(cd.axv, cd.bxv, cd.cxv, cd.dxv, VARPTR(cd.PG))
 END SELECT
 DEF SEG
RETURN

showmouse:      'display mouse cursor
 cd.axv = 1
 GOSUB accessmouse
 visible = -1
RETURN

hidemouse:      'hide mouse cursor
 cd.axv = 2
 GOSUB accessmouse
 visible = 0
RETURN

resetmouse:     'resets mouse
 cd.axv = 0
 GOSUB accessmouse
 IF NOT cd.axv THEN mousepref = 0 'no mouse? (borrowed from Phylo's code)
 obx = 0: ocx = o: odx = 0
RETURN

initmousecode:          'loads both mouse routines
 PRINT "Loading mouse routines"

' ;Written by Michael Calkins
' ;this routine has been tested on and fine on the following operating systems:
' ;MS-DOS 7.1, MS Windows 95b, MS Windows 98SE, IBM OS/2 Warp 3
'A1????        MOV     AX,[axv]
'CD33          INT     33
'A3????        MOV     [axv],AX
'890E????      MOV     [cxv],CX
'8916????      MOV     [dxv],DX
'891E????      MOV     [bxv],BX
'CB            RETF

 t$ = ""        'my routine incorporates memory offsets at runtime
 t$ = t$ + CHR$(&HA1) + MKI$(VARPTR(cd.axv))'MOV AX,[axv]
 t$ = t$ + CHR$(&HCD) + CHR$(&H33)'INT 33
 t$ = t$ + CHR$(&HA3) + MKI$(VARPTR(cd.axv))'MOV [axv],AX
 t$ = t$ + CHR$(&H89) + CHR$(&HE) + MKI$(VARPTR(cd.cxv))'MOV [cxv],CX
 t$ = t$ + CHR$(&H89) + CHR$(&H16) + MKI$(VARPTR(cd.dxv))'MOV [dxv],DX
 t$ = t$ + CHR$(&H89) + CHR$(&H1E) + MKI$(VARPTR(cd.bxv))'MOV [bxv],BX
 t$ = t$ + CHR$(&HCB)'RETF
 IF LEN(t$) <> LEN(cd.code) THEN PRINT "ERROR with initcd": SYSTEM
 cd.code = t$
 FOR i = 1 TO 57        'Phylo's is static
  MID$(cd.PG, i, 1) = CHR$(VAL("&h" + MID$(PhyloGenesis, (i * 2) - 1, 2)))
 NEXT i
 cd.s = -1

'functions 0 to 3:
'0, "Reset mouse and get status"
'1, "Show mouse pointer"
'2, "Hide mouse pointer"
'3, "Get mouse position and button status"
 PRINT "Done."
RETURN

*

'Written by Michael Calkins
DEFINT A-Z

CONST upperBound = 6    'this should be 1 less than the number of values

DIM InputN(0 TO upperBound)
DIM Ascend(0 TO upperBound)
DIM Descend(0 TO upperBound)

CLS
PRINT "Input"; upperBound + 1; "numbers:"
FOR i = 0 TO upperBound
 INPUT InputN(i)
NEXT i

'sort Ascending

last = -1
FOR i = 0 TO upperBound         'this is the "slot" loop
 best = -1
 FOR n = 0 TO upperBound        'this loop tests each candidate for each slot
  IF best = -1 THEN     'first legal candidate?
   IF last = -1 THEN    'first slot?
    best = n    'this is the first slot and first candidate
   ELSE 'not first slot
    IF InputN(n) > InputN(last) THEN    'better than the last slot?
     best = n
    ELSE 'not better; test if it is equal to last slot, with a greater index
     IF (InputN(n) = InputN(last)) AND (n > last) THEN best = n
    END IF
   END IF
  ELSE  'not first leagl candidate
   IF last = -1 THEN    'first slot?
    IF InputN(n) < InputN(best) THEN best = n   'better than previous candidate?
   ELSE 'not first slot
    IF InputN(n) > InputN(last) THEN    'better than last slot?
     IF InputN(n) < InputN(best) THEN best = n  'better than previous candidate?
    ELSE 'not better;. test if it is equal to last slot, with a greater index, and than previous candidate
     IF (InputN(n) = InputN(last)) AND (n > last) AND (InputN(n) < InputN(best)) THEN best = n
    END IF
   END IF
  END IF
 NEXT n
 Ascend(i) = InputN(best) 'we know which candidate is best for this slot
 last = best    'and we prepare for the next iteration
NEXT i

'sort Descending

last = -1
FOR i = 0 TO upperBound
 best = -1
 FOR n = 0 TO upperBound
  IF best = -1 THEN
   IF last = -1 THEN
    best = n
   ELSE
    IF InputN(n) < InputN(last) THEN
     best = n
    ELSE
     IF (InputN(n) = InputN(last)) AND (n > last) THEN best = n
    END IF
   END IF
  ELSE
   IF last = -1 THEN
    IF InputN(n) > InputN(best) THEN best = n
   ELSE
    IF InputN(n) < InputN(last) THEN
     IF InputN(n) > InputN(best) THEN best = n
    ELSE
     IF (InputN(n) = InputN(last)) AND (n > last) AND (InputN(n) > InputN(best)) THEN best = n
    END IF
   END IF
  END IF
 NEXT n
 Descend(i) = InputN(best)
 last = best
NEXT i

'display results:

PRINT
PRINT "Ascending:", ;
FOR i = 0 TO upperBound
 PRINT Ascend(i);
NEXT i
PRINT
PRINT "Descending:", ;
FOR i = 0 TO upperBound
 PRINT Descend(i);
NEXT i
PRINT

SYSTEM