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 / CPM / DATABASE / DIMS103.ARK / DSORT.ASC < prev    next >
Text File  |  1986-12-07  |  14KB  |  484 lines
  1. 10 PRINT"DSORT must be entered via DIMS
  2. 20 STOP
  3. 1000 DEFINT A-Z
  4. 1010 ON ERROR GOTO 3760
  5. 1020 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  6.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  7.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  8. 1040 NK=0:DIM S(NC,4)        'field #, num?, length, pad?
  9. 1050 Y=T2-T1+1
  10. 1060 DIM D(Y)
  11. 1070 X=INT(LOG(Y)/LOG(2))
  12. 1080 DIM LST(X),HST(X)        'lo and hi stacks
  13. 1090 '
  14.  
  15.                 ENTER HERE TO RE-SPECIFY
  16.  
  17. 1100 GOSUB 4010
  18. 1110 D$(0)="":ERASE D$:DIM D$(T2-T1+1)    ' do here for recycle (erased below)
  19. 1120 PRINT"SORT 1.03 -- January 13, 1984
  20. 1125 ' by Dan Dugan -- public domain
  21. 1130 PRINT:PRINT"Arranges a selected set of records in numerical or alphabetical order.
  22. 1140 PRINT"To quit this activity, enter 'x' in response to a 'y/n' question.
  23. 1150 IF T1=1 AND T2=N THEN GOTO 1200
  24. 1160 PRINT:PRINT"Shall the output include the records outside the range sorted? (n/y) ";
  25. 1170 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="n"
  26. 1180 PRINT A$: IF A$="y" THEN S9=1
  27. 1190 IF A$="x" THEN 3400
  28. 1200 PRINT
  29. 1210 PRINT"Please define the key fields for sorting in '"F$".'  The fields are:
  30. 1220 PRINT: GOSUB 4190 ' show
  31. 1230 PRINT"The file will be re-arranged according to the contents of the key fields.
  32. 1240 PRINT"Enter the primary key field number first, then any others you wish to
  33. 1250 PRINT"be sorted within that order, etc.
  34. 1260 S6=1:KLEN=0:KLENFLAG=0 ' any alph field will change S6 to 0; key length
  35. 1270 PRINT:FOR I=1 TO NC
  36. 1280    PRINT I;".  ";:
  37.     INPUT"Enter field number of key field (0 when done) ";S(I,1)
  38. 1290    IF S(I,1)=0 THEN 1420
  39. 1300    IF S(I,1)<1 OR S(I,1)>NC THEN PRINT"Field"S(I,1)"???  Enter again."
  40.         GOTO 1280
  41. 1310    S(I,2)=0:IF RIGHT$(N$(S(I,1)),1)="n" THEN S(I,2)=1 ELSE S6=0
  42. 1320        '(if just one is alpha, do alpha sort)
  43. 1330    INPUT"Number of characters in field to use (RETURN for all)";S(I,3)
  44. 1332    IF S(I,3) THEN 1334 ELSE 1340
  45. 1334    S(I,4)=0:PRINT"Do you want to pad shorter fields to that length? (n/y) ";
  46.         :A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  47. 1335    PRINT A$:IF A$="y" THEN S(I,4)=1
  48. 1340    IF S(I,3) THEN 1350 ELSE PRINT"You want to sort on all characters of ";
  49.         :GOTO 1360
  50. 1350    PRINT"You want to sort on the first"S(I,3)"characters of ";
  51. 1360    PRINT LEFT$(N$(S(I,1)),4)"? (y/n) ";:
  52.         A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  53. 1370    PRINT A$:IF A$="x" THEN 3400
  54. 1380    IF A$<>"y" THEN PRINT"Entry cancelled; ready for key"I"again.":GOTO 1280
  55. 1390    IF S(I,3) THEN KLEN=KLEN+S(I,3) ELSE KLEN=KLEN+10:KLENFLAG=1
  56. 1400    PRINT
  57. 1410 NEXT I
  58. 1420 NK=I-1
  59. 1430 IF S(1,1)=0 THEN 3400    'quit
  60. 1435 GOTO 1480            'skip this because of bug in desc. sort
  61. 1440 PRINT:PRINT"Ascending order? (y/n) ";
  62. 1450 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y"
  63. 1460 PRINT A$: IF A$="n" THEN S8=1
  64. 1470 IF A$="x" THEN 3400
  65. 1480 '
  66.  
  67.         OUTPUT SWITCH (P7)
  68.  
  69. 1490 P7=0
  70. 1500 PRINT:PRINT"Shall the product of the sort overlay the original file? (y/n) ";
  71. 1510 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y"
  72. 1520 PRINT A$:IF A$="x" THEN 3400
  73. 1530 IF A$="n" THEN P7=1:GOTO 1600
  74. 1540 IF A$<>"y" THEN 1500
  75. 1550 '
  76.         YES, OVERLAY
  77.  
  78. 1560 IF (T1=1 AND T2=N) OR S9=1 THEN 1630
  79. 1570 PRINT:PRINT"NOT ALLOWED - Overlaying part of file on file will erase records
  80. 1580 PRINT"outside of range.": PRINT:GOTO 1480
  81. 1590 '
  82.  
  83.         NAME OUTPUT FILE
  84.  
  85. 1600 PRINT:INPUT"Name of sort product file (no prefix or suffix) ";F2$
  86. 1610 IF F2$="" THEN 1480
  87. 1620 X$=F2$:GOSUB 3920:F2$=Y$ ' ucv
  88. 1630 '
  89.  
  90.                 SHOW SORT SET-UP
  91.  
  92. 1640 GOSUB 4010 'cs
  93. 1650 PRINT"SETUP FOR SORT
  94. 1660 PRINT: IF T1=1 AND T2=N THEN PRINT"Sort all records ("N")": GOTO 1710
  95. 1670 PRINT"Sorting range of records from"T1"to"T2"
  96. 1680 ON S9+1 GOTO 1690,1700
  97. 1690    PRINT"The output will be the range of records only.": GOTO 1710
  98. 1700    PRINT"The output will be the entire file with the selected range sorted.
  99. 1710 PRINT:PRINT"Records will be put in order by examining":
  100.     PRINT"the contents of the sort key fields."
  101. 1720 PRINT:FOR I=1 TO NK
  102. 1730    PRINT TAB(29);:PRINT USING"##";I;:
  103.     PRINT".  "LEFT$(N$(S(I,1)),4);
  104. 1740    PRINT TAB(40);:IF S(I,3) THEN PRINT S(I,3) ELSE PRINT" all"
  105. 1750 NEXT I
  106. 1760 PRINT:IF KLENFLAG THEN 1762 ELSE 1766
  107. 1762 PRINT"ESTIMATED string space needed for the key array is"KLEN*(T2-T1+1):
  108.     GOTO 1768
  109. 1766 PRINT"String space needed for the key array is"KLEN*(T2-T1+1)
  110. 1768 PRINT"and the available space is"FRE(X$)".
  111. 1770 PRINT"This program can't tell whether there is enough space on disk "
  112.     DD$(5)" for tempo-
  113. 1780 PRINT"rary storage of the key array.
  114. 1790 PRINT:PRINT"The records will be sorted in ";
  115. 1800 IF S8=0 THEN PRINT"ascending ";: GOTO 1820
  116. 1810 PRINT"descending ";
  117. 1820 IF S6=0 THEN PRINT"alphabetical ";: GOTO 1840
  118. 1830 PRINT"numerical ";
  119. 1840 PRINT"order."
  120. 1850 PRINT: PRINT"The output of the sort will ";
  121. 1860 IF P7=0 THEN PRINT"overlay the original file.":GOTO 1880
  122. 1870 PRINT"create a new DIMS file "F2$" on disk "DD$(4)"."
  123. 1880 PRINT:IF P7=0 AND (T1<>1 OR T2<>N) AND S9=0 THEN
  124.     PRINT"You are aware that this process will erase records?
  125. 1885 IF P7 THEN 1890 ELSE 1900
  126. 1890 PRINT"The new file "F2$" will replace the safety copy of "F$".
  127. 1892 PRINT"You must then use PIP to move "F2$" to another disk,
  128. 1894 PRINT"and use the DEDIT 'backup' command on "F$" to re-create a
  129. 1896 PRINT"safety copy.
  130. 1900 '
  131.  
  132.                 FINAL APPROVAL
  133.  
  134. 1910 PRINT:PRINT"Is this exactly what you want? (y/n) ";
  135. 1920 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y"
  136. 1930 PRINT A$
  137. 1940 IF A$="x" THEN 3400
  138. 1950 IF A$="n" THEN PRINT"Try again.":GOTO 1090
  139. 1960 IF A$<>"y" THEN GOTO 1910
  140. 1970 GOTO 2110
  141. 1980 '
  142.  
  143.                 SORT CONTROLS GUIDE
  144.  
  145. 1990 ' S() array holds key orders (field#, num? (1=num), length, pad?)
  146. 2000 ' NK = number of keys specified
  147. 2010 ' S6 = 0 alpha sort
  148. 2020 '      1 numeric sort
  149. 2030 ' S7 = 0 don't rename dupe file
  150. 2040 '      1 rename dupe file as F2$.D
  151. 2050 ' S8 = 0 ascending order
  152. 2060 '      1 descending order
  153. 2070 ' S9 = 0 output only sorted range of records
  154. 2080 '      1 output records above and below sorted range
  155. 2090 ' P7 = 0 overlay main file
  156. 2100 '      1 output to named file
  157. 2110 '
  158.  
  159.                 PUT KEYS IN TEMP FILE
  160.  
  161. 2120 GOSUB 4010
  162. 2130 PRINT"SORTING '"F$"'
  163. 2140 PRINT:PRINT"Extracting keys.":PRINT
  164. 2150 OPEN"O",3,DD$(5)+"KEYS.$$$"
  165. 2160 FOR I=T1 TO T2
  166. 2170    GOSUB 4270:GOSUB 4110 ' get record
  167. 2180    IF ASC(T$)=0 THEN X$=CHR$(126)+"(del)":GOTO 2320 ' sorts deletes to end
  168. 2190    GOSUB 3540 ' parse
  169. 2200    X$=""
  170. 2210    FOR X=1 TO NK
  171. 2220        IF S(X,3) THEN 2230 ELSE X$=X$+B$(S(X,1))+CHR$(32):GOTO 2280
  172. 2230        Z$=LEFT$(B$(S(X,1)),S(X,3))
  173. 2240        Y=LEN(Z$)
  174. 2250        IF S(X,2)=1 THEN
  175.             Y$=STRING$(S(X,3)-Y,CHR$(48)):
  176.             X$=X$+Y$+Z$:GOTO 2280    'pad num field with left 0's
  177. 2252        IF S(X,4) THEN 2260 ELSE Y$="":GOTO 2270
  178. 2260        Y$=STRING$(S(X,3)-Y,CHR$(32))    'spaces to pad right
  179. 2270        X$=X$+Z$+Y$
  180. 2280    NEXT
  181. 2290    IF X$="" THEN X$=CHR$(126):GOTO 2320 ' makes empties go later
  182. 2300    IF S6 THEN 2320
  183. 2310    GOSUB 3920:X$=Y$    'ucv
  184. 2320    PRINT I,X$
  185. 2330    PRINT#3,X$
  186. 2340 NEXT
  187. 2350 CLOSE 3
  188. 2360 '
  189.                 LOAD INDEX AND KEY ARRAYS
  190.  
  191. 2370 PRINT:PRINT"Loading key array:":PRINT
  192. 2380 OPEN"I",3,DD$(5)+"KEYS.$$$"
  193. 2390 I=T1:J=1:D$(0)=CHR$(0)
  194. 2400 IF EOF(3) THEN 2450
  195. 2410    LINE INPUT#3,D$(J)
  196. 2420    D(J)=I
  197. 2430    I=I+1:J=J+1
  198. 2440 GOTO 2400
  199. 2450 CLOSE 3
  200. 2460 KILL DD$(5)+"KEYS.$$$"
  201. 2470 '
  202.  
  203.                 READY TO SORT ARRAY
  204.  
  205. 2480 PRINT:PRINT"Sorting array.":PRINT
  206. 2490 ' from QUICKSORT by Sylvan Rubin DDJ #33 p.42
  207. 2500 LND=1:HND=J-1:STP=0
  208. 2510 '
  209.     PARTITION
  210.  
  211. 2520 GOSUB 4270        'exit
  212. 2530 IF LND>=HND THEN 2910 ' pop stack
  213. 2540 PRINT CHR$(80);:CTR=INT((LND+HND+1)/2) ' use center for pivot
  214. 2550 SWAP D(CTR),D(HND):SWAP D$(CTR),D$(HND)
  215. 2560 LO=LND-1:HI=HND
  216. 2570 PIV$=D$(HND):GOTO 2600 ' scan-l
  217. 2580 '
  218.     EXCHANGE
  219.  
  220. 2590 SWAP D(LO),D(HI):SWAP D$(LO),D$(HI)
  221. 2600 '
  222.     SCAN-L
  223.  
  224. 2610 LO=LO+1:ON S6+1 GOTO 2620,2630 ' alph, num
  225. 2620 ON S8+1 GOTO 2640,2650 ' asc, desc
  226. 2630 ON S8+1 GOTO 2660,2670
  227. 2640 IF D$(LO)<PIV$ THEN 2610 ELSE 2680
  228. 2650 IF D$(LO)>PIV$ THEN 2610 ELSE 2680
  229. 2660 IF VAL(D$(LO))<VAL(PIV$) THEN 2610 ELSE 2680
  230. 2670 IF VAL(D$(LO))>VAL(PIV$) THEN 2610 ELSE 2680
  231. 2680 '
  232.     SCAN-H
  233.  
  234. 2690 HI=HI-1:ON S6+1 GOTO 2700,2710
  235. 2700 ON S8+1 GOTO 2720,2730
  236. 2710 ON S8+1 GOTO 2740,2750
  237. 2720 IF D$(HI)>PIV$ THEN 2690 ELSE 2760
  238. 2730 IF D$(HI)<PIV$ THEN 2690 ELSE 2760
  239. 2740 IF VAL(D$(HI))>VAL(PIV$) THEN 2690 ELSE 2760
  240. 2750 IF VAL(D$(HI))<VAL(PIV$) THEN 2690 ELSE 2760
  241. 2760 '
  242.  
  243. 2765 IF LO<=HI THEN 2590
  244. 2770 '
  245.     SWAP PIVOT
  246.  
  247. 2780 SWAP D(LO),D(HND):SWAP D$(LO),D$(HND)
  248. 2790 '
  249.     PUSH STACK
  250.  
  251. 2800 IF (HI+1-LND)>(HND-LO) THEN 2860 ' stack low
  252. 2810 '
  253.     STACK HIGH
  254.  
  255. 2820 IF LO+2>HND THEN 2840
  256. 2830 STP=STP+1:LST(STP)=LO+1:HST(STP)=HND
  257. 2840 '
  258.     SHIFT HIGHEND
  259.  
  260. 2850 HND=HI:GOTO 2510 ' partition
  261. 2860 '
  262.     STACK LOW
  263.  
  264. 2870 IF LND+1>HI THEN 2900 ' shift lowend
  265. 2880 STP=STP+1:LST(STP)=LND:HST(STP)=HI
  266. 2890 '
  267.     SHIFT LOWEND
  268.  
  269. 2900 LND=LO+1:GOTO 2510 ' partition
  270. 2910 '
  271.     POP STACK
  272.  
  273. 2920 IF STP=0 THEN 2950 ' done
  274. 2930 LND=LST(STP):HND=HST(STP)
  275. 2940 STP=STP-1:GOTO 2510 ' partition
  276. 2950 PRINT:PRINT:PRINT"Array sorted.
  277. 2960 '
  278.  
  279.                 OUTPUT
  280.  
  281. 2970 NR=0 ' counts number of records in product file
  282. 2980 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$:GOSUB 4080
  283. 2990 IF S9=0 GOTO 3060
  284. 3000 '
  285.  
  286.                 COPY BLOCK BELOW T1
  287.  
  288. 3010 IF T1=1 THEN 3060
  289. 3020 PRINT:PRINT"Outputting records below range.
  290. 3030 FOR I=1 TO T1-1
  291. 3040    GOSUB 3430 'output record
  292. 3050 NEXT
  293. 3060 '
  294.  
  295.                 MOVE RECORDS PER INDEX ARRAY
  296.  
  297. 3070 PRINT:PRINT"Now moving records from "
  298.     DD$(3)" to "DD$(4)" in sorted order per index array.":PRINT
  299. 3080 ERASE D$ ' don't need strings
  300. 3090 FOR J=1 TO T2-T1+1
  301. 3100    I=D(J):GOSUB 3430
  302. 3110 NEXT
  303. 3120 '
  304.  
  305.                 COPY BLOCK ABOVE
  306.  
  307. 3130 IF S9=0 OR T2=N THEN 3180 ' skip block copy
  308. 3140 PRINT:PRINT"Outputting records above range
  309. 3150 FOR I=T2+1 TO N
  310. 3160    GOSUB 3430 ' output
  311. 3170 NEXT
  312. 3180 '
  313.  
  314.  
  315.                 SAVE HEADER AND TIDY UP
  316.  
  317. 3190 PRINT:PRINT"Saving header;"NR"records
  318. 3200 T$=""
  319. 3210 I=0
  320. 3220 I=I+1
  321. 3230    T$=T$+N$(I)+CHR$(126)
  322. 3240    IF LEFT$(N$(I),4)="stop" THEN 3260
  323. 3250 GOTO 3220
  324. 3260 T$=T$+STR$(NR)+CHR$(126) ' NR at end
  325. 3270 NR=0 ' for header
  326. 3280 GOSUB 3470 ' put it
  327. 3290 PRINT"!"
  328. 3300 IF P7 THEN 3330    'rename product
  329. 3310 GOSUB 3620 ' copy dupe to main
  330. 3320 GOTO 3380
  331. 3330 '
  332.  
  333.         RENAME OUTPUT FILE
  334.  
  335. 3340 CLOSE 2:NAME DD$(4)+F$+".DD"+FT$ AS DD$(4)+F2$+".D"+FT$:GOSUB 4080
  336. 3350 PRINT"Product file "F2$" is now on disk "DD$(4)" (backup erased).
  337. 3360 PRINT"After moving product to desired disk, use 'backup' command on "F$
  338. 3370 INPUT"to restore safety copy.  Hit RETURN to continue.    ";A$
  339. 3380 PRINT:PRINT:PRINT"Sort completed
  340. 3390 PRINT CHR$(7); 'beep
  341. 3400 '
  342.  
  343.                 RETURN TO DEDIT
  344.  
  345. 3410 PRINT:PRINT"Re-loading DEDIT.
  346. 3420 CHAIN DD$(1)+"DEDIT",1000
  347. 3430 '
  348.  
  349.  
  350.  
  351.                 (SUB) OUTPUT RECORD "I"
  352.  
  353. 3440 GOSUB 4110:PRINT T$ ' get rec I
  354. 3450 GOSUB 4270 ' exit
  355. 3460 NR=NR+1 ' # records in prod. file
  356. 3470 '
  357.  
  358.         PUT RECORD NR
  359.  
  360. 3480 ON FT GOTO 3510,3490
  361. 3490 LSET S$=MID$(T$,129)
  362. 3500 PUT #2,FT*NR+2
  363. 3510 LSET S$=LEFT$(T$,128)
  364. 3520 PUT #2,FT*NR+1
  365. 3530 RETURN
  366. 3540 '
  367.  
  368.  
  369.  
  370.                 (SUB) PARSE STRING
  371.  
  372. 3550 K=0
  373. 3560 J=INSTR(T$,CHR$(126)) ' delimiter
  374. 3570 IF J=0 THEN RETURN
  375. 3580 K=K+1
  376. 3590 B$(K)=MID$(T$,1,J-1)
  377. 3600 T$=MID$(T$,J+1)
  378. 3610 GOTO 3560
  379. 3620 '
  380.  
  381.  
  382.                 (SUB) ERASE ORIGINAL FILE AND COPY DUP TO ORIG
  383.  
  384. 3630 CLOSE
  385. 3640 PRINT
  386. 3650 KILL DD$(3)+F$+".D"+FT$
  387. 3660 PRINT"Copying dupe, overlaying original file.":PRINT
  388. 3670 GOSUB 4040 ' open both files
  389. 3680 FOR J=1 TO FT*(N+1)
  390. 3690    GET #2,J
  391. 3700    PRINT"&";
  392. 3710    LSET R$=S$
  393. 3720    PUT #1,J
  394. 3730    PRINT"*";
  395. 3740 NEXT J
  396. 3750 RETURN
  397. 3760 '
  398.  
  399.  
  400.                 ERROR HANDLING
  401.  
  402. 3770 IF ERR=61 THEN RESUME 3780 ELSE 3810
  403. 3780    PRINT CHR$(7)"Sorry - process halted because there isn't enough disk space
  404. 3790    PRINT"for the key file.
  405. 3800    INPUT"Hit return to recover.";A$:CLOSE:T=8:CHAIN DD$(1)+"DIMS",1000
  406. 3810 IF ERR=7 OR ERR=14 THEN RESUME 3820 ELSE 3850
  407. 3820    PRINT CHR$(7)"Sorry - process halted because key array needed more memory
  408. 3830    PRINT"than is available.  Try again with shorter key specifications.
  409. 3840    INPUT"Hit return to try again.";A$:CLOSE 3:GOTO 1090
  410. 3850 IF ERR=58 THEN RESUME 3860 ELSE 3910
  411. 3860    PRINT"Sorry - file named "F2$" already exists.
  412. 3870    INPUT"Enter another name for the output file here:  ";X$
  413. 3880    IF X$="" THEN 3870
  414. 3890    GOSUB 3920:F2$=Y$    'ucv
  415. 3900    GOTO 3330
  416. 3910 ON ERROR GOTO 0
  417. 3920 '
  418.  
  419.  
  420.                 (SUB) UCV
  421.  
  422. 3930 Y$=""
  423. 3940 FOR J=1 TO LEN(X$)
  424. 3950    Y$=Y$+" "
  425. 3960    X=ASC(MID$(X$,J,1))
  426. 3970    IF 96<X AND X<123 THEN MID$(Y$,J,1)=CHR$(X-32): GOTO 3990
  427. 3980    MID$(Y$,J,1)=MID$(X$,J,1)
  428. 3990 NEXT
  429. 4000 RETURN
  430. 4010 '
  431.  
  432.  
  433.                 (SUB) CLEAR SCREEN(TERM DEP)
  434.  
  435. 4020 PRINT CHR$(12)
  436. 4030 RETURN
  437. 4040 '
  438.  
  439.                 (SUB) OPEN UP FILES
  440.  
  441. 4050 CLOSE
  442. 4060 OPEN"R",1,DD$(3)+F$+".D"+FT$
  443. 4070 FIELD #1,128 AS R$
  444. 4080 OPEN"R",2,DD$(4)+F$+".DD"+FT$
  445. 4090 FIELD #2,128 AS S$
  446. 4100 RETURN
  447. 4110 '
  448.  
  449.  
  450.                 (SUB) GET RECORD "I" IN T$
  451.  
  452. 4120 T$=""
  453. 4130 ON FT GOTO 4160,4140
  454. 4140    GET#1,FT*I+2 ' latter half
  455. 4150    T$=LEFT$(R$,127)
  456. 4160    GET#1,FT*I+1
  457. 4170    T$=R$+T$
  458. 4180 RETURN
  459. 4190 '
  460.  
  461.  
  462.                 (SUB) SHOW FIELDS
  463.  
  464. 4200 FOR J=1 TO NC
  465. 4210    IF C(J)=0 THEN 4240
  466. 4220    PRINT TAB(29);
  467. 4230    PRINT USING"##";J;:PRINT".  "LEFT$(N$(J),4)"  "RIGHT$(N$(J),1)
  468. 4240 NEXT
  469. 4250 PRINT
  470. 4260 RETURN
  471. 4270 '
  472.  
  473.                 (SUB) EXIT TEST
  474.  
  475. 4280 X$=INKEY$
  476. 4282 IF X$<>CHR$(27) THEN RETURN
  477. 4290 PRINT:PRINT"Process paused by ESCAPE from keyboard.
  478. 4300 PRINT"Do you want to continue (y,n or x) ? ";
  479. 4310 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  480. 4320 PRINT A$:IF A$="x" THEN CLOSE 3:GOTO 3400
  481. 4330 IF A$<>"y" THEN CLOSE 3:GOTO 1090
  482. 4340 RETURN
  483.  A$=CHR$(13) THEN A$="y"
  484. 4320 PRINT