⟦26e65c0dd⟧

Text

0100 DIM K1$(17),K2$(17),K3$(17),K4$(17),K5$(17),K6$(17),K7$(17),T11(9)
0110 DIM K9$(17),T12(9),N1$(6),A$(1),BLANK$(25),TKO$(1),BEO$(12),TEO$(25)
0120 DIM T21(9),T22(9)
0130 BLANK$="                         "
0140 CLEAR 
0150 REPEAT 
0160 CURSOR 30,13
0170 INPUT "Sæt plade nr 21 i ,tast RETURN",A$
0180 UNTIL ORD(A$)=255
0190 K1$="P641220:SYSTEM1"
0200 OPEN K1$,R
0210 EXEC FEJL(1,1,K1$)
0220 GET K1$,2:MKASPOST,MPPOST,MBHPOST,MFMID
0230 EXEC FEJL(1,2,K1$)
0240 GET K1$,3:MDMID,MKMID,MFPOST,MDPOST
0250 EXEC FEJL(1,3,K1$)
0260 GET K1$,4:MKPOST
0270 EXEC FEJL(1,4,K1$)
0280 GET K1$,10:N1$
0290 EXEC FEJL(1,6,K1$)
0300 CLOSE K1$
0310 EXEC FEJL(1,5,K1$)
0320 DIM HDTAB(MDPOST DIV 40,2),HFTAB(MFPOST DIV 40,2),UDTAB(4,2),UFTAB(4,2)
0330 DIM HKRTAB(MKPOST DIV 40,2),UKTAB(4,2)
0340 IMD=MFMID
0350 IF IMD<MDMID THEN IMD=MDMID
0360 IF IMD<MKMID THEN IMD=MKMID
0370 DIM N(IMD),D(IMD),BI(IMD),TK$(IMD,1),BE$(IMD,12),TE$(IMD,25),PEG(IMD)
0380 K1$=N1$+"20:SYSTEM2"
0390 EXEC FSYSIN(K1$,T11,T12)
0400 K2$=N1$+"21:SYSTEM21"
0410 EXEC FSYSIN(K2$,T21,T22)
0420 K3$=N1$+"20:DMID"
0430 K4$=N1$+"21:DMID1"
0440 EXEC FSORT(K3$,T11(3),K4$,T21(3))
0450 EXEC FSYSUD(K2$,T21,T22)
0460 K5$=N1$+"20:DPOST"
0470 K6$=N1$+"21:DPOST1"
0480 K7$=N1$+"21:HDTAB1"
0490 K9$=N1$+"20:HDTAB"
0500 EXEC FFLET(K5$,K6$,T11(3),T11(6),T21(6))
0510 EXEC FSYSUD(K2$,T21,T22)
0520 EXEC TABINIT(K6$,K7$,MDPOST,HDTAB,UDTAB)
0530 EXEC FKOPI(K6$,K5$,T21(6),T11(6))
0540 EXEC TABINIT(K5$,K9$,MDPOST,HDTAB,UDTAB)
0550 T11(3)=0
0560 EXEC FSYSUD(K1$,T11,T12)
0570 K3$=N1$+"20:FMID"
0580 K4$=N1$+"21:FMID1"
0590 EXEC FSORT(K3$,T11(2),K4$,T21(2))
0600 EXEC FSYSUD(K2$,T21,T22)
0610 K5$=N1$+"20:FPOST"
0620 K6$=N1$+"21:FPOST1"
0630 K7$=N1$+"21:HFTAB1"
0640 K9$=N1$+"20:HFTAB"
0650 EXEC FFLET(K5$,K6$,T11(2),T11(5),T21(5))
0660 EXEC FSYSUD(K2$,T21,T22)
0670 EXEC TABINIT(K6$,K7$,MFPOST,HFTAB,UFTAB)
0680 EXEC FKOPI(K6$,K5$,T21(5),T11(5))
0690 EXEC TABINIT(K5$,K9$,MFPOST,HFTAB,UFTAB)
0700 T11(2)=0
0710 EXEC FSYSUD(K1$,T11,T12)
0720 K3$=N1$+"20:KRMID";K4$=N1$+"21:KRMID1";K5$=N1$+"20:KRPOST"
0730 K6$=N1$+"21:KRPOST1";K7$=N1$+"21:HKRTAB1";K9$=N1$+"20:HKRTAB"
0740 EXEC FSORT(K3$,T11(4),K4$,T21(4))
0750 EXEC FSYSUD(K2$,T21,T22)
0760 EXEC FFLET(K5$,K6$,T11(4),T11(7),T21(7))
0770 EXEC FSYSUD(K2$,T21,T22)
0780 EXEC TABINIT(K6$,K7$,MKPOST,HKRTAB,UKTAB)
0790 EXEC FKOPI(K6$,K5$,T21(7),T11(7))
0800 EXEC TABINIT(K5$,K9$,MKPOST,HKRTAB,UKTAB)
0810 T11(4)=0;T12(1)=0
0820 EXEC FSYSUD(K1$,T11,T12)
0830 CLEAR 
0840 REPEAT 
0850 CURSOR 30,13
0860 INPUT "Sæt plade nr 10 i ,tast RETURN",A$
0870 UNTIL ORD(A$)=255
0880 CHAIN "P641210:OPSTART"
0890 END 
0900 PROC FEJL(NR1,NR2,NR3)
0910 IF STATUS(NR3$)<>0 THEN 
0920 PRINT NR1,NR2,NR3$,STATUS(NR3$)
0930 STOP 
0940 ENDIF 
0950 ENDPROC 
0960 PROC FSORT(K,MID,K21,MIDE)
0970 OPEN K$,R
0980 EXEC FEJL(2,1,K$)
0990 OPEN K21$,W
1000 EXEC FEJL(2,11,K21$)
1010 J=1
1020 FOR I=1 TO MID
1030 EXEC FGET2(K$,I,N(J),D(J),BI(J),TK$(J),BE$(J),TE$(J))
1040 J=J+1
1050 NEXT I
1060 FOR I=1 TO J-1
1070 PEG(I)=I
1080 NEXT I
1090 FOR I=1 TO J-1
1100 MIN=I
1110 FOR H=I+1 TO J-1
1120 IF N(PEG(H))<N(PEG(MIN)) THEN 
1130 MIN=H
1140 ELSE 
1150 IF N(PEG(H))=N(PEG(MIN)) THEN 
1160 IF D(PEG(H))<D(PEG(MIN)) THEN MIN=H
1170 ENDIF 
1180 ENDIF 
1190 NEXT H
1200 MP=PEG(I)
1210 PEG(I)=PEG(MIN)
1220 PEG(MIN)=MP
1230 NEXT I
1240 H=1
1250 FOR I=1 TO J-1
1260 Q=PEG(I)
1270 EXEC FPUT2(K21$,H,N(Q),D(Q),BI(Q),TK$(Q),BE$(Q),TE$(Q))
1280 H=H+1
1290 NEXT I
1300 MIDE=H-1
1310 CLOSE K$
1320 EXEC FEJL(2,4,K$)
1330 CLOSE K21$
1340 EXEC FEJL(2,5,K21$)
1350 ENDPROC 
1360 PROC FSYSIN(K11,T1,T2)
1370 OPEN K11$,R
1380 EXEC FEJL(5,1,K11$)
1390 GET K11$,13:T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1(9)
1400 EXEC FEJL(5,2,K11$)
1410 GET K11$,17:T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8),T2(9)
1420 EXEC FEJL(5,3,K11$)
1430 CLOSE K11$
1440 EXEC FEJL(5,4,K11$)
1450 ENDPROC 
1460 PROC FSYSUD(K12,T3,T4)
1470 OPEN K12$,W
1480 EXEC FEJL(6,1,K12$)
1490 PUT K12$,13:T3(1),T3(2),T3(3),T3(4),T3(5),T3(6),T3(7),T3(8),T3(9)
1500 EXEC FEJL(6,2,K12$)
1510 PUT K12$,17:T4(1),T4(2),T4(3),T4(4),T4(5),T4(6),T4(7),T4(8),T4(9)
1520 EXEC FEJL(6,3,K12$)
1530 CLOSE K12$
1540 EXEC FEJL(6,4,K12$)
1550 ENDPROC 
1560 PROC FGET2(K15,I3,N3,D3,BI3,TK3,BE3,TE3)
1570 GET K15$,I3:N3,D3,BI3,TK3$,BE3$
1580 EXEC FEJL(9,1,K15$)
1590 IF ORD(TK3$)-48>9 AND ORD(TK3$)-48<20 THEN 
1600 I3=I3+1
1610 GET K15$,I3:N3,TE3$
1620 EXEC FEJL(9,2,K15$)
1630 ELSE 
1640 TE3$=BLANK$
1650 ENDIF 
1660 ENDPROC 
1670 PROC FPUT2(K16,I4,N4,D4,BI4,TK4,BE4,TE4)
1680 PUT K16$,I4:N4,D4,BI4,TK4$,BE4$
1690 EXEC FEJL(10,1,K16$)
1700 IF ORD(TK4$)-48>9 AND ORD(TK4$)-48<20 THEN 
1710 I4=I4+1
1720 PUT K16$,I4:N4,TE4$
1730 EXEC FEJL(10,2,K16$)
1740 ENDIF 
1750 ENDPROC 
1760 PROC FFLET(K17,K18,DPM2,DPO2,DPO3)
1770 OPEN K17$,R
1780 EXEC FEJL(11,1,K17$)
1790 OPEN K18$,W
1800 EXEC FEJL(11,2,K18$)
1810 L=1
1820 M=1
1830 P=1
1840 TEST=0
1850 IF DPM2<>0 AND DPO2<>0 THEN 
1860 REPEAT 
1870 IF TEST=0 THEN 
1880 EXEC FGET2(K17$,L,NO,DO,BIO,TKO$,BEO$,TEO$)
1890 L=L+1
1900 TEST=1
1910 ENDIF 
1920 IF M<J THEN 
1930 Q=PEG(M)
1940 ELSE 
1950 N(Q)=100000
1960 ENDIF 
1970 IF N(Q)<NO THEN 
1980 EXEC FPUT2(K18$,P,N(Q),D(Q),BI(Q),TK$(Q),BE$(Q),TE$(Q))
1990 M=M+1
2000 ELSE 
2010 IF N(Q)=NO AND D(Q)<DO THEN 
2020 EXEC FPUT2(K18$,P,N(Q),D(Q),BI(Q),TK$(Q),BE$(Q),TE$(Q))
2030 M=M+1
2040 ELSE 
2050 EXEC FPUT2(K18$,P,NO,DO,BIO,TKO$,BEO$,TEO$)
2060 TEST=0
2070 ENDIF 
2080 ENDIF 
2090 P=P+1
2100 UNTIL (DPO2=L-1 OR M=J) AND TEST=0
2110 IF DPO2=L-1 THEN 
2120 STYR=1
2130 ELSE 
2140 STYR=0
2150 ENDIF 
2160 ELSE 
2170 IF DPM2=0 THEN 
2180 STYR=0
2190 ELSE 
2200 STYR=1
2210 ENDIF 
2220 ENDIF 
2230 IF STYR=1 THEN 
2240 FOR I=M TO J-1
2250 Q=PEG(I)
2260 EXEC FPUT2(K18$,P,N(Q),D(Q),BI(Q),TK$(Q),BE$(Q),TE$(Q))
2270 P=P+1
2280 NEXT I
2290 ELSE 
2300 FOR I=L TO DPO2
2310 EXEC FGET2(K17$,I,NO,DO,BIO,TKO$,BEO$,TEO$)
2320 EXEC FPUT2(K18$,P,NO,DO,BIO,TKO$,BEO$,TEO$)
2330 P=P+1
2340 NEXT I
2350 ENDIF 
2360 DPO3=P-1
2370 CLOSE K17$
2380 EXEC FEJL(11,3,K17$)
2390 CLOSE K18$
2400 EXEC FEJL(11,4,K18$)
2410 ENDPROC 
2420 PROC FKOPI(K19,K20,DPO4,DPO5)
2430 OPEN K19$,R
2440 EXEC FEJL(12,1,K19$)
2450 OPEN K20$,W
2460 EXEC FEJL(12,2,K20$)
2470 FOR I=1 TO DPO4
2480 J=I
2490 EXEC FGET2(K19$,I,NO,DO,BIO,TKO$,BEO$,TEO$)
2500 EXEC FPUT2(K20$,J,NO,DO,BIO,TKO$,BEO$,TEO$)
2510 NEXT I
2520 CLOSE K19$
2530 CLOSE K20$
2540 EXEC FEJL(12,3,K20$)
2550 DPO5=DPO4
2560 ENDPROC 
2570 PROC TABINIT(K31,K32,MPOSTANTAL3,HTAB2,UTAB2)
2580 OPEN K31$,R
2590 EXEC FEJL(15,1,K31$)
2600 OPEN K32$,W
2610 EXEC FEJL(15,2,K32$)
2620 H=1
2630 FOR I=1 TO MPOSTANTAL3 DIV 40
2640 GET K31$,H:KONR
2650 EXEC FEJL(15,3,K31$)
2660 HTAB2(I,1)=KONR
2670 FOR J=1 TO 4
2680 GET K31$,H:KONR
2690 EXEC FEJL(15,4,K31$)
2700 UTAB2(J,1)=KONR
2710 H=H+9
2720 GET K31$,H:KONR
2730 EXEC FEJL(15,5,K31$)
2740 UTAB2(J,2)=KONR
2750 H=H+1
2760 NEXT J
2770 HTAB2(I,2)=KONR
2780 EXEC UNDUD(K32$,I,UTAB2,MPOSTANTAL3)
2790 NEXT I
2800 EXEC HOVUD(K32$,MPOSTANTAL3,HTAB2)
2810 CLOSE K31$
2820 EXEC FEJL(15,6,K31$)
2830 CLOSE K32$
2840 EXEC FEJL(15,7,K32$)
2850 ENDPROC ;TABINIT
2860 PROC UNDUD(V3,U2,T,MPOSTANT)
2870 U3=U2+MPOSTANT DIV 160
2880 PUT V3$,U3:T(1,1),T(1,2),T(2,1),T(2,2),T(3,1),T(3,2),T(4,1),T(4,2)
2890 EXEC FEJL(16,1,V3$)
2900 ENDPROC ;UNDUD
2910 PROC HOVUD(V4,MPOSTANTAL4,S)
2920 FOR I=1 TO MPOSTANTAL4 DIV 160
2930 J=(I-1)*4+1;J1=J+1;J2=J+2;J3=J+3
2940 PUT V4$,I:S(J,1),S(J,2),S(J1,1),S(J1,2),S(J2,1),S(J2,2),S(J3,1),S(J3,2)
2950 EXEC FEJL(17,2,V4$)
2960 NEXT I
2970 ENDPROC
DataMuseum.dk

MIKADOS

⟦26e65c0dd⟧

Derivation

Text
