|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 4096 (0x1000)
Types: TextFile
Names: »ARK«
└─⟦2a24d2e1b⟧ Bits:30003042 Programmer fra Aarhus kursus
└─⟦this⟧ »ARK«
type streng = string(.80.);
var
zliste: array (.1..100.) of streng;
zantal,zl,zp: integer;
procedure fyldop;
var
s: streng;
begin
writeln('Skriv højst 100 ord (max. 80 tegn) adskilt af linieskift');
writeln('Afslut med tom linie:');
zantal:=0; readln(s);
while (zantal<100) and (len(s)>0) do
begin
zantal:=zantal+1;
zliste(.zantal.):=s;
readln(s);
end;
zl:=1; zp:=1;
end;
function tom: boolean;
begin
if zl>zantal then
tom:=true
else
tom:=false;
end;
function linieskift: boolean;
begin
if (zp=1) and (zl<>1) then
linieskift:=true
else
linieskift:=false;
end;
procedure naeste(var blok: streng);
var
stop,alfanum: boolean;
s: streng; ch: char;
begin
blok:='';
if zl>zantal then
writeln('Naeste kaldt på tom side')
else
begin
s:=zliste(.zl.);
stop:=false; alfanum:=s(.zp.) in (.'0'..'9','A'..'Å','a'..'å'.);
while (zp<=len(s)) and not stop do
begin
ch:=s(.zp.);
if alfanum then
begin
if ch in (.'0'..'9','A'..'Å','a'..'å'.) then
blok:=blok+s(.zp.)
else
stop:=true;
end
else
begin
if not (ch in (.'0'..'9','A'..'Å','a'..'å'.)) then
blok:=blok+s(.zp.)
else
stop:=true;
end;
if not stop then
zp:=zp+1;
end;
if zp>len(s) then
begin
zl:=zl+1; zp:=1;
end;
end;
end; (* naeste *)
procedure stav(tal: streng; var tekst: streng);
var
ciffer1: char;
lille,mellem,stor : array (.'0'..'9'.) of string(.10.);
hundreder: streng;
procedure stav2(tal2: streng; var tekst: streng);
var
ciffer1,ciffer2: char;
begin
if len(tal2) = 1 then
tal2 := '0'+tal2;
ciffer1:=tal2(.1.); (* første ciffer *)
ciffer2:=tal2(.2.); (* andet ciffer *)
if ciffer1='0' then
tekst:=lille(.ciffer2.) else
if ciffer1='1' then
tekst:=mellem(.ciffer2.) else
if ciffer2='0' then
tekst:=stor(.ciffer1.)
else
tekst:=lille(.ciffer2.) + 'og' + stor(.ciffer1.);
end; (* stav2 *)
begin (* stav *)
lille (.'0'.) := 'nul';
lille (.'1'.) := 'en';
lille (.'2'.) := 'to';
lille (.'3'.) := 'tre';
lille (.'4'.) := 'fire';
lille (.'5'.) := 'fem';
lille (.'6'.) := 'seks';
lille (.'7'.) := 'syv';
lille (.'8'.) := 'otte';
lille (.'9'.) := 'ni';
mellem(.'0'.) := 'ti';
mellem(.'1'.) := 'elleve';
mellem(.'2'.) := 'tolv';
mellem(.'3'.) := 'tretten';
mellem(.'4'.) := 'fjorten';
mellem(.'5'.) := 'femten';
mellem(.'6'.) := 'seksten';
mellem(.'7'.) := 'sytten';
mellem(.'8'.) := 'atten';
mellem(.'9'.) := 'nitten';
stor (.'2'.) := 'tyve';
stor (.'3'.) := 'tredive';
stor (.'4'.) := 'fyrre';
stor (.'5'.) := 'halvtreds';
stor (.'6'.) := 'tres';
stor (.'7'.) := 'halvfjerds';
stor (.'8'.) := 'firs';
stor (.'9'.) := 'halvfems';
if len(tal) < 3 then
stav2(tal,tekst)
else
begin
ciffer1:=tal(.1.);
delete(tal,1,1);
(* tal indeholder nu de sidste to cifre *)
stav2(tal,tekst);
(* tekst indeholder stavningen af de to sidste cifre *)
if ciffer1<>'0' then
begin
if ciffer1='1' then
hundreder:='ethundrede'
else
hundreder:=lille(.ciffer1.)+'hundrede';
if tekst='nul' then
tekst:=hundreder
else
tekst:=hundreder+'og'+tekst;
end;
end;
end; (* stav *)
function allecifre(s: streng): boolean;
var i: integer; ok: boolean;
begin
ok:=true;
i:=1;
while i<=len(s) do
begin
if not ( ('0'<=s(.i.)) and (s(.i.)<='9') ) then
ok:=false;
i:=i+1;
end;
allecifre:=ok;
end;
«eof»