|
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;