/* Yacht-C.rexx version 1.1 by Matt English 8-4-93

   This game was written to work on Richard Stockton's
   BBBBS program. You are welcome to use this on your
   BBBBS system as long as my name is not removed from
   this code, or the game screen.

   CONVERSIONS : !!!!!!!!
   You are given permission to convert this game to ANY
   other BBS system, Amiga or IBM, as long as:

   1. You leave my name in the code and on the game screen.
   2. You have never written a game that says "ONLY TO BE
      USED ON xxxxx BBS SYSTEM". ( I really, really hate that!)

   TO ALL SYSOPS:
    If you use this game, a call to my BBS would be nice!
    (If you've never called.) I have more ideas for the game,
    and if I get enough interest there will be a "next version".

    The Alternative BBS (503) 761-3043


    TO INSTALL ON BBBBS:
     All ya have to do is copy the file "Yacht_C.rexx"
     to your RexxDoors directory. The game will create
     some data files after its played. Easy, Huh?

    Enjoy.
 */

options results
FF='0C'x  /* FormFeed */
CR='0D'x  /* Carraige Return */
CALL TIME('R')
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

bbspath='wwbbs:'
bbspath=bbspath'rexxDoors/Data/'
datapath = bbspath'Yacht_C'

/* Open the support library if it is not already open. */
if ~show('L',"rexxsupport.library") then do
    addlib('rexxsupport.library',0,-30,0)
     end

wz = random(1,999,time('S')) /* initalize random number generator */

PARSE arg name winnings . colorflag secs .

BBSIDENTIFY EMULATION
PARSE VAR RESULT type .
if type = "ANSI" then
  colorflag=1
else
  colorflag=0

BBSIDENTIFY USER
PARSE VAR RESULT Username From Acces .
name = substr(Username,2,length(Username)-2)

IF secs='' THEN secs=3600
signal on syntax
player = left(name,20)

address command'C:resident C:sort add'

def=''
CLS = ''
UNL = ''

call Prefs(1)
IF ADDRESS()~='BAUD' THEN call Prefs(5)

player = pen.6||unl||player||def


/* Positions */
 pplayer='';ps.1='';ps.2='';ps.3='';ps.4='';ps.5=''
 ps.6='';psub='';pbon='';putot='';ps.3k=''
 ps.4k='';ps.fh='';ps.ss='';ps.ls=''
 ps.c='';ps.y='';pltot='';putot2='';ptot=''

 pln.1='';pln.2='';pln.3='';pln.4='';pln.5='';pln.6='';pln.3k=''
 pln.4k='';pln.fh='';pln.ss='';pln.ls=''
 pln.c='';pln.y=''

 phold.1='';phold.2='';phold.3='';phold.4='';phold.5=''
 prollsleft=''
 pprompt=''
 pprompt1=''
 pprompt2=''

 pd.1.1='';pd.1.2='';pd.1.3='';pd.1.4='';pd.1.5='';pd.1.6='';pd.1.7='';pd.1.8='';pd.1.9=''
 pd.2.1='';pd.2.2='';pd.2.3='';pd.2.4='';pd.2.5='';pd.2.6='';pd.2.7='';pd.2.8='';pd.2.9=''
 pd.3.1='';pd.3.2='';pd.3.3='';pd.3.4='';pd.3.5='';pd.3.6='';pd.3.7='';pd.3.8='';pd.3.9=''
 pd.4.1='';pd.4.2='';pd.4.3='';pd.4.4='';pd.4.5='';pd.4.6='';pd.4.7='';pd.4.8='';pd.4.9=''
 pd.5.1='';pd.5.2='';pd.5.3='';pd.5.4='';pd.5.5='';pd.5.6='';pd.5.7='';pd.5.8='';pd.5.9=''

 poptln=''

 optstr = 'H Q P SC 1 2 3 4 5 6 3K 4K FH SS LS C Y'
 sstr = '1 2 3 4 5 6 3K 4K FH SS LS C Y' /* Scoreable string */

call setlines

if ~exists(datapath) then do
 call makedir(datapath)
 tempname = name
 name = 'MATT_ENGLISH'    /* Has to be one file to match Scorelist */
 call zerovar
 call savedata
 name = tempname
 end
if exists(datapath'/'name) then call loaddata
else do
 call zerovar
 say''CLS''cr
 say cr
 say cr
 say' A NEW PLAYER !!! 'cr
 say' Welcome to Yacht_C !!!'cr
 call delay(100)
 newplayer = 1 /* first time player */
 end

call refresh1
call refresh2
call setlines

/*
Loop:
 do forever
  spotsleft = spotsleft - 1
  if spotsleft = 0 then call done
  call getopt
  end  */

call getopt

zerovar:                           /* Variable values at startup */
 s.1 = '' /* Score for the 1's */
 s.2 = '';s.3='';s.4='';s.5='';s.6=''
 sub='0';bon='0';utot='0';utot2='0'
 s.3k='';s.4k='';s.fh='';s.ss='';s.ls='';s.c='';s.y='';ltot='0';tot='0'
 hold.1='    ';hold.2='    ';hold.3='    ';hold.4='    ';hold.5='    '
 rollsleft='3'
 spotsleft = 13
 dvalue.1 = 1;dvalue.2=2;dvalue.3=3;dvalue.4=4;dvalue.5=5
 do t = 1 to 6
  x.t = random(1,10)
  end
 dcstring = x.1' d1 'x.2' d2 'x.3' d3 'x.4' d4 'x.5' d5 'x.6' d6'
 rvalue = 0
 newplayer = 0
return


setlines:
 low = bak.0||pen.1
 hi = bak.2||pen.1
 ln.1=''pen.1' [ 1] ones      (add 1''s)'def''
 ln.2=''pen.1' [ 2] twos      (add 2''s)'def''
 ln.3=''pen.1' [ 3] threes    (add 3''s)'def''
 ln.4=''pen.1' [ 4] fours     (add 4''s)'def''
 ln.5=''pen.1' [ 5] fives     (add 5''s)'def''
 ln.6=''pen.1' [ 6] 'unl'sixes     (add 6''s)'def''
 ln.3k=''pen.1' [3K] 3 of a kind (total)'def''
 ln.4k=''pen.1' [4K] 4 of a kind (total)'def''
 ln.fh=''pen.1' [FH] Full House     (25)'def''
 ln.ss=''pen.1' [SS] Small Straight (30)'def''
 ln.ls=''pen.1' [LS] Large Straight (40)'def''
 ln.c=''pen.1' [ C] Chance      (total)'def''
 if s.y = '' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |   'def''
 if s.y = '50' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' 50'def''
 if s.y = ' --' then ln.y=''pen.1' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' --'def''
return

Loaddata:
 call open(data,datapath'/'name,'R')
 lastplay = readln(data)
 colorset = readln(data)
 if colorset = '' then
   DO
     IF ADDRESS()='BAUD' THEN colorset=1
     ELSE colorset=5
   END
 call prefs(colorset)
 say''CLS''cr
 say cr
 say cr
 say' Welcome back to Yacht_C!!'cr
 say' You last played this game on 'lastplay''cr
 say cr
 call delay(100)
 prompt(''pen.4' Would you like to continue your last game? (Y,n) > ')
 continue=readstr()
 if continue = 'N' then do
  call close(data)
  call zerovar
  return
  end
 call zerovar
 say cr
 say' Loading data, stand by ...'cr
 again = 1
 rollsleft = readln(data)
 spotsleft = readln(data)
 if spotsleft = 0 then do
  call zerovar
  call close(data)
  return
  end
 do i = 1 to words(sstr)
  j = word(sstr,i)
  s.j = readln(data)
  end
 sub = readln(data)
 bon = readln(data)
 utot = Readln(data)
 utot2 = readln(data)
 ltot = Readln(data)
 tot = readln(data)
 do i = 1 to 5
  dvalue.i = readln(data)
  end
 call close(data)
 call refresh1
 call refresh2
 call setlines
 call showdice
 call getopt

savedata:
 if exists(datapath'/'name) then call delete(datapath'/'name)
 call open(data,datapath'/'name,'W')
 thedate = date()
 call writeln(data,thedate)
 if colorset = '' then colorset = 1
 call writeln(data,colorset)
 call writeln(data,rollsleft)
 call writeln(data,spotsleft)
 do i = 1 to words(sstr)
  j = word(sstr,i)
  call writeln(data,s.j)
  end
 call writeln(data,sub)
 call writeln(data,bon)
 call writeln(data,utot)
 call writeln(data,utot2)
 call writeln(data,ltot)
 call writeln(data,tot)
 do i = 1 to 5
  call writeln(data,dvalue.i)
  end
 call close(data)
return

clrl:
 arg what
 if what = 0 then where = pprompt
 if what = 1 then where = pprompt1
 if what = 2 then where = poptln
 if what = 3 then where = pprompt2
 if what = 2 then color = bak.6
 else color = def
 say''where''color'                              'def'  '
return

getopt:
 if spotsleft = 0 then call done
 call setopt
 say''prollsleft''rollsleft''
 call clrl(0)
 call clrl(1)
 do s = 1 to 5
  hold.s = '    '
  say''phold.s''hold.s''
  end
 if rollsleft = 3 then line = 'Hit 'pen.3'Return'def' 'pen.1'to Roll the dice'def' > '
 if rollsleft = 2 | rollsleft = 1 then line = '   'pen.1'Enter the Option to take or 'def''
 if rollsleft = 0 then line = ''pen.1'Enter your Option'def' > '
 if rollsleft = 2 | rollsleft = 1 then do
  say''pprompt''line''
  prompt(''pprompt1'       'pen.3'Return'def' 'pen.1'to Roll 'def'> ')
  end
 else prompt(''pprompt''line'')
 opt=readstr()
 opt = upper(strip(opt))
 if rollsleft = 3 then do
  select
   when opt = H then call help
   when opt = Q then call quit(1)
   when opt = SC then call checkopt
   when opt = P then do
    call setPrefs
    call getopt
    end
   otherwise call rolldice(12345)
   end
  end
 if rollsleft = 2 | rollsleft = 1 then do
  select
   when opt = H then call help
   when opt = Q then call quit(1)
   when opt = P then do
    call setPrefs
    call getopt
    end
   when opt = '' then do
    call holddice
    call rolldice(pick)
    end
   otherwise call checkopt
   end
  end
 if rollsleft = 0 then do
  select
   when opt = H then call help
   when opt = Q then call quit(1)
   when opt = P then do
    call setPrefs
    call getopt
    end
   when opt = '' then call getopt
   otherwise call checkopt
   end
  end
return

checkopt:
 init = 0
 if opt = SC then init = 1
 if init = 0 then do i = 1 to words(optln)
  testopt = word(optln,i)
  if opt = testopt then init = 1
  end
 if init = 0 then do
  call clrl(0)
  call clrl(1)
  say''pprompt''pen.2'INVALID Option!!'def''
  call delay(100)
  call getopt
  end
 if opt = 1 then s.1 = countin(dstring,'1')
 if opt = 2 then s.2 = (countin(dstring,'2') * 2)
 if opt = 3 then s.3 = (countin(dstring,'3') * 3)
 if opt = 4 then s.4 = (countin(dstring,'4') * 4)
 if opt = 5 then s.5 = (countin(dstring,'5') * 5)
 if opt = 6 then s.6 = (countin(dstring,'6') * 6)
 if opt = 3K then s.3K = dvalue.1 + dvalue.2 + dvalue.3 + dvalue.4 + dvalue.5
 if opt = 4K then s.4K = dvalue.1 + dvalue.2 + dvalue.3 + dvalue.4 + dvalue.5
 if opt = FH then s.FH = 25
 if opt = SS then s.SS = 30
 if opt = LS then s.LS = 40
 if opt = C  then s.c = dvalue.1 + dvalue.2 + dvalue.3 + dvalue.4 + dvalue.5
 if opt = Y  then s.Y = 50
 if opt = SC then do
  call clrl(0)
  call clrl(1)
  prompt(''pprompt'Which item to Scratch? > ')
  scit=readstr()
  itsok = 0
  do i = 1 to words(sstr)
   j = word(sstr,i)
   if j = scit & s.j = '' then do
    itsok = 1
    call clrl(0)
    prompt(''pprompt'Scratch 'scit'? (Y,n) > ')
    thething=readstr()
    if thething = 'N' then call getopt
    s.scit = ' --'
    end
   end
  if itsok = 0 then do
   call clrl(0)
   say''pprompt''pen.3'SAY WHAT?? Try again..'def''
   call getopt
   end
  end
 sub = 0
 bon = 0
 utot = 0
 utot2 = 0
 ltot = 0
 tot = 0
 do i = 1 to words(sstr)
  thisscore = word(sstr,i)
  if i < 7 then do
   if s.thisscore = ' --' then do
    s.thisscore = 0
    scratch = 'YES'
    end
   if s.thisscore = '' then s.thisscore = 0
   sub = sub + s.thisscore
   if sub > 62 then bon = 35
   utot = sub + bon
   utot2 = utot
   if s.thisscore = 0 then s.thisscore = ''
   if scratch = 'YES' then do
    s.thisscore = ' --'
    scratch = 'NO'
    end
   end
  if i > 6 then do
   if s.thisscore = ' --' then do
    s.thisscore = 0
    scratch = 'YES'
    end
   if s.thisscore = '' then s.thisscore = 0
   ltot = ltot + s.thisscore
   tot = ltot + utot
   if s.thisscore = 0 then s.thisscore = ''
   if scratch = 'YES' then do
    s.thisscore = ' --'
    scratch = 'NO'
    end
   end
  end
 do i = 1 to words(sstr)
  j = word(sstr,i)
  if i = 6 | i = 'Y' then style = unl
  else style = ''
  nostyle = def
  here = right(s.j,3)
  say''ps.j''style''here''nostyle''
  end
 say''psub''right(sub,3)''
 say''pbon''unl''right(bon,3)''def''
 say''putot''right(utot,3)''
 say''pltot''right(ltot,3)''
 say''putot2''unl''right(utot2,3)''def''
 say''ptot''right(tot,3)''
 rollsleft = 3
 spotsleft = spotsleft - 1
 call getopt

/* call loop */


sortstr:
 call open(file,'ram:sortfile','W')
 do i = 1 to 5
  num = substr(dstring,i,1)
  call writeln(file,num)
  end
 call close(file)
 address command'sort Ram:sortfile ram:sorted'
 call open(file,'ram:sorted','R')
 az=readln(file)
 bz=Readln(file)
 cz=readln(file)
 dz=readln(file)
 ez=readln(file)
 call close(file)
return

setopt:               /* Hilight or Lowlight proper options */
 dstring = dvalue.1||dvalue.2||dvalue.3||dvalue.4||dvalue.5
 call sortstr
 histr = ''
 call clrl(2)
 if rollsleft = 3 then do
  call sethi(histr)
  return
  end
 do l = 1 to 5              /* Chk for 1's thru 6's */
  do m = 1 to 6
   if dvalue.l = m & s.m = '' then do
    if histr = '' then histr = m
    else histr = histr||' 'm
    end
   end
  end
 temphi = ''
 do i = 1 to 6
  if instring(i,histr) then do
   if temphi = '' then temphi = i
   else temphi = temphi||' 'i
   end
  end
 histr = temphi
               /* Chk for 3K */
 do l = 1 to 6
  if countin(dstring,l) > 2 & s.3K = '' then do
   if histr = '' then histr = '3K'
   else histr = histr||' 3K'
   end
  end
               /* Chk for 4K */
 do l = 1 to 6
  if countin(dstring,l) > 3 & s.4K = '' then do
   if histr = '' then histr = '4K'
   else histr = histr||' 4K'
   end
  end
               /* chk for FH */
 do l = 1 to 6
  if countin(dstring,l) > 2 then
   do m = 1 to 6
    if m = l then iterate m
    if countin(dstring,m) > 1 & s.FH = '' then do
     if histr = '' then histr = 'FH'
     else histr = histr||' FH'
     end
    end
  end
               /* Chk for SS */
 test = 0
 test1 = 0
 skip = 0
 if s.SS = '' then do z = 1 to 3
  if instring(az+z,dstring) then test = test + 1
  skip = 1
  end
 if test < 3 then skip = 0
 if s.SS = '' & skip = 0 then do z = 1 to 3
  if instring(ez-z,dstring) then test1 = test1 + 1
  end
 if test = 3 | test1 = 3 then do
  histr = histr||' SS'
  end

               /* Chk for LS */
 test = 0
 test1 = 0
 skip = 0
 if s.LS = '' then do z = 1 to 4
  if instring(az+z,dstring) then test = test + 1
  skip = 1
  end
 if test < 4 then skip = 0
 if s.LS = '' & skip = 0 then do z = 1 to 4
  if instring(ez-z,dstring) then test1 = test1 + 1
  end
 if test = 4 | test1 = 4 then do
  histr = histr||' LS'
  end

               /* Chance is automatic unless already taken */
 if s.c = '' then histr = histr||' C'
               /* Chk fo Yacht_C */
 do i = 1 to 6
  if countin(dstring,i) = 5 & s.Y = '' then do
   histr = histr||' Y'
   end
  end

 call sethi(histr)
return

sethi:
 arg histr
 if histr = '' then do
  call setalllow
  optln = 'H Q P SC'
  optln = center(optln,30)
  call clrl(2)
  say''poptln''bak.6''pen.1''optln''def''
  return
  end
 call setalllow
 optln = 'H Q P SC'
 do i = 1 to words(histr)
  hiword = word(histr,i)
  do j = 1 to words(optstr)
   optword = word(optstr,j)
   where = pln.hiword
   what = ln.hiword
   if hiword = optword then do
    say''where''hi''what''def''
    optln = optln' 'hiword
    iterate i
    end
   else say''where''low''what''def''
   end
  end
 optln = center(optln,30)
 call clrl(2)
 say''poptln''bak.6''pen.1''optln''def''
return

setalllow:
 low = bak.0||pen.1
 hi = bak.2||pen.1
 say''pln.1''low''ln.1''def''
 say''pln.2''low''ln.2''def''
 say''pln.3''low''ln.3''def''
 say''pln.4''low''ln.4''def''
 say''pln.5''low''ln.5''def''
 say''pln.6''low''ln.6''def''
 say''pln.3K''low''ln.3K''def''
 say''pln.4K''low''ln.4K''def''
 say''pln.FH''low''ln.FH''def''
 say''pln.SS''low''ln.SS''def''
 say''pln.LS''low''ln.LS''def''
 say''pln.c''low''ln.c''def''
 if s.y = '50' then say''pln.y''low' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' 50'def''
 if s.y = '' then say''pln.y''low' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |   'def''
 if s.y = ' --' then say''pln.y''low' [ Y] 'unl'Yacht-C        (50)'def''unl''pen.1' |'def''unl' --'def''
return

CountIn: procedure
arg str,dnum
   points = 0
   pos = 1
   oldpos = 1
   do while (pos ~== 0)
      pos = index(str,dnum,oldpos)
      if (pos ~==0) then do
         points = points + 1
         oldpos = pos + 1
      end
   end
return(points)


holddice:
pick = ''
 call clrl(0)
 call clrl(1)
 prompt(''pprompt'Hold which dice ? (0-5) > ')
 holdem=readstr()
 holdem = strip(holdem)
 if holdem = '' then call getopt
 if holdem = '0' then do
  pick = '12345'
  return
  end
 do t = 1 to 5
  if instring(t,holdem) then hold.t = ''pen.5'HOLD'def''
  else do
   hold.t = '    '
   if pick = '' then pick = t
   else pick = pick||t
   end
  end
 do s = 1 to 5
  say''phold.s''hold.s''
  end
 call clrl(0)
 prompt(''pprompt'Look right to you ? (Y,n) > ')
 answer=readstr()
 if answer = 'N' then call holddice
return

instring: procedure
arg letter,string
 if (index(string,letter) == 0) then return 0
  else return 1

rolldice:
 arg toroll
 do i=1 to length(toroll)
  die = substr(toroll,i,1)
  if rvalue = 0 then do
   dvalue.die = getrandom()
   rvalue = 1
   end
  else do
   dvalue.die = random(1,6)
   rvalue = 0
   end
  do
   do w = 1 to 6
    say''pd.die.w''pen.2''bak.1' 'def''
    end
   do w = 7 to 9
    say''pd.die.w''pen.2''bak.1''unl' 'def''
    end
   end

  if dvalue.die = 1 then pd.die.1.v = ' '
  else pd.die.1.v = 'O'
  pd.die.2.v = ' '
  if dvalue.die > 3 then pd.die.3.v = 'O'
  else pd.die.3.v = ' '
  if dvalue.die = 6 then pd.die.4.v = 'O'
  else pd.die.4.v = ' '
  if dvalue.die = 1 | dvalue.die = 3 | dvalue.die = 5 then pd.die.5.v = 'O'
  else pd.die.5.v = ' '
  if dvalue.die = 6 then pd.die.6.v = 'O'
  else pd.die.6.v = ' '
  if dvalue.die > 3 then pd.die.7.v = ''unl'O'
  else pd.die.7.v = ''unl' '
  pd.die.8.v = ''unl' '
  if dvalue.die > 1 then pd.die.9.v = ''unl'O'
  else pd.die.9.v = ''unl' '
  do x = 1 to 9
   if pd.die.x.v = ' ' then say''pd.die.x''pen.2''bak.1' 'def''
   else say''pd.die.x''pen.2''bak.1''pd.die.x.v''def''
   end

  end
 rollsleft = rollsleft - 1
call getopt
exit

Help:
 say''CLS''
 say cr
 say'    'pen.7'Yacht_C written by Matt English 7-29-93'def''cr
 say cr
 say'  Yacht_C is a fairly simple (and fun) dice game!'cr
 say' The object is to fill your score card with all'cr
 say' the options and achieve the highest possible score!'cr
 say cr
 say'  You get up to 3 rolls of the 5 dice for each turn.'cr
 say' To roll the dice, just hit 'pen.3'RETURN'def' at the prompt,'cr
 say' and you''ll be asked which dice you''d like to hold. Enter the'cr
 say' numbers that appear over the dice you wanna hold, (1-5).'cr
 say' After your first roll, you can 'pen.2'HOLD'def' any of the dice'cr
 say' and re-roll the remaining dice. You don''t have to hold'cr
 say' any dice if you wanna re-roll all of them.'cr
 say cr
 say'  You 'pen.3'MUST'def' score one item on your score card each turn!'cr
 say' If there aren''t any available options, you 'pen.3'MUST SCRATCH'def''cr
 say' one item. You will receive zero points for each scratched'cr
 say' item, so try to avoid it..'cr
 say cr
 prompt(' 'pen.4'Hit return to continue...'def'')
 junk=readstr()
 say''cls''
 say cr
 say' 'pen.6'The Options:'def''cr
 say cr
 say' 1''s thru 6''s........ Add the total of all the matching dice.'cr
 say' 3K (3 of a kind).... At least 3 dice match, Add all dice.'cr
 say' 4K (4 of a kins).... At least 4 dice match, Add all dice.'cr
 say' FH (Full House)..... 3 dice match AND 2 other dice match'cr
 Say' SS (Small Straight). Run of 4 dice (1,2,3,4) (3,4,5,6)'cr
 say' LS (Large Straight). Run of 5 dice (1,2,3,4,5) (2,3,4,5,6)'cr
 say' C  (Chance)......... Take this when there are no other choices.'cr
 say' Y  (Yacht_C)........ All five dice match.'cr
 say cr
 say' 'pen.5'BONUS!'def''cr
 say cr
 say'  If you can achieve a score of 63 or more on the upper part'cr
 say' of the score sheet, you get a 35 point Bonus!'cr
 say cr
 prompt(' 'pen.4'Hit return to continue...'def'')
 junk=readstr()
 say''cls''
 say cr
 say' 'pen.5'Prefs:'def''cr
 say cr
 say'  Using Prefs will give you 6 options to adjust the colors'cr
 say' that you see while playing this game. Your choice will be'cr
 say' recorded and used each time you play the game. You can change'cr
 say' it at any time.'cr
 say cr
 say'  If at any time your screen gets screwed up (phone noise,'cr
 say' crazy fingers, ect..) Just re-read this help file, or go to'cr
 say' the prefs utility and your screen will be re-drawn when you'cr
 say' return to the game.'cr
 say cr
 say'  Your score will be automatically saved when you quit the game'cr
 say' so that you can continue your game next call if you wish.'cr
 say cr
 say' 'pen.7'Hope you enjoy the game!'def''cr
 say cr
 prompt(' 'pen.4'Hit return to continue...'def'')
 junk=readstr()
 call refresh1
 call refresh2
 call showdice
 call getopt
return

setPrefs:
 say''cls''cr
 say cr
 say cr
 say' Since everyone has their color palettes set'cr
 say' differently on their Comm programs, there is no'cr
 say' way to tell how the colors for this game will'cr
 say' look on your screen.'cr
 say cr
 say' This little utility will set and save your'cr
 say' colors preferences for this game. You can 'cr
 say' change them again at any time.'cr
 say cr
 say' ColorSet # 1       ColorSet # 2       ColorSet # 3'cr
 say' ColorSet # 4       ColorSet # 5       ColorSet # 6'cr
 say cr
 prompt(' Enter a ColorSet # to use (1-6) > ')
 color=readstr()
 if color = '' then do
  call refresh1
  call refresh2
  call setlines
  call showdice
  call getopt
  end
 if ~datatype(color,'W') then call setprefs
 if color < 0 | color > 6 then call setprefs
 call prefs(color)
 say cr
 prompt(' Enter "T" to test or RETURN to use > ')
 test=readstr()
 if test = 'T' then do
  call refresh1
  call refresh2
  call setlines
  prompt(''pprompt'Hit Return to continue')
  junk=readstr()
  call setprefs
  end
 else do
  call refresh1
  call refresh2
  call setlines
  call showdice
  call getopt
  end


Prefs:
 arg colorset
 if colorset = '' then colorset = 1
 col.0=''
 col.1=''
 col.2=''
 col.3=''
 col.4=''
 col.5=''
 col.6=''
 col.7=''
 bakcol.0=''
 bakcol.1=''
 bakcol.2=''
 bakcol.3=''
 bakcol.4=''
 bakcol.5=''
 bakcol.6=''
 bakcol.7=''
 if colorset = 1 then do
  do i = 0 to 7
   pen.i = col.i
   end
  do i = 0 to 7
   bak.i = bakcol.i
   end
  end
 if colorset = 2 then do
  do i = 1 to 7
   if i = 7 then do
    pen.i = col.1
    iterate i
    end
   x = i + 1
   pen.i = col.x
   end
  do i = 1 to 7
   if i = 7 then do
    bak.i = bakcol.1
    iterate i
    end
   x = i + 1
   bak.i = bakcol.x
   end
  end
 if colorset = 3 then do
 j = 0
 k = 0
  do i = 1 to 7
   if i > 5 then do
    j = j + 1
    pen.i = col.j
    iterate i
    end
   x = i + 2
   pen.i = col.x
   end
  do i = 1 to 7
   if i > 5 then do
    k = k + 1
    bak.i = bakcol.k
    iterate i
    end
   x = i + 2
   bak.i = bakcol.x
   end
  end
 if colorset = 4 then do
 j = 0
 k = 0
  do i = 1 to 7
   if i > 4 then do
    j = j + 1
    pen.i = col.j
    iterate i
    end
   x = I + 3
   pen.i = col.x
   end
  do i = 1 to 7
   if i > 4 then do
    k = k + 1
    bak.i = bakcol.k
    iterate i
    end
   x = i + 3
   bak.i = bakcol.x
   end
  end
 if colorset = 5 then do
 j = 0
 k = 0
  do i = 1 to 7
   if i > 3 then do
    j = j + 1
    pen.i = col.j
    iterate i
    end
   x = i + 4
   pen.i = col.x
   end
  do i = 1 to 7
   if i > 3 then do
    k = k + 1
    bak.i = bakcol.k
    iterate i
    end
   x = i + 4
   bak.i = bakcol.x
   end
  end
 if colorset = 6 then do
 j = 0
 k = 0
  do i = 1 to 7
   if i > 2 then do
    j = j + 1
    pen.i = col.j
    iterate i
    end
   x = i + 5
   pen.i = col.x
   end
  do i = 1 to 7
   if i > 2 then do
    k = k + 1
    bak.i = bakcol.k
    iterate i
    end
   x = i + 5
   bak.i = bakcol.x
   end
  end

return

getrandom:
 call sortstr2
 x = random(1,4)
 if x = 1 then it = caz
 if x = 2 then it = cbz
 if x = 3 then it = ccz
 if x = 4 then it = cdz
 do
  count = word(it,1)
  num = word(it,2)
  do ii = 1 to 6
   testcount = word(dcstring,(ii*2)-1)
   testnum = word(dcstring,ii*2)
   if testnum = num then do
    count = count + 1
    if ii = 1 then tempstring = count' 'num
    else tempstring = tempstring' 'count' 'num
    end
   else do
    if ii = 1 then tempstring = testcount' 'testnum
    else tempstring = tempstring' 'testcount' 'testnum
    end
   end
  end
  dcstring = tempstring
return right(num,1)

sortstr2:
 call open(file,'ram:sortfile2','W')
 do ii = 1 to 6
  num = word(dcstring,ii*2)
  count = word(dcstring,(ii*2)-1)
  call writeln(file,count num)
  end
 call close(file)
 address command'sort Ram:sortfile2 ram:sorted2 NUMERIC'
 call open(file,'ram:sorted2','R')
 caz=readln(file)
 cbz=Readln(file)
 ccz=readln(file)
 cdz=readln(file)
 cez=readln(file)
 cfz=readln(file)
 call close(file)
return

showdice:
 do die = 1 to 5
  if dvalue.die = 1 then pd.die.1.v = ' '
  else pd.die.1.v = 'O'
  pd.die.2.v = ' '
  if dvalue.die > 3 then pd.die.3.v = 'O'
  else pd.die.3.v = ' '
  if dvalue.die = 6 then pd.die.4.v = 'O'
  else pd.die.4.v = ' '
  if dvalue.die = 1 | dvalue.die = 3 | dvalue.die = 5 then pd.die.5.v = 'O'
  else pd.die.5.v = ' '
  if dvalue.die = 6 then pd.die.6.v = 'O'
  else pd.die.6.v = ' '
  if dvalue.die > 3 then pd.die.7.v = ''unl'O'
  else pd.die.7.v = ''unl' '
  pd.die.8.v = ''unl' '
  if dvalue.die > 1 then pd.die.9.v = ''unl'O'
  else pd.die.9.v = ''unl' '
  do x = 1 to 9
   if pd.die.x.v = ' ' then say''pd.die.x''pen.2''bak.1' 'def''
   else say''pd.die.x''pen.2''bak.1''pd.die.x.v''def''
   end
  end
return

refresh1:
low = bak.0||pen.1
hi = bak.2||pen.1
say''def''cls''cr
say''pen.1'      'unl'                    |   'def'    'pen.1''bak.5'Yacht_C 1.1 by Matt English'def''cr
say''pen.1' [ 1] ones      (add 1''s) |'def'       'cr
say''pen.1' [ 2] twos      (add 2''s) |   'def'   'unl''pen.2'  1  'def' 'unl''pen.2'  2  'def' 'unl''pen.2'  3  'def' 'unl''pen.2'  4  'def' 'unl''pen.2'  5  'def''cr
say''pen.1' [ 3] threes    (add 3''s) |      'bak.1''pen.2'|   |'def' 'bak.1''pen.2'|O  |'def' 'bak.1''pen.2'|O  |'def' 'bak.1''pen.2'|O O|'def' 'bak.1''pen.2'|O O|'def''cr
say''pen.1' [ 4] fours     (add 4''s) |      'bak.1''pen.2'| O |'def' 'bak.1''pen.2'|   |'def' 'bak.1''pen.2'| O |'def' 'bak.1''pen.2'|   |'def' 'bak.1''pen.2'| O |'def' 'cr
say''pen.1' [ 5] fives     (add 5''s) |      'unl''bak.1''pen.2'|   |'def' 'unl''bak.1''pen.2'|  O|'def' 'unl''bak.1''pen.2'|  O|'def' 'unl''bak.1''pen.2'|O O|'def' 'unl''bak.1''pen.2'|O O|'def'   'cr
say''pen.1' [ 6] 'unl'sixes     (add 6''s) |   'def'    'cr
say''pen.1'            Sub TOTAL     |  'def'             'cr
say''pen.1'            'unl'BONUS         |   'def'   'pen.3' "H" = Help'def'   'pen.3' "P" = Prefs'def''cr
say''pen.1'            Upper TOTAL   |      'pen.3' "Q" = Quit'def'   'pen.3'"SC" = Scratch'def''cr
say'                                              'cr
say''pen.1' [3K] 3 of a kind (total) | 'def''cr
say''pen.1' [4K] 4 of a kind (total) |      'bak.6'          'unl'Options :'def''bak.6'           'def''cr
say''pen.1' [FH] Full House     (25) |      'bak.6'                              'def' 'cr
say''pen.1' [SS] Small Straight (30) |      'bak.6'                              'def' 'cr
say''pen.1' [LS] Large Straight (40) | 'def''cr
say''pen.1' [ C] Chance      (total) | 'def''cr
say''pen.1' [ Y] 'unl'Yacht-C        (50) |   'def'        'cr
say''pen.1'            Lower TOTAL   | 'def''cr
say''pen.1'            'unl'Upper TOTAL   |   'def''cr
say''pen.1'            Game TOTAL    | 'def''cr
return

refresh2:
say''pplayer''player''
say''ps.1''right(s.1,3)''
say''ps.2''right(s.2,3)''
say''ps.3''right(s.3,3)''
say''ps.4''right(s.4,3)''
say''ps.5''right(s.5,3)''
say''ps.6''unl''right(s.6,3)''def''
say''psub''right(sub,3)''
say''pbon''unl''right(bon,3)''def''
say''putot''right(utot,3)''
say''ps.3k''right(s.3k,3)''
say''ps.4k''right(s.4k,3)''
say''ps.fh''right(s.fh,3)''
say''ps.ss''right(s.ss,3)''
say''ps.ls''right(s.ls,3)''
say''ps.c''right(s.c,3)''
say''ps.y''unl''right(s.y,3)''def''
say''pltot''right(ltot,3)''
say''putot2''unl''right(utot2,3)''def''
say''ptot''right(tot,3)''
say''phold.1''hold.1''
say''phold.2''hold.2''
say''phold.3''hold.3''
say''phold.4''hold.4''
say''phold.5''hold.5''
say''prollsleft''pen.1''rollsleft' 'pen.4'Rolls left this turn'def''
return

savescore:
 if ~exists(datapath'/scores') then do
  call open(win,datapath'/scores','W')
  call writeln(win,'100 MATT_ENGLISH 'date())
  call close(win)
  end
 if newplayer = 1 then do
  call open(win,datapath'/scores','A')
  call writeln(win,tot name date())
  call close(win)
  call sortscore
  call checkplace(1)
  call clrl(0)
  call clrl(1)
  fromtop = (scorecount - yspos) + 1
  call getpost
  say''pprompt'This game''s score was 'fromtop''post''
  say''pprompt1'  place outta 'scorecount' players!'
  call delay(250)
  end
 if newplayer = 0 then do
  call checkplace(1)
  if tot > oldtop then do
   call open(win,datapath'/scores','W')
   do i = 1 to scorecount
    call writeln(win,bestln.i)
    end
   call close(win)
   call sortscore
   call checkplace(2)
   call clrl(0)
   call clrl(1)
   say''pprompt'This score beats your previous'
   say''pprompt1'best of 'oldtop' from 'olddate2' 'olddate1' 'olddate3' !'
   fromtop = (scorecount - yspos) + 1
   call getpost
   say''pprompt2''fromtop''post' place outta 'scorecount' players!'
   call delay(250)
   call clrl(3)
   end
  else do
   call clrl(0)
   call clrl(1)
   say''pprompt'This didn''t beat your previous'
   say''pprompt1'best of 'ytopscore' from 'ytopdate2' 'ytopdate1' 'ytopdate3'..'
   fromtop = (scorecount - yspos) + 1
   call getpost
   say''pprompt2''fromtop''post' place outta 'scorecount' players!'
   call delay(250)
   call clrl(3)
   end
  end
return

getpost:
 if right(fromtop,2) > 10 & right(fromtop,2) < 14 then post = 'th'
 else do
  if right(fromtop,1) = 0 | right(fromtop,1) > 3 & right(fromtop,1) < 10 then post = 'th'
  if right(fromtop,1) = 1 then post = 'st'
  if right(fromtop,1) = 2 then post = 'nd'
  if right(fromtop,1) = 3 then post = 'rd'
  end
return

sortscore:
 address command'sort 'datapath'/scores Ram:sortscores numeric'
 address command'C:copy Ram:sortscores 'datapath'/scores QUIET'
 call delete('RAM:sortscores')
return

checkplace:
 arg times
 scorecount = 0
 call open(win,datapath'/scores','r')
 do until eof(win)
  scorecount = scorecount + 1
  bestln.scorecount = readln(win)
  if bestln.scorecount = '' then do
   scorecount = scorecount - 1
   break
   end
  if times ~= '3' & word(bestln.scorecount,2) = name then do
   yspos = scorecount                                  /* your score pos from bottom of list */
   ytopscore = word(bestln.scorecount,1)                              /* your top score */
   ytopdate1 = word(bestln.scorecount,3)                               /* the date you got the top score */
   ytopdate2 = word(bestln.scorecount,4)
   ytopdate3 = word(bestln.scorecount,5)
   if times = '1' & tot > ytopscore then do
    bestln.scorecount = tot name date()
    oldtop = ytopscore
    olddate1 = ytopdate1
    olddate2 = ytopdate2
    olddate3 = ytopdate3
    end
   end
  end
 call close(win)
return


done:
 call clrl(0)
 call clrl(1)
 say''pprompt'Checking your score against'
 say''pprompt1'the High Score list..'
 call delay(100)
 call savescore
 call clrl(0)
 call clrl(1)
 prompt(''pprompt'Wanna play again? (Y,n) > ')
 playagain=readstr()
 call zerovar
 if newplayer = 1 then call savedata
 newplayer = 0
 if playagain = 'N' then call quit(2)
 call refresh1
 call refresh2
 call setlines
/* call loop */
 call getopt
 end

quit:
 arg quitopt
 call clrl(0)
 call clrl(1)
 if quitopt ~= 2 then do
  prompt(''pprompt'Really Quit? (Y,n) > ')
  this=readstr()
  if this = 'N' then call getopt
  end
call savedata
exit

readstr: procedure
str=''
out=readch(STDIN)
 call WRITECH(STDOUT,out)
 do while out~=D2C(13)
      if out=D2C(8) then do
         str=SUBSTR(str,1,LENGTH(str)-1)
         call WRITECH(STDOUT,' ')
         call WRITECH(STDOUT,out)
         end
      else
         str=INSERT(str,out)
      out=readch(STDIN)
      call WRITECH(STDOUT,out)
    end
say '0D'x
return(UPPER(str))

prompt: procedure
parse arg str
writech(STDOUT,str)
return 1

Break_C:
Break_E:
 call clrl(0)
 say''pprompt'Saving data, standby ....'
 call savedata
 if quitopt ~= 2 then call savescore
 if exists('ram:sortfile') then call delete('ram:sortfile')
 if exists('ram:sortfile2') then call delete('ram:sortfile2')
 if exists('ram:sorted') then call delete('ram:sorted')
 if exists('ram:sorted2') then call delete('ram:sorted2')
 call clrl(0)
 call clrl(1)
 call clrl(3)
 say''pprompt'Thanks for playing Yacht_C!'
 call delay(100)
 call checkplace(3)
 say''CLS''cr
 title = 'Top 15 Yacht_C Players!!!'
 title = center(title,70)
 say''pen.3''title''def''cr
 say cr
 line = bestln.scorecount
 score = left(word(line,1),5)
 name = left(word(line,2),20)
 date1 = left(word(line,4),4)
 date2 = left(word(line,3),3)
 yr = word(line,5)
 say'                 'pen.6''score''name''date1''date2''yr''def''cr
 do i = 1 to 14
  scorecount = scorecount - 1
  if scorecount = 0 then leave i
  line = bestln.scorecount
  score = left(word(line,1),5)
  name = left(word(line,2),20)
  date1 = left(word(line,4),4)
  date2 = left(word(line,3),3)
  yr = word(line,5)
  say'                 'pen.6''score''name''date1''date2''yr''def''cr
  end
 call delay(250)
 say cr
 say'   Bye!'cr
 exit

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