{****************************************************************************}
{*                           > T E X T O P I A                              *}
{*     Ein Toolbox fuer die Programmierung von Textadventures in Pascal     *}
{*      Fuer Turbo Pascal ab 6.0, Free Pascal ab 0.99.10 und Delphi 4       *}
{*                 Geschrieben von Oliver Berse 1998-1999                   *}
{*                              Version 1.0                                 *}
{****************************************************************************}
{* TIO definiert Routinen fuer die Ein/Ausgabe von Texten                   *}
{****************************************************************************}
UNIT TIO;
{$DEFINE fpc}

{$IFNDEF fpc}
  {$B-} {$L+}
{$ENDIF}
  {$D+} {$I-} {$R-} {$S-} {$V-} {$X+}
{$IFDEF delphi}
  {$H-}
{$ENDIF}

INTERFACE
{$IFNDEF delphi}
  USES OBJECTS;
{$ENDIF}

TYPE
  PChain    = ^TChain;   { Element der String-Liste }
  TChain    = RECORD
                c    : Char;
                next : PChain;
              END;
  {$IFDEF tp}
  PDiskText = ^TDiskText;    { Stringverwaltung mit Textdatei. Nur fuer TP/Dos }
  TDiskText = OBJECT
                CONSTRUCTOR Init;
                FUNCTION    HasText : BOOLEAN;
                PROCEDURE   SetText(str : STRING; clear : BOOLEAN);
                PROCEDURE   PrintText;
                FUNCTION    GetText : STRING;
                DESTRUCTOR  Done;
                PRIVATE
                start       : LONGINT;  { Startposition des Textes in Datei }
              END;
  {$ENDIF}
  PMemText  = ^TMemText;     { Stringverwaltung mit Liste }
  TMemText  = OBJECT
                CONSTRUCTOR Init;
                FUNCTION    HasText : BOOLEAN;
                PROCEDURE   SetText(str : STRING; clear : BOOLEAN);
                PROCEDURE   PrintText;
                FUNCTION    GetText : STRING;
                DESTRUCTOR  Done;
                PRIVATE
                pfirst      : PChain;   { Startadresse des Textes im Speicher }
                PROCEDURE   DelStr;
              END;
  PMStr     = ^TMStr;
  TMStr     = RECORD
                line : STRING[132];
                next : PMStr;
              END;
  PMap      = ^TMap;  { Nimmt Karte fuers Automapping auf }
  TMap      = OBJECT
                start       : PMStr;
                CONSTRUCTOR Init;
                PROCEDURE   InsStr(x1,y1 : SHORTINT; str : STRING);
                PROCEDURE   Show;
                DESTRUCTOR  Done;
              END;

CONST
  back_kc  = #08;      { Tastaturcodes }
  del_kc   = #83;
  down_kc  = #80;
  end_kc   = #79;
  enter_kc = #13;
  esc_kc   = #27;
  f1_kc    = #59;
  f2_kc    = #60;
  f3_kc    = #61;
  f4_kc    = #62;
  f5_kc    = #63;
  f6_kc    = #64;
  f7_kc    = #65;
  f8_kc    = #66;
  f9_kc    = #67;
  f10_kc   = #68;
  home_kc  = #71;
  ins_kc   = #82;
  left_kc  = #75;
  pdown_kc = #81;
  pup_kc   = #73;
  right_kc = #77;
  up_kc    = #72;
  {
    Farben, da im Spiel keine CRT gebraucht wird
  }
  black        = 0;
  blue         = 1;
  green        = 2;
  cyan         = 3;
  red          = 4;
  magenta      = 5;
  brown        = 6;
  lightgray    = 7;
  darkgray     = 8;
  lightblue    = 9;
  lightgree    = 10;
  lightcyan    = 11;
  lightred     = 12;
  lightmagenta = 13;
  yellow       = 14;
  white        = 15;

VAR
  maxcol,             { Bildschirmspalten }
  maxrow,             { Bildschirmzeilen }
  row     : BYTE;     { aktuelle Zeile }
  replay,             { Bestaetigung fuer Textausgabe }
  debug   : BOOLEAN;  { Debug-Modus ein/aus }

PROCEDURE CloseScript;
PROCEDURE CloseText;
PROCEDURE Declension(sub : STRING);
FUNCTION  GetForeColor : BYTE;
FUNCTION  GetBackColor : BYTE;
PROCEDURE InversText;
PROCEDURE NormalText;
PROCEDURE OpenScript(name : STRING);
PROCEDURE OpenText(name : STRING; _write : BOOLEAN);
PROCEDURE Print(line : STRING);
FUNCTION  Question(str,chars : STRING) : CHAR;
PROCEDURE Scan(VAR line : STRING; prompt,upsize : BOOLEAN; lmem : BYTE);
PROCEDURE SetColor(fc,bc : BYTE);
PROCEDURE SetFKey(n : BYTE; str : STRING);
PROCEDURE SetWinTitle(title : STRING);
PROCEDURE Warning(str : STRING);
PROCEDURE XYWrite(x,y : BYTE; str : STRING);

IMPLEMENTATION
{$IFNDEF delphi}
  USES CRT,TSTRING;
{$ELSE}
  USES WINDOWS,DCRT,TSTRING;
{$ENDIF}

TYPE
  PHistory = ^THistory;  { Liste fuer letze n Eingaben }
  THistory = RECORD
               str       : STRING[78];
               prev,next : PHistory;
             END;
VAR
  hstart     : PHistory;
  keystr     : ARRAY[1..10] OF STRING[20];
  forecolor,
  backcolor  : 0..15;
  filewrite  : BOOLEAN;
  textfile   : FILE OF BYTE;  { Schon richtig so... }
  {$IFNDEF delphi}
  scriptfile : TEXT;          { Handle fuer Protokolldatei }
  {$ELSE}
  scriptfile : TEXT;
  {$ENDIF}
  scriptline : STRING;        { Uebertraegt Ein/Ausgabe in Protokolldatei }

PROCEDURE XYWrite(x,y : BYTE; str : STRING);
BEGIN
  GOTOXY(x,y);
  WRITE(str);
END;

PROCEDURE InversText;
BEGIN
  TEXTCOLOR(backcolor);
  TEXTBACKGROUND(forecolor);
END;

PROCEDURE NormalText;
BEGIN
  TEXTCOLOR(forecolor);
  TEXTBACKGROUND(backcolor);
END;

PROCEDURE SetColor(fc,bc : BYTE);
BEGIN
  forecolor:=fc;
  backcolor:=bc;
  NormalText;
END;

FUNCTION GetForeColor : BYTE;
BEGIN
  GetForeColor:=forecolor;
END;

FUNCTION GetBackColor : BYTE;
BEGIN
  GetBackColor:=backcolor;
END;

PROCEDURE NewLine;
BEGIN
  WRITELN;
  IF row<maxrow-2 THEN INC(row)
                  ELSE BEGIN
                         WRITE(' [WEITER] ');
                         READKEY;
                         GOTOXY(1,WHEREY);
                         CLREOL;
                         GOTOXY(1,WHEREY);
                         row:=1;
                       END;
  SYSTEM.WRITELN(scriptfile,scriptline);
  scriptline:='';
END;

PROCEDURE Print(line : STRING);
CONST
  a0 : ARRAY[0..6] OF STRING
       = ('\a','\o','\u','\s','\A','\O','\U');
  a1 : ARRAY[0..6] OF CHAR
       = (lae_kc,loe_kc,lue_kc,ss_kc,uae_kc,uoe_kc,uue_kc);
VAR
  i,j : BYTE;
  rev : BOOLEAN;
BEGIN
  FOR i:=0 TO 6 DO SwpStr(line,a0[i],a1[i]);
  i:=1;
  rev:=f;
  REPEAT
    j:=i;
    WHILE (NOT(line[j] IN [' ','\'])) AND (j<LENGTH(line)) DO j:=j+1;
    IF WHEREX+j-i>maxcol-1 THEN NewLine;
    REPEAT;
      IF line[i]<>'\' THEN
      BEGIN
        WRITE(line[i]);
        scriptline:=scriptline+line[i];
      END ELSE BEGIN
                 CASE line[i+1] OF
                   'n' : NewLine;
                   'h' : HIGHVIDEO;
                   'l' : NORMVIDEO;
                   'r' : BEGIN
                           IF rev THEN NormalText
                                  ELSE InversText;
                           rev:=NOT(rev);
                         END;
                   'b' : line[i+2]:=UpChar(line[i+2]);
                 END;
                 DELETE(line,i,1);
               END;
      INC(i);
    UNTIL i>j;
    i:=j+1;
  UNTIL j>=LENGTH(line);
  replay:=t;
END;

{
  Zeileneditor fuer Eingaben des Spielers
  line    Eingabestring
  prompt  > Zeichen anzeigen?
  upsize  Eingabe in Grossbuchstaben umwandeln?
  lmem    Max. Zeilen im Eingabepuffer
}
PROCEDURE Scan(VAR line : STRING; prompt,upsize : BOOLEAN; lmem : BYTE);
CONST
  chars = [#32,#34,#35,#44,#48..#57,#65..#90,#97..#122,
           lae_kc,loe_kc,lue_kc,ss_kc,uae_kc,uoe_kc,uue_kc];
  punct = ['.','!','?'];
VAR
  key           : CHAR;
  x,p,len,i,max : BYTE;
  ins,pressed   : BOOLEAN;
  hline         : PHistory;
  PROCEDURE AddLine;
  VAR
    n : WORD;
    p : PHistory;
  BEGIN
    IF (hstart<>NIL) AND (hstart^.str='') THEN
    BEGIN
      p:=hstart^.next;
      DISPOSE(hstart);
      hstart:=p;
    END;
    NEW(hline);
    WITH hline^ DO
    BEGIN
      str:=line;
      IF hstart<>NIL THEN
      BEGIN
        next:=hstart;
        prev:=NIL;
        hstart^.prev:=hline;
        hstart:=hline;
      END ELSE BEGIN
                 hstart:=hline;
                 next:=NIL;
                 prev:=NIL;
               END;
    END;
    n:=0;
    p:=hstart;
    WHILE p^.next<>NIL DO
    BEGIN
      INC(n);
      p:=p^.next;
    END;
    IF n>lmem THEN
    BEGIN
      IF p^.prev<>NIL THEN p^.prev^.next:=NIL;
      DISPOSE(p);
    END;
  END;
BEGIN
  IF prompt THEN
  BEGIN
    IF debug THEN WRITE('d');
    WRITE('>');
  END;
  x:=WHEREX-1;
  max:=80-WHEREX;
  line:='';
  key:=#0;
  hline:=NIL;
  GOTOXY(x,WHEREY);
  ins:=t;
  p:=1;
  REPEAT;
    len:=LENGTH(line);
    GOTOXY(x+p,WHEREY);
    key:=READKEY;
    IF upsize THEN key:=UpChar(key);
    IF (key IN chars) OR (key IN punct) THEN
    BEGIN
      IF NOT(ins) THEN
      BEGIN
        IF p>len THEN line:=line+key
                 ELSE line[p]:=key;
        IF p<max THEN INC(p);
        WRITE(key);
      END ELSE BEGIN
                 IF len<max THEN
                 BEGIN
                   IF p>len THEN line:=line+key
                            ELSE INSERT(key,line,p);
                   IF p<=len THEN WRITE(COPY(line,p,255))
                             ELSE WRITE(key);
                   IF LENGTH(line)<max THEN INC(p);
                 END;
               END;
    END;
    IF key=#0 THEN
    BEGIN
      key:=READKEY;
      CASE key OF
        left_kc  : IF p>1 THEN DEC(p);
        right_kc : IF (p<=len) AND (p<max) THEN INC(p);
        up_kc,
        down_kc  : BEGIN
                     IF hline=NIL THEN
                     BEGIN
                       AddLine;
                       hline:=hstart^.next;
                     END;
                     GOTOXY(x+1,WHEREY);
                     CLREOL;
                     line:=hline^.str;
                     XYWRITE(x+1,WHEREY,line);
                     len:=LENGTH(line);
                     p:=len+1;
                     IF (key=up_kc) AND (hline^.next<>NIL) THEN hline:=hline^.next;
                     IF key=down_kc THEN IF hline^.prev<>NIL THEN hline:=hline^.prev;
                   END;
        ins_kc   : ins:=NOT(ins);
        del_kc   : IF (len>0) AND (p<=len) THEN
                   BEGIN
                     DELETE(line,p,1);
                     WRITE(COPY(line,p,255)+' ');
                   END;
        home_kc  : p:=1;
        end_kc   : IF len<max THEN p:=len+1
                              ELSE p:=len;
        ELSE IF key IN [#59..#68,#133..#134] THEN
             BEGIN
               i:=ORD(key);
               IF i<69 THEN DEC(i,58)
                       ELSE DEC(i,122);
               IF (keystr[i]<>'') AND (LENGTH(line)+LENGTH(keystr[i])<max) THEN
               BEGIN
                 IF NOT(ins) THEN
                 BEGIN
                   IF p>len THEN line:=line+keystr[i]
                            ELSE BEGIN
                                   DELETE(line,p,LENGTH(keystr[i]));
                                   INSERT(keystr[i],line,p);
                                 END;
                   IF p<max THEN INC(p,LENGTH(keystr[i]));
                   WRITE(keystr[i]);
                 END ELSE BEGIN
                            IF len<max THEN
                            BEGIN
                              IF p>len THEN line:=line+keystr[i]
                                       ELSE INSERT(keystr[i],line,p);
                              IF p<=len THEN WRITE(COPY(line,p,255))
                                        ELSE WRITE(keystr[i]);
                              IF LENGTH(line)<max THEN INC(p,LENGTH(keystr[i]));
                            END;
                          END;
               END;
             END;
      END;
    END;
    IF (key=back_kc) AND (p>1) THEN
    BEGIN
      IF len=max THEN DELETE(line,p,1)
                 ELSE BEGIN
                        DELETE(line,p-1,1);
                        DEC(p);
                      END;
      XYWrite(x+p,WHEREY,COPY(line,p,255)+' ')
    END;
    IF key=esc_kc THEN
    BEGIN
      p:=1;
      line:='';
      GOTOXY(x+1,WHEREY);
      CLREOL;
    END;
  UNTIL key=enter_kc;
  SYSTEM.WRITELN(scriptfile,'>'+line);
  WRITELN;
  IF line<>'' THEN
  BEGIN
    IF (lmem>0) AND (hline=NIL) THEN AddLine;
    i:=1;
    WHILE i<=LENGTH(line) DO
    BEGIN
      IF line[i] IN punct THEN DELETE(line,i,1)
                          ELSE INC(i);
    END;
  END;
END;

PROCEDURE SetFKey(n : BYTE; str : STRING);
BEGIN
  IF n<11 THEN keystr[n]:=str;
END;

{
  Fenstertitel fuer Windows
}
PROCEDURE SetWinTitle(title : STRING);
{$IFDEF delphi}
VAR
  s : ANSISTRING;
{$ENDIF}
BEGIN
  {$IFDEF delphi}
  s:=title;
  SETCONSOLETITLE(PCHAR(s));
  {$ENDIF}
END;

FUNCTION Question(str,chars : STRING) : CHAR;
VAR
  key : CHAR;
BEGIN
  Print(str);
  key:=#0;
  WHILE POS(key,chars)=0 DO key:=LowCase(READKEY);
  Print(key+'\n');
  question:=key;
END;

PROCEDURE Warning(str : STRING);
BEGIN
  Print('<'+str+'>\n');
  IF Question('Abbrechen oder fortfahren? (a/f) ','af')='a' THEN HALT;
END;

PROCEDURE Declension(sub : STRING);
VAR
  a,b      : BYTE;
  c        : TCasus;
  d        : BOOLEAN;
  s1,s2,s3 : STRING;
BEGIN
  FOR a:=1 TO 2 DO
  BEGIN
    IF a=1 THEN s3:='S'
           ELSE s3:='P';
    FOR b:=1 TO 2 DO
    BEGIN
      d:=b=1;
      IF d THEN s2:='b'
           ELSE s2:='u';
      FOR c:=nom TO dat DO
      BEGIN
        CASE c OF
          nom : s1:='Nominativ';
          acc : s1:='Akkusativ';
          gen : s1:='Genitiv  ';
          dat : s1:='Dativ    ';
        END;
        Print(s1+'/'+s2+'/'+s3+': '+Noun(sub,c,d,a)+'\n');
      END;
    END;
  END;
END;

PROCEDURE OpenText(name : STRING; _write : BOOLEAN);
PROCEDURE fatal;
BEGIN
  WRITELN('Textdatei kann nicht ge'+loe_kc+'ffnet werden');
  HALT;
END;
BEGIN
  filewrite:=_write;
  IF _write THEN                   { Neue Textdatei schreiben }
  BEGIN
    {$IFNDEF delphi}
    ASSIGN(textfile,name);
    {$ELSE}
    ASSIGNFILE(textfile,name);
    {$ENDIF}
    REWRITE(textfile);
    IF IORESULT<>0 THEN fatal;
  END ELSE BEGIN                   { Vorhandene Textdatei verwenden }
             {$IFNDEF delphi}
             ASSIGN(textfile,name);
             {$ELSE}
             ASSIGNFILE(textfile,name);
             {$ENDIF}
             RESET(textfile);
             IF IORESULT<>0 THEN   { Wenn keine Textdatei vorhanden, }
             BEGIN                 { dann neu schreiben }
               filewrite:=t;
               {$IFNDEF delphi}
               ASSIGN(textfile,name);
               {$ELSE}
               ASSIGNFILE(textfile,name);
               {$ENDIF}
               REWRITE(textfile);
               IF IORESULT=0 THEN
               BEGIN
                 CLOSE(textfile);
                 {$IFNDEF delphi}
                 ASSIGN(textfile,name);
                 {$ELSE}
                 ASSIGNFILE(textfile,name);
                 {$ENDIF}
                 RESET(textfile);
               END ELSE fatal;
             END;
           END;
END;

PROCEDURE CloseText;
BEGIN
  Close(textfile);
END;

PROCEDURE OpenScript(name : STRING);
BEGIN
  {$IFNDEF delphi}
  ASSIGN(scriptfile,name);
  {$ELSE}
  ASSIGNFILE(scriptfile,name);
  {$ENDIF}
  REWRITE(scriptfile);
  IF IORESULT<>0 THEN
  BEGIN
    WRITELN('Protokolldatei kann nicht ge'+loe_kc+'ffnet werden');
    HALT;
  END;
END;

PROCEDURE CloseScript;
BEGIN
  Close(scriptfile);
END;

{* TDiskText ********************************************************************}

{$IFDEF tp}
CONSTRUCTOR TDiskText.Init;
CONST
  zero : BYTE = 0;
VAR
  dummy : BYTE;
BEGIN
  start:=-1;  { Noch keinen Text geschrieben oder gelesen }
  IF FILEPOS(textfile)>0 THEN
  BEGIN
    IF filewrite THEN WRITE(textfile,zero)  { Textende markieren }
                 ELSE READ(textfile,dummy);
  END;
END;

FUNCTION TDiskText.HasText : BOOLEAN;
BEGIN
  HasText:=start<>-1;
END;

PROCEDURE TDiskText.SetText(str : STRING; clear : BOOLEAN);
VAR
  i,ascii : BYTE;
BEGIN
  IF start<0 THEN
  BEGIN
    start:=FILEPOS(textfile);  { Startposition merken }
    clear:=NOT(clear);         { Dummy }
  END;
  FOR i:=1 TO LENGTH(str) DO                 { Zeichenkette speichern oder }
  BEGIN                                      { weiterlesen }
    IF filewrite THEN
    BEGIN
      ascii:=ORD(str[i])+(FILEPOS(textfile) MOD 8);
      WRITE(textfile,ascii);
    END ELSE READ(textfile,ascii);
  END;
END;

{
  Gibt gesamten Text fuer aktuelles Objekt aus
}
PROCEDURE TDiskText.PrintText;
VAR
  str   : STRING;
  stop  : BOOLEAN;
  ascii : BYTE;
BEGIN
  str:='';
  stop:=f;
  SEEK(textfile,start);
  WHILE NOT(stop) DO
  BEGIN
    READ(textfile,ascii);
    stop:=(ascii=0) OR (EOF(textfile));
    IF ascii>0 THEN str:=str+CHR(ascii-(FILEPOS(textfile)-1) MOD 8);
    IF (LENGTH(str)=254) OR (stop) THEN
    BEGIN
      Print(str);
      str:='';
    END;
  END;
END;

{
  Gibt Text als String zurueck
}
FUNCTION TDiskText.GetText : STRING;
VAR
  str   : STRING;
  ascii : BYTE;
BEGIN
  str:='';
  ascii:=1;
  SEEK(textfile,start);
  WHILE (ascii>0) AND (LENGTH(str)<256) AND (NOT(EOF(textfile))) DO
  BEGIN
    READ(textfile,ascii);
    IF ascii>0 THEN str:=str+CHR(ascii-(FILEPOS(textfile)-1) MOD 8);
  END;
  GetText:=str;
END;

DESTRUCTOR TDiskText.Done;
BEGIN
END;
{$ENDIF}

{* TMemText *********************************************************************}

CONSTRUCTOR TMemText.Init;
BEGIN
  pfirst:=NIL;
END;

FUNCTION TMemText.HasText : BOOLEAN;
BEGIN
  HasText:=pfirst<>NIL;
END;

PROCEDURE TMemText.SetText(str : STRING; clear : BOOLEAN);
VAR
  p1,p2 : PChain;
  i     : BYTE;
BEGIN
  p1:=NIL;
  IF pfirst<>NIL THEN  { Wenn Liste bereits Text enthaelt }
  BEGIN
    IF NOT(clear) THEN { Listenende suchen }
    BEGIN
      p1:=pfirst;
      WHILE p1^.next<>NIL DO p1:=p1^.next;
    END ELSE DelStr;   { oder Liste loeschen }
  END;
  FOR i:=1 TO LENGTH(str) DO
  BEGIN
    NEW(p2);
    WITH p2^ DO
    BEGIN
      c:=str[i];
      next:=NIL;
    END;
    IF pfirst<>NIL THEN p1^.next:=p2
                   ELSE pfirst:=p2;
    p1:=p2;
  END;
END;

PROCEDURE TMemText.PrintText;
VAR
  p   : PChain;
  str : STRING;
BEGIN
  str:='';
  p:=pfirst;
  WHILE p<>NIL DO
  BEGIN
    str:=str+p^.c;
    p:=p^.next;
    IF (p=NIL) OR (LENGTH(str)=254) THEN
    BEGIN
      Print(str);
      str:='';
    END;
  END;
END;

{
  Gibt eine Liste von maximal 255 Zeichen als String zurueck.
}
FUNCTION TMemText.GetText : STRING;
VAR
  p   : PChain;
  str : STRING;
BEGIN
  IF HasText THEN
  BEGIN
    str:='';
    p:=pfirst;
    WHILE (p<>NIL) AND (LENGTH(str)<255) DO
    BEGIN
      str:=str+p^.c;
      p:=p^.next;
    END;
  END ELSE str:='Ohne Namen';
  GetText:=str;
END;

PROCEDURE TMemText.DelStr;
VAR
  p : PChain;
BEGIN
  WHILE pfirst<>NIL DO
  BEGIN
    p:=pfirst^.next;
    DISPOSE(pfirst);
    pfirst:=p;
  END;
END;

DESTRUCTOR TMemText.Done;
BEGIN
  DelStr;
END;

CONSTRUCTOR Tmap.Init;
VAR
  x,y   : BYTE;
  p1,p2 : PMStr;
BEGIN
  p1:=NIL;
  start:=NIL;
  FOR y:=1 TO maxrow DO
  BEGIN
    NEW(p2);
    WITH p2^ DO
    BEGIN
      line:='!';  { Markierung fuer Leerzeilen }
      FOR x:=1 TO maxcol-2 DO line:=line+' ';
      next:=NIL;
    END;
    IF start<>NIL THEN p1^.next:=p2
                  ELSE start:=p2;
    p1:=p2;
  END;
END;

PROCEDURE TMap.InsStr(x1,y1 : SHORTINT; str : STRING);
VAR
  p  : PMStr;
  y0 : SHORTINT;
BEGIN
  p:=start;
  y0:=1;
  WHILE y0<y1 DO
  BEGIN
    p:=p^.next;
    y0:=y0+1;
  END;
  p^.line[1]:=' ';
  DELETE(p^.line,x1,LENGTH(str));
  INSERT(str,p^.line,x1);
END;

PROCEDURE Tmap.Show;  { Karte ausgeben }
VAR
  p : PMStr;
BEGIN
  p:=start;
  WHILE p<>NIL DO
  BEGIN
    IF p^.line[1]<>'!' THEN WRITELN(p^.line);  { Print fuers Scriptfile }
    p:=p^.next;
  END;
END;

DESTRUCTOR  Tmap.Done;
VAR
  p : PMStr;
BEGIN
  WHILE start<>NIL DO
  BEGIN
    p:=start^.next;
    DISPOSE(start);
    start:=p;
  END;
END;

BEGIN
{$IFDEF tp}
  CHECKBREAK:=f;
{$ENDIF}
{$IFDEF fpc}
  SetColor(black,lightgray);
{$ELSE}
  SetColor(lightgray,blue);
{$ENDIF}
  maxcol:=80;
  maxrow:=25;
  scriptline:='';
  hstart:=NIL;
  replay:=f;
  debug:=t;
END.
