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 / SIMTEL / CPMUG / CPMUG045.ARK / P_R06A.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  3KB  |  98 lines
  1. REMARK    *************************************************************\
  2.     *  PR06A.BAS  TRANSACTION FILE SORT PROGRAM     5/10/79     *\
  3.     *  =======================================================  *\
  4.     *  THIS PROGRAM USES THE SHELL-METZNER SORTING ALGORITHM    *\
  5.     *  TO SORT A TRANSACTION FILE IN DECREASING INCREMENTS AND  *\
  6.     *  WRITE THE SORTED RECORDS OUT TO A WORKFILE.            *\
  7.     *  ONCE THE WORKFILE IS COMPLETELY WRITTEN, IT REPLACES THE *\
  8.     *  FILE USED AS INPUT.                        *\
  9.     *************************************************************
  10.  
  11.     DIM TAG.ARRAY(875),T2(8)
  12. %INCLUDE CURSOR
  13.     GOTO 6000
  14. 780    READ #Y4,X0;T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8)    REMARK  READ RECORD FROM P/R TRANSACTION FILE
  15.     RETURN
  16. 800    PRINT #Y4;T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8)    REMARK  RE-WRITE RECORD ONTO WORKFILE
  17.     RETURN
  18. 6000    Y4=2
  19.     CONSOLE:PRINT CLEAR.SCREEN$;"TRANSACTION ENTRY F/M (SORT)"
  20.     PRINT "PROCESSING...DO NOT INTERRUPT"
  21.     PRINT
  22.     OUTPUT.FILE$="WORKFILE.DAT"
  23.     INPUT.FILE$="P/R0F040.DAT":RECLENGTH=42
  24.  
  25.         REMARK*** OPEN FILES ***
  26.  
  27.     CREATE OUTPUT.FILE$ RECL RECLENGTH AS 1
  28.     IF END #2 THEN 8000                        REMARK  IF NULL FILE, ABORT PROGRAM
  29.     OPEN INPUT.FILE$ RECL RECLENGTH AS 2
  30.     IF END #2 THEN 6950                        REMARK  SET END-OF-FILE BRANCH CONDITION
  31. 6055        RECORD.COUNT%=RECORD.COUNT% + 1                REMARK  INCREMENT NUMBER OF RECORDS
  32.         X0=RECORD.COUNT%
  33.         GOSUB 780                        REMARK  READ FROM TRANSACTION FILE
  34. REM    *************************************************************
  35. REM    *  THE SORT KEY IS CALCULATED ON THE NEXT LINE FOR AN        *
  36. REM    *  ALGEBRAIC-RESULT SORT.  BINARY SORTS MUST USE CHARACTERS *
  37. REM    *  WHICH ARE PROPERLY JUSTIFIED FOR COMPARISON.             *
  38.  
  39.  
  40.     TAG.ARRAY(RECORD.COUNT%)=\
  41.     T2(1)*10000000+T2(2)*100000+T2(3)*1000+RECORD.COUNT%
  42.  
  43.  
  44.  
  45. REM    *  THIS IS A GENERALIZED SORT, IDENTICAL IN ALMOST ALL      *
  46. REM    *  CASES TO PR290.BAS.                        *
  47. REM    *************************************************************
  48.         PRINT CURSOR.HOME$:PRINT
  49.         PRINT USING "RECORD NO : ###";RECORD.COUNT%
  50.         GOTO 6055
  51.  
  52. 6950        RECORD.COUNT%=RECORD.COUNT%-1
  53.         IF RECORD.COUNT%=0 THEN 8000
  54.         CLOSE 2
  55.         OPEN INPUT.FILE$ RECL RECLENGTH AS 2
  56.         PRINT "NUMBER OF RECORDS READ = ";RECORD.COUNT%
  57.         PRINT "SORTING..."
  58.         M%=RECORD.COUNT%
  59. 7000        M%=M% / 2
  60.         IF M%=0 THEN GOTO 7150                    REMARK  IF SORT INTERVAL (M) IS EXHAUSTED,\
  61.                                             THEN TERMINATE THE SORT.
  62.  
  63.         K%=RECORD.COUNT%-M%
  64.         J%=1
  65. 7040        I%=J%
  66. 7050        L%=I% + M%
  67.         IF TAG.ARRAY(I%) <= TAG.ARRAY(L%) THEN GOTO 7120
  68.         TEMP=TAG.ARRAY(I%)
  69.         TAG.ARRAY(I%)=TAG.ARRAY(L%)
  70.         TAG.ARRAY(L%)=TEMP
  71.         I%=I% - M%
  72.         IF I% >= 1 THEN 7050
  73. 7120        J%=J% + 1
  74.         IF J% > K% THEN GOTO 7000 ELSE GOTO 7040
  75.  
  76.  
  77.  
  78. 7150    FOR X%=1 TO RECORD.COUNT%                    REMARK  RE-WRITE TRANSACTION FILE IN SORTED ORDER
  79.     
  80.     X0=TAG.ARRAY(X%)-INT(TAG.ARRAY(X%)/1000)*1000
  81.         Y4=2
  82.         IF X0=0 THEN 7200
  83.         GOSUB 780                        REMARK  READ THE TRANSACTION FILE AT POSITION X0
  84.         Y4=1                            REMARK  SWAP FILE ASSIGNMENTS
  85.         GOSUB 800                        REMARK  WRITE THE ORDERED RECORD TO WORKFILE.
  86. 7200    NEXT X%
  87.     DELETE 2
  88.     CLOSE 1
  89.     A=RENAME(INPUT.FILE$,OUTPUT.FILE$)                REMARK  ERASE INPUT FILE AND RENAME WORKFILE TO \
  90.                                             ORIGINAL FILENAME
  91.     PRINT CLEAR.SCREEN$
  92.     PRINT "SORT COMPLETE "
  93.     PRINT "LOADING TRANS. F/M (ALTER)"
  94.     CHAIN "P/R06B"                            REMARK  LOAD THE TRANSACTION F/M PROGRAM
  95.  
  96. 8000    PRINT "EMPTY TRANSACTION FILE--PROGRAM ABORTED"
  97.     CHAIN "P/R000"                            REMARK  IF OPEN ERROR OCCURRED, LOAD THE MENU
  98.