home *** CD-ROM | disk | FTP | other *** search
/ Mega CD-ROM 1 / megacd_rom_1.zip / megacd_rom_1 / MAGAZINE / MSJOURNA / MSJV3_3.ZIP / QB4CODE.ALL < prev    next >
Text File  |  1988-04-28  |  9KB  |  334 lines
  1. Microsoft Systems Journal
  2. Volume 3; Issue 3; May, 1988
  3.  
  4.  
  5. Code Listings For:
  6.  
  7.     ADMA3A
  8.     pp. 49-62
  9.  
  10. Author(s): Augie Hansen
  11. Title:     New Compiler Technology Boosts Microsoft QuickBASIC 4.0 
  12.            Productivity
  13.  
  14.  
  15.  
  16.  
  17. Figure 7
  18. ========
  19.  
  20.  
  21.  
  22. '====================================================================
  23. ' ADM3A Terminal Emulator
  24. ' Version 1.0
  25. '
  26. ' This program emulates a Lear Siegler adm3a video terminal.  The
  27. ' emulator gives PC users the ability to run full-screen video
  28. ' programs on UNIX and XENIX systems, and others that support a
  29. ' video terminal interface.
  30. '
  31. ' Author: Augie Hansen
  32. ' Released: 1-14-88
  33. '====================================================================
  34.  
  35. DEFINT A-Z
  36.  
  37. '--- Subprogram declarations.
  38. DECLARE SUB BreakSignal ()
  39. DECLARE SUB Delay (Period!)
  40. DECLARE SUB Dial ()
  41. DECLARE SUB DoCommand (CmdKey$)
  42. DECLARE SUB InitScreen ()
  43. DECLARE SUB ProcessInput (Code$)
  44.  
  45. '--- Manifest constants.
  46. CONST TRUE = -1, FALSE = NOT TRUE
  47. CONST BLACK = 0, BLUE = 1, GREEN = 2, CYAN = 3
  48. CONST RED = 4, MAGENTA = 5, BROWN = 6, WHITE = 7
  49. CONST BRIGHT = 8, BLINK = 128
  50. CONST CURSOROFF = 0, CURSORON = 1
  51. CONST BUFSIZE = 512
  52. CONST SPACE = 32
  53. CONST ROWS = 25, COLS = 80
  54. CONST BANNERCOL = 4, COMMANDCOL = 33
  55. CONST TESTMODE = 0
  56.  
  57. '--- Screen management data.
  58. TYPE WinType
  59.     Top AS INTEGER
  60.     Left AS INTEGER
  61.     Bottom AS INTEGER
  62.     Right AS INTEGER
  63.     Fgnd AS INTEGER
  64.     Bkgnd AS INTEGER
  65.     Standout AS INTEGER
  66. END TYPE
  67.  
  68. DIM CmdWin AS WinType
  69. DIM ViewWin AS WinType
  70.  
  71. CmdWin.Top = 1
  72. CmdWin.Bottom = 1
  73. CmdWin.Left = 1
  74. CmdWin.Right = 80
  75. CmdWin.Fgnd = BLACK
  76. CmdWin.Bkgnd = WHITE
  77. CmdWin.Standout = BROWN + BRIGHT
  78.  
  79. ViewWin.Top = 2
  80. ViewWin.Bottom = 25
  81. ViewWin.Left = 1
  82. ViewWin.Right = 80
  83. ViewWin.Fgnd = WHITE
  84. ViewWin.Bkgnd = BLUE
  85. ViewWin.Standout = WHITE + BRIGHT
  86.  
  87. '--- Set cursor-positioning offsets.
  88. RowOffset = SPACE - ViewWin.Top
  89. ColOffset = SPACE - ViewWin.Left
  90.  
  91. '--- Install an error-recovery mechanism.
  92. ON ERROR GOTO ErrorRecovery
  93.  
  94. '--- Set up the emulator screen.
  95. InitScreen
  96.  
  97. '--- Set communications parameters.
  98. Parm$ = ENVIRON$("COMPARMS")            ' Check environment.
  99. IF Parm$ = "" THEN
  100.     Parm$ = "COM2:1200,E,7,1"       ' Use defaults.
  101. END IF
  102.  
  103. Port$ = LEFT$(Parm$, 4)
  104. IF Port$ = "COM1" THEN
  105.     PortAddress = &H3FB
  106. ELSE
  107.     PortAddress = &H2FB
  108. END IF
  109. BreakMask = &H40                        ' Break control bits
  110.  
  111. '--- Open the communications channel.
  112. OPEN Parm$ FOR RANDOM AS #1 LEN = BUFSIZE
  113.  
  114. '--------------------------------------------------------------------
  115. ' Main communications loop.
  116. '
  117. ' Check the keyboard for input.  Send all normal characters typed by
  118. ' the user to the communications port for transmission to the remote
  119. ' system. If the user presses any of the emulator command keys, run
  120. ' the associated procedure.
  121. '--------------------------------------------------------------------
  122. Main:
  123. EscapeFlag = FALSE
  124. DO
  125.     '--- Process keyboard input for commands and characters.
  126.     UserKey$ = INKEY$
  127.     IF LEN(UserKey$) > 1 THEN
  128.         DoCommand UserKey$
  129.     ELSEIF UserKey$ <> "" THEN
  130.         '--- Send the character to the remote system.
  131.         PRINT #1, UserKey$;
  132.     END IF
  133.  
  134.     '--- Check the communications line for received characters.
  135.     DO
  136.         IF EOF(1) THEN
  137.             EXIT DO
  138.         END IF
  139.         Received$ = INPUT$(1, #1) ' Read a single character.
  140.  
  141.         '--- Look for cursor-positioning command.
  142.         IF EscapeFlag = TRUE THEN
  143.             IF Received$ = "=" THEN
  144.                 CursorRow = ASC(INPUT$(1, #1))-RowOffset
  145.                 CursorCol = ASC(INPUT$(1, #1))-ColOffset
  146.                 LOCATE CursorRow, CursorCol
  147.             ELSE
  148.                 PRINT CHR$(27); ' The retained Esc code.
  149.                 PRINT Received$;
  150.             END IF
  151.             EscapeFlag = FALSE
  152.         ELSE
  153.             ProcessInput Received$
  154.         END IF
  155.     LOOP
  156. LOOP
  157.  
  158. END
  159.  
  160. ErrorRecovery:
  161.     RESUME Main
  162.  
  163. '
  164. '====================================================================
  165. ' BreakSignal
  166. '
  167. ' Send a "break" signal to the communications port.
  168. '====================================================================
  169. '
  170. SUB BreakSignal
  171.     SHARED PortAddress, BreakMask
  172.  
  173.     '--- Set the break bit.
  174.     OUT PortAddress, (INP(PortAddress) OR BreakMask)
  175.  
  176.     '--- Mark time for the break period.
  177.     Delay .5
  178.        
  179.     '--- Clear the break bit.
  180.     OUT PortAddress, (INP(PortAddress) AND NOT BreakMask)
  181. END SUB
  182.  
  183. '
  184. '====================================================================
  185. ' Delay
  186. '
  187. ' Produce a specified delay.  The delay period is specified in
  188. ' seconds as a single-precision number with tenth-second precision.
  189. '====================================================================
  190. '
  191. SUB Delay (Period!) STATIC
  192.     Start! = TIMER
  193.  
  194.     '--- Loop for specified period.  Abort if clock rolls over.
  195.     DO
  196.         Now! = TIMER
  197.         IF (Now! - Start! < Period!) OR (Now! < Start!) THEN
  198.             EXIT SUB
  199.         END IF
  200.     LOOP
  201. END SUB
  202.  
  203. '
  204. '====================================================================
  205. ' Dial
  206. '
  207. ' Ask the user for a telephone number and dial it.
  208. '====================================================================
  209. '
  210. SUB Dial
  211.     INPUT "Number: ", Phone$
  212.     PRINT #1, "ATDT" + Phone$
  213. END SUB
  214.  
  215. '
  216. '====================================================================
  217. ' DoCommand
  218. '
  219. ' Examine the extended key code to see whether it is an Emulator
  220. ' program command.  If it is, execute the requested command.  If it
  221. ' is not, return to the caller without doing anything.
  222. '====================================================================
  223. '
  224. SUB DoCommand (CmdKey$) STATIC
  225.     SHARED CmdWin AS WinType
  226.     SELECT CASE ASC(RIGHT$(CmdKey$, 1))
  227.         CASE 16 ' Alt+q -- Quit the emulator.
  228.             ' Close the communications channel.
  229.             CLOSE
  230.             ' Restore full screen.
  231.             VIEW PRINT
  232.             ' Clear the screen and "home" the cursor.
  233.             COLOR WHITE, BLACK
  234.             CLS
  235.             LOCATE CmdWin.Top, CmdWin.Left, CURSORON
  236.             END
  237.         CASE 32 ' Alt-d -- Dial a number
  238.             Dial
  239.         CASE 48 ' Alt+b -- Send break signal.
  240.             BreakSignal
  241.         CASE 83 ' PC keyboard Del key -- Send an ASCII DEL
  242.             PRINT #1, CHR$(127);
  243.         CASE ELSE
  244.             ' Unknown command -- ignore it.
  245.     END SELECT
  246. END SUB
  247.  
  248. '
  249. '====================================================================
  250. ' InitScreen
  251. '
  252. ' Set up command bar (1 line), guarantee that the cursor is turned
  253. ' on, and establish the active terminal display window (24 lines).
  254. '====================================================================
  255. '
  256. SUB InitScreen STATIC
  257.     SHARED CmdWin AS WinType, ViewWin AS WinType
  258.  
  259.     '--- Initialize the screen for text and 80 columns.
  260.     SCREEN TEXTMODE
  261.     WIDTH COLS, ROWS
  262.     COLOR WHITE, BLACK
  263.     CLS
  264.        
  265.     '--- Draw the command window on the top line.
  266.     LOCATE CmdWin.Top, CmdWin.Left, CURSORON
  267.     COLOR CmdWin.Fgnd, CmdWin.Bkgnd
  268.     PRINT SPACE$(CmdWin.Right - CmdWin.Left + 1)
  269.        
  270.     '--- Display the program banner.
  271.     LOCATE CmdWin.Top, CmdWin.Left + BANNERCOL
  272.     COLOR CmdWin.Standout, CmdWin.Bkgnd
  273.     PRINT "ADM3A EMULATOR";
  274.  
  275.     '--- Display a command summary.
  276.     LOCATE CmdWin.Top, CmdWin.Left + COMMANDCOL
  277.     COLOR CmdWin.Fgnd, CmdWin.Bkgnd
  278.     PRINT "Break (Alt+b)   Dial (Alt+d)   Quit (Alt+q)"
  279.  
  280.     '--- Initialize the terminal screen.
  281.     VIEW PRINT ViewWin.Top TO ViewWin.Bottom
  282.     COLOR ViewWin.Fgnd, ViewWin.Bkgnd
  283.     CLS
  284. END SUB
  285.  
  286. '
  287. '====================================================================
  288. ' ProcessInput
  289. '
  290. ' Check input from the communucations line and analyze it.  Act on
  291. ' any adm3a terminal commands codes.  Pass anything else unchanged
  292. ' to the terminal screen.
  293. '====================================================================
  294. '
  295. SUB ProcessInput (Code$) STATIC
  296.     SHARED EscapeFlag, ViewWin AS WinType
  297.     SELECT CASE ASC(Code$)
  298.         CASE 8 ' ASCII backspace character
  299.             IF POS(0) > ViewWin.Left THEN
  300.                 ' Non-destructive backspace
  301.                 LOCATE , POS(0) - 1
  302.             END IF
  303.         CASE 10 ' ^J -- New-line character
  304.             IF CSRLIN < ViewWin.Bottom THEN
  305.                 LOCATE CSRLIN + 1
  306.             ELSE
  307.                 PRINT Code$;
  308.             END IF
  309.         CASE 11 ' ^K -- Upline command
  310.             IF CSRLIN > ViewWin.Top THEN
  311.                 LOCATE CSRLIN - 1
  312.             END IF
  313.         CASE 12 ' ^L -- Form-feed character
  314.             ' adm3a use as non-destructive space
  315.             IF POS(0) < ViewWin.Right THEN
  316.                 LOCATE , POS(0) + 1
  317.             ELSEIF (POS(0) = ViewWin.Right) AND _
  318.                     (CSRLIN < ViewWin.Bottom) THEN
  319.                 LOCATE CSRLIN + 1, ViewWin.Left
  320.             END IF
  321.         CASE 13
  322.             LOCATE , ViewWin.Left
  323.         CASE 26 ' ^Z -- clear the screen
  324.             CLS
  325.         CASE 27 ' Esc -- Could be start of cursor sequence
  326.             EscapeFlag = TRUE
  327.         CASE 30 ' ^^ -- Cursor to home position
  328.             LOCATE ViewWin.Top, ViewWin.Left
  329.         CASE ELSE
  330.             PRINT Code$;
  331.     END SELECT
  332. END SUB
  333.  
  334.