|
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: 12288 (0x3000)
Types: TextFile
Names: »pagefeedtx«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦787c125fb⟧ »adjprocfile«
└─⟦this⟧
; page_feed_tx * page 1 3 01 78, 15.35;
; page_feed
; *********
if listing.yes
char 10 12 10
page_feed = set 1
page_feed = algol
external integer procedure page_feed
____________________________________
_ (out_z, reg_lab, job_tp, date_tm, page_no, expr, line_no);
value date_tm;
zone out_z;
array reg_lab;
string job_tp;
long date_tm;
integer page_no, expr, line_no;
comment
page_feed (call, integer)
page_feed produces a nl, ff and a nl, followed by * and the
name of the region given in reg_lab(2), first byte, followed
the string job_tp (preferably less than 20 characters), the time
and date and the page_number, which is increased by one
after the output. after a nl char a short description taken from
reg_lab is givem. then expr is evaluated, mostly with the
consequence of an output, and at last a semicolon is output.
finally the line_no is returned as 2 + the value of expr.
the procedure has the sane value as line_no.
out_z (call and return, zone)
the zone used for output of the characters. the zone must be open
and ready for char output.
reg_lab (call, array)
the array containing then standard reg_label information.
job_tp (call, string)
a string describing the type of the job, eg. transformation.
the string should no exceed 20 char.
date_tm (call, long)
the date and time in standard gi-format, eg. as given by
date_time.
page_no (call and return, integer)
the value used in the call is output and then increased by one.
expr (call, integer)
the value of expr is evaluated just after the increase of page_no
and should equal the number of nl produced (as side effect) of
the evaluation. the expr should be used as JENSEN's device.
line_no (return, integer)
line_no is given the value of 2 at entry, and increased by the
value of expr when expr is evaluated (called by name).
Prog.: Knud Poder, JAN 1978.
Modified APR 80, RF
;
\f
comment page_feed_tx * page 2 3 01 78, 15.35
0 1 2 3 4 5 6 7 8 9 ;
begin
integer t, reg_type, region, ell, datum, cstm;
_
comment line_no;
________________
line_no := 2;
_
comment reg_type, region, and cstm;
___________________________________
reg_type := (reg_lab(1) shift (-24)) extract 24;
region := (reg_lab(2) shift (-36)) extract 12;
cstm := (reg_lab(2)) extract 12;
_
comment output first line;
__________________________
write(out_z, sp, 20
- write(out_z, <:<10><12><10>*_:>,
case region of (<*job-defined*> <::>,
_ <:Danmark:>,
_ <:RETrig:>,
_ <:Færøerne:>,
_ <:Grønland:>,
_ <:Nordtrig:>,
_ <:Global:>)));
write(out_z, sp, 20 - write(out_z, job_tp));
write(out_z, sp, 20 - wr_date_time(out_z, date_tm));
write(out_z, <:side:>, page_no);
page_no := page_no + 1;
_
comment reg_types;
__________________
case reg_type + 1 of
begin
comment case 0, output 1 blank; write(out_z,sp,1);
comment case 1, output 1 blank; write(out_z,sp,1);
begin comment case 2, coord;
_
comment ell and datum;
______________________
ell := (reg_lab(2) shift (-24)) extract 12;
datum := (reg_lab(2) shift (-12)) extract 12;
write(out_z, nl, 1, <:__Koordinater:_:>);
case cstm of
begin
comment case 1, job-def. system;
________________________________
write(out_z, <:Job-defineret system:>);
\f
comment page_feed_tx * page 3 3 01 78, 15.35
0 1 2 3 4 5 6 7 8 9 ;
comment case 2, geographical coord;
___________________________________
write(out_z, <:geografiske:>);
comment case 3, itm;
____________________
begin
write(out_z, <:ITM (Gauss-Krueger), cntr_lng._:>);
write_geo_c(out_z, long reg_lab(4),
_ false add (1 shift 6 + 6));
write(out_z, sp, 2, <:centr. sc. dev:>, <<_.dddddd'-dd>,
reg_lab(8));
end case 3;
comment case 4, utm;
____________________
write(out_z, <:UTM_zone_:>, long reg_lab(4));
comment case 5, system34;
_________________________
write(out_z, <:System:>,
case long reg_lab(4) of (
<:34_Jylland:>, <:34_Sjælland:>, <:45_Bornholm:>));
comment case 6, conf. conical;
_____________________________
begin
write(out_z, <:Konf. koniske:>);
if region = 5 <*grønland*> then
begin
write(out_z, <:kegle_:>, (long reg_lab(4)) mod 10,
if long reg_lab(4) < 10 then <:_v:> else <:_ø:>);
end;
end case 7;
comment case 6, mercator;
_________________________
write(out_z, <:Mercator:>);
comment case 8, cartesian;
__________________________
write(out_z, abs long reg_lab(4),
<:-dim. cartesiske_:>,
if long reg_lab(4) > 0 then
<:højre:> else <:venstre:>, <:orienteret:>);
comment case 9, heights;
_________________________
write(out_z, <:Højder:>);
comment case 10, kbh. komm;
___________________________
write(out_z, <:Københavns kommune system:>);
comment case 11, ostenf. system;
________________________________
write(out_z, <:Ostenfeldt system (Sønderjylland):>);
comment case 12, sb;
____________________
write(out_z, <:Statsbroen storebælt:>);
end cstm cases;
\f
comment page_feed_tx * page 4 3 01 78, 15.35
0 1 2 3 4 5 6 7 8 9 ;
if cstm <> 9 <*heights*> then
begin
_
comment ellipsoid;
__________________
write(out_z, nl, 1, <:__Ellipsoide:__:>);
write(out_z, case ell of (
_ <:job-defineret:>,
_ <:Intern. 1924, Hayford:>,
_ <:Geod. ref. stm. 1967:>,
_ <:Bessel 1841:>,
_ <:GS:>,
_ <:Andræ:>,
_ <:Clarke 1866:>,
_ <:World geod. stm. 1972:>,
_ <:NWL9D = WGS66:>,
_ <:Fischer1960:>,
_ <:GRS80:>,
_ <:NAD83:>,
_ <:* unavngiven *:>));
write_geo_c(out_z, long reg_lab(6),
_ false add (8 shift 6 + (case ell of (
_ <* 1*> 6, 0, 0, 4,
_ <* 5*> 4, 4, 6, 0,
_ <* 9*> 0, 0, 0, 0, 6))));
write(out_z, <:_1/:>, <<ddd.ddd_dddd>, 1/reg_lab(7));
_
comment datum;
______________
write(out_z, nl, 1, <:__Datum:_______:>);
write(out_z, sp, 15
- write(out_z, case datum of (
_ <:job-defineret:>,
_ <:Dansk 1934:>,
_ <:Europ. 1950:>,
_ <:Færø 1954:>,
_ <:Qornoq 1927:>,
_ <:Scoresbysund 1952:>,
_ <:Angmagssalik 1957:>,
_ <:GS:>,
_ <:GS_Bornholm:>,
_ <:NAD 1927 = Meades Ranch:>,
_ <:NAD 1983 = Rev. NAD:>,
_ <:Nordtrig 1972:>,
_ <:WGS 72:>,
_ <:NWL9D:>,
_ <::>)));
end not heights;
end case 2, cstm info;
begin comment case 3, observations;
comment obs_kind cases;
_______________________
case cstm <* = obs_kind*> of
begin
comment case 1, jobdef obs;
___________________________
<*no action*> ;
\f
comment page_feed_tx * page 5 3 01 78, 15.35
0 1 2 3 4 5 6 7 8 9 ;
_
comment case 2, geometrical geodesy;
____________________________________
begin
write(out_z, nl, 1, <:Retninger og afstande:>,
_ nl, 1, <:Bånd nr :>, (long reg_lab(4))//100);
t := (long reg_lab(4)) mod 100;
if t <> 0 then
write(out_z, <:/:>, <<d>, t);
end case 2;
_
comment case 3, ellred geom. geod.;
___________________________________
begin
write(out_z, nl, 1, <:Ellipsoidered. retninger og afstande:>,
_ nl, 1, <:Bånd nr :>, (long reg_lab(4))//100);
t := (long reg_lab(4)) mod 100;
if t <> 0 then
write(out_z, <:/:>, <<d>, t);
end case 3;
_
comment case 4, zenith-distances and height diff;
___________________________________________________
begin
write(out_z, nl, 1, <:Zenitdistancer og højdedifferenser:>,
_ nl, 1, <:Bånd nr :>, (long reg_lab(4))//100);
t := (long reg_lab(4)) mod 100;
if t <> 0 then
write(out_z, <:/:>, <<d>, t);
end case 4;
_
comment case 5, pot diff;
_________________________
begin
write(out_z, nl, 1, <:Potentialdifferenser:>,
_ nl, 1, <:Bånd nr :>, (long reg_lab(4))//100);
t := (long reg_lab(4)) mod 100;
if t <> 0 then
write(out_z, <:/:>, <<d>, t);
end case 5;
_
comment case 6, anblock;
________________________
begin
write(out_z, nl, 1, <:Fotogr. an-block data:>,
_ nl, 1, <:Bånd nr :>, (long reg_lab(4))//100);
t := (long reg_lab(4)) mod 100;
if t <> 0 then
write(out_z, <:/:>, <<d>, t);
end case 6;
\f
comment page_feed_tx * page 6 3 01 78, 15.35
0 1 2 3 4 5 6 7 8 9 ;
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
write(out_z, nl, 1, <:kind =:>, cstm,
<:__selvbetjening - udvid case for denne kind:>);
end obs_kind cases;
end case 3;
begin comment case 4, ident;
write(out_z, nl, 1, <:identiteter:>);
end case 4;
end reg_type cases;
_
comment evaluation of expr;
___________________________
t := expr;
line_no := line_no + t;
write(out_z,false add 59 <*;*>,1);
end page_feed;
end
if warning.yes
(mode 0.yes
message page_feed not ok
lookup page_feed)
end
▶EOF◀