|
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: 15642 (0x3d1a)
Types: Q1_Text, reclen=79
Notes: q1file
Names: »MENY_S«
└─⟦cd9c00c3f⟧ Bits:30008718 DDMQ1-0159_KTOTXREN
└─⟦this⟧ »MENY_S«
/* 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;