home *** CD-ROM | disk | FTP | other *** search
/ Beijing Paradise BBS Backup / PARADISE.ISO / software / BBSDOORW / MAPL0206.ZIP / ANSICHAT.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-02-06  |  13.5 KB  |  327 lines
  1. ' $title: 'ANSIChat Split Screen Chat for RBBS-PC v17.4'
  2. '          By Dan Drinnon 8:903/2 1:313/6
  3. '              The Cellar Door RBBS (505) 763-1795 9600 v32
  4. '             Scott McNay 1:395/11
  5. '              The Wizard II RBBS   (817) 554-5331 9600 V32b, V42b
  6. '
  7. '          Copyright (c) 1992 by Daniel T. Drinnon   All Rights Reserved
  8. '
  9. '          DO NOT Distribute in Modified Form!
  10. '
  11. 'REVISIONS:
  12. '1.00  -  06-28-92 Initial Release
  13. '1.01  -  06-29-92 Fix for F2 Shell to DOS from ANSICHAT
  14. '1.02  -  07-04-92 Prevent F10 from Loading another ANSIChat
  15. '                  Keep ANSIChat from showing 'RBBS' if that is already
  16. '                  part of the BBS name.
  17. '                  added support for Sysop's PgUp/PgDn (RBBSSUB3.BAS)
  18. '                  combined local and remote input routines
  19. '1.03  -  07-09-92 Greater control over ANSI colors independent of RBBS colors
  20. '1.04  -  07-13-92 Added control to keep ANSICHAT from popping up when
  21. '                  the sysop does not have ANSI installed according to
  22. '                  CONFIG.
  23. '1.05  -  07-19-92 Modified RBBSSUB3 to get status of ANSIChat Capability
  24. '                  in DRSTx.DEF after return from a DOOR.
  25. '                  Removed redundant code in RBBS-PC.BAS.
  26. '                  Included ANSIFUN - a mod to make a Ring instead of a BEEP
  27. '                  for Sysop Page.
  28. '1.06  -  07-04-92 Gave the remote the option to terminate the chat by
  29. '                  pressing ESC.
  30. '1.07  -  08-10-92 Fixed BackSpace routine to properly locate the cursor.
  31. '1.08  -  08-13-92 Fixed the wordwrap/color mix problem and tweaked the
  32. '                  ANSI commands and a couple other things to speed up
  33. '                  the I/O.
  34. '1.09  -  08-18-92 Changed the bottom line of the remote screen to not go
  35. '                  past line 23.
  36. '                  Changed ZIP distribution file name to ACHATxxx.ZIP where xxx
  37. '                  denotes the version number.
  38. '1.10  -  08-26-92 Removed "STATIC" from SUB headers to force string space to
  39. '                  be released after use.
  40. '                  Added GetUserScreenSize sub to determine user's screen size
  41. '                  so that screen layout can be determined dynamically.  Makes
  42. '                  ANSIChat more compatible with non-standard (25x80) screens.
  43. '                  Changed exit method to require ESC key to be pressed twice.
  44. '                  This is compatible with ANSIED, and prevents accidents when
  45. '                  user hits a cursor key.
  46. '
  47. ' 12/23/92  Added "STATIC back to Sub Headers for Qb3.0 Qb4.5 support
  48. ' if you are using PDS7.? these can be removed to release string space
  49. '   Pete Eibl
  50. '
  51. ' $INCLUDE: 'RBBS-VAR.MOD'
  52. '
  53. ' $SUBTITLE: 'ANSIChat - ANSI Split Screen Chat Routine'
  54. '
  55. ' $PAGE
  56. '
  57. '  SUBROUTINE NAME    -- ANSIChat
  58. '
  59. '  INPUT PARAMETERS   -- None
  60. '
  61. '  OUTPUT PARAMETERS  -- None
  62. '
  63. '  SUBROUTINE PURPOSE -- Allows Split Screen ANSI Chat for RBBS
  64. '
  65. '
  66. DIM ANSIRow(1), ANSICol(1), ACColor$(1), HoldInput$(1), StartRow(1)
  67. DIM MaxRow(1), WasX$(1), LastChar$(1)                                ' 1.10
  68.  
  69. Common Shared ANSIRow(), ANSICol(), ACColor$(), HoldInput$(), StartRow()
  70. Common Shared MaxRow(), WasX$(), LastChar$()                         ' 1.10
  71. Common Shared LocalOut, RemoteOut, SideOut
  72. Common Shared MenuColor1$, MenuColor2$
  73. Common Shared RowMax, ColMax, RowMid                                 ' 1.10
  74. '
  75. 1000 SUB ANSIChat  Static
  76. '
  77.      LocalOut = 0
  78.      RemoteOut = 1
  79.      SideOut = LocalOut
  80.      TimeChatStarted! = TIMER                                        ' 1.10
  81.      CALL GetUserScreenSize                                          ' 1.10
  82.      ANSIRow(LocalOut) = 2
  83.      ANSIRow(RemoteOut) = RowMid + 2                                 ' 1.10
  84.      ANSICol(LocalOut) = 1
  85.      ANSICol(RemoteOut) = 1
  86.      ACColor$(LocalOut) = "32;40m"                              ' 1.08
  87.      ACColor$(RemoteOut) = "33;40m"                             ' 1.08
  88.      ZWasCM = ZTrue
  89.      ZSubParm = 1
  90.      HoldColorReset$ = ZColorReset$
  91.      MenuColor1$ = "33;44m"                                     ' 1.08
  92.      MenuColor2$ = "36;44m"                                     ' 1.08
  93.      ZColorReset$ = MenuColor2$                                      ' 1.03
  94.      CALL ANSIMenu
  95.      CALL ANSILocate (ANSIRow(LocalOut),ANSICol(LocalOut))
  96.      CALL QuickTPut1 (ACColor$(LocalOut) + ZSysopGreeting$)
  97.      CALL SplitScreenChat
  98.      ZWasCM = 0
  99.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  100.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  101.      IF NOT ZLocalUser THEN _
  102.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  103.      CALL ClearANSIScreen
  104.      CALL QuickTPut(ZEmphasizeOff$ + ZCrLF$ + _                      ' 1.08
  105.           "Chat over.  BBS resuming",1)                              ' 1.08
  106.      ZColorReset$ = HoldColorReset$
  107.      END SUB
  108. '
  109. 4000 SUB ANSIMenu Static
  110. '
  111.      LineBar$ = STRING$(80,177)                                      ' 1.08
  112.      CALL ClearANSIScreen
  113.      CALL ANSILocate (1,1)
  114.      CALL QuickTPut (MenuColor2$ + LineBar$,0)                       ' 1.03
  115.      IF INSTR(ZRBBSName$,"BBS") <> 0 THEN _                          ' 1.02
  116.         ZOutTxt$ = "░*>>> " + ZRBBSName$ + " ANSI Chat <<<*░" _      ' 1.02
  117.      ELSE _                                                          ' 1.02
  118.         ZOutTxt$ = "░*>>> " + ZRBBSName$ + " RBBS ANSI Chat <<<*░"   ' 1.02
  119.      temppos = (40 - (LEN(ZOutTxt$)/2))
  120.      CALL ANSILocate (1,temppos)
  121.      CALL QuickTPut (MenuColor1$ + ZOutTxt$,0)                       ' 1.03
  122.      CALL ANSILocate (RowMid + 1,1)                                  ' 1.10
  123.      CALL QuickTPut (MenuColor2$ + LineBar$,0)                       ' 1.03
  124.      CALL ANSILocate (RowMid + 1,3)                                  ' 1.10
  125.      CALL QuickTPut (MenuColor2$ + "░" + ZSysopFirstName$ + _       ' 1.03
  126.           " " + ZSysopLastName$ + "░",0)                            ' 1.03
  127.      CALL ANSILocate (RowMid + 1,43)                                 ' 1.10
  128.      CALL QuickTPut (MenuColor2$ + "░" + ZActiveUserName$ + "░",0) ' 1.03
  129.      CALL Line25
  130.      END SUB
  131. '
  132. 5000 SUB ClearANSIScreen Static
  133. '
  134.      CALL QuickTPut ("",0)                                       ' 1.03
  135.      ZSubParm = 2
  136.      CALL Line25
  137.      ZSubParm = 0
  138.      CALL ANSILocate (1,1)
  139.      END SUB
  140. '
  141. 6000 SUB ANSILocate (ANSIRow,ANSICol) Static
  142. '
  143.      CALL QuickTPut ("" + MID$(STR$(ANSIRow),2) + ";" + _
  144.           MID$(STR$(ANSICol),2) + "H",0)
  145.      END SUB
  146. '
  147. 8000 SUB SplitScreenChat Static
  148. '
  149. 8001 HoldInput$(LocalOut) = ""                                       ' 1.01
  150.      HoldInput$(RemoteOut) = ""
  151.      MaxLen = ColMax - 2                                             ' 1.10
  152.      StartRow(LocalOut) = 2
  153.      StartRow(RemoteOut) = RowMid + 2                                ' 1.10
  154.      MaxRow(LocalOut) = RowMid                                       ' 1.10
  155.      MaxRow(RemoteOut) = RowMax                                      ' 1.10
  156.      ANSICol(LocalOut) = 1
  157.      ANSICol(RemoteOut) = 1
  158.      ANSIRow(LocalOut) = StartRow(LocalOut) + 1
  159.      ANSIRow(RemoteOut) = StartRow(RemoteOut)
  160.      WasX$(LocalOut) = ""
  161.      WasX$(RemoteOut) = ""
  162.      ZWaitExpired = ZFalse
  163. '
  164. 8010 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  165.      CALL Carrier
  166.      IF ZSubParm < 0 THEN _
  167.         EXIT SUB
  168. '
  169. 8020 CALL FindFKey
  170.      IF ZWasCM = 0 THEN _                                            ' 1.01
  171.         CALL FlushCom (ZCommPortStack$) : _                          ' 1.01
  172.         ZKeyPressed$ = "" : _                                        ' 1.01
  173.         CALL ANSIMenu : _                                            ' 1.01
  174.         ZWasCM = ZTrue : _                                           ' 1.01
  175.         GOTO 8001                                                    ' 1.01
  176.      SideOut = LocalOut
  177.      WasX$(LocalOut) = ZKeyPressed$
  178.      IF ZKeyPressed$ = ZEscape$ THEN _
  179.         EXIT SUB
  180.      IF WasX$(LocalOut) <> "" THEN _
  181.         GOTO 8060
  182. '
  183. 8030 IF ZLocalUser THEN _
  184.         GOTO 8010
  185.      SideOut = RemoteOut
  186.      IF ZCommPortStack$ <> "" THEN _
  187.         WasX$(RemoteOut) = LEFT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  188.         GOTO 9000
  189.      CALL EofComm (Char)
  190.      IF Char <> -1 THEN _
  191.         GOTO 8050 _
  192.      ELSE _
  193.         GOTO 8010
  194. '
  195. 8050 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  196.      CALL GetCom (WasX$(RemoteOut))
  197. '
  198. 8060 'Control keys
  199.      LastChar$(SideOut) = RIGHT$(LastChar$(SideOut),1) + _           ' 1.10
  200.                           WasX$(SideOut)                             ' 1.10
  201.      IF WasX$(SideOut) = CHR$(8) THEN _
  202.         GOTO 8500 _
  203.      ELSE IF WasX$(SideOut) = CHR$(9) THEN _
  204.         GOTO 8510 _
  205.      ELSE IF WasX$(SideOut) = CHR$(13) THEN _
  206.         GOTO 8520
  207.      GOTO 9000
  208. '
  209. 8500 'BackSpace
  210.      IF HoldInput$(SideOut) <> "" THEN _                             ' 1.07
  211.         HoldInput$(SideOut) = LEFT$(HoldInput$(SideOut), _           ' 1.07
  212.                               LEN(HoldInput$(SideOut))-1)            ' 1.07
  213.      IF ANSICol(SideOut) > 1 THEN _
  214.         ANSICol(SideOut) = ANSICol(SideOut) - 1 : _                  ' 1.07
  215.         GOTO 8501                                                    ' 1.07
  216.      IF ANSICol(SideOut) = 1 THEN _                                  ' 1.07
  217.         GOSUB 8502 : _                                               ' 1.07
  218.         ANSICol(SideOut) = MaxLen - 1 : _                            ' 1.07
  219.         ANSIRow(SideOut) = ANSIRow(SideOut) - 1                      ' 1.03
  220.      IF ANSIRow(SideOut) < StartRow(SideOut) THEN _                  ' 1.07
  221.         ANSIRow(SideOut) = MaxRow(SideOut)                           ' 1.07
  222. 8501 GOSUB 8502                                                      ' 1.07
  223.      GOTO 8010
  224. 8502 CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))             ' 1.07
  225.      IF NOT ZLocalUser THEN _                                        ' 1.07
  226.         CALL PutCom (" ")                                            ' 1.07
  227.      CALL LPrnt (" ",0)                                              ' 1.07
  228.      CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))             ' 1.07
  229.      RETURN                                                          ' 1.07
  230. '
  231. 8510 'TAB
  232.      HoldInput$(SideOut) = ""
  233.      IF ANSICol(SideOut) + 5 > MaxLen THEN _
  234.         CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) _
  235.      ELSE _
  236.         ANSICol(SideOut) = ANSICol(SideOut) + 5 : _
  237.         CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
  238.      GOTO 8010
  239. '
  240. 8520 'CR
  241.      HoldInput$(SideOut) = ""
  242.      CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
  243.      GOTO 8010
  244. '
  245. 9000 'Character Placement
  246.      IF LastChar$(SideOut) = ZEscape$ + ZEscape$ THEN _              ' 1.10
  247.            EXIT SUB
  248.      HoldInput$(SideOut) = HoldInput$(SideOut) + WasX$(SideOut)
  249.      IF WasX$(SideOut) = " " THEN _
  250.         HoldInput$(SideOut) = ""
  251.      IF ANSICol(SideOut) = MaxLen AND WasX$(SideOut) <> " " THEN _
  252.         CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut) - _
  253.                          LEN(HoldInput$(SideOut))) : _
  254.         CALL QuickTput(ACColor$(SideOut) + "", 0) : _             ' 1.08
  255.         CALL AddRow (StartRow(SideOut),MaxRow(SideOut)) : _
  256.         CALL QuickTPut (HoldInput$(SideOut),0) : _
  257.         ANSICol(SideOut) = ANSICol(SideOut) + LEN(HoldInput$(SideOut)) - 1 : _
  258.         WasX$(SideOut) = "" : _
  259.         HoldInput$(SideOut) = ""
  260.      CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
  261.      IF NOT ZLocalUser THEN _
  262.         CALL PutCom (ACColor$(SideOut) + WasX$(SideOut))
  263.      CALL LPrnt (ACColor$(SideOut) + WasX$(SideOut),0)
  264.      ANSICol(SideOut) = ANSICol(SideOut) + 1
  265.      IF ANSICol(SideOut) > MaxLen THEN _
  266.         CALL AddRow (StartRow(SideOut),MaxRow(SideOut))
  267.      WasX$(SideOut) = ""
  268.      GOTO 8010
  269.      END SUB
  270. '
  271. 10000 SUB AddRow (StartRow,MaxRow) Static
  272. '
  273.       ANSICol(SideOut) = 1
  274.       ANSIRow(SideOut) = ANSIRow(SideOut) + 1
  275.       IF ANSIRow(SideOut) > MaxRow THEN _
  276.          ANSIRow(SideOut) = StartRow
  277.       IF ANSIRow(SideOut) < MaxRow THEN _
  278.          CALL ANSILocate (ANSIRow(SideOut) + 1,ANSICol(SideOut)) : _
  279.          CALL QuickTput("", 0)
  280.       IF ANSIRow(SideOut) = MaxRow THEN _
  281.          CALL ANSILocate (StartRow,ANSICol(SideOut)) : _
  282.          CALL QuickTput("", 0)
  283.       CALL ANSILocate (ANSIRow(SideOut),ANSICol(SideOut))
  284.       END SUB
  285. '
  286. 11000 SUB GetUserScreenSize  Static                               ' 1.10
  287. '
  288.       ColMax = 80
  289.       RowMax = 24
  290.       RowMid = RowMax \ 2
  291.       IF ZLocalUser THEN _
  292.          EXIT SUB
  293.       CALL FlushCom (Strng$)
  294.       CALL PutCom ("CCBn")
  295.       CALL GetUserCursorLoc (RowMax, ColMax)
  296.       IF ColMax > 80 THEN _
  297.          ColMax = 80
  298.       IF RowMax > 24 THEN _
  299.          RowMax = 24
  300.       RowMid = RowMax \ 2
  301.       END SUB
  302. '
  303. 11100 SUB GetUserCursorLoc (Row, Col) Static                          ' 1.10
  304. '
  305.       Call ReadString ("R",ZTestANSITime,Response$)
  306.       Temp = INSTR(Response$,"")
  307.       IF Temp > 0 THEN _
  308.          SemiPtr =INSTR(Temp,Response$,";") : _
  309.          IF (SemiPtr > 0) THEN _
  310.             Temp2 = INSTR(SemiPtr,Response$,"R") : _
  311.             IF (Temp2 > 0) THEN _
  312.                Row = VAL(MID$(Response$,Temp+2,SemiPtr-1)) : _
  313.                Col = VAL(MID$(Response$,SemiPtr+1,Temp2-1))
  314.       END SUB
  315. '
  316. 11200 SUB ReadString (Wait$, DelayTime,Response$) Static             ' 1.10
  317. '
  318.       Response$ = ""
  319.       TempElapsed! = 0
  320.       Delay! = TIMER
  321.       WHILE (INSTR(Strng$,Wait$) = 0) AND (TempElapsed < DelayTime)
  322.          CALL FlushCom (Strng$)
  323.          Response$ = Response$ + Strng$
  324.          CALL CheckTime (Delay!, TempElapsed!, 2)
  325.       WEND
  326.       END SUB
  327.