/* /X Horse Racing v4.12 */ /* */ /* By BrUcE Lee/TeKnO RaGe/NNB95.. */ /* */ /* */ /* ThIz GaMe WaS MaDe By Kenneth Brill, i JuSt cOnVeRtEd It... So, If YoU */ /* WaNNa LeAvE Me A MeSSy, YoU CaN LeAvE It At AnY Of ThIz BBS: */ /* */ /* BBS NAME SYSOP NAME NUMBER SCHEDULE GROUP */ /*-----------------------------------------------------------------------------*/ /* Dark Instinct Dirty Harry +351-1 -9371992 22h - 9h Century */ /* Digital Dungeon Martin +351-1 -9572361 24 Hrs Tekno Rage */ /* Los Angels Officer +351-1 -8121038 24 Hrs Misery */ /* Wolf's Lair Werewolf +351-38 -23098 22h - 9h Tekno Rage */ /* Drugstore Undertaker +351-2 -3799957 24 Hrs Tekno Rage */ /* Kaotic Pleasure Fractal Guru +351-52 -73434 24 Hrs Tekno Rage */ /* Time Out Nady +351 -ASKELITE 22h - 9h Tekno Rage */ /* Alien World Vector +351-38 -23587 23h - 8h INDEPENDENT */ /* Central Station Communicator +351-1 -4912872 24 Hrs Tekno Rage */ /* Infinite Dreams Eddie +351-1 -9555056 22h - 9h Century */ /* */ /* Or You Can Call My Board: */ /* Last Hope Bruce Lee +351-38 -23834 22h - 9h Tekno Rage */ Parse Arg Node Options Results Address Value 'AERexxControl'Node SIGNAL ON ioerr SIGNAL ON syntax /*BBS variable initialization */ BBSname = 'Last Hope' Sysopname = 'Bruce Lee' Progname = 'HorseRacing II v4.13' MaxPlayers = 50 Path 6 Doors=result /* DO NOT EDIT */ player.0 = "Bank's Farm" /* DO NOT EDIT */ FilePath = "Doors:Horses/" /* Path to the HORSES/ directory in your DOORS: dir */ NameOfPerson = 'Bruce Lee' /* Name of the person in charge of games on your BBS */ /*******************************************************************************/ /* Don't edit anything below this point unless you know what you are doing!! */ /*******************************************************************************/ if ~show('L','rexxsupport.library') then do if addlib('rexxsupport.library',0,-30,0) then nop else exit 10 end pragma('directory', FilePath) /* set current dir to FilePath */ address command 'MAKEDIR Messages' t='transmit' sm='sendmessage' Cr=d2c(13) ss='sendstring' Today=0 bufferflush t " " ss ''CR"" ss center('Welcome to 'ProgName,78)""CR"" ss ''CR"" ss ''CR"" ss center('An AREXX HorseRacing Simulation',78)""CR"" ss ''CR"" ss center('Report any problems to '||NameOfPerson||' thru EMail',78)""CR"" ss ''CR"" ss center('Written and Developed by',78)""CR"" ss ' Kenneth Brill - Complete Rewrite'CR"" ss center("Converted to /X by",78)""CR"" ss " Bruce Lee - Complete Conversion"CR"" ss ''CR"" t center("Press Any Key",78); Getchar /*Program variable initialization */ getuser 100; Uhandle = result /* get the user's handle */ getuser 144; Udate = result /* get current date & time */ getuser 105 ; Uaccess = result /* get user's access level (0,32) */ CLS=d2c(12) T "[0 p" Fast=0 /* Set Fast Display to OFF */ if ~exists('Dplayers') then do t 'Horse Racing game was won, Resetting all files!' t 'Resetting Owners file.' open(file1, 'DHorses', 'R') NumOfHorses=readln(file1) do i = 1 to NumOfHorses RName.i = readln(file1) HRaces.i = readln(file1) HOdd.i = readln(file1) HOwner.i = readln(file1) HWins.i = readln(file1) HPlaces.i = readln(file1) HShows.i = readln(file1) HAge.i = readln(file1) HHurt.i = readln(file1) HLocal.i = readln(file1) HStatus.i = readln(file1) HTrain.i = readln(file1) HSitout.i = readln(file1) end close(file1) open(file1, 'DHorses', 'W') writeln(file1,NumOfHorses) do i = 1 to NumOfHorses writeln(file1,RName.i) writeln(file1,random(20,40,TIME('S'))) writeln(file1,0) writeln(file1,0) temp=Random(1,10,Time('S')) if temp<=5 then writeln(file1,random(0,10,TIME('S'))) else writeln(file1,random(0,2,TIME('S'))) writeln(file1,random(0,10,TIME('S'))) writeln(file1,random(0,10,TIME('S'))) writeln(file1,random(0,4,TIME('S'))) writeln(file1,0) writeln(file1,0) writeln(file1,0) writeln(file1,1) writeln(file1,HSitout.i) end close(file1) end /* Read in the Horses file */ open(file1, 'DHorses', 'R') NumOfHorses=readln(file1) do i = 1 to NumOfHorses RName.i = readln(file1) HRaces.i = readln(file1) HOdd.i = readln(file1) HOwner.i = readln(file1) HWins.i = readln(file1) HPlaces.i = readln(file1) HShows.i = readln(file1) HAge.i = readln(file1) HHurt.i = readln(file1) HLocal.i = readln(file1) HStatus.i = readln(file1) HTrain.i = readln(file1) HSitout.i = readln(file1) end close(file1) /************************************************************************/ /* MAIN PROGRAM */ /************************************************************************/ MAIN: CALL PLAYERFILE CALL CHECKBALANCE CALL CHECKHORSE Choice = 0 Do until Choice = 10 t CLS t "********************************************************************************" t " Welcome to BBS Downs!" t "********************************************************************************" t " 1) Read Instructions" t " 2) View Scoreboard" t " 3) Millionaires Club" t " 4) Go to the Track!" t " 5) A Guide to the Horses" t " 6) Buy a Horse" t " 7) Sell a Horse" t " 8) Train Your Horses" t " 9) Special Stuff" t " 10) Quit" t "********************************************************************************" Query " What would you like to do? " Choice = result If Choice = 1 then CALL INSTRUCT If Choice = 2 then CALL SCOREBOARD If Choice = 3 then CALL MILLIONS If Choice = 4 then CALL THETRACK If Choice = 5 then CALL INFO If Choice = 6 then CALL BUYHORSE If Choice = 7 then CALL SELLHORSE if Choice = 8 then CALL TRAINING if Choice = 9 then CALL SPECIAL if Choice = 'OFF' then exit end CALL BYE Call DExit PLAYERFILE: t CLS t "Checking player file..." ms = 1 Flag = 0 nplayers = 0 if ~exists('Dplayers') then do /* Create a Players file if needed*/ open(file1, 'Dplayers', 'W') writeln(file1, 0) /* There are no players as yet */ close(file1) end open(file1, 'Dplayers', 'R') /* Read in existing player info */ nplayers = readln(file1) /* Get current number of players */ do i = 1 to nplayers player.i = readln(file1) /*player's name*/ score.i = readln(file1) /*player's score*/ pwins.i = readln(file1) /*How many wins*/ pshows.i = readln(file1) /*How Many Shows*/ pplaces.i = readln(file1) /*How Many Places*/ stable.i = readln(file1) /*Stable Owned*/ days.i = readln(file1) /*Number of 'days' played*/ horses.i = readln(file1) /*Number of horses owned*/ if player.i = Uhandle then do /*find user's acct balance*/ ms = i t "I see you have bet here before!" t "Your account balance is: $"trunc(score.ms)"" t "Your Membership ID number is "ms"" IF Stable.ms>0 then do IF Stable.ms=1 then t 'You have a single stable ranch with' IF Stable.ms=2 then t 'You have a double stable ranch with' IF Stable.ms=3 then t 'You have a triple stable ranch with' IF Stable.ms=4 then t 'You have a four stable ranch with' IF Stable.ms=5 then t 'You have a grand stable ranch with' if horses.ms=0 then hm='no' if horses.ms>0 then hm=horses.ms if horses.ms=1 then hn='horse' if horses.ms~=1 then hn='horses' t ' 'hm ''hn' on it.' end t ' ' Flag = 1 /*signal player was found*/ if exists('messages/MES '||ms) then do Message=FilePath||'Messages/MES '||ms t Message SendFile Message Address command 'Delete "'||Message'"' end end end close(file1) if Flag = 0 then do /*if player was not found in file*/ if nplayers < MaxPlayers then do t "A new player!!" t "You will be given $100 to start you out!" nplayers = nplayers + 1 ms = nplayers player.nplayers = UHandle pwins.ms=0 pshows.ms=0 pplaces.ms=0 score.ms = 100 horses.ms=0 stable.ms=0 days.ms=0 end else if nplayers >= MaxPlayers then do t "Sorry there is no room for another gambler at the track!" t "Talk to "SysopName" maybe he/she can do something about that!" CALL BYE end end CALL PAUSE RETURN CHECKBALANCE: LowBal = "FALSE" If score.ms < 2 then do LowBal = "TRUE" t "It seems your account balance of $"score.ms" is too low to place any bets." Query "Would you like to try to win $50 with no strings attached? " Flag = UPPER(result) If Flag = "Y" then do Query "Okay, Pick a number between 1 and 5: " Guess = result RNum = RANDOM(1,5,TIME('S')) if Guess = RNum then do t "You guessed it!!! Adding to your Account Balance..." score.ms = trunc(score.ms) + 50 LowBal = "FALSE" end else do t "Sorry the number was "RNum". Try again sometime!" end end else do t "Okay fine...but you won't be able to place any bets until " t "you have more money!!" end CALL PAUSE end RETURN INSTRUCT: t ' ' if exists(filepath||'Dinstruct') then ShowFile FilePath||'DInstruct' else do t "Instructions file was not found..." t "Notify "Sysopname"!" end CALL PAUSE RETURN SCOREBOARD: Market=0;Market1=0;Flag = 1;i = 1;j = 1;More = 'Y' t ' ' t '********************************************************************************' t ' SCOREBOARD' t '********************************************************************************' t '' t ' Name Winnings Win Place Show Days Horses Net Worth' t ' ---- -------- --- ----- ---- ---- ------ ---------' Do Forever if More ~= 'Y' then break Do q=1 to NumOfHorses If HOwner.q=j Then Do Market = 5000-(5000*HHurt.q) + ((HWins.q * 1200) + (HPlaces.q * 800) + (HShows.q *400)) - ((HRaces.q * 2) + (HAge.q * 5)) Market1=Market1+Market end end if player.j = UHandle then Score.j = trunc(score.ms) Market1=Market1+Score.j if Stable.j=1 then Market1=Market1+125000 if Stable.j=2 then Market1=Market1+225000 if Stable.j=3 then Market1=Market1+325000 if Stable.j=4 then Market1=Market1+425000 if Stable.j=5 then Market1=Market1+950000 s.0=0;s.1=4;s.2=8;s.3=12;s.4=20;s.5=50 P = Left(Player.j,20,' ') /*Pad end of handle with spaces*/ S = Left(trunc(Score.j),10,' ') temp=stable.j H = Horses.j'('S.temp')' Coordenada=length(Horses.j)+length(S.temp)-2 ss "["7+j";3H"P"["7+j";22H$"S"["7+j";"38-length(PWins.j)"H"PWins.j ss "["7+j";"46-length(PPlaces.j)"H"PPlaces.j"["7+j";"50--length(PShows.j)"H"PShows.j t "["7+j";"58-length(Days.j)"H"Days.j"["7+j";"62-Coordenada"H"H "["7+j";"76-length(Market1)"H$"trunc(Market1) i = i + 1;j = j + 1;Market=0;Market1=0 if j > Nplayers then break else if j <= Nplayers & i = 11 then do Flag = 1 i = 0 /* Only display 10 names per page */ t "********************************************************************************" Query " Do you want to see more(Y/N)? " More = UPPER(result) iterate end if j <= Nplayers & i < 11 then iterate end if More = 'Y' then t "********************************************************************************" CALL PAUSE RETURN MILLIONS: if exists('Dmillions') then do open(mill, 'Dmillions', 'R') j = 0 i = 0 do while ~eof(mill) do while j = 0 t CLS t "********************************************************************************" t " MILLIONAIRES CLUB" t "********************************************************************************" j = 1 end line = readln(mill) t " "line i = i + 1 if i = 10 then do j = 0 i = 0 CALL PAUSE end end close(mill) end else do t "There are no millionaires yet..." end CALL PAUSE RETURN CHECKMILLIONS: if trunc(score.ms) >= 5000000 then do t "Congratulations!!!! You have become a Multi-Millionaire!!" t "Adding your name to this elite group of gamblers...." line = left(UHandle,20,' ')||"$"trunc(score.ms)||" "||left(UDate,15)||" after "days.ms" days" if ~exists('Dmillions') then do /* Create a Dmillions file if needed*/ open(fileM, 'Dmillions', 'W') writeln(fileM, line) /* Put player in file */ close(fileM) end else do open(fileM, 'Dmillions', 'A') writeln(fileM, line) /* Add player to file */ close(fileM) end address command 'Delete DPlayers' address command 'Delete Messages/#?' Query "Would you like to see the Millionaires Club list (Y/N)? " More = UPPER(result) If More = "Y" then CALL MILLIONS t 'Resetting all players and starting the game over again.' Call Dexit end RETURN THETRACK: Another = "Y" Do While Another = "Y" CALL CHECKBALANCE If LowBal = "FALSE" then do CALL BOOKIE CALL GETBETS CALL RACE CALL WINNERS today=today+1 if today>14 then do t 'You are out of turns for this play period.' CALL PAUSE signal bye end t 'You have '15-today' turns left.' QueryY "Do you want to play another race? (y/N) " Another = UPPER(result) if Another='YES' THEN Another='Y' end end RETURN PAUSE: t "Press any key to continue..." getchar t '' RETURN SENDMESSAGE: procedure /* Message Routines */ Path=arg(1) Name=arg(2) Message1=arg(3) Message2=arg(4) from=arg(5) If exists(Path'MES 'name) then call open('message',Path'MES 'Name,'A') else call open('message',Path'MES 'Name,'W') call writeln('message','From: '||From) call writeln('message',''||Message1) call writeln('message',Message2) Call writeln('message','') call close('message') RETURN TRAINING: t CLS t "" t 'Number Name Odds to win' t '------ -------------------- -----------' do i = 1 to NumOfHorses if HOwner.i = ms then do name=left(rname.i,20,' ');find=left(i,3,' ') t ' ('find') 'Name' 'hodd.i'/1' ;HasHorse=HasHorse+1;HorseList.HasHorse=i end end query 'Which horse do you wish to train? ' la=result More=0 do i=1 to HasHorse if la=HorseList.i THEN More=1 end If More=0 THEN RETURN t '********************************************************************************' t ' BBS Downs Training Field' t '********************************************************************************' t ' 1) Light Traning ($2500)' t ' 2) Medium Traning ($4000)' t ' 3) Heavy Traning ($6500)' query 'Select:' answer=result if answer~=1 & Answer~=2 & answer~=3 THEN RETURN IF answer=1 then do HRaces.la=trunc(HRaces.la*.9) score.ms=trunc(score.ms)-2500 end IF answer=2 then do HRaces.la=trunc(HRaces.la*.8) score.ms=trunc(score.ms)-4000 end IF answer=3 then do HRaces.la=trunc(HRaces.la*.7) score.ms=trunc(score.ms)-6500 end OddMaker=trunc((HRaces.la - (HTrain.la * .2)) / (HWins.la + (HPlaces.la*.25) + (HShows.la*.15))) if HHurt.la=1 then OddMaker = OddMaker + 10 HOdd=OddMaker if HOdd < 3 then HOdd = 3 t 'Old odds to win were 'HOdd.la'/1' HOdd.la=HOdd t 'New odds to win are 'HOdd.la'/1' CALL PAUSE RETURN CHANCESTUFF: Temp = random(1,100,TIME('S')) If Temp > 95 then do temp=Random(1,10,Time('S')) if temp=1 then do money=Random(0,999,Time('S')) t 'You find a winning ticket from the last race on the ground!!!' t 'You cash it in for $'Money'!' score.ms = score.ms + Money CALL PAUSE end If Temp=2 then do money=Random(0,999,Time('S')) t 'Another person wins big on your advice, he gives you' t '$'Money' to thank you!!!!' score.ms = score.ms + Money CALL PAUSE end If Temp=3 then do money=Random(0,999,Time('S')) t 'You win a side bet for $'Money'!!!' score.ms = score.ms + Money CALL PAUSE end If Temp=4 then do money=Trunc(Score.ms*.3333) t 'You lose a side bet for $'Money'!!!' score.ms = score.ms - Money CALL PAUSE end If Temp=5 then do money=Trunc(Score.ms*.4) t 'You forgot to pay taxes on winnings, you are fined $'Money'!!!' score.ms = score.ms - Money CALL PAUSE end If Temp=6 then do money=Trunc(Score.ms*.15) t 'A fire at your stable costs you $'Money'!!!' score.ms = score.ms - Money CALL PAUSE end If Temp=7 then do money=Random(10,999,Time('S'))*5 t 'You win on the little lotto game for $'Money'!!!' score.ms = score.ms + Money CALL PAUSE end If Temp=8 then do money=Random(100,999,Time('S'))*2 t 'You furnish a stud service from one of your lesser males for $'Money'!!!' score.ms = score.ms + Money CALL PAUSE end If Temp=9 then do money=Trunc(Score.ms*.25) t 'You get robbed for $'Money'!!!' score.ms = score.ms - Money CALL PAUSE end If Temp=10 then do money=Trunc(Score.ms*.1) t 'New equipment costs you $'Money'!!!' score.ms = score.ms - Money CALL PAUSE end end return BOOKIE: do i=1 to NumOfHorses IsIn.i=0 end CALL CHANCESTUFF /* Set all bets to zero */ do i = 1 to 3 WHorse.i = 0 WBet.i = 0 end /* Pick the 8 horses to race */ i=0 t CLS||'' PICKRACE: temp = random(1,NumOfHorses,TIME('S')) If IsIn.temp = 1 then signal PICKRACE IsIn.temp=1 i=i+1 HName.i=RName.temp t ""HName.i" has entered the race." HInfo.i=temp la=temp Wins=HWins.la;Places=HPlaces.la;Shows=HShows.la;Races=HRaces.la Call COMPUTEODDS WOdds.i = WinOdds WRace.i = WRaces POdds.i = PlaceOdds PRace.i = PRaces SOdds.i = ShowOdds SRace.i = SRaces WinDollar.i=WDollar PlaceDollar.i=PDollar ShowDollar.i=SDollar HRaces.temp = HRaces.temp + 1 if i < 8 then signal PICKRACE DRAWSCREEN: PlayerHorse=0 t ' ' Line="********************************************************************************" t Line t " PLACE YOUR BETS!!" t Line t " No. Horse Win Odds Place Odds Show Odds" t " --- --------------- -------- ---------- ---------" ss "" do i = 1 to 8 ss right(i,4,' ')" " /* Horse No. */ temp=hinfo.i IF HOwner.temp=ms THEN ss '' ss left(Hname.i,21,' ') /* Horse's name */ IF HOwner.temp=ms THEN do ss '' PlayerHorse=PlayerHorse+1 end ss right(WRace.i,2,' ')":"WOdds.i" " /* Win Odds */ ss right(PRace.i,2,' ')":"POdds.i" " /* Place Odds */ t right(SRace.i,2,' ')":"SOdds.i /* Show Odds */ end t Line||' ' /* QueryN "Would you like to see the Betting form for this race? (y/N)" answer=upper(result) if answer='Y' then do do i=1 to 8 la=HInfo.i WantNoList=1 CALL INFO end signal DRAWSCREEN end */ RETURN GETBETS: t "" str.1 = "WIN: ";str.2 = "PLACE: ";str.3 = "SHOW: ";i = 1 do forever /* Position cursor for each bet */ t "";t "Your account balance is: $"trunc(score.ms)" " ss '' if i > 3 then break /* Check for all bets in*/ if score.ms < 2 then break /* Not enough money to bet anymore */ /* Get the horse number to bet on for each: win, place, show */ Query "Enter the horse number to " str.i WHorse.i = result Pick=result if WHorse.i ~= "" then do if i = 1 Then t ''Hname.pick' @ 'WRace.pick':'WOdds.pick'' if i = 2 Then t ''Hname.pick' @ 'PRace.pick':'POdds.pick'' if i = 3 Then t ''Hname.pick' @ 'SRace.pick':'SOdds.pick'' end 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 */ t "Invalid Horse number. Try again!"; Delay(150) iterate end else do /* If a horse is being bet on then get the amount of the bet */ Query "How much do you want to bet: " WBet.i = result if WBet.i >= 2 & WBet.i <= score.ms & WBet.i <= 2000 then do /* make sure the amount of the bet is within range */ score.ms = score.ms - WBet.i if i=1 THEN do t '';t copies('',WHorse.i);t "["WHorse.i+6";3H" end if i=2 THEN do t '';t copies('',WHorse.i);t "["WHorse.i+6";3H

" end if i=3 THEN do t '';t copies('',WHorse.i);t "["WHorse.i+6";3H" end i = i + 1 iterate end else if WBet.i < 2 then do /* if bet is too low then redo */ t "Sorry you must bet at least $2. Try again!"; Delay(150) iterate end else if WBet.i > score.ms then do /* if bet is too high then redo */ t "You can not bet more than your account balance of: $"score.ms". Try Again!"; Delay(150) iterate end else if WBet.i > 2000 then do /* if bet is too high then redo */ t "You can not bet more $2,000. Try Again!"; Delay(150) iterate end end /* else do */ end /* do forever */ if score.ms < 2 then t "You have bet as much as you can. The window is now closed!!" CALL PAUSE RETURN RACE: ss " " sm ""CR"" sm "THEY'RE OFF!!!"CR"" /* The race itself is 55 spaces long */ sm ""CR"" sm "++++++++++++|Start------------------------------------------Finish|"CR"" do i = 1 to 8 sm RIGHT(Hname.i, 12,' ')"|"CR"" ct.i = 1 /* reset all horse counters */ end sm "++++++++++++|-----------------------------------------------------|"CR"" ss "" win = 0 place = 0 show = 0 fall = 0 j = random(1,8,Time('S')) /* 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 */ RNum = random(1,8,TIME('S')) /* Pick a random number*/ do while i <= 8 /* cycle through each horse and add up their 'scores' */ QNum=RNum if fall=0 then do FChance = random(1,50,TIME('S')) /* Chance to fall*/ If FChance > 47 then do t ''HName.i' has fallen!!!!' Fall=i HHurt.i=1 end end if win=0 then BNum = random(1,trunc(WRace.i/WOdds.i),TIME('S')) else if Place=0 then BNum = random(1,trunc(PRace.i/POdds.i),TIME('S')) else if Show=0 then BNum = random(1,trunc(SRace.i/SOdds.i),TIME('S')) QNum = QNum - BNum /* Makes low odds = better horses */ if QNum < 1 then do QNum = 1 end Temp=Random(1,100,Time('S')) If Temp>80 then QNum=QNum+Random(1,4,Time('S')) if fall~=i Then ct.i = ct.i + QNum /* 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) & (i ~= Fall) then do ss "" /* Position cursor at top of Race Track */ ss "["i+4";"j+13"H" /* move down to the current horse's vertical positon */ /*Draw current horse's horizontal position */ If (i ~= WHorse.1) & (i ~= WHorse.2) & (i ~= WHorse.3) then sm "["ct.i"C"i""CR"" If (i = WHorse.1) | (i = WHorse.2) | (i = WHorse.3) then sm "["ct.i"C"i""CR"" end /* Check for win, place, and show horse */ If ct.i >= 55 then do If Win = 0 then do HorseLength1=APlace Win = i /* remember winning horse's number */ Who = HInfo.i HWins.Who = HWins.who + 1 ss "" ss "["i+4";"j+13"H" ss "["ct.i"CW" end else if (Place = 0) & (i ~= Win) then do HorseLength2=AShow Place = i /* remember place horse's number */ Who = HInfo.i HPlaces.Who = HPlaces.who + 1 ss "" ss "["i+4";"j+13"H" ss "["ct.i"CP" end else if (Show = 0) & (i ~= Win) & (i ~= Place) then do Show = i /* remember show horse's number */ Who = HInfo.i HShows.Who = HShows.who + 1 ss "" ss "["i+4";"j+13"H" ss "["ct.i"CS" i = 8 /* race is over */ Flag = "Stop" /* signal end of race */ end end /* If ct.i >= 55 then do */ i = i + 1 end /* Do while i <= 8 */ If Fast=0 then do AWin=0 APlace=0 AShow=0 do find= 1 to 8 IF ct.find>AWin THEN do AWin=ct.find BWin=Find end end do find = 1 to 8 IF ct.find>APlace & BWin~=find THEN do APlace=ct.find BPlace=Find end end do find= 1 to 8 IF ct.find>AShow & BWin~=find & BPlace~=find THEN do AShow=ct.find BShow=Find end end sm ""HName.BWin||' is in the lead with '||HName.BPlace||' close behind 'CR"" sm 'and 'HName.BSHow||' in third. 'CR"" end end /* Do while Flag = "Go" */ t '' t '' ss "" t '' if PlayerHorse>0 Then do score.ms=score.ms-(260*PlayerHorse) ss 'You payed your jockey' if PlayerHorse>1 then ss 's' t ' the flat fee of $'||(225*playerhorse)||' and an' t ' entrance fee of $'||(115*playerhorse) end temp=hinfo.show jockey=random(1,20,TIME('S')) if HOwner.temp=ms then do t 'Your horse 'rname.temp' ran show in the race!';t 'You win $1000';score.ms=score.ms+1000 money = trunc(1000/jockey) t ' Your jockey gets $'||money score.ms=score.ms-money end else do if HOwner.temp~=0 then do Who=HOwner.Temp money=1000/Jockey score.who=score.who+1000-money Path='Messages/' Name=Who Message1='Your horse '||rname.temp||' ran show in a race! You win $1000' Message2='Your jockey was paid $'||money||'.' From='The Track Manager' CALL SENDMESSAGE Path,name,message1,message2,from end end temp=hinfo.place if HOwner.temp=ms then do t 'Your horse 'rname.temp' placed!';t 'You win $2500';score.ms=score.ms+2500 money = trunc(2500/jockey) t ' Your jockey gets $'||money score.ms=score.ms-money end else do if HOwner.temp~=0 then do Who=HOwner.Temp money=2500/Jockey score.who=score.who+2500-money Path='Messages/' Name=Who Message1='Your horse '||rname.temp||' placed in a race! You win $2500' Message2='Your jockey was paid $'||money||'.' From='The Track Manager' CALL SENDMESSAGE Path,name,message1,message2,from end end temp=hinfo.win if HOwner.temp=ms then do t 'Your horse 'rname.temp' won the race!';t 'You win $5000';score.ms=score.ms+5000 money = trunc(5000/jockey) t ' Your jockey gets $'||money score.ms=score.ms-money end else do if HOwner.temp~=0 then do Who=HOwner.Temp money=5000/Jockey score.who=score.who+5000-money Path='Messages/' Name=Who Message1='Your horse '||rname.temp||' won a race! You win $5000' Message2='Your jockey was paid $'||money||'.' From='The Track Manager' CALL SENDMESSAGE Path,name,message1,message2,from end end CALL PAUSE RETURN WINNERS: t CLS if fast=0 then t 'Horse #'Win' ('HName.win') is the winner by '55-HorseLength1' lengths!!' else t 'Horse #'Win' ('HName.win') is the winner!!' t 'Paying $'WinDollar.win*2' $'PlaceDollar.win*2' $'ShowDollar.win*2'' If WHorse.1 = '' then t "You did not bet on a horse to win!" else do temp=WHorse.1 t "You bet $"WBet.1" on Horse #"WHorse.1" ("HName.temp") @ "WRace.temp":"WOdds.temp" to win." If WHorse.1 = Win then do Won = WBet.1 * WinDollar.temp score.ms = score.ms + Won t "Congratulations! You WIN $"Won" on your win bet!" pwins.ms=pwins.ms+1 end else t "Sorry you LOST on your win bet." end if fast=0 then t "Horse #"Place" ("HName.place") placed by "55-HorseLength2" lengths!" else t 'Horse #'Place' ('HName.place') placed!' t 'Paying $'PlaceDollar.place*2' $'ShowDollar.place*2'' If WHorse.2 = '' then t "You did not bet on a horse to place!" else do Temp=WHorse.2 t "You bet $"WBet.2" on Horse #"WHorse.2" ("HName.temp") @ "PRace.temp":"POdds.temp" to place." If (WHorse.2 = Place) | (WHorse.2 = Win) then do Won = WBet.2 * PlaceDollar.temp score.ms = score.ms + Won t "Congratulations! You WIN $"Won" on your place bet!" If WHorse.2 = Place then pplaces.ms=pplaces.ms+1 end else t "Sorry you LOST on your place bet." end t "Horse #"Show" ("HName.show") showed." t 'Paying $'ShowDollar.show*2'' If WHorse.3 = '' then t "You did not bet on a horse to show!" else do Temp = WHorse.3 t "You bet $"WBet.3" on Horse #"WHorse.3" ("HName.temp") @ "SRace.temp":"SOdds.temp" to show." If (WHorse.3 = Show) | (WHorse.3 = Place) | (WHorse.3 = Win) then do Won = WBet.3 * ShowDollar.temp score.ms = score.ms + Won t "Congratulations! You WIN $"Won" on your show bet!" If WHorse.3 = Show then pshows.ms=pshows.ms+1 end else t "Sorry you LOST on your show bet." end RETURN INFO: Inital = 5000 /* if WantNolist=1 then */ Call HORSELIST if la < 1 then RETURN if la > NumOfHorses then RETURN t CLS t '' t 'Number: 'la t 'Name: 'RName.la t 'Races ran: 'trunc(HRaces.la) Wins=HWins.la;Places=HPlaces.la;Shows=HShows.la;Races=HRaces.la CALL COMPUTEODDS t 'Odds to win: 'WRaces':'WinOdds t 'Odds to place 'PRaces':'PlaceOdds t 'Odds to show 'SRaces':'ShowOdds t 'WINS: 'HWins.la t 'PLACES: 'HPlaces.la t 'SHOWS: 'HShows.la input=Howner.la t 'Owner: 'player.input t 'Age: 'HAge.la' years' if HHurt.la = 1 then t 'Health: Hurt' if HHurt.la = 0 then t 'Health: Healthy' Market = Inital-(Inital*HHurt.i) + ((HWins.i * 1200) + (HPlaces.i * 800) + (HShows.i *400)) - ((HRaces.i * 2) + (HAge.i * 5)) t 'Market Value: $'Market t 'Paying $'Wdollar*2 t 'Paying $'Pdollar*2 t 'Paying $'Sdollar*2'' if WantNoList=0 then CALL PAUSE else do QueryY ' Do you want to see the next horse? ' answer=upper(result) if answer='Y' then Call Info end RETURN BUYHORSE: If Stable.ms=0 then do t 'You MUST own a stable before you can buy a horse!' CALL PAUSE Return end h=0 if stable.ms=1 then h=4 if stable.ms=2 then h=8 if stable.ms=3 then h=12 if stable.ms=4 then h=20 if stable.ms=5 then h=50 if horses.ms > h-1 then do t 'You have all the horses that your stable will hold!' CALL PAUSE Return end INITAL = 5000 CALL HORSELIST IF la='' then Return IF HOwner.la ~= "0" then do t 'Horse is owned by another player.' CALL PAUSE RETURN end IF score.ms < Market.la then do t 'You do not have the money to buy this horse!' CALL PAUSE RETURN end score.ms = score.ms - Market.la HOwner.la = ms t 'You now own the horse!' horses.ms=horses.ms+1 CALL PAUSE RETURN SELLHORSE: HasHorse=0 Inital = 2000 t CLS t "" t 'Looks like you need some money' do i = 1 to NumOfHorses if HOwner.i = ms then do Market.i = Inital-(Inital*HHurt.i) + ((HWins.i * 1200) + (HPlaces.i * 800) + (HShows.i * 400)) - ((HRaces.i * 2) + (HAge.i * 5)) t '('i') 'RName.i' $'Market.i' ('UHandle')' HasHorse=1 end end if HasHorse = 0 then do t 'You do not own any horses!' CALL PAUSE RETURN END t 'Which horse to Sell?' QUERY '' Answer=result If Answer = '' then RETURN IF HOwner.Answer ~= ms then do t 'You do not own that horse!' CALL PAUSE RETURN end HOwner.answer = "0" t 'You no longer own the horse!' score.ms = score.ms + Market.Answer Horses.ms=horses.ms-1 CALL PAUSE RETURN CHECKHORSE: HasHorse=0 t CLS t "" t 'Welcome to the stables!' t "" do i = 1 to NumOfHorses if HOwner.i = ms then do t '('i') 'RName.i HasHorse=HasHorse+1 HorseList.HasHorse=i end end if HasHorse > 0 then do t "For Stabling - $"HasHorse*100 score.ms=score.ms-(HasHorse*100) t "For Feed - $"HasHorse*50 score.ms=score.ms-(HasHorse*50) t "Other Expenses:" base=Random(50,150,Time('S')) t '---------------' t 'Transportation : $'hashorse*(base+hashorse) score.ms=score.ms-(hashorse*(base+hashorse)) t 'Practice runs : $'trunc(hashorse*(.5*base+hashorse))"" t "" score.ms=trunc(score.ms-(hashorse*(.5*base+hashorse))) do i= 1 to NumOfHorses if HOwner.i=ms then do if HHurt.i=1 THEN do RNum = RANDOM(1,100,TIME('S')) if RNum>85 Then do t ''RName.i' is hurt.' RNum = RANDOM(1,100,TIME('S')) t 'The vet bill is $'RNum*10'' Score.ms=score.ms-(RNum*10) end end end end CALL PAUSE END RETURN HORSELIST: More = 0;start = 1 List = NumOfHorses if NumOfHorses > 20 Then do List = 20 More = 1 end LISTTHEM: inital=5000 t CLS t "" t 'Welcome to the Stables. You have $'Score.ms t 'Which horse are you interested in?' ScreenPos=0 do i = start to List s=0 IF i>9 Then s=1 IF i>99 Then s=2 IF HOwner.i=0 THEN ss '('i') 'RName.i IF HOwner.i>0 THEN ss '('i') 'RName.i ss '['25-Length(RName.i)-s'CWins: 'HWins.i market.i = Inital-(Inital*HHurt.i) + ((HWins.i * 1200) + (HPlaces.i * 800) + (HShows.i * 400)) - ((HRaces.i * 2) + (HAge.i * 5)) if HWins.i>9 then Space=' ' else Space=' ' ss space'$'trunc(Market.i) temp = HOwner.i IF HOwner.i=0 THEN t ' Owner: 'player.temp IF HOwner.i>0 THEN t ' Owner: 'player.temp end If More = 2 Then t '(P)rev Screen' If more = 1 Then t '(P)rev Screen (N)ext Screen ' If more = 0 Then t '' QUERY 'Enter Selection>' la = result If UPPER(la) = 'P' then do If start > 15 then do If start = 21 then start = 1 if start > 21 then start = start - 20 List = Start+19 If List > NumOfHorses then List = NumOfHorses More=1 signal LISTTHEM end end If UPPER(la) = 'N' then do start = start + 20 List = list + 20 If List > NumOfHorses Then do List = NumOfHorses More=2 end signal LISTTHEM end RETURN COMPUTEODDS: if wins<2 then wins=2 if places<2 then places=2 if shows<2 then shows=2 Races=trunc(Races) WinOdds=trunc(Wins) PlaceOdds=trunc(Places) ShowOdds=trunc(Shows) WRaces=Races;PRaces=Races;SRaces=Races Test.1=2;Test.2=3;Test.3=5;Test.4=7;Test.5=9;Test.6=11;Test.7=13;Test.8=17;Test.9=19;Test.10=23 Test.11=29;Test.12=31;Test.13=39;Test.14=43;Test.15=47 PRIMELOOP: if WRaces/WinOdds=trunc(WRaces/WinOdds) then do WRaces=trunc(WRaces/WinOdds) WinOdds=1 end if PRaces/PlaceOdds=trunc(PRaces/PlaceOdds) then do PRaces=trunc(PRaces/PlaceOdds) PlaceOdds=1 end if SRaces/ShowOdds=trunc(SRaces/ShowOdds) then do SRaces=trunc(SRaces/ShowOdds) ShowOdds=1 end Change=0 do Prime=1 to 15 if WinOdds/Test.Prime=trunc(WinOdds/Test.Prime) & WRaces/Test.Prime=Trunc(WRaces/Test.Prime) then do WinOdds=trunc(WinOdds/Test.Prime) WRaces=trunc(WRaces/Test.Prime) Change=1 end if PlaceOdds/Test.Prime=trunc(PlaceOdds/Test.Prime) & PRaces/Test.Prime=Trunc(PRaces/Test.Prime) then do PlaceOdds=trunc(PlaceOdds/Test.Prime) PRaces=trunc(PRaces/Test.Prime) Change=1 end if ShowOdds/Test.Prime=trunc(ShowOdds/Test.Prime) & SRaces/Test.Prime=Trunc(SRaces/Test.Prime) then do ShowOdds=trunc(ShowOdds/Test.Prime) SRaces=trunc(SRaces/Test.Prime) Change=1 end end if change=1 then signal PRIMELOOP if WinOdds>5 then do Div=trunc(WinOdds/2) WRaces=trunc(WRaces/Div) WinOdds=2 end if PlaceOdds>5 then do Div=trunc(PlaceOdds/2) PRaces=trunc(PRaces/Div) PlaceOdds=2 end if ShowOdds>5 then do Div=trunc(ShowOdds/2) SRaces=trunc(SRaces/Div) ShowOdds=2 end if WinOdds>3 then do WRaces=trunc(WRaces/WinOdds) WinOdds=1 end if PlaceOdds>3 then do PRaces=trunc(PRaces/PlaceOdds) PlaceOdds=1 end if ShowOdds>3 then do SRaces=trunc(SRaces/ShowOdds) ShowOdds=1 end if WinOdds>1 & WRaces>15 then do WRaces=trunc(WRaces/WinOdds) WinOdds=1 end if PlaceOdds>1 & PRaces>15 then do PRaces=trunc(PRaces/PlaceOdds) PlaceOdds=1 end if ShowOdds>1 & SRaces>15 then do SRaces=trunc(SRaces/ShowOdds) ShowOdds=1 end WDollar=WRaces/WinOdds if pos('.',WDollar)=0 then WDollar=WDollar||'.00' else do Parse var WDollar first '.' last last=left(last,1) Wdollar=first||'.'||last||'0' end PDollar=PRaces/PlaceOdds if pos('.',PDollar)=0 then PDollar=PDollar||'.00' else do Parse var PDollar first '.' last last=left(last,1) Pdollar=first||'.'||last||'0' end SDollar=SRaces/ShowOdds if pos('.',SDollar)=0 then SDollar=SDollar||'.00' else do Parse var SDollar first '.' last last=left(last,1) Sdollar=first||'.'||last||'0' end RETURN BYE: days.ms=days.ms+1 CALL CHECKMILLIONS t "" t ' Returning to 'BBSname'...' /* Rewrite PlayersFile */ ss 'Saving the players file'copies('.',NPlayers)''copies('',NPlayers) open(file1, 'Dplayers', 'W') writeln(file1, NPlayers) do i = 1 to NPlayers ss '.' writeln(file1, player.i) writeln(file1, trunc(score.i)) writeln(file1, pwins.i) writeln(file1, pshows.i) writeln(file1, pplaces.i) writeln(file1, Stable.i) writeln(file1, days.i) writeln(file1, horses.i) end close(file1) /* Rewrite in the Horses file */ ss 'Saving the Stable data' temp=trunc(NumOfHorses*.1) ss copies('.',temp)''copies('',temp) q=0 CALL SaveHorses Call Dexit SaveHorses: open(file1, 'DHorses', 'W') writeln(file1,NumOfHorses) SS '' do i = 1 to NumOfHorses q=q+1 if q=10 then do q=0 ss '.' end writeln(file1,RName.i) writeln(file1,HRaces.i) OddMaker=(HRaces.i - (HTrain.i * .2)) / (HWins.i + (HPlaces.i*.25) + (HShows.i*.15)) if HHurt.i=1 then OddMaker = OddMaker + 10 HOdd=trunc(OddMaker) if HOdd = 1 then HOdd = 2 HOdd.i=HOdd writeln(file1,HOdd) writeln(file1,HOwner.i) writeln(file1,HWins.i) writeln(file1,HPlaces.i) writeln(file1,HShows.i) If HRaces.i < 90 Then HAge.i = 1 If HRaces.i >= 90 & HRaces.i < 130 Then HAge.i = 2 If HRaces.i >= 130 & HRaces.i < 180 Then HAge.i = 3 If HRaces.i >= 180 & HRaces.i < 300 Then HAge.i = 4 If HRaces.i >= 300 Then HAge.i = 5 writeln(file1,HAge.i) If HHurt.i=1 then do HChance = random(1,10,TIME('S')) If HChance > 6 Then HHurt.i = 0 end writeln(file1,HHurt.i) writeln(file1,HLocal.i) writeln(file1,HStatus.i) If HOwner.i = 0 Then HTrain.i = HTrain.i + .15 writeln(file1,HTrain.i) writeln(file1,HSitout.i) end close(file1) RETURN SPECIAL: t CLS t '' t '********************************************************************************' t '** Special Functions **' t '********************************************************************************' t ' 1) Add a Horse to the list' t ' 2) Buy a Ranch to keep your horses on' /* t ' 3) Send a message to the SysOp ('NameOfPerson')' t ' 4) Send a message to another player'*/ t ' 3) See what is on the list for version 3.20' if fast=0 then t ' 4) Toggle Fast Display for races (Currently OFF)' if fast=1 then t ' 4) Toggle Fast Display for races (Currently ON)' t ' Q) Quit this menu' query 'Choice >' answer=upper(result) if answer='Q' then Return if answer=1 then CALL ADDHORSE if answer=2 then CALL BUYTHERANCH /* if answer=3 then do PutUstr "C"; PutUser 508 end if answer=4 then do PutUstr "E"; PutUser 508 end */ if answer=3 then do t ' What I am working on at this moment.....' t 'Testing this version and planning new options' CALL PAUSE end if answer=4 then do if Fast=0 then do Fast=1 t 'Fast Display is ON' CALL PAUSE signal SPECIAL end if Fast=1 then do Fast=0 t 'Fast Display is OFF' CALL PAUSE Signal SPECIAL end end if datatype(answer)=CHAR then do BBSCOMMAND answer CALL PAUSE answer=0 end Signal SPECIAL BUYTHERANCH: if Stable.ms=5 then do t 'You already have the best there is.....' CALL PAUSE return end t CLS t "" t '********************************************************************************' t '** Ranches For Sale **' t '********************************************************************************' t ' 1) Single Stable Ranch $175,000' t ' - Can stable up to 4 horses' t ' 2) Double Stable Ranch $225,000' t ' - Can stable up to 8 horses' t ' 3) Three Stable Ranch $325,000' t ' - Can stable up to 12 horses' t ' 4) Four Stable Ranch $425,000' t ' - Can stable up to 20 horses' t ' 5) Grand Stable Ranch $950,000' t ' - Can stable up to 50 horses' s.1=175000;s.2=225000;s.3=325000;s.4=425000;s.5=950000 IF Stable.ms>0 then do temp=stable.ms t 'You already have a stable. If you bought a new one then you can sell' t 'this one for $'trunc(s.temp*.75)'.' end query 'Buy which ranch (=none)' answer=result if answer<6 & answer>0 then do temp=stable.ms if stable.ms>0 then score.ms=score.ms+trunc(s.temp*.75) if score.ms0 then score.ms=score.ms-TRUNC(s.temp*.75) t 'You do not have enough for that ranch!' CALL PAUSE return end stable.ms=answer score.ms=score.ms-s.answer end answer=0 Return ADDHORSE: t "" t " The SysOp will be able to review all horses names!" t " Do not use profanity or inflammitory words in your name" t "" query " Name of Horse:" answer=result if answer='' then Return AlreadyThere=0 do i=1 to NumOfHorses If HName.i=Answer then AlreadyThere=1 end if AlreadyThere=1 then do t 'There is already a horse by that name.' t 'Press Any Key' getchar answer=0 return end owner=0 wins=Random(0,3,Time('S')) shows=Random(0,5,Time('S')) places=Random(0,8,Time('S')) races=Random(1,40,Time('S')) If score.ms>10000 then do query 'Do you wish to own his horse at a cost of $10,000? (y/N)' Own=upper(result) if Own='Y' then do owner=ms wins=0 shows=1 places=1 races=10 score.ms=score.ms-10000 Horses.ms=Horses.ms+1 end end t 'ReWriting Horse File.........' open(file1, 'DHorses', 'W') writeln(file1,NumOfHorses+1) do i = 1 to NumOfHorses writeln(file1,RName.i) writeln(file1,HRaces.i) OddMaker=(HRaces.i - (HTrain.i * .2)) / (HWins.i + (HPlaces.i*.25) + (HShows.i*.15)) if HHurt.i=1 then OddMaker = OddMaker + 10 HOdd=trunc(OddMaker) if HOdd = 1 then HOdd = 2 HOdd.i=HOdd writeln(file1,HOdd) writeln(file1,HOwner.i) writeln(file1,HWins.i) writeln(file1,HPlaces.i) writeln(file1,HShows.i) writeln(file1,HAge.i) writeln(file1,HHurt.i) writeln(file1,HLocal.i) writeln(file1,HStatus.i) writeln(file1,HTrain.i) writeln(file1,HSitout.i) end writeln(file1,Answer) writeln(file1,races) writeln(file1,0) writeln(file1,owner) writeln(file1,wins) writeln(file1,places) writeln(file1,shows) writeln(file1,1) writeln(file1,0) writeln(file1,0) writeln(file1,0) writeln(file1,0) writeln(file1,0) close(file1) NumOfHorses=NumOfHorses+1 t 'ReReading Horse File..............' open(file1, 'DHorses', 'R') NumOfHorses=readln(file1) do i = 1 to NumOfHorses RName.i = readln(file1) HRaces.i = readln(file1) HOdd.i = readln(file1) HOwner.i = readln(file1) HWins.i = readln(file1) HPlaces.i = readln(file1) HShows.i = readln(file1) HAge.i = readln(file1) HHurt.i = readln(file1) HLocal.i = readln(file1) HStatus.i = readln(file1) HTrain.i = readln(file1) HSitout.i = readln(file1) end close(file1) answer=0 return /************************************************************************/ /* Error Handling Routines */ /************************************************************************/ ioerr: t 'Input/Output Error in 'progname'. Line: 'SIGL t 'Error: 'RCALL errortext(RC) t 'Please notify 'sysopname'!' t 'Returning to 'BBSname'...' t 'Input/Output Error in 'progname'. Line: 'SIGL t 'Error: 'RCALL errortext(RC) Call Dexit syntax: t 'Syntax Error in 'progname'. Line: 'SIGL t 'Error: 'RCALL errortext(RC) t 'Please notify 'sysopname'!' t 'Returning to 'BBSname'...' t 'Syntax Error in 'progname'. Line: 'SIGL t 'Error: 'RCALL errortext(RC) Call Dexit DExit: t "[1 p"; bufferflush ; ShutDown ; Exit