|
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: 7189 (0x1c15)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »BILDRED3«
└─⟦2e6028d8c⟧ Bits:30008748 50001581
└─⟦this⟧ »BILDRED3«
/* 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 KONTO CHAR (5),
2 DUMMY (10) CHAR (47);
DCL RAD CHAR (47);
DCL KTOBESKR FILE;
DCL 1 S CHAR (5),
2 HJALP CHAR (47);
DCL BLANK CHAR (47) INIT (' '),
P CHAR (5),
M CHAR (47);
/* PROCEDURE DIVISION. */
L0:
OPEN KTOBESKR;
L1:
PUT FILE (D) SKIP EDIT ('KONTONUMMER:') (A(42));
GET SKIP LIST (P);
CALL KEYFUN (I);
IF I = 23 THEN GO TO UT;
ON ERROR GO TO UT;
ON ENDFILE GO TO L30;
READ KEY (P) FILE (KTOBESKR) INTO (KONTO);
PUT FILE (D) EDIT (P) (A(5));
DO I = 1 TO 10;
RAD = DUMMY (I);
PUT FILE (D) EDIT (RAD) (A(47));
END;
J = 1;
L2:
RAD = DUMMY (J);
CALL TYPIST (RAD,47);
GET SKIP LIST (RAD);
CALL KEYFUN (I);
DUMMY (J) = RAD;
PUT FILE (D) EDIT (RAD) (A(47));
IF I = 18 THEN GO TO SKRIV;
J = J + 1;
IF J > 10 THEN J = 1;
IF I = 21 THEN DO;
PUT SKIP (3) EDIT ('KONTONUMMER:') (A(14)) (P) (A(5)) SKIP (3);
DO K = 1 TO 10;
RAD = DUMMY (K);
PUT SKIP EDIT (' ') (A(20)) (K) (P'Z9',X(8)) (RAD) (A(47));
END;
PUT SKIP (6);
END;
GO TO L2;
L30:
END;
CALL SEOF (KTOBESKR);
PUT FILE (D) EDIT (P) (A(5));
DO I = 1 TO 10;
RAD = BLANK;
PUT FILE (D) EDIT (RAD) (A(47));
END;
J = 0;
L40:
GET SKIP LIST (M);
PUT FILE (D) EDIT (M) (A(47));
J = J + 1;
CALL KEYFUN (N);
IF N = 140 THEN GO TO SKRIVNY;
IF J < 10 THEN GO TO L40;
IF J = 10 THEN DO;
J = 0;
GO TO L40;
END;
GO TO SKRIVNY;
KONTO = P;
SKRIV:
REWRITE FILE (KTOBESKR) FROM (KONTO);
GO TO L1;
SKRIVNY:
WRITE FILE (KTOBESKR) FROM (KONTO);
CLOSE KTOBESKR;
GO TO L0;
UT:
IF ONCODE = 4 THEN GO TO L30;
CLOSE KTOBESKR;
END;