Enigma Amiga Life 113/EnigmaAmiga113CD.iso/software/on-line/amirsay/rexx/amirsay.amirx

Text File | 2000-04-20 | 12.2 KB | 538 lines

/* Program Written By Bruce Steers <[e-mail]> */
/* Using Clipper By Bruce Steers <[e-mail]> */

OPTIONS RESULTS

debug=0

amirc=0
go=0
nicknum=1

SIGNAL ON BREAK_C
/*SIGNAL ON ERROR*/

LF='0A'X
vers='$VER: AmIRSay.amirx 4.5 (09/04/00)'
ver=word(vers,3)

myecho='p='d2c(27)'b«AmIRSay» '
myintro='«AmIRSay»'

adr=address()
 IF index(adr,'AMIRC.')~=0 then do
 amircport=adr
 parse var adr 'AMIRC.' portnum .
 amirc=1
 end
 else do;
 p=show('p')
 parse var p 'AMIRC.' portnum .
   if portnum~="" then do
   address value 'AMIRC.'portnum
   amirc=1 ;
   end
   else do
   amirc=0
   end
 end

call addlib('rexxsupport.library',0,-30,0)
call addlib('rexxdossupport.library',0,-30,0)

parse source . . . prog .
lp=max(lastpos('/',prog),lastpos(':',prog))-1
parse var prog progpath +lp +1 progname
progname=strip(progname)

lp=max(lastpos('/',progpath),lastpos(':',progpath))
parse var progpath amircpath +lp .
progpath=progpath'/'

ownp='AMIRSAYRX.'portnum
overalert=""
parse arg args
ag=upper(word(args,1))

 if ag~="" then do
   select
   when index(ag,'-A')==1 then parse var ag '-A' overalert .
   when ag=='SAYN' then do; call irsgui(); address AMIRSAY 'COM GETNEW'; exit; end
   when ag=='SAYV' then do; sayme(vers); exit; end
   when ag=='SAYG' then do; call irsgui(); exit; end
   when ag=='SAYR' then do; 'say /ping'; call reload(); go=1; end;
   when ag=='SAYU' then do; 'say /ping'; address value 'AMIRSAYRX.'portnum; 'SAYU'; exit; end
   when ag=="SAY?" | ag=="SAYH" | ag=="SAYHELP" then do; call sayhelp();exit; end
    otherwise do;
    'say /ping'
    address value ownp
    interpret(args)
    exit
    end
   end
 end

call loadprefs()

if show('p',ownp) then do
if dstart==0 then call sayme('Error! AmIRSay already running at port AMIRC.'portnum)
else; call irsgui()
exit
end
else
op=openport(ownp)


ibase=showlist(l,'intuition.library',,a)
call forbid; scrA=next(ibase,56)
scrW=c2d(IMPORT(offset(scrA,12),2))
scrH=c2d(IMPORT(offset(scrA,14),2))
screen=word(IMPORT(next(scrA,26)),1)
call permit


call makemuicodes()

IF ~getsay() THEN do;call sayme('Error finding ''Say'' Command !'); exit(1); end

if amirc then do; 'getmynick'; mynick=RESULT;end; else; mynick='Brucey'

if overalert~="" then do; oa=alertchan; alertchan=overalert; end
if alertchan | overalert==1 then; call sayChan('V'ver' (^: 'mynick' is now in Speech Mode :^)')
else; call sayme('V'ver' (^: 'mynick' you are now in Speech Mode :^)')
if overalert~="" then alertchan=oa

 DO until go~=0
 drop comm; drop dest; drop prefix; drop rest

 call getvars()
call getrx()

 if debug then call sayme('"'rest'"')
/* parse var prefix nick '!' user '@' host .*/

   if comm=="PRIVMSG" then do

     if nick==mynick then do
     w1=upper(word(rest,1))
       select
       when w1==":SAY#" then call chanfunc(substr(rest,7))
       when w1==":SAYG" then call irsgui()
       when w1==":SAYV" then call sayme(vers)
       when w1==":SAYU" then do; call loadprefs ; call sayme('prefs Reloaded'); end
       when w1==":SAY?" | w1==":SAYH" | w1==":SAYHELP" then call sayhelp();
       when w1==":SAYQ" | (rest==":" & amirc==0) then go=1
       when w1==":SAYR" then call reload()
       otherwise nop
       end
     end

if index(rest,"ACTION ")==3 then do; rest=delstr(rest,1,9); rest=':'nick rest; end

   call dosay()
   end
 end

IF go~=0 THEN do
if alertchan then; call sayChan(mynick'''s AmIRSay 'ver' has Exited')
else; call sayme(mynick' your AmIRSay 'ver' has Exited')
end
call closeport ownp
Exit

chanfunc:

parse arg chan; chan=make#(word(chan,1))
select
 when upper(chan)=='#S' then do;
call open(th,'s:amirsay.cfg')
call open(nh,'T:AmIRSay.cfg','W')
at=0
do while at<5
ln=readln(th)
if at~=5 then call writeln(nh,ln)
if ln=='[¿]' then at=at+1
end
call close(th)
sme='Saved New Channel Ignore List, , '
do c=1 to nochan0
call writeln(nh,nochan.c)
sme=sme', 'nochan.c
end
call close(nh)
address command 'copy <>nil: clone T:AmIRSay.cfg s: QUIET'
call delete('T:AmIRSay.cfg')
call sayme(sme)
return;
end

 when upper(chan)=='#L' then do
  if nochan0>0 then do
   sme='Channel Ignore List , '
   do c=1 to nochan.0; sme=sme', 'nochan.c; end
  end
  else; sme='Not Ignoring Any Channels'
 call sayme(sme)
 return
 end
otherwise do
sme='';   do c=1 to nochan.0; sme=sme nochan.c; end

if chan=='#' then do; "getchannel" ; chan=result; end

 if index(upper(sme),upper(chan))~=0 then; call subnochan();
 else; call addnochan(1);
end
return

addnochan:
 if arg(1)==1 then do
 ln=chan
  do cc=1 to nochan0
  if upper(ln)==upper(nochan.cc) then do; call sayme('Channel 'nochan.cc' is already being Ignored in AmIRC.'portnum); return; end
  end
 call sayme('Adding 'chan' to the Ignore List')
 end
nochan0=nochan0+1
nochan.0 = nochan0
nochan.nochan0 = ln
return

make#: PROCEDURE; new=arg(1); if index(new,'#')~=1 then new='#'new; return new

subnochan:
if nochan0==0 then do; call sayme('There are no channels being ignored..'); return; end
 do cc=1 to nochan0
  if upper(chan)==upper(nochan.cc) then do;
  call sayme('Removing Ignore for Channel 'nochan.cc);
   do mc=cc to nochan0
   p1=mc+1
   nochan.mc=nochan.p1
   end
  nochan0=nochan0-1
  nochan.0 = nochan0
  return;
  end
 end

call sayme('Error . Channel 'chan' is not set to be ignored')
return

reload:
call open(h,'T:tmp','W')
call writeln(h,'/**/')
if show('p','AMIRSAY') then call writeln(h,'address ''AMIRSAY''; QUIT; address command ''run >nil: 'amircpath'AmIRSayPrefs PORT AMIRC.'portnum''' ; address command ''waitforport AMIRSAY''')
call writeln(h,'do while show(''p'','''ownp'''); call delay(30); end')
if ~amirc then call writeln(h,'address command ''rx <>con://///CLOSE 'prog'''')
else; call writeln(h,'address AMIRC.'portnum' ''say /rx amirsay''')
call close(h); address command 'run <>nil: rx t:tmp'
go=1;
return

dosay:
parse var rest ':' lin
 IF 0 < (privt.0) then do
  do c=1 to privt.0
  if index(lin,privt.c)==2 then return
  end
 end

call saytext()
return

loadprefs:
if ~exists('s:AmIRSay.cfg') then do
call open(ph,'s:AmIRSAY.cfg','W')
call writeln(ph,'-l0 -d1 -p1 -a1 -s0'LF'Hello, this is just a test')
call writeln(ph,'oic¿oh i see'LF'lol¿laughs outloud'LF'brb¿b right bak'LF'ic¿i see'LF'm8¿mate'LF'[¿]')
call writeln(ph,'*'LF'<'LF'>'LF'@'LF'^'LF'[¿]')
call writeln(ph,'Default¿-r -p100 -s200'LF'Girl¿-f -p270 -s200'LF'Man¿-m -p120 -s200[¿]')
call writeln(ph,'PING 'LF'SOUND 'LF'DCC 'LF'USERINFO 'LF'VERSION ')
call writeln(ph,'st bernard¿saint bernard[¿]')
call close(ph)
end

call open(ph, 's:AmIRSAY.cfg' )
ln = readln(ph)

 IF index(ln,'-')==0 then do  /* THEN IT's OLD Style Prefs */
 saynick =readln(ph)
 readln(ph) /* no mui obsolete */
 alertchan=1
 readln(ph); readln(ph); readln(ph)
 end
 else do
 parse var ln '-l' saynick . 0 '-a' alertchan . 0 '-s' dstart . 0 '-r' regnum .
 end
if alertchan=="" then alertchan=1
if dstart=="" then dstart=0
drop text.
drop mwd.
drop blank.
drop uvoice.
drop privt.
drop nochan.
text0=0
text.0=0
mwd0=0
mwd.0=0
blank0=0
blank.0=0
uvoice0=0
uvoice.0=0
privt0=0
privt.0=0
nochan0=0
nochan.0=0
doing=0

  do c=1 while ~eof(ph)
  ln=readln(ph)
  if ln=="" then leave
    select
    when doing==0 then; if ln=='[¿]' then; doing=doing+1; else; call addtext()
    when doing==1 then; if ln=='[¿]' then; doing=doing+1; else; call addblank()
    when doing==2 then; if ln=='[¿]' then; doing=doing+1; else; call adduv()
    when doing==3 then; if ln=='[¿]' then; doing=doing+1; else; call addprivt()
    when doing==4 then; if ln=='[¿]' then; doing=doing+1; else; call addmwords()
    when doing==5 then; if ln=='[¿]' then; doing=doing+1; else do; ln=make#(ln); call addnochan(); end
    otherwise nop
    end
  end
call close(ph)

return

addtext:
text0=text0+1
text.0 = text0
parse var ln text.text0.t_repl '¿' text.text0.t_with
text.text0.t_with = strip(text.text0.t_with)
return

addmwords:
mwd0=mwd0+1
mwd.0 = mwd0
parse var ln mwd.mwd0.t_repl '¿' mwd.mwd0.t_with
mwd.mwd0.t_with = strip(mwd.mwd0.t_with)
return

addblank:
blank0=blank0+1
blank.0 = blank0
blank.blank0 = ln
return

adduv:
uvoice0=uvoice0 + 1
uvoice.0 = uvoice0
parse var ln uvoice.uvoice0.uv_nick '¿' uvoice.uvoice0.uv_mode
uvoice.uvoice0.uv_mode = strip(uvoice.uvoice0.uv_mode)
return

addprivt:
privt0=privt0 + 1
privt.0 = privt0
privt.privt0 = ln
return

saytext:
if delstr(rest,1,1)=='AMIRSAY VERSION CHECK' then do; 'echo Sending AmIRSay Version Info to 'nick; 'RAW NOTICE 'nick' :<-- Using AmIRSay 'ver word(vers,4); end
if saynick then rest=':'nick'.' strip(rest,,':')
if nick ~= lastnick then call checkvoice()

if index(uvoice.nicknum.uv_mode,'-0')==1 THEN return
if nochan0>0 then do
do c=1 to nochan.0
if upper(dest)==upper(nochan.c) then return
end
end

cp=1
 do while cp~=0
 cp=index(rest,'')
   if cp~=0 then do
   cc=1
     do while cc>0
     nc=substr(rest,cp+cc,1)
     if datatype(nc)=='NUM' | nc==',' then do; ec=cc; cc=cc+1; end
     else; cc=-1
     end
   rest=delstr(rest,cp,ec+1)
   end
 end

   do c=1 to nom.0
   orest=rest
   rest=reptag(rest,nom.c,"")
   if orest~=rest then c=c-1
   end

 if 0 < text.0 then do
  do c=1 to text.0
  orest=rest
  rest=reptag(rest,text.c.t_repl,text.c.t_with,1)
  if orest~=rest then c=c-1
  end
 end

 if 0 < mwd.0 then do
  do c=1 to mwd.0
  orest=rest
  rest=reptag(rest,mwd.c.t_repl,mwd.c.t_with)
  if orest~=rest then c=c-1
  end
 end

 if 0 < blank.0 then do
  do c=1 to blank.0
  orest=rest
  rest=reptag(rest,blank.c," ")
  if orest~=rest then c=c-1
  end
 end

rest=reptag(rest,';',"")

/*say sayc' <>nil: 'uvoice.nicknum.uv_mode' 'substr(rest,2)*/


ADDRESS COMMAND sayc' <>nil: 'uvoice.nicknum.uv_mode' 'substr(rest,2)

rest=''
return

reptag: PROCEDURE  /* replaces text for text */
parse arg ln , tag , rep , word1; word1=strip(word1)
p=1

ln=substr(ln,2)


 if word1=="" then do
    do until p<1
    p=index(upper(ln),upper(tag),p)
        if p~=0 then do
      ln=delstr(ln,p,length(tag))
      ln=insert(rep,ln,p-1)
      /*p=p+1*/
        end
    end
 end
 else do
    do c=1 to words(ln)
        if upper(word(ln,c))==upper(tag) then do
        ps=wordindex(ln,c)
      ln=delstr(ln,ps,length(tag))
      ln=insert(rep,ln,ps-1)
      /*p=p+1*/
        end
    end
 end
return ':'ln

checkvoice:
if uvoice.0 == 0 then return
lastnick = nick
nicknum=1
 do c=1 to uvoice.0
 if nick == uvoice.c.uv_nick then nicknum = c
 end
return

getvars:
 if Amirc then do
 'getline'
 comm=line.command
 dest=line.dest
 rest=translate(line.rest,"'","`")
 prefix=line.prefix
 parse var prefix nick '!' host .
 getmynick
 mynick=result
 return
 end

call writech(STDOUT, 'enter line: ')
rest=':'readln(STDIN)
comm='PRIVMSG'
dest='#Amiga'
prefix='Brucey!~[e-mail]'
parse var prefix nick '!' host .
mynick='Brucey'
return

SayChan:
if amirc then; 'say 'myintro arg(1)
else; say 'CHAN: 'arg(1)
return

SayMe:
if amirc then; 'echo 'myecho arg(1)
else; say 'PRIV: 'arg(1)
return

sayhelp:
call sayme('AmIRSAY By Bruce.  ( commands are case insensitive)')
call sayme('')
call sayme(' AmIRSay has the following commands ....')
call sayme('either /msg yourself or use /rx amirsay <command>')
call sayme('or send the relevant AMIRC Port the commands')
call sayme('SAYV   = Get AmIRSay''s Version')
call sayme('SAYG   = Load the AmIRSAYPrefs GUI')
call sayme('SAYU   = Update settings')
call sayme('SAYQ   = Quit AmIRSAY')
call sayme(' SAY? SAYHELP or SAYH = Calls this help text')
call sayme('')
return

irsgui:
if ~show('p','AMIRSAY') then do
 address command 'run >nil: 'amircpath'AmIRSayPrefs PORT 'address()
 address command 'waitforport AMIRSAY'
end
else do
 address AMIRSAY 'show'
 address AMIRSAY 'COM ToFront'
 end
return

makemuicodes:
nom.1=''; nom.2=''; nom.3=''; nom.4=''; nom.5=''; nom.0=5
return

BREAK_C:
IF alertchan THEN; call saychan(myintro' V'ver' has Quit (Ctrl_C Detected)');
else; call sayme(myintro' V'ver' has Quit (Ctrl_C Detected)');
exit(0);
return

getsay:
sayc='sys:utilities/say' ; if exists(sayc) THEN return(1)
sayc='C:say' ; if exists(sayc) THEN return(1)
sayc='sys:system/say' ; if exists(sayc) THEN return(1)
sayc='say' ; if exists(sayc) THEN return(1)
return (0)

getrx:
rt=0
pkt=getpkt(ownp)
if pkt~=null() then do
rxa=getarg(pkt)
parse var rxa rxarg rxparam ; rxparam=strip(rxparam)
rxarg=upper(rxarg)

select
when rxarg=='SAYV' then call sayme(vers)
when rxarg=='SAYG' then call irsgui()
when rxarg=='SAY#' then call chanfunc(rxparam)
when rxarg=='SAYQ' then do;call sayme('Quitting..'); exit(0) ; end
when rxarg=='SAYU' then do; call loadprefs ; call sayme('prefs Reloaded'); end
otherwise rt=5
end
call reply(pkt,rt)
end
return

ERROR: 'echo line 'SIGL; exit