home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / jsage / znode3 / uploads / z3bas.lbr / TCAP24.BZS / TCAP24.BAS
Encoding:
BASIC Source File  |  1993-06-07  |  10.6 KB  |  275 lines
  1. 10   '
  2. 20   ' TCAP.BAS, Version 2.4
  3. 30   '
  4. 40   ' Original Idea: Biff Bueffel
  5. 50   ' Date: 7 May 90
  6. 60   ' By: Lee Bradley 
  7. 70   '
  8. 80   ' TCAP began life as a sample program to show how Basic code 
  9. 90   ' and the proper use of the linker can be used to capture 
  10. 100  ' terminal capability data if available on a Z-System 
  11. 110  ' computer. It seems to have evolved into a fairly handy 
  12. 120  ' (albeit still simple) Z-System viewing tool.
  13. 130  '
  14. 140  ' TCAP determines if ZCPR3 is running and if so, gathers 
  15. 150  ' environment and tcap data, signs on, displays cpu speed, 
  16. 160  ' terminal id and ...
  17. 170  '
  18. 180  ' if the wheel is set ...
  19. 190  '
  20. 200  ' a command line which includes a help selection.  From here, 
  21. 210  ' the user may select various memory display options, 
  22. 220  ' (forward, backward, specific address, character, hex or 
  23. 230  ' both) or toggle the quiet flag or reset the wheel byte.  
  24. 240  ' Pressing the return key, the reset wheel key (W) or any key 
  25. 250  ' other than the memory display selection keys (>,<,A,C,H,B), 
  26. 260  ' the quiet toggle key (Q) or the help key (/) will quit the 
  27. 270  ' program.
  28. 280  '
  29. 290  ' Lee Bradley, Sysop, Z-Node #12 (203) 665-1100
  30. 300  '
  31. 310  ' To compile and link:
  32. 320  '
  33. 330  ' BASCOM =TCAP24/Z/E
  34. 340  ' L80 Z3HDR,TCAPxx,TCAPxx/N/E
  35. 350  '
  36. 360  ' where Z3HDR.REL is the Microsoft REL form of:
  37. 370  '
  38. 380  '   CSEG
  39. 390  '   DEFB 'Z3ENV'
  40. 400  '   DEFB 1
  41. 410  '   DEFW 0
  42. 420  '   END
  43. 430  '
  44. 440 ON ERROR GOTO 1560
  45. 450 VER$="2.4"
  46. 460 D$="C" ' Set display mode to char ("H" would give hex, "B", both) 
  47. 470 GOSUB 1740 ' Get environment address
  48. 480 TINDEX=0:GOSUB 1970:TID$=X$ ' Get terminal id string
  49. 490 TINDEX=1:GOSUB 1970:CL$=X$  ' clear screen
  50. 500 TINDEX=4:GOSUB 1970:SO$=X$  ' start highlighting
  51. 510 TINDEX=5:GOSUB 1970:SE$=X$  ' stop highlighting
  52. 520 GOSUB 2680 ' Get wheel address
  53. 530 GOSUB 2690 ' Get wheel status
  54. 540 GOSUB 2700 ' Get cpu speed
  55. 550 PRINT CL$+ "TCAP, Version "+VER$
  56. 560 GOSUB 2670 ' Get quiet flag
  57. 570 PRINT:PRINT SO$+"Cpu Speed:"+SE$;MHZ;"MHz "+SO$+" Terminal:"+SE$+" "+TID$
  58. 580 IF WHEEL=0 THEN END ELSE 910
  59. 590 PRINT "Enter hex address or <ret> for Z3 env ("+HEX$(ENV)+") ";:ADR$=""
  60. 600 IF LEN(ADR$)=4 THEN PRINT CL$;:GOTO 670
  61. 610 IN$=INKEY$:IF LEN(IN$)=0 THEN 610
  62. 620 IF IN$=CHR$(13) THEN PRINT CL$;:GOTO 670
  63. 630 IF (IN$>="a" AND IN$<="f") THEN IN$=CHR$(ASC(IN$)-32) ' Upper case
  64. 640 IF (IN$>="0" AND IN$<="9") OR (IN$>="A" AND IN$<="F") THEN 660
  65. 650 PRINT CHR$(7);:GOTO 600
  66. 660 PRINT IN$;:ADR$=ADR$+IN$:GOTO 600
  67. 670 IF LEN(ADR$)=0 THEN ADR$=HEX$(ENV)
  68. 680 GOSUB 1230 ' Convert hex to decimal
  69. 690 '
  70. 700 ' Display selected sector(s) entry point
  71. 710 '
  72. 720 ULIM=15:IF D$="B" THEN ULIM=7:PASS=1
  73. 730 FOR I=0 TO ULIM
  74. 740 IF I=0 OR I=8 THEN GOSUB 1160 ' Output heading line
  75. 750 FOR J=0 TO 15
  76. 760 IF J<>0 THEN 800
  77. 770 ADR$=HEX$(ADR+16*I)
  78. 780 IF LEN(ADR$)<>4 THEN ADR$="0"+ADR$:GOTO 780
  79. 790 PRINT SO$+ADR$+SE$+"           ";
  80. 800 BYTE=PEEK(ADR+16*I+J)
  81. 810 BYTEHEX$=HEX$(BYTE)+" "
  82. 820 IF LEN(BYTEHEX$)=2 THEN BYTEHEX$="0"+BYTEHEX$
  83. 830 BYTECHR$=" . ":IF BYTE>=32 AND BYTE<=126 THEN BYTECHR$=" "+CHR$(BYTE)+" "
  84. 840 IF D$="H" THEN BYTE$=BYTEHEX$:GOTO 870
  85. 850 IF D$="C" THEN BYTE$=BYTECHR$:GOTO 870
  86. 860 IF PASS=1 THEN BYTE$=BYTEHEX$ ELSE BYTE$=BYTECHR$
  87. 870 PRINT BYTE$;
  88. 880 NEXT:PRINT:NEXT
  89. 890 IF D$="B" AND PASS=1 THEN PASS=2:GOTO 730
  90. 900 '
  91. 910 ' Build command prompt
  92. 920 '
  93. 930 IF D$="C" THEN MODE$="H,B,"
  94. 940 IF D$="H" THEN MODE$="C,B,"
  95. 950 IF D$="B" THEN MODE$="H,C,"
  96. 960 CMD$="(/ for help) "
  97. 970 IF QUIET=0 THEN CMD$="(>,<,A,"+MODE$+"W,Q,X or / for help) "
  98. 980 PRINT:PRINT "Cmd "+CMD$;
  99. 990 A$=INKEY$:IF LEN(A$)=0 THEN 990
  100. 1000 IF A$=CHR$(13) THEN 1140
  101. 1010 IF D$="B" THEN INCR=128 ELSE INCR=256
  102. 1020 IF A$=">" OR A$="." THEN ADR=ADR+INCR:PRINT CL$;:GOTO 700
  103. 1030 IF A$="<" OR A$="," THEN ADR=ADR-INCR:PRINT CL$;:GOTO 700
  104. 1040 IF A$="A" OR A$="a" THEN PRINT CL$;:GOTO 590
  105. 1050 IF A$="/" OR A$="?" THEN PRINT CL$;:GOSUB 1340:GOTO 900
  106. 1060 IF NOT (A$="Q" OR A$="q") THEN 1090
  107. 1070 IF QUIET<>0 THEN POKE ENV+&H28,0 ELSE POKE ENV+&H28,1
  108. 1080 GOTO 550 ' Loop back to beginning
  109. 1090 IF NOT (A$="W" OR A$="w") THEN 1110
  110. 1100 POKE WHLA,0:GOTO 1140
  111. 1110 IF (A$="C" OR A$="c") THEN D$="C":PRINT CL$;:GOTO 700
  112. 1120 IF (A$="H" OR A$="h") THEN D$="H":PRINT CL$;:GOTO 700
  113. 1130 IF (A$="B" OR A$="b") THEN D$="B":PRINT CL$;:GOTO 700
  114. 1140 PRINT CL$
  115. 1150 END
  116. 1160 '
  117. 1170 ' Heading line subroutine
  118. 1180 '
  119. 1190 PRINT:PRINT "              "+SO$;
  120. 1200 FOR K=0 TO 15:PRINT " 0"+HEX$(K);:NEXT:PRINT SE$
  121. 1210 PRINT
  122. 1220 RETURN
  123. 1230 '
  124. 1240 ' Convert hex string ADR$ to decimal number ADR
  125. 1250 '
  126. 1260 IF LEN(ADR$)<4 THEN ADR$="0"+ADR$:GOTO 1260
  127. 1270 ADR=0
  128. 1280 FOR I=0 TO 3
  129. 1290 ASCII=ASC(MID$(ADR$,I+1,1))-&H30
  130. 1300 IF ASCII>9 THEN ASCII=ASCII-7
  131. 1310 ADR=ADR+ASCII*16^(3-I)
  132. 1320 NEXT
  133. 1330 RETURN
  134. 1340 '
  135. 1350 ' Help subroutine
  136. 1360 '
  137. 1370 PRINT CL$
  138. 1380 PRINT "            "+SO$+"Memory Viewing Commands"+SE$
  139. 1390 PRINT
  140. 1400 PRINT "> or .  show the next" INCR "bytes, from hex "+HEX$(ADR+INCR) 
  141. 1410 PRINT "< or ,  show the previous" INCR "bytes, from hex "+HEX$(ADR-INCR)
  142. 1420 PRINT "A or a  enter a start address to view"
  143. 1430 PRINT     
  144. 1440 PRINT "H or h  hex display"
  145. 1450 PRINT "C or c  character display"
  146. 1460 PRINT "B or b  both hex and character display"
  147. 1470 PRINT
  148. 1480 PRINT "            "+SO$+"Other Commands"+SE$
  149. 1490 PRINT
  150. 1500 PRINT "Q or q  toggle quiet state, clear display"
  151. 1510 PRINT "W or w  turn wheel off and quit"
  152. 1520 PRINT
  153. 1530 PRINT "X or x  (or <ret> etc.) quit"
  154. 1540 RETURN
  155. 1550 '
  156. 1560 ' Error handler
  157. 1570 '
  158. 1580 PRINT "Error " ERN "on line" ERL:PRINT " Aborting ...":END
  159. 1590 '
  160. 1600 ' Z3BAS.LIB
  161. 1610 '
  162. 1620 ' Version: 1.0.  Date: 6/7/90
  163. 1630 ' Author: Lee Bradley, Sysop, Z-Node 12, 203-665-1100
  164. 1640 '
  165. 1650 ' Include these routines in your program and reference them
  166. 1660 ' when you need to determine environment address, load a tcap 
  167. 1670 ' string, position the cursor, determine the status of the 
  168. 1680 ' wheel byte, quiet flag etc.
  169. 1690 '
  170. 1700 ' ---
  171. 1710 ' Load ENV with environment address.
  172. 1720 ' ---
  173. 1730 '
  174. 1740 IF CHR$(PEEK(&H103))+CHR$(PEEK(&H104))="Z3" THEN 1810
  175. 1750 ' ==> NOTE! Edit &H value below. Will be used under MBASIC.
  176. 1760 ENV=&HE780+65536! ' Note need to make positive by adding 2^16
  177. 1770 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
  178. 1780 IF ENV1=ENV THEN 1880
  179. 1790 PRINT:PRINT "ZCPR3 required. If running ZCPR3, change statement"
  180. 1800 PRINT "ENV=&H ...  above.":SYSTEM
  181. 1810 IF PEEK(&H10A)<> 0 THEN 1840
  182. 1820 PRINT "If not ZCPR3 version ZCPR33+ you must use Z3INS "
  183. 1830 PRINT "ZCPR33+ was not found. ":ENV=0:GOTO 1880
  184. 1840 ENV=PEEK(&H109)+256*PEEK(&H10A)
  185. 1850 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
  186. 1860 IF ENV1=ENV THEN 1880
  187. 1870 PRINT:PRINT "Environment self-reference error detected":END
  188. 1880 RETURN
  189. 1890 '
  190. 1900 ' ---
  191. 1910 ' Load X$ with tcap string based on TINDEX, a tcap string "index"
  192. 1920 ' and ENV, the environment address.
  193. 1930 ' X$ will hold terminal id string if TINDEX is 0
  194. 1940 ' X$ will hold clear screen string if TINDEX is 1. Etc.
  195. 1950 ' ---
  196. 1960 '
  197. 1970 J=128                  ' Start at beginning of tcap segment
  198. 1980 IF TINDEX=0 THEN 2070 ' No need to skip anything if looking for id
  199. 1990 J=J+16+4+3             ' Get past id, arrow and delay bytes 
  200. 2000 IF TINDEX=1 THEN 2070 ' No need to skip any more if clear scr wanted
  201. 2010 FOR I=1 TO TINDEX-1    ' Skip the strings we don't want
  202. 2020 IF CHR$(PEEK(ENV+J))<>"\" THEN 2040     ' Catch literals
  203. 2030 J=J+2                                    ' advance to next character 
  204. 2040 IF PEEK(ENV+J)<>0 THEN J=J+1:GOTO 2020  ' Loop till null found
  205. 2050 J=J+1                  ' Advance and move to next string
  206. 2060 NEXT
  207. 2070 ' Build tcap string
  208. 2080 X$=""                  ' Null out work string 
  209. 2090 IF CHR$(PEEK(ENV+J))<>"\" THEN 2110     ' Catch literals
  210. 2100 J=J+1:GOTO 2140                         ' Advance to literal
  211. 2110 IF J=128+13 AND TINDEX=0 THEN RETURN     ' Get out if id complete
  212. 2120 IF PEEK(ENV+J)<>0 THEN 2140             ' If null
  213. 2130 RETURN                                   ' return
  214. 2140 X$=X$+CHR$(PEEK(ENV+J)):J=J+1:GOTO 2090 ' else, grab it and loop  
  215. 2150 '
  216. 2160 ' ---
  217. 2170 ' Cursor motion macro interpreter
  218. 2180 ' Input: R,C,CM$ (row,col,cursor motion macro)
  219. 2190 ' Output: CMO$ (string to output to the terminal)
  220. 2200 ' Ref: ZCPR3 The Manual, Richard Conn, Ch 22.
  221. 2210 ' ---
  222. 2220 '
  223. 2230 DIM OFFSET(2),PREINFIX$(2),RC(2),CMD$(2)
  224. 2240 WK$="":PCTR=0:I1=0:OFFSET(1)=0:OFFSET(2)=0 ' Initialize
  225. 2250 PREINFIX$(1) = "":PREINFIX$(2) = "":RC(1)=R:RC(2)=C ' Initialize 
  226. 2260 I1=I1+1:IF I1>LEN(CM$) THEN 2570  ' Top of loop
  227. 2270 CMC$=MID$(CM$,I1,1)                ' Load cursor motion macro char.
  228. 2280 IF CMC$<>"%" THEN 2540            ' If not a %, tack onto work string
  229. 2290 I1=I1+1:CMC$=MID$(CM$,I1,1)        ' Advance
  230. 2300 RI=INSTR("RrIi",CMC$)
  231. 2310 IF RI=1 OR RI=2 THEN CB4R$="ON":GOTO 2260 ' Handle R,I commands
  232. 2320 IF RI=3 OR RI=4 THEN HOME=1:GOTO 2260
  233. 2330 PCTR=PCTR+1                      ' Update % counter
  234. 2340 PREINFIX$(PCTR)=WK$              ' Save work string 
  235. 2350 WK$=""                           ' Null out for future build
  236. 2360 IF CMC$<>"." THEN 2390          ' Binary ?
  237. 2370 CMD$(PCTR)=CHR$(RC(PCTR)+HOME)
  238. 2380 GOTO 2260   ' Loop
  239. 2390 D23=INSTR("D23d",CMC$):IF D23=0 THEN 2450 ' Ascii?
  240. 2400 CMD$(PCTR)=MID$(STR$(RC(PCTR)+HOME),2)
  241. 2410 IF LEN(CMD$(PCTR))=1 AND D23=2 THEN CMD$(PCTR)="0"+CMD$(PCTR) ' Fix
  242. 2420 IF LEN(CMD$(PCTR))=1 AND D23=3 THEN CMD$(PCTR)="00"+CMD$(PCTR)
  243. 2430 IF LEN(CMD$(PCTR))=2 AND D23=3 THEN CMD$(PCTR)="0"+CMD$(PCTR)
  244. 2440 GOTO 2260  ' Loop
  245. 2450 IF CMC$<>"+" THEN 2500  ' Offset?
  246. 2460 I1=I1+1:CMC$=MID$(CM$,I1,1)
  247. 2470 OFFSET(PCTR)=ASC(CMC$)
  248. 2480 CMD$(PCTR)=CHR$(RC(PCTR)+HOME+OFFSET(PCTR))
  249. 2490 GOTO 2260  ' Loop
  250. 2500 IF CMC$<>">" THEN PRINT "Error in cursor motion macro ... ":END
  251. 2510 I1=I1+1:CMC1$=MID$(CM$,I1,1):I1=I1+1:CMC$=MID$(CM$,I1,1)
  252. 2520 IF CHR$(RC(PCTR))>CMC1$ THEN 2470 ELSE 2480
  253. 2530 ' Compute conditional offset, then use "+" code
  254. 2540 ' We have a character that's not part of a % command. Just add it
  255. 2550 WK$=WK$+CMC$
  256. 2560 GOTO 2260  ' Loop
  257. 2570 ' All done. Anything left (in WK$) is the postfix part.
  258. 2580 IF CB4R$="ON" THEN SWAP CMD$(1),CMD$(2)  ' If col before row, swap
  259. 2590 CMO$=PREINFIX$(1)+CMD$(1)+PREINFIX$(2)+CMD$(2)+WK$  ' Build CMO$
  260. 2600 RETURN
  261. 2610 '
  262. 2620 ' ---
  263. 2630 ' Load variables (QUIET, WHEEL etc.) based on ENV,
  264. 2640 ' the environment address. 
  265. 2650 ' ---
  266. 2660 '
  267. 2670 QUIET=PEEK(ENV+&H28):RETURN
  268. 2680 WHLA=PEEK(ENV+&H29)+256*PEEK(ENV+&H2A):RETURN
  269. 2690 WHEEL=PEEK(WHLA):RETURN
  270. 2700 MHZ=PEEK(ENV+&H2B):RETURN
  271. 2710 MAXD=PEEK(ENV+&H2C):RETURN
  272. 2720 MAXU=PEEK(ENV+&H2D):RETURN
  273. 2730 DUOK=PEEK(ENV+&H2E):RETURN
  274. 2740 '
  275.