|
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: 7680 (0x1e00)
Types: TextFile
Names: »let7txt«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »let7txt«
let7=set 1
scope day let7
let7=algol list.no
CD 82-09-16
fpparametre:
lw.60 (liniebredde)
min.1 (det minimale antal tegn før deletegnet <->)
begin
<*Program til skærmstyret tekstjustering af almindelig tekst
indeholdende orddelingstegnet <->. Justeringen foretages ved
linieombrydning inden for en paragraf, der er defineret som
tekst efterfulgt af <nl><nl>, <nl><sp> eller <nl><.>, hvor
sidste mulighed omtales senere.
Linieombrydningen styres af fpparametrene <lw> og <min>,
hvor <lw> angiver det maksimale antal tegn pr. linie, og
<min> angiver det minimale antal tegn foran orddelingstegnet
<->, hvis tekstjusteringen kræver orddelinger.
Det ord der skal deles udskrives på skærmen som f.eks:
konstant i o n p o l i t a nerinde
9 8 7 6 5 4 3 2 1 0
=
og der svares med et tal svarende til orddelingens
placering. Svares med et negativt tal f.eks.-2 deles ordet
ved 2 og værdien af <min> gøres stor, således at resten af
tekstjusteringen foretages uden orddelinger.
Paragrafafslutningen <nl><.> gør det muligt at ændre værdien
af <min> i teksten, hvis der f.eks. er indsat et stykke
tekst i en i forvejen indsat tekst. Værdien af <min> ændres
til x ved at skrive .min.x først på en linie.
Eksempel 1:
Området tekst1 indeholder en ujusteret tekst der skal
justeres og lægges i området tekst2:
tekst2=let7 tekst1
Da hverken <lw> eller <min> er angivet ved kaldet fås
standardværdierne 60 og 2.
Eksempel 2:
tekst2 indeholder følgende:
justeret tekst
.min.2
ujusteret tekst
.min.99
justeret tekst
Den ujusterede tekst justeret og hele den justerede tekst
lægges i tekst1:
tekst1=let7 tekst2 min.99 *>
integer i,j,linelength,lw,pointer,old,new,newsema,
oldsema,reduce,delpointer,wl,spl,mode,minchar;
boolean specchar, normchar;
real array field raf;
integer array I,J(1:255);
long array IFILE,OFILE(1:3);
zone zi,zo(128,1,stderror);
procedure error(num); value num; integer num;
begin
write(out,<:error :>,num);
goto FIN;
end;
procedure wordwindow;
begin
integer j,j1,k;
connectcuri(<:c:>);
k:=if I(1)=32 then 2 else 1;
for j:=k step 1 until i-1 do
begin
if j=k then write(out,"sp",1);
if j<=delpointer and j>k and delpointer-j<=9
then write(out,"sp",1);
write(out,false add I(j),1);
end;
write(out,"nl",1);
k:=delpointer-k;
for j:=k step -1 until 0 do
begin
if j<=9 then write(out,<<d>,j,"sp",1) else
write(out,"sp",1);
if j=10 then write(out,"sp",1);
end;
if k>9 then k:=9;
j1:=readil(<::>,-k,k);
if j1<0 then
begin
j1:=-j1; minchar:=99;
end;
delpointer:=delpointer-j1;
if delpointer>2 then J(delpointer):=1;
end;
integer procedure speclength;
begin
integer newsema,oldsema,reduce,j;
oldsema:=0; newsema:=0; reduce:=0;
for j:=1 step 1 until i-1 do
begin
if I(j)=35 or I(j)=36 then
begin
newsema:= if I(j)=35 then newsema-1 else newsema+1;
if abs(newsema) > abs(oldsema) then reduce:=reduce+1
else reduce:=reduce+2;
oldsema:=newsema;
end;
if j>1 then
begin
if I(j)<>35 and I(j)<>36 and I(j-1)<>35
and I(j-1)<>36 then
oldsema:=newsema:=0;
end;;
end;
speclength:=spl:=i-1-reduce;
end;
procedure move;
begin
integer j;
for j:=2 step 1 until i-1 do
begin
I(j-1):=I(j); J(j-1):=J(j);
end;
end;
procedure ww;
begin
integer j;
for j:=1 step 1 until i-1 do
begin
if J(j)>1 then
write(zo,<:-:>,"nl",1);
write(zo,false add I(j),1);
end;
end;
procedure clear;
begin
cleararray(I); cleararray(J);
normchar:=false; specchar:=false;
end;
procedure writeword;
begin
integer j;
if linelength>= lw then
begin
move; linelength:=0; i:=i-1; write(zo,"nl",1);
end;
linelength:=if specchar then linelength+speclength
else linelength+i-1;
if linelength<=lw then
begin
ww;
clear;
I(1):=32; i:=2;
end else
begin
if specchar then
begin
I(1):=10; ww;
clear; I(1):=32; i:=2; specchar:=false;
linelength:=spl-1;
end else
begin
j:=i-1-(linelength-lw);
if j=0 then j:=1 else
begin
delpointer:=j;
if j>minchar and J(j)=0 then wordwindow;
end;
for j:=j step -1 until 1 do
begin
if j>0 then
begin
if J(j)>0 or j=1 then
begin
if j=1 and I(1)<>32 then else
if J(j)>0 then J(j):=2 else I(1):=10;
ww;
linelength:=i-j;
if j=1 then linelength:=linelength-1;
clear;
I(1):=32; i:=2;
goto LBL2;
end;
end;
end;
if j=0 then error(3);
end;
LBL2:
end;
end;
raf:=0;
cleararray(IFILE); readinfp(IFILE.raf,1);
open(zi,4,IFILE,0);
cleararray(OFILE); readlsfp(OFILE.raf);
open(zo,4,OFILE,0);
clear;
i:= 1; linelength:= 0; old:= 0;
readifp(<:lw:>,lw,60);
readifp(<:min:>,minchar,2);
minchar:= if minchar<2 then 2 else minchar+1;
if lw<minchar+2 then lw:=minchar+2;
specchar:=normchar:=false;
for i:= i while old<>25 do
begin
readchar(zi,new);
if i>1 then
begin
if old=45 and new=10 and i>2 then
begin
if -,((i=3 and I(1)=32) or I(i-2)=45) then
begin
i:=i-1; J(i):=1; goto LBL;
end;
end;
if old=10 and (new=10 or new=32 or new=12 or new=46 or new=25) then
begin
if J(i)=1 then
begin
J(i):=0; I(i):=45; i:=i+1; writeword;
end;
linelength:=0; i:=1; write(zo,"nl",1);
goto LBL0;
end;
if new=10 or (new=32 and normchar) or (new=25 and i>1) then
begin
if J(i)=1 then
J(i):=0;
writeword; goto LBL;
end;
goto LBL1;
end;
LBL0:
if i=1 then
begin
if new=10 or new=12 then
begin
write(zo,false add new,1); goto LBL;
end;
if new=46 then
begin
old:=new; readchar(zi,new);
if new=77 or new=109 then
begin
for i:=i while new<>46 do readchar(zi,new);
read(zi,minchar);
minchar:=if minchar<2 then 2 else minchar+1;
end else
begin
write(zo,false add old,1); write(zo,false add new,1);
for i:=i while new<>10 do
begin
readchar(zi,new); write(zo,false add new,1);
end;
end;
goto LBL;
end;
end;
LBL1:
I(i):=new; i:=i+1;
if new=35 or new=36 then specchar:=true;
if new<>32 then normchar:=true;
LBL:
old:=new;
end;
FIN:write(zo,"em",1);
close(zi,true); close(zo,true);
end
▶EOF◀