home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 18 REXX
/
18-REXX.zip
/
rxcht10a.zip
/
chat.cmd
< prev
next >
Wrap
OS/2 REXX Batch file
|
1997-06-17
|
20KB
|
435 lines
/*┌─────────────────────────────────────────────────────────────────────────┐*\
┌┘ CHAT.CMD Client layer of REXXchat, an Internet chat system for OS/2. └┐
│ │
│ Product : REXXchat Client │
│ Author : Kevin Yank (kyank@ibm.net) │
│ Version : 1.0 │
│ Date : 17 June 1997 │
│ Revision: First Version │
│ │
└┐ FOR LICENSING, DISCLAIMER AND OTHER INFORMATION SEE REXXCHAT.INF ┌┘
\*└─────────────────────────────────────────────────────────────────────────┘*/
SIGNAL ON HALT
SIGNAL ON SYNTAX
START:
CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
CALL SysLoadFuncs
CALL RxFuncAdd 'PopSleep', 'POPPLAY', 'PopSleep'
CLIENTSTART:
/* Set Up Display Area */
CALL CHAROUT , "c" /* Reset Device */
CALL CHAROUT , "1H Welcome to REXXchat 1.0 by Kevin Yank /? for help "
CALL CHAROUT , "3r"
CALL CHAROUT , "1HD1H***
YOUR TERMINAL SHOULD SUPPORT VT100 AND BE CONFIGURED FOR AN 80X25 SCREEN.
"
CALL CHAROUT , "1HD1H***"
CALL CHAROUT , "1HD1H*** Connecting to REXXchat Server..."
QueueToServer = ''
QueueFromServer = ''
/* Check if server is running by checking for */
/* the existance of a queue called */
/* REXXCHAT_MAINT. */
MaintenanceQueue = RxQueue('CREATE', 'REXXCHAT_MAINT')
IF MaintenanceQueue = 'REXXCHAT_MAINT' THEN DO
CALL RxQueue 'DELETE', MaintenanceQueue
CALL CHAROUT , "1HD1H*** REXXchat Server not found!"
CALL CHAROUT , "1H*** PRESS ANY KEY TO QUIT ***"
CALL SysGetKey('NOECHO')
SIGNAL CLIENTEND
END
CALL RxQueue 'DELETE', MaintenanceQueue
/* Check if REXXchat can read the welcome */
/* message file. */
streamstatus = STREAM('welcome.txt', C, 'OPEN READ')
IF streamstatus <> 'READY:' THEN DO
CALL CHAROUT , "1HD1H*** REXXchat welcome message file error:" streamstatus
DROP streamstatus
CALL CHAROUT , "1H*** PRESS ANY KEY TO QUIT ***"
CALL SysGetKey('NOECHO')
SIGNAL CLIENTEND
END
/* Create a queue for the server to address this client */
QueueFromServer = RxQueue('CREATE')
/* Get nickname */
NewNick = InitialGetNick()
/* Request a connection from the server */
CALL RxQueue 'SET', 'REXXCHAT_MAINT'
DO UNTIL QueueToServer <> ""
CALL RxQueue 'SET', 'REXXCHAT_MAINT'
QUEUE "NewClientRequest" QueueFromServer NewNick
CALL RxQueue 'SET', QueueFromServer
DO WHILE Queued() = 0
CALL PopSleep 250
END
PULL QueueToServer
IF QueueToServer = "BADNICK" THEN DO
QueueToServer = ''
CALL CHAROUT , "1HD1H*** Nickname" NewNick "already in use!"
/* Get nickname */
NewNick = InitialGetNick()
END
END
CurrentNick = NewNick
DROP NewNick
CALL CHAROUT , "1HD1H*** Connected to REXXchat Server!"
CALL CHAROUT , "1H /? for help "
CALL CHAROUT , "1H <" || CurrentNick || "> not in a channel"
DO WHILE LINES("welcome.txt")
DROP streamstatus
WelcomeLine = LINEIN("welcome.txt")
CALL CHAROUT , "1HD1H*** " || WelcomeLine
END
CALL STREAM 'welcome.txt', C, 'CLOSE'
CharacterCount = 0 /* Number of chars on lowest command line at present */
Command = ''
EntryFieldSize = 1
/* Go into main client loop */
DO FOREVER
IF CHARS() THEN DO WHILE CHARS()
CALL CHAROUT , "" || 1 + CharacterCount || "H"
character = SysGetKey('NOECHO')
if c2d(character) = 8 THEN DO /* Backspace */
IF LENGTH(Command) > 0 THEN DO
IF LENGTH(Command) = 1 THEN Command = ''
ELSE
Command = SUBSTR(Command,1,LENGTH(Command) - 1)
IF CharacterCount > 0 THEN DO
CharacterCount = CharacterCount - 1
CALL CHAROUT , "D"
END
ELSE IF EntryFieldSize > 1 THEN DO
CharacterCount = 79
CALL ShrinkEntryField
CALL CHAROUT , "80H"
END
END
END
/*ELSE if c2d(character) = 224 THEN DO / Del, Ctrl-Del /
CALL SysGetKey 'NOECHO'
IF CharacterCount > 0 THEN DO
CharacterCount = CharacterCount - 1
IF CharacterCount = 0 THEN Command = ''
ELSE
Command = SUBSTR(Command,1,LENGTH(Command) - 1)
CALL CHAROUT , "D"
END
END*/
ELSE IF c2d(character) = 13 THEN DO
IF LENGTH(Command) > 0 THEN DO /* Enter */
CharacterCount = 0
CALL ResetEntryField
CALL ProcessCommand(Command)
Command = ''
END
END
ELSE IF c2d(character) = 7 THEN DO /* Bell */
CharacterCount = CharacterCount + 1
Command = Command || character
CALL CHAROUT , '
*
'
IF CharacterCount > 79 THEN DO
CALL ExpandEntryField
CharacterCount = 0
END
END
ELSE DO
CharacterCount = CharacterCount + 1
Command = Command || character
CALL CHAROUT , character
IF CharacterCount > 79 THEN DO
CALL ExpandEntryField
CharacterCount = 0
END
END
END
CALL RxQueue 'SET', QueueFromServer
IF Queued() > 0 THEN DO WHILE Queued() > 0
PARSE PULL MessageCode ' ' MessageBody
SELECT
WHEN MessageCode = "OUTPUT" THEN DO
/*IF LENGTH(MessageBody) > 80 THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Error Caught: Line greater than 80 characters received!"
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Please report to administrator!"
MessageBody = SUBSTR(MessageBody,1,80)
END*/
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H" || MessageBody
CALL CHAROUT , "" || 1 + CharacterCount || "H"
END
WHEN MessageCode = "NICKCHANGED" THEN DO
CurrentNick = MessageBody
CALL CHAROUT , "" || 25 - EntryFieldSize || ";1H /? for help "
CALL CHAROUT , "" || 25 - EntryFieldSize || ";1H <" || CurrentNick || "> on channel #main (public)"
CALL CHAROUT , "" || 1 + CharacterCount || "H"
END
WHEN MessageCode = "ENDSESSION" THEN DO
CALL RxQueue 'DELETE', QueueFromServer
SIGNAL CLIENTEND
END
OTHERWISE DO
SAY "Invalid Message in Client Maintenance Queue!"
SIGNAL CLIENTEND
END
END
DROP MessageCode MessageBody
END
CALL PopSleep 250
END
SIGNAL CLIENTEND
ExpandEntryField: PROCEDURE EXPOSE EntryFieldSize
EntryFieldSize = EntryFieldSize + 1
CALL CHAROUT , 'r' /* Scroll whole screen */
CALL CHAROUT , ',1HD' /* Scroll 1 row */
CALL CHAROUT , '' || ( 24 - EntryFieldSize ) || 'r' /* Scroll only display area */
CALL CHAROUT , ",1H" /* Home */
RETURN
ShrinkEntryField: PROCEDURE EXPOSE EntryFieldSize
EntryFieldSize = EntryFieldSize - 1
CALL CHAROUT , 'r' /* Scroll whole screen */
CALL CHAROUT , ',1HM' /* Scroll 1 row */
CALL CHAROUT , '' || ( 24 - EntryFieldSize ) || 'r' /* Scroll only display area */
CALL CHAROUT , ",1H" /* Home */
RETURN
ResetEntryField: PROCEDURE EXPOSE EntryFieldSize
DO i = 1 to EntryFieldSize /* Clear Entryfield */
CALL CHAROUT , '' || 26 - i || ';1H'
END
IF EntryFieldSize > 1 THEN DO UNTIL EntryFieldSize = 1
CALL ShrinkEntryField
END
RETURN
InitialGetNick:
CharacterCount = 0 /* Count of characters entered */
done = 0
Nick = ''
CALL CHAROUT , "1HPlease choose a nickname for yourself: "
DO UNTIL DONE
IF CHARS() THEN DO WHILE CHARS()
/* NEED TO ADD CODE FOR LONG LINES */
CALL CHAROUT , "" || 40 + CharacterCount || "H"
character = SysGetKey('NOECHO')
if c2d(character) = 8 THEN DO /* Backspace */
IF CharacterCount > 0 THEN DO
CharacterCount = CharacterCount - 1
IF CharacterCount = 0 THEN Nick = ''
ELSE
Nick = SUBSTR(Nick,1,LENGTH(NICK) - 1)
CALL CHAROUT , "D"
END
END
/*ELSE IF c2d(character) = 224 THEN DO / Del, Ctrl-Del /
CALL SysGetKey 'NOECHO'
IF CharacterCount > 0 THEN DO
CharacterCount = CharacterCount - 1
IF CharacterCount = 0 THEN Nick = ''
ELSE
Nick = SUBSTR(Nick,1,LENGTH(NICK) - 1)
CALL CHAROUT , "D"
END
END*/
ELSE IF c2d(character) = 13 THEN DO
IF CharacterCount > 0 THEN DO /* Enter */
PARSE VAR Nick Firstword Otherwords
IF LENGTH(Firstword) > 9 THEN DO
CALL CHAROUT , "1HD1H*** Invalid Nickname! (max 9 chars)"
CALL CHAROUT , "1HPlease choose a nickname for yourself: "
Nick = ''
CharacterCount = 0
END
ELSE IF Otherwords <> '' THEN DO
CALL CHAROUT , "1HD1H*** Invalid Nickname! (no spaces allowed)"
CALL CHAROUT , "1HPlease choose a nickname for yourself: "
Nick = ''
CharacterCount = 0
END
ELSE DO
done = 1
CALL CHAROUT , ",1H"
END
DROP Firstword Otherwords
END
END
ELSE IF c2d(character) = 7 THEN DO /* Bell */
NOP /* IGNORE */
END
ELSE DO
CharacterCount = CharacterCount + 1
Nick = Nick || character
CALL CHAROUT , character
END
END
CALL PopSleep 250
END
Nick = STRIP(Nick, 'LEADING')
RETURN Nick
ProcessCommand:
/* Routine for interpreting commands typed by the user */
PARSE ARG Command
IF SUBSTR(Command,1,1) = '/' THEN DO
/* The user is typing a command */
PARSE VAR Command CommandString ' ' Arguments
SELECT
WHEN TRANSLATE(CommandString) = '/MSG' THEN DO
Arguments = STRIP(Arguments, 'LEADING')
PARSE VAR Arguments TargetNick ' ' PrivateMessage
TargetNick = STRIP(TargetNick, 'LEADING')
IF ( TargetNick = '' ) | ( PrivateMessage = '' ) THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Syntax: /msg <targetnick> <privatemessage>"
END
ELSE DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'PRIVMSG' TargetNick PrivateMessage
END
DROP TargetNick PrivateMessage
END
WHEN TRANSLATE(CommandString) = '/DESCRIBE' THEN DO
Arguments = STRIP(Arguments, 'LEADING')
PARSE VAR Arguments TargetNick ' ' PrivateMessage
TargetNick = STRIP(TargetNick, 'LEADING')
IF ( TargetNick = '' ) | ( PrivateMessage = '' ) THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Syntax: /describe <targetnick> <privateaction>"
END
ELSE DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'PRIVDO' TargetNick PrivateMessage
END
DROP TargetNick PrivateMessage
END
WHEN TRANSLATE(CommandString) = '/NICK' THEN DO
Arguments = STRIP(Arguments, 'LEADING')
PARSE VAR Arguments Firstword Otherwords
IF Arguments = '' THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** You must specify a nickname!"
END
ELSE IF LENGTH(Firstword) > 9 THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Nickname! (max 9 chars)"
END
ELSE IF Otherwords <> '' THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Nickname! (no spaces allowed)"
END
ELSE DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'NICKCHANGEREQUEST' Arguments
END
DROP Firstword Otherwords
END
WHEN TRANSLATE(CommandString) = '/JOIN' THEN DO
Arguments = STRIP(Arguments)
PARSE VAR Arguments Firstword Otherwords
IF LENGTH(Firstword) > 10 THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Channel Name! (max 10 chars)"
END
ELSE IF Otherwords <> '' THEN DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Channel Name! (no spaces allowed)"
END
ELSE DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'JOINCHANNEL' Arguments
/* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
CALL CHAROUT , "1H /? for help "
CALL CHAROUT , "1H <" || CurrentNick || "> in channel " || Arguments || ""
/* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
END
DROP Firstword Otherwords
END
WHEN TRANSLATE(CommandString) = '/LEAVE' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'LEAVECHANNEL' Arguments
/* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
CALL CHAROUT , "1H /? for help "
CALL CHAROUT , "1H <" || CurrentNick || "> not in a channel"
/* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
END
WHEN TRANSLATE(CommandString) = '/QUIT' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'QUIT' Arguments
END
WHEN TRANSLATE(CommandString) = '/ME' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'DO' Arguments
END
WHEN TRANSLATE(CommandString) = '/NAMES' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'LISTCHANNELUSERS'
END
WHEN TRANSLATE(CommandString) = '/USERS' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'LISTUSERS'
END
WHEN TRANSLATE(CommandString) = '/LIST' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'LISTCHANNELS'
END
WHEN TRANSLATE(CommandString) = '/TOPIC' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'CHANGETOPIC' Arguments
END
WHEN TRANSLATE(CommandString) = '/CLEAR' THEN DO
CALL ClearWindow
END
WHEN CommandString = '/?' THEN DO
CALL RxQueue 'SET', QueueToServer
QUEUE 'HELP'
END
OTHERWISE DO
CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Command "CommandString" not recognized! /? for help."
END
END
DROP Arguments CommandString
END
ELSE DO
/* The user is saying something */
CALL RxQueue 'SET', QueueToServer
QUEUE 'SAY' Command
END
RETURN
ClearWindow:
/* User has requested that his display area be cleared */
CALL CHAROUT , "" || 24 - EntryFieldSize || ",1H"
CALL CHAROUT , "" || 1 + CharacterCount || "H"
RETURN
SYNTAX:
CALL CHAROUT , "r"
SAY
SAY "Abnormal program interruption!"
SAY 'A SYNTAX condition was raised on line' sigl'!'
SAY ' The error number is' rc', which means "'Errortext(rc)'"'
SAY ' That line is "'Sourceline(sigl)'"'
SAY ' Entering DEBUG mode.'
TRACE ?R
Nop
SIGNAL END
HALT:
CLIENTEND:
IF QueueToServer <> '' THEN
CALL RxQueue 'DELETE', QueueToServer
IF QueueToClient <> '' THEN
CALL RxQueue 'DELETE', QueueFromServer
CALL CHAROUT , "rc"
SIGNAL END
END:
EXIT(0)