/* $VER: bbsDoors.rexx 8.3 (19.12.94)
copyright 1993-94 Richard Lee Stockton
FREELY DISTRIBUTABLE
Thanks to Matt English for "Jump.rexx"
*/

IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
IF ~SHOW('P','QuickSortPort') THEN EXIT 666

SIGNAL ON BREAK_C
SIGNAL ON FAILURE
SIGNAL ON SYNTAX
OPTIONS FAILAT 999999
CALL TIME('R')

ARG maxtime name pw
IF ~DATATYPE(maxtime,'N') THEN maxtime=3000

namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
IF ADDRESS()='BAUD' THEN
  DO
    frombb=1
    CR='0D'x
  END
ELSE
  DO
    frombb=0
    CR=''
  END

figarg='s:CONFIG.BBS'
IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
x=OPEN(f,figarg,'R')
IF x=0 THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'CR
    EXIT(20)
  END
lynes.=''
DO i=1 TO 6
  lynes.i=READLN(f)
END
CALL CLOSE(f)
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop  =WORD(lynes.2,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'CR
    CALL SETCLIP('BBS_STAT')
    EXIT(20)
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
IF GETCLIP('BBS_path')='' THEN CALL SETCLIP('BBS_path',bbspath)
CALL PRAGMA('D',bbspath'rexxDoors')
IF ARG()=0 THEN
  DO
    SAY
    SAY '                       bbsDoors.rexx'
    SAY '               Original by Matt English 9-30-92'
    SAY '            Alterations by RLS through 11-25-94'
    SAY
  END
IF name='' THEN
  DO
    SAY
    SAY
    options prompt' Are you 'sysop' ? Y or n > '
    pull answer
    if answer='Y' | answer='' then name=sysop
    else DO
      SAY
      options prompt' Please enter your name > '
      pull name
      name=strip(name)
      name=translate(name,'_',' ')
      if name='' then CALL bye
    END
    SAY
  END
file=bbspath'Users/'name
IF ~EXISTS(file) THEN
  DO
    SAY  CR
    SAY 'I can''t find' name 'on the users list!'CR
    SAY 'You should log on to the BBS before you try this!'CR
    CALL delay(100)
    CALL bye
  END

colorflag=0
userfile=bbspath'Users/'name
CALL OPEN(data,userfile,'r')
DO i=1 TO 20
  line=readln(data)
  IF i=5 THEN password=line
  IF i=8 THEN
    IF FIND(line,'COLOR')>0 THEN colorflag=1
  IF i=18 THEN winnings=WORD(line,1)
  IF i=20 THEN level=WORD(line,1)
  END
CALL close(data)
IF ~DATATYPE(winnings,'N') THEN winnings=0

def='';bak2='';pen3=''
IF colorflag=0 THEN
  DO
    def='';bak2='';pen3=''
  END

IF pw~=password THEN
  DO
    passprompt=' 'pen3'Please Enter Password: '
    DO tries=1 TO 3
      OPTIONS PROMPT passprompt
      PULL newpassword
      SAY ''CR
      IF(password=newpassword) THEN LEAVE tries; /* correct password */
      IF tries=3 THEN
        DO
          SAY CR
          SAY 'Access terminated.'CR
          SAY '*** Bad password ***' newpassword '***'CR
          CALL bye
        END
      passprompt='Incorrect.  Password: '
    END
    SAY CR
    SAY' OK, 'name' here we go....'CR
    SAY CR
  END

CALL sortdoors()
temp=1
played=0
DO doorloop=1
  IF temp=0 THEN
    DO
      IF played THEN
        DO
          doors.0=''
          CALL sortdoors()
        END
      SAY CR
      SAY CENTER('- Number of accesses per file -',75)||CR
    END
  CALL showtime()
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO jd=1 TO jdoors.0
    IF temp=0 THEN SAY jdoors.jd.0||CR
    ELSE SAY jdoors.jd||CR
  END
  SAY pen3||LEFT('-',75,'-')||def||CR
  IF temp=0 THEN
    DO
      OPTIONS PROMPT '                                 'pen3'Press RETURN 'def
      PULL junk
      temp=1
      SAY CR
      ITERATE doorloop
    END
  arg='Menu'
  CALL postuser()
  temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
  IF temp=0 THEN ITERATE doorloop
  IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN CALL bye
  arg=doors.temp
  IF GETCLIP('BBS_door')=arg | GETCLIP('BBS_localdoor')=arg THEN
    DO
      SAY 'That door is in use!  Try again in a few minutes...'CR
      ITERATE doorloop
    END
  played=1
  IF frombb THEN CALL SETCLIP('BBS_door',arg)
  ELSE CALL SETCLIP('BBS_localdoor',arg)
  CALL Increment.rexx(bbspath'rexxDoors/'arg)
  savewinnings=0
  testwin=''
  IF frombb THEN
    DO
      CALL send2log(arg 'at' TIME('C'))
      CALL SETCLIP('BBS_winnings')
      timeleft=TRUNC(maxtime-TIME('E'))
      IF UPPER(arg)='ONE_ARMED_BANDIT.REXX' THEN
        IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
          DO
            savewinnings=winnings
            IF savewinnings=0 THEN savewinnings=1
            winnings=timeleft
            SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
          END
      CALL postuser()
    END
  ELSE CALL TIME('R')
  comm='CALL' arg'('TRANSLATE(name,'_','-') winnings savewinnings colorflag maxtime-TIME('E')-42')'
  INTERPRET comm
  IF frombb THEN
    DO
      testwin=GETCLIP('BBS_winnings')
      IF DATATYPE(testwin,'N') THEN
        DO
          IF savewinnings>0 THEN
            DO
              IF testwin>7200 THEN
                DO
                  SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
                  testwin=7200
                END
              maxtime=TRUNC(testwin+TIME('E'))
              CALL SETCLIP('BBS_maxtime',maxtime)
              winnings=savewinnings
            END
          ELSE
            DO
              winnings=testwin
              CALL SETCLIP('BBS_winnings',winnings)
            END
        END
      CALL SETCLIP('BBS_door')
    END
  ELSE CALL SETCLIP('BBS_localdoor')
END


sortdoors:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  DO
    played=0
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      DO j=0 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          DO
            jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
            dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
            jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
          END
      END
    END
  END
RETURN 0


send2log:
PARSE ARG sendline
IF ~frombb THEN RETURN
logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
fl='W'
IF EXISTS(logfile) THEN fl='A'
IF ~OPEN('log',logfile,fl) THEN
  DO
    IF ~OPEN('log',logfile,fl) THEN
      DO
        SAY 'failed to open log file'CR
        RETURN
     END
  END
CALL WRITELN('log','bbsDoors:' sendline)
CALL CLOSE('log')
RETURN


getinput:
PARSE ARG upflag' 'oneflag' 'pline
CALL checkdcd()
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
inarg=cleanstring(0':'inarg)
CALL checktime()
RETURN inarg


showtime:
IF ~frombb THEN RETURN
mins=TIME('E')%60
secs=TRUNC(TIME('E')//60)+1
IF secs>59 THEN secs=59
IF secs<10 THEN secs='0'secs
line=' Time:  Used' mins':'secs
mins=(maxtime-TIME('E'))%60
secs=TRUNC((maxtime-TIME('E'))//60)
IF secs<10 THEN secs='0'secs
line=line'   Remaining' mins':'secs
SAY def||line||CR

checktime:
IF ~frombb THEN RETURN
IF TIME('E')>maxtime THEN EXIT 0
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
CALL checkdcd()
RETURN


waiting:
CALL checktime()
IF waitchar='Q' THEN
  DO
    waitchar=''
    RETURN
  END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3'                          RETURN=Continue 'def
PULL waitchar
CALL checkdcd()
RETURN


checkdcd:
IF ~frombb THEN RETURN
dcd
IF RC=0 THEN
  DO
    DO dcds=1 TO 3  /* 5 second delay */
      CALL DELAY(50)
      dcd
      IF RC~=0 THEN RETURN
    END
    dcd
    IF RC=0 THEN EXIT
  END
xmsg=GETCLIP('BBS_MESSAGE')
IF xmsg~='' THEN
  DO
    CALL SETCLIP('BBS_MESSAGE')
    SAY CR
    SAY bak2' Message From BBBBS: 'def||CR
    SAY xmsg||CR
    SAY CR
    CALL waiting()
  END
IF POS('G',GETCLIP('BBS_COMMAND'))>0 THEN EXIT
RETURN


strip_ansi:
PARSE ARG aline 
n=POS('1B'x,aline)
DO WHILE n>0
  DO k=2
    IF DATATYPE(SUBSTR(aline,n+k,1),'M') | (n+k+1)>LENGTH(aline) THEN
      leave k
  END
  aline=DELSTR(aline,n,k+1)
  n=POS('1B'x,aline)
END
RETURN aline


cleanstring:
PARSE ARG nflag':'cstr
IF nflag=1 THEN
  DO
    cstr=COMPRESS(cstr,"'`")
    cstr=TRANSLATE(cstr,,namemask)
    cstr=SPACE(cstr,1,'_')
    RETURN cstr
  END
bot=XRANGE(,'1F'x)
IF nflag=2 THEN bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
ELSE cstr=strip_ansi(cstr)
top=XRANGE('7F'x)
cstr=COMPRESS(cstr,bot||top)
IF nflag=0 THEN cstr=STRIP(cstr)
RETURN cstr


postuser:
IF ~frombb | ~SHOW('P','BBSPOST') THEN RETURN
ptext=GETCLIP('BBSPOST4')
IF WORDS(ptext)>4 THEN ptext=LEFT(ptext,WORDINDEX(ptext,5)-1)
ptext=STRIP(ptext)
ptext=CENTER(ptext'   Door:' arg,74)
CALL SETCLIP('BBSPOST4',ptext)
ADDRESS BBSPOST 'UPDATE'
RETURN


bye:
BREAK_C:
IF frombb THEN CALL SETCLIP('BBS_door')
ELSE CALL SETCLIP('BBS_localdoor')
SAY CR
EXIT


FAILURE:
SYNTAX:
lin.1=''ERRORTEXT(RC)''
lin.2=SIGL-1     SOURCELINE(SIGL-1)
lin.3=SIGL ''SOURCELINE(SIGL)''
lin.4=SIGL+1     SOURCELINE(SIGL+1)
DO er=1 TO 4
  IF level>sysoplevel | ~frombb THEN SAY 'bbsDoors:' lin.er||CR
  IF frombb THEN CALL send2log(lin.er)
END
EXIT

/* bbsDoors.rexx */