home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / JSAGE / ZSUS / PROGPACK / Z3BAS.LBR / Z3BAS.LZB / Z3BAS.LIB
Text File  |  2000-06-30  |  5KB  |  120 lines
  1. 10000 '
  2. 10010 ' Z3BAS.LIB
  3. 10020 '
  4. 10030 ' Version: 1.0.  Date: 6/7/90
  5. 10040 ' Author: Lee Bradley, Sysop, Z-Node 12, 203-665-1100
  6. 10050 '
  7. 10060 ' Include these routines in your program and reference them
  8. 10070 ' when you need to determine environment address, load a tcap 
  9. 10080 ' string, position the cursor, determine the status of the 
  10. 10090 ' wheel byte, quiet flag etc.
  11. 10100 '
  12. 10110 ' ---
  13. 10120 ' Load ENV with environment address.
  14. 10130 ' ---
  15. 10140 '
  16. 10150 IF CHR$(PEEK(&H103))+CHR$(PEEK(&H104))="Z3" THEN 10220
  17. 10160 ' ==> NOTE! Edit &H value below. Will be used under MBASIC.
  18. 10170 ENV=&HE780+65536! ' Note need to make positive by adding 2^16
  19. 10180 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
  20. 10190 IF ENV1=ENV THEN 10290
  21. 10200 PRINT:PRINT "ZCPR3 required. If running ZCPR3, change statement"
  22. 10210 PRINT "ENV=&H ...  above.":SYSTEM
  23. 10220 IF PEEK(&H10A)<> 0 THEN 10250
  24. 10230 PRINT "If not ZCPR3 version ZCPR33+ you must use Z3INS "
  25. 10240 PRINT "ZCPR33+ was not found. ":ENV=0:GOTO 10290
  26. 10250 ENV=PEEK(&H109)+256*PEEK(&H10A)
  27. 10260 ENV1=PEEK(ENV+&H1B)+256*PEEK(ENV+&H1C)
  28. 10270 IF ENV1=ENV THEN 10290
  29. 10280 PRINT:PRINT "Environment self-reference error detected":END
  30. 10290 RETURN
  31. 10300 '
  32. 10310 ' ---
  33. 10320 ' Load X$ with tcap string based on TINDEX, a tcap string "index"
  34. 10330 ' and ENV, the environment address.
  35. 10340 ' X$ will hold terminal id string if TINDEX is 0
  36. 10350 ' X$ will hold clear screen string if TINDEX is 1. Etc.
  37. 10360 ' ---
  38. 10370 '
  39. 10380 J=128                  ' Start at beginning of tcap segment
  40. 10390 IF TINDEX=0 THEN 10480 ' No need to skip anything if looking for id
  41. 10400 J=J+16+4+3             ' Get past id, arrow and delay bytes 
  42. 10410 IF TINDEX=1 THEN 10480 ' No need to skip any more if clear scr wanted
  43. 10420 FOR I=1 TO TINDEX-1    ' Skip the strings we don't want
  44. 10430 IF CHR$(PEEK(ENV+J))<>"\" THEN 10450     ' Catch literals
  45. 10440 J=J+2                                    ' advance to next character 
  46. 10450 IF PEEK(ENV+J)<>0 THEN J=J+1:GOTO 10430  ' Loop till null found
  47. 10460 J=J+1                  ' Advance and move to next string
  48. 10470 NEXT
  49. 10480 ' Build tcap string
  50. 10490 X$=""                  ' Null out work string 
  51. 10500 IF CHR$(PEEK(ENV+J))<>"\" THEN 10520     ' Catch literals
  52. 10510 J=J+1:GOTO 10550                         ' Advance to literal
  53. 10520 IF J=128+13 AND TINDEX=0 THEN RETURN     ' Get out if id complete
  54. 10530 IF PEEK(ENV+J)<>0 THEN 10550             ' If null
  55. 10540 RETURN                                   ' return
  56. 10550 X$=X$+CHR$(PEEK(ENV+J)):J=J+1:GOTO 10500 ' else, grab it and loop  
  57. 10560 '
  58. 10570 ' ---
  59. 10580 ' Cursor motion macro interpreter
  60. 10590 ' Input: R,C,CM$ (row,col,cursor motion macro)
  61. 10600 ' Output: CMO$ (string to output to the terminal)
  62. 10610 ' Ref: ZCPR3 The Manual, Richard Conn, Ch 22.
  63. 10620 ' ---
  64. 10630 '
  65. 10640 DIM OFFSET(2),PREINFIX$(2),RC(2),CMD$(2)
  66. 10650 WK$="":PCTR=0:I1=0:OFFSET(1)=0:OFFSET(2)=0 ' Initialize
  67. 10660 PREINFIX$(1) = "":PREINFIX$(2) = "":RC(1)=R:RC(2)=C ' Initialize 
  68. 10670 I1=I1+1:IF I1>LEN(CM$) THEN 10980  ' Top of loop
  69. 10680 CMC$=MID$(CM$,I1,1)                ' Load cursor motion macro char.
  70. 10690 IF CMC$<>"%" THEN 10950            ' If not a %, tack onto work string
  71. 10700 I1=I1+1:CMC$=MID$(CM$,I1,1)        ' Advance
  72. 10710 RI=INSTR("RrIi",CMC$)
  73. 10720 IF RI=1 OR RI=2 THEN CB4R$="ON":GOTO 10670 ' Handle R,I commands
  74. 10730 IF RI=3 OR RI=4 THEN HOME=1:GOTO 10670
  75. 10740 PCTR=PCTR+1                      ' Update % counter
  76. 10750 PREINFIX$(PCTR)=WK$              ' Save work string 
  77. 10760 WK$=""                           ' Null out for future build
  78. 10770 IF CMC$<>"." THEN 10800          ' Binary ?
  79. 10780 CMD$(PCTR)=CHR$(RC(PCTR)+HOME)
  80. 10790 GOTO 10670   ' Loop
  81. 10800 D23=INSTR("D23d",CMC$):IF D23=0 THEN 10860 ' Ascii?
  82. 10810 CMD$(PCTR)=MID$(STR$(RC(PCTR)+HOME),2)
  83. 10820 IF LEN(CMD$(PCTR))=1 AND D23=2 THEN CMD$(PCTR)="0"+CMD$(PCTR) ' Fix
  84. 10830 IF LEN(CMD$(PCTR))=1 AND D23=3 THEN CMD$(PCTR)="00"+CMD$(PCTR)
  85. 10840 IF LEN(CMD$(PCTR))=2 AND D23=3 THEN CMD$(PCTR)="0"+CMD$(PCTR)
  86. 10850 GOTO 10670  ' Loop
  87. 10860 IF CMC$<>"+" THEN 10910  ' Offset?
  88. 10870 I1=I1+1:CMC$=MID$(CM$,I1,1)
  89. 10880 OFFSET(PCTR)=ASC(CMC$)
  90. 10890 CMD$(PCTR)=CHR$(RC(PCTR)+HOME+OFFSET(PCTR))
  91. 10900 GOTO 10670  ' Loop
  92. 10910 IF CMC$<>">" THEN PRINT "Error in cursor motion macro ... ":END
  93. 10920 I1=I1+1:CMC1$=MID$(CM$,I1,1):I1=I1+1:CMC$=MID$(CM$,I1,1)
  94. 10930 IF CHR$(RC(PCTR))>CMC1$ THEN 10880 ELSE 10890
  95. 10940 ' Compute conditional offset, then use "+" code
  96. 10950 ' We have a character that's not part of a % command. Just add it
  97. 10960 WK$=WK$+CMC$
  98. 10970 GOTO 10670  ' Loop
  99. 10980 ' All done. Anything left (in WK$) is the postfix part.
  100. 10990 IF CB4R$="ON" THEN SWAP CMD$(1),CMD$(2)  ' If col before row, swap
  101. 11000 CMO$=PREINFIX$(1)+CMD$(1)+PREINFIX$(2)+CMD$(2)+WK$  ' Build CMO$
  102. 11010 RETURN
  103. 11020 '
  104. 11030 ' ---
  105. 11040 ' Load variables (QUIET, WHEEL etc.) based on ENV,
  106. 11050 ' the environment address. 
  107. 11060 ' ---
  108. 11070 '
  109. 11080 QUIET=PEEK(ENV+&H28):RETURN
  110. 11090 WHLA=PEEK(ENV+&H29)+256*PEEK(ENV+&H2A):RETURN
  111. 11100 WHEEL=PEEK(WHLA):RETURN
  112. 11110 MHZ=PEEK(ENV+&H2B):RETURN
  113. 11120 MAXD=PEEK(ENV+&H2C):RETURN
  114. 11130 MAXU=PEEK(ENV+&H2D):RETURN
  115. 11140 DUOK=PEEK(ENV+&H2E):RETURN
  116. 11150 '
  117. V+&H2B):RETURN
  118. 11120 MAXD=PEEK(ENV+&H2C):RETURN
  119. 11130 MAXU=PEEK(ENV+&H2D):RETURN
  120. 11140 DUOK=PEEK(ENV+&H2E