|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 96768 (0x17a00)
Types: TextFile
Names: »ventatttx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »ventatttx «
(
message ventatt
ventatt=set 1
ventatt=algol ;message.no
;scope project ventatt
)
external
integer procedure ventatt(vent,z,i,ia,name,p);
boolean vent; zone z; integer i; integer array ia;
long array name; boolean procedure p;
begin
integer inres,res,gli;
own boolean att,holdt; boolean stop,pause,start;
gli:= i;
rep:
i:= gli;
res:= ventatt:= monitor(if vent or holdt then 24 else 66,z,i,ia);
if res = 0 then
begin comment message;
if ia(1) = 0 then
begin comment attention;
boolean ud,op;
long field l;
long array field laf;
long array po(1:2);
integer array ia1(1:20),sv(1:9);
zone zio(10,1,q);
procedure q(z,s,b);
zone z; integer s,b;
begin
if ud then else
begin
ud:= true;
if s shift 7 < 0 <* attention *> then att:= true else
if s shift 2 < 0 <* timer *> then
begin
setposition(zio,0,0);
write(zio,"nl",1);
close(zio,true)
end
end;
goto rep
end q;
procedure r(b);
boolean b;
if -,p(b,ia1.laf) then
begin
setposition(zio,0,0);
write(zio,<:<10>wait<10>:>);
close(zio,true);
if -,op then monitor(64) remove process :(zio,0,ia1)
end r;
name(1):=name(2):=0;
ud:= true;
getzone6(z,ia1);
laf:= 2;
monitor(26) get event :(z,i,ia);
for res:= 1,2,3,4,5,6,7,8 do sv(res):= 0;
sv(9):= 1;
monitor(22) send answer :(z,i,sv);
l:= 6;
if ia.l = long <:stop:> then p(true,ia1.laf) else
begin comment terminal;
open(zio,8,ia1.laf,1 shift 21 + 1 shift 16);
system(7,0,po);
op:= ia1.laf(1) = po(1) and ia1.laf(2) = po(2);
if op and -,att then
begin comment console;
write(zio,<:<10>STOP ? :>);
setposition(zio,0,0);
ud:= false;
inres:=res:= inrec6(zio,0);
inrec6(zio,res);
if res >= 2 then
begin comment >5 tegn læst;
<*--- if zio(1) shift (-16) shift 16 = real <:test:> then
begin comment test;
integer p,l,h,c,s,t;
boolean plus;
procedure gem;
if s >= l and s <= h then test(s):= plus;
p:= 5;
res:= 3 * res // 2;
t:= 1;
l:= system(3,h,test);
if l < 0 then l:= 0;
if h >= l then
while p <= res do
begin
getchar(zio,p,c);
if c = 'nl' or c = 'sp' then
begin
if t = 3 then goto svar;
if t = 4 then gem;
if c = 'nl' then goto svar;
t:= 2
end 'nl' or 'sp' else
if c = '+' or c = '-' then
begin
if t = 3 then goto svar;
if t = 4 then gem;
plus:= c = '+';
t:= 3
end '+' or '-' else
if c >= '0' and c <= '9' then
begin
if t <= 2 then plus:= true;
s:= c - '0' + (if t <= 3 then 0 else s * 10);
t:= 4
end else goto svar
end while;
svar:
ud:= true;
setposition(zio,0,0);
write(zio,<:<10> Test:>);
for res:= l step 1 until h do
if test(res) then write(zio,<< dd>,res);
write(zio,"nl",2);
close(zio,true)
end test else
if zio(1) shift (-16) shift 16 = real <:stop:> then
---*>
stop:=res>=4; pause:=start:=false;
if stop then start:=zio(1) shift(-8) shift 8 = real <:start:>;
if stop then pause:=zio(1) shift(-8) shift 8 = real <:pause:>;
if stop then stop:=zio(1) shift(-16) shift 16 = real <:stop:>;
message CASE;
if stop then
begin comment stop;
holdt:=false;
ud:= true;
r(false add 1)
end stop
else if pause then
begin comment pause;
holdt:= true;
end pause
else if start then
begin comment start;
holdt:= false;
end start
else if not holdt then
begin
integer array konv(0:255);
integer p1, p2, k, t;
isotable(konv);
for k:=128 step 1 until 255 do konv(k):=6 shift 12 add k;
p1:=p2:=1;
message NAVN;
repeat
k:=getchar(zio,p1,konv,t) shift(-12);
if (k=6 or k=2) and t<128 then putchar(name,p2,t);
until k>6 or t=0 or p2=12;
end;
end >5 tegn læst
end console else
begin
att:= false;
r(false)
end;
att:= false
end terminal;
goto rep
end attention
end message
end ventatt;
end
▶EOF◀