DataMuseum.dk

top - download

    Length: 4096 (0x1000)
    Types: TextFile
    Names: »ARK«

└─⟦2a24d2e1b⟧ Bits:30003042 Programmer fra Aarhus kursus
    └─ ⟦this⟧ »ARK« 

TextFile

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»