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