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