home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / enterprs / cpm / utils / s / vmap.ark / VMAP.BAS next >
Encoding:
BASIC Source File  |  1989-09-27  |  6.5 KB  |  173 lines
  1. 10 'VMAP.BAS VERSION 1.0
  2. 11 '
  3. 12 '
  4. 13 '
  5. 14 '--------------------------------------------------------------
  6. 20 'BATCH BUILD SEGMENT, 07/26/81, JWC
  7. 30 '
  8. 40 '
  9. 50 CL$=CHR$(12)'CLEAR SCREEN CODE FOR ADDS VIEWPOINT TERMINAL
  10. 60 FF$=CHR$(12)'FORMFEED CODE FOR CENTRONICS PRINTERS
  11. 70 '
  12. 80 '
  13. 90 PRINTCL$
  14. 100 INPUT "PROCESS LAST SETUP (Y/N) ";TI$:IFTI$="Y"THENGOTO170
  15. 105 PRINT
  16. 110 OPEN "O",#1,"A:VARDAT"
  17. 120 INPUT"FILE NAME, TERMINATOR, LOWER BOUND, UPPER BOUND ";PN$,TI$,LB!,UB!
  18. 130 PRINT#1,CHR$(34);PN$;CHR$(34);CHR$(34);TI$;CHR$(34);LB!,UB!
  19. 140 IFTI$="END"THENGOTO160
  20. 150 GOTO120
  21. 160 CLOSE1
  22. 161 '
  23. 162 '
  24. 163 '----------------------------------------------------
  25. 170 'MAPPING SEGMENT FOR BASIC FILES, 07/27/81, JWC
  26. 171 '
  27. 172 '
  28. 180 PRINTCL$:WIDTH 80:LC=0:DR%=0
  29. 190 OPEN"I",2,"A:VARDAT"
  30. 200 PRINT:PRINT:PRINT"ONE MOMENT FOR SETUP PLEASE.......":PRINT
  31. 210 INPUT"DO YOU WANT A PRINT OUT (Y/N) ";PO$
  32. 220 IF PO$="Y"THENPT$="P"ELSEPT$="N"
  33. 230 NX=80'MAX NUMBER OF VARIABLE CAPACITY
  34. 240 DIMV$(NX),NL%(NX),LL%(NX,NX-10),PA%(NX)
  35. 250 FORI=1TONX:PA%(I)=I:NEXTI
  36. 260 READNK:DIMK$(NK):DEFFNA$(A)=MID$(STR$(A),2)
  37. 270 FORI=1TONK:READK$(I):NEXTI
  38. 280 INPUT#2,PN$,I1$,LB!,UB!
  39. 290 PN$="A:"+PN$+".BAS"
  40. 300 OPEN"I",1,PN$
  41. 310 PRINT:PRINT"*** LINES BEING PROCESSED:":
  42. 320 IFEOF(1)THEN360
  43. 330 S=0:H=0:O=0:IN%=0:Q=0:LINEINPUT#1,L$
  44. 340 GOSUB740
  45. 350 IFN+32767!<UB!GOTO320
  46. 360 PRINT:PRINT:PRINT"SORTING VARIABLES....... "
  47. 370 GOSUB1160
  48. 380 IFPT$="P"THENGOTO530ELSEPRINT:PRINT:INPUT"HIT RETURN WHEN READY FOR LISTING ON CRT ";I$
  49. 390 PRINT:PRINT:PRINT"LIST OF VARIABLES FOR PROGRAM ";PN$:PRINT
  50. 400 FORI=1TONF
  51. 410 PRINTV$(I);TAB(15);"-";
  52. 420 FORJ=0TONL%(PA%(I))-1:IFJ>0THENPRINT", ";
  53. 430 PRINTFNA$(LL%(PA%(I),J)+32767!);
  54. 440 NEXTJ
  55. 450 PRINT:PRINT:NEXTI
  56. 460 GOTO630
  57. 470 CLOSE1
  58. 480 IFI1$="K"THENPRINT"KILL '";PN$;"',";DR%:KILLPN$,DR%
  59. 490 IFI1$="P"THEN530
  60. 500 IFI1$="C"THEN180
  61. 510 IFI1$<>"END"THENRUN
  62. 520 CLOSE2:PRINT:PRINT"*** END OF VARIABLE MAP PROGRAM ***":END
  63. 530 GOSUB1250:LPRINTTAB(50);"LINES";NL+32767!;"TO";N+32767!:LPRINT:LC=LC+2
  64. 540 FORI=1TONF:LPRINTSTR$(I);".";TAB(6);V$(I);TAB(15);"-";:C=0
  65. 550 FORJ=0TONL%(PA%(I))-1:IFCTHENLPRINT", ";:ELSEC=-1
  66. 560 IFJMOD13=12THENLPRINT:LC=LC+1:LPRINTTAB(15);"-";
  67. 570 LPRINTFNA$(LL%(PA%(I),J)+32767!);
  68. 580 NEXTJ
  69. 590 LPRINT:LPRINT:LC=LC+2
  70. 600 IF LC>60THENGOSUB1240:GOSUB1250:LPRINT:LC=LC+1
  71. 610 NEXTI
  72. 620 IFLC>50THENGOSUB1240:GOSUB1250:LPRINT:LC=LC+1
  73. 630 IFPT$="P"THENLPRINT:LPRINT"EQUIVALENT VARIABLES":LC=LC+3
  74. 640 V$="$(!(#(%("
  75. 650 FORI=0TONF-1:FORJ=I+1TONF-1
  76. 660 IFLEFT$(V$(I),2)<>LEFT$(V$(J),2)ORLEFT$(V$(I),2)="FN"THEN700
  77. 670 ONERRORGOTO1390
  78. 680 IF(INSTR(V$,RIGHT$(V$(I),2))<>INSTR(V$,RIGHT$(V$(J),2)))OR(INSTR(V$(RIGHT$(V$(I),1))<>INSTR(V$(RIGHT$(V$(J),1)))THEN700
  79. 690 IFPT$="P"THENGOSUB990:LPRINTV$(I);"=";V$(J)ELSELPRINTV$(I);"=";V$(J):LC=LC+1:EF%=-1
  80. 700 NEXTJ:NEXTI
  81. 710 IFNOTEF%THENIFPT$="P"THENLPRINT"** NONE FOUND **":LC=LC+1
  82. 720 IFPT$="P"THENGOSUB1240
  83. 730 GOTO470
  84. 731 '
  85. 732 '
  86. 733 '
  87. 734 '-------------------------------------------------------------
  88. 735 'VARIABLE SEARCH SUBROUTINE
  89. 736 '
  90. 737 '
  91. 740 R=0:V=0:X=INSTR(L$," "):N=VAL(LEFT$(L$,X))-32767!:S$=MID$(L$,X+1)
  92. 750 IFN+32767!>UB!THENRETURN
  93. 760 IFN+32767!<LB!THENRETURN ELSEPRINT:PRINTL$:PRINTTAB(5);:IFNOTXN%THENXN%=-1:NL=N
  94. 770 IFLEFT$(S$,1)=" "THENS$=MID$(S$,2):GOTO770
  95. 780 IF INSTR(S$,"DATA")=1THENRETURN
  96. 790 FORI=1TOLEN(S$)
  97. 800 X$=MID$(S$,I,1):X=ASC(X$)
  98. 810 IFNOTSTHEN860
  99. 820 IFHTHENIF(X=>48ANDX<=57)OR(X=>65ANDX<=70)THEN950ELSEH=0:S=0:GOTO860
  100. 830 IFOTHENIF(X=>48ANDX<=57)THEN950ELSEO=0:S=0:GOTO860
  101. 840 IFX=72ANDNOTHTHENH=-1:GOTO950
  102. 850 IFX=79ANDNOTOTHENO=-1:GOTO950ELSES=0:H=0:O=0
  103. 860 IFX=34THENIFQTHENQ=0:V$="":GOTO950ELSEQ=-1:GOTO950
  104. 870 IFQTHEN950
  105. 880 IFX=39THENRETURN 'REMARK
  106. 890 IFX=38THENS=-1:GOTO950
  107. 900 IF(X=>48ANDX<=57)OR(X=>65ANDX<=90)OR(X=35ORX=33ORX=36ORX=37)THENIFVTHENV$=V$+X$:GOTO950ELSEV$=X$:V=-1:GOTO950
  108. 910 IFX=40ANDVTHENV$=V$+X$
  109. 920 IFNOTVTHEN950
  110. 930 GOSUB960:V=0
  111. 940 IFRTHENRETURN
  112. 950 NEXTI:IFNOTVTHENRETURN
  113. 951 '
  114. 952 '
  115. 953 '
  116. 954 '------------------------------------------------------
  117. 955 'KEYWORD COMPARE SUBROUTINE
  118. 956 '
  119. 957 '
  120. 960 IFV$="REM"ORV$="DATA"THENR=-1:RETURN'SUB ---- 20000
  121. 970 IFVAL(V$)<>0ORLEFT$(V$,1)="0"THENV$=MID$(V$,2):GOTO970
  122. 980 FORJ=1TONK:Y=INSTR(V$,K$(J)):IFY=0THEN1030
  123. 990 IFV$=K$(J)THENRETURN'KEY WORD
  124. 1000 IFLEFT$(V$,LEN(K$(J)))=K$(J)THENV$=MID$(V$,LEN(K$(J))+1):GOTO960
  125. 1010 IFRIGHT$(V$,LEN(K$(J)))=K$(J)THENV$=MID$(V$,1,LEN(V$)-LEN(K$(J))):GOTO960
  126. 1020 VH$=MID$(V$,Y+LEN(K$(J))):V$=LEFT$(V$,Y-1):GOSUB960:IFRTHENRETURNELSEV$=VH$:GOTO960
  127. 1030 NEXTJ
  128. 1040 IFV$="("ORV$=""ORV$="!"ORV$="%"ORV$="#"THENRETURN
  129. 1050 IFIN%THENPRINT";";:ELSEIN%=-1
  130. 1060 IFNF=0THEN1130
  131. 1070 FORJ=0TONF
  132. 1080 IFV$<>V$(J)THEN1110
  133. 1090 IFLL%(J,NL%(J)-1)=NTHENRETURN
  134. 1100 IFNL%(J)<80THENLL%(J,NL%(J))=N:NL%(J)=NL%(J)+1:PRINTV$;",<";FNA$(NL%(J));">";:RETURN
  135. 1110 NEXTJ
  136. 1120 IFNF=NX-1THENPRINT:PRINT"OUT OF ROOM FOR VARIABLES, CONTINUE NEXT RUN...":GOTO360
  137. 1130 PRINTV$;",[";FNA$(NF+1);"]";
  138. 1140 V$(NF)=V$:LL%(NF,NL%(NF))=N:NL%(NF)=NL%(NF)+1:NF=NF+1
  139. 1150 RETURN
  140. 1151 '
  141. 1152 '
  142. 1153 '
  143. 1154 '-----------------------------------------------------------
  144. 1155 'SORT SUBROUTINE
  145. 1156 '
  146. 1157 '
  147. 1160 DIMH(9):H(1)=1:H(2)=4:H(3)=13:T=1
  148. 1170 IFH(T+2)<5000THENT=T+1:H(T+2)=3*H(T+1)+1:GOTO1170
  149. 1180 IFNF=0THENRETURNELSEFORT=1TO6:IFH(T+2)<NFTHENNEXT
  150. 1190 FORS=TTO1STEP-1:H=H(S):FORJJ=HTONF
  151. 1200 V$=V$(JJ):PA%=PA%(JJ):FORII=JJ-HTO0STEP-H
  152. 1210 IFV$<V$(II)THENV$(II+H)=V$(II):PA%(II+H)=PA%(II):NEXT
  153. 1220 V$(II+H)=V$:PA%(II+H)=PA%:NEXTJJ,S
  154. 1230 RETURN
  155. 1240 FORIK=LCTO65:LPRINT:NEXTIK:LC=0:RETURN
  156. 1250 LPRINTFF$:LPRINT:LPRINT:LPRINT"LIST OF VARIABLES FOR PROGRAM ";PN$;:LC=LC+3:RETURN
  157. 1260 DATA116
  158. 1270 DATA CONSOLE,RESTORE,SPACE$(,UNLOAD
  159. 1280 DATA LPRINT,DEFDBL,DEFINT,DEFSNG,DEFSTR,DELETE,RESUME,RETURN,RIGHT$
  160. 1290 DATA PRINT,LLIST,INPUT,CLEAR,CLOAD,CLOSE,CSAVE,DSKI$,DSKO$,ERASE
  161. 1300 DATA ERROR,FIELD,FILES,GOSUB,INSTR,LEFT$,MERGE,MOUNT,TROFF,USING
  162. 1310 DATA TRON,CDBL,CHR$,CINT,CONT,CSNG,DSKF,EDIT,ELSE,GOTO,KILL,LINE
  163. 1320 DATA LIST,LOAD,LPOS,LSET,MID$,MKD$,MKI$,MKS$,NAME,NEXT,NULL,OPEN
  164. 1330 DATA PEEK,POKE,READ,RSET,SAVE,SPC,(,STEP,STOP,STR$,SWAP,TAB(,THEN,WAIT
  165. 1340 DATA ABS,AND,ASC,ATN,COS,CVD,CVI,CVS,DEF,DIM,END,EOF,ERL,ERR,EXP,FOR
  166. 1350 DATA FRE,GET,INP,INT,LEN,LET,LOC,LOF,LOG,MOD,NEW,NOT,OUT,POS,PUT,RND
  167. 1360 DATA RUN,SGN,SIN,SQR,TAN,USR,BAL
  168. 1370 DATA AS,IF,TO,ON,OR
  169. 1380 DATA WIDTH,TAB
  170. 1390 IFERR=13THENPRINT:PRINT:PRINT"**** NO VARIABLES FOUND *****":PRINT:GOTO470
  171. 1400 PRINT"ERROR CODE IS ";ERR;" ON LINE NUMBER ";ERL;:PRINT:END
  172. NT:PRINT:PRINT"**** NO VARIABLES FOUND *****":PRINT:GOTO470
  173. 1400 PRINT"ERROR CODE