home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / amigalibdisks / disk950 / bbdoors / bbdoors65.lha / rexxDoors / Yacht_C.rexx < prev    next >
OS/2 REXX Batch file  |  1993-08-07  |  32KB  |  1,254 lines
  1. /* Yacht-C.rexx version 1.1 by Matt English 8-4-93
  2.  
  3.    This game was written to work on Richard Stockton's
  4.    BBBBS program. You are welcome to use this on your
  5.    BBBBS system as long as my name is not removed from
  6.    this code, or the game screen.
  7.  
  8.    CONVERSIONS : !!!!!!!!
  9.    You are given permission to convert this game to ANY
  10.    other BBS system, Amiga or IBM, as long as:
  11.  
  12.    1. You leave my name in the code and on the game screen.
  13.    2. You have never written a game that says "ONLY TO BE
  14.       USED ON xxxxx BBS SYSTEM". ( I really, really hate that!)
  15.  
  16.    TO ALL SYSOPS:
  17.     If you use this game, a call to my BBS would be nice!
  18.     (If you've never called.) I have more ideas for the game,
  19.     and if I get enough interest there will be a "next version".
  20.  
  21.     The Alternative BBS (503) 761-3043
  22.  
  23.  
  24.     TO INSTALL ON BBBBS:
  25.      All ya have to do is copy the file "Yacht_C.rexx"
  26.      to your RexxDoors directory. The game will create
  27.      some data files after its played. Easy, Huh?
  28.  
  29.     Enjoy.
  30.  */
  31.  
  32. options results
  33. FF='0C'x  /* FormFeed */
  34. CR='0D'x  /* Carraige Return */
  35. CALL TIME('R')
  36. SIGNAL ON BREAK_C
  37. SIGNAL ON BREAK_E
  38.  
  39. bbspath=GETCLIP('BBS_path')
  40. bbspath=bbspath'rexxDoors/Data/'
  41. datapath = bbspath'Yacht_C'
  42.  
  43. /* Open the support library if it is not already open. */
  44. if ~show('L',"rexxsupport.library") then do
  45.     addlib('rexxsupport.library',0,-30,0)
  46.      end
  47.  
  48. wz = random(1,999,time('S')) /* initalize random number generator */
  49.  
  50. PARSE arg name winnings . colorflag secs .
  51. IF secs='' THEN secs=3600
  52. signal on syntax
  53. player = left(name,20)
  54.  
  55. address command'C:resident C:sort add'
  56.  
  57. def=''
  58. CLS = 'H'
  59. UNL = ''
  60.  
  61. call Prefs(1)
  62. IF ADDRESS()~='BAUD' THEN call Prefs(5)
  63.  
  64. player = pen.6||unl||player||def
  65.  
  66.  
  67. /* Positions */
  68.  pplayer='H';ps.1='8H';ps.2='8H';ps.3='8H';ps.4='8H';ps.5='8H'
  69.  ps.6='8H';psub='8H';pbon='28H';putot='28H';ps.3k='28H'
  70.  ps.4k='28H';ps.fh='28H';ps.ss='28H';ps.ls='28H'
  71.  ps.c='28H';ps.y='28H';pltot='28H';putot2='28H';ptot='28H'
  72.  
  73.  pln.1='H';pln.2='H';pln.3='H';pln.4='H';pln.5='H';pln.6='H';pln.3k='1H'
  74.  pln.4k='1H';pln.fh='1H';pln.ss='1H';pln.ls='1H'
  75.  pln.c='1H';pln.y='1H'
  76.  
  77.  phold.1='5H';phold.2='1H';phold.3='7H';phold.4='3H';phold.5='9H'
  78.  prollsleft='38H'
  79.  pprompt='34H'
  80.  pprompt1='34H'
  81.  pprompt2='34H'
  82.  
  83.  pd.1.1='5H';pd.1.2='6H';pd.1.3='7H';pd.1.4='5H';pd.1.5='6H';pd.1.6='7H';pd.1.7='5H';pd.1.8='6H';pd.1.9='7H'
  84.  pd.2.1='1H';pd.2.2='2H';pd.2.3='3H';pd.2.4='1H';pd.2.5='2H';pd.2.6='3H';pd.2.7='1H';pd.2.8='2H';pd.2.9='3H'
  85.  pd.3.1='7H';pd.3.2='8H';pd.3.3='9H';pd.3.4='7H';pd.3.5='8H';pd.3.6='9H';pd.3.7='7H';pd.3.8='8H';pd.3.9='9H'
  86.  pd.4.1='3H';pd.4.2='4H';pd.4.3='5H';pd.4.4='3H';pd.4.5='4H';pd.4.6='5H';pd.4.7='3H';pd.4.8='4H';pd.4.9='5H'
  87.  pd.5.1='9H';pd.5.2='0H';pd.5.3='1H';pd.5.4='9H';pd.5.5='0H';pd.5.6='1H';pd.5.7='9H';pd.5.8='0H';pd.5.9='1H'
  88.  
  89.  poptln='34H'
  90.  
  91.  optstr = 'H Q P SC 1 2 3 4 5 6 3K 4K FH SS LS C Y'
  92.  sstr = '1 2 3 4 5 6 3K 4K FH SS LS C Y' /* Scoreable string */
  93.  
  94. call setlines
  95.  
  96. if ~exists(datapath) then do
  97.  call makedir(datapath)
  98.  tempname = name
  99.  name = 'MATT_ENGLISH'    /* Has to be one file to match Scorelist */
  100.  call zerovar
  101.  call savedata
  102.  name = tempname
  103.  end
  104. if exists(datapath'/'name) then call loaddata
  105. else do
  106.  call zerovar
  107.  say''CLS''cr
  108.  say cr
  109.  say cr
  110.  say' A NEW PLAYER !!! 'cr
  111.  say' Welcome to Yacht_C !!!'cr
  112.  call delay(100)
  113.  newplayer = 1 /* first time player */
  114.  end
  115.  
  116. call refresh1
  117. call refresh2
  118. call setlines
  119.  
  120. /*
  121. Loop:
  122.  do forever
  123.   spotsleft = spotsleft - 1
  124.   if spotsleft = 0 then call done
  125.   call getopt
  126.   end  */
  127.  
  128. call getopt
  129.  
  130. zerovar:                           /* Variable values at startup */
  131.  s.1 = '' /* Score for the 1's */
  132.  s.2 = '';s.3='';s.4='';s.5='';s.6=''
  133.  sub='0';bon='0';utot='0';utot2='0'
  134.  s.3k='';s.4k='';s.fh='';s.ss='';s.ls='';s.c='';s.y='';ltot='0';tot='0'
  135.  hold.1='    ';hold.2='    ';hold.3='    ';hold.4='    ';hold.5='    '
  136.  rollsleft='3'
  137.  spotsleft = 13
  138.  dvalue.1 = 1;dvalue.2=2;dvalue.3=3;dvalue.4=4;dvalue.5=5
  139.  do t = 1 to 6
  140.   x.t = random(1,10)
  141.   end
  142.  dcstring = x.1' d1 'x.2' d2 'x.3' d3 'x.4' d4 'x.5' d5 'x.6' d6'
  143.  rvalue = 0
  144.  newplayer = 0
  145. return
  146.  
  147.  
  148. setlines:
  149.  low = bak.0||pen.1
  150.  hi = bak.2||pen.1
  151.  ln.1=''pen.1' [ 1] ones      (add 1''s)'def''
  152.  ln.2=''pen.1' [ 2] twos      (add 2''s)'def''
  153.  ln.3=''pen.1' [ 3] threes    (add 3''s)'def''
  154.  ln.4=''pen.1' [ 4] fours     (add 4''s)'def''
  155.  ln.5=''pen.1' [ 5] fives     (add 5''s)'def''
  156.  ln.6=''pen.1' [ 6] 'unl'sixes     (add 6''s)'def''
  157.  ln.3k=''pen.1' [3K] 3 of a kind (total)'def''
  158.  ln.4k=''pen.1' [4K] 4 of a kind (total)'def''
  159.  ln.fh=''pen.1' [FH] Full House     (25)'def''
  160.  ln.ss=''pen.1' [SS] Small Straight (30)'def''
  161.  ln.ls=''pen.1' [LS] Large Straight (40)'def''
  162.  ln.c=''pen.1' [ C] Chance      (total)'def''
  163.  if s.y = '' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |   'def''
  164.  if s.y = '50' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' 50'def''
  165.  if s.y = ' --' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' --'def''
  166. return
  167.  
  168. Loaddata:
  169.  call open(data,datapath'/'name,'R')
  170.  lastplay = readln(data)
  171.  colorset = readln(data)
  172.  if colorset = '' then
  173.    DO
  174.      IF ADDRESS()='BAUD' THEN colorset=1
  175.      ELSE colorset=5
  176.    END
  177.  call prefs(colorset)
  178.  say''CLS''cr
  179.  say cr
  180.  say cr
  181.  say' Welcome back to Yacht_C!!'cr
  182.  say' You last played this game on 'lastplay''cr
  183.  say cr
  184.  call delay(100)
  185.  options prompt''pen.4' Would you like to continue your last game? (Y,n) > '
  186.  pull continue
  187.  if continue = 'N' then do
  188.   call close(data)
  189.   call zerovar
  190.   return
  191.   end
  192.  call zerovar
  193.  say cr
  194.  say' Loading data, stand by ...'cr
  195.  again = 1
  196.  rollsleft = readln(data)
  197.  spotsleft = readln(data)
  198.  if spotsleft = 0 then do
  199.   call zerovar
  200.   call close(data)
  201.   return
  202.   end
  203.  do i = 1 to words(sstr)
  204.   j = word(sstr,i)
  205.   s.j = readln(data)
  206.   end
  207.  sub = readln(data)
  208.  bon = readln(data)
  209.  utot = Readln(data)
  210.  utot2 = readln(data)
  211.  ltot = Readln(data)
  212.  tot = readln(data)
  213.  do i = 1 to 5
  214.   dvalue.i = readln(data)
  215.   end
  216.  call close(data)
  217.  call refresh1
  218.  call refresh2
  219.  call setlines
  220.  call showdice
  221.  call getopt
  222.  
  223. savedata:
  224.  if exists(datapath'/'name) then call delete(datapath'/'name)
  225.  call open(data,datapath'/'name,'W')
  226.  thedate = date()
  227.  call writeln(data,thedate)
  228.  if colorset = '' then colorset = 1
  229.  call writeln(data,colorset)
  230.  call writeln(data,rollsleft)
  231.  call writeln(data,spotsleft)
  232.  do i = 1 to words(sstr)
  233.   j = word(sstr,i)
  234.   call writeln(data,s.j)
  235.   end
  236.  call writeln(data,sub)
  237.  call writeln(data,bon)
  238.  call writeln(data,utot)
  239.  call writeln(data,utot2)
  240.  call writeln(data,ltot)
  241.  call writeln(data,tot)
  242.  do i = 1 to 5
  243.   call writeln(data,dvalue.i)
  244.   end
  245.  call close(data)
  246. return
  247.  
  248. clrl:
  249.  arg what
  250.  if what = 0 then where = pprompt
  251.  if what = 1 then where = pprompt1
  252.  if what = 2 then where = poptln
  253.  if what = 3 then where = pprompt2
  254.  if what = 2 then color = bak.6
  255.  else color = def
  256.  say''where''color'                              'def'  '
  257. return
  258.  
  259. getopt:
  260.  if spotsleft = 0 then call done
  261.  call setopt
  262.  say''prollsleft''rollsleft''
  263.  call clrl(0)
  264.  call clrl(1)
  265.  do s = 1 to 5
  266.   hold.s = '    '
  267.   say''phold.s''hold.s''
  268.   end
  269.  if rollsleft = 3 then line = 'Hit 'pen.3'Return'def' 'pen.1'to Roll the dice'def' > '
  270.  if rollsleft = 2 | rollsleft = 1 then line = '   'pen.1'Enter the Option to take or 'def''
  271.  if rollsleft = 0 then line = ''pen.1'Enter your Option'def' > '
  272.  if rollsleft = 2 | rollsleft = 1 then do
  273.   say''pprompt''line''
  274.   options prompt''pprompt1'       'pen.3'Return'def' 'pen.1'to Roll 'def'> '
  275.   end
  276.  else options prompt''pprompt''line''
  277.  pull opt
  278.  opt = upper(strip(opt))
  279.  if rollsleft = 3 then do
  280.   select
  281.    when opt = H then call help
  282.    when opt = Q then call quit(1)
  283.    when opt = SC then call checkopt
  284.    when opt = P then do
  285.     call setPrefs
  286.     call getopt
  287.     end
  288.    otherwise ca