{                                                                       }
{ BANNER                                                                }
{ ------                                                                }
{                                                                       }
{ Ein Programm zur Papier- und Farbbandverschwendung.                   }
{                                                                       }
{ Mit diesem Programm kann man meterlange Spruchbänder drucken.         }
{ Die Parameter werden vom CLI übergeben. Syntax:                       }
{                                                                       }
{  Banner { -v|-h|-cN|-xN|-yN|-rZ|+FONTNAME } TEXT                      }
{                                                                       }
{ Die verschiedenen Parameter haben dabei folgende Bedeutung:           }
{                                                                       }
{ -v  : vertikale Ausgabe (die Schrift läuft von oben nach unten        }
{ -h  : horizontale Ausgabe (zeilenweise)                               }
{       Standardeinstellung ist "h" bei Zeichensätzen bis 15 Punkten    }
{       Höhe und "v" ab 16 Punkten Schrifthöhe.                         }
{ -cN : (Center) Der Text ist horizontal und auf "N" Spalten zentriert  }
{       auszugeben.                                                     }
{ -xN : Jeder Punkt des Zeichensatzes soll bei der Ausgabe "N" Sternchen}
{       breit ausgedruckt werden.                                       }
{ -yN : Jeder Punkt des Zeichensatzes soll "N" Sterne hoch ausgegeben   }
{       werden.                                                         }
{       Standardeinstellung:    -x1 -y1  bei horizontaler Shcrift       }
{                               -x3 -y1  bei vertokaler Ausgabe         }
{ -rZ : links ist ein "Z" Spalten breiter Rand zu lassen. Der Rand kann }
{       auch negativ sein: dann werden die ersten "-Z" Zeichen jeder    }
{       Zeile weggelassen.                                              }
{ +FONTNAME : Der enstprechende Amiga-Systemzeichensatz wird verwendet. }
{       Beispiel: +Ruby15  benutzt den "Ruby.font" mit 15 Punkten Höhe. }
{       Standardeinstellung ist "+topaz9".                              }
{ TEXT: Der Text, der auszugeben ist. Bei horizontaler Ausgabe können   }
{       dabei mehrere Zeilen durch "\" getrennt werden.                 }
{                                                                       }
{ Beispiele:                                                            }
{                                                                       }
{ Banner Hallo                                                          }
{  Ergebnis:                                                            }
{  **   **              ***       ***                                   }
{  **   **               **        **                                   }
{  **   **   *****       **        **       *****                       }
{  *******       **      **        **      **   **                      }
{  **   **    *****      **        **      **   **                      }
{  **   **  **   **      **        **      **   **                      }
{  **   **   **** **    ****      ****      *****                       }
{                                                                       }
{ Banner -v -x8 -y5 Hallo                                               }
{  Der normale Topaz9-Font wird so vergrößert, daß er bei senkrechter   }
{  Textausgabe den ganzen Bildschirm ausfüllt.                          }
{                                                                       }
{ Banner +ruby15 -c77 Du\mich\auch!                                     }
{  In drei zentrierten Zeilen wird der Text "Du mich auch!" mit dem     }
{  Ruby15-Zeichensatz ausgegeben.                                       }
{                                                                       }
{ Banner +emerald20 -r-5 Horrido!                                       }
{  Es wird der Emerald20-Font benutzt. Durch die Höhe 20 wird           }
{  automatisch senkrecht geschrieben. Dabei werden ("negativer Rand")   }
{  die ersten 5 Spalten weggelassen, da sie eh' nur Spaces enthalten.   }
{                                                                       }
{ Übrigens erfolgt die Ausgabe normalerweise auf dem Bildschirm. Wenn   }
{ Sie das Banner drucken wollen, müssen Sie es mit "Banner >prt: ..."   }
{ zum Printer schicken.                                                 }

{ Written by Jens "Himpel" Gelhar Oct/Nov. 89 }

{ MaxonPascal3-Anpassung: Falk Zühlsdorff (PackMAN) 1994 }


Program banner;
USES Graphics;
{$incl 'diskfont.lib'}

Label 99;             { Anmerkung: in MP3/KP ist die Goto-Anweisung zu
                                   vermeiden, will nur Programm nicht
                                   total umschreiben, PackMAN          }
Const
  Trenn = '\';

Type
  CLocType = Array [0..255] of Record offset, breite:Word End;
  SpaceType = Array[0..255] of integer;
  strtype = String[200];

Var
  fnt: p_TextFont;      { Zeiger auf Font-Struktur }
  txat: TextAttr;       { Text-Attribut-Struktur für "OpenDiskFont" }
  YSize: integer;       { Zeichensatzhöhe }
  Fontname: string[50]; { Zeichensatzname }
  i, j: integer;
  Punktbreite, Punkthoehe: integer;   { "Vergrößerung" }
  tx: string[300];                    { Puffer für ParameterString }
  err, VertFlag, HorizFlag, CenterFlag: Boolean;
  Ausgabe: strtype;
  HiChar, LoChar: char;
  CharData: Long;       { Bitplane-Adresse }
  Offset, Width, Kern, Space: Array[Char] of integer;
  Modulo, Rand: integer;
  Zeilenlaeng: integer;
  buf: String[257];     { Puffer für Ausgabe }


Procedure InitVars;
 { Nach "OpenDiskFont" diverse Variablen aufgrund von Feldern }
 { der Font-Struktur initialisieren                           }
 Var
  clp: ^CLocType;
  krp,spp: ^SpaceType;
  i: integer;
  c: Char;
 Begin
  LoChar := chr(fnt^.tf_LoChar);
  HiChar := chr(fnt^.tf_HiChar);
  Modulo := fnt^.tf_Modulo;
  CharData := Long(fnt^.tf_CharData);
  clp := fnt^.tf_CharLoc;
  krp := fnt^.tf_CharKern;
  spp := fnt^.tf_CharSpace;
  For c:=chr(0) to chr(MaxByte) do   { Defaultwerte für Bereich }
    Begin                            { außerhalb LoChar..HiChar }
      Offset[c]:= 0;
      Width[c] := 0;
      Space[c] := fnt^.tf_xsize;
      Kern[c]  := 0
    End;
  For c:=LoChar to HiChar Do { wegen schnelleren Zugriffs Daten }
    Begin                    { aus der Font-Struktur in Arrays kopieren }
      Offset[c] := clp^[ord(c)-ord(LoChar)].offset;
      Width [c] := clp^[ord(c)-ord(LoChar)].breite;
      If krp=Nil Then
        Kern[c] := 0
      Else
        Kern[c] := krp^[ord(c)-ord(LoChar)];
      If spp=Nil Then
        Space[c] := fnt^.tf_XSize
      Else
        Space[c] := spp^[ord(c)-ord(LoChar)];
    End;
  YSize := fnt^.tf_YSize
 End;


Function Dot(ch: char; x,y: integer): Boolean;
  { prüft, ob Punkt (x,y) im Zeichen "ch" des aktuellen Fonts }
  { gesetzt ist.                                              }
  Var
    Adr: Long;
    Schleif, Off: integer;
  Begin
    If x < kern[ch] Then
      Dot:=false
    Else
      Begin
        If x >= Width[ch]+kern[ch] Then
          Dot:=false
        Else
          Begin
            Off := offset[ch] - kern[ch] + x;
            Adr := CharData + y * Modulo + Off div 8;
            Dot := (Mem[Adr] and ($80 shr (Off mod 8))) <> 0
          End;
      End
  End;


Procedure Aus(k: integer);
  { String "buf" mit Rand und ohne überflüssige }
  { Leerzeichen am Ende "k"-mal ausgeben        }
  Var i, j: integer;
  Begin
    If Rand<0 Then
      For i:=1 to StrLen(buf)+Rand+1 do buf[i]:=buf[i-Rand];
    i:=Length(buf);
    While (i>1) and (buf[i]=' ') Do i:=pred(i);
    If buf[i]=' ' Then buf[i]  :=chr(0)
                  Else buf[i+1]:=chr(0);
    For j:=1 to k Do
      Begin
        If break(1) Then      { Ctrl-C? Dann geordneter Ausstieg. }
          Begin
            writeln('^C');
            Goto 99
          End;
        If Rand>0 Then write('': Rand);
        writeln(buf)
      End
  End;

Procedure Horizontal(s: strtype);
  { waagerechte Ausgabe }
  Var x, y, i, j, i0, x1, y1: integer;
      breite, Pos0, t: integer;
      c: char;
  Begin
    i0 := 1;
    While s[i0] >= ' ' Do
     Begin
      breite:=0;
      i:=i0;
      While (s[i]>=' ') and (s[i]<>Trenn) Do
        Begin
          breite := breite + Punktbreite*space[s[i]];
          i := i+1
        End;

      If breite > 256 Then
        Begin
          writeln('Maximum lenght of line is 256');
          goto 99
        End;

      If Centerflag Then Pos0 := (Zeilenlaeng-breite) div 2
                    Else Pos0 := 0;
      For y:=0 To YSize-1 Do
        Begin
          i:=i0;
          t:=1;
          For j:=1 To Pos0 Do
            Begin
              buf[t] := ' ';
              t := t+1
            End;
          While (s[i] >= ' ') and (s[i] <> Trenn) Do
            Begin
              c := s[i];
              If (c < LoChar) or (c > HiChar) Then c:=' ';
              For x:=0 To space[c]-1 Do
                If Dot(c,x,y) Then
                  For x1:=1 To Punktbreite Do
                    Begin
                      buf[t]:='*';
                      t:=succ(t)
                    End
                 Else
                  For x1:=1 To Punktbreite Do
                    Begin
                      buf[t]:=' ';
                      t:=succ(t)
                    End;
              i:=i+1
            End;
          buf[t]:=chr(0);
          Aus(PunktHoehe)
        End;
      i0 := i;
      If s[i] = Trenn Then i0 := i0+1
     End;
  End;


Procedure Vertikal(s: strtype);
  Var x, y, i, t, x1, y1: integer;
      c: char;
  Begin
    i:=1;
    While s[i] >= ' ' Do
      Begin
        c := s[i];
        If (c < LoChar) or (c > HiChar) Then c:=' ';
        For x:=0 to Space[c]-1 Do
          Begin
            t:=1;
            For y:=YSize-1 Downto 0 Do
              If Dot(c,x,y) Then
                For y1:=1 To Punktbreite Do
                  Begin buf[t]:='*'; t:=succ(t) End
               Else
                For y1:=1 To Punktbreite Do
                  Begin buf[t]:=' '; t:=succ(t) End;
             buf[t]:=chr(0);
             Aus(PunktHoehe)
          End
        i:=i+1
      End;
  End;


Function Digit(ch: Char): integer;
  { testen, ob Zeichen "ch" Ziffer ist, und Wert zurückgeben }
  Begin
    If ch in ['0'..'9'] Then
      Digit := ord(ch)-ord('0')
    Else
      Digit := -1
  End;


Procedure Info;
  { Info-Text ausbannern }
  Begin
    txat := TextAttr('topaz.font', 9, 0, 0);
    fnt := OpenDiskFont(^txat);
    If fnt=Nil Then
      error('Font nicht gefunden!');
    InitVars;
    Punktbreite:=1;
    Punkthoehe:=1;
    Centerflag := true;
    Zeilenlaeng:=77;
    write(''\n\e'33m');
    Horizontal('Banner');
    write(''\e'31m'\n);
    Horizontal('Written\by:\Jens\Gelhar\1989')
  End;


Begin
  OpenLib(DiskFontBase, 'diskfont.library', 0);
  OpenLib(GfxBase, 'graphics.library', 0);

  YSize := 9;
  Fontname := 'topaz.font';     { Defaultfont und -höhe }
  Punktbreite := 0;
  Punkthoehe := 0;
  Rand := 0;
  tx := parameterstr;
  tx[parameterlen+1] := chr(0);
  i := 1;
  VertFlag := false;
  Horizflag := false;
  Centerflag := false;
  While tx[i]=' ' Do i:=succ(i);
  err:= tx[i]<' ';
  While ((tx[i]=' ') or (tx[i]='-') or (tx[i]='+')) and not err Do
    { Optionen auswerten }
    Begin
      If tx[i]='+' Then
        Begin
          j:=1; i:=i+1;
          While tx [i] >= 'A' Do
            Begin
              Fontname[j] := tx[i];
              i := i+1;
              j := j+1
             End;
           fontname[j] := chr(0);
           If fontname='' Then err:=true;
           fontname:=fontname + '.font';
           YSize:=Digit(tx[i]);
           If YSize<0 Then err:=true
           Else
             If Digit(tx[i+1]) >= 0 Then
               Begin
                 i := i+1;
                 YSize := 10*YSize + digit(tx[i])
               End;
          If not(Vertflag or Horizflag) Then
            Begin
              Vertflag:= YSize>16;
              Horizflag := not Vertflag
            End;
        End;
      If tx[i]='-' Then
        Begin
          i:=i+1;
          Case tx[i] Of
          'v': VertFlag:=true;
          'h': VertFlag:=false;
          'x': Begin i:=i+1; PunktBreite:=Digit(tx[i]);
                     err := Punktbreite<0
               End;
          'y': Begin i:=i+1; PunktHoehe:=Digit(tx[i]);
                     err := Punkthoehe<0
               End;
          'r': Begin i := i+1;
                     If tx[i]='-' Then
                       Begin
                         i:=i+1; j:=-1
                       End
                     Else j:=1;
                     Rand:=Digit(tx[i]);
                     If Rand<=0 Then err:=true
                     Else
                       While Digit(tx[i+1])>=0 Do
                         Begin
                           i:=i+1; Rand:=10*Rand+Digit(tx[i])
                         End;
                     Rand := j*Rand; { Vorzeichen }
               End;
          'c': Begin
                 i := i+1;
                 Zeilenlaeng := Digit(tx[i]);
                 If Zeilenlaeng <= 0 Then err:=true
                 Else
                 While Digit(tx[i+1]) >= 0 Do
                   Begin
                     i:=i+1; Zeilenlaeng := 10*Zeilenlaeng + Digit(tx[i])
                   End;
                 Centerflag := true;
                 Horizflag := true;
                 Vertflag := false;
                 If Zeilenlaeng > 256 Then
                   Error('Maximum lenght of line is 256')
               End;
          '?': Info;
          Otherwise
            err:=true
          End
        End;
      i := i+1
    End;

  Ausgabe:=Copy(tx,i,Length(tx)-i+1);  { Rest ist auszugeben }

  If err Then
    Error('Usage: Banner { -v|-h|-cN|-xN|-yN|-rZ|+FONTNAME } TEXT'\n' Info: Banner -?');

  If Punktbreite=0 Then             { Defaultwerte: }
    If VertFlag Then Punktbreite := 3
                Else Punktbreite := 1;

  If Punkthoehe=0 Then Punkthoehe:= 1;

  txat := TextAttr(Fontname, YSize, 0, 0);
  fnt := OpenDiskFont(^txat);       { Zeichensatz laden }
  If fnt=Nil Then
    error('Font nicht gefunden!');
  InitVars;

  If Vertflag and (YSize*Punktbreite>256) Then
    Begin
      CloseFont(fnt);
      Error('Maximum lenght of line is 256')
    End;

  If VertFlag Then
    Vertikal(Ausgabe)
  Else
    Horizontal(Ausgabe)

99:
  CloseFont(fnt);
  CloseLib(GfxBase);
  CloseLib(DiskFontBase)
End.