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

⟦5c3699d95⟧ Q1_Text, reclen=79

    Length: 15642 (0x3d1a)
    Types: Q1_Text, reclen=79
    Notes: q1file
    Names: »MENY_S«

Derivation

└─⟦cd9c00c3f⟧ Bits:30008718 DDMQ1-0159_KTOTXREN
    └─⟦this⟧ »MENY_S« 

Text

/* FÖRSTA RADEN. TRYCK "F6" OCH "F2"     EFTER INMATNING TRYCK "F1" OCH "F7" */
/* MENY ÄR ETT MENYPROGRAM SOM LÄSER TEXTER FRÅN FILEN Q_TEXT PRG              
790726 INKNAPPAT LMC AMF 1979-12-20                                            
                                                                               
DCL 1 POST,                                                                    
      2 REK_#             BINARY,                                              
      2 TEXT              CHAR(47),                                            
      2 LENGD             BINARY,                                              
      2 KOMANDO           CHAR(10),                                            
      2 SPECIAL           BINARY,                                              
      2 N_POST_X          BINARY      INIT(1),                                 
      2 N_POST_Y          BINARY      INIT(1),                                 
      2 L_TEXT            CHAR(50),                                            
                                                                               
                                                                               
    1 AREA(250),                                                               
      2 CH                CHAR(117),                                           
                                                                               
    POS_TAB(0:12)         BINARY      INIT(1),                                 
    KOMANDO_TAB(12)       CHAR(10),                                            
    RAD_ANT               BINARY,                                              
    POS                   BINARY      INIT(1),                                 
    VERSION               CHAR(47)    INIT                                     
    ('MENY VERSION 1.3                791127');                                
                                                                               
POST_IN:PROC;                                                                  
DCL Q_TEXT                FILE;                                                
        OPEN Q_TEXT;                                                           
        ON ENDFILE GO TO PIN_1;                                                
        READ FILE(Q_TEXT) INTO(AREA);                                          
PIN_1:                                                                         
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
DISP_SKRIV:PROC(R_ANT_DS);                                                     
DCL R_ANT_DS  BINARY;                                                          
        N_POST_X=N_POST_Y;                                                     
        R_ANT_DS=1;                                                            
        PUT FILE(D) SKIP;                                                      
LOOPS_DS:POS_TAB(R_ANT_DS)=N_POST_X;                                           
        POST=AREA(N_POST_X);                                                   
        KOMANDO_TAB(R_ANT_DS)=KOMANDO;                                         
        IF N_POST_X¬=0 & R_ANT_DS<12 THEN DO;                                  
           PUT FILE(D) EDIT(TEXT)(A(47));                                      
           R_ANT_DS=R_ANT_DS+1;                                                
           GO TO LOOP_DS;                                                      
        END;                                                                   
        ELSE DO;                                                               
           PUT FILE(D) EDIT(TEXT)(A(LENGD));                                   
    RETURN;                                                                    
        END;                                                                   
END;                                                                           
                                                                               
                                                                               
                                                                               
KOM:PROC(T_K,L_K);                                                             
DCL T_K                   CHAR(10),                                            
    L_K                   BINARY,                                              
    T47_K                 CHAR(47),                                            
    T47_HOD               CHAR(1)     INIT(' '),                               
    SVAR                  CHAR(47),                                            
    TOM                   CHAR(47)    INIT                                     
    ('                                      '),                                
    I_K                   BINARY,                                              
    J_K                   BINARY;                                              
        T47_K=TOM;                                                             
        GET SKIP LIST(SVAR);                                                   
        I_K=INDEX(SVAR,'.');                                                   
        J_K=INDEX(SVAR,' ');                                                   
        IF I_K=O THEN L_K=J_K-1;                                               
        ELSE L_K=I_K-1;                                                        
        IF I_K>0 THEN DO;                                                      
           SUBSTR(T47_K,1,47-I_K)=SUBSTR(SVAR,I_K+1,47-I_K);                   
           CALL TYPIST(T47_K,48);                                              
        END;                                                                   
        T_K='          ';                                                      
        IF L_K<11 THEN SUBSTR(T_K,1,L_K)=SUBSTR(SVAR,1,L_K);                   
        ELSE T_K='¬¬¬¬¬¬¬¬¬¬';                                                 
        IF L_K>0 THEN L_K=10;                                                  
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
GET_DAT:PROC(POS_GD,R_GD);                                                     
DCL POS_GD                BINARY,                                              
    R_GD                  BINARY,                                              
    P_GD                  POINTER,                                             
    DATUM_GD              CHAR(6)     BASED(P_GD),                             
    DAT GD                CHAR(6),                                             
    T10_GD                CHAR(10),                                            
    L_GD                  BINARY;                                              
                                                                               
           UNSPEC(P_GD)=16570;                                                 
GD_1:  CALL DATCHECK(DAT_GD);                                                  
        IF DAT_GD='0     ' THEN DO;                                            
           GET SKIP LIST(DATUM_GD);                                            
           CALL KEYFUN(K_GD);                                                  
           IF K_GD=23 THEN STOP;                                               
           IF K_GD=24 THEN DO;                                                 
              POS_GD=1;                                                        
    RETURN;                                                                    
              END;                                                             
              GO TO GD_1;                                                      
           END;                                                                
           POS_GD=POS_TAB(R_GD);                                               
        RETURN;                                                                
END;                                                                           
                                                                               
                                                                               
GET_KOM:PROC(POS_GK,R_GK;                                                      
GET_KOM:PROC(POS_GK,R_GK);                                                     
DCL R_GK                  BINARY,                                              
    POS_GK                BINARY,                                              
    L_GK                  BINARY,                                              
    T10_GK                CHAR(10),                                            
    I_GK                  BINARY;                                              
        CALL KOM(T10_GK,L_GK);                                                 
        CALL KEYFUN(I_GK);                                                     
        IF I_GK=5 THEN DO;                                                     
           PUT FILE(D) SKIP EDIT(VERSION)(A(94);                               
           GET SKIP LIST('');                                                  
        END;                                                                   
        IF I_GK=23 THEN STOP;                                                  
        IF I_GK=24 THEN DO;                                                    
           POS_GK=1;                                                           
    RETURN;                                                                    
        END;                                                                   
        IF L_GK=0 THEN RETURN;                                                 
        DO I_GK=1 TO R_GK;                                                     
           IF SUBSTR(T10_GK,1,L_GK)=SUBSTR(KOMANDO_TAB(I_GK),1,L_GK)THEN       
           POS_GK=POS_TAB(I_GK);                                               
        END;                                                                   
    RETURN;                                                                    
END;                                                                           
                                                                               
                                                                               
KOMENTAR:PROC(P_K,R_K);                                                        
DCL P_K                   BINARY,                                              
    R_K                   BINARY;                                              
           GET SKIP LIST('');                                                  
        P_K=POS_TAB(R_K);                                                      
    RETURN;                                                                    
END;                                                                           
                                                                               
KOMANDO_TEST:PROC(POS_KT,R_KT);                                                
DCL R_KT                  BINARY,                                              
    POS_KT                BINARY,                                              
    LABEL_KT(0:9)         LABEL       INIT(KT_0,KT_1,KT_2,KT_3,KT_4,           
                                      KT_5,KT_6,KT_7,KT_8,KT_9);               
        IF SPECIAL>10 Ö SPECIAL<0 THEN RETURN;                                 
        GO TO LABEL_KT(SPECIAL);                                               
KT_O    CALL GET_KOM(POS_KT,R_KT);                                             
    RETURN;                                                                    
KT_1:   CALL GET_DAT(POS_KT,R_KT);                                             
    RETURN;                                                                    
KT_2:   CALL KOMENTAR(POS_KT,R_KT);                                            
    RETURN;                                                                    
KT_3:                                                                          
    RETURN;                                                                    
KT_4:                                                                          
    RETURN;                                                                    
KT_5:                                                                          
    RETURN;                                                                    
KT_6:                                                                          
    RETURN;                                                                    
KT_7:                                                                          
    RETURN;                                                                    
KT_8:                                                                          
    RETURN;                                                                    
KT_9:                                                                          
    RETURN;                                                                    
END;                                                                           
                                                                               
GET_NEXT_PROG:PROC(T50_GNP);                                                   
DCL T50_GNP               CHAR(50);                                            
                                                                               
        IF SUBSTR(T50_GNP,1,8)='STOP ' THEN STOP;                              
        IF SUBSTR(T50_GNP,9,1)='&' THEN CALL PLOAD(T50_GNP);                   
        DO I=50 TO 1 BY -1;                                                    
           IF SUBSTR(T50_GNP,I,1)¬=' ' THEN DO;                                
              CALL LOAD(T50_GNP,I);                                            
    RETURN;                                                                    
           END;                                                                
        END;                                                                   
    RETURN;                                                                    
END;                                                                           
                                                                               
           CALL POST_IN;                                                       
                                                                               
LOOP:   CALL DISP_SKRIV(RAD_ANT);                                              
        CALL KOMANDO_TEST(POS,RAD_ANT);                                        
        POST=AREA(POS);                                                        
        IF N_POST_Y¬=0 THEN GO TO LOOP;                                        
                                                                               
        CALL GET_NEXT_PROG(L_TEXT);                                            
                                                                               
END;