/***********************************************************************/
/*                BBS DOWNS! (V2.01d for BBBBS, 18 Oct 93)              */
/***********************************************************************/
/*     A horse race pfile written in Arexx for the Amiga Cnet BBS!     */
/*                                                                     */
/*     Brought to you by Lori Bogan and Gene Ponce, sysops of....      */
/*                                                                     */
/*                   Superboard Two (702) 423-7206                     */
/*                                                                     */
/*         Converted for Tempest & Modified by Sean Kelly              */
/*                                                                     */
/*                           Amizon BBS                                */
/*                                                                     */
/*                          312-594-1146                               */
/*                                                                     */
/* This program is based on another program called "Horses" which was  */
/* written in C for the Tag BBS.  While this program is not a direct   */
/* porting of the "Horses" program, we would still like to credit the  */
/* author of "Horses", D.Budzitowski, for many of the concepts we have */
/* used in this pfile!                                                 */
/***********************************************************************/
/*                    A FEW NOTES TO OTHER SYSOPS                      */
/***********************************************************************/
/*  1. With this door you should also have an accompanying file called */
/*     Dinstuct which is called when the user asks for instructions.   */
/*     If that file is not present you can make a simple text file to  */
/*     to be used or do nothing since the program will still  run      */
/*     without the Dinstruct file.                                     */
/*  2. You will need to change the variables below (under the comment  */
/*     *BBS variable initialization*) to suit your configuration.      */
/***********************************************************************/
/*                       VARIABLE DECLARATIONS                         */
/***********************************************************************/
/* BBSname   = name of the BBS this pfile is being run on              */
/* Sysopname = name of the sysop offering this pfile                   */
/* Progname  = name of this program                                    */
/* FilePath  = path to subdirectory for support files                  */
/* input     = used in CHECKPANIC procedure to hold input argument     */
/* Uhandle   = Handle of current player                                */
/* Udate     = Current date & time                                     */
/* Uaccess   = User's access number (0,23)                             */
/* CLS       = User's screen clear code                                */
/* AcctBal   = Current player's account balance                        */
/* LowBal    = Flag to signal when player's acct balance is too low    */
/* MaxPlayers= Maximum players allowed                                 */
/* player.i  = 'array' to hold all player handles                      */
/* score.i   = 'array' to hold all player acct balances                */
/* i, j      = simple counters used in various places in program       */
/* temp      = temporary variable used when sorting/swapping           */
/* nplayers  = total number of players in Dplayers files               */
/* Flag      = used to signal different events                         */
/* More      = used to ask if user wants to see more of the score list */
/* Choice    = main menu choice                                        */
/* Another   = does player want to bet on ANOTHER race?                */
/* Hname.i   = horse names                                             */
/* WHorse.i  = horse(s) picked to win, show or place                   */
/* WBet.i    = amount bet to win, show or place                        */
/* WOdds.i   = holds the current "To win" odds on the horses           */
/* POdds.i   = holds the current "To place" odds on the horses         */
/* SOdds.i   = holds the current "To show" odds on the horses          */
/* RNum      = holds random numbers picked for horse race              */
/* Count.i   = holds the cumulative counter for each horse during race */
/* Win       = holds number of WIN horse                               */
/* Place     = holds number of PLACE horse                             */
/* Show      = holds number of Show horse                              */
/***********************************************************************/
/*                       VARIABLE INITIALIZATIONS                      */
/***********************************************************************/

  options results
  PARSE arg name winnings . colorflag secs .
  IF ~DATATYPE(secs,'N') THEN secs=3600

  FF='0C'x  /* FormFeed */
  CR='0D'x  /* Carraige Return */

  CALL TIME('R')
  SIGNAL ON BREAK_C
  SIGNAL ON BREAK_E

/*Program error handling */
  SIGNAL ON syntax      /* if a syntax error occurs goto syntax:      */

/**********************************************************************/
/*                        BBS VARIABLES                               */
/**********************************************************************/


  info= 's:CONFIG.BBS'
  IF ~EXISTS(info) THEN info='BBS:BBS_TEXT/CONFIG.BBS'
  call open(con,info,'R')
  IF con=0 THEN EXIT 666
  lynes.1=readln(con)
  compos=POS('/*',lynes.1)
  IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  bbsname=STRIP(lynes.1)
  lynes.2=readln(con)
  sysopname=WORD(lynes.2,1)
  call close(con)
  Progname = 'BBS Downs!'
  MaxPlayers = 100        /* max number of players allowed by sysop */
  bbspath=GETCLIP('BBS_path')
  bbspath=bbspath'rexxDoors/Data/'
  Dir = bbspath'Horses'

  if ~exists(dir) then makedir(dir)

/*Program variable initialization */

  Uhandle = name                        /* get the user's handle           */
  Udate = date()            /* get current date & time         */
  CLS = ''
  Hname.1 = "Tumble Weed"
  Hname.2 = "Frisky Girl"
  Hname.3 = "Citation"
  Hname.4 = "Thunder"
  Hname.5 = "Whirlaway"
  Hname.6 = "Seabiscuit"
  Hname.7 = "Comet"
  Hname.8 = "Old-Nag"

/************************************************************************/
/*                            MAIN PROGRAM                              */
/************************************************************************/
MAIN:
  call random(1,10,time(s))
  CALL PLAYERFILE
  CALL CHECKBALANCE
  Choice = 0
  Do until Choice = 5
     say CLS
     say "                    ***************************"cr
     say "                       Welcome to BBS Downs!"cr
     say "                    ***************************"cr
     say ""cr
     say "                       1) Read Instructions"cr
     say "                       2) View Scoreboard"cr
     say "                       3) Millionaires Club" cr
     say "                       4) Go to the Track!"cr
     say "                       5) Quit"cr
     say ""cr
     say "                    ***************************"cr
     say ""cr
     Options prompt"                    What would you like to do?  "
     pull Choice
     CALL checkBBS()
     If Choice = 1 then CALL INSTRUCT
     else If Choice = 2 then CALL SCOREBOARD
     else If Choice = 3 then CALL MILLIONS
     else If Choice = 4 then CALL THETRACK
  end
  CALL BYE
EXIT

PLAYERFILE:
  say CLS
  say "Checking player file..."cr
  say ""cr
  AcctBal = 100
  Flag = 0
  nplayers = 0

  if ~exists(dir'/Dplayers') then do     /* Create a Players file if needed*/
    call open(file1,dir'/Dplayers', 'W')
    call writeln(file1,'0')              /* There are no players as yet */
    call close(file1)
   end

   call open(file1,dir'/Dplayers', 'R')      /* Read in existing player info */
     nplayers = readln(file1)        /* Get current number of players */
      if nplayers = 0 then signal newfile
     do i = 1 to nplayers
        player.i = readln(file1)     /*Read a player's name*/
        score.i = readln(file1)      /*Read a player's score*/
        if player.i = Uhandle then do  /*find user's acct balance*/
       AcctBal = score.i           /*set user's acct balance*/
           say "I see you have bet here before!"cr
           say "Your account balance is:  $"AcctBal""cr
           Flag = 1                   /*signal player was found*/
        end
     end
   call close(file1)
Newfile:
   if Flag = 0 then do                 /*if player was not found in file*/
       if nplayers < MaxPlayers then do 
         say "A new player!!"cr
         say "You will be given $100 to start you out!"cr
         nplayers = nplayers + 1
         player.nplayers = UHandle
         score.nplayers = AcctBal
         call close(file1)
         end
       else if nplayers >= MaxPlayers then do
         say ""cr
         say "Sorry there is no room for another gambler at the track!"cr
         say "Talk to "SysopName" maybe he/she can do something about that!"cr
         CALL BYE
       end
    end
  CALL PAUSE
RETURN

CHECKBALANCE:
  LowBal = "FALSE"
  If AcctBal <= 2 then do
    LowBal = "TRUE"
    say ""cr

    say "It seems your account balance of $"AcctBal" is too low to place any bets."cr
    say ""cr
    Options prompt"Would you like to try to win $50 with no strings attached? "
    pull Flag ; Flag = upper(Flag) ; flag = left(flag,1)
    say ""cr
    If Flag = "Y" then do
      say ""cr
      Options prompt"Okay, Pick a number between 1 and 5:  "cr
      pull Guess
      RNum = RANDOM(1,5)
      if Guess = RNum then do
         say ""cr
         say "You guessed it!!! Adding to your Account Balance..."cr
         say ""cr
         AcctBal = AcctBal + 50
         LowBal = "FALSE"
         end
      else do
         say ""cr
         say "Sorry the number was "RNum".  Try again sometime!"cr
         say ""cr
         end
    end
    else do
      say ""cr
      say "Okay fine...but you won't be able to place any bets until "cr
      say "you have more money!!"cr
      say ""cr
      end
    CALL PAUSE
end
RETURN

INSTRUCT:
  say CLS

  say'  This is a horse racing game rewritten for DLG by Basil Barnes from a'cr
  say'CNET game.'cr
  say cr
  say'  The game is pretty well self-explanatory.  Play it for a while and'cr
  say'see how addictive it is.'cr
  say cr
  say'  Please note:  You MUST have an ansi positioning terminal program to be'cr
  say'able to play this game.'cr
  say cr
  say'                                         Basil Barnes'cr
  say'                                         August 6, 1992'cr
  say cr
  say'This version has been adapted to run on BBBBS by Matt English. 1-12-93'cr
  say ""cr
  CALL PAUSE
RETURN

SCOREBOARD:
  say ""CLS" Sorting Scores............."cr
  CALL SORTSCORES
  Flag = 1
  i = 1
  j = 1
  More = 'Y'
  Do Forever
     if More ~= 'Y' then break
     Do while Flag = 1
        say CLS
        say "                    *******************************"cr
        say "                              SCOREBOARD"cr
        say "                    *******************************"cr
        Flag = 0
     end
     if player.j = UHandle then Score.j = AcctBal
     P = Left(Player.j,20,' ')   /*Pad end of handle with spaces*/
     say "                       "P"  $"Score.j""cr
     i = i + 1
     j = j + 1
     if j > Nplayers then break
     else if j <= Nplayers & i = 11 then do
         Flag = 1
         i = 0          /* Only display 10 names per page */
         say "                    *******************************"cr
         Options prompt"                    Do you want to see more(Y/N)? "cr
         pull More ; more = upper(more) ; more = left(more,1)
         iterate
       end
     else if j <= Nplayers & i < 11 then iterate
  end
  if More = 'Y' then say "                    *******************************"cr
  CALL PAUSE
RETURN

MILLIONS:
  say CLS
  say ""cr
  if exists(dir'/Dmillions') then do
    call open(mill,dir'/Dmillions', 'R')
        j = 0
        i = 0
        do while ~eof(mill)
        do while j = 0
          say CLS
          say "             ***********************************************"cr
          say "                            MILLIONAIRES CLUB"cr
          say "             ***********************************************"cr
          j = 1
        end
          line = readln(mill)
          say "             "line""cr
          i = i + 1
          if i = 10 then do
            j = 0
            i = 0
            call PAUSE
          end
        end
    call close(mill)
  end
  else do
    say "There are no millionaires yet..."cr
  end
  say ""cr
  CALL PAUSE
RETURN

CHECKMILLIONS:
  if acctbal >= 1000000 then do
    say ""cr
    say "Congratulations!!!! You have become a Millionaire!!"cr
    say "Adding your name to this elite group of gamblers...."cr
    say cr
    say 'The game is now being reset!...'cr
    call delay(100)

    call delete(dir'/Dplayers')
    Nplayers = 1
    Player.1 = UHandle

    say ""cr
    line = left(UHandle,22,' ')||"$"AcctBal||"  "||left(UDate,15)
    if ~exists(dir'/Dmillions') then do     /* Create a Dmillions file if needed*/
      call open(fileM,dir'/Dmillions', 'W')
      call writeln(fileM, line)  /* Put player in file */
      call close(fileM)
    end
    else do
      call open(fileM,dir'/Dmillions', 'A')
      call writeln(fileM,line)   /* Add player to file */
      call close(fileM)
    end
    AcctBal = 1000
    say "Your new account balance is $1,000."cr
    say ""cr
    options prompt"Would you like to see the Millionaires Club list (Y/N)? "
    pull More ; more = upper(more) ; more = left(more,1)
    If More = "Y" then CALL MILLIONS
  end
RETURN

SORTSCORES:
  /* Straight Selection Sort */
  do i = 1 to (Nplayers - 1)
     do j = (i+1) to Nplayers
        if Score.i < Score.j then do
          Temp = Score.i
          Score.i = Score.j
          Score.j = Temp
          Temp = Player.i
          Player.i = Player.j
          Player.j = Temp
        end
     end
  end
RETURN

THETRACK:
  Another = "Y"
  Do While Another = "Y"
       CALL checkBBS()
       CALL CHECKBALANCE
    If LowBal = "FALSE" then do
       CALL BOOKIE
       CALL GETBETS
       CALL RACE
       CALL WINNERS
       say ""cr
       options prompt"Do you want to play another race?  "
       pull Another ; Another = upper(Another) ; Another = left(another,1)
     end
     else Another = "N"
  end
RETURN

BOOKIE:
  /* Choose the odds on the horses */
  do i = 1 to 8
    WOdds.i = random(1,15)    /* Pick a random number*/
    POdds.i = Left(WOdds.i *.75,pos('.', WOdds.i*.75) -1)
    SOdds.i = Left(WOdds.i *.5,pos('.', WOdds.i*.5) -1)
  end

  /* Set all bets to zero */
  do i = 1 to 3
    WHorse.i = 0
    WBet.i = 0
  end

  say CLS
  say "*********************************************************************"cr
  say "                         PLACE YOUR BETS!!"cr
  say "*********************************************************************"cr
  say "  No.         Horse           Win Odds     Place Odds     Show Odds"cr
  say "  ---    ---------------      --------     ----------     ---------"cr
  do i = 1 to 8
    tes1 = right(Hname.i,16,' ')
    tes2 = right(WOdds.i,14,' ') 
    tes3 = right(POdds.i,12,' ')
    hnum = right(i,4,' ')
    todd = right(SOdds.i,12,' ')

    say''hnum''tes1''tes2':1'tes3':1'todd':1'cr
    
    /*call writech(stdout,right(i,4,' ')                   /* Horse No.    */
    call writech(stdout,tes1)                             /* Horse's name */
    call writech(stdout,tes2":1")                         /* Win Odds     */
    call writech(stdout,tes3":1")                         /* Place Odds   */
    say right(SOdds.i,12,' ')":1"         /* Show Odds    */    */
  end
  say "*********************************************************************"cr
  say ""cr
RETURN

GETBETS:
  str.1 = "WIN:  "
  str.2 = "PLACE:  "
  str.3 = "  SHOW:  "
  i = 1
  do forever
    /* Position cursor for each bet */
    say "      "
    ab = Left(AcctBal,10,'.')
    say "Your account balance is:  $"AB""cr
    say "        "cr
    do j = 1 to 4
      say "                                                                      "cr
    end
    call writech(stdout,"")

    if i > 3 then break       /* Check for all bets in*/

    if AcctBal < 2 then break  /* Not enough money to bet anymore */

    /* Get the horse number to bet on for each: win, place, show */
    options prompt"Enter the horse number to " str.i" "
    pull WHorse.i
    say ""cr
    if WHorse.i = '' then do
       /* Check if user pressed return, if so there is no bet on this round */
       WBet.i = 0
       i = i + 1
       iterate
    end
    else if WHorse.i < 1 | WHorse.i > 8 then do
       /* Make sure horse number bet on is within range */
       call writech(stdout,"")
       call writech(stdout,"Invalid Horse number.  Try again!")
       iterate
    end
    if Whorse.i ~= ''then do
       /* If a horse is being bet on then get the amount of the bet */
       options prompt"How much do you want to bet:  "
       pull WBet.i
       if WBet.i >= 2 & WBet.i <= AcctBal & WBet.i <= 2000 then do
         /* make sure the amount of the bet is within range */
         AcctBal = AcctBal - WBet.i
         i = i + 1
         iterate
       end
       else if WBet.i < 2 then do
         /* if bet is too low then redo */
         call writech(stdout,"")
         call writech(stdout,"Sorry you must bet at least $2.  Try again!")
         iterate
       end
       else if WBet.i > AcctBal then do
         /* if bet is too high then redo */
         call writech(stdout,"")
         say "You can not bet more than your account balance of:  $"AcctBal". Try Again!"cr
         iterate
       end
       else if WBet.i > 2000 then do
         /* if bet is too high then redo */
         say "You can not bet more $2,000. Try Again!"cr
         iterate
       end
     end
  say ""cr
  end
 
  if AcctBal < 2 then say "You have bet as much as you can.  The window is now closed!!"cr

  CALL PAUSE
RETURN

RACE:
  call writech(stdout,CLS"")  /* clear screen and go to home position */
  say ""cr
  say "THEY'RE OFF!!!"cr
  say ""cr
  /* The race itself is 55 spaces long */
  say "++++++++++++|Start------------------------------------------Finish|" cr
  do i = 1 to 8
    say RIGHT(Hname.i, 12,' ')"|"cr
    Count.i = 1    /* reset all horse counters */
  end
  say "++++++++++++|-----------------------------------------------------|" cr
  call writech(stdout,"")
  win = 0    /* no winning horse yet */
  place = 0  /* no place horse yet */
  show = 0   /* no show horse yet */

  j = random(1,8)  /* pick random horse to start out of gate */
  Flag = "Go"
  Do while Flag = "Go"
    i = j
    j = 1  /* always start at 1 after 1st time through loop */
    do while i <= 8     /* cycle through each horse and add up their 'scores' */
      RNum = random(1,5)    /* Pick a random number*/
      Count.i = Count.i + RNum        /* Add the number to the current horse's count */
      /* Draw the horse's new position if he has not already crossed finish line*/
      If (i ~= Win) & (i ~= Place) & (i ~= Show) then do
        call writech(stdout,"") /* Position cursor at top of Race Track */
        call writech(stdout,"["i"B")        /* move down to the current horse's vertical positon */
        /*Draw current horse's horizontal position */
        call writech(stdout,Copies(' ', (Count.i) - 2) i)
      end

      /* Check for win, place, and show horse */
      If Count.i >= 55 then do
         If Win = 0 then do         
            Win = i  /* remember winning horse's number */
            call writech(stdout,"")
            call writech(stdout,"["i"B")
            call writech(stdout,Copies(' ', (Count.i) - 2) "W")
         end
         else if (Place = 0) & (i ~= Win) then do
            Place = i  /* remember place horse's number */
            call writech(stdout,"")
            call writech(stdout,"["i"B")
            call writech(stdout,Copies(' ', (Count.i) - 2) "P")
         end
         else if (Show = 0) & (i ~= Win) & (i ~= Place) then do
            Show = i   /* remember show horse's number */
            call writech(stdout,"")
            call writech(stdout,"["i"B")
            call writech(stdout,Copies(' ', (Count.i) - 2) "S")
            i = 8  /* race is over */
            Flag = "Stop"  /* signal end of race */
         end
       end /* If Count.i >= 55 then do */

       i = i + 1
    end  /* Do while i <= 8 */
  end /* Do while Flag = "Go" */
  call writech(stdout,"")
  CALL PAUSE
RETURN

WINNERS:
  say ""cr
  say "Horse #"Win" is the winner!!"cr
  If WHorse.1 = '' then  say "You did not bet on a horse to win!"cr
  else do
    say "You bet $"WBet.1" on Horse #"WHorse.1" to win."cr
    If WHorse.1 = Win then do
       Won = WBet.1 * WOdds.Win
       AcctBal = AcctBal + Won  + WBet.1
       say "Congratulations! You WIN $"Won" on your win bet!" cr
    end
    else say "Sorry you LOST on your win bet." cr
  end
  say ""cr

  say "Horse #"Place" placed!"cr
  If WHorse.2 = '' then say "You did not bet on a horse to place!"cr
  else do
    say "You bet $"WBet.2" on Horse #"WHorse.2" to place." cr
    If (WHorse.2 = Place) | (WHorse.2 = Win) then do
       Won = WBet.2 * WOdds.Place
       AcctBal = AcctBal + Won + WBet.2
       say "Congratulations! You WIN $"Won" on your place bet!" cr
    end
    else say "Sorry you LOST on your place bet." cr
  end
  say ""cr

  say "Horse #"Show" showed."cr
  If WHorse.3 = '' then say "You did not bet on a horse to show!"cr
  else do
    say "You bet $"WBet.3" on Horse #"WHorse.3" to show."cr
    If (WHorse.3 = Show) | (WHorse.3 = Place) | (WHorse.3 = Win) then do
       Won = WBet.3 * WOdds.Show
       AcctBal = AcctBal + Won + WBet.3
       say "Congratulations! You WIN $"Won" on your show bet!"cr
    end
    else say "Sorry you LOST on your show bet." cr
  end
    call pause
RETURN

PAUSE:
  say ""cr
  options prompt "Press [Return] to continue..."
  pull junk
  say ""cr
RETURN


BYE:
    CALL CHECKMILLIONS
    say ""cr
    say "                     Brought to you by Sean Kelly "cr
    say ""cr
    say "                       Amizon BBS  312-775-9138"cr
    say "                  Ported over to DLG by Basil Barnes"cr
    say "                    Amiga Devil BBS (403)-484-9200"cr
    say ""cr
    say "               Adapted to BBBBS by Matt English 1-11-93"cr
    say "                  The Alternative BBS (503)761-3043"cr
    say""cr
    say "                      Returning to "BBSname"..."cr
    CALL SORTSCORES
    /* Rewrite PlayersFile */
    call open(file1,dir'/Dplayers', 'W')
    call writeln(file1,NPlayers)
      do i = 1 to NPlayers
        if player.i = UHandle then Score.i = AcctBal
        call writeln(file1, player.i)
        call writeln(file1, score.i)
      end
    call close(file1)
EXIT

/************************************************************************/
/* Error Handling Routines                                              */
/************************************************************************/

syntax:
    say 'Syntax Error in 'progname'.  Line:  'SIGL''cr
    say 'Error:  'RC' 'errortext(RC)''cr
    say 'Please notify 'sysopname'!'cr
    say 'Returning to 'BBSname'...'cr
EXIT


checkBBS:
IF ADDRESS()~='BAUD' THEN RETURN 0
IF TIME('e')>secs THEN SIGNAL BYE
dcd
IF RC=0 THEN SIGNAL BYE
temp=secs-TIME('E')
IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR 
RETURN 0


BREAK_C:
BREAK_E:
SIGNAL bye

/* Horse_Racing.rexx */