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_R290.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  4KB  |  107 lines
  1. REMARK    *************************************************************\
  2.     *  PR290.BAS  JOB POSTING FILE SORT PROGRAM     5/17/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 JOB POSTING 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.  
  19. 6000    Y4=2
  20.     CONSOLE:PRINT CLEAR.SCREEN$;"JOB POSTING SORT/UPDATE"
  21.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
  22. 6000.1    IF CONSTAT%=0 THEN GOTO 6000.1                    REMARK POLL KEYBOARD FOR CTRL-C OR RETURN
  23.     A%=CONCHAR%
  24.     IF A%=03H THEN GOTO 7300                    REMARK ABORT PROGRAM ON CTRL-C
  25.     IF A%<>0DH THEN GOTO 6000.1                    REMARK WAIT FOR RETURN BEFORE EXECUTING PROGRAM
  26.     PRINT "PROCESSING...DO NOT INTERRUPT"
  27.     PRINT
  28.     OUTPUT.FILE$="WORKFILE.DAT"
  29.     INPUT.FILE$="JOB0F110.DAT":RECLENGTH=42
  30.  
  31.         REMARK*** OPEN FILES ***
  32.  
  33.     CREATE OUTPUT.FILE$ RECL RECLENGTH AS 1
  34.     IF END #2 THEN 8000                        REMARK  IF NULL FILE, ABORT PROGRAM
  35.     OPEN INPUT.FILE$ RECL RECLENGTH AS 2
  36.     IF END #2 THEN 6950                        REMARK  SET END-OF-FILE BRANCH CONDITION
  37. 6055        RECORD.COUNT%=RECORD.COUNT% + 1                REMARK  INCREMENT NUMBER OF RECORDS
  38.         X0=RECORD.COUNT%
  39.         GOSUB 780                        REMARK  READ FROM JOB POSTING FILE
  40. REM    *************************************************************
  41. REM    *  THE SORT KEY IS CALCULATED ON THE NEXT LINE FOR AN        *
  42. REM    *  ALGEBRAIC-RESULT SORT.  BINARY SORTS MUST USE CHARACTERS *
  43. REM    *  WHICH ARE PROPERLY JUSTIFIED FOR COMPARISON.             *
  44.  
  45.  
  46.     TAG.ARRAY(RECORD.COUNT%)=T2(6)*10000000+T2(1)*10000+RECORD.COUNT%
  47.  
  48.  
  49.  
  50. REM    *  THIS IS A GENERALIZED SORT, IDENTICAL IN ALMOST ALL      *
  51. REM    *  CASES TO PR06A.BAS.                        *
  52. REM    *************************************************************
  53.         PRINT CURSOR.HOME$:PRINT:PRINT
  54.         PRINT USING "RECORD NO : ###";RECORD.COUNT%
  55.         GOTO 6055
  56. 6950        RECORD.COUNT%=RECORD.COUNT%-1
  57.         IF RECORD.COUNT%<1 THEN 8000
  58.         CLOSE 2
  59.         OPEN INPUT.FILE$ RECL RECLENGTH AS 2
  60.         PRINT "NUMBER OF RECORDS READ = ";RECORD.COUNT%
  61.         PRINT "SORTING..."
  62.         M%=RECORD.COUNT%
  63. 7000        M%=M% / 2
  64.         IF M%=0 THEN GOTO 7150                    REMARK  IF SORT INTERVAL (M) IS EXHAUSTED,\
  65.                                             THEN TERMINATE THE SORT.
  66.  
  67.         K%=RECORD.COUNT%-M%
  68.         J%=1
  69. 7040        I%=J%
  70. 7050        L%=I% + M%
  71.         IF TAG.ARRAY(I%) <= TAG.ARRAY(L%) THEN GOTO 7120
  72.         TEMP=TAG.ARRAY(I%)
  73.         TAG.ARRAY(I%)=TAG.ARRAY(L%)
  74.         TAG.ARRAY(L%)=TEMP
  75.         I%=I% - M%
  76.         IF I% >= 1 THEN 7050
  77. 7120        J%=J% + 1
  78.         IF J% > K% THEN GOTO 7000 ELSE GOTO 7040
  79.  
  80.  
  81.  
  82. 7150    FOR X%=1 TO RECORD.COUNT%                    REMARK  RE-WRITE POSTING FILE IN SORTED ORDER
  83.     
  84.     X0=TAG.ARRAY(X%)-INT(TAG.ARRAY(X%)/10000)*10000
  85.         Y4=2
  86.         IF X0=0 THEN 7200
  87.         GOSUB 780                        REMARK  READ THE POSTING FILE AT POSITION X0
  88.         Y4=1                            REMARK  SWAP FILE ASSIGNMENTS
  89.         GOSUB 800                        REMARK  WRITE THE ORDERED RECORD TO WORKFILE.
  90. 7200    NEXT X%
  91.     DELETE 2
  92.     CLOSE 1
  93.     A=RENAME(INPUT.FILE$,OUTPUT.FILE$)                REMARK  ERASE INPUT FILE AND RENAME WORKFILE TO \
  94.                                             ORIGINAL FILENAME
  95.     PRINT CLEAR.SCREEN$
  96.     PRINT "SORT COMPLETE "
  97.     PRINT "LOADING UPDATE PROCESSOR"
  98.     CHAIN "P/R291"                            REMARK  LOAD THE JOB POSTING UPDATE PROGRAM
  99.  
  100.  
  101. 7300    PRINT CLEAR.SCREEN$;"JOB POSTING LOADING MENU"
  102.     CHAIN "P/R000"
  103.  
  104.  
  105. 8000    PRINT "EMPTY TRANSACTION FILE--PROGRAM ABORTED"
  106.     CHAIN "P/R000"                            REMARK  IF OPEN ERROR OCCURRED, LOAD THE MENU
  107.