|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 2528 (0x9e0)
Types: TextFile
Notes: Mikados TextFile, Mikados_K
Names: »FCOPY80«
└─⟦670c0171b⟧ Bits:30005246 COMAL-80 version 1.3 (MIKADOS)
└─ ⟦this⟧ »FCOPY80«
0100 // 05.09.1980 PNM, COMAL80 VERSION 24.04.1982 0110 DIM DREVFRA$ OF 2,DREVTIL$ OF 2,TYPE$ OF 1,NAVNFRA$ OF 9 0120 DIM NAVN$ OF 18,SIDSTECHAR$ OF 1,NAVNTIL$ OF 9 0130 INTEGER INDEX,FLAG,FOREVER,Y 0140 PRINT "FCOPY80 - KOPIER FIL." 0150 PRINT 0160 REPEAT 0170 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES FRA: ":DREVFRA$ 0180 UNTIL DREVFRA$>"P0" AND DREVFRA$<="P9" 0190 PRINT 0200 REPEAT 0210 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES TIL: ":DREVTIL$ 0220 UNTIL DREVTIL$>"P0" AND DREVTIL$<="P9" 0230 REPEAT 0240 PRINT 0250 REPEAT 0260 NAVNFRA$:="";NAVN$:="";FLAG,FOREVER:=0 0270 INPUT "INDTAST FILNAVN: ":NAVN$ 0280 EXEC KONVERTOGMOVE(NAVN$,1,NAVNFRA$,SIDSTECHAR$,FLAG) 0290 IF LEN(NAVNFRA$)>8 OR LEN(NAVNFRA$)<1 OR NAVN$(9)<>"" THEN FLAG:=1 0300 IF SIDSTECHAR$=":" THEN FLAG:=1 0310 UNTIL FLAG=0 0320 TYPE$:="K" 0330 EDIT "B FOR BINÆR FIL: ":TYPE$ 0340 REPEAT 0350 NAVN$:="";NAVNTIL$:="";FLAG:=0 0360 INPUT "EVT NYT FILNAVN: ":NAVN$ 0370 IF LEN(NAVN$)=0 THEN 0380 NAVNTIL$:=NAVNFRA$ 0390 ELSE 0400 EXEC KONVERTOGMOVE(NAVN$,1,NAVNTIL$,SIDSTECHAR$,FLAG) 0410 IF LEN(NAVNTIL$)>8 OR LEN(NAVNTIL$)<1 OR NAVN$(9)<>"" THEN FLAG:=1 0420 ENDIF 0430 UNTIL FLAG=0 0440 EXEC COPY 0450 UNTIL FOREVER 0460 PROC COPY 0470 CALL "SYSPROG:CFCOPY" 0480 IF FLAG THEN 0490 PRINT "FCOPY MISLYKKEDES. FEJLKODE ";FLAG 0500 STOP 0510 ELSE 0520 PRINT NAVNFRA$;" ER KOPIERET FRA ";DREVFRA$;" TIL ";DREVTIL$; 0530 PRINT " UNDER NAVNET ";NAVNTIL$ 0540 ENDIF 0550 ENDPROC COPY 0560 PROC KONVERTOGMOVE(NFRA$,I,REF NTIL$,REF CH$,REF F) 0570 Y:=1 0580 REPEAT 0590 CH$:=NFRA$(I) 0600 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32) 0610 IF CH$<>":" THEN 0620 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN 0630 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0640 ELSE 0650 IF CH$<>"" THEN 0660 F:=1 0670 EXIT // ULOVLIGT TEGN 0680 ENDIF 0690 ENDIF 0700 ENDIF 0710 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18 0720 ENDPROC KONVERTOGMOVE
20100 // 05.09.1980 PNM, COMAL80 VERSION 24.04.19822=0110 DIM DREVFRA$ OF 2,DREVTIL$ OF 2,TYPE$ OF 1,NAVNFRA$ OF 9=30120 DIM NAVN$ OF 18,SIDSTECHAR$ OF 1,NAVNTIL$ OF 93!0130 INTEGER INDEX,FLAG,FOREVER,Y!"0140 PRINT "FCOPY80 - KOPIER FIL.""▶0b◀0150 PRINT ▶0b◀\f 0160 REPEAT \f >0170 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES FRA: ":DREVFRA$>+0180 UNTIL DREVFRA$>"P0" AND DREVFRA$<="P9"+▶0b◀0190 PRINT ▶0b◀\f 0200 REPEAT \f >0210 INPUT "DREVNR (P1, P2, .. ), DER KOPIERES TIL: ":DREVTIL$>+0220 UNTIL DREVTIL$>"P0" AND DREVTIL$<="P9"+\f 0230 REPEAT \f ▶0b◀0240 PRINT ▶0b◀\f 0250 REPEAT \f +0260 NAVNFRA$:="";NAVN$:="";FLAG,FOREVER:=0+$0270 INPUT "INDTAST FILNAVN: ":NAVN$$:0280 EXEC KONVERTOGMOVE(NAVN$,1,NAVNFRA$,SIDSTECHAR$,FLAG):G0290 IF LEN(NAVNFRA$)>8 OR LEN(NAVNFRA$)<1 OR NAVN$(9)<>"" THEN FLAG:=1G$0300 IF SIDSTECHAR$=":" THEN FLAG:=1$▶11◀0310 UNTIL FLAG=0▶11◀▶0f◀0320 TYPE$:="K"▶0f◀#0330 EDIT "B FOR BINÆR FIL: ":TYPE$#\f 0340 REPEAT \f #0350 NAVN$:="";NAVNTIL$:="";FLAG:=0#$0360 INPUT "EVT NYT FILNAVN: ":NAVN$$▶1a◀0370 IF LEN(NAVN$)=0 THEN ▶1a◀▶17◀0380 NAVNTIL$:=NAVNFRA$▶17◀ 0390 ELSE :0400 EXEC KONVERTOGMOVE(NAVN$,1,NAVNTIL$,SIDSTECHAR$,FLAG):G0410 IF LEN(NAVNTIL$)>8 OR LEN(NAVNTIL$)<1 OR NAVN$(9)<>"" THEN FLAG:=1G▶0b◀0420 ENDIF ▶0b◀▶11◀0430 UNTIL FLAG=0▶11◀▶0e◀0440 EXEC COPY▶0e◀▶12◀0450 UNTIL FOREVER▶12◀▶0e◀0460 PROC COPY▶0e◀▶1a◀0470 CALL "SYSPROG:CFCOPY"▶1a◀▶12◀0480 IF FLAG THEN ▶12◀.0490 PRINT "FCOPY MISLYKKEDES. FEJLKODE ";FLAG. 0500 STOP 0510 ELSE B0520 PRINT NAVNFRA$;" ER KOPIERET FRA ";DREVFRA$;" TIL ";DREVTIL$;B$0530 PRINT " UNDER NAVNET ";NAVNTIL$$▶0b◀0540 ENDIF ▶0b◀▶11◀0550 ENDPROC COPY▶11◀80560 PROC KONVERTOGMOVE(NFRA$,I,REF NTIL$,REF CH$,REF F)8 0570 Y:=1 \f 0580 REPEAT \f ▶12◀0590 CH$:=NFRA$(I)▶12◀90600 IF CH$=>"a" AND CH$<="å" THEN CH$:=CHR$(ORD(CH$)-32)9▶16◀0610 IF CH$<>":" THEN ▶16◀K0620 IF (CH$=>"0" AND CH$<="9") OR (CH$=>"A" AND CH$<="Å") OR CH$="_" THEN K 0630 NTIL$(Y):=CH$;Y:=Y+1;I:=I+1 0640 ELSE ▶15◀0650 IF CH$<>"" THEN ▶15◀ 0660 F:=1 ▶1a◀0670 EXIT // ULOVLIGT TEGN▶1a◀▶0b◀0680 ENDIF ▶0b◀▶0b◀0690 ENDIF ▶0b◀▶0b◀0700 ENDIF ▶0b◀H0710 UNTIL Y=LEN(NFRA$)+1 OR CH$=":" OR CH$="" OR LEN(NTIL$)=>9 OR I=>18H▶1a◀0720 ENDPROC KONVERTOGMOVE▶1a◀▶00◀▶00◀ KTLK1 ;HOP HVIS JA# LXI H,KTRU ;HVAD MED ▶1e◀ CALL HLDEC ;"RUN"?▶1e◀# JZ KTLK1 ;HOP HVIS JA#▶1d◀ LXI H,KTCL ;"NEW"▶1d◀▶19◀ CALL HLDEC ;?▶19◀0 POP H ; HENT FØRSTE IKKE-BLANKE0& PUSH H ; RETABLER STAK&; JNZ FE37 ;KUN CAT, LOAD, NEW, RUN TILLADT HER;▶06◀KTLK1:▶06◀▶1e◀ POP D ;AFSTAK▶1e◀ POP H ;REGISTRE 5 RET ;EKSEKVER LOAD, CAT, ELLER RUN5▶01◀;▶01◀▶18◀ ;▶18◀.KTAP: c