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