PROGRAM LOCOSCRIPT_KONVERTIERUNG;
(* Aus dem Original von W.Otternberg habe ich lediglich den Teil verwendet, *)
(* der aus der LocoScript-Datei eine ASCII-Datei macht                      *)
(* Dies habe ich noch erweitert fuer optionale HTML-Ausgabe                 *)
(* Es wird immer die gesamte Datei gewandelt!                               *)

const
  PufferLen       = 2176;  {17 Bloecke mit je 128 byte}
  ff              = #$0C;  {Form Feed}
type
  FormString      = string[ 6];
  UmlString       = string[10];
  NameString      = string[15];
  HTMLstring      = string[50];
var
  KonvWahl        : char;
  LiRand,
  Kopfteil,
  i,n,m,
  BloeckeEin,
  StartBlock,
  ErsteSeite,
  LetzteSeite     : integer;
  Quelldatei      : file;
  Zieldatei       : text;
  Zieldateiname,
  Quelldateiname  : NameString;
  Puffer          : Array[0..PufferLen] of byte;
  LayoutTabelle   : Array[0..10,0..5]   of byte;

                                             (*            11111111112222222222333333333344444444445        *)
const                                        (*   12345678901234567890123456789012345678901234567890        *)
  HTMLTexte      : array[0..13] of string[40] = ('<b>',                                               (*  0 *)
                                                 '</b>',                                              (*  1 *)
                                                 '<span style="text-decoration:underline">',          (*  2 *)
                                                 '</span>',                                           (*  3 *)
                                                 '<i>',                                               (*  4 *)
                                                 '</i>',                                              (*  5 *)
                                                 '',                                                  (*  6 *)
                                                 '<font size="3">',                                   (*  7 *)
                                                 '<font size="2">',                                   (*  8 *)
                                                 '<font size="1">',                                   (*  9 *)
(* *)
                                                 '&quot;',                                            (* 10 *)
                                                 '&amp;',                                             (* 11 *)
                                                 '&lt;',                                              (* 12 *)
                                                 '&gt;'                                               (* 13 *)
);

procedure Fehler(n:integer);
Begin
  case n of
    1 : writeln('Ausgabe-Datei ',Zieldateiname,' kann nicht angelegt werden');
    2 : begin
          writeln('LocoScript nach HTML-Wandler');
          writeln;
          writeln('Aufruf mit:');
          writeln;
          writeln('   LOCOHTML LocoDatei [[HTMLDatei] [Modus]]');
          writeln;
          writeln('Modus ist H (HTML) oder A (ASCII)');
        end;
    3 : writeln('Fehler ! Datei:  ',Quelldateiname,' nicht gefunden');
    4 : writeln('Keine Locoscript-Datei !!!!'); 
    5 : writeln('Format der Locoscript-Datei ungeeignet!');
    6 : writeln('Locoscript-Datei ist zu lang !!');
   end;
  halt;
End;

procedure DateinamenHolen;
var
  Modus        : string[3];
  Ziel         : boolean;
  p            : integer;

  procedure CheckModus;
  begin
    KonvWahl:=Modus[2];
    if not ((Modus[1]='[') and (Modus[3]=']') and (KonvWahl in ['A','H'])) then
    begin
      writeln('Falscher Modus.');
      Fehler(2);
    end;
  end;

  procedure CheckZiel;
  begin
    p:=pos('.',Zieldateiname);
    if p=0 then
      if KonvWahl='H' then Zieldateiname:=Zieldateiname+'.HTM'
                      else Zieldateiname:=Zieldateiname+'.TXT';
  end;

Begin { DateinamenHolen }
  KonvWahl:='H';
  Ziel:=false;
  Modus:='';
  if Paramcount in [1..3] then Quelldateiname:=ParamStr(1);
  if Paramcount in [2..3] then Zieldateiname:= ParamStr(2);
  case Paramcount of
    1 : ;
    2 : if Zieldateiname[1]='[' then Modus:=Zieldateiname
                                else Ziel:=true;
    3 : begin
          Modus:=ParamStr(3);
          Ziel:=true;
        end;
    else Fehler(2);
  end;
  if not (Modus='') then CheckModus;
  if not Ziel then
  begin
    p:=pos('.',Quelldateiname);
    if p=0 then
    begin
      Zieldateiname:=Quelldateiname;
      CheckZiel;
    end else
    begin
      Zieldateiname:=copy(Quelldateiname,1,pred(p));
      CheckZiel;
    end;
  end else CheckZiel;
End;

procedure QuelldateiOeffnen;
Begin
  assign(Quelldatei,Quelldateiname);
  {$I-}reset(Quelldatei);{$I+}
  if IOresult<>0 then Fehler(3);
End;

function UmlautASC(var b:byte):FormString;
Begin
  case b of
    208: UmlautASC:='[';
    211: UmlautASC:='\';
    212: UmlautASC:=']';
    240: UmlautASC:='{';
    243: UmlautASC:='|';
    244: UmlautASC:='}';
    186: UmlautASC:='~';
    else UmlautASC:=chr(b);
  end;
End;

function HTMLUmlaut(var b:byte):UmlString;
Begin
  if KonvWahl='H' then
  begin
    case b of
       208: HTMLUmlaut:='&Auml;';
       211: HTMLUmlaut:='&Ouml;';
       212: HTMLUmlaut:='&Uuml;';
       240: HTMLUmlaut:='&auml;';
       243: HTMLUmlaut:='&ouml;';
       244: HTMLUmlaut:='&uuml;';
       186: HTMLUmlaut:='&szlig;';
       else HTMLUmlaut:=chr(b);
    end
  end else HTMLUmlaut:=UmlautASC(b);
End;

procedure LocoVorhanden;
Begin
  Blockread(Quelldatei,Puffer,3,BloeckeEin);
  if ((Puffer[0]=ord('J')) and
      (Puffer[1]=ord('O')) and
      (Puffer[2]=ord('Y'))) then
  begin
    writeln('Locoscriptdatei : << ',Quelldateiname,' >> gefunden.');
    StartBlock:=Puffer[$7E];
    if ((not(StartBlock in [1..15])) or (BloeckeEin<3)) then Fehler(4)
    else
    begin
      ErsteSeite:= Puffer[107];
      LetzteSeite:=Puffer[109];
      writeln('Von Seite   : ',ErsteSeite);
      writeln('   bis Seite: ',LetzteSeite);
      writeln('Dateigroesse: ',FileSize(Quelldatei) shl 7,' Bytes');
      write('Text-Info   : ');
      for i:= 5 to 34 do write(UmlautASC(Puffer[i]));
      writeln;
      for i:=35 to 64 do write(UmlautASC(Puffer[i]));
      writeln;
      for i:=65 to 94 do write(UmlautASC(Puffer[i]));
      writeln;
      for n:=0 to 10 do
        for m:=0 to 5 do                                         {10 Layouts   }
        LayoutTabelle[n,m]:=Puffer[$80+((10+Puffer[$60])*n)+m];  {Schrift-Rand}
      Kopfteil:=(Puffer[$70] shr 1)-6;
    end;
  end else Fehler(5);
End;

procedure LocoDateiBearbeiten;
var
  Seitenlaenge,
  LetzterTab,
  LiVersatz,
  n,p,SeitenNr   : integer;
  PufferChr,
  Schriftart,
  Hervorhebecode : byte;
  Textzeile      : string[128];
  Unterstreichen,
  StartFlag,
  EndFlag        : boolean;

  function HTMLcode(i:integer):HTMLstring;
  begin
    if KonvWahl='H' then HTMLcode:=HTMLTexte[i]
                    else HTMLcode:='';
  end;

  procedure HTMLout(i:integer);
  begin
    Textzeile:=Textzeile+HTMLcode(i);
  end;

  procedure ASCIIorHTML(i:integer);
  begin
    if KonvWahl='H' then HTMLout(i)
                    else Textzeile:=Textzeile+chr(PufferChr);
  end;

  procedure Out(Zeichen:FormString);
  begin
    case Zeichen[1] of
      #$86: begin                            {Zeilenanfang}
              p:=LiRand-LiVersatz;
              Textzeile:='';
              if Unterstreichen then HTMLout(3);
              for n:=1 to p do Textzeile:=Textzeile+' ';
              if Unterstreichen then HTMLout(2);
            end;
      #$88: begin                              {Zeilenende}
              if Textzeile[length(Textzeile)]=' '
                 then delete(Textzeile,length(Textzeile),1);
              for n:=1 to length(Textzeile) do write(Zieldatei,Textzeile[n]);
              writeln(Zieldatei);
              Textzeile:='';
            end;
      #$89: begin                                     {TAB}
              for n:=succ(p) to (LetzterTab-LiVersatz) do
              begin
                Textzeile:=Textzeile+' ';
                p:=succ(p);
              end;
            end;
       ff:  writeln(Zieldatei,ff);         {Seitenende}
       else begin
              Textzeile:=Textzeile+Zeichen;
              if length(Zeichen)<6 then p:=p+length(Zeichen); {keine Steuersequenz}
          end;
    end;
  end; {Out}

  procedure Schriftwahl(x:byte);
  begin
    case x of
      $00: HTMLout(6);
      $0E: HTMLout(9);
      $10: HTMLout(9);
      $14: HTMLout(8);
      $18: HTMLout(7);
    end;
  end;

  procedure Hervorheben(x:byte); {doppelt/kursiv/unterstr.}
  begin
    if (x and $11)>0 then HTMLout(0)
                     else HTMLout(1);
    if (x and $20)>0 then HTMLout(4)
                     else HTMLout(5);
    if (x and $06)>0 then begin
                            HTMLout(2);
                            Unterstreichen:=True;
                          end
                     else HTMLout(3);
  end;

  procedure LocoSonderzeichen;
  begin
    case Puffer[i] of
      $80: if EndFlag then Out(ff);            {Seitenende}
      $81: Out(' ');                          {Leerzeichen}
      $82: begin
             if Puffer[succ(i)]=1 then Out(#$88); {Seitenwech.}
             if Puffer[succ(i)]=2 then Out('-');  {Bindestrich}
             i:=succ(i);
           end;
      $86: begin                             {Zeilenanfang}
             Out(#$86);
             i:=i+2;
           end;
      $88: begin                               {Zeilenende}
             if Puffer[succ(i)]=8 then else Out(#$88);
             i:=succ(i);
           end;
      $89,                                            {Tab}
      $8B: begin                              {Buendig-Tab}
             if Puffer[succ(i)]=0 then LiRand:=Puffer[i+2]
               else begin
                      LetzterTab:=Puffer[i+2];
                      Out(#$89);
                    end;
             if Puffer[i]=$8B then i:=i+7 else i:=i+4;
           end;
      $8A: begin                                  {buendig}
             if Puffer[succ(i)]=8 then else Out(#$88);
             i:=i+5;
           end;
    end;
  end;  {LocoSonderzeichen}

  procedure Steuerzeichen;
  begin
    case Puffer[i] of
      $83 : begin                         {Hervorheben ein}
              case Puffer[succ(i)] of
                0,4: HTMLout(0);
                1,2: begin
                       HTMLout(2);
                       Unterstreichen:=True;
                     end;
                5  : HTMLout(4);
              end;
              i:=succ(i);
            end;
      $84 : begin                         {Hervorheben aus}
              case Puffer[succ(i)] of
                0,4: HTMLout(1);
                1,2: begin
                       HTMLout(3);
                       Unterstreichen:=False;
                     end;
                5  : HTMLout(5);
              end;
              i:=succ(i);
            end;
      $85 : begin                               {Einfuegen}
              case Puffer[succ(i)] of
                0: if Puffer[i+2]=1 then Out('-'); {Softtrenn}
                2: if Puffer[i+2]<11 then    {neues Layout}
                   begin
                     Unterstreichen:=False;
                     Hervorhebecode:=LayoutTabelle[Puffer[i+2],3];
                     Hervorheben(Hervorhebecode);
                     Schriftart:=LayoutTabelle[Puffer[i+2],0];
                     Schriftwahl(Schriftart);
                   end;
                5: begin                          {Schrift}
                     Schriftart:=Puffer[i+2];
                     Schriftwahl(Schriftart);
                    end;
              end;
              i:=i+2;
            end;
    end;
  End;  {Steuerzeichen}

  procedure Seitenanfang;
  Begin
    Schriftart:=(Puffer[9] and $7F);
    Hervorhebecode:=Puffer[12];
    LiRand:=Puffer[8];
    LiVersatz:=LayoutTabelle[0,4];
    if LiVersatz>LiRand then LiVersatz:=LiRand;
    Out(#$86);
    for n:=3 to Kopfteil do writeln(Zieldatei);
  end;

Begin {LocoDateiBearbeiten}
  writeln('*  B i t t e    e t w a s   G e d u l d   *');
  Unterstreichen:=False;
  SeitenNr:=ErsteSeite;
  Textzeile:='';
  p:=1;
  QuelldateiOeffnen;
  Blockread(Quelldatei,Puffer,StartBlock);  {Info-Bloecke blind einlesen}
  while not((eof(Quelldatei)) or (SeitenNr>LetzteSeite)) do
  begin
    repeat
      Blockread(Quelldatei,Puffer,1);     {1. Textblock }
      Seitenlaenge:=(Puffer[0] SHL 7)-2;
      StartFlag:=(Puffer[2] and $80)>0;
      EndFlag:=(Puffer[2] and $01)>0;
      Blockread(Quelldatei,Puffer[128],pred(Puffer[0]),BloeckeEin);
      if (BloeckeEin<(Puffer[0]-1)) then exit;
      if StartFlag then Seitenanfang;
      i:=13;                                 {Textanfang}
      repeat
        PufferChr:=Puffer[i];
        case PufferChr of
          $00..$1A: ;                        { ASCII Steuerzeichen }
            $22   : ASCIIorHTML(10);         { ASCII " }
            $26   : ASCIIorHTML(11);         { ASCII & }
            $3C   : ASCIIorHTML(12);         { ASCII < }
            $3E   : ASCIIorHTML(13);         { ASCII > }
          $20..$5A,
          $61..$7A: Out(chr(PufferChr));     { Druckbare ASCII Steuerzeichen }             (* PufferChr !!! *)
          $83..$85: Steuerzeichen;           { LOCO Steuerzeichen }
          $80..$82,
          $86..$9F: LocoSonderzeichen;       { LOCO Sonderzeichen }
          else Out(HTMLUmlaut(PufferChr));   { $1B..$1F, $5B..$60, $7B..$7F, $A0..$FF}     (* PufferChr !!! *)
        end;
        i:=succ(i);
      until i>Seitenlaenge;
    until EndFlag=True;
    SeitenNr:=succ(SeitenNr);
  end;
End;  {LocoDateiBearbeiten}

procedure Ausgabe;
Begin
  assign(Zieldatei,Zieldateiname);
  {$I-}rewrite(Zieldatei);{$I+}
  if IOresult<>0 then Fehler(1);
  if KonvWahl='H' then
  begin
    writeln(Zieldatei,'<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 //EN">');
    writeln(Zieldatei,'<html>');
    writeln(Zieldatei,'<head>');
    writeln(Zieldatei,'<title>',Quelldateiname,'</title>');
    writeln(Zieldatei,'<meta name="description" content="______________">');
    writeln(Zieldatei,'<meta name="keywords" content="______________">');
    writeln(Zieldatei,'<meta name="author" content="Werner Cirsovius">');
    writeln(Zieldatei,'</head>');
    writeln(Zieldatei,'<body>');
  end;
  LocoDateiBearbeiten;
  if KonvWahl='H' then
  begin
    writeln(Zieldatei,'</body>');
    writeln(Zieldatei,'</html>');
  end;
  close(Quelldatei);
  close(Zieldatei);
end;

BEGIN     {LOCOCON}
  DateinamenHolen;
  QuelldateiOeffnen;
  LocoVorhanden;
  close(Quelldatei);
  Ausgabe;
END.