DataMuseum.dk

Presents historical artifacts from the history of:

Q1 computer

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Q1 computer

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦36a6a64dc⟧ Q1_Text, reclen=79

    Length: 5846 (0x16d6)
    Types: Q1_Text, reclen=79
    Notes: q1file
    Names: »BILDRED2«

Derivation

└─⟦651a288b5⟧ Bits:30008768 50001583
    └─⟦this⟧ »BILDRED2« 

Text

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