'===========================================================================
' Subject: BBS GAME PROGRAMMING               Date: 04-14-96 (00:00)       
'  Author: Robert Fortune                     Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: MISC.ABC
'===========================================================================
'>statements, but the Real problem is, what if a new user
'>wants to use the game? Can someone help... I need it to
'>open the player.dat file, search for the Real Name, Load
'>The Data, And Save The Data in the right spot.... Can
'>Someone Help Me?

'   I can try. The following code uses a random access file to keep
'   scores for a BBS game. The PlayerName field is the key field
'   that the code uses to keep track of the players and their scores,
'   etc... The code also creates an SCORES.ANS file which is just an ANSI
'   high scores file that a SysOp can use on his BBS bulletin(s) menu. You
'   can modify as needed or use as a rough guide. It will reach you in
'   2 messages as it's kind of long so you will need to edit it back into
'   a single file before running it. Hope it helps. Good luck!

' ----------------------- CUT HERE -------------CUT HERE ----------------
REM GAMESHEL.BAS  04/14/96
REM QB/QBX Demo game shell using a Random Access data file to store,
REM sort and display players names and scores. Also creates an ANSI
REM color high scores bulletin file (SCORES.ANS)

DEFINT A-Z  ' all untyped variables default to type integer
DECLARE SUB MoveCursor (X%, Y%)           ' position cursor on screen
DECLARE SUB SetColors (FG%, BG%, Attrib%) ' set ANSI colors to use

REM Define our random access file structure
TYPE GameRecord
     RecordNumber AS INTEGER
     PlayerAlias AS STRING * 25
     PlayerName AS STRING * 25
     ExperPoints AS LONG
     GoldOnHand AS LONG
     GoldInBank AS LONG
     Beauty AS LONG
     GEMS AS LONG
     PlayerScore AS LONG
     PlayerDay AS STRING * 11
END TYPE
DIM PlayerRecord AS GameRecord   ' reserve some memory
DIM TempRecord AS GameRecord

CONST True = -1, False = NOT True
ClrScrn$ = CHR$(27) + "[2J"      ' clear ANSI screen

OPEN "CONS:" FOR OUTPUT AS #1    ' local output via CONSole device

REM Open the random access players file
OPEN "GAMEFILE.DAT" FOR RANDOM AS #2 LEN = LEN(PlayerRecord)

REM Here is where you would normally get the player's name from the BBS drop
REM file (DOOR.SYS, PCBOARD.SYS, etc...). As an example we get the player's
REM name manually. In a BBS game door you should get the info from the BBS
REM drop file.

DO
  CLS
  LINE INPUT "Please enter your FULL Name: "; FullName$
  FullName$ = UCASE$(FullName$)
LOOP WHILE FullName$ = ""

REM Search existing records for a match on player's full name.
REM We're using record number 1 for the All-Time-Winner record
REM to keep all the player data in the same file.

RecordNumber% = 1   ' this record is reserved for All-Time-Winner
IF LOF(2) > 0 THEN  ' Any records in the file yet?
   DO
      RecordNumber% = RecordNumber% + 1
      GET #2, RecordNumber%, PlayerRecord
   LOOP UNTIL (RTRIM$(PlayerRecord.PlayerName) = FullName$) OR (EOF(2))
ELSE
   RecordNumber% = RecordNumber% + 1
   PlayerRecord.PlayerName = FullName$
   PlayerRecord.PlayerScore = 500  ' start each player with 500 points
   PlayerRecord.PlayerDay = DATE$
   PUT #2, 1, PlayerRecord
   PUT #2, 2, PlayerRecord
END IF

REM Did we find a match?

IF RTRIM$(PlayerRecord.PlayerName) <> FullName$ THEN ' No match, new player
   RecordNumber% = LOF(2) \ LEN(PlayerRecord) + 1
   PlayerRecord.PlayerName = FullName$
   PlayerRecord.PlayerScore = 500  ' start each player with 500 points
   PlayerRecord.PlayerDay = DATE$
   PUT #2, RecordNumber%, PlayerRecord
END IF
CLOSE #2

Score# = PlayerRecord.PlayerScore

Start:

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' YOUR PROGRAM STARTS HERE
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

' Somewhere in your game player would win/lose points as in

Score# = Score# + 10   ' demo score keeper for game

' More of your game program

' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
' YOUR GAME ENDS HERE. Now we need to update the player's scores.
' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Finish:

OPEN "GAMEFILE.DAT" FOR RANDOM AS #2 LEN = LEN(PlayerRecord)
OPEN "SCORES.ANS" FOR OUTPUT AS #3  ' open ANSI high scores bulletin file

RecordNumber% = 2
GET #2, RecordNumber%, PlayerRecord
DO UNTIL RTRIM$(PlayerRecord.PlayerName) = FullName$
   RecordNumber% = RecordNumber% + 1
   GET #2, RecordNumber%, PlayerRecord
LOOP
PlayerRecord.PlayerScore = Score#
PlayerRecord.PlayerDay = DATE$

REM See if we have a new All-Time-Winner
GET #2, 1, TempRecord
IF PlayerRecord.PlayerScore > TempRecord.PlayerScore THEN
   PUT #2, 1, PlayerRecord    ' write a new all-time winner record
END IF

REM Write the updated player's record to random access highscores file
PUT #2, RecordNumber%, PlayerRecord
' (Disk) Sort players scores using basic bubblesort from MS QB Bible book
DO
   Switch = False
   FOR I% = 2 TO (LOF(2) \ LEN(PlayerRecrd)) - 1
       GET #2, I%, PlayerRecord
       GET #2, I% + 1, TempRecord
       IF PlayerRecord.PlayerScore < TempRecord.PlayerScore THEN
          SWAP PlayerRecord, TempRecord
          PUT #2, I%, PlayerRecord
          PUT #2, I% + 1, TempRecord
          Switch = True
       END IF
   NEXT I
LOOP WHILE Switch
' Now print the players names and scores which are in sorted order
' in the GAMEFILE.DAT file (sorted on players' scores).

PRINT #1, ClrScrn$        ' clear the screen
PRINT #3, ClrScrn$

REM this is where the final score board starts .
GET #2, 1, PlayerRecord
CALL SetColors(33, 40, 1)  ' make screen colors bright yellow on black

REM (Long line split to fit email line length)
Text$ = "< < <  " + RTRIM$(PlayerRecord.PlayerName) + " won "
Text$ = Text$ + LTRIM$(STR$(PlayerRecord.PlayerScore)) + " points on "
Text$ = Text$ + PlayerRecord.PlayerDay + "  > > > "

X% = 2                     ' print on 2nd line of screen
Y% = 40 - LEN(Text$) \ 2   ' center the high scores title
CALL MoveCursor(X%, Y%)    ' position the cursor
PRINT #1, Text$      ' print high scores title to the screen
PRINT #3, Text$      ' print high scores title to the SCORES.ANS file
CALL SetColors(34, 40, 1) ' make screen colors bright blue on black
Text$ = "Last Played     Player                  Score"
X% = 4
Y% = 40 - LEN(Text$) \ 2
CALL MoveCursor(X%, Y%)
PRINT #1, Text$
PRINT #3, Text$
CALL SetColors(31, 40, 1)   ' make screen colors bright red on black
Text$ = "-------------------------------------------------"
X% = X% + 1
Y% = 40 - LEN(Text$) \ 2
CALL MoveCursor(X%, Y%)
PRINT #1, Text$
PRINT #3, Text$
CALL SetColors(32, 40, 1)   ' make screen colors bright green on black
Y% = Y% + 2
REM Print out the first 10 records in our random access file
IF LOF(2) \ LEN(PlayerRecord) < 12 THEN
   Bottom% = LOF(2) \ LEN(PlayerRecord)
ELSE
   Bottom% = 11
END IF
FOR I% = 2 TO Bottom%
    GET #2, I%, PlayerRecord
    Text$ = PlayerRecord.PlayerDay + "      " + PlayerRecord.PlayerName
    Text$ = Text$ + "    " + STR$(PlayerRecord.PlayerScore)
    X% = X% + 1
    CALL MoveCursor(X%, Y%)
    PRINT #1, Text$
    PRINT #3, Text$
NEXT I%
REM Print an underline after top scores are displayed
CALL SetColors(31, 40, 1)   ' make screen colors bright red on black
Text$ = "================================================="
X% = X% + 1
Y% = 40 - LEN(Text$) \ 2
CALL MoveCursor(X%, Y%)
PRINT #1, Text$
PRINT #3, Text$
CALL SetColors(40, 37, 1)  ' set screen colors bright white on black
Text$ = "[PRESS ANY KEY TO CONTINUE]"
X% = X% + 2
Y% = 40 - LEN(Text$) \ 2
CALL MoveCursor(X%, Y%)
PRINT #1, Text$
DO
   AnyKey$ = INKEY$
LOOP UNTIL LEN(AnyKey$)
CALL SetColors(37, 40, 0)  ' reset screen colors to drab white on black
PRINT #1, ClrScrn$         ' clear the screen
CLOSE #1, #2, #3           ' All done. Close up all open files
END                        ' The End

' Position cursor on ANSI screen where X% = screen row position and
' Y% = screen column position where X% can equal 1 thru 25 and Y%
' can equal 1 thru 80.
SUB MoveCursor (X%, Y%)
Move$ = CHR$(27) + "[" + LTRIM$(STR$(X%)) + ";"
Move$ = Move$ + LTRIM$(STR$(Y%)) + "H"
PRINT #1, Move$;
END SUB

' Set ANSI screen colors
' FG% = ANSI foreground color, BG% = ANSI background color.
' Valid fore colors (FG%)     Valid back colors (BG%)
' Black   30                        40
' Red     31                        41
' Green   32                        42
' Yellow  33                        43
' Blue    34                        44
' Magenta 35                        45
' Cyan    36                        46
' White   37                        47
' ANSI Attr% = attribute (bright(1), blink(5), reverse(7), reset(0)-
' cancelled(8), underline(4) (mono only else blue)
SUB SetColors (FG%, BG%, Attr%)
    Text$ = CHR$(27) + "[" + LTRIM$(STR$(Attr%)) + ";"
    Text$ = Text$ + LTRIM$(STR$(BG%)) + ";" + LTRIM$(STR$(FG%)) + "m"
    PRINT #1, Text$;
    PRINT #3, Text$;
END SUB