q b a s i c p p o g r a m s [LONG!]

[ken collins]

REM $DYNAMIC
SUB SortNewDerivs

SHARED ITM%(), NEWITM%, NEWITM$, Dups%, TRACE$

     ' DESCENDING ORDER (LARGEST=1ST OCCURRENCE)
     NEWITM$ = "N": Dups% = 0
     FOR I% = 1 TO NEWITM% - 1
       IF TRACE$ = "Y" THEN LOCATE 27, 1: PRINT "sorting NEW Derivative
file..."; I%: IF SNORE% = 1 THEN SLEEP 1
       FOR K% = 1 TO NEWITM% - I%
         T% = 0: Dups% = 1
         FOR J% = 25 TO 1 STEP -1
           IF ITM%(I% + K%, J%) = ITM%(I%, J%) THEN GOTO 1800
           IF ITM%(I% + K%, J%) < ITM%(I%, J%) THEN T% = 0: Dups% = 0: GOTO
1800
           IF ITM%(I% + K%, J%) > ITM%(I%, J%) THEN T% = 1: Dups% = 0
1800     NEXT J%
         IF Dups% = 1 THEN BEEP: PRINT "DUPLICATE new Derivative input ": PRINT
: Dups% = Dups% + 1
         IF T% = 0 THEN GOTO 1900
         FOR P% = 1 TO 25
           SWAP ITM%(I% + K%, P%), ITM%(I%, P%)
         NEXT P%
         SWAP ITM%(I% + K%, 26), ITM%(I%, 26)
1900   NEXT K%
     NEXT I%

END SUB

SUB WriteMergedFile

SHARED Dups%, NEWITM%

    IF NEWITM% > 30 THEN PRINT "new Derivative space exceeded - 30 can be
saved": NEWITM% = 30
    IF NEWITM% > 0 THEN
       INPUT ">>>save new Derivs (Y OR N)"; SAV$
    ELSE GOTO 1100
    END IF
    IF SAV$ <> "Y" THEN GOTO 1100

600 INPUT ">>> Enter version of Derivative file to be written to (2-99)", An$
    IF An$ = "RAVEN" THEN An$ = "1": GOTO 700
    IF An$ = "1" THEN MsgLine "version 1 is reserved ": GOTO 600
    IF An$ < "1" OR An$ > "99" THEN MsgLine "bad version number": GOTO 600

700 File$ = "ENGRAM" + An$ + ".DAT"
    OPEN "O", #2, File$
    MsgLine "file ENGRAM" + An$ + ".DAT opened"
    IF SAV$ = "Y" THEN SortNewDerivs

    MERGERECS% = LTMRECS% + NEWITM%
    WRITE #2, MERGERECS%: PRINT "records on MERGED Derivative file = ";
MERGERECS%

    ' MERGES NEW/OLD Derivative FILES 2 FEB 85

    I% = 1: K% = 1: ' I%=NUM OLD RECS WRITTEN; K%=NUM NEW RECS WRITTEN
800 IF TRACE$ = "Y" THEN
       LOCATE 28, 1
       PRINT "merging new/old Derivative files... old "; I%; " new "; K%: SLEEP
1
    END IF

    IF I% > LTMRECS% AND K% <= NEWITM% THEN FINISH$ = "Y": GOSUB 1300: GOTO
1100
    IF K% > NEWITM% AND I% <= LTMRECS% THEN FINISH$ = "Y": GOSUB 1200: GOTO
1100

    Dups% = 1
    FOR J% = 25 TO 1 STEP -1
      IF LTM%(I%, J%) = ITM%(K%, J%) THEN GOTO 900
      IF LTM%(I%, J%) < ITM%(K%, J%) THEN T% = 0: Dups% = 0: GOTO 900
      IF LTM%(I%, J%) > ITM%(K%, J%) THEN T% = 1: Dups% = 0
900 NEXT J%

     IF Dups% = 1 THEN BEEP: PRINT "NEW Derivative DUPLICATES OLD": INPUT ;
An$: GOSUB 1300: GOSUB 1200: Dups% = Dups% + 1: GOTO 1000
     IF T% = 0 THEN GOSUB 1300 ELSE GOSUB 1200: ' WRITE Derivative RECORDS
1000 IF I% <= LTMRECS% OR K% <= NEWITM% THEN GOTO 800

1100 CLOSE #1, #2
     IF Dups% > 0 THEN BEEP: COLOR 14: LOCATE 12, 22: PRINT "DUPS ON FILE":
INPUT ; An$
     EXIT SUB

1200 ' WRITES OLD Derivative RECORDS (NOTE I% MUST BE SET BEFORE CALL)
     FOR C% = 1 TO 26
       WRITE #2, LTM%(I%, C%)
       IF PEOJ$ = "D" THEN PRINT LTM%(I%, C%);  ELSE IF PEOJ$ = "P" THEN LPRINT
LTM%(I%, C%);
     NEXT C%
     IF PEOJ$ = "D" THEN PRINT "above rec was on OLD Derivative file" ELSE IF
PEOJ$ = "P" THEN LPRINT "above rec was on SHORT-TERM Derivative file"
     I% = I% + 1
     IF I% > LTMRECS% THEN RETURN ELSE IF FINISH$ = "Y" THEN GOTO 1200
     RETURN

1300 ' WRITES NEW Derivative RECORDS (NOTE K% MUST BE SET BEFORE CALL)
     FOR C% = 1 TO 26
       WRITE #2, ITM%(K%, C%)
       IF PEOJ$ = "D" THEN PRINT ITM%(K%, C%);  ELSE IF PEOJ$ = "P" THEN LPRINT
ITM%(K%, C%);
     NEXT C%
     IF PEOJ$ = "D" THEN PRINT "above rec is a NEW Derivative" ELSE IF PEOJ$ =
"P" THEN LPRINT "above rec is a new Derivative"
     K% = K% + 1
     IF K% > NEWITM% THEN RETURN ELSE IF FINISH$ = "Y" THEN GOTO 1300
     RETURN

END SUB

SUB WriteNewDerivs

SHARED ITM%(), Dups%, NEWITM$, NEWITM%

5900 IF Dups% > 0 THEN
        BEEP
        INPUT "DUPS on file -- continue with write? (Y OR N)", An$
        IF An$ <> "Y" THEN EXIT SUB
     END IF

6000 INPUT ">>> enter version of Derivative file to be written to ", An$
     IF An$ = "RAVEN" THEN An$ = "1": GOTO 6100
     IF An$ = "1" THEN MsgLine "version 1 is reserved ": GOTO 6000
     IF An$ < "1" OR An$ > "99" THEN MsgLine "bad version number": GOTO 6000

6100 File$ = "ENGRAM" + An$ + ".DAT"
     OPEN "O", #3, File$
     MsgLine "file ENGRAM" + An$ + ".DAT opened"

     IF NEWITM$ = "Y" THEN SortNewDerivs

     WRITE #3, NEWITM%: PRINT "records on NEW Derivative file = "; NEWITM%

     FOR I% = 1 TO NEWITM%
       FOR J% = 1 TO 25
         WRITE #3, ITM%(I%, J%)
       NEXT J%
       WRITE #3, ITM%(I%, 26)
     NEXT I%
     CLOSE #3

END SUB
' e n d c r u d e I n f o C a l c . B A S ------------------------------

's a v e t h e f o l l o w i n g a s e n g r a m 1 . d a t -------------
2
3
4
4
3
3
3
1
2
0
2
3
2
4
1
3
2
2
2
1
3
4
4
4
3
4
7
2
3
4
3
2
3
1
2
1
3
2
3
4
3
2
3
1
2
1
3
3
3
3
3
3
2

3
2
4
1
3
2
2
2
1
3
4
4
4
3
4
7
2
3
4
3
2
3
1
2
1
3
2
3
4
3
2
3
'e n d o f e n g r a m 1 . d a t -----------------------------------------

'K . P . C o l l i n s