Turbo Toolbox/Turbo_Toolbox.iso/1991/05/trickbox/trickbox.pas

Pascal/Delphi Source File | 1991-04-03 | 16.7 KB | 509 lines

PROGRAM TrickBox;
(* (c) 1991 Ralf Hensmann & toolbox *)

(************************************************************************)
(*                                                                      *)
(*                             Import                                   *)
(*                                                                      *)
(* ScreenLow:   SaveGroundLine         - speichert die unterste Zeile   *)
(*              RestoreGroundLine      - restort die unterste Zeile     *)
(*                                                                      *)
(* Interpreter: PStatus                - Z. auf Bildschirminh. & Status *)
(*              InitScreen             - Initialisiert Schirm           *)
(*              SaveState(b) : PStatus - speichert Status in Zeiger     *)
(*              RestoreState(PStatus,b)- baut Schirm nach Zeiger auf    *)
(*              PrintCode(CHAR,BOOLEAN)- schreibt Code auf Schirm       *)
(*                                       wenn die Boolean-Variable TRUE *)
(*                                       ist, wird die Zeitverzögerung  *)
(*                                       verwendet.                     *)
(*              PrintChar(CHAR,BOOLEAN)- schreibt Zeichen auf Schirm    *)
(*                                       BOOLEAN wie bei Printchar      *)
(*              PrintState             - BOOLEAN-Variable, die angibt,  *)
(*                                       ob die Operation erfolgreich   *)
(*                                       war (TRUE) oder nicht.         *)
(*              WriteStatusLine(i)     - Gibt die Statuszeile aus       *)
(*                                                                      *)
(************************************************************************)
USES  Dos, Interpreter, ScreenLow, Crt;


CONST CMax      = 15000;
      CtrlChar  = #254;

VAR   CharBuf     : ARRAY [0..CMax] OF CHAR;
      CharLast    : WORD;
      CtrlMode    : BOOLEAN;
      LastX,LastY : BYTE;
      ProgPath    : STRING;

(************************************************************************)
(*                                                                      *)
(*                         Stackoperationen                             *)
(*                                                                      *)
(* Push, Pop, Top und Clear sind Stackoperationen für den Screen-Stack, *)
(* der für die Undo-Funktion zum schnelleren Bildaufbau verwendet wird. *)
(*                                                                      *)
(************************************************************************)
CONST MaxStack   = 9;
VAR   Stack      : ARRAY [0..MaxStack] OF PStatus;
      StackPtr   : WORD;

PROCEDURE InitStack;
BEGIN
  FOR StackPtr := MaxStack DOWNTO 0 DO
    Stack[StackPtr] := NIL;
END;

FUNCTION Pop : PStatus;
BEGIN
  IF StackPtr = 0 THEN
    Pop := NIL
  ELSE BEGIN
    Dec(StackPtr);
    Pop := Stack[StackPtr];
  END;
END;

PROCEDURE Push(P : PStatus);
BEGIN
  IF StackPtr = MaxStack+1 THEN BEGIN
    Dispose(Stack[0]);
    Move(Stack[1],Stack[0],MaxStack*SizeOf(PStatus));
    Stack[MaxStack] := P;
  END ELSE BEGIN
    Stack[StackPtr] := P;
    Inc(StackPtr);
  END;
END;

FUNCTION Top : PStatus;
BEGIN
  IF StackPtr = 0 THEN Top := NIL
                  ELSE Top := Stack[StackPtr-1];
END;

PROCEDURE Clear;
BEGIN
  WHILE StackPtr > 0 DO BEGIN
    Dec(StackPtr);
    Dispose(Stack[StackPtr]);
  END;
END;
(************************************************************************)
(*                    Ende der Stackoperationen                         *)
(************************************************************************)

(************************************************************************)
(*                                                                      *)
(*                           Hilfsroutinen                              *)
(*                                                                      *)
(************************************************************************)

(************************************************************************)
(* GetKey liest von der Tastatur eine erweiterte Taste ein. Speziellen  *)
(* Tasten wird 1000 zum Wert dazuaddiert.                               *)
FUNCTION GetKey : INTEGER;
VAR CH : CHAR;
BEGIN
  CH:= ReadKey;
  IF CH = #0 THEN GetKey := 1000+Ord(ReadKey)
             ELSE GetKey := Ord(CH);
END;

(************************************************************************)
(* Wait wartet auf einen Tastendruck. Vorher getippte Tasten werden     *)
(* überlesen.                                                           *)
PROCEDURE Wait;
VAR Dummy : INTEGER;
BEGIN
  WHILE KeyPressed DO Dummy := GetKey;
  Dummy := GetKey;
END;

(************************************************************************)
(* ClearSession löscht die gesamte bisherige Aktion                     *)
PROCEDURE ClearSession;
BEGIN
  CharLast := 0;
  CtrlMode := FALSE;
  Clear;
  InitScreen;
END;

(************************************************************************)
(* LowPlaySession spielt eine Sequenz von einer Position im Buffer bis  *)
(* zu einer neuen Position im Puffer ab. Die Variable CtrlMode gibt an, *)
(* ob sich die Wiedergabe gerade im Kontrollmodus aufhält.              *)
PROCEDURE LowPlaySession( FromP,Top : WORD);
VAR i : WORD;
BEGIN
  i := FromP;
  WHILE i < Top DO BEGIN
    IF CharBuf[i] = CtrlChar THEN
      CtrlMode := NOT CtrlMode
    ELSE
      IF CtrlMode THEN PrintCode(CharBuf[i],FALSE)
                  ELSE PrintChar(CharBuf[i],FALSE);
    (* Screens abspeichern *)
    IF i MOD 5 = 4 THEN
      Push(SaveState(CtrlMode));
    Inc(i);
  END;
END;

(************************************************************************)
(* PlaySession spielt die Session ab, wie dies auch normal geschehen    *)
(* würde. Zeitverzögerungen werden hier berücksichtigt. Jeder Tasten-   *)
(* druck hält die Session an, ESCAPE bricht die Session ab und löscht   *)
(* den Rest der Session.                                                *)
PROCEDURE PlaySession;
VAR i        : WORD;
    Key      : INTEGER;
BEGIN
  i := 0;
  CtrlMode := FALSE;
  InitScreen;
  WHILE i < CharLast DO BEGIN
    IF CharBuf[i] = CtrlChar THEN
      CtrlMode := NOT CtrlMode
    ELSE
      IF CtrlMode THEN PrintCode(CharBuf[i],TRUE)
                  ELSE PrintChar(CharBuf[i],TRUE);
    (* Screens abspeichern *)
    IF i MOD 5 = 4 THEN
      Push(SaveState(CtrlMode));
    IF KeyPressed THEN BEGIN
      Key := GetKey;
      IF Key = 27 THEN BEGIN
        CharLast := i+1; Exit;
      END;
      Exit;
    END;
    Inc(i);
  END;
END;

(************************************************************************)
(* Undo-Session nimmt einen Zug zurück. Undo-Session verwendet den      *)
(* letzten, auf dem Stack gespeicherten Zug.                            *)
PROCEDURE UndoSession;
VAR LastScreen : PStatus;
    i,Back     : WORD;
BEGIN
  REPEAT
    IF CharLast = 0 THEN Exit;
    LastScreen := Top;
    IF LastScreen = NIL THEN BEGIN
      CtrlMode := FALSE;
      InitScreen;
      LowPlaySession(0,CharLast-1);
    END ELSE BEGIN
      i := 5*(CharLast DIV 5);
      IF i = CharLast THEN BEGIN
        LastScreen := Pop; Dispose(LastScreen);
        LastScreen := Top;
        Dec(i,5);
      END;
      IF LastScreen <> NIL THEN BEGIN
        RestoreState(LastScreen,CtrlMode);
        LowPlaySession(i,CharLast-1);
      END ELSE BEGIN
        CtrlMode := FALSE;
        InitScreen;
        LowPlaySession(0,CharLast-1);
      END;
    END;
    Dec(CharLast);
  UNTIL (CharLast=0) OR (CharBuf[CharLast-1] <> CtrlChar);
END;

(************************************************************************)
(* SaveSession speichert eine Session als Textfile ab. Die Zeilenlänge  *)
(* ist 75 Zeichen, damit mit einem Texteditor editiert werden kann.     *)
FUNCTION SaveSession( Name : STRING) : BOOLEAN;
VAR t        : TEXT;
    i,ccount : WORD;
    st       : STRING[80];
BEGIN
  IF Name = '' THEN BEGIN
    SaveSession := FALSE;
    Exit;
  END;
  SaveSession := IOResult = 0;
  (*$I-*)
  Assign(t,Name); ReWrite(t);
  i := 0; ccount := CharLast;
  st[0] := CHAR(75);
  WHILE ccount > 75 DO BEGIN
    Move(CharBuf[i],st[1],75);
    WriteLn(t,st);
    Dec(ccount,75);
    Inc(i,75);
  END;
  st[0] := CHAR(ccount);
  Move(CharBuf[i],st[1],ccount);
  WriteLn(t,st);
  Close(t);
  (*$I+*)
  SaveSession := IOResult = 0;
END;

(************************************************************************)
(* Error gibt eine Fehlermeldung aus und wartet auf einen Tastendruck   *)
PROCEDURE Error(Meldung : STRING);
VAR H : PStatus;
BEGIN
  H := SaveState(CtrlMode);
  ClrScr;
  GotoXY(10,10);
  Write(Meldung);
  Wait;
  RestoreState(H,CtrlMode);
  Dispose(H);
END;

(************************************************************************)
(* LoadSession lädt eine Session von der Platte. Die Session sofort     *)
(* ausgeführt.                                                          *)
FUNCTION LoadSession(Name : STRING) : BOOLEAN;
VAR t     : TEXT;
    Zeile : STRING;
    i     : INTEGER;
BEGIN
  IF Name = '' THEN BEGIN
    LoadSession := FALSE;
    Exit;
  END;
  (* Session in Puffer laden *)
  Assign(t,Name);
  {$I-} Reset(t); {$I+}
  IF IOResult <> 0 THEN BEGIN
    Error('Datei ist nicht auffindbar');
    LoadSession := FALSE;
    Exit;
  END;
  ClearSession;
  i := 0;
  REPEAT
    ReadLn(t,Zeile);
    Move(Zeile[1],CharBuf[i],Length(Zeile));
    Inc(i,Length(Zeile));
  UNTIL EoF(t);
  CharLast := i;
  CtrlMode := FALSE;
  InitScreen;
  LowPlaySession(0,CharLast);
  LoadSession := TRUE;
END;

(************************************************************************)
(*                       Ende der Hilfsroutinen                         *)
(************************************************************************)

PROCEDURE Help;
VAR H : PStatus;
    t : TEXT;
    i : INTEGER;
    Zeile : STRING;
BEGIN
  H := SaveState(CtrlMode);
  TextColor(LightGray); TextBackground(Black);
  Assign(t,ProgPath+'TRICKBOX.HLP');
  (*$I-*) Reset(t); (*$I+*)
  IF IOResult <> 0 THEN BEGIN
    ClrScr;
    GotoXY(10,10);
    WriteLn('Hilfsdatei nicht gefunden...');
  END ELSE BEGIN
    ClrScr;
    FOR i := 1 TO 25 DO BEGIN
      ReadLn(t,Zeile);
      GotoXY(1,i);
      Write(Zeile);
    END;
    Close(t);
  END;
  Wait;
  RestoreState(H,CtrlMode);
  Dispose(H);
END;

(************************************************************************)
(* EditSession editiert die Session, d.h. hängt neue Events an die bis- *)
(* herige Session an. EditSession macht die unterste Zeile zur Status-  *)
(* zeile, die automatisch verschwindet, sobald der Cursor auf der Zeile *)
(* steht. EditSession selbst verwaltet nur "Meta-Events", wie das       *)
(* Zurücknehmen eines Events. Alle anderen Events werden von EditSes-   *)
(* sion nur abgespeichert, wie z.B. Farben einstellen bzw. in spezielle *)
(* Kommandos umgewandelt wie INS/OVR.                                   *)
PROCEDURE EditSession;
  PROCEDURE Send(CH : CHAR; M : BOOLEAN);
  BEGIN
    IF M <> CtrlMode THEN BEGIN
      CharBuf[CharLast] := CtrlChar;
      Inc(CharLast);
      LowPlaySession(CharLast-1,CharLast);
    END;
    CharBuf[CharLast] := CH;
    Inc(CharLast);
    LowPlaySession(CharLast-1,CharLast);
  END;
VAR Key,CX,cy,CKey : INTEGER;
    CCh            : CHAR;
    Tb             : BYTE;
BEGIN
  REPEAT
    IF WhereY <> 25 THEN BEGIN
      SaveGroundLine;
      CX := WhereX; cy := WhereY;
      WriteStatusLine(CharLast);
      GotoXY(CX,cy);
      Key := GetKey;
      RestoreGroundLine;
    END ELSE
      Key := GetKey;
    CASE Key OF
      32..126,
      128..254: Send(Chr(Key),FALSE);
      1059    : Help;                   (* Hilfestellung *)
      1072    : Send('^',TRUE);         (* Pfeiltasten *)
      1075    : Send('<',TRUE);
      1077    : Send('>',TRUE);
      1080    : Send('_',TRUE);
      1071    : Send('{',TRUE);         (* Home,End *)
      1079    : Send('}',TRUE);
      1073    : Send('(',TRUE);         (* PgUp, PgDown *)
      1081    : Send(')',TRUE);
      1083    : Send('$',TRUE);         (* DEL, BS *)
         8    : Send('&',TRUE);
      1115    : Send('[',TRUE);         (* Ctrl-Pfeiltasten *)
      1116    : Send(']',TRUE);
        13    : Send('R',TRUE);         (* RETURN *)
        26    : Send('Z',TRUE);         (* ^Z für ClrScr *)
      1082    : Send('#',TRUE);         (* INS *)
        23    : Send('W',TRUE);         (* ^W für Warten *)
        14    : Send('X',TRUE);         (* ^N für Zeile einfügen *)
        25    : Send('Y',TRUE);         (* ^Y für Zeile löschen *)
      1035    : Send('!',TRUE);         (* Alt-H für hellen Hintergrund *)
      1038    : Send('?',TRUE);         (* Alt-L für Line-Modus *)
      1031    : Send('-',TRUE);         (* Alt-S für Single-Line Modus *)
      1032    : Send('=',TRUE);         (* Alt-D für Double-Line Modus *)
      1046    : Send('+',TRUE);         (* Alt-C für Zeilen doppeln *)
      1120    : Send('*',TRUE);         (* Alt-1 für schneller *)
      1121    : Send('~',TRUE);         (* Alt-2 für langsamer *)
      1049    : Send('/',TRUE);         (* Alt-N für Zeilen-Modus aus *)
      1022    : Send('U',TRUE);         (* Alt-U für Rubber-Mode *)
       127    : UndoSession;            (* Ctrl-Backspace für Undo *)
        11    : BEGIN                   (* Ctrl-K für Vordergrundfarbe *)
                  SaveGroundLine;
                  GotoXY(1,25);
                  Write('Vordergrund (A..P) : ');
                  CKey := GetKey;
                  RestoreGroundLine;
                  IF (CKey <=256) THEN BEGIN
                    CCh := UpCase(Chr(CKey));
                    IF (CCh>='A') AND (CCh<='P') THEN
                      Send(CCh,TRUE);
                  END;
                END;
        17    : BEGIN                   (* Ctrl-K für Vordergrundfarbe *)
                  SaveGroundLine;
                  GotoXY(1,25);
                  Write('Hintergrund (A..P) : ');
                  CKey := GetKey;
                  RestoreGroundLine;
                  IF (CKey <=256) THEN BEGIN
                    CCh := UpCase(Chr(CKey));
                    IF (CCh>='A') AND (CCh<='P') THEN
                      Send(Chr(Ord(CCh)+32),TRUE);
                  END;
                END;
    END;
  UNTIL Key = 27;
  TextColor(LightGray);
  TextBackground(Black);
END;

(************************************************************************)
(* MainMenu stellt das Hauptmenü zur Verfügung. Das Hauptmenü wird in   *)
(* der untersten Zeile des Bildschirms dargestellt; auf Wunsch ist ein  *)
(* Hilfsbildschirm verfügbar.                                           *)
PROCEDURE MainMenu;
VAR Key,i : INTEGER;
    H     : PStatus;
    t     : TEXT;
    Zeile : STRING;
    Saved : BOOLEAN;
BEGIN
  REPEAT
    SaveGroundLine;
    GotoXY(1,25);
    Write('F1-Help   F2-Speichern   F3-Laden   F4-Play   F5-Edit   F6-Neustart   F10-Ende');
    REPEAT
      Key := GetKey;
    UNTIL (Key >= 1059) AND (Key <= 1068);
    RestoreGroundLine;
    CASE Key OF
      1059 : Help;
      1060 : BEGIN
               H := SaveState(CtrlMode);
               WHILE KeyPressed DO i := GetKey;
               GotoXY(1,25);
               Write('Speichern Dateiname : ');
               ReadLn(Zeile);
               IF SaveSession(Zeile) THEN
                 Saved := TRUE;
               RestoreState(H,CtrlMode);
               Dispose(H);
             END;
      1061 : BEGIN
               H := SaveState(CtrlMode);
               WHILE KeyPressed DO i := GetKey;
               GotoXY(1,25);
               Write('Laden Dateiname : ');
               ReadLn(Zeile);
               RestoreState(H,CtrlMode);
               Dispose(H);
               IF LoadSession(Zeile) THEN
                 Saved := TRUE;
             END;
      1062 : PlaySession;
      1063 : BEGIN
               EditSession;
               Saved := FALSE;
             END;
      1064 : ClearSession;
    END;
  UNTIL Key = 1068;
  TextColor(LightGray);
  TextBackground(Black);
  IF NOT Saved THEN BEGIN
    REPEAT
      GotoXY(1,25);
      Write('Session nicht abgespeichert, Name : ');
      ReadLn(Zeile);
      IF Zeile <> '' THEN BEGIN
        IF SaveSession(Zeile) THEN
          Saved := TRUE;
      END ELSE
        Saved := TRUE;
    UNTIL Saved;
  END;
END;

VAR D1, D2 : STRING;
BEGIN
  FSplit(ParamStr(0),ProgPath,D1,D2);
  InitStack;
  CtrlMode := FALSE;
  CharLast := 0;
  ClearSession;
  InitScreen;
  MainMenu;
  TextColor(Black);
  TextBackground(LightGray);
  ClrScr;
  Write;
END.