Shareware Overload/ShartewareOverload.cdr/games/m18v22.zip/M18.BAS

BASIC Source File | 1988-02-01 | 6KB | 189 lines

'****************************************************
'This program is designed to be used with the MEAN-18
'golf game by Accolade. It will allow you to have as
'many golf courses as you wish available to play rather
'than the limit of three imposed by MEAN-18.
'
'A special thanks to Fred Strobl for his programming
'help with the read.filename routine he wrote for me.
'
'written in March, 1987 by Ken Hopkins (WA9WCP)
'who only wishes he could play golf for real as well as
'he can with Mean18.
'
'========  Modifications since the origonal release  ========
'
' 12/30/87 - I added a CLS to the first line of "readdir" to
'            ensure that the files were always displayed in
'            the proper place on the screen and thus would
'            always be read correctly.
'            I also rewrote the "choose" function so that it
'            would work properly with more than 9 courses.
'            Released as M18V20.ARC
'
' 12/31/87 - Added the capability to utilize up to 42 courses.
'            Changed the format of the menu display to allow
'            three columns of names.
'            Fixed a bug that wouldn't let you select the same
'            course twice in a row.
'
' 01/02/88 - Fixed a bug that didn't allow the full 42 courses
'            to be used...only 41!  Added some error checking
'            code.  This is version 2.1
'
' 01/29/88 - Once again I have increased the capacity of the
'            program.  It is reaching the point where I am out
'            of screen space!  I have renumbered this version
'            to 2.2.  I used a couple of routines from the
'            Advanced Basic 4.0 library.  You need to have this
'            to be able to compile the program now.
'
'                                     Dick Stout
'                                     Computing Technology BBS
'                                     [phone]
'
KEY OFF
DEFINT A-Z
Max = 100                  '**Changed max files to 100
DIM File$(Max)
'
CLS
GOSUB CheckGolfFile   'Make sure the GOLF.* file is present
GOSUB Getfiles
GOSUB Menu            'Display which courses are available?
GOSUB Choose          'Choose which course do you want to play?
SHELL "GOLF"          'Call the Golf game

END
'

Menu:
Fmt1$ = "\\### - \      \"
CLS
PRINT TAB(15); "M18.EXE; version 2.2, compiled with QBasic 4.0"
PRINT
PRINT TAB(5); "                   Menu of available MEAN-18 Golf Courses"
PRINT TAB(5); "~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~"
'PRINT
FOR a = 1 TO Max STEP 5
  SELECT CASE a
  CASE IS < Max - 3
    PRINT USING Fmt1$; ""; a; File$(a); ""; a + 1; File$(a + 1);
    PRINT USING Fmt1$; ""; a + 2; File$(a + 2); ""; a + 3; File$(a + 3);
    PRINT USING Fmt1$; ""; a + 4; File$(a + 4)
  CASE IS < Max - 2
    PRINT USING Fmt1$; ""; a; File$(a); ""; a + 1; File$(a + 1);
    PRINT USING Fmt1$; ""; a + 2; File$(a + 2); ""; a + 3; File$(a + 3)
  CASE IS < Max - 1
    PRINT USING Fmt1$; ""; a; File$(a); ""; a + 1; File$(a + 1);
    PRINT USING Fmt1$; ""; a + 2; File$(a + 2)
  CASE IS < Max
    PRINT USING Fmt1$; ""; a; File$(a); ""; a + 1; File$(a + 1)
  CASE ELSE
    PRINT USING Fmt1$; ""; a; File$(a)
  END SELECT
NEXT
PRINT
RETURN
'
Choose:
ch$ = ""
Iline = CSRLIN
WHILE (ch$ = "")
   LOCATE Iline, 1
   INPUT "      Enter the number of the course you wish to play => ", ch$                         'ADDED 12/30/87 by Dick Stout
WEND
i = VAL(ch$)
IF i > 0 AND i <= Max THEN
   NAME File$(i) AS LEFT$(File$(i), 8) + ".M18"
ELSE
   GOSUB Menu
   GOTO Choose
END IF
RETURN

Getfiles:
Filename$ = "*.M1?" + CHR$(0)
fil$ = SPACE$(12)
CALL findfirstf(Filename$, attr%, ercd%)
IF ercd% THEN
    PRINT "No MEAN-18 courses were found, this program must be run in"
    PRINT "the directory that contains the .M10 or M18 courses."
    END
ELSE
    CALL getnamef(fil$, flen%)
    File$(1) = LEFT$(fil$, 12)
END IF
IF ercd% = -1 THEN PRINT "ERROR!"

i = 2
DO WHILE ercd% = 0
CALL findnextf(ercd%)
IF ercd% THEN
    PRINT
ELSE
    CALL getnamef(fil$, flen%)
    File$(i) = LEFT$(fil$, 12)
    i = i + 1
END IF
IF ercd% = -1 THEN
    PRINT "ERROR!"
    EXIT DO
END IF
LOOP
Max = i - 1

FOR j = 1 TO Max
    k = INSTR(File$(j), ".")
    first$ = LEFT$(File$(j), k - 1)
    fext$ = MID$(File$(j), k + 1, 3)
    File$(j) = first$ + SPACE$(8 - LEN(first$)) + "." + fext$
    IF MID$(File$(j), 10, 3) = "M18" THEN            'rename left over *.M18
        NAME File$(j) AS LEFT$(File$(j), 8) + ".M10"  'files from last game
        File$(j) = LEFT$(File$(j), 8) + ".M10"
    END IF
NEXT
' ============================== BubbleSort ==================================
'    The BubbleSort algorithm cycles through SortArray, comparing adjacent
'    elements and swapping pairs that are out of order.  It continues to
'    do this until no pairs are swapped.
' ============================================================================
'
BubbleSort:
   Limit = Max
   DO
      Switch = FALSE
      FOR Row = 1 TO (Limit - 1)

         ' Two adjacent elements are out of order, so swap their values
         ' and redraw those two bars:
         IF File$(Row) > File$(Row + 1) THEN
            SWAP File$(Row), File$(Row + 1)
            Switch = Row
         END IF
      NEXT Row

      ' Sort on next pass only to where the last switch was made:
      Limit = Switch
   LOOP WHILE Switch

RETURN

RETURN

CheckGolfFile:
Filename$ = "GOLF.*" + CHR$(0)
fil$ = SPACE$(12)
CALL findfirstf(Filename$, attr%, ercd%)
IF ercd% THEN
    PRINT
    PRINT "No GOLF.EXE file was found, this program must be run in"
    PRINT "the directory that contains GOLF.EXE and the courses."
    PRINT
    END
ELSE
END IF
RETURN