10 REM #######################################
20 REM R.A.M.P./FM - HULPPROGRAMMA JOIN-RAMP
30 REM AUTHOR: ERIK DE RUIJTER - DECEMBER 1983
40 REM #######################################
61 REM Clear Screen-funktie (na PRINT gebruiken)
71 REM Adresseer-funktie (idem)
81 REM Shift-in en Shift-out karakters
91 REM Storage maximum: RAM die Mbasic vrijlaat
121 REM N.REC = maximaal toegestaan aant; N.CHAR = recordlengte
131 REM  VNUM = indikator numeriek veld; VJUST = justificatie getallen
132 REM VPR.POS = printpositie (0 = niet printen)
1120 PRINT CLS$ : PRINT STRING$(80,"*")
1130 PRINT TAB(20);"J O I N R A M P (JOIN R.A.M.P./FM FILES)"
1140 PRINT FNADR$(5,10);"Hoeveel invoerbestanden ?"
1150 ILEN=2 : IM=15 : IVER=5 : IHOR=40 : GOSUB 15000
1160 IF II < 2 THEN 1150
1170 DIM BINH$(II), BN(II),BT(II)
1180 N.FIL=II : N.VOL=0
1181 REM N.VOL = aantal volledig gelezen/geschreven invoerbestanden
1200 ON ERROR GOTO 2900
1480 RECT=0 : REM Recordteller invoer - voor rekenhulp op 1590/1630
1490 ILEN=14 : IM=0 : IHOR=40 : REM gelijke parameters voor alle namen
1500 FOR L=1 TO N.FIL
1510 PRINT FNADR$(8+L,10);"Naam bestand Nr.";L
1520 IVER=8+L : GOSUB 15000 : REM vertikale positie bijstellen / invoer
1530 IF RIGHT$(INVOER$,2) < > "  " THEN IF MID$(INVOER$,2,1) < > ":" THEN 1520
1531 REM Voor namen met alle 14 posities: check drive : -teken
1540 IF RIGHT$(INVOER$,1)=" " THEN INVOER$=LEFT$(INVOER$,(INSTR(2,INVOER$," ")-1))
1550 IF MID$(INVOER$,(LEN(INVOER$)-3),1) < > "." THEN 1520 : REM valideren CP/M-naam
1560 OPEN "I", L+1, INVOER$ : REM Filenummer heeft offset van 1, i.v.m. uitvoer
1570 INPUT #L+1, LI$
1580 BN(L)=VAL(LI$) : REM Bestands- Number of records ; grootte
1590 RECT=RECT+BN(L)
1600 NEXT
1610 PRINT CLS$
1630 PRINT FNADR$(22,10);"Dit betekent ";INT(RECT/N.REC)+1;" uitvoerbestanden";
1635 REM Rekenwerk met RECT dient alleen om tevoren te verifieeren of er ruimte
1636 REM voldoende is; helaas kent MBASIC niet de CP/M-samenwerking om dat zelf te kunnen
1640 PRINT ", samen ";INT(RECT*N.CHAR/1024);" kbytes"
1660 PRINT FNADR$(23,10);"Op welke drive moeten de uitvoerbestanden ?"
1670 ILEN=2 : IVER=23 : IHOR = 50 : GOSUB 15000
1680 IF INVOER$ < > "A:" AND INVOER$ < > "B:" THEN 1670
1690 UDRIV$=INVOER$
1700 FOR L= 18 TO 23 : PRINT FNADR$(L,1);SPACE$(80) : NEXT
1705 FOR L= 1 TO N.FIL
1710 PRINT FNADR$(L,5);"Bestand ";L;TAB(17);"op record   1"
1715 NEXT : REM Eerste afdruk van 'aktiviteitsmeters' in 2200
2000 FOR L=1 TO N.FIL
2010 LINE INPUT #L+1, BINH$(L) : REM invoer 1e records ter vergelijking
2020 BT(L)=1
2030 NEXT
2040 UNUM=1
2050 GOSUB 3100 : REM Maak uitvoerbestand nr.1 open 
2100 BLAAG=1 : REM Start vergelijkingslus - zet pointer 'laagste' bestand
2110 FOR L=1 TO N.FIL
2120 IF BINH$(L) = STRING$(N.CHAR,"Z") THEN 2140 : REM bestand doet niet meer mee
2130 IF BINH$(L) < BINH$(BLAAG) THEN BLAAG=L
2140 NEXT
2150 PRINT #1, BINH$(BLAAG) : REM schrijf laagste record weg
2160 UTEL=UTEL+1 : PRINT FNADR$(20,45);UTEL : REM Uitvoerteller ,aktiviteits-index
2170 IF UTEL=N.REC THEN GOSUB 3000 : GOSUB 3100 : REM Wissel uitvoerbestand
2175 IF BT(BLAAG)=BN(BLAAG) THEN GOSUB 3500 : IF N.VOL=N.FIL THEN 2300 ELSE GOTO 2200
2176 REM Alleen als een invoerbestand "kompleet uitgelezen" is, kan er 
2177 REM gecheckt worden of soms alle bestanden c.q. de verwerking af zijn
2180 LINE INPUT #BLAAG+1, BINH$(BLAAG) : REM Invoer vervangend record
2190 BT(BLAAG)=BT(BLAAG) + 1
2200 PRINT FNADR$(BLAAG,30);BT(BLAAG) : REM Aktiviteits-index
2210 GOTO 2100
2300 GOSUB 3000 : REM Sluit laatste uitvoerbestand
2320 PRINT FNADR$(23,10);SSI$;"E I N D E  V E R W E R K I N G ";SSO$
2330 END
2900 IF ERL=1560 OR ERL = 1570 THEN PRINT FNADR$(23,20);"INVOERBESTAND ";INVOER$;" IS NIET TE LEZEN " : RESUME 1520
2910 ON ERROR GOTO 0 : REM Normale foutmeldingen
3000 CLOSE #1 : REM Sluit vorige uitvoerbestand
3010 OPEN "R",1, UFIL$ , N.CHAR+2
3020 FIELD #1, N.CHAR AS LU$, 2 AS LV$ : REM benader zelfde bestand 'direkt'
3025 LSET LV$=CHR$(13)+CHR$(10) : REM dus inklusief <CR> en <LF> achteraan
3030 L$=STR$(UTEL)
3040 LSET LU$=L$+SPACE$(N.CHAR+2-LEN(L$))
3050 PUT #1, 1
3060 CLOSE #1
3070 UNUM=UNUM+1 : REM nummer voor volgende uitvoerbestand
3080 RETURN
3100 REM Open nieuw uitvoerbestand
3110 UTEL=0 : REM Uitvoerteller in dit bestand
3120 UFIL$=UDRIV$+"RAMPOUT"+CHR$(64+UNUM)+".DAT" : REM Bestandsnummer via letter vanaf "A"
3130 OPEN "O", 1, UFIL$
3140 PRINT #1, STRING$(N.CHAR,0)
3150 PRINT FNADR$(20,10);"Uitvoer in ";UFIL$;" op record 0"
3160 RETURN
3500 CLOSE #BLAAG + 1 : REM Sluit een invoerbestand af
3510 N.VOL=N.VOL+1 : REM Aantal afgesloten files
3520 BINH$(BLAAG)=STRING$(N.CHAR,"Z") : REM Om 'hors competition' te stellen
3530 RETURN
15000 IHOR=IHOR-1 : REM EENMALIGE VERMINDERING
15001 REM Algemene invoerroutine, karakter voor karakter
15002 REM Vermindering IHOR is nodig wegens zuivere "denkpositie"
15050 PRINT FNADR$(IVER, IHOR+1); : LI%=1
15051 REM Kan soms scrollproblemen voorkomen
15100 FOR LJ%=1 TO ILEN : PRINT "."; : NEXT
15150 IF LI%=1 THEN INVOER$=""
15151 REM Tonen invoermasker
15200 PRINT FNADR$(IVER, IHOR + LI%); : LV$=INPUT$(1)
15250 IF LV$=CHR$(13) AND LI%=1 THEN INVOER$=SPACE$(ILEN)  : GOTO 15900
15251 REM Invoer 1 karakter LV$; kwetsbaar voor ^C
15300 IF LV$=CHR$(13) THEN 15900
15301 REM Trapping <RTN>; voor 'omslachtig' afleveren zie 16050
15350 IF LV$=CHR$(8) THEN LI%=LI%+(LI%>1) : PRINT FNADR$(IVER, IHOR+LI%);".";FNADR$(IVER, IHOR + LI%); : INVOER$=LEFT$(INVOER$,LI%+(LI%>1)) : GOTO 15150
15400 IF LV$= "" THEN LV$=" "
15401 REM Backspace
15450 IF LI% > ILEN THEN LI%=ILEN +1 : PRINT CHR$(7) :  GOTO 15150
15500 PRINT LV$;
15501 REM Bescherming rechtergrens masker; BEEP-7 lukt niet op alle systemen
15550 LJ%=ASC(LV$) : IF LJ% < 32 OR LJ% > 126 THEN PRINT CHR$(7) : GOTO 15150
15551 REM N.B. dat Input$-funktie wel leest, maar display onderdrukt
15600 IF IM=0 THEN 15800
15601 REM Validatie op zinnige ASCII-karakters
15650 IF LJ% > 47 AND LJ% < 58 THEN 15800 : REM CIJFER
15700 IF LJ% = 32 OR LJ%=45 THEN IF LI% < 4 THEN 15800
15701 REM Extra kontrole voor numerieke velden: cijfers OK
15750 PRINT CHR$(7) : GOTO 15150
15751 REM N.b. Spaties en - teken alleen voor getal akkoord
15800 INVOER$= INVOER$ + LV$
15801 REM En natuurlijk de punt, als je die wilt gebruiken
15850 LI%=LI%+1 : GOTO 15150
15851 REM Maar als de instruktieteller hier is, heb je geen getal!
15900 PRINT FNADR$(IVER, IHOR+LI%);SPACE$(ILEN-LI%+1)
15950 INVOER$=INVOER$+SPACE$(ILEN-LI%+1) : REM VOOR FIXING
16000 IHOR=IHOR + 1 : REM 15000 NU ONGEDAAN
16001 REM Invoer is af (15350); punten van scherm weg
16050 IF IM=0 THEN RETURN
16051 REM Aanvulling met blanks; vereist voor recordstruktuur!
16100 II=VAL(INVOER$)
16150 IF ABS(II) > ABS(IM) THEN PRINT CHR$(7) : GOTO 15000 ELSE RETURN
16249 REM N.b. laatste afkeur-mogelijkheid voor getallen. + of - doet niet mee
) THEN PRINT CHR$(7) : GOTO 15000 ELSE RETURN
16249 REM N.b. laatste afkeur-mogelijkheid voor getallen. + of - do