DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFileVerbose
    Names: »telextxt«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »telextxt« 

TextFileVerbose

job j 1 time 9 0 devi 44 perm disc1 10 10
telex=set 42 disc1
scope user telex
telex=algol
begin
<* 
this program punches a file on a 5-channel telex-paper-tape
ready to be sent as a telex.

programmed 10.12.1979 by stb
*>

integer
<*****>

i,char,last_char,current_class,
lf,sp,cr,class,no_of_illegal_chars;


integer array
<***********>

table(0:255);               <* holds the intable *>


zone zout(50,2,stderror);


boolean
<*****>

eof;

\f


procedure change_paper(type);
value type; integer type;
begin <* sends a change_paper message to boss.
the message is displayed on the main console and
the operator must type
answer <job>
when the paper tape has been changed *>

integer array share(1:12), answer(1:8);
integer result;
real field rf;
zone boss(1,1,stderror);

write(out,<:
skift strimmel i perforatoren og
tast 'answer <job>' p} hovedkonsollen n}r du er f{rdig.<10>:>);
setposition(out,0,0);


open(boss,0,<:boss:>,0);
getshare6(boss,share,1);
share(4):=26 shift 12 + 1 shift 9 + 1;  <* change paper message *>
rf:=12;

share.rf:= real<:chang:> add 101;   <* change *>
share(7):=type;                     <* paper type *>

rf:=18;
share.rf:=real <:punch:> ;    <* punch *>
rf:=22;
share.rf:=real<::>;

setshare6(boss,share,1);

<* now send the message *>
monitor(16 <* send message *>, boss,1,answer);
result:=monitor(18 <* wait answer *>,boss,1,answer);

close(boss,true);
end change paper;


\f


integer procedure next_char;
if -,eof then
begin <* reads the next character from input.
if it is blind (class 0) it is skipped *>
integer char;

class:=readchar(in,char);
eof:=class=4;
if class=5 then no_of_illegal_chars:=no_of_illegal_chars+1;
nextchar:=if class=5 then nextchar else char;
end;


\f


procedure punch_big_telex;
begin <* punches the word 'telex' in big easy_to_read
letters *>
integer char;

for char:= 16,16,31,16,16,0,
_          31,21,21,21,0,
_          31,1,1,1,0,
_          31,21,21,21,0,
_          17,10,4,10,17
do outchar(zout,char);

end punch big telex;


\f


procedure rep_char(no,char);
value no,char; integer no,char;
begin <* punches 'char' 'no' times *>
integer i;

for i:=1 step 1 until no do outchar(zout,char);
end rep char;


\f


procedure set_table;
begin <* initialises the input conversion table .

we have 5 classes of characters:

class 0:   cr and other blind characters
class 2:   digits and marks (0..9, -, :, ( ... )
class 3:   sp,lf
class 4:   eof characters
class 5:   illegal characters
class 6:   letters (a..z)
*>

integer i;

procedure init(no,val,class);
value no,val,class;
integer no,val,class;
table(no):=class shift 12 + val;


for i:=0 step 1 until 31 do init(i,0,0);
for i:=32 step 1 until 255 do init(i,4,5); <* illegal chars are punched as spaces *>


init(10,8,3);
init(25,0,4);   <* em *>
init(32,4,3);  <* sp *>
init(33,26,2); <* bell *>
init(35,18,2);


init(39,20,2);
init(40,30,2);
init(41,9,2);
init(43,17,2);
init(44,6,2);
init(45,24,2);
init(46,7,2);
init(47,23,2);
init(48,13,2);
init(49,29,2);
init(50,25,2);
init(51,16,2);
init(52,10,2);
init(53,1,2);
init(54,21,2);
init(55,28,2);
init(56,12,2);
init(57,3,2);

init(58,14,2);
init(61,15,2);
init(63,19,2);

<* letters *>

for i:=0,32 do
begin  <* i=0 => upper case letters,  i=32  => lower case letters *>

for char:=1 step 1 until 26 do
init(char+i+64,
_    case char of (
24,19,14,18,16,22,11,5,12,26,30,9,7,6,3,13,29,10,20,1,28,15,25,23,21,17),
_  6);
end;

<* {,| and } *>
for i:=0,32 do
begin
init(91+i,11,2);
init(92+i,5,2);
init(93+i,22,2);
end;


intable(table);

end set table;



procedure testout(text,int);
value int; integer int; string text;
begin
write(out,text,int,false add 10,1);
setposition(out,0,0);
end test out;


\f


<***************   main loop  ******************>

change_paper(1);    <* mount telex paper tape into punch *>

set_table;          <* initialise conversion table *>

open(zout,4 shift 12 + 12, <:punch:>,0);

repchar(10,0);
punch_big_telex;
repchar(20,0);
repchar(10,31);

<**** initialise variables *****>

eof:= false;
current_class:=-1;
no_of_illegal_chars:=0;
char:=0;
lastchar:=0;
lf:=8;
sp:=4;
cr:=2;
repchar(1,cr);
repchar(1,lf);

\f


<*******  punch telex   ******>

char:=nextchar;


while -,eof do
begin
if (current_class <> class) and ( (class=2) or (class=6) ) then
begin <* change class *>
current_class:=class;
outchar(zout,if class=6 then 31 else 27);
end
else
if (last_char <> lf) and (char = lf) then outchar(zout,cr);

outchar(zout,char);

<* get the next *>
lastchar:=char;
char:=nextchar;
end;


repchar(10,31);
repchar(50,0);
close(zout,true);
change_paper(0);

if no_of_illegal_chars>0 then
write(out,<:<10><10>advarsel: :>,no_of_illegal_chars,
_     <: illegale tegn<10>:>);

end
if warning.yes
(message warning compilation not ok
finis)
message compilation ok
finis

«eof»