home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / modems / modem / nsd.ark / NSD < prev   
Encoding:
Text File  |  1987-11-01  |  6.3 KB  |  262 lines
  1. ' NSD: (N)ot (S)o (D)umb
  2. ' terminal program for CP/M Kaypro
  3. ' with an external modem.
  4. '
  5. ' Many Thanks to:
  6. ' Richard Walker, for the useful info in UARTKPRO.DOC
  7. ' ZEDCOR Inc., for the amazing ZBasic compiler.
  8. '
  9. ' NSD - Copyright, 1986 by Lee D. Rimar.
  10. ' ZBasic - Copyright, 1986 by ZEDCOR Inc.
  11. '
  12. ' NSD may be distributed without charge.  Feel free to study
  13. ' and/or use any routines from this program, but please do
  14. ' NOT distribute altered versions of NSD.  Thanks...    LDR
  15.  
  16. ON ERROR GOSUB "Error Traps"
  17.  
  18. ' Definitions
  19.  
  20. ' Initial Flagged Values
  21. Yes   = -1
  22. No    = 0
  23. AddLF = 0  ' add line feeds
  24. Done  = 0  ' termination flag
  25. Echo  = 0  ' echo mode
  26. Here  = 0  ' local character
  27. Rate  = 12 ' initial baud rate/100
  28. Wrap  = 0  ' word wrap
  29.  
  30. ' Serial Port Addresses
  31. Baud = 0
  32. Data = 4
  33. Cntl = 6
  34.  
  35. ' Other Integers
  36. A   = 0   ' for CHR$-ASC conversions
  37. Bel = 7   ' keyboard beep
  38. Bs  = 8   ' back space
  39. Cmd = 0   ' for holding extended commands
  40. Cr  = 13  ' carriage return
  41. Del = 127 ' delete
  42. Esc = 27  ' ESCape code
  43. Lf  = 10  ' line feed
  44. Spc = 32  ' space
  45.  
  46. ' Strings
  47.  
  48. DEF LEN = 14
  49. File$ = "A:VERYLONG.FIL"  ' just filling the space
  50.  
  51. DEF LEN = 1
  52. A$   = " " ' for ASC-CHR$ conversions
  53. Cmd$ = " "      ' see integer defs.
  54. Bel$ = CHR$(7)
  55. Bs$  = CHR$(8)
  56. Cr$  = CHR$(13)
  57. Lf$  = CHR$(10)
  58. Esc$ = CHR$(27)
  59.  
  60. ' Long functions
  61.  
  62. LONG FN WaitKey
  63. "Hit Any Key"
  64. ? Cr$ Lf$ "Hit any key... ";
  65. DO : UNTIL LEN(INKEY$)
  66. ?
  67. ENDFN ' WaitKey
  68.  
  69. LONG FN CarriageReturn
  70. A$ = Cr$ : A = Cr
  71. ENDFN ' CarriageReturn
  72.  
  73. LONG FN EmptyString
  74. A$ = "" : A = 0
  75. ENDFN ' EmptyString
  76.  
  77. LONG FN CheckLocal ' scan local keyboard for character
  78. A$ = INKEY$
  79. IF LEN(A$) THEN A = ASC(A$) : Here = -1
  80. ENDFN ' CheckLocal
  81.  
  82. LONG FN CheckRemote ' check modem for character 
  83. LONG IF ((INP(Cntl) AND 1) AND 1) = 1
  84. A  = INP(Data)
  85. A$ = CHR$(A)
  86. Here = 0
  87. ENDIF
  88. ENDFN ' CheckRemote
  89.  
  90. LONG FN Sendout ' send character to modem
  91. OUT Data, A
  92. DO : UNTIL ((INP(Cntl) AND 4) AND 4) = 4
  93. ENDFN ' Sendout
  94.  
  95. ' end of Definitions
  96.  
  97. ' Single Use Code
  98.  
  99. ' Z80 SIO Register Settings
  100. ' don't mess with this unless you know what you're doing!
  101. OUT Cntl, 4 : OUT Cntl, &H46 ' reg4: 16 clock, 1 stop bit, no parity
  102. OUT Cntl, 3 : OUT Cntl, &HC1 ' reg3: enable rx, 8 bit
  103. OUT Cntl, 5 : OUT Cntl, &HE8 ' reg5: enable tx, 8 bit, DTR on
  104. OUT Cntl, 1 : OUT Cntl, &H00 ' reg1: disable SIO interrupts
  105. GOSUB "Set Baud" ' can reset later with command "B"
  106. ' end of Initial Register Settings
  107.  
  108. ' Sign On
  109. CLS
  110. ? "(N)ot (S)o (D)umb, a simple terminal program" Cr$ Lf$
  111. ? "Copyright, 1986 by Lee D. Rimar"
  112. ? "Portions Copyright, 1986 by ZEDCOR Inc." Cr$ Lf$
  113. ? "For: CP/M Kaypro computer with external modem" Cr$ Lf$
  114. ? "Type ESC-Q to exit.  See NSD.DOC for help." Cr$ Lf$
  115. FN WaitKey
  116. CLS
  117.  
  118. ' end of Single Use Code
  119.  
  120. "Main Loop"
  121.  
  122. DO:
  123. FN CheckLocal
  124. IF A$ = "" FN CheckRemote
  125. UNTIL LEN(A$)
  126.  
  127. GOSUB "Filters"
  128. IF A$ = "" THEN "Main Loop"
  129.  
  130. GOSUB "Process Character"
  131.  
  132. LONG IF AddLF AND A = Cr
  133. A$ = Lf$ : A = Lf
  134. GOSUB "Process Character"
  135. ENDIF ' AddLF AND A = Cr
  136.  
  137. GOTO "Main Loop"
  138.  
  139. END ' of Main Loop
  140.  
  141. ' Subroutines, in order of use.
  142.  
  143. "Filters"
  144. IF Here AND A = Esc THEN "Command Processor"
  145. IF Wrap AND (A = Spc) AND (Count > 65) FN CarriageReturn
  146. IF AddLF AND A = Lf FN EmptyString
  147. IF A = Del THEN A$ = Bs$ : A = Bs
  148. IF A = Bs AND Count = 0 FN EmptyString
  149. RETURN ' de Filters
  150.  
  151. "Process Character"
  152. LONG IF Echo
  153. ? A$;
  154. GOSUB "Count Characters"
  155. FN Sendout
  156. XELSE
  157. IF Here FN Sendout ELSE ? A$; : GOSUB "Count Characters"
  158. ENDIF
  159. RETURN ' de Process Character
  160.  
  161. "Count Characters"
  162. IF A = 8 THEN Count = Count - 1 ELSE Count = Count + 1
  163. IF A = 13 THEN Count = 0
  164. RETURN ' de Count Characters
  165.  
  166. "Command Processor"
  167. ? Bel$;
  168. DO: Cmd$ = UCASE$(INKEY$) : UNTIL LEN(Cmd$)
  169. Cmd = ASC(Cmd$) ' convert it to a number
  170. IF Cmd = Esc THEN A$ = Esc$ : A = Esc : RETURN
  171. IF Cmd = Lf THEN "Line Feed"  '  LF
  172. IF Cmd = 66 THEN "Baud Rate"  ' "B"
  173. IF Cmd = 68 THEN "Disconnect" ' "D"
  174. IF Cmd = 69 THEN "Echo Mode"  ' "E"
  175. IF Cmd = 81 THEN CLS : END    ' "Q"
  176. IF Cmd = 84 THEN "Send Text"  ' "T"
  177. IF Cmd = 87 THEN "Word Wrap"  ' "W"
  178. ? Bel$; ' if you get this far, it was an invalid command, so
  179. RETURN ' de Command Processor
  180.  
  181. ' Command Processor Subroutines:
  182. ' if you didn't RETURN de Command Processor,
  183. ' you will from one of the routines below.
  184.  
  185. "Line Feed"
  186. AddLF = NOT AddLF
  187. ? Cr$ Lf$ "Line feeds ";
  188. IF AddLF ? "ON" ELSE ? "OFF"
  189. FN EmptyString
  190. RETURN ' de Line Feeds
  191.  
  192. "Baud Rate"
  193. ?
  194. "Get Rate" : INPUT "Baud/100 (3,6,12,24)? "; Rate
  195. "Set Baud" ' comes here once at beginning of program
  196. IF Rate<>3 AND Rate<>12 AND Rate<>24 THEN "Get Rate"
  197. IF Rate =  3 THEN OUT Baud, 5
  198. IF Rate =  6 THEN OUT Baud, 6
  199. IF Rate = 12 THEN OUT Baud, 7
  200. IF Rate = 24 THEN OUT Baud, 10
  201. FN CarriageReturn
  202. RETURN ' de Adjust Baud Rate
  203.  
  204. "Disconnect"
  205. OUT Cntl, 5 ' select SIO register 5
  206. OUT Cntl, 0 ' don't be fussy, shut off everything
  207. ? Cr$ Lf$ "Disconnecting:  ";
  208. DELAY 200   ' give modem time to notice (1/5 second)
  209. OUT Cntl, 5 ' gotta select the register again
  210. OUT Cntl,&HE8 ' restore register 5, turning DTR on
  211. ? "Ready to proceed."
  212. FN CarriageReturn
  213. RETURN ' de Disconnect
  214.  
  215. "Echo Mode"
  216. Echo = NOT Echo
  217. ? Cr$ Lf$ "Echo ";
  218. IF Echo ? "ON" ELSE ? "OFF"
  219. FN EmptyString
  220. RETURN ' de Echo Mode
  221.  
  222. "Send Text"
  223. ?
  224. "Get filename" ' if file is nil found, error trap returns here
  225. INPUT "File? "; File$
  226. IF LEN(File$) THEN File$ = UCASE$(File$) ELSE "Skip It"
  227. OPEN "I",1,File$
  228. INPUT "Slow? "; Slow
  229. WHILE NOT Done
  230. READ#1,A$;1 : A = ASC(A$)
  231. "Check EOF" ' error trap returns here if premature end of file 
  232. LONG IF A = 26
  233. Done = -1
  234. XELSE
  235. ? A$;
  236. FN Sendout
  237. ENDIF
  238. IF A = Cr THEN DELAY Slow * 5 ELSE DELAY Slow
  239. WEND
  240. CLOSE
  241. ? Cr$ Lf$ "Transmit Complete"
  242. "Skip It" ' check here to see if transmit was really done
  243. IF Done FN CarriageReturn ELSE FN EmptyString
  244. Done = 0
  245. RETURN ' de Send Text
  246.  
  247. "Word Wrap"
  248. Wrap = NOT Wrap
  249. ? Cr$ Lf$ "Word wrap ";
  250. IF Wrap ? "ON" ELSE ? "OFF"
  251. FN EmptyString
  252. RETURN ' de Word Wrap
  253.  
  254. END ' of Command Processor Subroutines
  255.  
  256. "Error Traps"
  257. IF ERROR = 259 THEN ERROR = 0 : CLOSE : RETURN "Get filename"
  258. IF ERROR = 257 THEN ERROR = 0 : A = 26 : RETURN "Check EOF"
  259.  
  260. ? "Error: " ERROR; ERRMSG$(ERROR) ' untrapped error stops here
  261. STOP
  262.