home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d09xx / d0950.lha / BBDoors / BBDoors65.lha / rexxDoors / Stock_Market.rexx < prev    next >
OS/2 REXX Batch file  |  1993-10-22  |  43KB  |  1,471 lines
  1. /*************************************
  2.  *    StockMarket v2.03 in AREXX     *
  3.  * Adapted for BBBBS by Matt English *
  4.  *    Last Edited: 22 Oct 1993 - RLS *
  5.  *************************************/
  6.  
  7. options results
  8. FF='0C'x
  9. CR='0D'x
  10. CALL TIME('R')
  11. SIGNAL ON BREAK_C
  12. SIGNAL ON BREAK_E
  13.  
  14. bbspath=GETCLIP('BBS_path')
  15. bbspath=bbspath'rexxDoors/Data/'
  16.  
  17. PARSE arg Username winnings . colorflag secs .
  18. IF secs='' THEN secs=3600
  19. signal on syntax
  20.  
  21. CLS = 'H'
  22. def=''
  23. pen2=''
  24. pen3=''
  25. pen4=''
  26. pen5=''
  27. pen6=''
  28. pen7=''
  29. IF colorflag=1 THEN
  30.   DO
  31.     def=''
  32.     pen2=''
  33.     pen3=''
  34.     pen4=''
  35.     pen5=''
  36.     pen6=''
  37.     pen7=''
  38.   END
  39.  
  40. if ~show('L',"rexxsupport.library") then do
  41.    addlib('rexxsupport.library',0,-30,0)
  42.     end
  43.  
  44. info= 's:CONFIG.BBS'
  45. IF ~EXISTS(info) THEN info='BBS:BBS_TEXT/CONFIG.BBS'
  46. call open(con,info,'R')
  47. IF con=0 THEN EXIT 666
  48. lynes.1=readln(con)
  49.  
  50. compos=POS('/*',lynes.1)
  51. IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
  52.  bbsname=STRIP(lynes.1)
  53.  
  54. lynes.2=readln(con)
  55. sysopname=WORD(lynes.2,1)
  56. call close(con)
  57.  
  58. file1=''bbspath'SM.players'
  59. file2=''bbspath'SM.playerstats'
  60. file3=''bbspath'SM.companystats'
  61. file4=''bbspath'SM.fame'
  62. file5=''bbspath'SM.news1'
  63. file6=''bbspath'SM.news2'
  64. file7=''bbspath'SM.oneliner'
  65. file8=''bbspath'SM.help'
  66. file9=''bbspath'SM.log'
  67.  
  68. smv1=1000000;smv2=-1500;smv3=50000;smv4=7
  69. smv5='New Game';smv6=10;smv7=24;smv8=1;smv9=1
  70. smv10=0;smv11=0;smv12=0;smv13=10000;smv14=.51
  71. smv15=.65;smv16=4;smv17=1;smv18=100;smv19=100;smv20=5
  72.  
  73. dashes='--------------------------------------'
  74.  
  75. name = UPPER(username)
  76.  
  77.   spaces='                 '
  78.   longdashes='-----------------------------------------------------------------------------'
  79.   say ''cr
  80.  
  81. norxit = 1 /* Normal exit, = 0 if ctrl c is hit */
  82.  
  83. START:
  84. say ''cr
  85. say ''cr
  86. say ''spaces''pen4'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$'def''cr
  87. say ''spaces''pen4'$$                                   $$'def''cr
  88. say ''spaces''pen4'$$'def'    'pen6'StockMarket v2.03 in ARexx'def'     'pen4'$$'def''cr
  89. say ''spaces''pen4'$$'def'                'pen6'by'def'                 'pen4'$$'def''cr
  90. say ''spaces''pen4'$$'def'             'pen6'Ken Koch'def'              'pen4'$$'def''cr
  91. say ''spaces''pen4'$$                                   $$'def''cr
  92. say ''spaces''pen4'$$'def' 'pen6'adapted for BBBBS by Matt English'def' 'pen4'$$'def''cr
  93. say ''spaces''pen4'$$                                   $$'def''cr
  94. say ''spaces''pen4'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$'def''cr
  95. say ''cr
  96. time=time();date=date()
  97. say ''cr
  98. say 'Checking Board of Members'cr
  99. if ~exists(file1) then do
  100.  
  101.   call open(fn1,file1,'W')
  102.   call writeln(fn1,smv7 smv8 smv9)
  103.   call writeln(fn1,date);call writeln(fn1,name)
  104.   call writeln(fn1,smv10)
  105.   call close(fn1)
  106.   end
  107. call open(fn2,file1,'R')
  108. line=readln(fn2)
  109. parse var line al np jd .
  110. addaday=readln(fn2)
  111. do n=1 to np
  112.   line=readln(fn2);name.n=upper(line);lc.n=readln(fn2)
  113.   end
  114. call close(fn2)
  115. do n=1 to np
  116.   CALL WRITECH(STDOUT,'.')
  117.   if name=name.n then cu=n
  118.   end
  119. SAY '.'CR
  120. if ~exists(file2) then do
  121.   call ALIAS
  122.   call open(fn3,file2,'W');call writeln(fn3,smv5);call writeln(fn3,name);call writeln(fn3,alias);call writeln(fn3,smv3)
  123.   do j = 1 to smv4
  124.     call writeln(fn3,'0' '0')
  125.     end
  126.   call close(fn3)
  127.   end
  128. call open(fn4,file3,'R')
  129. nc = readln(fn4)
  130. do i=1 to nc
  131.   cn$.i=readln(fn4);line=readln(fn4)
  132.   parse var line cv.i vi.i vs.i sf.i tq.i rv.i aa.i .
  133.   end
  134. call close(fn4)
  135.  
  136.  
  137.  
  138. call open(fn5,file2,'R');line=readln(fn5)
  139. parse var line lp$
  140. do n=1 to np
  141.   name.n=readln(fn5);alias.n=readln(fn5);cr.n=readln(fn5)
  142.   do j=1 to smv4
  143.     line=readln(fn5)
  144.     parse var line cn.n.j so.n.j .
  145.     end
  146.   end
  147. call close(fn5)
  148.  
  149. call STATCK
  150.  
  151. say ''cr
  152. say ''pen3'Connecting to Wall Street...'def''cr
  153. say ''cr
  154. if ~exists(file4) then do
  155.   call open(fn6,file4,'W');call writeln(fn6,'  Members of the Millionaire''s Club');call writeln(fn6,dashes);call close(fn6)
  156.   end
  157. call open(fa7,file4,'r')
  158. do until eof(fa7)
  159.   line=readln(fa7)
  160.   say ''spaces''line''cr
  161.   end
  162. call close(fa7)
  163. say ''spaces''dashes''cr;say ''cr
  164. options prompt 'Tap 'pen3'Return'def' to continue.'
  165.  
  166. pull result
  167. say ''CLS''cr
  168. say ''cr
  169. if ~exists(file6) then do
  170.   call open(fn8,file6,'W')
  171.   call writeln(fn8,spaces dashes)
  172.   call writeln(fn8,spaces time date)
  173.   call writeln(fn8,spaces'Stock Market opens for business')
  174.   call close(fn8)
  175.   end
  176. if ~exists(file5) then do
  177.   call open(fn9,file5,'W')
  178.   call writeln(fn9,spaces dashes)
  179.   call writeln(fn9,spaces'  Stock Market News for' date)
  180.   call close(fn9)
  181.   end
  182. if date=addaday then nop
  183. else do
  184.   addaday=date;jd=jd+1
  185.  
  186.   address command 'c:delete 'file6' quiet'
  187.   address command 'c:rename 'file5' 'file6''
  188.  
  189.   call open(fn12,file5,'W')
  190.   call writeln(fn12,spaces dashes)
  191.   call writeln(fn12,spaces ' Stock Market News for 'date)
  192.   call close(fn12)
  193.   do i=1 to nc
  194.     vi.i=0
  195.     end
  196.   do i=1 to nc
  197.     vs.i=0
  198.     end
  199.   do i=1 to nc
  200.     zz=(((randu(time('s'))-.45 )*10)%1)/10
  201.  
  202.  
  203.     tq.i=tq.i+zz
  204.     end
  205.  
  206.   address command 'c:delete 'file3' quiet'
  207.   call open(fn13,file3,'W')
  208.   call writeln(fn13,nc)
  209.   do i=1 to nc
  210.     cv.i=trunc(cv.i+.005,2);vs.i=trunc(vs.i+.005,2);aa.i=trunc(aa.i+.005,2)
  211.     call writeln(fn13,cn$.i);call writeln(fn13,cv.i vi.i vs.i sf.i tq.i rv.i aa.i)
  212.     end
  213.   call close(fn13)
  214.   end
  215. say ''cr
  216. say ''cr
  217.  
  218. say'             Use option 'pen5'[8] 'def'to read the lastest Stock Market news!'cr
  219.  
  220. say ''cr;say ''cr
  221. say ''spaces'Last Investor:'pen5'' lp$''def''cr
  222. lc.cu=jd;call delay(100)
  223. if jd=smv18 & smv17=1 then do
  224.   say ''cr;say ''pen6'There has been no winners in the last'def' 'pen3''smv18''def' 'pen6'days.'def'  The game is being reset.'cr
  225.   call RESETPLAYERS;call RESETCOMPANIES;call RESETNEWS
  226.   signal BYE
  227.   end
  228. if ~exists(file7) then signal MAIN
  229. say ''cr
  230. call open(fny,file7,'R');mess=readln(fny);bywhom=readln(fny)
  231. say ''longdashes''cr;say ''pen6''mess ''pen3''bywhom''def''cr;say ''longdashes''cr
  232. call close(fny);call delay(200)
  233. signal MAIN
  234.  
  235.  
  236. MAIN:
  237. call MENU;signal PROMPT
  238.  
  239. MENU:
  240. say ''cr
  241. say ''spaces''pen6'['pen3'1'pen6'] 'pen7'The Big Board'def''cr
  242. say ''spaces''pen6'['pen3'2'pen6'] 'pen7'Your Portfolio'def''cr
  243. say ''spaces''pen6'['pen3'3'pen6'] 'pen7'List of Investors and Net Worth'def''cr
  244. say ''spaces''pen6'['pen3'4'pen6'] 'pen7'Check a Company''s Stockholders'def''cr
  245. say ''spaces''pen6'['pen3'5'pen6'] 'pen7'Visit the Broker (Buy/Sell Stock)'def''cr
  246. say ''spaces''pen6'['pen3'6'pen6'] 'pen7'Help and Instructions'def''cr
  247. say ''spaces''pen6'['pen3'7'pen6'] 'pen7'Update Stock Market Prices'def''cr
  248. say ''spaces''pen6'['pen3'8'pen6'] 'pen7'Read Stock Market News'def''cr
  249. say ''spaces''pen6'['pen3'X'pen6'] 'pen7'Exit Stock Market to'pen3'' bbsname''def''cr
  250. x=randu(time('s'))
  251. if x>smv15 then signal RNDNOTICES
  252. say ''cr
  253. return
  254.  
  255. PROMPT:
  256. say ''cr
  257. options prompt ''pen2'Enter Your Stock Market Option?'def' > '
  258. pull result
  259. choice=upper(result)
  260. CALL checkBBS()
  261.  
  262. if result='###PANIC' then SIGNAL GETOUT
  263. if choice='?' then call MENU
  264. if choice='Z' then call SYSOPMENU
  265. if choice='1' then signal BIGBOARD
  266. if choice='2' then call PORTFOLIO
  267. if choice='3' then signal INVESTORWORTH
  268. if choice='4' then signal EXAMINECO
  269. if choice='5' then signal BUYSELL
  270. if choice='6' then signal HELP
  271. if choice='7' then signal USERUPDATEFLAG
  272. if choice='8' then signal NEWS
  273. if choice='X' then signal EXITREG
  274. signal MAIN
  275.  
  276. STATCK:
  277. do n=1 to np
  278.   if name.n=name then return
  279.   end
  280. if np>=al then do
  281.   say ''cr
  282.   say ''pen3'Sorry, the maximum number of players are now registered.'def''cr
  283.   call delay(100);say ''cr
  284.   say ''pen5'Check back daily for new openings.'def''cr
  285.   call delay(100);say ''cr
  286.   say 'Returning to'pen2'' bbsname''def''cr
  287.   call delay(100)
  288.   end
  289. if np>=al then exit
  290. if name=lp$ then do
  291.   say ''cr
  292.   say ''spaces''pen3'You cannot re-register at this time'def''spaces''cr
  293.   say ''cr;say 'Returning to'pen2'' bbsname''def''cr
  294.   call delay(100);exit
  295.   end
  296. call ALIAS
  297. say ''cr;say ''pen7'Adding your name to the Board of Members...'def''cr
  298. np=np+1;alias.np=alias;lc.np=smv10;cu=np
  299. address command 'c:delete 'file1' quiet'
  300. call open(fn14,file1,'W');call writeln(fn14,al np jd);call writeln(fn14,addaday)
  301. do n=1 to np
  302.   call writeln(fn14,name.n);call writeln(fn14,lc.n)
  303.   end
  304. call close(fn14)
  305. say ''cr
  306. say''pen5'Setting up your account'def''cr
  307. call open(fn15,file2,'A');call writeln(fn15,name);call writeln(fn15,alias.cu);call writeln(fn15,smv3)
  308. do j=1 to smv4
  309.   CALL WRITECH(STDOUT,'.');call writeln(fn15,'0' '0')
  310.   end
  311. say '.'cr
  312. call close(fn15)
  313. call open(fn5,file2,'R');lp$=readln(fn5)
  314. do n=1 to np
  315.   name.n=readln(fn5);alias.n=readln(fn5);cr.n=readln(fn5)
  316.   do j=1 to smv4
  317.     line=readln(fn5)
  318.     parse var line cn.n.j so.n.j .
  319.     end
  320.   end
  321. call close(fn5)
  322. return
  323.  
  324. PORTFOLIO:
  325. time=time();date=date()
  326. say ''cr;say ''spaces''pen2''center('Your Investment Portfolio as of:',40)''def''cr
  327. say ''spaces''pen3''center(time date,40)''def''cr
  328. say ''cr;say ''spaces'   'pen5'Company              Shares    Net'def''cr
  329. say ''spaces' 'pen5'# Name                  Owned   Gain'def''cr
  330. say ''spaces''dashes''cr
  331. do j=1 to smv4
  332.   do i=1 to nc
  333.     if cn.cu.j~=i then nop
  334.     else do
  335.      
  336. mi=right(i,2);mcn$.i=left(cn$.i,20);mso.cu.j=right(so.cu.j,6);mvs.i=trunc(vs.i+.005,2);mvs.i=right(mvs.i,6);say ''spaces''pen6''mi' 'mcn$.i' 'mso.cu.j' 'mvs.i''def''cr
  337.       end
  338.     end
  339.   end
  340. say ''spaces''dashes''cr
  341. say ''spaces'Your available cash: 'pen3'$'cr.cu''def''cr
  342. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  343.  
  344.  
  345. pull result
  346. if result='###PANIC' then SIGNAL GETOUT
  347. say ''cr
  348. return
  349.  
  350.  
  351. EXITREG:
  352. say ''cr;say ''pen3'Leaving the Stock Market...'def''cr
  353. call NEGCASH
  354. say ''cr;options prompt ''pen3'Are you sure (Y/n)?'def' > '
  355.  
  356.  
  357. pull result
  358. choice=upper(result)
  359.  
  360.  
  361. if result='###PANIC' then SIGNAL GETOUT
  362. if choice='N' then signal MAIN
  363. if choice='Y' then SIGNAL GETOUT
  364.  
  365. GETOUT:
  366. if jd=smv18 & smv17=1 then do
  367.   address command 'c:delete 'file3' quiet'
  368.   call open(fn16,file3,'W');call writeln(fn16,nc);cv.i=trunc(cv.i+.005,2);vs.i=trunc(vs.i+.005,2);aa.i=trunc(aa.i+.005,2)
  369.     do i=1 to nc
  370.     call writeln(fn16,cn$.i);call writeln(fn16,cv.i vi.i vs.i sf.i tq.i rv.i aa.i)
  371.     end
  372.   call close(fn16)
  373.   end
  374. winner=0;call CHECKFORWINNER
  375. if jd=smv18 then do
  376.   address command 'c:delete 'file3' quiet'
  377.   call open(fn17,file3,'W');call writeln(fn17,nc)
  378.   do i=1 to nc
  379.     cv.i=trunc(cv.i+.005,2);vs.i=trunc(vs.i+.005,2);aa.i=trunc(aa.i+.005,2);call writeln(fn17,cn$.i);call writeln(fn17,cv.i vi.i vs.i sf.i tq.i rv.i aa.i)
  380.     end
  381.   call close(fn17)
  382.   end
  383. if alias.cu~=lp$ then do
  384.   say ''cr;say ''pen7'Processing Update...'def''cr;call PRICEUPDATE
  385.   end
  386. say ''cr;say ''pen3'Updating Stock Market files...'def''cr
  387. say ''cr;ct=np
  388. do n=1 to np
  389.   badso.n=0
  390.   do j=1 to smv4
  391.     badso.n=badso.n+so.n.j
  392.     end
  393.   if badso.n<1 & cr.n<100 then do
  394.     time=time();date=date()
  395.     say ''spaces''dashes''cr
  396.     say ''spaces''time'' date''cr
  397.     say ''spaces''pen5'alias.n'def 'was removed from the'cr
  398.     say ''spaces'Board due to Bad Debts!'cr
  399.     say ''cr
  400.     call open(fn19,file5,'A');call writeln(fn19,dashes);call writeln(fn19,time date);call writeln(fn19,alias.n 'was removed from the');call writeln(fn19,'Board due to Bad Debts!');call close(fn19)
  401.     alias.n='^';ct=ct-1
  402.     do j=1 to smv4
  403.       sf.j=sf.j+so.n.j
  404.       end
  405.     end
  406.   end
  407. if alias.cu~='^' & cr.cu<-1500 then do
  408.   time=time();date=date()
  409.   say ''spaces''dashes''cr
  410.   say ''spaces''time'' date''cr
  411.   say ''spaces''pen3''alias.cu ''def'was removed from the'cr
  412.   say ''spaces'Board due to Bad Debts!'cr
  413.   say ''cr
  414.   call open(fn19,file5,'A');call writeln(fn19,''dashes);call writeln(fn19,''time date);call writeln(fn19,''alias.cu 'was removed from the');call writeln(fn19,'Board due to Bad Debts!');call close(fn19)
  415.   alias.cu='^';ct=ct-1
  416.   do j=1 to smv4
  417.     sf.j=sf.j+so.cu.j
  418.     end
  419.   end
  420. do n=1 to np
  421.   if smv19<jd-lc.n then do
  422.     time=time();date=date()
  423.     say ''spaces''dashes''cr
  424.     say ''spaces''time'' date''cr
  425.     say ''spaces''pen3''alias.n ''def'was removed from the'cr
  426.     say ''spaces'Board due to inactivity!'cr
  427.     say ''cr
  428.     call open(fn18,file5,'A');call writeln(fn18,dashes);call writeln(fn18,time date);call writeln(fn18,alias.n 'was removed from the');call writeln(fn18,'Board due to inactivity!');call close(fn18)
  429.     alias.n='^';ct=ct-1
  430.     do j=1 to smv4
  431.       sf.j=sf.j+so.n.j
  432.       end
  433.     end
  434.   end
  435. address command 'c:delete 'file1' quiet'
  436. call open(fn20,file1,'W');call writeln(fn20,al ct jd);call writeln(fn20,addaday)
  437. do n=1 to np
  438.   if alias.n~='^' then do
  439.     call writeln(fn20,name.n);call writeln(fn20,lc.n)
  440.     end
  441.   end
  442. call close(fn20)
  443. address command 'c:delete 'file2' quiet'
  444. call open(fn21,file2,'W');call writeln(fn21,alias.cu)
  445. do n=1 to np
  446.   if alias.n~='^' then do
  447.     call writeln(fn21,name.n);call writeln(fn21,alias.n);call writeln(fn21,cr.n)
  448.     do j=1 to smv4
  449.       call writeln(fn21,cn.n.j so.n.j)
  450.       end
  451.     end
  452.   end
  453. call close(fn21)
  454. address command 'c:delete 'file3' quiet'
  455. call open(fn22,file3,'W');call writeln(fn22,nc)
  456. do i=1 to nc
  457.   cv.i=trunc(cv.i+.005,2);vs.i=trunc(vs.i+.005,2);aa.i=trunc(aa.i+.005,2);call writeln(fn22,cn$.i);call writeln(fn22,cv.i vi.i vs.i sf.i tq.i rv.i aa.i)
  458.   end
  459. call close(fn22)
  460. say ''cr
  461. if norxit = 1 then do /* Normal exit, = 0 if ctrl c is hit */
  462.   call ONELINER
  463.   end
  464. say ''cr
  465. say ''spaces''pen2'Thank you for playing Stock Market'def''spaces''cr
  466. say ''cr;call delay(100)
  467. say 'Returning to 'pen6''bbsname''def''cr;call delay(100);y=0.05
  468. do j=1 to smv4
  469.   do i=1 to smv6
  470.     if cn.cu.j=i then do
  471.       y=y+(so.cu.j*cv.i)
  472.       end
  473.     end 
  474.   end
  475. y=y+cr.cu
  476.  
  477.  
  478.  if ~exists(''bbspath'SM.log') then do
  479.      call open(log,''bbspath'SM.log','W')
  480.      end
  481.  else call open(log,''bbspath'SM.log','A')
  482.  
  483. call writeln(log,name date() time())
  484. call close(log)
  485.  
  486. exit
  487.  
  488.  
  489.  
  490. NEGCASH:
  491. if cr.cu>smv2 then return
  492. say ''cr;say ''pen3'FLASH'spaces''pen2'Your available cash is in the 'pen3'red!'def''spaces ''cr
  493. say ''cr;say ''pen6'If you leave the Stock Market with a with a debt of more than 'pen5'$'smv2 ''pen6'in cash,'def''cr
  494. say ''pen6'your account will be 'pen3'DELETED!'def''cr
  495. return
  496.  
  497. USERUPDATEFLAG:
  498. say ''cr
  499. if alias.cu=lp$ then do
  500.   say ''cr;say ''pen3'You did the last update.'def''cr;say ''cr;call delay(100)
  501.   say ''pen5'Another investor must do the next update!'def''cr;call delay(100)
  502.   end
  503. else call PRICEUPDATE
  504. signal MAIN
  505.  
  506. PRICEUPDATE:
  507. time=time();date=date()
  508. if alias.cu=lp$ then return
  509. lp$=alias.cu
  510. do i=1 to nc
  511.   div.i=0
  512.   if cv.i>0 then do
  513.     x=(randu(time('s'))*(rv.i/10)+((tq.i/20)-(rv.i/20)));cv.i=cv.i+x;vs.i=vs.i+x
  514.     if x>smv14 then div.i=1
  515.     end
  516.   end
  517. call DIVIDENDS
  518. do i=1 to nc
  519.   split.i=0
  520.   if cv.i>(aa.i*2.2) then split.i=1
  521.   end
  522. call SPLIT
  523. do i=1 to nc
  524.   if cv.i<1 then do
  525.     time=time();date=date()
  526.     say ''spaces''dashes''cr
  527.     say ''spaces''time'' date''cr
  528.     say ''spaces''pen5'' cn$.i ''def'goes 'pen3'BANKRUPT!'def' 'cr
  529.     say ''cr
  530.     call open(fn25,file5,'A');call writeln(fn25,dashes);call writeln(fn25,time date);call writeln(fn25,cn$.i 'goes BANKRUPT!');call close(fn25)
  531.     cv.i=0;sf.i=0
  532.     do n=1 to np
  533.       do j=1 to smv4
  534.       if cn.n.j=i then do
  535.         cn.n.j=0;so.n.j=0
  536.         end
  537.       end
  538.     end
  539.   end
  540. address command 'c:delete 'file3' quiet'
  541. call open(fn26,file3,'W');call writeln(fn26,nc)
  542. do i=1 to nc
  543.   cv.i=trunc(cv.i+.005,2);vs.i=trunc(vs.i+.005,2);aa.i=trunc(aa.i+.005,2);call writeln(fn26,cn$.i);call writeln(fn26,cv.i vi.i vs.i sf.i tq.i rv.i aa.i)
  544.   end
  545. call close(fn26)
  546. return
  547.  
  548. DIVIDENDS:
  549. do i=1 to nc
  550.   if div.i=1 then do
  551.     pd=(((randu(time('s'))*smv16)+1)%1)/2
  552.     time=time();date=date()
  553.     say ''spaces''dashes''cr
  554.     say ''spaces''time'' date''cr
  555.     say ''spaces''pen3''cn$.i''def''cr
  556.     say ''spaces'paid 'pen6'$'trunc(pd+.005,2) ''def'per share in Dividends'cr
  557.     say ''spaces'P/S 'pen5'$'trunc(cv.i+.005,2)''def'       N/G 'pen6'$'trunc(vs.i+.005,2)''def''cr
  558.     say ''cr
  559.  
  560.     call close(fn23)
  561.     call open(fn23,file5,'A')
  562.     call writeln(fn23,longdashes)
  563.     call writeln(fn23,time cn$.i ':' 'paid $'trunc(pd+.005,2) '/ share, P/S $'trunc(cv.i+.005,2)', N/G $'trunc(vs.i+.005,2))
  564.     call close(fn23)
  565.  
  566.  
  567.     end
  568.   end
  569. call PAYDIVIDENDS
  570. return
  571.  
  572. PAYDIVIDENDS:
  573. do i=1 to nc
  574.   if div.i=1 then do
  575.     do n=1 to np
  576.       do j=1 to smv4
  577.         if cn.n.j=i then do
  578.           cr.n=(cr.n+(pd*so.n.j)+.5)%1
  579.           end
  580.         end
  581.       end
  582.     end
  583.   end
  584. return
  585.  
  586. SPLIT:
  587. do i=1 to nc
  588.   if split.i=1 then do
  589.     time=time();date=date();cv.i=(cv.i*1.07)/2;aa.i=cv.i
  590.     say ''spaces''dashes''cr
  591.     say ''spaces''time'' date''cr
  592.     say ''spaces''pen3''cn$.i''def''cr
  593.     say ''spaces'Stock has split!  P/S 'pen5'$'trunc(cv.i+.005,2)''def''cr
  594.     say ''cr
  595.     call open(fn38,file5,'A');call writeln(fn38,dashes);call writeln(fn38,time date);call writeln(fn38,cn$.i);call writeln(fn38,'Stock has split!  P/S $'trunc(cv.i+.005,2));call close(fn38)
  596.     sf.i=sf.i*2
  597.     do n=1 to np
  598.       do j=1 to smv4
  599.         if cn.n.j=i then so.n.j=so.n.j*2
  600.         end
  601.       end
  602.     end
  603.   end
  604. return
  605.  
  606. CHECKFORWINNER:
  607. say ''cr;say ''pen6'Checking your holdings...'def''cr
  608. y=0.05;fame=0
  609. do j=1 to smv4
  610.   do i=1 to smv6
  611.     if cn.cu.j=i then y=y+(so.cu.j*cv.i)
  612.     end
  613.   end
  614.  
  615. y=y+cr.cu;my=trunc(y);my=right(my,8);malias=left(alias.cu,19)
  616.  
  617. /* y=y+cr.cu;my='$'trunc(y);my=right(my,8);malias=left(alias.cu,19)*/ /*changed y,8 to my,8 */
  618. if y>=smv1 then do
  619.   date=date(U)
  620.   say ''cr;say ''pen3'FLASH 'pen6'Congratulations,'pen4'' alias.cu''def''cr;winner=1;call delay(100)
  621.   say ''cr;say 'Your Net Worth is 'pen3'$'my'.  'pen5'You have won the game!'def''cr;call delay(100)
  622.   say ''cr;say ''pen3'Adding your name to the Millionaire''s Club'def''cr
  623.   call open(fn37,file4,'A');call writeln(fn37,date malias '$'my);call close(fn37)
  624.   do i=1 to nc
  625.     sf.i=smv13;cv.i=((randu(time('s'))*4500)+500)%1/100;aa.i=cv.i
  626.     end
  627.   fame=1;np=0;jd=999;call RESETPLAYERS;call RESETCOMPANIES;call RESETNEWS;signal GAMEWON
  628.   end
  629. say ''cr;say ''spaces'Your Net Worth is : 'pen3'$'trunc(y)''def''cr;call delay(100)
  630. say ''cr
  631. say ''pen2'Checking other members...'def''cr;say ''cr
  632. do n=1 to np
  633.   if n=cu then iterate
  634.   say ''pen3''alias.n''def''cr
  635.   yy=0
  636.   do j=1 to smv4
  637.     do i=1 to smv6
  638.       if cn.n.j=i then yy=yy+(so.n.j*cv.i)
  639.       end 
  640.     end
  641. yy.n=trunc(yy+cr.n);myy.n=right(yy.n,8);malias.n=left(alias.n,19)
  642.   if yy.n>=smv1 & fame=0 then do
  643.     date=date(U)
  644.     say ''cr;say ''pen3'FLASH Notice!'def''cr;winner=1
  645.     say ''cr;say ''pen6''alias.n' 'pen3'has won the game!'def''cr;call delay(100)
  646.     say ''cr;say 'Adding 'pen3''alias.n''def' to the Millionaire''s Club'cr
  647.     call open(fn37,file4,'A');call writeln(fn37,date malias.n '$'myy.n);call close(fn37)
  648.     do i=1 to nc
  649.       sf.i=smv13;cv.i=((randu(time('s'))*4500)+500)%1/100;aa.i=cv.i
  650.       end 
  651.     np=0;jd=999;call RESETPLAYERS;call RESETCOMPANIES;call RESETNEWS;signal GAMEWON
  652.     end
  653.   end
  654. return
  655.  
  656. BIGBOARD:
  657. time=time();date=date()
  658. say ''cr;say ''spaces''pen3''center('Market Prices as of:',40)''def''cr
  659. say ''spaces''pen2''center(time date,40)''def''cr
  660. say ''cr;say ''spaces'    'pen6'Company             Shares Current'def''cr
  661. say ''spaces'    'pen2'Name             Available   Price'def''cr
  662. say ''spaces''dashes''cr
  663. vi=smv11;vs=smv12
  664. do i=1 to nc
  665.   vi=vi+vi.i;vs=vs+vs.i;mi=right(i,2);mcn$.i=left(cn$.i,20);msf.i=right(sf.i,6);mcv.i=trunc(cv.i+.005,2);mcv.i=right(mcv.i,7)
  666.   if cv.i=0 then do
  667.     data='***BANKRUPT***';say ''spaces''pen3''mi' 'mcn$.i' 'data''def''cr
  668.     end
  669.  
  670.   else say ''spaces''pen2''mi'' mcn$.i'' msf.i'' mcv.i''def''cr
  671.  
  672.  end
  673. say ''spaces''dashes''cr
  674. say ''spaces'Volume Traded:'pen6' 'vi''def''cr
  675. say ''spaces'Price Index  :'pen3'' trunc(vs+.005,2)''def''cr
  676. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  677.  
  678. pull result
  679. if result='###PANIC' then SIGNAL GETOUT
  680. say ''cr;signal MAIN
  681.  
  682.  
  683. INVESTORWORTH:
  684. time=time();date=date()
  685. say ''cr;say ''spaces''pen3''center('Stockholders as of:',40)''def''cr
  686. say ''spaces''pen3''center(time date,40)''def''cr
  687. say ''cr;say ''spaces''pen2'Investor                     Net Worth'def''cr
  688. say ''spaces''dashes''cr
  689. do n=1 to np
  690.   y=0.05
  691.   do j=1 to smv4
  692.     do i=1 to nc
  693.       if cn.n.j=i then do
  694.         y=y+(so.n.j*cv.i)
  695.         end
  696.       end
  697.     end
  698.   y=y+cr.n;my='$'trunc(y);my=right(my,8);malias.n=left(alias.n,29);say ''spaces''pen6''malias.n' 'my''def''cr
  699.   end
  700. say ''spaces''dashes''cr
  701. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  702.  
  703.  
  704. pull result
  705. if result='###PANIC' then SIGNAL GETOUT
  706. say ''cr;signal MAIN
  707.  
  708. EXAMINECO:
  709. say ''cr
  710. do i=1 to nc
  711.   if i<10 then say ''spaces' 'pen6'['pen3''i''pen6'] 'pen5'' cn$.i''def''cr
  712.   else say ''spaces''pen6'['pen3''i''pen6']'pen5'' cn$.i''def''cr
  713.   end
  714. say ''spaces' 'pen6'['pen3'X'pen6']'def' Exit'cr
  715. say ''cr
  716.  
  717.  
  718. options prompt 'Enter the Number of the Company you wish to check > '
  719. pull result;i=upper(result)
  720. if result='###PANIC' then SIGNAL GETOUT
  721. if i='X' then signal MAIN
  722. if i<1 | i>nc then signal EXAMINECO
  723. time=time();date=date()
  724. say ''cr;say ''spaces''pen3''center('Stock Report for:',40)''def''cr
  725. say ''spaces''pen2''center(cn$.i,40)''def''cr
  726. say ''spaces'   'pen5'As of:' time'' date''def''cr
  727. say ''cr;say ''spaces''pen7'Investor                  Shares Owned'def''cr
  728. say ''spaces''dashes''cr
  729. if cv.i=0 then do
  730.   say ''spaces'     'pen3'>>>>> COMPANY BANKRUPT <<<<<'def'      'cr;say ''spaces''dashes''cr;say ''cr;call delay(100)
  731.   end
  732. if cv.i=0 then signal EXAMINECO
  733. do n=1 to np
  734.   do j=1 to smv4
  735.     if cn.n.j~=i then nop
  736.     else do
  737.       mso.n.j=right(so.n.j,8);malias.n=left(alias.n,28,);say ''spaces''pen5''malias.n' 'mso.n.j''def''cr
  738.       end
  739.     end
  740.   end
  741. say ''spaces''dashes''cr;say ''spaces'Net Gain today      :'pen7'' trunc(vs.i+.005,2)''def''cr
  742. say ''spaces'Volume traded today :'pen3'' vi.i''def''cr
  743. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  744.  
  745.  
  746. pull result
  747. if result='###PANIC' then SIGNAL GETOUT
  748. say ''cr;signal EXAMINECO
  749.  
  750. BUYSELL:
  751. say ''cr
  752. say ''spaces''pen6'['pen3'B'pen6']  'pen7'Buy Stocks'def''cr
  753. say ''spaces''pen6'['pen3'S'pen6']  'pen7'Sell Stocks'def''cr
  754. say ''spaces''pen6'['pen3'X'pen6']  'pen3'Exit'def''cr
  755. say ''cr;options prompt 'Do you wish to BUY or SELL Stocks > '
  756.  
  757.  
  758. pull result;choice=upper(result)
  759. if result='###PANIC' then SIGNAL GETOUT
  760. if choice='B' then signal BUY
  761. if choice='S' then signal SELL
  762. if choice='X' then signal MAIN
  763. else signal BUYSELL
  764.  
  765. BUY:
  766. say ''cr
  767. do i=1 to nc
  768.   if i<10 then say ''spaces' 'pen6'['pen3''i''pen6']  'pen5''cn$.i''def''cr
  769.   else say ''spaces''pen6'['pen3''i''pen6']  'pen5''cn$.i''def''cr
  770.   end
  771. say ''spaces' 'pen6'['pen3'X'pen6']  'pen3'Exit'def''cr;say ''cr
  772.  
  773.  
  774. options prompt 'Enter Number of the Company you wish to Buy > '
  775. pull result;i=upper(result)
  776. if result='###PANIC' then SIGNAL GETOUT
  777. if i='X' then signal BUYSELL
  778. if i=0 then signal BUYSELL
  779. if i<1 | i>smv6 then signal BUY
  780. say ''cr;say ''spaces''pen2'Company Name   :'pen6'' cn$.i''def''cr
  781. say ''spaces''pen7'Shares Free    :'pen6'' sf.i''def''cr
  782. if cv.i<0 then say ''spaces''pen7'Price per Share:    'pen3'>>>>> BANKRUPT <<<<<   'def''cr
  783. else say ''spaces'Price per Share: 'pen6'$'trunc(cv.i+.005,2)''def''cr
  784. say ''spaces'Net Gain today : 'pen6'$'trunc(vs.i+.005,2)''def''cr
  785. say ''spaces'Available Cash : 'pen3'$'cr.cu''def''cr
  786. say ''cr;say ''pen4'Enter the Amount of Shares you wish to Purchase'def''cr
  787.  
  788.  
  789. options prompt 'Enter ''A'' to buy the MAXIMUM amount > '
  790. pull result;buyme=upper(result)
  791. if result='###PANIC' then SIGNAL GETOUT
  792. if buyme='A' then do
  793.   buyme=(cr.cu*(1-(smv20/100)))%1;buyme=(buyme/cv.i)%1
  794.   if buyme>sf.i then buyme=sf.i
  795.   end
  796. if buyme='' then signal BUYSELL
  797. if ~datatype(buyme,'w') then signal BUY
  798. if buyme<=0 then signal BUYSELL
  799. if buyme<5 then do
  800.   say ''cr;say ' 'pen3'Five Shares MINIMUM purchase 'def''cr;say ''cr;call delay(100)
  801.   end
  802. if buyme>sf.i then do
  803.   say ''cr;say ''pen3'' sf.i ''def'Shares 'pen6'MAXIMUM'def' Purchase 'cr;say ''cr
  804.   end
  805. if buyme<5 | buyme>sf.i then signal BUY
  806. price=buyme*cv.i;price=((price+(price*(smv20/100)))%1)*100/100
  807. if price>cr.cu then do
  808.   say ''cr;say ' 'pen3'You don''t have enough Cash!'def' 'cr;say ''cr;call delay(100)
  809.   end
  810. if price>cr.cu then signal BUY
  811. say ''cr;say ''spaces'Total shares will be :'pen6'' buyme''def''cr
  812. say ''spaces'Total cost will be   : 'pen7'$'price''def''cr
  813. say ''spaces''pen3'(including a 'smv20'% Broker''s Fee)'def''cr
  814. say ''cr;options prompt ''pen5'Execute purchase order (Y/n)?'def' > '
  815.  
  816.  
  817. pull result;choice=upper(result)
  818. if result='###PANIC' then SIGNAL GETOUT
  819. if choice='N' then signal BUY
  820. bought=0
  821. do j=1 to smv4
  822.   if cn.cu.j=i then do
  823.     bought=1;so.cu.j=so.cu.j+buyme;vi.i=vi.i+buyme;sf.i=sf.i-buyme;cr.cu=cr.cu-price
  824.     say ''cr;say ''pen3''buyme ''pen7'shares have been added to your portfolio'def''cr;say ''cr;call delay(100)
  825.     say ''pen7'Total purchase price was 'pen3'$'price' 'pen4'(including a 'smv20'% Broker''s fee)'def''cr;say ''cr;call delay(100)
  826.     say ''pen7'Your available cash is now 'pen3'$'cr.cu''def''cr;call delay(100)
  827.     end
  828.   end
  829. if bought=1 then signal BUYSELL
  830. do j=1 to smv4
  831.   if bought=0 & cn.cu.j=0 then do
  832.     bought=1;cn.cu.j=i;so.cu.j=buyme;vi.i=vi.i+buyme;sf.i=sf.i-buyme;cr.cu=cr.cu-price
  833.     say ''cr;say ''pen3''buyme ''pen7'shares have been added to your portfolio'def''cr;say ''cr;call delay(100)
  834.     say ''pen7'Total purchase price was 'pen3'$'price' 'pen4'(including a 'smv20'% Broker''s fee)'def''cr;say ''cr;call delay(100)
  835.     say ''pen5'Your available cash is now 'pen3'$'cr.cu''def''cr;call delay(100)
  836.     end
  837.   end
  838. if bought=1 then signal BUYSELL
  839. say ''cr;say ' 'pen2'You may own 'pen3''smv4' 'pen2'companies 'pen3'MAXIMUM! 'def''cr
  840. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  841.  
  842.  
  843. pull result
  844. if result='###PANIC' then SIGNAL GETOUT
  845. say ''cr;signal BUYSELL
  846.  
  847. SELL:
  848. nostock=0;time=time();date=date()
  849. say ''cr;say ''spaces'   'pen5'Your Investment Portfolio as of:'def''cr
  850. say ''spaces'        'pen5' 'time'' date''def''cr
  851. say ''cr;say ''spaces'   'pen3'Company              Shares    Net'def''cr
  852. say ''spaces' 'pen6'# Name                  Owned   Gain'def''cr
  853. say ''spaces''dashes''cr
  854. do j=1 to smv4
  855.   do i=1 to nc
  856.     if cn.cu.j~=i then nop
  857.     else do  
  858.       mi=right(i,2);mcn$.i=left(cn$.i,20);mso.cu.j=right(so.cu.j,6);mvs.i=trunc(vs.i+.005,2);mvs.i=right(mvs.i,6)
  859.       say ''spaces''pen7''mi'' mcn$.i'' mso.cu.j'' mvs.i''def''cr
  860.       end
  861.     end
  862.   end
  863. say ''spaces''dashes''cr;say ''cr;say ''spaces''pen7'Your available cash: 'pen3'$'cr.cu''def''cr
  864. say ''cr;say ''pen4'Enter the Number of the Company you wish to Sell'def''cr
  865.  
  866.  
  867. options prompt 'Tap ''X'' to Exit > '
  868. pull result;i=upper(result)
  869. if result='###PANIC' then SIGNAL GETOUT
  870. if i=0 then signal BUYSELL
  871. if i='X' then signal BUYSELL
  872. if i<1 | i>smv6 then signal SELL
  873. do j=1 to smv4
  874.   if cn.cu.j=i then do
  875.     nostock=1;sale=j
  876.     end
  877.   end
  878. if nostock=0 then do
  879.   say ''cr;say ' 'pen3'You don''t own'pen6'' cn$.i ''def''cr;call delay(100)
  880.   end
  881. if nostock=0 then signal SELL
  882. say ''cr;say ''spaces''pen2'Company Name    :'pen6'' cn$.i''def''cr
  883. say ''spaces''pen2'Price per Share : 'pen3'$'trunc(cv.i+.005,2)''def''cr
  884. say ''spaces''pen2'Shares Owned    :'pen5'' so.cu.sale''def''cr
  885. say ''cr;say ''pen4'Enter the number of SHARES to sell'def''cr
  886.  
  887. options prompt 'Enter ''A'' to sell all your Shares of 'cn$.i' > '
  888. pull result;sellme=upper(result)
  889. if result='###PANIC' then SIGNAL GETOUT
  890. if sellme='A' then sellme=so.cu.sale
  891. if sellme='' then signal BUY/SELL
  892. if ~datatype(sellme,'w') then signal SELL
  893. if sellme<1 then signal BUYSELL
  894. if sellme<5 then do
  895.   say ''cr
  896.   say ' 'pen3'Five Shares MINIMUM Transaction 'def''cr;say ''cr;call delay(100)
  897.   end
  898. if sellme>so.cu.sale then do
  899.   say ''cr;say ''pen3'' so.cu.sale ''def'Shares 'pen3'MAXIMUM 'def'Transaction 'cr;say ''cr;call delay(100)
  900.   end
  901. if sellme<5 | sellme>so.cu.sale then signal SELL
  902. sold=sellme*cv.i;sold=((sold-(sold*(smv20/100)))%1)*100/100
  903. say ''cr;say ''spaces''pen7'Number of Shares being sold :'pen3'' sellme''def''cr
  904. say ''spaces''pen7'Total sale will be : 'pen5'$'sold''def''cr
  905. say ''spaces''pen4'(including a 'smv20'% Broker''s Fee)'def''cr
  906. say ''cr;options prompt ''pen3'Execute sell order (Y/n)?'def' > '
  907.  
  908.  
  909. pull result;choice=upper(result)
  910. if result='###PANIC' then SIGNAL GETOUT
  911. if choice='N' then signal SELL
  912. vi.i=vi.i+sellme;sf.i=sf.i+sellme;cr.cu=cr.cu+sold;so.cu.sale=so.cu.sale-sellme
  913. if so.cu.sale<=0 then do
  914.   cn.cu.sale=0;so.cu.sale=0
  915.   end
  916. say ''cr
  917. say ''pen3'$'sold ''pen2'has been added to your cash holdings'def''cr;say ''cr;call delay(100)
  918. say ''pen2'You now have 'pen5'$'cr.cu' 'pen2'in cash'def''cr
  919. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  920.  
  921.  
  922. pull result
  923. if result='###PANIC' then SIGNAL GETOUT
  924. say ''cr;signal BUYSELL
  925.  
  926. HELP:
  927. say ''cr
  928. if ~exists(file8) then do
  929.   say ' 'pen3'Please ask SYSOP to install the Help File for Stock Market! 'def''cr;call delay(200)
  930.   end
  931. if exists(file8) then do
  932.   call open(hlp,file8)
  933.    do until eof(hlp)
  934.  
  935.   do
  936.    do for 18
  937.    helpln = readln(hlp)
  938.    say''pen7''helpln''def''cr
  939.    end
  940.   say ''cr
  941.   options prompt'Hit 'pen3'return to continue'def''
  942.   pull result
  943.   say ''cr
  944.   end
  945.  
  946.   end
  947. call close(hlp)
  948. say ''cr
  949.  
  950.  
  951. if result='###PANIC' then SIGNAL GETOUT
  952. say ''cr;signal MAIN
  953.  
  954. NEWS:
  955. call open(fn27,file6,'r')
  956.   call readfl (fn27)
  957. call close(fn27)
  958. say ''spaces''dashes''cr;say ''cr
  959. options prompt 'Tap 'pen3'Return'def' to continue.'
  960. pull result
  961.  
  962. say ''cr
  963. call open(fn28,file5,'r')
  964.   call readfl (fn28)
  965. call close(fn28)
  966. say ''spaces''dashes''cr;say ''cr
  967. options prompt 'Tap 'pen3'Return'def' to continue.'
  968. pull result
  969.  
  970. say ''cr;signal MAIN
  971.  
  972. RNDNOTICES:
  973. i=((randu(time('s'))*99)%1)+1
  974. if i<2 then signal IRSAUDIT
  975. if i<10 & cr.cu<300 then signal FURNITURE
  976. if i<15 then signal BURGLAR
  977. if i<40 then signal LUCKY
  978. if i<50 then signal INTERESTPAID
  979. if i<65 then signal ILLEGAL
  980. if i<80 then signal INSIDEINFO
  981. if i<95 then signal FEESDUE
  982. if i<98 then signal FOLD
  983. else signal RNDNOTICES
  984.  
  985. FURNITURE:
  986. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  987. x=((randu(time('s'))*1900)%1)+100;cr.cu=cr.cu-x
  988. say ''pen7'New office furniture arrives C.O.D.  The amount of 'pen3'$' x ''pen7'has been'def''cr
  989. say ''pen7'subtracted from your cash account.'def''cr
  990. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  991.  
  992.  
  993. pull result
  994. if result='###PANIC' then SIGNAL GETOUT
  995. say ''cr;signal MAIN
  996.  
  997. BURGLAR:
  998. if cr.cu<1 then signal RNDNOTICES
  999. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1000. cr.cu=0
  1001. say ''pen3'Your office was burglarized!  'pen2'All your cash was stolen.'def''cr
  1002. say ''pen5'The SHOP VAC BANDIT strikes again!'def''cr
  1003. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'cr
  1004.  
  1005.  
  1006. pull result
  1007. if result='###PANIC' then SIGNAL GETOUT
  1008. say ''cr;signal MAIN
  1009.  
  1010. LUCKY:
  1011. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1012. x=(((randu(time('s'))*10)+1)%1)*1000;cr.cu=cr.cu+x
  1013. say ''pen2'This is your lucky day!  On your way to'pen3'' bbsname''def''cr
  1014. say ''pen6'you find 'pen3'$' x ''pen6'in cash!'def''cr
  1015. say ''cr
  1016. options prompt 'Tap 'pen3'Return'def' to continue.'
  1017.  
  1018.  
  1019. pull result
  1020. if result='###PANIC' then SIGNAL GETOUT
  1021. say ''cr;signal MAIN
  1022.  
  1023. /*-------------------------------------------------------------------*/
  1024.  
  1025. readfl:
  1026.  
  1027. arg shfl
  1028.    do until eof(shfl)
  1029.  
  1030.  
  1031.    do for 6
  1032.    shln = readln(shfl)
  1033.    say''pen3''shln''def''cr
  1034.    if eof(shfl) then return
  1035.    shln = readln(shfl)
  1036.    say''pen5''shln''def''cr
  1037.    if eof(shfl) then return
  1038.    shln = readln(shfl)
  1039.    say''pen6''shln''def''cr
  1040.    if eof(shfl) then return
  1041.    end
  1042.   say ''cr
  1043.   options prompt'Hit 'pen3'return'def' to continue or 'pen6'Q'def' to quit >'
  1044.   pull result
  1045.   if result = 'Q' then return
  1046.   say ''cr
  1047.   end
  1048.  
  1049. return
  1050. INTERESTPAID:
  1051. if cr.cu<1 then signal RNDNOTICES
  1052. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1053. x=((cr.cu*.14)%1);cr.cu=cr.cu+x
  1054. say ''pen5'Interest has been paid on your cash.  'pen3'$' x ''pen5'has been added'def''cr
  1055. say ''pen5'to your cash available!'def''cr
  1056. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  1057.  
  1058.  
  1059. pull result
  1060. if result='###PANIC' then SIGNAL GETOUT
  1061. say ''cr;signal MAIN
  1062.  
  1063. ILLEGAL:
  1064. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1065. x=(((randu(time('s'))*10)+1)%1)*1000;cr.cu=cr.cu-x
  1066. say ''pen4'You''ve been caught 'pen3'red-handed!  'pen4'The Board Commission has discovered'def''cr
  1067. say ''pen4'illegal practices in your transactions.  You are fined 'pen3'$' x ''pen4'!'def''cr
  1068. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  1069.  
  1070.  
  1071. pull result
  1072. if result='###PANIC' then SIGNAL GETOUT
  1073. say ''cr;signal MAIN
  1074.  
  1075. IRSAUDIT:
  1076. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1077. lc.cu=jd-(smv19+1);time=time();date=date()
  1078. call open(fn29,file5,'A');call writeln(fn29,dashes);call writeln(fn29,time date);call writeln(fn29,alias.cu 'seat is sold due to');call writeln(fn29,'I.R.S audit!');call close(fn29)
  1079. say ''pen5'An I.R.S. audit has revealed that you owe back taxes in excess of'def''cr
  1080. say ''pen3'3.5 million dollars!  'pen4'Your seat on the Board has been 'pen3'SOLD 'pen4'in order to'def''cr
  1081. say ''pen4'satisfy your debts.'def''cr
  1082. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  1083. pull result
  1084. if result='###PANIC' then SIGNAL GETOUT
  1085. say ''cr
  1086. SIGNAL GETOUT
  1087.  
  1088. FOLD:
  1089. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1090. x=((randu(time('s'))*nc)%1)+1
  1091. if cv.x=0 then signal FOLD
  1092. time=time();date=date()
  1093. call open(fn30,file5,'A');call writeln(fn30,dashes);call writeln(fn30,time date);call writeln(fn30,cn$.x 'FOLDS!');call close(fn30)
  1094. cv.x=0;sf.x=0
  1095. do i=1 to np
  1096.   do j=1 to smv4
  1097.     if cn.i.j=x then do
  1098.       cn.i.j=0;so.i.j=0
  1099.     end
  1100.   end
  1101. say ''pen3''cn$.x ''pen6'has folded due to bad business practices!'def''cr
  1102. say ''cr
  1103. options prompt 'Tap 'pen3'Return'def' to continue.'
  1104. pull result
  1105. if result='###PANIC' then SIGNAL GETOUT
  1106. say ''cr;signal MAIN
  1107.  
  1108. INSIDEINFO:
  1109. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1110. x=(((randu(time('s'))*30)%1)+5)*100;cr.cu=cr.cu+x
  1111. say ''pen2'Inside information pays off!  Receive 'pen3'$' x ''pen2'in windfall profits.'def''cr
  1112. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  1113. pull result
  1114. if result='###PANIC' then SIGNAL GETOUT
  1115. say ''cr;signal MAIN
  1116.  
  1117. FEESDUE:
  1118. say ''cr;say ''pen3'FLASH Notice!'def''cr;say ''cr
  1119. cr.cu=cr.cu-2500
  1120. say ''pen7'Board membership fees are due.  'pen3'$2500 'pen7'has been deducted from'def''cr
  1121. say ''pen7'your cash account.'def''cr
  1122. say ''cr;options prompt 'Tap 'pen3'Return'def' to continue.'
  1123.  
  1124.  
  1125. pull result
  1126. if result='###PANIC' then SIGNAL GETOUT
  1127. say ''cr;signal MAIN
  1128.  
  1129. RESETPLAYERS:
  1130. say ''cr;say ''pen3'Resetting PLAYERS file...'def''cr
  1131. address command 'c:delete 'file1' quiet'
  1132. call open(fn34,file1,'W');call writeln(fn34,smv7 smv8 smv9);call writeln(fn34,date);call writeln(fn34,name);call writeln(fn34,smv10);call close(fn34)
  1133. say ''pen6'Resetting PLAYERSTATS file...'def''cr
  1134. address command 'c:delete 'file2' quiet'
  1135. call open(fn35,file2,'W');call writeln(fn35,smv5);call writeln(fn35,name.cu);call writeln(fn35,alias.cu);call writeln(fn35,smv3)
  1136. do j=1 to smv4
  1137.   call writeln(fn35,'0' '0')
  1138.   end
  1139. call close(fn35)
  1140. return
  1141.  
  1142. RESETCOMPANIES:
  1143. say ''pen4'Resetting COMPANYSTATS file...'def''cr
  1144. do i=1 to smv6
  1145.   cv.i=aa.i;vi.i=smv11;vs.i=smv12;sf.i=smv13
  1146.   rv.i=random(1,100,time('s'))-50
  1147.   end
  1148. address command 'c:delete 'file3' quiet'
  1149. call open(fn36,file3,'W');call writeln(fn36,smv6)
  1150. do i=1 to smv6
  1151.   cv.i=trunc(cv.i+.005,2);vs.i=trunc(vs.i+.005,2);aa.i=trunc(aa.i+.005,2);call writeln(fn36,cn$.i);call writeln(fn36,cv.i vi.i vs.i sf.i tq.i rv.i aa.i)
  1152.   end
  1153. call close(fn36)
  1154. return
  1155.  
  1156. RESETNEWS:
  1157. say ''pen3'Resetting NEWS1 and NEWS2 files...'def''cr
  1158. address command 'c:delete 'file5' quiet';address command 'c:delete 'file6' quiet'
  1159. return
  1160.  
  1161. SYSOPMENU:
  1162. if name ~= sysopname then return
  1163. say ''cr;say ''spaces'Stock Market Sysop Functions'cr;say ''cr
  1164. say ''spaces'[1]  Change Company Stats'cr
  1165. say ''spaces'[2]  Delete Player'cr
  1166. say ''spaces'[3]  View Stock Market Files'cr
  1167. say ''spaces'[4]  Reset Game'cr
  1168. say ''spaces'[X]  Exit to Stock Market'cr
  1169. say ''cr;options prompt 'Your choice,' name '> '
  1170.  
  1171.  
  1172. pull result;mci=upper(result)
  1173. if result='###PANIC' then SIGNAL GETOUT
  1174. if mci='X' then signal MAIN
  1175. if mci<1 | mci>4 then signal SYSOPMENU
  1176. if mci=1 then signal CHANGECOMPANY
  1177. if mci=2 then signal DELETEPLAYER
  1178. if mci=3 then signal VIEWFILES
  1179. if mci=4 then signal RESETGAME
  1180. return
  1181.  
  1182. CHANGECOMPANY:
  1183. say ''cr;say ''spaces'Change Company Stats'cr;say ''cr
  1184. do i=1 to nc
  1185.   if i<10 then say ''spaces'['i']' cn$.i''cr
  1186.   else say ''spaces'['i']' cn$.i''cr
  1187.   end
  1188. say ''spaces'[X]  Exit to Sysop Menu'cr;say ''cr
  1189.  
  1190.  
  1191. options prompt ''pen2'Enter the Number of the Company you wish to check'def' > '
  1192. pull result;i=upper(result)
  1193. if result='###PANIC' then SIGNAL GETOUT
  1194. if i='X' then signal SYSOPMENU
  1195. if i<1 | i>nc then signal CHANGECOMPANY
  1196. say ''cr;say ''spaces''center('Company Stats for :',40)''cr
  1197. say ''spaces''center(cn$.i,40)''cr
  1198. say ''cr;say ''spaces'[1]  Company Name   : 'cn$.i''cr
  1199. say ''spaces'[2]  Current Price  :' cv.i''cr
  1200. say ''spaces'[3]  Initial Price  :' aa.i''cr
  1201. say ''spaces'[4]  Shares Free    :' sf.i''cr
  1202. say ''spaces'[5]  Trend Value    :' tq.i''cr
  1203. say ''spaces'[6]  Risk Value     :' rv.i''cr
  1204. say ''spaces'[X]  Exit to Sysop Menu'cr
  1205. say ''cr;options prompt 'Enter companystat you wish to change > '
  1206.  
  1207.  
  1208. pull result;di=upper(result)
  1209. if result='###PANIC' then SIGNAL GETOUT
  1210. if di='X' then signal SYSOPMENU
  1211. if di<1 | di>6 then signal CHANGECOMPANY
  1212. if di=1 then do
  1213.   say 'Enter new Company Name.  Maximum length 20 characters.'cr
  1214.   say ' >--------------------<'cr
  1215.  
  1216.  
  1217.   options prompt ' > ';pull result;newcn$=result
  1218.   if result='###PANIC' then SIGNAL GETOUT
  1219.   cn$.i=newcn$
  1220.   end
  1221. if di=2 then do
  1222.  
  1223.  
  1224.   options prompt 'Enter new Current Price > '
  1225.   pull result;cv.i=result
  1226.   if result='###PANIC' then SIGNAL GETOUT
  1227.   end
  1228. if di=3 then do
  1229.  
  1230.   options prompt 'Enter new Initial Price > '
  1231.   pull result;aa.i=result
  1232.   if result='###PANIC' then SIGNAL GETOUT
  1233.   end
  1234. if di=4 then do
  1235.  
  1236.  
  1237.   options prompt 'Enter the new number of Shares Free > '
  1238.   pull result;sf.i=result
  1239.   if result='###PANIC' then SIGNAL GETOUT
  1240.   end
  1241. if di=5 then do
  1242.  
  1243.  
  1244.   options prompt 'Enter the new Trend Value > '
  1245.   pull result;tq.i=result
  1246.   if result='###PANIC' then SIGNAL GETOUT
  1247.   end
  1248. if di=6 then do
  1249.  
  1250.  
  1251.   options prompt 'Enter new Risk Value > '
  1252.   pull result;rv.i=result
  1253.   if result='###PANIC' then SIGNAL GETOUT
  1254.   end
  1255. signal SYSOPMENU
  1256.  
  1257. DELETEPLAYER:
  1258. say ''cr;say ''spaces'Delete a Player'cr;say ''cr
  1259. do n=1 to np
  1260.   if n<10 then say ''spaces' ['n']  'alias.n''cr
  1261.   else say ''spaces'['n']  'alias.n''cr
  1262.   end
  1263. say ''spaces' [X]  Exit to Sysop Menu'cr;say ''cr
  1264.  
  1265.  
  1266. options prompt 'Enter the number of the player you wish to delete > '
  1267. pull result;delplyr=upper(result)
  1268. if result='###PANIC' then SIGNAL GETOUT
  1269. if delplyr='X' then signal SYSOPMENU
  1270. if delplyr<1 | delplyr>n then signal DELETEPLAYER
  1271. say ''cr;say ''alias.delplyr' will be deleted'cr
  1272. say ''cr;options prompt 'Are you sure (Y/n)? > '
  1273.  
  1274.  
  1275. pull result;choice=upper(result)
  1276. if result='###PANIC' then SIGNAL GETOUT
  1277. if choice='N' then signal DELETEPLAYER
  1278. n=delplyr 
  1279. do j=1 to smv7
  1280.   if cn.n.j=0 then nop
  1281.   else do
  1282.     sf.cn.n.j=sf.cn.n.j+so.n.j;so.n.j=0;cn.n.j.=0
  1283.     end
  1284.   end
  1285. cr.n=0
  1286. say ''pen3'Player files will be updated when you exit the Stock Market.'def''cr
  1287. signal SYSOPMENU
  1288.  
  1289. VIEWFILES:
  1290. say '';say spaces'View Stock Market Files';say ''
  1291. say ''spaces'[1]  'file1''cr
  1292. say ''spaces'[2]  'file2''cr
  1293. say ''spaces'[3]  'file3''cr
  1294. say ''spaces'[4]  'file9''cr
  1295. say ''spaces'[X]  Exit to Sysop Menu'cr
  1296. say ''cr;options prompt 'Enter the number of the file to view > '
  1297.  
  1298.  
  1299. pull result;vfile=upper(result)
  1300. if result='###PANIC' then SIGNAL GETOUT
  1301. if vfile='X' then signal SYSOPMENU
  1302. if vfile=1 then do
  1303.    call open(vf1,file1,'R')
  1304.    call readfl (vf1)
  1305.    call close (vf1)
  1306.    end
  1307. if vfile=2 then do
  1308.    call open(vf2,file2,'R')
  1309.    call readfl (vf2)
  1310.    call close (vf2)
  1311.    end
  1312. if vfile=3 then do
  1313.    call open(vf3,file3,'R')
  1314.    call readfl (vf3)
  1315.    call close (vf3)
  1316.    end
  1317. if vfile=4 then do
  1318.    call open(vf4,file9,'R')
  1319.    call readfl (vf4)
  1320.    call close (vf4)
  1321.    end
  1322. if vfile<1 | vfile>4 then signal VIEWFILES
  1323. say ''cr
  1324. options prompt 'Tap 'pen3'Return'def' to continue.'
  1325.  
  1326.  
  1327. pull result
  1328. if result='###PANIC' then SIGNAL GETOUT
  1329. say ''cr;signal VIEWFILES
  1330.  
  1331. RESETGAME:
  1332. time=time();date=date()
  1333. say ''cr;say ''spaces'Reset Game'spaces''cr;say ''cr
  1334. say 'A reset will delete all players and reset all companies to default'cr
  1335. say 'number of shares free.'cr
  1336. say ''cr;options prompt 'Are you sure (Y/n)? > '
  1337.  
  1338.  
  1339. pull result;choice=upper(result)
  1340. if result='###PANIC' then SIGNAL GETOUT
  1341. if choice='N' then signal SYSOPMENU
  1342. call RESETPLAYERS;call RESETCOMPANIES;call RESETNEWS
  1343. EXIT
  1344. signal SYSOPMENU
  1345.  
  1346. ONELINER:
  1347. say ''cr
  1348. options prompt ''pen6'Leave a one line tip for the next Investor (y/N)?'def' > '
  1349.  
  1350.  
  1351. pull result;ans=upper(result)
  1352. if result='###PANIC' then signal BYE
  1353. if ans~='Y' then do
  1354.   say ''pen3'No'def''cr
  1355.   return
  1356.   end
  1357. say ''pen7'Yes'def''cr;say ''cr
  1358. options prompt''pen2'Enter a ONE LINE tip:'def' ';say ''cr
  1359.  
  1360. pull result; mess=result
  1361. if result='###PANIC' then signal BYE
  1362. if length(mess)<10 then do
  1363.   say ''pen3'Message too short, Entry Aborted.'def''cr;signal ONELINER
  1364.   end
  1365. say ''cr;say ''longdashes''cr;say ''pen5''mess ''alias.cu''def''cr;say ''longdashes''cr;say ''cr
  1366. options prompt ''pen4'Does this look OK?'def' > '
  1367.  
  1368.  
  1369. pull result;ans=upper(result)
  1370. if result='###PANIC' then signal BYE
  1371. if ans='N' then do
  1372.   say 'Nope!'cr;signal ONELINER
  1373.   end
  1374. say ''pen5'Yep!'def''cr
  1375. address command 'c:delete 'file7' quiet'
  1376. call open(fnx,file7,'W');call writeln(fnx,mess);call writeln(fnx,alias.cu);call close(fnx)
  1377. return
  1378.  
  1379. ALIAS:
  1380. say ''cr
  1381. options prompt ''pen6'Do you wish to use an 'pen3'ALIAS 'pen6'(Y/n)? >'def' '
  1382.  
  1383.  
  1384. pull result
  1385. choice=upper(result)
  1386. if result='###PANIC' then SIGNAL GETOUT
  1387. if choice='N' then do
  1388.   say ''pen3'No'def''cr;alias=name;say ''cr;say ''pen6'You shall be known as'pen3'' alias''def''cr;return
  1389.   end
  1390. say ''pen5'Yes'def''cr
  1391. say ''cr
  1392. options prompt''pen2'Enter your 'pen3'ALIAS 'pen5'(Max 20 chars):'def' '
  1393. pull result
  1394. say ''cr
  1395.  
  1396. alias=upper(result)
  1397. if result='###PANIC' then SIGNAL GETOUT
  1398. if length(alias)<1 then do
  1399.   say ''pen3'Alias too short, Entry Aborted.'def''cr
  1400.   signal ALIAS
  1401.   end
  1402. do n=1 to np
  1403.   if alias=alias.n then do
  1404.     say''cr;say ''pen4'Sorry, that ALIAS is already in use!'def''cr;signal ALIAS
  1405.     end
  1406.   end
  1407. say ''cr
  1408. say ''pen3''alias''def''cr
  1409. say ''cr
  1410. options prompt ''pen2'Does this look OK (Y/n)?'def' > '
  1411.  
  1412. pull result;ans=upper(result)
  1413. if result='###PANIC' then SIGNAL GETOUT
  1414. if ans='N' then do
  1415.   say ''pen3'Nope!'def''cr
  1416.   signal ALIAS
  1417.   end
  1418. say ''pen6'Yep!'def''cr
  1419. return
  1420.  
  1421. GAMEWON:
  1422. say ''cr
  1423. call ONELINER
  1424. say ''cr
  1425. say ''spaces''pen5'Thank you for playing Stock Market'def''spaces''cr
  1426. say ''cr;call delay(100)
  1427. say ''pen6'Returning to'pen3'' bbsname''def''cr;call delay(100)
  1428.  
  1429. BYE:
  1430. exit
  1431.  
  1432. SYNTAX:
  1433. code=rc
  1434. say'OOPS! Please tell SYSOP that the Stock Market Crashed!'cr
  1435.   SAY 'Line:' SIGL '   Error Code:' RC
  1436.  
  1437.  
  1438.  
  1439.  if ~exists(''bbspath'SM.errlog') then do
  1440.      call open(err,''bbspath'SM.errlog','W')
  1441.      end
  1442.  else call open(err,''bbspath'SM.errlog','A')
  1443. call writeln(err,date() time())
  1444. call writeln(err,name' - Stock Market')
  1445. call writeln(err,'Line - 'sigl' Code - 'code)
  1446. call writeln(err,errortext(code))
  1447. call writeln(err,'')
  1448. call close(err)
  1449.  
  1450. BREAK_C:
  1451. BREAK_E:
  1452. norxit = 0 /* Normal exit, = 0 if ctrl c is hit */
  1453. SIGNAL GETOUT
  1454. exit
  1455.  
  1456. checkBBS:
  1457. IF ADDRESS()~='BAUD' THEN RETURN 0
  1458. IF TIME('E')>secs THEN SIGNAL GETOUT
  1459. dcd
  1460. IF RC=0 THEN EXIT
  1461. temp=secs-TIME('E')
  1462. IF temp<120 THEN SAY '*** Only' temp 'seconds left! ***'CR 
  1463. RETURN 0
  1464.  
  1465. /**************************************
  1466.  *     call The PUB (817)690-3387     *
  1467.  **************************************
  1468.  
  1469.  *****************************************
  1470.  * call The Alternative BBS 503-761-3043 *
  1471.  *****************************************/