Turbo Toolbox/Turbo_Toolbox.iso/1991/07_08/tricks/readme.pas

Pascal/Delphi Source File | 1990-08-07 | 9KB | 361 lines

{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
{$M 1024,0,655360}
PROGRAM Readme;

USES Crt, Dos;

CONST
  FileName = 'READ.ME';
  MaxLines = 2000;
  LOX = 3;
  LOY = 10;
  RUX = 78;
  RUY = 24;
  LinesOnScreen = RUY-LOY+1;
  MaxLaenge = RUX-LOX+8;
  MaxHotKeys = 50;

TYPE
  ZeilenString = STRING[MaxLaenge];
  StringZeiger = ^ZeilenString;
  FarbTyp = (Texte, HighLight,
             DiskLabel, Frame, Header, toolbox, Diskette, Invers);
  ScreenRecord = RECORD
                   Ch:  CHAR;
                   Att: BYTE;
                 END;
  ScreenArray = ARRAY [1..25, 1..80] OF ScreenRecord;
  HotKeyRecord = RECORD
                   ch: CHAR;
                   Line: WORD;
                 END;
VAR
  HotKey: ARRAY[1..MaxHotKeys] OF HotKeyRecord;
  ColorScreen: ScreenArray ABSOLUTE $B800:0000;
  MonoScreen:  ScreenArray ABSOLUTE $B000:0000;
  Inhalt: ARRAY[1..MaxLines] OF StringZeiger;
  Label1, Label2: STRING;
  Datei: TEXT;
  AnzLines: WORD;
  Color: BOOLEAN;

CONST
  Farben: ARRAY[FALSE..TRUE, Texte..Invers] OF BYTE =
{ Mono }  ((7,                           { Texte }
            15,                          { HighLight }
            112,                         { DiskLabel }
            7,                           { Frame }
            7,                           { Header }
            15,                          { toolbox }
            15,                          { Diskette }
            112),                        { Invers }
{ Color }  (LightGreen,                  { Texte }
            White,                       { HighLight }
            Magenta SHL 4 OR White,      { DiskLabel }
            Blue,                        { Frame }
            Blue,                        { Header }
            Yellow,                      { toolbox }
            White,                       { Diskette }
            Blue SHL 4));                { Invers }

PROCEDURE SchalteCursor(An: BOOLEAN);
VAR
  Reg: REGISTERS;
BEGIN
  WITH Reg DO
  BEGIN
    IF An THEN
      CX:=$A0B
    ELSE
      CX:=$FFFF;
    BX:=0;
    AX:=$0100
  END;
  Intr($10,Reg)
END;

PROCEDURE SetColor(Farbe: FarbTyp);
BEGIN
  TextAttr:=Farben[Color, Farbe];
END;

PROCEDURE StartUp;
VAR
  R: Registers;
BEGIN
  R.AH:=$0F;
  Intr($10, R);
  Color:=R.AL<>7;
  IF Color THEN
    TextMode(CO80)
  ELSE
    TextMode(BW80);
END;

PROCEDURE Effekt;
CONST
  Hoehe = 8;
  LabelX = 67;
  LabelY = 2;
  LabelLength = 9;
  Logo: ARRAY[1..Hoehe] OF STRING[80] =
    ('▓▓▓▓██▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓███▓▓▓███▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓┌───────────┐▓▓▓',
     '▓▓▓████▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓██░▓▓▓██░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓│           │░▓▓',
     '▓▓▓▓██░░▓▓▓█████▓▓▓▓█████▓▓▓▓██░▓▓▓██████▓▓▓▓█████▓▓▓██▓▓▓▓██▓▓▓│           │░▓▓',
     '▓▓▓▓██░▓▓▓██░░░██▓▓██░░░██▓▓▓██░▓▓▓██░░░██▓▓██░░░██▓▓▓██▓▓██░░▓▓│     O     │░▓▓',
     '▓▓▓▓██░▓▓▓██░▓▓██░▓██░▓▓██░▓▓██░▓▓▓██░▓▓██░▓██░▓▓██░▓▓▓▓██▓░░▓▓▓│     ║     │░▓▓',
     '▓▓▓▓██░▓▓▓██░▓▓██░▓██░▓▓██░▓▓██░▓▓▓██░▓▓██░▓██░▓▓██░▓▓██▓░██▓▓▓▓│     ║     │░▓▓',
     '▓▓▓▓████▓▓▓█████░░▓▓█████░▓▓████▓▓███████░░▓▓█████░▓▓██░░▓▓██▓▓▓└───────────┘░▓▓',
     '▓▓▓▓▓░░░░▓▓▓░░░░░▓▓▓▓░░░░░▓▓▓░░░░▓▓░░░░░░░▓▓▓▓░░░░░▓▓▓░░▓▓▓▓░░▓▓▓░░░░░░░░░░░░░▓▓');
  Del = 4;
VAR
  x, y, Att: BYTE;
  n, m, o: WORD;
  s: STRING[LabelLength];
  Zeichen: CHAR;
  Reihe: ARRAY[0..Hoehe*80-1] OF WORD;
BEGIN
  SetColor(Invers);
  FOR n:=0 TO Hoehe*80-1 DO
    Reihe[n]:=n;
  FOR n:=Hoehe*80-1 DOWNTO 1 DO
  BEGIN
    m:=Random(n)+1;
    o:=Reihe[n];
    Reihe[n]:=Reihe[m];
    Reihe[m]:=o;
  END;
  FOR n:=0 TO Hoehe*80-1 DO
  BEGIN
    x:=Reihe[n] MOD 80+1;
    y:=Reihe[n] DIV 80+1;
    GotoXY(x, y);
    Write(Logo[y][x]);
    Delay(Del);
  END;
  Delay(300);

  FOR x:=1 TO 80 DO
  BEGIN
    FOR Y:=1 TO Hoehe DO
    BEGIN
      IF Color THEN
        Zeichen:=ColorScreen[y, x].Ch
      ELSE
        Zeichen:=MonoScreen[y, x].Ch;
      CASE Zeichen OF
        '█': Att:=Farben[Color, toolbox];
        '┐'..'─', '│', '┘', '┌', '║', 'O':
             Att:=Farben[Color, Diskette];
      ELSE
        Att:=Farben[Color, Header];
      END;
      IF Color THEN
        ColorScreen[y, x].Att:=Att
      ELSE
        MonoScreen[y, x].Att:=Att;
    END;
    Delay(2*Del);
  END;

  SetColor(DiskLabel);
  FillChar(s, LabelLength+1, #32);
  s[0]:=Chr(LabelLength);
  GotoXY(LabelX, LabelY);
  Write(s);
  GotoXY(LabelX, LabelY);
  Write(Label1);
  GotoXY(LabelX, LabelY+1);
  Write(s);
  GotoXY(LabelX, LabelY+1);
  Write(Label2);

  Att:=Farben[Color, Frame];
  FOR n:=Hoehe+1 TO 25 DO
  BEGIN
    FOR x:=1 TO 80 DO
    BEGIN
      IF Odd(x) THEN
        y:=n
      ELSE
        y:=26-n+Hoehe;
      IF Color THEN
        ColorScreen[y, x].ch:=#178
      ELSE
        MonoScreen[y, x].ch:=#178;
      IF Color THEN
        ColorScreen[y, x].Att:=Att
      ELSE
        MonoScreen[y, x].Att:=Att;
    END;
    Delay(Del*8);
  END;
END;

PROCEDURE ReadFile;
VAR
  Hot, n: WORD;
  Zeile: STRING[MaxLaenge];
BEGIN
  FOR n:=1 TO MaxHotKeys DO
  BEGIN
    HotKey[n].ch:=#255;
    HotKey[n].Line:=1;
  END;
{$I-}
  Assign(Datei, FileName);
  Reset(Datei);
  IF IOResult<>0 THEN
  BEGIN
    Writeln(^G, 'Konnte die Datei ', FileName,
            ' nicht öffnen - Programmabbruch!');
    Halt;
  END;
  ReadLn(Datei, Label1);
  ReadLn(Datei, Label2);
  n:=1;
  Hot:=1;
  WHILE NOT EOF(Datei) AND (n<=MaxLines) DO
  BEGIN
    New(Inhalt[n]);
    ReadLn(Datei, Zeile);
    IF Copy(Zeile, 1, 2)<>',,' THEN
    BEGIN
      Inhalt[n]^:=Zeile;
      Inc(n);
    END
    ELSE
    BEGIN
      HotKey[Hot].ch:=UpCase(Zeile[3]);
      HotKey[Hot].Line:=n;
      Inc(Hot);
    END;
  END;
  AnzLines:=Pred(n);
  Close(Datei);
{$I+}
END;

PROCEDURE ShowText;
VAR
  Line: INTEGER;
  n, Hot: WORD;
  ch: CHAR;
CONST
  HighLightOn = '⌐';  { ALT 169 }
  HighLightOff = '¬'; { ALT 170 }

  PROCEDURE WriteLine(n: BYTE);
  VAR
    i: BYTE;
    Zeichen: CHAR;
  BEGIN
    TextAttr:=Farben[Color, Texte];
    GotoXY(2, n);
    FOR i:=1 TO Length(Inhalt[Line+n-1]^) DO
    BEGIN
      IF LOX>RUX THEN
        Exit;
      Zeichen:=Inhalt[Line+n-1]^[i];
      CASE Zeichen OF
        HighLightOn:  BEGIN
                        TextAttr:=Farben[Color, HighLight];
                      END;
        HighLightOff: BEGIN
                        TextAttr:=Farben[Color, Texte];
                      END;
      ELSE
        Write(Zeichen);
      END;
    END;
    ClrEol;
  END;

  PROCEDURE TextOnScreen;
  VAR
    n: BYTE;
  BEGIN
    FOR n:=1 TO LinesOnScreen DO
    BEGIN
      WriteLine(n);
    END;
  END;

BEGIN
  Line:=1;
  Window(LOX, LOY, RUX, RUY);
  SetColor(Texte);
  ClrScr;
  TextOnScreen;
  REPEAT
    ch:=ReadKey;
    CASE ch OF
      #0: CASE ReadKey OF
            #72: IF Line>1 THEN
                 BEGIN
                   GotoXY(1,1);
                   InsLine;
                   Dec(Line);
                   WriteLine(1);
                   ClrEol;
                 END;
            #80: IF Line<AnzLines-LinesOnScreen+1 THEN
                 BEGIN
                   GotoXY(1, 1);
                   DelLine;
                   GotoXY(1, LinesOnScreen);
                   Inc(Line);
                   WriteLine(LinesOnScreen);
                   ClrEol;
                 END;
            #73: BEGIN
                   Dec(Line, LinesOnScreen);
                   IF Line<1 THEN
                     Line:=1;
                   TextOnScreen;
                 END;
            #81: BEGIN
                   Inc(Line, LinesOnScreen);
                   IF Line>AnzLines-LinesOnScreen+1 THEN
                     Line:=AnzLines-LinesOnScreen+1;
                   TextOnScreen;
                 END;
            #71: BEGIN
                   Line:=1;
                   TextOnScreen;
                 END;
            #79: BEGIN
                   Line:=AnzLines-LinesOnScreen+1;
                   TextOnScreen;
                 END;
          END;
      #27:BEGIN
            Window(1, 1, 80, 25);
            ClrScr;
            SchalteCursor(TRUE);
            Halt;
          END;
    ELSE             { Hotkey gedrückt ? }
      Hot:=0;
      REPEAT
        Inc(Hot);
      UNTIL (HotKey[Hot].ch=#255) OR
        (Hot>MaxHotKeys) OR (UpCase(ch)=Hotkey[Hot].ch);
      IF ch=HotKey[Hot].ch THEN
      BEGIN
        Line:=HotKey[Hot].Line;
        TextOnScreen;
      END;
    END;
  UNTIL FALSE;
END;

BEGIN
  ClrScr;
  StartUp;
  SchalteCursor(FALSE);
  ReadFile;
  Effekt;
  ShowText;
END.