|
|
DataMuseum.dkPresents historical artifacts from the history of: Q1 computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Q1 computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 5846 (0x16d6)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BILDRED2«
└─⟦651a288b5⟧ Bits:30008768 50001583
└─⟦this⟧ »BILDRED2«
/* PROGRAM-ID. BILDRED2. */
/* DATE-WRITTEN. 1978-06-21. */
/* AUTHOR. JOHNNY ÅHSTRAND / OLLE BERG */
/* REMARKS. PROGRAMMET GÖR DISPLAY PÅ 12 RADER ÅT GÅNGEN */
/* FRÅN EN FIL "BILDFIL" MED 600 RADER. */
/* EN BILD KAN KOPIERAS FÖR MODIFIERING VARVID */
/* URSPRUNGSBILDEN LIGGER KVAR OFÖRÄNDRAD UNDER */
/* SITT GAMLA BILDNUMMER OCH KOPIAN UNDER SITT */
/* BILDNUMMER */
/* WORKING-STORAGE SECTION. */
DCL 1 DUMMY (12),
2 CH CHAR (47);
DCL 1 STR,
2 RAD CHAR (47);
DCL BILDFIL FILE,
S CHAR (2);
/* PROCEDURE DIVISION. */
OPEN BILDFIL;
L1:
PUT FILE (D) SKIP EDIT ('BILD NUMMER:') (A(45));
GET SKIP LIST (S);
CALL KEYFUN (I);
IF I = 23 THEN GO TO UT;
I = S;
IF I > 50 ö I < 1 THEN GO TO L1;
PUT FILE (D) SKIP;
UNSPEC (BILDFIL) = (I - 1) * 12;
ON ERROR GO TO UT;
ON ENDFILE GO TO UT;
READ FILE (BILDFIL) INTO (DUMMY);
DO I = 1 TO 12;
STR = DUMMY (I);
PUT FILE (D) EDIT (RAD) (A(47));
END;
J = 1;
L2:
STR = DUMMY (J);
CALL TYPIST (RAD,47);
GET SKIP LIST (RAD);
CALL KEYFUN (I);
DUMMY (J) = STR;
PUT FILE (D) EDIT (RAD) (A(47));
IF I = 18 THEN GO TO SKRIV;
IF I = 21 THEN DO;
PUT SKIP (3) EDIT ('BILD NUMMER:') (A(14)) (S) (A) SKIP (3);
DO K = 1 TO 12;
STR = DUMMY (K);
PUT SKIP EDIT (' ') (A(20)) (K) (P'Z9',X(8)) (RAD) (A(47));
END;
PUT SKIP (6);
END;
J = J + 1;
IF J > 12 THEN J = 1;
GO TO L2;
SKRIV:
REWRITE FILE (BILDFIL) FROM (DUMMY);
PUT FILE (D) SKIP EDIT ('TRYCK F1 OM BILDEN SKALL KOPIERAS') (A(47));
GET SKIP LIST (S);
CALL KEYFUN (I);
IF I = 17 THEN GO TO KOPIA;
GO TO L1;
KOPIA:
PUT FILE (D) EDIT ('VILKET BILDNUMMER SKALL VARA KOPIA') (A(47));
GET SKIP LIST (S);
I = S;
IF I > 50 ö I < 1 THEN GO TO L1;
UNSPEC (BILDFIL) = (I - 1) * 12;
ON ERROR GO TO UT;
ON ENDFILE GO TO UT;
WRITE FILE (BILDFIL) FROM (DUMMY);
GO TO L1;
UT:
END;