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