/* $VER: bbsWrite.rexx 8.4 (26.1.95)
copyright © 1994-95 Richard Lee Stockton
BBBBS write & setup email or message
FREELY DISTRIBUTABLE
*/

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

OPTIONS RESULTS

SIGNAL ON BREAK_C
SIGNAL ON BREAK_E
SIGNAL ON FAILURE
SIGNAL ON SYNTAX

PARSE ARG name maxtime edtype toname orig msgnum msgdir subj 

CALL TIME('R')
IF toname='.' THEN toname=''
IF orig='.' THEN orig=''
subj=STRIP(subj)
namemask=COMPRESS(XRANGE(),XRANGE('A','Z')' _-')
lineup='1B'x'M'
CR=''
IF ADDRESS()='BAUD' THEN
  DO
    CR='0D'x
    frombb=1
  END
ELSE frombb=0
courtesy=''
thechosen.=''
CALL config()
IF ~loaddata() THEN
  DO
    SAY 'Userfile' name 'failed to open for reading!'CR
    EXIT 0
  END
SAY '                    'CR
def=''
pen3=''
bak2=''
IF colorflag=0 THEN
  DO
    def=''
    pen3=''
    bak2=''
  END
Friends.=''
IF OPEN(f,bbspath'Friends/'name,'R')~=0 THEN
  DO
    DO i=1
      Friends.i=READLN(f)
      IF EOF(f) THEN LEAVE i
    END
    Friends.0=i
    CALL CLOSE(f)
  END
IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
ELSE 
  DO
    IF OPEN(f,bbspath'Lists/Conferences','R')~=0 THEN
      DO
        msg.=''
        DO i=1
          line=READLN(f)
          IF line='END' | EOF(f) THEN LEAVE i
          num=WORD(line,1)
          IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
          IF num=msgdir THEN LEAVE i
        END
        CALL CLOSE(f)
      END
    IF edtype='MSG' THEN
      DO
        IF msgdir=0 THEN
          IF areaselect() THEN EXIT 0
      END
    lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
    IF edinfo(msgpath||msgdir'.txt',msg.msgdir,'Public Message Conference') THEN
      EXIT 0
  END
IF toname='' THEN
  DO
    IF edtype='MAIL' THEN
      DO
        CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
        toname=thechosen.1
      END
    ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
  END
toname=SPACE(toname,1,'_')
toname=cleanstring(1':'toname)
toname=check_alias(toname)
IF toname='' | FIND(exclusion,toname)>0 THEN
  DO
    IF toname='' & edtype='MSG' THEN toname='ALL'
    ELSE toname=sysop
    SAY pen3'*** Re-Addressed to'def toname||CR
  END
IF toname~='ALL' THEN
  DO
    IF toname='BBBBS' THEN toname=sysop
    IF ~EXISTS(bbspath'Users/'toname) THEN
      DO
        IF courtesy='' THEN CALL loadcourtesy()
        IF FIND(courtesy,toname)=0 THEN
          DO
            SAY CR
            SAY bak2' 'toname' is not on the user list! 'def||CR
            IF edtype='MAIL' THEN EXIT 0
            ELSE IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN EXIT 0
          END
      END
  END
IF frombb THEN
  DO
    IF toname=sysop THEN CALL sound('FEEDBACK')
    ELSE CALL sound('MESSAGE')
  END
IF edtype='MAIL' THEN
  DO
    CALL MAKEDIR(bbspath'EMail/'toname)
    mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  END
ELSE
  DO
    CALL MAKEDIR(msgpath||msgdir)
    mailname=msgpath||msgdir'/'lastwrit+1
  END
lynes.=''
lynes.0=6
IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
lynes.2=' From:' name
IF city~='' THEN lynes.2=lynes.2' - 'city
lynes.3='   To:' toname                       /*  To: toname   MSG # */
IF edtype='MAIL' THEN
  DO
    IF OPEN(f,bbspath||'Users/'toname,'R')~=0 THEN
      DO
        CALL READLN(f)
        CALL READLN(f)
        temp=READLN(f)
        CALL CLOSE(f)
        temp=docity(temp)
        IF temp~='' THEN lynes.3=lynes.3' - 'temp
      END
    IF subj='|@NEW@|' THEN
      DO
        CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
        subj='Welcome to' bbsname
      END
  END
IF edtype='REPLY' THEN
  DO
    SAY pen3'Subj:'def subj||CR
    temp=getinput(0 0 'Change the current subject? (Ny) > ')
    IF LENGTH(temp)>3 THEN subj=temp
    ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  END
IF subj='' THEN
  DO
    SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
    subj=getinput(0 0 pen3': 'def)
    IF level>sysoplevel THEN
      DO
        temp=bbspath'BBS_TEXT/SUBJ.'WORD(subj,1)
        IF EXISTS(temp) THEN
          IF getinput(1 1 'Use SUBJ.'WORD(subj,1)'? (nY) > ')~='N' THEN
            CALL readlines(temp 7)
      END
  END
IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
IF subj='' THEN subj='?'
lynes.4=' Subj:' subj
lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
lynes.6=LEFT('',74,'=')
IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
DO i=1 TO lynes.0
  SAY lynes.i||CR
END
IF frombb THEN temp='File'
ELSE temp='LOCAL'
CALL writebuffer(scratch'/Message'temp)
CALL DELETE(mailname)
IF savelines(mailname) THEN EXIT 0
CALL seelines(1)
IF thechosen.0='' THEN
  DO
    thechosen.0=1
    thechosen.1=toname
  END
carbons=thechosen.0+1
DO FOREVER
  IF thechosen.0>=carbons THEN
    DO
      junk='Copies To:'
      DO cci=carbons TO thechosen.0
        junk=junk thechosen.cci
      END
      SAY junk||CR
    END
  pline=''
  IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  junk=getinput(1 1 pline)
  IF junk='E' THEN
    DO
      IF level>sysoplevel THEN firstedit=1
      ELSE firstedit=7
      IF bbsEd.rexx(firstedit mailname name TRUNC(maxtime-TIME('E'))-28)=2 THEN EXIT 0
      junk='R'
    END
  ELSE IF edtype='MAIL' & junk='C' THEN
    DO
      CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
      junk='R'
    END
  ELSE IF junk='K' THEN
    DO
      IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR
      EXIT 0
    END
  ELSE IF junk='U' THEN
    DO
      CALL txup(mailname)
      junk='R'
    END
  IF junk='R' THEN
    DO
      CALL readlines(mailname 1)
      CALL seelines(1)
      nonstop=0
    END
  ELSE BREAK
END
IF edtype='MAIL' THEN
  DO
    IF orig~='' & toname~='' THEN
      DO
        IF toname=sysop THEN junk='Y'
        ELSE junk=getinput(1 1 'Attach original mail from' toname'? (nY) > ')
        IF junk~='N' THEN
          IF ~readlines(orig 1) THEN CALL savelines(mailname)
      END
    junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
    IF junk='Y' THEN
      DO
        savearg=arg
        arg=''
        IF frombb THEN arg=getinput(0 0 'Filename: ')
        curdir=PRAGMA('D')
        CALL MAKEDIR(bbspath'EmailFiles/'toname)
        CALL setdir(bbspath'EmailFiles/'toname)
        DO WHILE uload()=2
        END
        IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
          DO
            CALL readlines(mailname 1)
            IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
            CALL setdir(curdir)
            CALL DELETE(mailname)
            CALL savelines(mailname)
          END
        ELSE
          DO
            CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
            SAY pen3'*** Upload failed! ***'def||CR
          END
        arg=savearg
      END
    totmail=WORD(data.17,2)
    IF ~DATATYPE(totmail,'W') THEN totmail=1
    ELSE totmail=totmail+1
    data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  END
CALL readlines(mailname 1)
DO ui=1 TO thechosen.0
  IF thechosen.ui='' THEN ITERATE ui
  IF ui>1 THEN
    DO
      CALL MAKEDIR(bbspath'Email/'thechosen.ui)
      newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
      IF ui<carbons THEN lynes.3='   To:' thechosen.ui
      ELSE
        DO
          lynes.1=lynes.1'  (Carbon Copy)'
          lynes.3='   To:' thechosen.1
        END
      CALL savelines(newname)
      IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
        DO
          CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
          ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
          line2='Copied' WORD(lynes.1,4)
          SAY line2 'to the' thechosen.ui 'file area.'CR
          CALL send2log(line2)
        END
    END
  line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  IF edtype~='MAIL' THEN
    DO
      IF EXISTS(bbspath'Users/'thechosen.ui) THEN
        CALL msgmark(thechosen.ui msgdir lastwrit+1)
      line=line 'in' msg.msgdir
    END
  CALL send2log(line)
  line=edtype 'Sent To' thechosen.ui
  l2='in the' msg.msgdir 'conference.'
  IF edtype~='MAIL' THEN line=line l2
  IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=thechosen.ui THEN
    DO
      oldmess=GETCLIP('BBS_MESSAGE')
      IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
      IF edtype='MAIL' THEN l3='You have new Email.'
      ELSE l3='There is a new message addressed to you' l2
      CALL SETCLIP('BBS_MESSAGE',oldmess||l3)
    END
  SAY line||CR
END
IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
CALL setdir(libpath||dirs.1)
CALL savedata()
EXIT 1


msgmark:
PARSE ARG markname markdir markmsg .
IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN
mlines.=''
DO mi=1
  temp=READLN(f)
  IF EOF(f) THEN LEAVE mi
  mlines.mi=STRIP(temp)
END
CALL CLOSE(f)
mlines.0=mi-1
CALL DELAY(28)
mlines.24=STRIP(mlines.24 markdir'/'markmsg)
IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN
DO mi=1 TO mlines.0
  CALL WRITELN(f,mlines.mi)
END
CALL CLOSE(f)
RETURN


edinfo:
PARSE ARG t1,t2,t3
IF level<sysoplevel THEN RETURN 0
IF getinput(1 1 'Edit the'pen3 t2 def||t3 'info file? (Ny) > ')='Y' THEN
  DO
    IF ~EXISTS(t) THEN
      DO
        IF OPEN(f,t1,'W')~=0 THEN
          DO
            CALL WRITELN(f,TRIM(CENTER('***'pen3 t2 def||t3 '***',75)))
            CALL WRITELN(f,LEFT('',75,'='))
            CALL CLOSE(f)
            CALL DELAY(28)
          END
      END
    CALL bbsEd.rexx(1 t1 name TRUNC(maxtime-TIME('E'))-28)
    RETURN 1
  END
RETURN 0


areaselect:
SAY pen3||LEFT('-',75,'-')||def||CR
count=0
smsg.=''
DO i=1 TO level
  IF msg.i='' THEN ITERATE i
  count=count+1
  smsg.count=msg.i i
END
smsg.0=count
IF count>0 THEN CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
  tempnum=WORD(smsg.i,2)
  tempdir=WORD(smsg.i,1)
  IF FIND(data.21,tempnum)=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'.'
      IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
        string=string LEFT(tempdir,20)
      ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
      count=count+1
      msgs.count=string
    END
END
DROP smsg.
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
  DO j=1 TO 2
    k=i+j*msgs.0
    IF k<=count THEN msgs.i=msgs.i msgs.k
  END
END
DO i=1 TO msgs.0
  SAY msgs.i||CR
  IF i//linesperpage=0 & i<msgs.0 THEN CALL waiting()
END
temp=getinput(1 0 pen3'Select Message Conference: 'def)
IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
IF msg.temp='' THEN RETURN 1
msgdir=temp
RETURN 0


selectchosen:
PARSE ARG startat selectline
IF startat<2 THEN thechosen.=''
line='Enter list of comma separated user names'
IF level>sysoplevel THEN line=line 'or ALL'
SAY line||CR
thechosen.startat=getinput(1 0 selectline' ')
IF STRIP(thechosen.startat)='' THEN RETURN 1
thechosen.startat=SPACE(thechosen.startat,1,'_')
thechosen.0=startat
IF level>sysoplevel & thechosen.startat='ALL' THEN
  thechosen.startat=SHOWDIR(bbspath'Users','F',',')
IF POS(',',thechosen.startat)>0 THEN
  DO
    temp=TRANSLATE(thechosen.startat,' ',',')
    thechosen.0=thechosen.0+WORDS(temp)-1
    DO ei=1 TO WORDS(temp)
      eii=startat+ei-1
      thechosen.eii=STRIP(WORD(temp,ei))
    END
  END
DO ei=startat TO thechosen.0
  thechosen.ei=check_alias(thechosen.ei)
  DO WHILE ~EXISTS(bbspath'Users/'thechosen.ei)
    IF thechosen.ei~='' THEN
      DO
        IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
          DO
            thechosen.ei=sysop
            ITERATE ei
          END
        IF courtesy='' THEN CALL loadcourtesy()
        IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
      END
    SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
    thechosen.ei=getinput(1 0 pen3||selectline' 'def)
    IF thechosen.ei='' THEN
      DO
        IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
          IF readlines(bbspath'Lists/USERS' 1)=0 THEN CALL seelines(1)
        ITERATE ei
      END
    thechosen.ei=SPACE(thechosen.ei,1,'_')
  END
END
RETURN 0


loadcourtesy:
IF EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF OPEN(f,bbspath'Lists/Courtesy','R') THEN
      DO
        SAY 'Checking Courtesy List...'CR
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          line=cleanstring(1':'line)
          courtesy=courtesy line
        END
        CALL CLOSE(f)
      END
  END
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 cleanline(1)
CALL checkdcd()
RETURN


waiting2:
CALL checktime()
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
IF waitchar='N' THEN
  DO
    nonstop=1
    SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
    SAY CR
    CALL DELAY(99)
    waitchar=''
  END
CALL cleanline(1)
CALL checkdcd()
IF waitchar='Q' THEN RETURN 1
RETURN 0


seelines:
DO i=1 TO lynes.0
  IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
  ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
    SAY pen3||lynes.i||def||CR
  ELSE SAY lynes.i||CR
  IF i//linesperpage=0 & i<lynes.0 THEN
    IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN


readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF OPEN(f,tempname,'R')=0 THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
  line=READLN(f)
  IF EOF(f) THEN BREAK
  lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0


savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
  DO
    ok=OPEN(f,tempname,'A')
    IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
  END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
  DO
    line='***' tempname 'failed to open for saving!'
    CALL send2log(line)
    SAY line||CR
    RETURN 1
  END
DO wi=1 TO lynes.0
  CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0


setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
IF frombb THEN Data directory
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN


config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
    EXIT 0
  END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop=WORD(lynes.2,1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'CR
    EXIT 0
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
  DO
    SAY msgpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
msgpath=msgpath'MSG'
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
bbsprefs.=''
DO i=16 TO 41
  j=i-15
  bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  DO
    SAY spellpath 'does not exist!'CR
    bbsprefs.5=0
  END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
RETURN


writebuffer:
PARSE ARG bufname .
IF frombb THEN Capture OFF
CALL DELETE(bufname)
startnum=lynes.0+1
SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
IF EXISTS(bufname) THEN
  DO
    CALL DELAY(56)
    CALL DELETE(bufname)
    CALL DELAY(56)
  END
IF frombb THEN
  DO
    CaptWrap 74
    Send pen3
    Capture bufname
    Send def
    TimeOut 120
    DO bufloop=1
      Wait '/E,/S,RING,NO CARRIER'
      Status 'L'
      test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
      CALL checkdcd()
      IF test='/E' | test='/S' | test='/X' THEN LEAVE bufloop
    END
    IF test~='/X' THEN Send '\b\b'pen3
    Capture OFF
    CALL checkdcd()
    TimeOut maxidle
    SAY def||CR
    CALL readlines(bufname startnum)
    CALL wrapbuf(startnum)
    QUEUE CR
  END
ELSE
  DO
    DO bufloop=startnum
      PARSE PULL line
      IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
        LEAVE bufloop
      lynes.bufloop=line
    END
    lynes.0=bufloop-1
    CALL wrapbuf(startnum)
    CALL DELETE(bufname)
    CALL savelines(bufname)
    SAY
  END
RETURN


wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def||CR
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=cleanstring(2':'lynes.startnum)
DO wi=startnum WHILE wi<=lynes.0
  wj=wi+1
  lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  lynes.wj=cleanstring(2':'lynes.wj)
  IF LENGTH(lynes.wi)>75 THEN
    DO
      testchar=''
      IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
      IF testchar=' ' | testchar='.' | testchar=':' THEN
        DO
          DO wjj=lynes.0 TO wi+1 BY -1
            wk=wjj+1
            lynes.wk=lynes.wjj
          END
          lynes.wj=''
          lynes.0=lynes.0+1
        END
      DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
        IF WORDS(lynes.wi)=1 THEN
          lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
        lynes.wj=WORD(lynes.wi,wl) lynes.wj
        lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
      END
    END
END
RETURN


txup:
PARSE ARG uparg .
IF frombb THEN
  DO
    SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
    pline='Are you SURE your file is un-compressed text? (Ny) > '
    IF getinput(1 1 pline)~='Y' THEN RETURN
  END
savearg=arg
arg='Upload'
arg2='tempfile1'
IF frombb THEN arg=arg'File'
ELSE
  DO
    arg=arg'LOCAL'
    arg2=arg2'LOCAL'
  END
curdir=PRAGMA('D')
CALL setdir(scratch)
CALL DELETE(arg)
CALL DELETE(arg2)
IF uload()=0 THEN
  DO
    ADDRESS COMMAND 'C:copy' uparg scratch'/'arg2 'CLONE'
    CALL DELETE(uparg)
    ADDRESS COMMAND 'C:join' scratch'/'arg2 PRAGMA('D')'/'arg 'AS' uparg
  END
CALL readlines(uparg 1)
CALL setdir(curdir)
arg=savearg
RETURN


chpro:
arg=UPPER(LEFT(arg,1))
IF(arg='') THEN
  DO
    SAY CR
    SAY '['pen3'W'def']- WXModem'CR
    SAY '['pen3'X'def']- XModem-CRC'CR
    SAY '['pen3'K'def']- XModem-1K'CR
    SAY '['pen3'Y'def']- YModem'CR
    SAY '['pen3'G'def']- YModem-G'CR
    SAY '['pen3'Z'def']- ZModem'CR
    SAY CR
    arg=getinput(1 0 STRIP(protocol) '> ')
 END
IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
Set arg
Status Transfer
protocol=STRIP(RESULT)
SAY protocol||CR
RETURN


uload:
CALL bbsspace(12)
SAY CR
IF bbsk<1 THEN
  DO
    line='Upload area is full!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    RETURN 1
  END
IF frombb THEN
  DO
    checkproto='T'
    targ=arg
    DO WHILE checkproto='T'
      arg=''
      SAY CR
      SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
      pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
      pline=pline '['pen3'U'def']pload (qtU) > '
      checkproto=getinput(1 1 pline)
      IF checkproto='Q' THEN RETURN 1
      IF checkproto='T' THEN CALL chpro()
    END
    arg=targ
    CALL sound('UPLOAD')
    uploadtime=TIME('E')
    CALL checktime()
    SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
    DownLoad arg
    IF RC>0 THEN RETURN 2
    IF bbsXferStats.baud(14 arg colorflag protocol) THEN RETURN 2
    rbytes=WORD(STATEF(arg),2)
    IF rbytes<1 THEN
      DO
        CALL DELETE(arg)
        RETURN 2
      END
    temp=''
    DO WHILE temp~='N' & temp~='Y'
      temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
    END
    IF temp='N' THEN RETURN 2
  END
ELSE
  DO
    frompath=GETCLIP('BBS_frompath')
    IF frompath='' THEN frompath='RAM:'
    fdir=''
    DO loop=1
      fromfile=GetFile(150,36,frompath,'',' Select File to Upload ')
      IF fromfile='' THEN RETURN 1
      IF EXISTS(fromfile) THEN LEAVE loop
      SAY
      SAY fromfile 'does not exist!'
    END
    ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D') 'CLONE'
    rbytes=WORD(STATEF(fromfile),2)
    x=LASTPOS('/',fromfile)
    IF x=0 THEN x=POS(':',fromfile)
    IF x>0 THEN
      DO
        arg=SUBSTR(fromfile,x+1)
        fdir=LEFT(fromfile,x)
        IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
        CALL SETCLIP('BBS_frompath',fdir)
      END
    ELSE arg=fromfile
  END
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  DO
    SAY CR
    SAY pen3'***'def arg pen3'failed archive check!'def||CR
    SAY CR
    temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
    IF temp~='Y' THEN
      DO
        CALL DELETE(arg)
        SAY CR
        RETURN 2
      END
  END
IF ~frombb THEN RETURN 0
CALL bytes2user(14 rbytes)
ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
IF bbsprefs.9 & name~=sysop THEN
  DO
    newufile=bbspath'EMail/'sysop'/NEW_FILES'
    IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
    ELSE
      DO
        ok=OPEN(f,newufile,'W')
        IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***') 
      END
    IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
    CALL CLOSE(f)
  END
RETURN 0


bytes2user:
PARSE ARG indx bytes .
tfiles=WORD(data.indx,1)
tbytes=WORD(data.indx,3)
IF ~DATATYPE(tfiles,'W') THEN tfiles=0
IF ~DATATYPE(tbytes,'W') THEN tbytes=0
tbytes=tbytes+bytes
tfiles=tfiles+1
IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
ELSE data.indx='1 file' bytes 'bytes.'
data.indx=data.indx DATE()
CALL savedata(0)
RETURN


bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >'scratch'/infout' bbsdevice
ok=OPEN(f,scratch'/infout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY CR
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
  DO
    line=bbsdevice 'is not an info compatible device!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    bbsk=0
    RETURN
  END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
RETURN


comma: PROCEDURE
ARG num .
t=''
x=POS('.',num)
IF x>0 THEN t=SUBSTR(num,x)
num=num%1
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
  DO
    numtext=','LEFT(RIGHT(num,12),3)||numtext
    numtext=LEFT(num,dgt-12)||numtext
  END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext||t


loaddata:
IF name='' THEN RETURN 0
IF OPEN(f,bbspath'USERS/'name,'R')=0 THEN RETURN 0
data.=''
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK
  data.i=line
END
data.0=i-1
CALL CLOSE(f)
city=docity(data.3)
protocol=data.6
IF ~DATATYPE(data.7,'W') | data.7<5 THEN data.7=20
linesperpage=data.7
IF ~frombb THEN linesperpage=20
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
clr=''
IF FIND(UPPER(data.8),'CLEAR')>0 THEN clr='0C'x
level=data.20
RETURN 1


savedata:
IF OPEN(f,bbspath'USERS/'name,'W')=0 THEN RETURN
IF data.0<27 THEN data.0=27
DO i=1 TO data.0
  CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'CR
RETURN


sound:
ARG snd 
IF bbsprefs.13=1 THEN RETURN
ADDRESS AREXX bbsSounds.rexx bbspath'Sounds/' snd 
RETURN


check_alias:
ARG ali .
IF ~DATATYPE(Friends.0,'W') THEN RETURN ali
DO ii=1 TO Friends.0
  IF UPPER(WORD(Friends.ii,1))=ali THEN RETURN WORD(Friends.ii,2)
END
RETURN ali


docity:
PARSE ARG citi
citi=TRANSLATE(citi,'          ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
  IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)


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'
        RETURN
     END
  END
CALL WRITELN('log','bbsWrite:' sendline)
CALL CLOSE('log')
RETURN


checktime:
IF ~frombb THEN RETURN
IF TIME('E')>maxtime THEN EXIT
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


cleanline:
ARG lflag .
IF nonstop=0 & clr~='' THEN
  DO
    Send clr
    RETURN
  END
IF colorflag~=1 & lflag=1 THEN RETURN
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
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)
RETURN inarg


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


countcheck:
PARSE ARG fname' 'cknum .
IF ~EXISTS(fname) THEN
  DO
    IF cknum=0 THEN RETURN 0
    IF OPEN(f,fname,'W')=0 THEN RETURN 0
    CALL WRITELN(f,cknum)
    CALL CLOSE(f)
    RETURN cknum
  END
IF OPEN(f,fname,'R')=0 THEN
  DO
    CALL DELAY(99)
    IF OPEN(f,fname,'R')=0 THEN RETURN cknum
  END
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
  DO
    IF OPEN(f,fname,'W')~=0 THEN
      DO
        CALL WRITELN(f,cknum)
        CALL CLOSE(f)
        RETURN cknum
      END
  END
RETURN retval


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 0
  END
xmsg=GETCLIP('BBS_MESSAGE')
Capture
IF RC=0 & 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


BREAK_E:
i=999999
ri=999999
wi=999999
RETURN


BREAK_C:
EXIT 0


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 'bbsWrite:' lin.er||CR
  IF frombb THEN CALL send2log(lin.er)
END
EXIT 0

/* bbsWrite.rexx */