home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / QBAS / BAS_SORT.ZIP / MNTSORT.BAS < prev    next >
BASIC Source File  |  1989-07-11  |  4KB  |  65 lines
  1. 10 ' ------------------------------------------------------------------
  2. 11 ' ---      This is a product of Mentat Software (c)1984-85
  3. 12 ' ---      it is freely given.  Feel free to use it as you
  4. 13 ' ---      wish but the first 16 lines of this message must
  5. 14 ' ---      remain intact.
  6. 15 ' ---           If you find this product or any Mentat
  7. 16 ' ---      Software products or any of the older software
  8. 17 ' ---      products written by Richard Ashwell, please feel
  9. 18 ' ---      free to contribute or donate. Send any contribu-
  10. 19 ' ---      tion to:
  11. 20 ' ---
  12. 21 ' ---             Richard F. Ashwell III
  13. 22 ' ---             1830 Dover Rd.
  14. 23 ' ---             Dover Fl.   33527
  15. 24 ' ---
  16. 25 ' ---        ============( Line 16 )===============
  17. 26 ' ---
  18. 27 ' ---         If you send a SASE, we will send you a brochure
  19. 28 ' ---     on our software and how to get it.
  20. 29 ' ---
  21. 30 ' ---     To Recieve the Mentat Sort programs send either:
  22. 31 ' ---
  23. 32 ' ---       1 DISK WITH RETURN MAILER &  $4
  24. 33 ' ---
  25. 34 ' ---     OR
  26. 35 ' ---
  27. 36 ' ---       A RETURN MAILER & $10 DOLLAR.  (SPECIFY DISK FORMAT)
  28. 37 ' ------------------------------------------------------------------
  29. 39 DEFINT A-Z  ' make integers the default in QuickBASIC 4.00/4.50
  30. 40 DIM D$(5000), PLANE(3000), WAVE(3000): SCREEN 0, 0, 0: WIDTH 80: CLS : KEY OFF: a$ = "MENTAT SORT": LOCATE 1, 40 - LEN(a$) / 2: PRINT a$: a$ = "-----------": LOCATE 2, 40 - LEN(a$) / 2: PRINT a$
  31. 50 LOCATE 23, 1: PRINT "Mentat Software (c)1984-85     written by   Richard F. Ashwell III"
  32. 60 LOCATE 3, 1: PRINT "5000 entry limit.": PRINT : INPUT "Enter input file name... -->", NA$: PRINT : PRINT "Enter output file name. Use 'LPT1:' for printer and 'SCRN:' for screen output.": PRINT : INPUT "---->", N2$: ON ERROR GOTO 300: OPEN NA$ FOR _
  33.  INPUT AS #1
  34. 70 IF EOF(1) THEN CLOSE #1: GOTO 90
  35. 80 Y = Y + 1: INPUT #1, D$(Y): GOTO 70
  36. 90 OPEN N2$ FOR OUTPUT AS #1: CLS : a$ = "-MENTAT WORKING-": COLOR 7: LOCATE 1, 1: PRINT a$: LT = 2: GOSUB 310: DREG = 1: PLANE(DREG) = 1: WAVE(DREG) = Y: EREG = 1: AREG = Y: LOCATE 23, 1: PRINT  _
  37. "Mentat Software (c)1984-85    written by    Richard F. Ashwell III"
  38. 95 Begin! = TIMER' save time
  39. 100 IF (AREG - EREG) < 9 THEN GOTO 230
  40. 110 BREG = EREG: CREG = AREG
  41. 120 IF D$(BREG) > D$(CREG) THEN GOTO 170
  42. 130 CREG = CREG - 1: IF CREG > BREG THEN GOTO 120
  43. 140 CREG = CREG + 1
  44. 150 DREG = DREG + 1: IF (BREG - EREG) < (AREG - CREG) THEN GOTO 220
  45. 160 PLANE(DREG) = EREG: WAVE(DREG) = BREG: EREG = CREG: GOTO 100
  46. 170 GOSUB 310: SWAP D$(CREG), D$(BREG): GOTO 190
  47. 180 IF D$(CREG) < D$(BREG) THEN GOTO 210
  48. 190 BREG = BREG + 1: IF CREG > BREG THEN GOTO 180
  49. 200 CREG = CREG + 1: GOTO 150
  50. 210 GOSUB 310: SWAP D$(CREG), D$(BREG): GOTO 130
  51. 220 PLANE(DREG) = CREG: WAVE(DREG) = AREG: AREG = BREG: GOTO 100
  52. 230 IF (AREG - EREG + 1) = 1 THEN GOTO 270
  53. 240 FOR BREG = (EREG + 1) TO AREG: FOR CREG = EREG TO (BREG - 1): FREG = BREG - CREG + EREG - 1: IF D$(FREG) <= D$(FREG + 1) THEN GOTO 260
  54. 250 SWAP D$(FREG), D$(FREG + 1): NEXT CREG
  55. 260 NEXT BREG
  56. 270 EREG = PLANE(DREG): AREG = WAVE(DREG): DREG = DREG - 1: IF DREG = 0 THEN GOTO 290
  57. 280 GOTO 100
  58. 290 Ending! = TIMER
  59. 292 CLS : BEEP: PRINT "Sorted"; Y; "records in"; Ending! - Begin!; "seconds!"
  60. 294 a$ = INPUT$(1)
  61. 296 CLS : FOR X = 1 TO Y: PRINT #1, D$(X): NEXT: CLOSE : END
  62. 300 SYSTEM
  63. 310 LOCATE 1, 1: COLOR 7: PRINT LEFT$(a$, LT - 1); : COLOR 15: PRINT MID$(a$, LT, 1); : COLOR 7: PRINT RIGHT$(a$, LEN(a$) - LT): LT = LT + 1: IF LT > LEN(a$) - 1 THEN LT = 2: RETURN ELSE RETURN
  64.  
  65.