home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1997 August / PCO0897.ISO / filesbbs / os2 / rxcht10a.arj / RXCHT10A.ZIP / chat.cmd < prev    next >
Encoding:
Text File  |  1997-06-17  |  19.2 KB  |  435 lines
  1. /*┌─────────────────────────────────────────────────────────────────────────┐*\
  2.  ┌┘ CHAT.CMD  Client layer of REXXchat, an Internet chat system for OS/2.   └┐
  3.  │                                                                           │
  4.  │      Product :       REXXchat Client                                      │
  5.  │      Author  :       Kevin Yank (kyank@ibm.net)                           │
  6.  │      Version :       1.0                                                  │
  7.  │      Date    :       17 June 1997                                         │
  8.  │      Revision:       First Version                                        │
  9.  │                                                                           │
  10.  └┐    FOR LICENSING, DISCLAIMER AND OTHER INFORMATION SEE REXXCHAT.INF     ┌┘
  11. \*└─────────────────────────────────────────────────────────────────────────┘*/
  12.  
  13. SIGNAL ON HALT
  14. SIGNAL ON SYNTAX
  15.  
  16. START:
  17.  
  18.     CALL RxFuncAdd 'SysLoadFuncs', 'RexxUtil', 'SysLoadFuncs'
  19.     CALL SysLoadFuncs
  20.     CALL RxFuncAdd 'PopSleep', 'POPPLAY', 'PopSleep'
  21.  
  22. CLIENTSTART:
  23.  
  24.     /* Set Up Display Area */
  25.     CALL CHAROUT , "c" /* Reset Device */
  26.     CALL CHAROUT , "1H Welcome to REXXchat 1.0 by Kevin Yank                          /? for help    "
  27.     CALL CHAROUT , "3r"
  28.  
  29.     CALL CHAROUT , "1HD1H*** YOUR TERMINAL SHOULD SUPPORT VT100 AND BE CONFIGURED FOR AN 80X25 SCREEN."
  30.     CALL CHAROUT , "1HD1H***"
  31.     CALL CHAROUT , "1HD1H*** Connecting to REXXchat Server..."
  32.  
  33.     QueueToServer   = ''
  34.     QueueFromServer = ''
  35.     
  36.     /* Check if server is running by checking for */
  37.     /* the existance of a queue called            */
  38.     /* REXXCHAT_MAINT.                            */
  39.     MaintenanceQueue = RxQueue('CREATE', 'REXXCHAT_MAINT')
  40.     IF MaintenanceQueue = 'REXXCHAT_MAINT' THEN DO
  41.         CALL RxQueue 'DELETE', MaintenanceQueue
  42.         CALL CHAROUT , "1HD1H*** REXXchat Server not found!"
  43.         CALL CHAROUT , "1H*** PRESS ANY KEY TO QUIT ***"
  44.         CALL SysGetKey('NOECHO')
  45.         SIGNAL CLIENTEND
  46.         END
  47.     CALL RxQueue 'DELETE', MaintenanceQueue
  48.  
  49.     /* Check if REXXchat can read the welcome     */
  50.     /* message file.                              */
  51.     streamstatus = STREAM('welcome.txt', C, 'OPEN READ')
  52.     IF streamstatus <> 'READY:' THEN DO
  53.         CALL CHAROUT , "1HD1H*** REXXchat welcome message file error:" streamstatus
  54.         DROP streamstatus
  55.         CALL CHAROUT , "1H*** PRESS ANY KEY TO QUIT ***"
  56.         CALL SysGetKey('NOECHO')
  57.         SIGNAL CLIENTEND
  58.         END
  59.  
  60.     /* Create a queue for the server to address this client */
  61.     QueueFromServer = RxQueue('CREATE')
  62.     
  63.     /* Get nickname */
  64.     NewNick = InitialGetNick()
  65.     
  66.     /* Request a connection from the server */
  67.     CALL RxQueue 'SET', 'REXXCHAT_MAINT'
  68.  
  69.     DO UNTIL QueueToServer <> ""
  70.         CALL RxQueue 'SET', 'REXXCHAT_MAINT'
  71.         QUEUE "NewClientRequest" QueueFromServer NewNick
  72.         CALL RxQueue 'SET', QueueFromServer
  73.         DO WHILE Queued() = 0
  74.             CALL PopSleep 250
  75.             END
  76.         PULL QueueToServer
  77.         IF QueueToServer = "BADNICK" THEN DO
  78.             QueueToServer = ''
  79.             CALL CHAROUT , "1HD1H*** Nickname" NewNick "already in use!"
  80.             /* Get nickname */
  81.             NewNick = InitialGetNick()
  82.             END
  83.         END
  84.  
  85.     CurrentNick = NewNick
  86.     DROP NewNick
  87.     
  88.     CALL CHAROUT , "1HD1H*** Connected to REXXchat Server!"
  89.     CALL CHAROUT , "1H                                                                    /? for help "
  90.     CALL CHAROUT , "1H <" || CurrentNick || "> not in a channel"
  91.     DO WHILE LINES("welcome.txt")
  92.         DROP streamstatus
  93.         WelcomeLine = LINEIN("welcome.txt")
  94.         CALL CHAROUT , "1HD1H*** " || WelcomeLine
  95.         END
  96.     CALL STREAM 'welcome.txt', C, 'CLOSE'
  97.     
  98.     CharacterCount = 0 /* Number of chars on lowest command line at present */
  99.     Command = ''
  100.     EntryFieldSize = 1
  101.     
  102.     /* Go into main client loop */
  103.     DO FOREVER
  104.         IF CHARS() THEN DO WHILE CHARS()
  105.             CALL CHAROUT , "" || 1 + CharacterCount || "H"
  106.             character = SysGetKey('NOECHO')
  107.             if c2d(character) = 8 THEN DO /* Backspace */
  108.                 IF LENGTH(Command) > 0 THEN DO
  109.                     IF LENGTH(Command) = 1 THEN Command = ''
  110.                     ELSE
  111.                         Command = SUBSTR(Command,1,LENGTH(Command) - 1)
  112.                     IF CharacterCount > 0 THEN DO
  113.                         CharacterCount = CharacterCount - 1
  114.                         CALL CHAROUT , "D"
  115.                         END
  116.                     ELSE IF EntryFieldSize > 1 THEN DO
  117.                         CharacterCount = 79
  118.                         CALL ShrinkEntryField
  119.                         CALL CHAROUT , "80H"
  120.                         END
  121.                     END
  122.                 END
  123.             /*ELSE if c2d(character) = 224 THEN DO / Del, Ctrl-Del /
  124.                 CALL SysGetKey 'NOECHO'
  125.                 IF CharacterCount > 0 THEN DO
  126.                     CharacterCount = CharacterCount - 1
  127.                     IF CharacterCount = 0 THEN Command = ''
  128.                     ELSE
  129.                         Command = SUBSTR(Command,1,LENGTH(Command) - 1)
  130.                     CALL CHAROUT , "D"
  131.                     END
  132.                 END*/
  133.             ELSE IF c2d(character) = 13 THEN DO
  134.                 IF LENGTH(Command) > 0 THEN DO /* Enter */
  135.                     CharacterCount = 0
  136.                     CALL ResetEntryField
  137.                     CALL ProcessCommand(Command)
  138.                     Command = ''
  139.                     END
  140.                 END
  141.             ELSE IF c2d(character) = 7 THEN DO /* Bell */
  142.                 CharacterCount = CharacterCount + 1
  143.                 Command = Command || character
  144.                 CALL CHAROUT , '*'
  145.                 IF CharacterCount > 79 THEN DO
  146.                     CALL ExpandEntryField
  147.                     CharacterCount = 0
  148.                     END
  149.                 END
  150.             ELSE DO
  151.                 CharacterCount = CharacterCount + 1
  152.                 Command = Command || character
  153.                 CALL CHAROUT , character
  154.                 IF CharacterCount > 79 THEN DO
  155.                     CALL ExpandEntryField
  156.                     CharacterCount = 0
  157.                     END
  158.                 END
  159.             END
  160.         CALL RxQueue 'SET', QueueFromServer
  161.         IF Queued() > 0 THEN DO WHILE Queued() > 0
  162.             PARSE PULL MessageCode ' ' MessageBody
  163.             SELECT
  164.                 WHEN MessageCode = "OUTPUT" THEN DO
  165.                     /*IF LENGTH(MessageBody) > 80 THEN DO
  166.                         CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Error Caught: Line greater than 80 characters received!"
  167.                         CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H***               Please report to administrator!"
  168.                         MessageBody = SUBSTR(MessageBody,1,80)
  169.                         END*/
  170.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H" || MessageBody
  171.                     CALL CHAROUT , "" || 1 + CharacterCount || "H"
  172.                     END
  173.                 WHEN MessageCode = "NICKCHANGED" THEN DO
  174.                     CurrentNick = MessageBody
  175.                     CALL CHAROUT , "" || 25 - EntryFieldSize || ";1H                                                                    /? for help "
  176.                     CALL CHAROUT , "" || 25 - EntryFieldSize || ";1H <" || CurrentNick || "> on channel #main (public)"
  177.                     CALL CHAROUT , "" || 1 + CharacterCount || "H"
  178.                     END
  179.                 WHEN MessageCode = "ENDSESSION" THEN DO
  180.                     CALL RxQueue 'DELETE', QueueFromServer
  181.                     SIGNAL CLIENTEND
  182.                     END
  183.                 OTHERWISE DO
  184.                     SAY "Invalid Message in Client Maintenance Queue!"
  185.                     SIGNAL CLIENTEND
  186.                     END
  187.                 END
  188.             DROP MessageCode MessageBody
  189.             END
  190.  
  191.         CALL PopSleep 250
  192.         END
  193.  
  194.     SIGNAL CLIENTEND
  195.  
  196. ExpandEntryField: PROCEDURE EXPOSE EntryFieldSize
  197.     EntryFieldSize = EntryFieldSize + 1
  198.     CALL CHAROUT , 'r' /* Scroll whole screen */
  199.     CALL CHAROUT , ',1HD' /* Scroll 1 row */
  200.     CALL CHAROUT , '' || ( 24 - EntryFieldSize ) || 'r' /* Scroll only display area */
  201.     CALL CHAROUT , ",1H" /* Home */
  202.     RETURN
  203.  
  204. ShrinkEntryField: PROCEDURE EXPOSE EntryFieldSize
  205.     EntryFieldSize = EntryFieldSize - 1
  206.     CALL CHAROUT , 'r' /* Scroll whole screen */
  207.     CALL CHAROUT , ',1HM' /* Scroll 1 row */
  208.     CALL CHAROUT , '' || ( 24 - EntryFieldSize ) || 'r' /* Scroll only display area */
  209.     CALL CHAROUT , ",1H" /* Home */
  210.     RETURN
  211.  
  212. ResetEntryField: PROCEDURE EXPOSE EntryFieldSize
  213.     DO i = 1 to EntryFieldSize /* Clear Entryfield */
  214.         CALL CHAROUT , '' || 26 - i || ';1H'
  215.         END
  216.     IF EntryFieldSize > 1 THEN DO UNTIL EntryFieldSize = 1
  217.         CALL ShrinkEntryField
  218.         END
  219.     RETURN
  220.     
  221. InitialGetNick:
  222.     CharacterCount = 0 /* Count of characters entered */
  223.     done = 0
  224.     Nick = ''
  225.     CALL CHAROUT , "1HPlease choose a nickname for yourself: "
  226.     DO UNTIL DONE
  227.         IF CHARS() THEN DO WHILE CHARS()
  228.             /* NEED TO ADD CODE FOR LONG LINES */
  229.             CALL CHAROUT , "" || 40 + CharacterCount || "H"
  230.             character = SysGetKey('NOECHO')
  231.             if c2d(character) = 8 THEN DO /* Backspace */
  232.                 IF CharacterCount > 0 THEN DO
  233.                     CharacterCount = CharacterCount - 1
  234.                     IF CharacterCount = 0 THEN Nick = ''
  235.                     ELSE
  236.                         Nick = SUBSTR(Nick,1,LENGTH(NICK) - 1)
  237.                     CALL CHAROUT , "D"
  238.                     END
  239.                 END
  240.             /*ELSE IF c2d(character) = 224 THEN DO / Del, Ctrl-Del /
  241.                 CALL SysGetKey 'NOECHO'
  242.                 IF CharacterCount > 0 THEN DO
  243.                     CharacterCount = CharacterCount - 1
  244.                     IF CharacterCount = 0 THEN Nick = ''
  245.                     ELSE
  246.                         Nick = SUBSTR(Nick,1,LENGTH(NICK) - 1)
  247.                     CALL CHAROUT , "D"
  248.                     END
  249.                 END*/
  250.             ELSE IF c2d(character) = 13 THEN DO
  251.                 IF CharacterCount > 0 THEN DO /* Enter */
  252.                     PARSE VAR Nick Firstword Otherwords
  253.                     IF LENGTH(Firstword) > 9 THEN DO
  254.                         CALL CHAROUT , "1HD1H*** Invalid Nickname! (max 9 chars)"
  255.                         CALL CHAROUT , "1HPlease choose a nickname for yourself: "
  256.                         Nick = ''
  257.                         CharacterCount = 0
  258.                         END
  259.                     ELSE IF Otherwords <> '' THEN DO
  260.                         CALL CHAROUT , "1HD1H*** Invalid Nickname! (no spaces allowed)"
  261.                         CALL CHAROUT , "1HPlease choose a nickname for yourself: "
  262.                         Nick = ''
  263.                         CharacterCount = 0
  264.                         END
  265.                     ELSE DO
  266.                         done = 1
  267.                         CALL CHAROUT , ",1H"
  268.                         END                    
  269.                     DROP Firstword Otherwords
  270.                     END
  271.                 END
  272.             ELSE IF c2d(character) = 7 THEN DO /* Bell */
  273.                 NOP /* IGNORE */
  274.                 END
  275.             ELSE DO
  276.                 CharacterCount = CharacterCount + 1
  277.                 Nick = Nick || character
  278.                 CALL CHAROUT , character
  279.                 END
  280.             END
  281.         CALL PopSleep 250
  282.         END
  283.     Nick = STRIP(Nick, 'LEADING')
  284.     RETURN Nick
  285.  
  286. ProcessCommand:
  287. /* Routine for interpreting commands typed by the user */
  288.     PARSE ARG Command
  289.     IF SUBSTR(Command,1,1) = '/' THEN DO
  290.         /* The user is typing a command */
  291.         PARSE VAR Command CommandString ' ' Arguments
  292.         SELECT
  293.             WHEN TRANSLATE(CommandString) = '/MSG' THEN DO
  294.                 Arguments = STRIP(Arguments, 'LEADING')
  295.                 PARSE VAR Arguments TargetNick ' ' PrivateMessage
  296.                 TargetNick = STRIP(TargetNick, 'LEADING')
  297.                 IF ( TargetNick = '' ) | ( PrivateMessage = '' ) THEN DO
  298.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Syntax: /msg <targetnick> <privatemessage>"
  299.                     END
  300.                 ELSE DO
  301.                     CALL RxQueue 'SET', QueueToServer
  302.                     QUEUE 'PRIVMSG' TargetNick PrivateMessage
  303.                     END
  304.                 DROP TargetNick PrivateMessage
  305.                 END
  306.             WHEN TRANSLATE(CommandString) = '/DESCRIBE' THEN DO
  307.                 Arguments = STRIP(Arguments, 'LEADING')
  308.                 PARSE VAR Arguments TargetNick ' ' PrivateMessage
  309.                 TargetNick = STRIP(TargetNick, 'LEADING')
  310.                 IF ( TargetNick = '' ) | ( PrivateMessage = '' ) THEN DO
  311.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Syntax: /describe <targetnick> <privateaction>"
  312.                     END
  313.                 ELSE DO
  314.                     CALL RxQueue 'SET', QueueToServer
  315.                     QUEUE 'PRIVDO' TargetNick PrivateMessage
  316.                     END
  317.                 DROP TargetNick PrivateMessage
  318.                 END
  319.             WHEN TRANSLATE(CommandString) = '/NICK' THEN DO
  320.                 Arguments = STRIP(Arguments, 'LEADING')
  321.                 PARSE VAR Arguments Firstword Otherwords
  322.                 IF Arguments = '' THEN DO
  323.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** You must specify a nickname!"
  324.                     END
  325.                 ELSE IF LENGTH(Firstword) > 9 THEN DO
  326.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Nickname! (max 9 chars)"
  327.                     END
  328.                 ELSE IF Otherwords <> '' THEN DO
  329.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Nickname! (no spaces allowed)"
  330.                     END
  331.                 ELSE DO
  332.                     CALL RxQueue 'SET', QueueToServer
  333.                     QUEUE 'NICKCHANGEREQUEST' Arguments
  334.                     END
  335.                 DROP Firstword Otherwords
  336.                 END
  337.             WHEN TRANSLATE(CommandString) = '/JOIN' THEN DO
  338.                 Arguments = STRIP(Arguments)
  339.                 PARSE VAR Arguments Firstword Otherwords
  340.                 IF LENGTH(Firstword) > 10 THEN DO
  341.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Channel Name! (max 10 chars)"
  342.                     END
  343.                 ELSE IF Otherwords <> '' THEN DO
  344.                     CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Invalid Channel Name! (no spaces allowed)"
  345.                     END
  346.                 ELSE DO
  347.                     CALL RxQueue 'SET', QueueToServer
  348.                     QUEUE 'JOINCHANNEL' Arguments
  349.                     /* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
  350.                     CALL CHAROUT , "1H                                                                    /? for help "
  351.                     CALL CHAROUT , "1H <" || CurrentNick || "> in channel " || Arguments || ""
  352.                     /* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */                    
  353.                     END
  354.                 DROP Firstword Otherwords
  355.                 END
  356.             WHEN TRANSLATE(CommandString) = '/LEAVE' THEN DO
  357.                 CALL RxQueue 'SET', QueueToServer
  358.                 QUEUE 'LEAVECHANNEL' Arguments
  359.                 /* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
  360.                 CALL CHAROUT , "1H                                                                    /? for help "
  361.                 CALL CHAROUT , "1H <" || CurrentNick || "> not in a channel"
  362.                 /* SHOULD BE MOVED TO A RESPONSE TO A CONFIRMING MESSAGE FROM SERVER */
  363.                 END
  364.             WHEN TRANSLATE(CommandString) = '/QUIT' THEN DO
  365.                 CALL RxQueue 'SET', QueueToServer
  366.                 QUEUE 'QUIT' Arguments
  367.                 END
  368.             WHEN TRANSLATE(CommandString) = '/ME' THEN DO
  369.                 CALL RxQueue 'SET', QueueToServer
  370.                 QUEUE 'DO' Arguments
  371.                 END
  372.             WHEN TRANSLATE(CommandString) = '/NAMES' THEN DO
  373.                 CALL RxQueue 'SET', QueueToServer
  374.                 QUEUE 'LISTCHANNELUSERS'
  375.                 END
  376.             WHEN TRANSLATE(CommandString) = '/USERS' THEN DO
  377.                 CALL RxQueue 'SET', QueueToServer
  378.                 QUEUE 'LISTUSERS'
  379.                 END
  380.             WHEN TRANSLATE(CommandString) = '/LIST' THEN DO
  381.                 CALL RxQueue 'SET', QueueToServer
  382.                 QUEUE 'LISTCHANNELS'
  383.                 END
  384.             WHEN TRANSLATE(CommandString) = '/TOPIC' THEN DO
  385.                 CALL RxQueue 'SET', QueueToServer
  386.                 QUEUE 'CHANGETOPIC' Arguments
  387.                 END
  388.             WHEN TRANSLATE(CommandString) = '/CLEAR' THEN DO
  389.                 CALL ClearWindow
  390.                 END
  391.             WHEN CommandString = '/?' THEN DO
  392.                 CALL RxQueue 'SET', QueueToServer
  393.                 QUEUE 'HELP'
  394.                 END
  395.             OTHERWISE DO
  396.                 CALL CHAROUT , "" || 24 - EntryFieldSize || ";1HD" || 24 - EntryFieldSize || ";1H*** Command "CommandString" not recognized! /? for help."
  397.                 END
  398.             END
  399.         DROP Arguments CommandString
  400.         END
  401.     ELSE DO
  402.         /* The user is saying something */
  403.         CALL RxQueue 'SET', QueueToServer
  404.         QUEUE 'SAY' Command
  405.         END
  406.     RETURN
  407.  
  408. ClearWindow:
  409. /* User has requested that his display area be cleared */
  410.     CALL CHAROUT , "" || 24 - EntryFieldSize || ",1H"
  411.     CALL CHAROUT , "" || 1 + CharacterCount || "H"
  412.     RETURN
  413.     
  414. SYNTAX:
  415.     CALL CHAROUT , "r"
  416.     SAY
  417.     SAY "Abnormal program interruption!"
  418.     SAY 'A SYNTAX condition was raised on line' sigl'!'
  419.     SAY '  The error number is' rc', which means "'Errortext(rc)'"'
  420.     SAY '  That line is "'Sourceline(sigl)'"'
  421.     SAY '  Entering DEBUG mode.'
  422.     TRACE ?R
  423.     Nop
  424.     SIGNAL END
  425. HALT:
  426. CLIENTEND:
  427.     IF QueueToServer <> '' THEN
  428.         CALL RxQueue 'DELETE', QueueToServer
  429.     IF QueueToClient <> '' THEN
  430.         CALL RxQueue 'DELETE', QueueFromServer
  431.     CALL CHAROUT , "rc"
  432.     SIGNAL END
  433.  
  434. END:
  435.     EXIT(0)