{                                                                       }
{ 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.                                                 }

Program banner(output);

{ Written by Jens "Himpel" Gelhar 21/10/89 }

{$path "ram:i/", "pascal:include/" }
{$incl "graphics/text.h", "graphics.lib", "libraries/diskfont.h" }

Label 99;

Const
  Trenn = '\';

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

Var
  fnt: p_TextFont;
  txat: TextAttr;
  YSize: integer;
  Fontname: string[50];
  i, j: integer;
  Punktbreite, Punkthoehe: integer;
  tx: string[300];
  err, VertFlag, HorizFlag, CenterFlag: Boolean;
  Ausgabe: strtype;
  Bits: Array[0..7] of Byte;
  HiChar, LoChar: char;
  CharData: Long;
  Offset, Width, Kern, Space: Array[Char] of integer;
  Modulo, Rand: integer;
  Zeilenlaeng: integer;
  buf: String[257];

Procedure InitVars;
 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;
  Bits[0] := 1;
  For i:=1 to 7 Do Bits[i]:=2*Bits[i-1];
  CharData := Long(fnt^.tf_CharData);
  clp := fnt^.tf_CharLoc;
  krp := fnt^.tf_CharKern;
  spp := fnt^.tf_CharSpace;
  For c:=LoChar to HiChar Do
    Begin
      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;
 Var
  Adr: ^Byte;
  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 := Ptr(CharData + y * Modulo + Off div 8);
          Dot := (Adr^ and Bits[7 - Off mod 8]) <> 0
        End;
    End
 End;

Procedure Aus(k: integer);
  Var i, j: integer;
  Begin
    If Rand<0 Then
      For i:=1 to StrLen(buf)+Rand+1 do buf[i]:=buf[i-Rand];
    i:=StrLen(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
          Begin
            writeln('^C');
            Goto 99
          End;
        If Rand>0 Then write('': Rand);
        writeln(buf)
      End
  End;

Procedure Horizontal(s: strtype);
  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
          Error('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;
  Begin
    If (ch >= '0') and (ch<='9') Then
      Digit := ord(ch)-ord('0')
    Else
      Digit := -1
  End;

Procedure Info;
  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';
  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
    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);

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

  If Punktbreite=0 Then
    If VertFlag Then Punktbreite := 3
                Else Punktbreite := 1;

  If Punkthoehe=0 Then Punkthoehe:= 1;

  txat := TextAttr(Fontname, YSize, 0, 0);
  fnt := OpenDiskFont(^txat);
  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.