{****************************************************************************}
{*                           > T E X T O P I A                              *}
{*    Eine 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                                 *}
{****************************************************************************}
{* TMain definiert die Objekte der Spielwelt und den Parser                 *}
{****************************************************************************}

UNIT TMAIN;
{$DEFINE fpc}

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

INTERFACE
{$IFNDEF delphi}
  USES OBJECTS,TSTRING,TIO;
{$ELSE}
  USES TSTRING,TIO;
{$ENDIF}

TYPE
  PBasic  = ^TBasic;  { Zeiger auf Basisobjekt }
  PLink   = ^TLink;   { Zeiger auf Verbindung }
  PGame   = ^TGame;   { Zeiger auf Spielobjekt }
  PLib    = ^TVerb;   { Zeiger auf Eintrag im Wrterbuch }
  PItem   = ^TItem;   { Zeiger auf Gegenstand }
  PLock   = ^TLock;   { Zeiger auf Schloss fuer Tueren und Behaelter }
  PNoun   = ^TNoun;   { Zeiger auf Informationen ueber Eingabe }
  PPlayer = ^TPlayer; { Zeiger auf Spielerobjekt }
  PRoom   = ^TRoom;   { Zeiger auf Raum }
  TDir    = (north,northeast,  { Himmelsrichtungen }
             east,southeast,
             south,southwest,
             west,northwest,
             up,down,
             nowhere);
  T_Class = (room,link,item);        { Bausteine der Spielwelt }
  TMatter = (inanimate,dead,alive);  { moegliche Zustaende der Items }
  {
    TNoun enthaelt Informationen ueber die in
    der Spielereingabe ausgewaehlten Objekte
  }
  TNoun   = RECORD
              detect,
              adj      : BOOLEAN;
              number   : INTEGER;
              xroom  : PRoom;
              xlink  : PLink;
              xitem  : PItem;
            END;
  {
    Record fuer Nachricht an Objekte
  }
  TEvent  = RECORD
              action,             { Event-Konstante des Ereignisses }
              exec,               { Wie oft ausgefuehrt? }
              maxexec : BYTE;     { Wie oft maximal ausfuehren? }
              return  : BOOLEAN;  { erfolgreich ausgefuehrt? }
              who     : PItem;    { Akteur: Spieler oder NPC }
              first,              { Empfaengerobjekt }
              second  : PNoun;    { Weiteres beteiligtes Objekt }
              data    : POINTER;  { Zeiger auf zusaetzliche Daten }
            END;
  {
    TWeight verwaltet Gewichte
  }
  TWeight   = OBJECT
                CONSTRUCTOR Init(_owner : POINTER; _min,_max : BYTE);
                FUNCTION    GetCont : BYTE;     { Zahl enthaltener Objekte }
                FUNCTION    GetSum  : BYTE;     { Gewicht }
                FUNCTION    GetMax  : BYTE;     { Maximalgewicht }
                DESTRUCTOR  Done;
                PRIVATE
                owner       : POINTER;  { Item oder Spieler }
                counter,                { Anzahl enthaltener Items }
                wsum,                   { Eigengewicht + Gewicht von Items }
                wmax        : BYTE;     { Maximalgewicht }
                PROCEDURE   Pick(x : POINTER; VAR error : BOOLEAN);
                PROCEDURE   Drop(x : POINTER);
              END;
  {
    Spielerobjekt
  }
  TPlayer = OBJECT
              CONSTRUCTOR Init(_where : WORD; _adress : TAdress;
                               _gender : TGender; _wmin,_wmax : BYTE);
              PROCEDURE   AfterLife; VIRTUAL;
              FUNCTION    GetAdress : TAdress;
              FUNCTION    GetContainer : PItem;
              FUNCTION    GetContent : BYTE;
              FUNCTION    GetGender : TGender;
              FUNCTION    GetLocation : PRoom;
              FUNCTION    GetMaxWeight : BYTE;
              FUNCTION    GetScores : WORD;
              FUNCTION    GetMoves : WORD;
              FUNCTION    GetState : BYTE;
              FUNCTION    GetWeight : BYTE;
              FUNCTION    HasPlayer(i : WORD) : BOOLEAN;
              PROCEDURE   IncScores(ds : WORD);
              PROCEDURE   Load(VAR h : File); VIRTUAL;
              PROCEDURE   MovePlayerTo(where : PBasic);
              PROCEDURE   SetState(s : BYTE);
              FUNCTION    StatusBarLeftStr : STRING; VIRTUAL;
              FUNCTION    StatusBarRightStr : STRING; VIRTUAL;
              PROCEDURE   Store(VAR h : File); VIRTUAL;
              FUNCTION    RankStr : STRING; VIRTUAL;
              PROCEDURE   Victory; VIRTUAL;
              DESTRUCTOR  Done;
            PRIVATE
              inside      : PItem;    { Zeiger auf Behaelter oder Fahrzeug }
              position    : PRoom;    { Zeiger auf aktuellen Raum }
              weight      : TWeight;
              adress      : TAdress;  { Anrede fuer Spieler }
              gender      : TGender;  { Spielergeschlecht }
              moves,                  { Runden }
              scores      : WORD;     { Punkte }
              state       : BYTE;     { Status des Spielers }
              PROCEDURE   Enter(_item : PItem);
              PROCEDURE   IncMoves;
              PROCEDURE   Inventory;
              PROCEDURE   Leave;
            END;
  {
    Basisobjekt fuer Raeume, Durchgaenge und Items
  }
  TBasic  = OBJECT
              name        : TMemText;   { Objektname als Listenobjekt }
              lock        : PLock;      { Schlosser fuer Links und Items }
              CONSTRUCTOR Init(_id : WORD; _name : STRING; _objclass : T_Class);
              PROCEDURE   AddText(str : STRING);
              PROCEDURE   DelText;
              FUNCTION    GetClass : T_Class;
              FUNCTION    GetCopies : BYTE;
              FUNCTION    GetID : WORD;
              PROCEDURE   HandleEvent(VAR event : TEvent); VIRTUAL;
              FUNCTION    HasDaemon : BOOLEAN;
              FUNCTION    HasTimer : BOOLEAN;
              PROCEDURE   Inspect; VIRTUAL;
              PROCEDURE   Load(VAR h : File); VIRTUAL;
              PROCEDURE   MyText; VIRTUAL;
              PROCEDURE   RunDaemon; VIRTUAL;
              FUNCTION    Scope : BYTE; VIRTUAL;
              PROCEDURE   StartDaemon;
              PROCEDURE   StopDaemon;
              PROCEDURE   StartTimer(rounds : BYTE);
              PROCEDURE   StopTimer;
              PROCEDURE   Store(VAR h : File); VIRTUAL;
              PROCEDURE   TimeOut; VIRTUAL;
              PROCEDURE   View; VIRTUAL;
              DESTRUCTOR  Done; VIRTUAL;
            PRIVATE
              _class      : T_Class;    { room, item oder link }
              id          : WORD;     { ID zur eindeutigen Identifikation }
              copies,                 { Anzahl erreichbarer Objekte mit gleichem Namen }
              counter     : BYTE;     { Zaehler fuer Timer }
              flag,                   { wichtig }
              daemon,                 { Daemon eingeschaltet? }
              timer,                  { Timer eingeschaltet? }
              tracing     : BOOLEAN;  { Objektzustand verfolgen? }
              {$IFDEF tp}
              objtext     : PDiskText;  { TP: Text in Datei speichern }
              {$ELSE}
              objtext     : PMemText;   { Delphi/FPC: Text in Liste speichern }
              {$ENDIF}    
              PROCEDURE   ObscureEvents;
              PROCEDURE   RunTimer;
              PROCEDURE   Reset;
              PROCEDURE   TextOut;
            END;
  {
    TLock: Schloesser fuer Tueren und Behaelter
  }
  TState  = (open,closed,locked);  { Zustaende fuer Schloesser }
  TLock   = OBJECT
              CONSTRUCTOR Init(_owner : PBasic; _openable,_closeable : BOOLEAN; _state : TState; _key : PItem);
              FUNCTION    AfterAction(event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    BeforeAction(event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    GetKey : PItem;
              FUNCTION    GetOwner : PBasic;
              FUNCTION    GetState : TState;
              PROCEDURE   HandleEvent(VAR event : TEvent); VIRTUAL;
              FUNCTION    HasKey(event : Tevent) : BOOLEAN;
              FUNCTION    IsOpenable : BOOLEAN;
              FUNCTION    IsCloseable : BOOLEAN;
              PROCEDURE   Load(VAR h : File); VIRTUAL;
              PROCEDURE   SetCloseable(s : BOOLEAN);
              PROCEDURE   SetOpenable(s : BOOLEAN);
              PROCEDURE   SetState(s : TState);
              PROCEDURE   Store(VAR h : File); VIRTUAL;
              PROCEDURE   View; VIRTUAL;
              DESTRUCTOR  Done; VIRTUAL;
              PRIVATE
              key         : PItem;    { Instanz von TItem oder NIL }
              owner       : PBasic;   { Instanz von TItem oder TLink }
              openable,               { kann das Schloss geoeffnet und }
              closeable   : BOOLEAN;  { geschlossen werden? }
              state       : TState;   { offen, geschlossen oder verschlossen }
            END;
  {
    TLink stellt eine Verbindung zwischen jeweils zwei Raeumen her
  }
  TLink   = OBJECT(TBasic)
              r1,r2       : PRoom;
              CONSTRUCTOR Init(_id : WORD; _name : STRING; _from : WORD; _dirto : TDir; _to : WORD; _show : BOOLEAN);
              FUNCTION    BeforeAction(VAR event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    AfterAction(VAR event : TEvent) : BOOLEAN; VIRTUAL;
              PROCEDURE   HandleEvent(VAR event : TEvent); VIRTUAL;
              FUNCTION    HasAutoDescription : BOOLEAN;
              PROCEDURE   Load(VAR h : File); VIRTUAL;
              FUNCTION    Scope : BYTE; VIRTUAL;
              PROCEDURE   Store(VAR h : File); VIRTUAL;
              PROCEDURE   View; VIRTUAL;
              DESTRUCTOR  Done; VIRTUAL;
            PRIVATE
              show        : BOOLEAN;  { Objekt in automatischer Raumbeschreibung erwaehnen? }
            END;
  {
    TRoom, der Objekttyp fuer alle Raeume
  }
  TRoom   = OBJECT(TBasic)
              gate        : ARRAY[north..down] OF PLink;
              CONSTRUCTOR Init(_id : WORD; _name : STRING);
              FUNCTION    AfterAction(event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    BeforeAction(event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    FromDir : TDir;
              PROCEDURE   HandleEvent(VAR event : TEvent); VIRTUAL;
              FUNCTION    HasLight : BOOLEAN;
              FUNCTION    IsGate(d : TDir) : TState;
              PROCEDURE   Load(VAR h : File); VIRTUAL;
              PROCEDURE   MyDarkness; VIRTUAL;
              PROCEDURE   SetLight(_light : BOOLEAN);
              PROCEDURE   Store(VAR h : File); VIRTUAL;
              FUNCTION    Scope : BYTE; VIRTUAL;
              FUNCTION    ToDir : TDir;
              PROCEDURE   View; VIRTUAL;
              DESTRUCTOR  Done; VIRTUAL;
            PRIVATE
              light,                   { Kann Spieler hier etwas sehen? }
              explored    : BOOLEAN;   { Deja-vu? }
              wto,wfrom   : TDir;      { Spieler will wohin / kommt woher? }
              PROCEDURE   CountLinks;
              PROCEDURE   RoomDescription;
            END;
  {
    TAttrib dient der Verwaltung von Item-Attributen in einer Liste
  }
  PAttrib   = ^TAttrib;
  TAttrib   = RECORD
                attribute : BYTE;
                prev,next : PAttrib;
            END;
  {
    TItem stellt alle Gegenstaende im Spiel dar
  }
  TItem   = OBJECT(TBasic)
              CONSTRUCTOR Init(_id : WORD; _name : STRING; _location : PBasic; _show : BOOLEAN; _wmin,_wmax : BYTE);
              FUNCTION    AfterAction(event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    BeforeAction(event : TEvent) : BOOLEAN; VIRTUAL;
              FUNCTION    Contains(x : PItem) : BOOLEAN;
              FUNCTION    DecAmount : BOOLEAN;
              FUNCTION    GetAmount : BYTE;
              FUNCTION    GetContainer : PItem;
              FUNCTION    GetContent : BYTE;
              FUNCTION    GetLocation : PRoom;
              FUNCTION    GetMatter : TMatter;
              FUNCTION    GetMaxWeight : BYTE;
              FUNCTION    GetWeight : BYTE;
              PROCEDURE   HandleEvent(VAR event : TEvent); VIRTUAL;
              FUNCTION    Has(p : BYTE) : BOOLEAN;
              FUNCTION    HasAutoDescription : BOOLEAN;
              FUNCTION    IsOn : BOOLEAN;
              FUNCTION    IsOff : BOOLEAN;
              PROCEDURE   ListMe(s : BOOLEAN);
              PROCEDURE   Load(VAR h : File); VIRTUAL;
              PROCEDURE   MoveCmd(where : POINTER; VAR event : TEvent);
              PROCEDURE   MoveItemTo(where : PBasic);
              FUNCTION    Scope : BYTE; VIRTUAL;
              PROCEDURE   SetAttrib(a : BYTE; _on : BOOLEAN);
              PROCEDURE   SetMatter(state : TMatter);
              PROCEDURE   SetPraepos(pp : STRING);
              PROCEDURE   SetAmount(n : BYTE);
              PROCEDURE   Store(VAR h : File); VIRTUAL;
              PROCEDURE   SwitchOn;
              PROCEDURE   SwitchOff;
              PROCEDURE   View; VIRTUAL;
              DESTRUCTOR  Done; VIRTUAL;
            PRIVATE
              location     : PRoom;
              inside       : PItem;
              weight       : TWeight;
              matter       : TMatter;   { Objekt unbelebt, lebendig oder tot? }
              pstart       : PAttrib;   { Startadresse Eigenschaften }
              show,                     { In Raumbeschreibung erwaehnen? }
              on           : BOOLEAN;   { Schalterzustand }
              amount       : BYTE;      { Menge,Tankfuellung etc. }
              praepos      : STRING[4]; { Praeposition fuer Dinge in/auf Behaeltern/Fahrzeugen }
              PROCEDURE   ClearAttributes;
              PROCEDURE   Follow;
              PROCEDURE   Register;
            END;
  {
    TVerb bildet das Woerterbuch
  }
  TVerb  = RECORD
             verb,syntax : TMemText;  { Verb und zugehoerige Tokenfolge }
             message     : BYTE;      { Vom Verb ausgeloeste Nachricht }
             prev,next   : PLib;      { vorheriges/naechstes Verb }
           END;
  {
    Hauptobjekt: Steuert Dialog mit Spieler, interpretiert dessen
    Eingabe und versendet Nachrichten an betroffene Objekte
  }
  TGame   = OBJECT
              CONSTRUCTOR Init(_statusline,_upsize,_verbose : BOOLEAN; _history : BYTE);
              FUNCTION    ActorWhere : PRoom;
              FUNCTION    ActorInside(container : PItem) : BOOLEAN;
              PROCEDURE   AddProlog(_str : STRING);
              PROCEDURE   AddVerb(_verb,_syntax : STRING; _event : BYTE);
              PROCEDURE   Admonition(adress : TAdress); VIRTUAL;
              FUNCTION    AfterAction(event : TEvent) : BOOLEAN;
              FUNCTION    BeforeAction(event : TEvent) : BOOLEAN;
              PROCEDURE   BeforeParsing(VAR input : STRING); VIRTUAL;
              PROCEDURE   ClearDictionary;
              PROCEDURE   DelVerb(_event : BYTE);
              FUNCTION    GetActor : PItem;
              PROCEDURE   GetTime(VAR hour,min : BYTE);
              PROCEDURE   HandleEvent(VAR event : TEvent); VIRTUAL;
              FUNCTION    MetaVerb(mv : BYTE) : BOOLEAN; VIRTUAL;
              FUNCTION    MyScope(_id : WORD; _action : BYTE) : BOOLEAN; VIRTUAL;
              PROCEDURE   ParserError(n : BYTE; str : STRING; i : BYTE; VAR error : BOOLEAN); VIRTUAL;
              PROCEDURE   Run;
              PROCEDURE   SetTime(_time,_rate : WORD);
              PROCEDURE   WriteProlog;
              DESTRUCTOR  Done;
            PRIVATE
              {$IFDEF tp}
              prologue    : PDiskText;  { Vorspann }
              {$ELSE}
              prologue    : PMemText;
              {$ENDIF}
              statusline,             { Statuszeile anzeigen? }
              verbose,                { Ausfuehrliche Beschreibung bekannter Raeume? }
              upsize,                 { Eingabe in Grossschrift? }
              meta        : BOOLEAN;  { Ist erkanntes Verb ein Metaverb? }
              history,                { Anzahl Zeilen im Historypuffer }
              quit,                   { Spielende erreicht? }
              maxwords    : BYTE;     { Zahl eingegebener Woerter }
              time,                   { Zeit in Minuten seit 0:00 Uhr }
              rate        : WORD;     { Minuten pro Runde }
              buffer      : TBuffer;  { Eingabepuffer }
              actor       : PItem;    { Akteuer }
              pverb       : PLib;     { Startadresse Woerterbuch }
              refpro      : PNoun;    { Substantiv fuer Reflexivpronomen }
              nounstr     : ARRAY[1..maxbuf] OF TNoun;  { wichtig }
              PROCEDURE   Browser;
              PROCEDURE   CheckCommandLine;
              FUNCTION    CmpScope(index,ttype,_action : BYTE) : BOOLEAN;
              PROCEDURE   DetectNumeral(w0 : BYTE; VAR number : INTEGER; VAR ok : BOOLEAN);
              PROCEDURE   DrawMap;
              PROCEDURE   DrawStatusline(location : BOOLEAN);
              PROCEDURE   InitEvent(VAR event : TEvent; _what,
                                    _maxexec : BYTE; _who : PItem; _first,
                                    _second : PNoun; _data : POINTER);
              FUNCTION    IsArtOrPron(str : STRING) : BOOLEAN;
              PROCEDURE   LoadGame(n : BYTE);
              PROCEDURE   Mapping(p : PRoom; x0,y0 : SHORTINT; VAR map : PMap);
              PROCEDURE   Parse(line : STRING);
              PROCEDURE   QuitGame;
              PROCEDURE   ReadLib;
              PROCEDURE   SaveGame(n : BYTE);
              PROCEDURE   SearchNoun(VAR w0 : BYTE; t0 : BYTE; VAR tfound : BYTE;
                                     ttype,_action : BYTE; VAR userstr : STRING;
                                     VAR pfailed : PBasic; VAR error : BOOLEAN);
              FUNCTION    IsVerbose : BOOLEAN;
              PROCEDURE   UserLoad;
              PROCEDURE   UserSave;
            END;

CONST
  sdstr : ARRAY[0..4] OF STRING[12]
        = ('notinroom_sd',
           'visible_sd',
           'reachable_sd',
           'bynpc_sd',
           'held_sd');
  {
    PlayerState: Spiel wird beendet, wenn Status des Spielers <> alive_ps
  }
  dead_ps    = 0;
  alive_ps   = 1;
  victory_ps = 2;
  {
    Scope-Definitionen
  }
  notinroom_sd = 0;   { Objekt ist ausser Sicht und Reichweite }
  visible_sd   = 1;   { Objekt ist sichtbar }
  reachable_sd = 2;   { Objekt ist sichtbar und erreichbar }
  bynpc_sd     = 3;   { Objekt wird von NPC gehalten }
  held_sd      = 4;   { Objekt wird vom Spieler gehalten }
  
  {
    Vordefinierte Ereignisse
  }
  close_ev      = 100;
  dance_ev      = 101;
  dec_ev        = 102;
  drink_ev      = 103;
  eat_ev        = 104;
  enter_ev      = 105;
  examine_ev    = 106;
  give_ev       = 107;
  go_ev         = 108;
  inv_ev        = 109;
  drop_ev       = 110;
  jump_ev       = 111;
  kill_ev       = 112;
  kiss_ev       = 113;
  leave_ev      = 114;
  lista_ev      = 115;
  lists_ev      = 116;
  load_ev       = 117;
  lock_ev       = 118;
  look_ev       = 119;
  map_ev        = 120;
  open_ev       = 121;
  press_ev      = 122;
  quit_ev       = 123;
  restart_ev    = 124;
  read_ev       = 125;
  score_ev      = 126;
  save_ev       = 127;
  set1_ev       = 128;
  set2_ev       = 129;
  show_ev       = 130;
  sleep_ev      = 131;
  smell_ev      = 132;
  switchoff_ev  = 133;
  switchon_ev   = 134;
  take_ev       = 135;
  tell_ev       = 136;
  touch_ev      = 137;
  trace_ev      = 138;
  wait_ev       = 139;
  {
    vordefinierte Item-Eigenschaften
  }
  drinkable_at   = 0;
  edable_at      = 1;
  enterable_at   = 2;
  moveable_at    = 3;
  readable_at    = 4;
  shining_at     = 5;
  switchable_at  = 6;
  takeable_at    = 7;
  talkable_at    = 8;
  transparent_at = 9;

VAR
  top        : PRoom;
  useroption : BOOLEAN;

FUNCTION  Adr(_id : WORD) : POINTER;
PROCEDURE Prepare(_filename : STRING; _new : BOOLEAN);
PROCEDURE WritePtr(VAR h : File; p : PBasic);
FUNCTION  ReadPtr(VAR h : File) : POINTER;
PROCEDURE WriteWord(VAR h : File; w : WORD);
PROCEDURE ReadWord(VAR h : File; VAR w : WORD);
PROCEDURE WriteBool(VAR h : File; v : Boolean);
PROCEDURE ReadBool(VAR h : File; VAR v : Boolean);
PROCEDURE WriteDir(VAR h : File; d1 : TDir);
PROCEDURE ReadDir(VAR h : File; VAR d1 : TDir);

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

CONST
  {
    TokenTypes
  }
  held_tt      = 1;
  noun_tt      = 2;
  npc_tt       = 3;
  number_tt    = 4;
  quote_tt     = 0;
  reachable_tt = 5;
  routine_tt   = 6;
  lockstr      : ARRAY[TState] OF STRING[12]
               = ('offen','geschlossen','verschlossen');
  dirstr  : ARRAY[north..nowhere] OF STRING[10]
          = ('Norden',
             'Nordosten',
             'Osten',
             'S'+lue_kc+'dosten',
             'S'+lue_kc+'den',
             'S'+lue_kc+'dwesten',
             'Westen',
             'Nordwesten',
             'oben',
             'unten',
             'nirgendwo');
  maxsave = 9;  { max. Zahl Spielstaende }

TYPE
  TSave   = ARRAY[1..maxsave] OF STRING[20];
  TToken  = RECORD
              tstr : STRING[10];
              tnum : BYTE;
            END;
  PElement = ^TElement;
  TElement = RECORD
               element   : PBasic;
               prev,next : PElement;
             END;
  TObjList = OBJECT
               CONSTRUCTOR Init;
               FUNCTION    At(index : WORD) : POINTER;
               FUNCTION    Count : WORD;
               PROCEDURE   Insert(_new : PBasic);
               FUNCTION    GetPtr(_id : WORD) : PBasic;
               DESTRUCTOR  Done;
               PRIVATE
               start : PElement;
             END;
VAR
  list    : TObjList;        { Ersatz fuer TCOLLECTION }
  savestr : STRING[128];
  player  : PPlayer;
  game    : PGame;

{
  Dateinamen festlegen, Textdatei oeffnen (nur DOS) und
  einen Raum als Versteck initialisieren.
}
PROCEDURE Prepare(_filename : STRING; _new : BOOLEAN);
BEGIN
  savestr:=_filename;
  {$IFDEF tp}
  OpenText(savestr+'.dat',_new);
  {$ENDIF }
  list.INIT;
  NEW(top,Init(0,'top'));
END;

FUNCTION Adr(_id : WORD) : POINTER;
BEGIN
  Adr:=list.GetPtr(_id);
END;

{
  Zaehlt mehrfach vorhandene Objekte im aktuellen Raum oder im Inventar
}
PROCEDURE CountItems(where : POINTER);
VAR
  i,j   : WORD;
  p1,p2 : PItem;
BEGIN
  FOR i:=0 TO list.COUNT-1 DO
  BEGIN
    p1:=list.At(i);
    IF p1^.location=where THEN p1^.copies:=1;
  END;
  FOR i:=0 TO list.COUNT-1 DO
  BEGIN
    FOR j:=SUCC(i) TO list.COUNT-1 DO
    BEGIN
      p1:=list.At(i);
      p2:=list.At(j);
      IF (p1^._class=item) AND (p2^._class=item) THEN
      BEGIN
        {
          Name, Raum und Behaelter muessen uebereinstimmen
        }
        IF (p1^.name.GetText=p2^.name.GetText) AND
           (p1^.location=where) AND
           (p2^.location=where) AND
           (p1^.inside=p2^.inside) THEN
        BEGIN
          INC(p1^.copies);
          INC(p2^.copies);
        END;
      END;
    END;
  END;
END;

PROCEDURE ResetAll;
VAR
  p : PBasic;
  i : WORD;
BEGIN
  FOR i:=0 TO list.COUNT-1 DO
  BEGIN
    p:=list.At(i);
    p^.Reset;
  END;
END;

{
  ShowItems: listet alle Objekte auf, die sich entweder im Inventar
  oder im aktuellen Raum befinden.
  held    True=Inventar auflisten / False=Objekte im Raum auflisten
  x       Linker Rand, Objekte in Behaeltern werden eingerueckt
  cont.   Wenn ungleich NIL: Objekte in diesem Behaelter ausgeben
}
PROCEDURE ShowItems(held : BOOLEAN; VAR x : BYTE; container : PItem);
VAR
  where   : PRoom;
  i,j     : WORD;
  p1,p2   : PItem;
  dstr    : STRING;
  c       : TCasus;
  visible : BOOLEAN;
  FUNCTION IsVisible : BOOLEAN;
  VAR
    k  : WORD;
    ok : BOOLEAN;
    p3 : PItem;
  BEGIN
    ok:=f;
    FOR k:=0 TO list.COUNT-1 DO
    BEGIN
      p3:=list.At(k);
      IF (p3^._class=item) AND (p3^.inside=p1) THEN ok:=t;
    END;
    IsVisible:=ok;
  END;
BEGIN
  IF held THEN where:=NIL
          ELSE where:=player^.position;
  IF container<>NIL THEN c:=acc
                    ELSE IF held THEN c:=acc
                                 ELSE c:=nom;
  FOR i:=0 TO list.COUNT-1 DO
  BEGIN
    p1:=list.At(i);
    WITH p1^ DO
    BEGIN
      visible:=(held) OR (NOT(held) AND (show));
      IF (_class=item) AND (location=where) AND (visible) AND (inside=container)
         AND (NOT(flag)) AND (player^.inside<>p1) THEN
      BEGIN
        IF copies=1 THEN dstr:=Noun(name.GetText,c,f,copies)
                    ELSE dstr:=Numeral(copies)+' '+Noun(name.GetText,c,f,copies);
        dstr[1]:=UpChar(dstr[1]);
        GOTOXY(x,WHEREY);
        IF (lock<>NIL) AND ((lock^.state=open) OR (Has(transparent_at))) AND (IsVisible) THEN
        BEGIN
          IF (weight.counter>0) AND (NOT((weight.counter=1) AND (player^.inside=p1))) THEN
          BEGIN
            IF NOT(Has(moveable_at)) THEN dstr:=dstr+', '+Noun(name.GetText,nom,t,copies)+' enth'+lae_kc+'lt:\n'
                                     ELSE BEGIN
                                            dstr:=dstr+', in '+Noun(name.GetText,dat,t,copies);
                                            IF weight.counter>1 THEN dstr:=dstr+' liegen:\n'
                                                             ELSE dstr:=dstr+' liegt:\n';
                                          END;
            Print(dstr);
            INC(x,2);
            ShowItems(held,x,p1);
            x:=1;
          END ELSE BEGIN
                     IF NOT(Has(moveable_at)) THEN
                     BEGIN
                       j:=1;
                       WHILE dstr[j]<>' ' DO INC(j);
                       IF dstr[j-1]='e' THEN INSERT(' leere',dstr,j)
                                        ELSE INSERT(' leeres',dstr,j);
                     END;
                     Print(dstr+'\n');
                   END;
        END ELSE Print(dstr+'.\n');
        IF copies>1 THEN
        BEGIN
          FOR j:=0 TO list.COUNT-1 DO
          BEGIN
            p2:=list.At(j);
            IF p2^.name.GetText=name.GetText THEN p2^.flag:=t;
          END;
        END;
      END;
    END;
  END;
END;

FUNCTION SwapDir(d1 : TDir) : TDir;
VAR
  d2 : TDir;
BEGIN
  CASE d1 OF
    north     : d2:=south;
    northeast : d2:=southwest;
    east      : d2:=west;
    southeast : d2:=northwest;
    south     : d2:=north;
    southwest : d2:=northeast;
    west      : d2:=east;
    northwest : d2:=southeast;
    up        : d2:=down;
    down      : d2:=up;
    ELSE d2:=nowhere;
  END;
  SwapDir:=d2;
END;

{****************************************************************************}
{* Pointer, Word und Boolean fuer Store und Load nach Byte konvertieren     *}
{****************************************************************************}

PROCEDURE WriteWord(VAR h : File; w : WORD);
VAR
  b1,b2 : BYTE;
BEGIN
  b1:=w DIV 256;
  b2:=w-256*b1;
  BLOCKWRITE(h,b1,1);
  BLOCKWRITE(h,b2,1);
END;

PROCEDURE ReadWord(VAR h : File; VAR w : WORD);
VAR
  b1,b2 : BYTE;
BEGIN
  BLOCKREAD(h,b1,1);
  BLOCKREAD(h,b2,1);
  w:=b1*256+b2;
END;

PROCEDURE WritePtr(VAR h : File; p : PBasic);
VAR
  zero : BYTE;
  n    : WORD;
BEGIN
  IF p<>NIL THEN
  BEGIN
    zero:=1;
    n:=p^.id;
  END ELSE BEGIN
             zero:=0;
             n:=0;
           END;
  BLOCKWRITE(h,zero,1);
  WriteWord(h,n);
END;

FUNCTION ReadPtr(VAR h : File) : POINTER;
VAR
  zero : BYTE;
  n    : WORD;
BEGIN
  BLOCKREAD(h,zero,1);
  ReadWord(h,n);
  IF zero=1 THEN ReadPtr:=Adr(n)
            ELSE ReadPtr:=NIL;
END;

PROCEDURE WriteScale(VAR h : File; s : TWeight);
BEGIN
  WITH s DO
  BEGIN
    BLOCKWRITE(h,counter,1);
    BLOCKWRITE(h,wsum,1);
    BLOCKWRITE(h,wmax,1);
  END;
END;

PROCEDURE ReadScale(VAR h : File; VAR s : TWeight);
BEGIN
  WITH s DO
  BEGIN
    BLOCKREAD(h,counter,1);
    BLOCKREAD(h,wsum,1);
    BLOCKREAD(h,wmax,1);
  END;
END;

PROCEDURE WriteBool(VAR h : File; v : Boolean);
VAR
  b : BYTE;
BEGIN
  IF v THEN b:=1
       ELSE b:=0;
  BLOCKWRITE(h,b,1);
END;

PROCEDURE ReadBool(VAR h : File; VAR v : Boolean);
VAR
  b : BYTE;
BEGIN
  BLOCKREAD(h,b,1);
  v:=b=1;
END;

PROCEDURE ReadDir(VAR h : File; VAR d1 : TDir);
VAR
  d2 : BYTE;
BEGIN
  BLOCKREAD(h,d2,1);
  CASE d2 OF
    0  : d1:=nowhere;
    1  : d1:=north;
    2  : d1:=northeast;
    3  : d1:=east;
    4  : d1:=southeast;
    5  : d1:=south;
    6  : d1:=southwest;
    7  : d1:=west;
    8  : d1:=northwest;
    9  : d1:=up;
    10 : d1:=down;
  END;
END;

PROCEDURE WriteDir(VAR h : File; d1 : TDir);
VAR
  d2 : BYTE;
BEGIN
  CASE d1 OF
    north     : d2:=1;
    northeast : d2:=2;
    east      : d2:=3;
    southeast : d2:=4;
    south     : d2:=5;
    southwest : d2:=6;
    west      : d2:=7;
    northwest : d2:=8;
    up        : d2:=9;
    down      : d2:=10;
    ELSE d2:=0;
  END;
  BLOCKWRITE(h,d2,1);
END;

{****************************************************************************}
{* TWeight verwaltet das Gewicht von Behltern und des Spielers             *}
{****************************************************************************}

CONSTRUCTOR TWeight.Init(_owner : POINTER; _min,_max : BYTE);
BEGIN
  owner:=_owner;
  counter:=0;
  wsum:=_min;
  wmax:=_max;
END;

{
  inkrementiert das Gewicht eines Behaelters, wenn er Objekt x aufnimmt
}
PROCEDURE TWeight.Pick(x : POINTER; VAR error : BOOLEAN);
VAR
  d : BYTE;
  p : PItem;
BEGIN
  error:=f;
  IF x=player THEN d:=player^.weight.wsum
              ELSE d:=PItem(x)^.weight.wsum;
  IF owner<>player THEN  { Behaelter befindet sich in anderem Behaelter }
  BEGIN                  { oder wird vom Spieler getragen }
    p:=PItem(owner);
    IF p^.inside<>NIL THEN p^.inside^.weight.Pick(x,error);
    IF (p^.inside=NIL) AND (p^.location=NIL) THEN player^.weight.Pick(x,error);
  END ELSE IF player^.inside<>NIL THEN player^.inside^.weight.Pick(x,error);
  IF NOT(error) THEN
  BEGIN
    INC(counter);
    INC(wsum,d);
  END;
END;

{
  dekrementiert das Gewicht eines Behaelters, wenn Objekt x entfernt wird
}
PROCEDURE TWeight.Drop(x : POINTER);
VAR
  d : BYTE;
  p : PItem;
BEGIN
  IF x=player THEN d:=player^.weight.wsum
              ELSE d:=PItem(x)^.weight.wsum;
  IF owner<>player THEN  { Behaelter befindet sich in anderem Behaelter }
  BEGIN                  { oder wird vom Spieler getragen }
    p:=PItem(owner);
    IF p^.inside<>NIL THEN p^.inside^.weight.Drop(x);
    IF (p^.inside=NIL) AND (p^.location=NIL) THEN player^.weight.Drop(x);
  END ELSE IF player^.inside<>NIL THEN player^.inside^.weight.Drop(x);
  DEC(counter);
  DEC(wsum,d);
END;

FUNCTION TWeight.GetCont : BYTE;
BEGIN
  GetCont:=counter;
END;

FUNCTION TWeight.GetSum : BYTE;
BEGIN
  GetSum:=wsum;
END;

FUNCTION TWeight.GetMax : BYTE;
BEGIN
  GetMax:=wmax;
END;

DESTRUCTOR TWeight.Done;
BEGIN
END;

{****************************************************************************}
{* Methoden des Basisobjekts                                                *}
{****************************************************************************}

CONSTRUCTOR TBasic.Init(_id : WORD; _name : STRING; _objclass : T_Class);
BEGIN
  id:=_id;
  name.Init;
  name.SetText(_name,t);
  _class:=_objclass;
  copies:=1;
  counter:=0;
  daemon:=f;
  timer:=f;
  flag:=f;
  lock:=NIL;
  tracing:=f;
  NEW(objtext,INIT);
  list.INSERT(@SELF);
END;

PROCEDURE TBasic.Store(VAR h : File);
BEGIN
  BLOCKWRITE(h,counter,1);
  BLOCKWRITE(h,copies,1);
  WriteBool(h,daemon);
  WriteBool(h,timer);
  IF lock<>NIL THEN lock^.Store(h);
END;

PROCEDURE TBasic.Load(VAR h : File);
BEGIN
  BLOCKREAD(h,counter,1);
  BLOCKREAD(h,copies,1);
  ReadBool(h,daemon);
  ReadBool(h,timer);
  IF lock<>NIL THEN lock^.Load(h);
END;

FUNCTION TBasic.GetID : WORD;
BEGIN
  GetID:=id;
END;

FUNCTION TBasic.GetClass : T_Class;
BEGIN
  GetClass:=_class;
END;

FUNCTION TBasic.GetCopies : BYTE;
BEGIN
  GetCopies:=copies;
END;



PROCEDURE TBasic.MyText;
BEGIN
END;

PROCEDURE TBasic.Reset;
BEGIN
  flag:=f;
END;

PROCEDURE TBasic.AddText(str : STRING);
BEGIN
  objtext^.SetText(str,f);
END;

PROCEDURE TBasic.TextOut;
BEGIN
  IF objtext^.HasText THEN objtext^.PrintText
                      ELSE MyText;
END;

PROCEDURE TBasic.DelText;
BEGIN
END;

PROCEDURE TBasic.StartDaemon;
BEGIN
  daemon:=t;
END;

PROCEDURE TBasic.RunDaemon;
BEGIN
END;

FUNCTION TBasic.HasDaemon : BOOLEAN;
BEGIN
  HasDaemon:=daemon;
END;

PROCEDURE TBasic.StopDaemon;
BEGIN
  daemon:=f;
END;

PROCEDURE TBasic.StartTimer(rounds : BYTE);
BEGIN
  counter:=rounds;
  timer:=t;
END;

PROCEDURE TBasic.RunTimer;
BEGIN
  IF counter=0 THEN
  BEGIN
    TimeOut;
    timer:=f;
  END ELSE DEC(counter);
END;

PROCEDURE TBasic.TimeOut;
BEGIN
END;

PROCEDURE TBasic.StopTimer;
BEGIN
  timer:=f;
END;

FUNCTION TBasic.HasTimer : BOOLEAN;
BEGIN
  HasTimer:=timer;
END;

PROCEDURE TBasic.ObscureEvents;
BEGIN 
  IF daemon=t THEN RunDaemon;
  IF timer=t THEN RunTimer;
END;

FUNCTION TBasic.Scope : BYTE;
BEGIN
  Scope:=0;
END;

PROCEDURE TBasic.Inspect;
BEGIN
  IF tracing THEN WRITE(ShortName(name.GetText,0)+' '+sdstr[Scope]);
END;

PROCEDURE TBasic.HandleEvent(VAR event : TEvent);
BEGIN
  WITH event DO
  BEGIN
    CASE action OF
      dance_ev,
      jump_ev    : game^.Admonition(player^.adress);
      examine_ev : BEGIN
                     TextOut;
                     IF NOT(replay) THEN Print('An '+Noun(name.GetText,dat,t,1)+' ist nichts Besonderes zu entdecken.\n');
                   END;
      smell_ev   : Print('Hier ist nichts zu riechen.\n');
      touch_ev   : return:=t;
      dec_ev,
      trace_ev,
      lists_ev   : BEGIN
                     WITH first^ DO
                     BEGIN
                       IF (xitem=@SELF) OR
                          (xroom=@SELF) OR
                          (xlink=@SELF) THEN
                       BEGIN
                         IF action=dec_ev THEN Declension(name.GetText);
                         IF action=trace_ev THEN tracing:=NOT(tracing);
                         IF action=lists_ev THEN View;
                         replay:=t;
                         return:=t;
                       END;
                     END;
                   END;
      ELSE game^.HandleEvent(event);
    END;
  END;
END;

PROCEDURE TBasic.View;
BEGIN
  WRITELN('Name:   '+name.GetText);
  WRITELN('Scope:  '+sdstr[Scope]);
  WRITE('Text:   ');
  IF objtext^.HasText THEN WRITELN('konstant')
                      ELSE WRITELN('variabel');
  WRITELN('Daemon: '+boolstr[daemon]);
  WRITE('Timer:  '+boolstr[timer]);
  IF timer THEN WRITELN('(noch '+NumToSTR(counter)+' Runden)')
           ELSE SYSTEM.WRITELN;
END;

DESTRUCTOR TBasic.Done;
BEGIN
  name.Done;
  IF lock<>NIL THEN lock^.Done;
  objtext^.Done;
END;

{****************************************************************************}
{* TRoom                                                                    *}
{****************************************************************************}

CONSTRUCTOR TRoom.Init(_id : WORD; _name : STRING);
VAR
  i : TDir;
BEGIN
  TBasic.Init(_id,_name,room);
  SetLight(t);
  explored:=f;
  wto:=nowhere;
  wfrom:=nowhere;
  FOR i:=north TO down DO gate[i]:=NIL;
END;

PROCEDURE TRoom.Store(VAR h : File);
VAR
  i : TDir;
BEGIN
  FOR i:=north TO down DO IF gate[i]<>NIL THEN gate[i]^.Store(h);
  WriteDir(h,wto);
  WriteDir(h,wfrom);
  WriteBool(h,light);
  WriteBool(h,explored);
END;

PROCEDURE TRoom.Load(VAR h : File);
VAR
  i : TDir;
BEGIN
  FOR i:=north TO down DO IF gate[i]<>NIL THEN gate[i]^.Load(h);
  ReadDir(h,wto);
  ReadDir(h,wfrom);
  ReadBool(h,light);
  ReadBool(h,explored);
END;

FUNCTION TRoom.HasLight : BOOLEAN;
VAR
  p  : PItem;
  i  : WORD;
  ok : BOOLEAN;
BEGIN
  IF NOT(light) THEN
  BEGIN
    i:=0;
    ok:=f;
    WHILE (NOT(ok)) AND (i<list.count) DO
    BEGIN
      p:=list.At(i);
      WITH p^ DO
      BEGIN
        ok:=(_class=item) AND (Has(shining_at)) AND (Scope>0) AND ((inside=NIL) OR
            (inside^.lock=NIL) OR (inside^.lock^.state=open) OR
            (inside^.Has(transparent_at)));
      END;
      INC(i);
    END;
    HasLight:=ok;
  END ELSE HasLight:=t;
END;

PROCEDURE TRoom.SetLight(_light : BOOLEAN);
BEGIN
  light:=_light;
  IF (light=f) AND (game<>NIL) THEN game^.DrawStatusLine(f);
END;

FUNCTION TRoom.IsGate(d : TDir) : TState;
BEGIN
  IF gate[d]<>NIL THEN
  BEGIN
    IF gate[d]^.lock<>NIL THEN IsGate:=gate[d]^.lock^.GetState
                          ELSE IsGate:=open;
  END ELSE Warning('Keine Verbindung in '+ShortName(name.GetText,0));
END;

PROCEDURE TRoom.CountLinks;
VAR
  i,j : TDir;
BEGIN
  FOR i:=north TO northwest DO
  BEGIN
    FOR j:=SUCC(i) TO northwest DO
    BEGIN
      IF (gate[i]<>NIL) AND (gate[j]<>NIL) THEN
      BEGIN
        IF gate[i]^.name.GetText=gate[j]^.name.GetText THEN
        BEGIN
          INC(gate[i]^.copies);
          INC(gate[j]^.copies);
        END;
      END;
    END;
  END;
END;

PROCEDURE TRoom.MyDarkness;
BEGIN
END;

PROCEDURE TRoom.RoomDescription;
  PROCEDURE InsLF(VAR line : STRING);
  VAR
    i,j : BYTE;
    w   : WORD;
  BEGIN
    w:=maxcol-1;
    FOR i:=1 TO 3 DO
    BEGIN
      IF LENGTH(line)>w THEN
      BEGIN
        j:=w;
        WHILE (j>1) AND (line[j]<>' ') DO DEC(j);
        IF j>1 THEN INSERT('\n',line,j);
        w:=j+maxcol-1;
      END;
    END;
    line:=line+'\n';
  END;
  PROCEDURE InsAnd(VAR line : STRING);  { 'und' in Aufzaehlung einfuegen }
  VAR
    i : BYTE;
  BEGIN
    i:=LENGTH(line);
    WHILE (i>1) AND (line[i]<>',') DO DEC(i);
    IF i>1 THEN
    BEGIN
      DELETE(line,i,1);
      INSERT(' und',line,i);
    END;
  END;
CONST
  s1 : ARRAY[1..2] OF TDir = (north,up);
  s2 : ARRAY[1..2] OF TDir = (northwest,down);
VAR
  i,j  : TDir;
  m,n  : BYTE;
  str  : STRING;
BEGIN
  game^.DrawStatusline(t);
  IF (HasLight) AND (NOT(explored) OR (game^.IsVerbose)) THEN
  BEGIN
    TextOut;
    str:='';
    FOR m:=1 TO 2 DO
    BEGIN
      n:=0;
      FOR i:=s1[m] TO s2[m] DO
      BEGIN
        IF gate[i]<>NIL THEN
        BEGIN
          WITH gate[i]^ DO
          BEGIN
            IF (show) AND (copies=1) THEN
            BEGIN
              INC(n);
              IF m=1 THEN
              BEGIN
                str:=str+'im '+dirstr[i]+' ';
                IF n=1 THEN str:=str+'befindet sich ';
                str:=str+Noun(name.GetText,nom,f,copies)+', ';
              END ELSE BEGIN
                         str:=str+Noun(name.GetText,nom,f,copies);
                         IF n=1 THEN str:=str+' f'+lue_kc+'hrt ';
                         str:=str+'nach '+dirstr[i]+', ';
                       END;
            END;
          END;
        END;
      END;
      DELETE(str,LENGTH(str)-1,2);
      InsAnd(str);
      IF str<>'' THEN str:=str+'. ';
    END;
    FOR i:=north TO northwest DO
    BEGIN
      IF (gate[i]<>NIL) AND (gate[i]^.show) AND (gate[i]^.copies>1) THEN
      BEGIN
        str:=str+Noun(gate[i]^.name.GetText,nom,f,gate[i]^.copies)
                      +' befinden sich im '+dirstr[i];
        FOR j:=north TO northwest DO
        BEGIN
          IF (i<>j) AND (gate[i]^.name.GetText=gate[j]^.name.GetText) THEN
          BEGIN
            str:=str+', '+dirstr[j];
            gate[j]^.copies:=1;
          END;
        END;
      END;
    END;
    IF POS('befinden',str)>0 THEN
    BEGIN
      InsAnd(str);
      str:=str+'. ';
    END;
    IF gate[up]<>NIL THEN
    BEGIN
      WITH gate[up]^ DO
      BEGIN
        IF (show) AND (copies>1) THEN str:=str+Noun(name.GetText,nom,f,copies)+' f'+lue_kc+'hren nach oben und unten.';
      END;
    END;
    IF str<>'' THEN
    BEGIN
      WithUpcase(str);
      IF COPY(str,LENGTH(str)-1,2)<>'\n' THEN InsLF(str);
      Print(str);
    END;
    m:=1;
    CountItems(player^.position);
    ShowItems(f,m,NIL);
    ResetAll;
  END ELSE IF NOT(HasLight) THEN MyDarkness;
  explored:=t;
END;

FUNCTION TRoom.ToDir : TDir;
BEGIN
  ToDir:=wto;
END;

FUNCTION TRoom.FromDir : TDir;
BEGIN
  FromDir:=wfrom;
END;

FUNCTION TRoom.BeforeAction(event : TEvent) : BOOLEAN;
BEGIN
  BeforeAction:=t;
END;

FUNCTION TRoom.AfterAction(event : TEvent) : BOOLEAN;
BEGIN
  AfterAction:=t;
END;

PROCEDURE TRoom.HandleEvent(VAR event : TEvent);
VAR
  error : BOOLEAN;
  dummy : TEvent;
  where : PRoom;
  str   : STRING;
  dir   : TDir;
BEGIN
  str:='';
  WITH event DO
  BEGIN
    CASE action OF
      go_ev   : BEGIN
                  dir:=TDir(data^);  { Wohin will der Spieler oder NPC? }
                  IF who=NIL THEN wto:=dir;
                  IF gate[dir]<>NIL THEN
                  BEGIN
                    {
                      Im Weg befindliche Tuer oeffnen
                    }
                    error:=f;
                    IF gate[dir]^.lock<>NIL THEN
                    BEGIN
                      IF gate[dir]^.lock^.state<>open THEN
                      BEGIN
                        dummy:=event;
                        dummy.action:=open_ev;
                        gate[dir]^.HandleEvent(dummy);
                        error:=gate[dir]^.lock^.state<>open;
                      END;
                    END;
                    IF NOT(error) THEN
                    BEGIN
                      IF gate[dir]^.r1=player^.position THEN where:=gate[dir]^.r2
                                                        ELSE where:=gate[dir]^.r1;
                      IF BeforeAction(event) THEN
                      BEGIN
                        IF who<>NIL THEN who^.MoveItemTo(where)
                                    ELSE BEGIN
                                           player^.MovePlayerTo(where);
                                           where^.wfrom:=SwapDir(wto);
                                         END;
                        IF AfterAction(event) THEN
                        BEGIN
                          IF who<>NIL THEN
                          BEGIN
                            CASE player^.adress OF
                              du  : str:=Noun(who^.name.GetText,nom,t,1)+
                                         ' verl'+lae_kc+ss_kc+'t dich und geht nach '+dirstr[dir];
                              sie : str:=Noun(who^.name.GetText,nom,t,1)+
                                         ' verl'+lae_kc+ss_kc+'t Sie und geht nach '+dirstr[dir];
                              ihr : str:=Noun(who^.name.GetText,nom,t,1)+
                                         ' verl'+lae_kc+ss_kc+'t Euch und geht nach '+dirstr[dir];
                            END;
                            Print('\b'+str+'.\n');
                          END ELSE replay:=t;
                        END;
                      END;
                    END;
                  END ELSE game^.ParserError(15,'',1,error);
                END;
      look_ev : IF player^.position=@SELF THEN
                BEGIN
                  IF BeforeAction(event) THEN
                  BEGIN
                    explored:=f;
                    Roomdescription;
                    AfterAction(event);
                  END;
                END;
      ELSE TBasic.HandleEvent(event);
    END;
  END;
END;

{
  Raeume sind fuer den Akteur nur sichtbar, wenn er sich in ihnen befindet
}
FUNCTION TRoom.Scope : BYTE;
BEGIN
  IF game^.ActorWhere=@SELF THEN scope:=visible_sd
                            ELSE scope:=notinroom_sd;
END;

PROCEDURE TRoom.View;
VAR
  i : TDir;
BEGIN
  TBasic.View;
  WRITELN('Licht: '+boolstr[light]);
  WRITELN('Besucht: '+boolstr[explored]);
  FOR i:=north TO down DO
  BEGIN
    IF gate[i]<>NIL THEN
    BEGIN
      WRITE(dirstr[i]+': ');
      IF gate[i]^.r1=@SELF THEN WRITE(ShortName(gate[i]^.r2^.name.GetText,2))
                           ELSE WRITE(ShortName(gate[i]^.r1^.name.GetText,2));
      IF gate[i]^.lock<>NIL THEN WRITELN(' ('+lockstr[gate[i]^.lock^.state]+')')
                            ELSE SYSTEM.WRITELN;
    END;
  END;
END;

DESTRUCTOR TRoom.Done;
BEGIN
END;

{****************************************************************************}
{* TLock stellt Schloesser fuer Tueren und Behaelter dar                    *}
{****************************************************************************}

CONSTRUCTOR TLock.Init(_owner : PBasic; _openable,_closeable : BOOLEAN; _state : TState; _key : PItem);
VAR
  container : PItem;
  door      : PLink;
BEGIN
  closeable:=_closeable;
  openable:=_openable;
  state:=_state;
  key:=_key;
  owner:=_owner;
  CASE owner^._class OF
    link : BEGIN
             door:=Adr(owner^.id);
             door^.lock:=@SELF;
           END;
    item : BEGIN
             container:=Adr(owner^.id);
             container^.lock:=@SELF;
           END;
    room : Warning('Objekt '+NumToStr(owner^.id)+' kann kein Schlo'+ss_kc+' zugewiesen werden');
  END;
END;

PROCEDURE TLock.Store(VAR h : File);
BEGIN
  WriteBool(h,openable);
  WriteBool(h,closeable);
  BLOCKWRITE(h,BYTE(state),1);
END;

PROCEDURE TLock.Load(VAR h : File);
BEGIN
  ReadBool(h,openable);
  ReadBool(h,closeable);
  BLOCKREAD(h,BYTE(state),1);
END;

FUNCTION TLock.GetKey : PItem;
BEGIN
  GetKey:=key;
END;

FUNCTION TLock.GetOwner : PBasic;
BEGIN
  GetOwner:=Owner;
END;

FUNCTION TLock.GetState : TState;
BEGIN
  GetState:=state;
END;

FUNCTION TLock.IsOpenable : BOOLEAN;
BEGIN
  IsOpenable:=openable;
END;

FUNCTION TLock.IsCloseable : BOOLEAN;
BEGIN
  IsCloseable:=closeable;
END;

PROCEDURE TLock.SetCloseable(s : BOOLEAN);
BEGIN
  closeable:=s;
END;

PROCEDURE TLock.SetOpenable(s : BOOLEAN);
BEGIN
  openable:=s;
END;

PROCEDURE TLock.SetState(s : TState);
BEGIN
  state:=s;
END;

{
  Stellt fest, ob Akteur benoetigten Schluessel traegt
}

FUNCTION TLock.HasKey(event : Tevent) : BOOLEAN;
VAR
  ok : BOOLEAN;
BEGIN
  ok:=f;
  WITH event DO
  BEGIN
    IF key<>NIL THEN
    BEGIN
      IF second<>NIL THEN
      BEGIN
        IF second^.xitem<>NIL THEN
        BEGIN
          IF second^.xitem=key THEN
          BEGIN
            IF who=NIL THEN ok:=key^.location=NIL
                       ELSE ok:=key^.inside=who;

          END;
        END;
      END ELSE BEGIN
                 IF who=NIL THEN ok:=key^.location=NIL
                            ELSE ok:=key^.inside=who;
               END;
    END ELSE ok:=t;
  END;
  HasKey:=ok;
END;

FUNCTION TLock.BeforeAction(event : TEvent) : BOOLEAN;
BEGIN
  BeforeAction:=t;
END;

FUNCTION TLock.AfterAction(event : TEvent) : BOOLEAN;
BEGIN
  AfterAction:=t;
END;

PROCEDURE TLock.HandleEvent(VAR event : TEvent);
VAR
  error : BOOLEAN;
  str   : STRING;
BEGIN
  error:=f;
  str:='';
  WITH event DO
  BEGIN
    CASE action OF
      open_ev  : IF openable THEN
                 BEGIN
                   CASE state OF
                     open   : game^.ParserError(20,owner^.name.GetText,1,error);
                     closed : IF BeforeAction(event) THEN
                              BEGIN
                                state:=open;
                                IF AfterAction(event) THEN
                                BEGIN
                                  IF who=NIL THEN
                                  BEGIN
                                    CASE player^.adress OF
                                      du  : str:='Du '+loe_kc+'ffnest '+Noun(owner^.name.GetText,acc,t,1);
                                      sie : str:='Sie '+loe_kc+'ffnen '+Noun(owner^.name.GetText,acc,t,1);
                                      ihr : str:='Ihr '+loe_kc+'ffnet '+Noun(owner^.name.GetText,acc,t,1);
                                    END;
                                  END ELSE str:='\b'+Noun(who^.name.GetText,nom,t,1)+
                                                ' '+loe_kc+'ffnet '+Noun(owner^.name.GetText,acc,t,1);
                                  Print(str+'.\n');
                                END;
                              END;
                     locked : IF HasKey(event) THEN
                              BEGIN
                                IF BeforeAction(event) THEN
                                BEGIN
                                  IF second=NIL THEN Print('(mit '+Noun(key^.name.GetText,dat,t,1)+')\n');
                                  state:=open;
                                  IF AfterAction(event) THEN
                                  BEGIN
                                    IF who=NIL THEN
                                    BEGIN
                                      CASE player^.adress OF
                                        du  : str:='Du '+loe_kc+'ffnest '+Noun(owner^.name.GetText,acc,t,1);
                                        sie : str:='Sie '+loe_kc+'ffnen '+Noun(owner^.name.GetText,acc,t,1);
                                        ihr : str:='Ihr '+loe_kc+'ffnet '+Noun(owner^.name.GetText,acc,t,1);
                                      END;
                                    END ELSE str:='\b'+Noun(who^.name.GetText,nom,t,1)+
                                                  ' '+loe_kc+'ffnet '+Noun(owner^.name.GetText,acc,t,1);
                                    Print(str+'.\n');
                                  END;
                                END;
                              END ELSE game^.ParserError(21,owner^.name.GetText,1,error);
                   END;
                 END ELSE game^.ParserError(9,'',1,error);
      close_ev : IF closeable THEN
                 BEGIN
                   CASE state OF
                     open  : IF BeforeAction(event) THEN
                             BEGIN
                               state:=closed;
                               IF AfterAction(event) THEN
                               BEGIN
                                 IF who=NIL THEN
                                 BEGIN
                                   CASE player^.adress OF
                                     du  : str:='Du schlie'+ss_kc+'t '+Noun(owner^.name.GetText,acc,t,1);
                                     sie : str:='Sie schlie'+ss_kc+'en '+Noun(owner^.name.GetText,acc,t,1);
                                     ihr : str:='Ihr schlie'+ss_kc+'t '+Noun(owner^.name.GetText,acc,t,1);
                                   END;
                                 END ELSE str:='\b'+Noun(who^.name.GetText,nom,t,1)+
                                               ' schlie'+ss_kc+'t '+Noun(owner^.name.GetText,acc,t,1);
                                 Print(str+'.\n');
                               END;
                             END;
                     closed,
                     locked : game^.ParserError(24,owner^.name.GetText,1,error);
                   END;
                 END ELSE game^.ParserError(9,'',1,error);
      lock_ev  : IF (closeable) AND (HasKey(event)) THEN
                 BEGIN
                   CASE state OF
                     open,
                     closed  : IF BeforeAction(event) THEN
                               BEGIN
                                 IF second=NIL THEN Print('(mit '+Noun(key^.name.GetText,dat,t,1)+')\n');
                                 state:=locked;
                                 IF AfterAction(event) THEN
                                    Print('\b'+Noun(owner^.name.GetText,nom,t,1)+' ist jetzt verschlossen.\n');
                               END;
                     locked  : game^.ParserError(22,owner^.name.GetText,1,error);
                   END;
                 END ELSE game^.ParserError(9,'',1,error);
    END;
    return:=NOT(error);
  END;
END;

PROCEDURE TLock.View;
BEGIN
  WRITE('Zustand: '+lockstr[state]);
  IF key<>NIL THEN WRITELN('  Schl'+lue_kc+'ssel: '+ShortName(key^.name.GetText,2))
              ELSE WRITELN;
END;

DESTRUCTOR TLock.Done;
BEGIN
END;

{****************************************************************************}
{* TLink                                                                    *}
{****************************************************************************}

CONSTRUCTOR TLink.Init(_id : WORD; _name : STRING; _from : WORD; _dirto : TDir; _to : WORD; _show : BOOLEAN);
VAR
  dir_from : TDir;
  error    : STRING;
BEGIN
  TBasic.Init(_id,_name,link);
  r1:=Adr(_from);
  r2:=Adr(_to);
  error:=NumToStr(r1^.GetID)+' und '+NumToStr(r2^.GetID)+' sind bereits verbunden';
  dir_from:=SwapDir(_dirto);
  IF r1^.gate[_dirto]=NIL THEN r1^.gate[_dirto]:=@SELF
                          ELSE Warning(error);
  IF r2^.gate[dir_from]=NIL THEN r2^.gate[dir_from]:=@SELF
                            ELSE Warning(error);
  show:=_show;
END;

PROCEDURE TLink.Store(VAR h : File);
BEGIN
  TBasic.Store(h);
  WritePtr(h,r1);
  WritePtr(h,r2);
  WriteBool(h,show);
END;

PROCEDURE TLink.Load(VAR h : File);
BEGIN
  TBasic.Load(h);
  r1:=PRoom(ReadPtr(h));
  r2:=PRoom(ReadPtr(h));
  ReadBool(h,show);
END;

FUNCTION TLink.HasAutoDescription : BOOLEAN;
BEGIN
  HasAutoDescription:=show;
END;

FUNCTION TLink.BeforeAction(VAR event : TEvent) : BOOLEAN;
BEGIN
  BeforeAction:=t;
END;

FUNCTION TLink.AfterAction(VAR event : TEvent) : BOOLEAN;
BEGIN
  AfterAction:=t;
END;

PROCEDURE TLink.HandleEvent(VAR event : TEvent);
BEGIN
  WITH event DO
  BEGIN
    CASE action OF
      open_ev,
      close_ev,
      lock_ev   : IF lock<>NIL THEN lock^.HandleEvent(event);
      ELSE TBasic.HandleEvent(event);
    END;
  END;
END;

FUNCTION TLink.Scope : BYTE;
VAR
  r : BYTE;
BEGIN
  IF (game^.ActorWhere=r1) OR (game^.ActorWhere=r2) THEN
  BEGIN
    IF game^.ActorInside(NIL) THEN r:=reachable_sd
                              ELSE r:=visible_sd;
  END ELSE r:=notinroom_sd;
  scope:=r;
END;

PROCEDURE TLink.View;
BEGIN
  TBasic.View;
  WRITELN('Sichtbar: '+boolstr[show]+' ');
  WRITELN('Verbindet <'+r1^.name.GetText+'> mit <'+r2^.name.GetText+'>');
  IF lock<>NIL THEN lock^.View;
END;

DESTRUCTOR TLink.Done;
BEGIN
END;

{****************************************************************************}
{* TItem stellt alles dar, was kein Raum, Durchgang oder Schloss ist        *}
{****************************************************************************}

CONSTRUCTOR TItem.Init(_id : WORD; _name : STRING; _location : PBasic; _show : BOOLEAN; _wmin,_wmax : BYTE);
BEGIN
  TBasic.Init(_id,_name,item);
  weight.Init(@SELF,_wmin,_wmax);
  inside:=NIL;
  MoveItemTo(_location);
  show:=_show;
  matter:=inanimate;
  pstart:=NIL;
  amount:=1;
  praepos:='in';
  on:=f;
END;

PROCEDURE TItem.Store(VAR h : File);
VAR
  m   : PAttrib;
  i,j : BYTE;
BEGIN
  TBasic.Store(h);
  WritePtr(h,location);
  WritePtr(h,inside);
  BLOCKWRITE(h,BYTE(matter),1);
  WriteBool(h,show);
  m:=pstart;
  i:=0;
  WHILE m<>NIL DO
  BEGIN
    m:=m^.next;
    INC(i);
  END;
  BLOCKWRITE(h,i,1);
  IF i>0 THEN
  BEGIN
    m:=pstart;
    WHILE m<>NIL DO
    BEGIN
      BLOCKWRITE(h,m^.attribute,1);
      m:=m^.next;
    END;
  END;
  WriteBool(h,on);
  BLOCKWRITE(h,amount,1);
  WriteScale(h,weight);
END;

PROCEDURE TItem.ListMe(s : BOOLEAN);
BEGIN
  show:=s;
END;

PROCEDURE TItem.Load(VAR h : File);
VAR
  i,j,k : BYTE;
BEGIN
  TBasic.Load(h);
  location:=PRoom(ReadPtr(h));
  inside:=PItem(ReadPtr(h));
  BLOCKREAD(h,BYTE(matter),1);
  ReadBool(h,show);
  ClearAttributes;
  BLOCKREAD(h,i,1);
  IF i>0 THEN
  BEGIN
    FOR j:=1 TO i DO
    BEGIN
      BLOCKREAD(h,k,1);
      SetAttrib(k,t);
    END;
  END;
  ReadBool(h,on);
  BLOCKREAD(h,amount,1);
  ReadScale(h,weight);
END;

FUNCTION TItem.GetLocation : PRoom;
BEGIN
  GetLocation:=location;
END;

FUNCTION TItem.GetContainer : PItem;
BEGIN
  GetContainer:=inside;
END;

FUNCTION TItem.GetMatter : TMatter;
BEGIN
  GetMatter:=matter;
END;

FUNCTION TItem.GetContent : BYTE;
BEGIN
  GetContent:=weight.counter;
END;

FUNCTION TItem.GetWeight : BYTE;
BEGIN
  GetWeight:=weight.wsum;
END;

FUNCTION TItem.GetMaxWeight : BYTE;
BEGIN
  GetMaxWeight:=weight.wmax;
END;

FUNCTION TItem.HasAutoDescription : BOOLEAN;
BEGIN
  HasAutoDescription:=show;
END;

PROCEDURE TItem.SetPraepos(pp : STRING);
BEGIN
  praepos:=pp;
END;

FUNCTION TItem.IsOn : BOOLEAN;
BEGIN
  IsOn:=on;
END;

FUNCTION TItem.IsOff : BOOLEAN;
BEGIN
  IsOff:=NOT(on);
END;

PROCEDURE TItem.SwitchOn;
BEGIN
  IF Has(switchable_at) THEN on:=t
                ELSE Warning(NumToStr(id)+' kann nicht ein-/ausgeschaltet werden');
END;

PROCEDURE TItem.SwitchOff;
BEGIN
  IF Has(switchable_at) THEN on:=f
                ELSE Warning(NumToStr(id)+' kann nicht ein-/ausgeschaltet werden');
END;

PROCEDURE TItem.SetAmount(n : BYTE);
BEGIN
  amount:=n;
END;

FUNCTION TItem.GetAmount : BYTE;
BEGIN
  GetAmount:=amount;
END;

PROCEDURE TItem.Register;
VAR
  error : BOOLEAN;
BEGIN
  IF (location=NIL) AND
     (inside=NIL) THEN player^.weight.Pick(@SELF,error)
                  ELSE error:=f;
  IF error THEN HALT;
END;

{
  Setzen und berprfen von Eigenschaften
}
PROCEDURE TItem.SetAttrib(a : BYTE; _on : BOOLEAN);
VAR
  m1,m2 : PAttrib;
  ok    : BOOLEAN;
BEGIN
  IF _on THEN
  BEGIN
    IF NOT(Has(a)) THEN
    BEGIN
      m1:=pstart;
      IF m1<>NIL THEN WHILE m1^.next<>NIL DO m1:=m1^.next;
      NEW(m2);
      WITH m2^ DO
      BEGIN
        attribute:=a;
        prev:=m1;
        next:=NIL;
      END;
      IF m1<>NIL THEN m1^.next:=m2
                 ELSE pstart:=m2;
    END;
  END ELSE BEGIN
             ok:=f;
             m1:=pstart;
             WHILE (m1<>NIL) AND (NOT(ok)) DO
             BEGIN
               ok:=m1^.attribute=a;
               IF ok THEN
               BEGIN
                 IF m1^.prev<>NIL THEN m1^.prev^.next:=m1^.next;
                 IF m1^.next<>NIL THEN m1^.next^.prev:=m1^.prev;
                 DISPOSE(m1);
               END ELSE m1:=m1^.next;
             END;
           END;
END;

FUNCTION TItem.Has(p : BYTE) : BOOLEAN;
VAR
  m  : PAttrib;
  ok : BOOLEAN;
BEGIN
  ok:=f;
  m:=pstart;
  WHILE (m<>NIL) AND (NOT(ok)) DO
  BEGIN
    ok:=m^.attribute=p;
    m:=m^.next;
  END;
  Has:=ok;
END;

PROCEDURE TItem.ClearAttributes;
VAR
  m1,m2 : PAttrib;
BEGIN
  m1:=pstart;
  WHILE m1<>NIL DO
  BEGIN
    m2:=m1^.next;
    DISPOSE(m1);
    m1:=m2;
  END;
  pstart:=NIL;
END;

{
  Bestimmt ein Item als unbelebt, lebendig oder tot
}
PROCEDURE TItem.SeTMatter(state : TMatter);
BEGIN
  matter:=state;
END;

{
  Follow sorgt dafuer, dass Objekte, die sich in Behaeltern befinden oder
  von NPCs getragen werden, ihre Position mit ihren Behaeltern / Traegern
  veraendern.
}
PROCEDURE TItem.Follow;
VAR
  p1 : PBasic;
  p2 : PItem;
  i  : WORD;
BEGIN
  FOR i:=0 TO list.COUNT-1 DO
  BEGIN
    p1:=list.At(i);
    IF p1^._class=item THEN
    BEGIN
      p2:=list.At(i);
      IF p2^.inside=@SELF THEN p2^.location:=location;
    END;
  END;
END;

{
  MoveCmd veraendert die Position eines Objekts, wenn dieses genommen,
  weggelegt oder weggegeben wird. Hierbei werden immer BeforeAction
  und AfterAction aufgerufen.
}
PROCEDURE TItem.MoveCmd(where : POINTER; VAR event : TEvent);
VAR
  p1      : PBasic;
  p2      : PItem;
  error,d : BOOLEAN;
  str     : STRING;
  n       : BYTE;
BEGIN
  str:='';
  error:=f;
  d:=event.first^.number>1;  { Bestimmter oder unbestimmter Artikel }
  n:=event.first^.number;    { Anzahl zu bewegender Objekte }
  IF inside<>NIL THEN
  BEGIN
    {
      Wenn Objekt aus einem Behaelter entfernt wird
    }
    IF (inside^.lock=NIL) OR (inside^.lock^.state=open) THEN inside^.weight.Drop(@SELF)
                                                        ELSE game^.ParserError(19,inside^.name.GetText,1,error);
  END ELSE error:=f;
  IF NOT(error) THEN
  BEGIN
    IF where<>NIL THEN
    BEGIN
      p1:=where;
      IF p1^._class=room THEN
      BEGIN
        {
          Objekt wird abgelegt
        }
        IF BeforeAction(event) THEN
        BEGIN
          IF (inside=NIL) AND (event.who=NIL) THEN player^.weight.Drop(@SELF);
          location:=Adr(p1^.id);
          inside:=NIL;
          IF AfterAction(event) THEN
          BEGIN
            IF event.who=NIL THEN
            BEGIN
              CASE player^.adress OF
                du  : str:='Du legst '+Noun(name.GetText,acc,d,n)+' weg';
                sie : str:='Sie legen '+Noun(name.GetText,acc,d,n)+' weg';
                ihr : str:='Ihr legt '+Noun(name.GetText,acc,d,n)+' weg';
              END;
            END ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' legt '+Noun(name.GetText,acc,d,n)+' weg';
          END;
        END ELSE IF inside<>NIL THEN inside^.weight.Pick(@SELF,error);
      END ELSE IF p1^._class=item THEN
               BEGIN
                 {
                   Objekt wird in einen Behaelter gelegt oder von
                   einem NPC aufgenommen
                 }
                 p2:=where;
                 IF (p2^.lock=NIL) OR (p2^.lock^.state=open) THEN
                 BEGIN
                   p2^.weight.Pick(@SELF,error);
                   IF NOT(error) THEN
                   BEGIN
                     IF BeforeAction(event) THEN
                     BEGIN
                       IF (inside=NIL) AND (event.who=NIL) THEN player^.weight.Drop(@SELF);
                       location:=p2^.location;
                       inside:=p2;
                       IF AfterAction(event) THEN
                       BEGIN
                         IF event.who=NIL THEN
                         BEGIN
                           CASE player^.adress OF
                             du  : IF event.action=drop_ev THEN
                                      str:='Du legst '+Noun(name.GetText,acc,d,n)+' in '+Noun(p2^.name.GetText,acc,d,n)
                                      ELSE str:='Du gibst '+Noun(p2^.name.GetText,dat,t,1)+' '+Noun(name.GetText,acc,d,n);
                             sie : IF event.action=drop_ev THEN
                                      str:='Sie legen '+Noun(name.GetText,acc,d,n)+' in '+Noun(p2^.name.GetText,acc,t,1)
                                      ELSE str:='Sie geben '+Noun(p2^.name.GetText,dat,t,1)+' '+Noun(name.GetText,acc,d,n);
                             ihr : IF event.action=drop_ev THEN
                                      str:='Ihr legt '+Noun(name.GetText,acc,d,n)+' in '+Noun(p2^.name.GetText,acc,t,1)
                                      ELSE str:='Ihr gebt '+Noun(p2^.name.GetText,dat,t,1)+' '+Noun(name.GetText,acc,d,n);
                           END;
                         END ELSE IF p2^.matter=alive THEN str:=Noun(event.who^.name.GetText,nom,t,1)
                                                                 +' nimmt '+Noun(name.GetText,acc,d,n)
                                                       ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' legt '
                                                                 +Noun(name.GetText,acc,d,n)+' in '
                                                                 +Noun(p2^.name.GetText,acc,t,1);
                       END;
                     END ELSE p2^.weight.Drop(@SELF);
                   END;
                 END ELSE game^.ParserError(19,p2^.name.GetText,1,error);
               END ELSE Warning('Objekt '+NumToStr(id)+' kann nicht in '+NumToStr(p1^.id)+' abgelegt werden');
    END ELSE BEGIN
               {
                 Objekt wird vom Spieler genommen oder ihm gegeben
               }
               player^.weight.Pick(@SELF,error);
               IF NOT(error) THEN
               BEGIN
                 IF BeforeAction(event) THEN
                 BEGIN
                   location:=NIL;
                   inside:=NIL;
                   IF AfterAction(event) THEN
                   BEGIN
                     CASE player^.adress OF
                       du  : IF event.action=take_ev THEN
                                str:='Du nimmst '+Noun(name.GetText,acc,d,event.first^.number)
                                ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' reicht dir '+Noun(name.GetText,acc,d,n);
                       sie : IF event.action=take_ev THEN
                                str:='Sie nehmen '+Noun(name.GetText,acc,d,n)
                                ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' reicht Ihnen '+Noun(name.GetText,acc,d,n);
                       ihr : IF event.action=take_ev THEN
                                str:='Ihr nehmt '+Noun(name.GetText,acc,d,n)
                                ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' reicht Euch '+Noun(name.GetText,acc,d,n);
                     END;
                   END;
                 END ELSE player^.weight.Drop(@SELF);
               END;
             END;
    Follow;
  END;
  IF (str<>'') AND (NOT(replay)) THEN
  BEGIN
    WithUpcase(str);
    Print(str+'.\n');
  END;
END;

(*PROCEDURE TItem.MoveCmd(where : POINTER; VAR event : TEvent);
VAR
  p1      : PBasic;
  p2      : PItem;
  error,d : BOOLEAN;
  str     : STRING;
  n       : BYTE;
BEGIN
  str:='';
  error:=f;
  d:=event.first^.number>1;  { Bestimmter oder unbestimmter Artikel }
  n:=event.first^.number;    { Anzahl zu bewegender Objekte }
  IF inside<>NIL THEN
  BEGIN
    {
      Wenn Objekt aus einem Behaelter entfernt wird
    }
    IF (inside^.lock=NIL) OR (inside^.lock^.state=open) THEN inside^.DecItemWeight(weight.wsum,t)
                                                        ELSE game^.ParserError(19,inside^.name.GetText,1,error);
  END ELSE error:=f;
  IF NOT(error) THEN
  BEGIN
    IF where<>NIL THEN
    BEGIN
      p1:=where;
      IF p1^._class=room THEN
      BEGIN
        {
          Objekt wird auf den Boden gelegt
        }
        IF BeforeAction(event) THEN
        BEGIN
          IF (inside=NIL) AND (event.who=NIL) THEN player^.DecPlayerWeight(weight.wsum,t);
          location:=Adr(p1^.id);
          inside:=NIL;
          IF AfterAction(event) THEN
          BEGIN
            IF event.who=NIL THEN
            BEGIN
              CASE player^.adress OF
                du  : str:='Du legst '+Noun(name.GetText,acc,d,n)+' weg';
                sie : str:='Sie legen '+Noun(name.GetText,acc,d,n)+' weg';
                ihr : str:='Ihr legt '+Noun(name.GetText,acc,d,n)+' weg';
              END;
            END ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' legt '+Noun(name.GetText,acc,d,n)+' weg';
          END;
        END ELSE IF inside<>NIL THEN inside^.IncItemWeight(weight.wsum,t,name.GetText,NIL,error);
      END ELSE IF p1^._class=item THEN
               BEGIN
                 {
                   Objekt wird in einen Behaelter gelegt oder von
                   einem NPC aufgenommen
                 }
                 p2:=where;
                 IF (p2^.lock=NIL) OR (p2^.lock^.state=open) THEN
                 BEGIN
                   p2^.IncItemWeight(weight.wsum,t,name.GetText,NIL,error);
                   IF NOT(error) THEN
                   BEGIN
                     IF BeforeAction(event) THEN
                     BEGIN
                       IF (inside=NIL) AND (event.who=NIL) THEN player^.DecPlayerWeight(weight.wsum,t);
                       location:=p2^.location;
                       inside:=p2;
                       IF AfterAction(event) THEN
                       BEGIN
                         IF event.who=NIL THEN
                         BEGIN
                           CASE player^.adress OF
                             du  : IF event.action=drop_ev THEN
                                      str:='Du legst '+Noun(name.GetText,acc,d,n)+' in '+Noun(p2^.name.GetText,acc,d,n)
                                      ELSE str:='Du gibst '+Noun(p2^.name.GetText,dat,t,1)+' '+Noun(name.GetText,acc,d,n);
                             sie : IF event.action=drop_ev THEN
                                      str:='Sie legen '+Noun(name.GetText,acc,d,n)+' in '+Noun(p2^.name.GetText,acc,t,1)
                                      ELSE str:='Sie geben '+Noun(p2^.name.GetText,dat,t,1)+' '+Noun(name.GetText,acc,d,n);
                             ihr : IF event.action=drop_ev THEN
                                      str:='Ihr legt '+Noun(name.GetText,acc,d,n)+' in '+Noun(p2^.name.GetText,acc,t,1)
                                      ELSE str:='Ihr gebt '+Noun(p2^.name.GetText,dat,t,1)+' '+Noun(name.GetText,acc,d,n);
                           END;
                         END ELSE IF p2^.matter=alive THEN str:=Noun(event.who^.name.GetText,nom,t,1)
                                                                 +' nimmt '+Noun(name.GetText,acc,d,n)
                                                       ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' legt '
                                                                 +Noun(name.GetText,acc,d,n)+' in '
                                                                +Noun(p2^.name.GetText,acc,t,1);
                       END;
                     END ELSE p2^.DecItemWeight(weight.wsum,t);
                   END;
                 END ELSE game^.ParserError(19,p2^.name.GetText,1,error);
               END ELSE Warning('Objekt '+NumToStr(id)+' kann nicht in '+NumToStr(p1^.id)+' abgelegt werden');
    END ELSE BEGIN
               {
                 Objekt wird vom Spieler genommen oder ihm gegeben
               }
               player^.IncPlayerWeight(weight.wsum,t,name.GetText,NIL,error);
               IF NOT(error) THEN
               BEGIN
                 IF BeforeAction(event) THEN
                 BEGIN
                   location:=NIL;
                   inside:=NIL;
                   IF AfterAction(event) THEN
                   BEGIN
                     CASE player^.adress OF
                       du  : IF event.action=take_ev THEN
                                str:='Du nimmst '+Noun(name.GetText,acc,d,event.first^.number)
                                ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' reicht dir '+Noun(name.GetText,acc,d,n);
                       sie : IF event.action=take_ev THEN
                                str:='Sie nehmen '+Noun(name.GetText,acc,d,n)
                                ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' reicht Ihnen '+Noun(name.GetText,acc,d,n);
                       ihr : IF event.action=take_ev THEN
                                str:='Ihr nehmt '+Noun(name.GetText,acc,d,n)
                                ELSE str:=Noun(event.who^.name.GetText,nom,t,1)+' reicht Euch '+Noun(name.GetText,acc,d,n);
                     END;
                   END;
                 END ELSE player^.DecPlayerWeight(weight.wsum,t);
               END;
             END;
    Follow;
  END;
  IF (str<>'') AND (NOT(replay)) THEN
  BEGIN
    WithUpcase(str);
    Print(str+'.\n');
  END;
END;*)

{
  Bewegt ein Objekt in einen Raum oder Behaelter. BeforeAction und
  AfterAction werden nicht aufgerufen. Es erfolgt keine Ausgabe,
  so dass die Positionsveraenderung vom Spieler unbemerkt erfolgen
  kann.
}
PROCEDURE TItem.MoveItemTo(where : PBasic);
VAR
  p     : PItem;
  error : BOOLEAN;
BEGIN
  error:=f;
  IF inside<>NIL THEN
  BEGIN
    {
      Fahrzeuge, die das Objekt enthalten, werden mitgenommen
    }
    IF inside^.Has(moveable_at) THEN inside^.location:=Adr(where^.id)
                                ELSE BEGIN
                                       inside^.weight.Drop(@SELF);
                                       inside:=NIL;
                                     END;
  END; { ELSE IF (location=NIL) AND (player<>NIL) AND (player^.weight.GetCont>0) THEN player^.weight.Drop(@SELF); }
  IF where<>NIL THEN
  BEGIN
    CASE where^._class OF
      room : BEGIN
               location:=Adr(where^.id);
               inside:=NIL;
             END;
      item : BEGIN
               p:=Adr(where^.id);
               p^.weight.Pick(@SELF,error);
               IF NOT(error) THEN
               BEGIN
                 location:=p^.location;
                 inside:=p;
               END ELSE HALT;
             END;
      link : Warning('Objekt '+NumToStr(id)+' kann nicht bei Objekt '+NumToStr(where^.id)+' positioniert werden');
    END;
  END ELSE IF player<>NIL THEN
           BEGIN
             player^.weight.Pick(@SELF,error);
             IF NOT(error) THEN
             BEGIN
               location:=NIL;
               inside:=NIL;
             END;
           END;
  Follow;
END;

FUNCTION TItem.DecAmount : BOOLEAN;
BEGIN
  IF amount>0 THEN
  BEGIN
    DEC(amount);
    DecAmount:=amount>0;
  END ELSE DecAmount:=f;
END;

FUNCTION TItem.Contains(x : PItem) : BOOLEAN;
BEGIN
  Contains:=(x<>NIL) AND (x^.GetContainer=@SELF);
END;

FUNCTION TItem.BeforeAction(event : TEvent) : BOOLEAN;
BEGIN
  BeforeAction:=t;
END;

FUNCTION TItem.AfterAction(event : TEvent) : BOOLEAN;
BEGIN
  AfterAction:=t;
END;

PROCEDURE TItem.HandleEvent(VAR event : TEvent);
VAR
  error : BOOLEAN;
  str   : STRING;
  dummy : TEvent;
BEGIN
  str:='';
  error:=f;
  WITH event DO
  BEGIN
    CASE action OF
        show_ev    : IF BeforeAction(event) THEN return:=t;
        take_ev    : IF Has(takeable_at) THEN MoveCmd(who,event)
                                         ELSE game^.ParserError(9,'',1,error);
        drop_ev    : IF second=NIL THEN MoveCmd(player^.position,event)
                                   ELSE IF second^.xitem<>NIL THEN
                                        BEGIN
                                         IF second^.xitem^.lock<>NIL THEN MoveCmd(second^.xitem,event)
                                                                     ELSE game^.ParserError(9,'',1,error);
                                        END ELSE game^.ParserError(9,'',1,error);
        drink_ev,
        eat_ev     : IF ((action=drink_ev) AND (Has(drinkable_at))) OR ((action=eat_ev) AND (Has(edable_at))) THEN
                     BEGIN
                       IF Scope<>held_sd THEN
                       BEGIN
                         dummy:=event;
                         dummy.action:=take_ev;
                         IF action=eat_ev THEN HandleEvent(dummy)
                                        ELSE IF (inside<>NIL) AND (inside^.Scope<>held_sd) AND (inside^.Has(takeable_at)) THEN
                                        BEGIN
                                          dummy.first^.xitem:=inside;
                                          inside^.HandleEvent(dummy);
                                        END;
                       END;
                       IF ((Scope=held_sd) OR (action=drink_ev)) AND (BeforeAction(event)) THEN
                       BEGIN
                         IF NOT(DecAmount) THEN MoveItemTo(top);
                         IF AfterAction(event) THEN
                         BEGIN
                           IF who=NIL THEN
                           BEGIN
                             CASE player^.adress OF
                               du  : IF action=eat_ev THEN str:='Du i'+ss_kc+'t '
                                                    ELSE str:='Du trinkst ';
                               sie : IF action=eat_ev THEN str:='Sie essen '
                                                    ELSE str:='Sie trinken ';
                               ihr : IF action=eat_ev THEN str:='Ihr e'+ss_kc+'t '
                                                    ELSE str:='Ihr trinkt ';
                             END;
                           END ELSE BEGIN
                                      str:='\b'+Noun(who^.name.GetText,nom,t,1);
                                      IF action=eat_ev THEN str:=str+' i'+ss_kc+'t '
                                                     ELSE str:=str+' trinkt ';
                                    END;
                           Print(str+Noun(name.GetText,acc,t,copies)+'.\n');
                         END;
                       END;
                       return:=t;
                     END ELSE game^.ParserError(9,'',1,error);
        enter_ev   : IF Has(enterable_at) THEN
                     BEGIN
                       IF who<>NIL THEN error:=who^.inside<>NIL
                                   ELSE error:=player^.inside<>NIL;
                       IF NOT(error) THEN
                       BEGIN
                         IF who<>NIL THEN weight.Pick(who,error)
                                     ELSE weight.Pick(player,error);
                         IF NOT(error) THEN
                         BEGIN
                           IF BeforeAction(event) THEN
                           BEGIN
                             IF who=NIL THEN player^.Enter(@SELF)
                                        ELSE who^.inside:=@SELF;
                             IF (AfterAction(event)) AND (who<>NIL) THEN
                             BEGIN
                               str:=Noun(who^.name.GetText,nom,t,1)+' befindet sich jetzt '+
                                    praepos+' '+Noun(name.GetText,dat,t,1);
                               Print('\b'+str+'.\n');
                             END ELSE return:=t;
                           END ELSE IF who<>NIL THEN weight.Drop(who)
                                                ELSE weight.Drop(player);
                         END;
                       END ELSE IF who=NIL THEN game^.ParserError(25,'',1,error)
                                           ELSE game^.ParserError(26,who^.name.GetText,1,error);
                     END ELSE game^.ParserError(9,'',1,error);
        kill_ev    : IF (BeforeAction(event)) AND (AfterAction(event)) THEN
                     BEGIN
                       IF who=NIL THEN
                       BEGIN
                         CASE player^.adress OF
                           du  : str:='Du bist ';
                           sie : str:='Sie sind ';
                           ihr : str:='Ihr seid ';
                         END;
                         str:=str+WithAdj('friedliebend',GenChar(player^.gender)+'Spieler',nom,f,1)+
                                  Ext(player^.gender)+'\n';
                       END ELSE str:='Dies ist '+WithAdj('friedliebend',name.GetText,nom,f,1)+'.\n';
                       Print(str);
                     END;
        kiss_ev    : IF (BeforeAction(event)) AND (AfterAction(event)) THEN game^.Admonition(player^.adress);
        leave_ev   : BEGIN
                       error:=((who<>NIL) AND (who^.inside<>@SELF)) OR ((who=NIL) AND (player^.inside=NIL));
                       IF NOT(error) THEN
                       BEGIN
                         IF BeforeAction(event) THEN
                         BEGIN
                           IF who=NIL THEN
                           BEGIN
                             player^.Leave;
                             weight.Drop(player);
                           END ELSE BEGIN
                                      who^.inside:=NIL;
                                      weight.Drop(who);
                                    END;
                           return:=t;
                           AfterAction(event);
                         END;
                       END ELSE BEGIN
                                  IF who<>NIL THEN
                                  BEGIN
                                    str:='\b'+Noun(who^.name.GetText,nom,t,1)+' befindet sich nicht '+
                                         praepos+' '+Noun(name.GetText,dat,t,1);
                                  END ELSE BEGIN
                                             CASE player^.adress OF
                                               du  : str:='Du befindest dich nicht';
                                               sie : str:='Sie befinden sich nicht';
                                               ihr : str:='Ihr befindet Euch nicht';
                                             END;
                                             str:=str+' '+praepos+' '+Noun(name.GetText,dat,t,1);
                                           END;
                                  Print(str+'.\n');
                                END;
                     END;
      give_ev      : IF second=NIL THEN MoveCmd(NIL,event)
                                   ELSE MoveCmd(second^.xitem,event);
      open_ev,
      close_ev,
      lock_ev      : IF lock<>NIL THEN lock^.HandleEvent(event)
                                  ELSE game^.ParserError(9,'',1,error);
      press_ev     : IF Has(switchable_at) THEN
                     BEGIN
                       IF BeforeAction(event) THEN
                       BEGIN
                         on:=NOT(on);
                         AfterAction(event);
                         return:=t;
                       END;
                     END ELSE game^.ParserError(9,'',1,error);
      read_ev      : IF Has(readable_at) THEN
                     BEGIN
                       BeforeAction(event);
                       AfterAction(event);
                       return:=t;
                     END ELSE game^.ParserError(9,'',1,error);
      switchon_ev  : IF Has(switchable_at) THEN
                     BEGIN
                       IF NOT(on) THEN
                       BEGIN
                         IF BeforeAction(event) THEN
                         BEGIN
                           on:=t;
                           AfterAction(event);
                           return:=t;
                         END;
                       END ELSE game^.ParserError(29,name.GetText,1,error);
                     END ELSE game^.ParserError(9,'',1,error);
      switchoff_ev : IF Has(switchable_at) THEN
                     BEGIN
                       IF on THEN
                       BEGIN
                         IF BeforeAction(event) THEN
                         BEGIN
                           on:=f;
                           AfterAction(event);
                           return:=t;
                         END;
                       END ELSE game^.ParserError(30,name.GetText,1,error);
                     END ELSE game^.ParserError(9,'',1,error);
      tell_ev      : IF Has(talkable_at) THEN
                     BEGIN
                       IF BeforeAction(event) THEN
                       BEGIN
                         Print('\b'+Noun(who^.name.GetText,nom,t,1)+' h'+loe_kc+
                               'rt '+PerPron(player^.adress,dat)+' nicht zu.\n');
                         AfterAction(event);
                       END;
                     END ELSE game^.ParserError(9,name.GetText,1,error);
      ELSE TBasic.HandleEvent(event);
    END;
    IF error THEN exec:=maxexec;
  END;
END;

{
  Scope-Definition fuer Items. Bei Problemen mit der Objektmanipulation
  bitte genau studieren...
}
FUNCTION TItem.Scope : BYTE;
VAR
  r : BYTE;
BEGIN
  r:=notinroom_sd;
  {
    Befindet sich das Objekt in einem Behaelter?
  }
  IF inside<>NIL THEN  { ja }
  BEGIN
    IF inside^.lock<>NIL THEN  { Behaelter hat ein Schloss }
    BEGIN
      IF inside^.lock^.state=open THEN
      BEGIN
        {
          Befindet sich Behaelter des Objekts beim Akteur?
        }
        IF ((inside^.location=NIL) AND (game^.actor=NIL)) OR
           ((inside^.inside=game^.actor) AND (game^.actor<>NIL)) THEN
           r:=held_sd
           ELSE r:=inside^.Scope;
      END ELSE IF inside^.Has(transparent_at) THEN r:=visible_sd;
      {
        Objekt wird von einem NPC getragen
      }
    END ELSE IF inside=game^.actor THEN r:=held_sd
                                           ELSE r:=visible_sd;
    {
      Befindet sich das Objekt mit dem Akteur in einem Raum?
    }
  END ELSE IF location=game^.ActorWhere THEN
           BEGIN
             {
               Objekt ist erreichbar, wenn es sich gleichen Raum wie
               der Akteur befindet oder den Akteuer enthaelt, andernfalls
               ist es nur sichtbar
             }
             IF (game^.ActorInside(NIL)) OR
                (game^.ActorInside(@SELF)) THEN r:=reachable_sd
                                           ELSE r:=visible_sd;
             {
               Objekt wird vom Spieler getragen
             }
           END ELSE IF (location=NIL) AND (game^.actor=NIL) THEN r:=held_sd;
  scope:=r;
END;

PROCEDURE TItem.View;
CONST
  mstr : ARRAY[TMatter] OF STRING = ('unbelebt','tot','lebendig');
BEGIN
  TBasic.View;
  WRITE('Position: ');
  IF location<>NIL THEN WRITELN(ShortName(location^.name.GetText,2)+' ('+NumToSTR(location^.id)+')')
                   ELSE WRITELN('Inventar');
  WRITELN('Wird in Raumbeschreibung erw'+lae_kc+'hnt? '+boolstr[show]);
  IF inside<>NIL THEN
  BEGIN
    IF inside^.matter=alive THEN WRITELN('Wird von '+ShortName(inside^.name.GetText,2)+' ('+NumToStr(inside^.id)+') getragen')
                             ELSE WRITELN('Befindet sich in '+ShortName(inside^.name.GetText,2)+' ('+NumToStr(inside^.id)+')');

  END;
  IF weight.counter>0 THEN WRITELN('Enth'+lae_kc+'lt oder tr'+lae_kc+'gt '+NumToStr(weight.counter)+' Objekt(e)');
  IF Has(switchable_at) THEN
  BEGIN
    WRITE('Objekt ist ');
    IF on THEN WRITELN('eingeschaltet')
          ELSE WRITELN('ausgeschaltet');
  END;
  WRITELN('Gewicht:        '+NumToStr(weight.wsum));
  WRITELN('Maximalgewicht: '+NumToStr(weight.wmax));
  WRITELN('Objekt ist '+mstr[matter]);
  WRITELN('Kann gegessen werden? ........ '+boolstr[Has(edable_at)]);
  WRITELN('Kann getrunken werden? ....... '+boolstr[Has(drinkable_at)]);
  WRITELN('Kann sich bewegen? ........... '+boolstr[Has(moveable_at)]);
  WRITELN('Kann ein/ausgeschaltet werden? '+boolstr[Has(switchable_at)]);
  WRITELN('Ist transparent? ............. '+boolstr[Has(transparent_at)]);
  WRITELN('Kann betreten werden? ........ '+boolstr[Has(enterable_at)]);
  WRITELN('Kann gelesen werden? ......... '+boolstr[Has(readable_at)]);
  WRITELN('Ist eine Lichtquelle? ........ '+boolstr[Has(shining_at)]);
  WRITELN('L'+lae_kc+ss_kc+'t sich aufnehmen? ......... '+boolstr[Has(takeable_at)]);
END;

DESTRUCTOR TItem.Done;
BEGIN
END;

{****************************************************************************}
{* TObjList verwaltet Objekte der Spielwelt in einer Liste                     *}
{****************************************************************************}

CONSTRUCTOR TObjList.Init;
BEGIN
  start:=NIL;
END;

{
  Neues Objekt in Liste einfuegen
}
PROCEDURE TObjList.Insert(_new : PBasic);
VAR
  p1,p2 : PElement;
BEGIN
  IF start<>NIL THEN   { Listenende suchen }
  BEGIN
    p1:=start;
    WHILE p1^.next<>NIL DO p1:=p1^.next;
  END ELSE p1:=NIL;
  NEW(p2);             { Neues Element erzeugen und initialisieren }
  WITH p2^ DO
  BEGIN
    element:=_new;
    prev:=p1;
    next:=NIL;
  END;
  IF start<>NIL THEN p1^.next:=p2
                ELSE start:=p2
END;

FUNCTION TObjList.At(index : WORD) : POINTER;
VAR
  n : WORD;
  p : PElement;
BEGIN
  n:=0;
  p:=start;
  WHILE (n<index) AND (p<>NIL) DO
  BEGIN
    INC(n);
    p:=p^.next;
  END;
  IF n<>index THEN Warning('Index '+NumToStr(index)+' existiert nicht');
  At:=p^.element;
END;

FUNCTION TObjList.GetPtr(_id : WORD) : PBasic;
VAR
  p1 : PElement;
  p2 : POINTER;
BEGIN
  p1:=start;
  p2:=NIL;
  WHILE (p1<>NIL) AND (p2=NIL) DO
  BEGIN
    IF p1^.element^.GetID=_id THEN p2:=p1^.element;
    p1:=p1^.next;
  END;
  GetPtr:=p2;
END;

FUNCTION TObjList.Count : WORD;
VAR
  n : BYTE;
  p : PElement;
BEGIN
  n:=0;
  p:=start;
  WHILE p<>NIL DO
  BEGIN
    INC(n);
    p:=p^.next;
  END;
  count:=n;
END;

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

{****************************************************************************}
{* TPlayer verwaltet die Spielerdaten                                       *}
{****************************************************************************}

CONSTRUCTOR TPlayer.Init(_where : WORD; _adress : TAdress; _gender : TGender; _wmin,_wmax : BYTE);
VAR
  p : PItem;
  i : WORD;
BEGIN
  weight.Init(@SELF,_wmin,_wmax);
  p:=Adr(_where);
  inside:=NIL;
  MovePlayerTo(p);
  moves:=0;
  scores:=0;
  adress:=_adress;
  gender:=_gender;
  state:=alive_ps;
  player:=@SELF;
  FOR i:=0 TO list.Count-1 DO
  BEGIN
    p:=list.At(i);
    IF p^._class=Item THEN p^.Register;
  END;
END;

{
  Zustand des Spielers speichern und laden
}

PROCEDURE TPlayer.Store(VAR h : File);
BEGIN
  WritePtr(h,position);
  WritePtr(h,inside);
  WriteWord(h,moves);
  WriteWord(h,scores);
  BLOCKWRITE(h,BYTE(adress),1);
  BLOCKWRITE(h,BYTE(gender),1);
  BLOCKWRITE(h,state,1);
  WriteScale(h,weight);
END;

PROCEDURE TPlayer.Load(VAR h : File);
BEGIN
  position:=PRoom(ReadPtr(h));
  inside:=PItem(ReadPtr(h));
  ReadWord(h,moves);
  ReadWord(h,scores);
  BLOCKREAD(h,BYTE(adress),1);
  BLOCKREAD(h,BYTE(gender),1);
  BLOCKREAD(h,state,1);
  ReadScale(h,weight);
END;

FUNCTION TPlayer.GetAdress : TAdress;
BEGIN
  GetAdress:=adress;
END;

FUNCTION TPlayer.GetGender : TGender;
BEGIN
  GetGender:=gender;
END;

FUNCTION TPlayer.GetContainer : PItem;
BEGIN
  GetContainer:=inside;
END;

FUNCTION TPlayer.GetLocation : PRoom;
BEGIN
  GetLocation:=position;
END;

FUNCTION TPlayer.GetState : BYTE;
BEGIN
  GetState:=state;
END;

PROCEDURE TPlayer.SetState(s : BYTE);
BEGIN
  IF state IN [dead_ps,alive_ps,victory_ps] THEN state:=s
                                            ELSE Warning('Ung'+lue_kc+'ltiger Spielerstatus');
END;

FUNCTION TPlayer.GetContent : BYTE;
BEGIN
  GetContent:=weight.counter;
END;

FUNCTION TPlayer.GetWeight : BYTE;
BEGIN
  GetWeight:=weight.wsum;
END;

FUNCTION TPlayer.GetMaxWeight : BYTE;
BEGIN
  GetMaxWeight:=weight.wmax;
END;

FUNCTION TPlayer.StatusBarLeftStr : STRING;
VAR
  str : STRING;
BEGIN
  IF position^.HasLight THEN str:=ShortName(position^.name.GetText,2)
                        ELSE str:='Finsternis';
  IF inside<>NIL THEN str:=str+' ('+inside^.praepos+' '+Noun(inside^.name.GetText,dat,f,1)+')';
  StatusBarLeftStr:=str;
END;

FUNCTION TPlayer.StatusBarRightStr : STRING;
VAR
  s1,s2 : STRING;
BEGIN
  STR(scores,s1);
  STR(moves,s2);
  StatusBarRightStr:=s1+'/'+s2;
END;

FUNCTION TPlayer.RankStr : STRING;
BEGIN
  RankStr:=NumToStr(scores)+' Punkte nach '+NumToStr(moves)+' Z'+lue_kc+'gen\n';
END;

PROCEDURE TPlayer.IncMoves;
BEGIN
  INC(moves);
  IF game^.statusline THEN game^.DrawStatusline(f);
END;

PROCEDURE TPlayer.IncScores(ds : WORD);
BEGIN
  INC(scores,ds);
  IF game^.statusline THEN game^.DrawStatusline(f);
END;

FUNCTION TPlayer.GetScores : WORD;
BEGIN
  GetScores:=scores;
END;

FUNCTION TPlayer.GetMoves : WORD;
BEGIN
  GetMoves:=moves;
END;

PROCEDURE TPlayer.Enter(_item : PItem);
BEGIN
  inside:=_item;
END;

PROCEDURE TPlayer.Inventory;
VAR
  x : BYTE;
BEGIN
  IF weight.GetCont>0 THEN
  BEGIN
    CASE adress OF
      du  : Print('Du tr'+lae_kc+'gst folgende Dinge bei dir:\n');
      sie : Print('Sie tragen folgende Dinge mit sich:\n');
      ihr : Print('Ihr tragt folgende Dinge mit Euch:\n');
    END;
    x:=1;
    CountItems(NIL);
    ShowItems(t,x,NIL);
    ResetAll;
  END ELSE BEGIN
             CASE adress OF
               du  : Print('Du tr'+lae_kc+'gst nichts bei dir\n');
               sie : Print('Sie tragen nichts mit sich\n');
               ihr : Print('Ihr tragt nichts mit Euch\n');
             END;
           END;
  IF debug THEN Print(NumToStr(weight.counter)+' Item(s)  Gewicht='+NumToStr(weight.wsum)+'\n');
END;

{
  Traegt Spieler das Objekt i?
}
FUNCTION TPlayer.HasPlayer(i : WORD) : BOOLEAN;
VAR
  p0 : PBasic;
  p1 : PItem;
  ok : BOOLEAN;
BEGIN
  ok:=f;
  p0:=Adr(i);
  IF p0<>NIL THEN
  BEGIN
    IF p0^._class=Item THEN
    BEGIN
      p1:=PItem(p0);
      ok:=p1^.location=NIL;
    END;
  END;
  HasPlayer:=ok;
END;

PROCEDURE TPlayer.Leave;
BEGIN
  inside:=NIL;
END;

PROCEDURE TPlayer.MovePlayerTo(where : PBasic);
VAR
  p : PItem;
BEGIN
  CASE where^._class OF
    room : BEGIN
             position:=Adr(where^.id);
             IF (inside<>NIL) AND (inside^.Has(moveable_at)) THEN
             BEGIN
               inside^.location:=position;
               IF inside^.lock<>NIL THEN inside^.Follow;
             END ELSE inside:=NIL;
           END;
    item : BEGIN
               p:=Adr(where^.id);
               position:=p^.location;
               inside:=p;
             END;
    link : Warning('Spieler kann nicht bei Objekt '+NumToStr(where^.id)+' positioniert werden');
  END;
END;

PROCEDURE TPlayer.AfterLife;
BEGIN
  Print(RankStr);
END;

PROCEDURE TPlayer.Victory;
BEGIN
  Print(RankStr);
END;

DESTRUCTOR TPlayer.Done;
BEGIN
END;

{****************************************************************************}
{* TGame                                                                    *}
{****************************************************************************}

CONSTRUCTOR TGame.Init(_statusline,_upsize,_verbose : BOOLEAN; _history : BYTE);
VAR
  i : BYTE;
BEGIN
  IF player=NIL THEN Warning('Spielerobjekt nicht initialisiert');
  pverb:=NIL;
  statusline:=_statusline;
  upsize:=_upsize;
  verbose:=_verbose;
  history:=_history;
  refpro:=NIL;
  game:=@SELF;
  SetTime(0,5);
  NEW(prologue,INIT);
  FOR i:=1 TO 10 DO SetFKey(i,'');
  IF useroption THEN CheckCommandLine;
  ReadLib;
END;

PROCEDURE TGame.CheckCommandLine;
VAR
  i,n   : BYTE;
  str   : STRING[3];
  c     : CHAR;
  error : INTEGER;
BEGIN
  IF (PARAMCOUNT>0) AND (COPY(PARAMSTR(1),1,1)='-') THEN
  BEGIN
    error:=0;
    FOR i:=1 TO PARAMCOUNT DO
    BEGIN
      str:=COPY(PARAMSTR(i),2,4);
      c:=UPCASE(str[1]);
      CASE c OF
        'T' : BEGIN
                VAL(COPY(str,2,2),n,error);
                SetColor(n,GetBackColor);
              END;
        'B' : BEGIN
                VAL(COPY(str,2,2),n,error);
                SetColor(GetForeColor,n);
              END;
        'R' : VAL(COPY(str,2,3),maxrow,error);
        'C' : VAL(COPY(str,2,3),maxcol,error);
        'S' : IF LENGTH(str)=2 THEN statusline:=str[2]='+'
                               ELSE error:=1;
        'V' : IF LENGTH(str)=2 THEN verbose:=str[2]='+'
                               ELSE error:=1;
        'U' : IF LENGTH(str)=2 THEN upsize:=str[2]='+'
                               ELSE error:=1;
        '?' : IF LENGTH(str)=1 THEN
              BEGIN
                WRITELN(Upper(savestr)+' Kommandozeilenoptionen');
                WRITELN('Gebrauch: -Option<n> oder -Option<x>');
                WRITELN('F<n> Textfarbe');
                WRITELN('B<n> Hintergrundfarbe');
                WRITELN('R<n> Bildschirmzeilen');
                WRITELN('C<n> Bildschirmspalten');
                WRITELN('S<x> Statuszeile ein/aus');
                WRITELN('V<x> Raumbeschreibung in bekannten R'+lae_kc+'umen ein/aus');
                WRITELN('U<x> Eingabe in Gro'+ss_kc+'buchstaben ein/aus');
                WRITELN('?    Diese Hilfe');
                HALT;
              END ELSE error:=1;
        ELSE error:=1;
      END;
      IF error>0 THEN
      BEGIN
        WRITELN('Ung'+lue_kc+'ltige Option: '+str);
        HALT;
      END;
    END;
  END;
END;

FUNCTION TGame.IsVerbose : BOOLEAN;
BEGIN
  IsVerbose:=verbose;
END;

FUNCTION TGame.BeforeAction(event : TEvent) : BOOLEAN;
BEGIN
  BeforeAction:=t;
END;

FUNCTION TGame.AfterAction(event : TEvent) : BOOLEAN;
BEGIN
  AfterAction:=t;
END;

PROCEDURE TGame.HandleEvent(VAR event : TEvent);
VAR
  error : BOOLEAN;
BEGIN
  WITH event DO
  BEGIN
    CASE action OF
      lista_ev   : IF BeforeAction(event) THEN
                   BEGIN
                     Browser;
                     return:=t;
                     AfterAction(event);
                   END;
      sleep_ev   : IF BeforeAction(event) THEN
                   BEGIN
                     CASE player^.adress OF
                       du  : Print('Du f'+lue_kc+'hlst dich nicht besonders m'+lue_kc+'de.\n');
                       ihr : Print('Sie f'+lue_kc+'hlen sich nicht besonders m'+lue_kc+'de.\n');
                       sie : Print('Ihr f'+lue_kc+'hlt Euch nicht besonders m'+lue_kc+'de.\n');
                     END;
                     AfterAction(event);
                   END;
      wait_ev    : IF BeforeAction(event) THEN
                   BEGIN
                     Print('Die Zeit vergeht...\n');
                     AfterAction(event);
                   END;
      ELSE ParserError(9,'',1,error);
    END;
  END;
END;

PROCEDURE TGame.DrawStatusline(location : BOOLEAN);
VAR
  y   : BYTE;
  str : STRING;
BEGIN
  IF statusline THEN
  BEGIN
    y:=WHEREY;
    InversText;
    WINDOW(1,1,maxcol,maxrow);
    GOTOXY(1,1);
    CLREOL;
    GOTOXY(2,1);
    WRITE(player^.StatusBarLeftStr);
    str:=player^.StatusBarRightStr;
    GOTOXY(maxcol-LENGTH(str),1);
    WRITE(str);
    NormalText;
    WINDOW(1,2,maxcol,maxrow);
    GOTOXY(1,y);
  END;
  IF location THEN Print(player^.StatusBarLeftStr+'\n');
END;

PROCEDURE TGame.Admonition(adress : TAdress);
BEGIN
  CASE adress OF
    du  : Print(RandStr('Bleib bitte bei der Sache;Konzentriere dich bitte auf das Spiel')+'.\n');
    sie : Print(RandStr('Bleiben Sie bitte bei der Sache;Konzentrieren Sie sich bitte auf das Spiel')+'.\n');
    ihr : Print(RandStr('Bleibt bitte bei der Sache;Konzentriert Euch bitte auf das Spiel')+'.\n');
  END;
END;

{
  Fehlermeldungen des Parsers
  n      Fehlernummer
  str    Objektname oder einzelnes Wort, kann leer sein
  i      Anzahl von Kopien des betroffenen Objekts
  error  Bestaetigung fuer aufrufende Methode
}
PROCEDURE TGame.ParserError(n : BYTE; str : STRING; i : BYTE; VAR error : BOOLEAN);
CONST
  dontknow = 'Unbekannte Fehlernummer';
VAR
  m : STRING;
BEGIN
  error:=t;
  CASE n OF
    1 : m:='Ich verstehe das Wort '+#34+str+#34+' nicht';
    2 : m:=Noun(str,nom,t,i)+' nimmt keine Befehle entgegen';
    3 : m:=Noun(str,nom,t,i)+' ist tot und nimmt keine Befehle mehr entgegen';
    4 : BEGIN
          CASE player^.adress OF
            du  : m:='Ich verstehe dich nicht';
            sie : m:='Ich verstehe Sie nicht';
            ihr : m:='Ich verstehe Euch nicht';
          END;
        END;
    5 : BEGIN
           m:='Ich bin mir nicht sicher, '+str+' ';
           CASE player^.adress OF
             du  : m:=m+'Du meinst';
             sie : m:=m+'Sie meinen';
             ihr : m:=m+'Ihr meint';
           END;
         END;
    6 : m:='So viele '+str+' gibt es hier nicht';
    7 : m:='Ich verstehe die Zahl '+str+' hier nicht';
    8 : m:='Die Eingabe enth'+lae_kc+'lt zuviele Substantive';
    9 : m:='Das geht nicht';
    10 : m:='Ich kann hier k'+Noun(str,acc,f,i)+' entdecken';
    11 : BEGIN
           CASE player^.adress OF
             du  : m:='Du kommst nicht an '+Noun(str,acc,t,i)+' heran';
             sie : m:='Sie kommen nicht an '+Noun(str,acc,t,i)+' heran';
             ihr : m:='Ihr kommt nicht an '+Noun(str,acc,t,i)+' heran';
           END;
         END;
    12 : BEGIN
           CASE player^.adress OF
             du  : m:='Du h'+lae_kc+'ltst '+Noun(str,acc,t,i)+' bereits';
             sie : m:='Sie halten '+Noun(str,acc,t,i)+' bereits';
             ihr : m:='Ihr haltet '+Noun(str,acc,t,i)+' bereits';
           END;
         END;
    13 : m:='In der Eingabe fehlt ein Substantiv';
    14 : BEGIN
           CASE player^.adress OF
             du  : m:='Du hast k'+Noun(str,acc,f,i);
             sie : m:='Sie haben k'+Noun(str,acc,f,i);
             ihr : m:='Ihr habt k'+Noun(str,acc,f,i);
           END;
         END;
    15 : m:='Hier geht es nicht weiter';
    16 : m:=Noun(str,nom,t,i)+' ist zu schwer bzw. zu gro'+ss_kc;
    17 : BEGIN
           CASE player^.adress OF
             du  : m:='Du h'+lae_kc+'ltst k'+Noun(str,acc,f,i);
             sie : m:='Sie halten k'+Noun(str,acc,f,i);
             ihr : m:='Ihr haltet k'+Noun(str,acc,f,i);
           END;
         END;
    18 : m:=Noun(actor^.name.GetText,nom,t,i)+' h'+lae_kc+'lt k'+Noun(str,acc,f,1);
    19 : m:=Noun(str,nom,t,i)+' mu'+ss_kc+' erst ge'+loe_kc+'ffnet werden';
    20 : m:=Noun(str,nom,t,i)+' ist bereits offen';
    21 : m:=Noun(str,nom,t,i)+' ist verschlossen';
    22 : m:=Noun(str,nom,t,i)+' ist bereits verschlossen';
    23 : m:='Womit soll das gemacht werden?';
    24 : m:=Noun(str,nom,t,i)+' ist bereits zu';
    25 : BEGIN
           CASE player^.adress OF
             du  : m:='Du mu'+ss_kc+'t erst '+Noun(str,acc,t,i)+'verlassen';
             sie : m:='Sie m'+lue_kc+'ssen erst '+Noun(str,acc,t,i)+'verlassen';
             ihr : m:='Ihr m'+lue_kc+ss_kc+'t erst '+Noun(str,acc,t,i)+'verlassen';
           END;
         END;
    26 : IF actor<>NIL THEN m:=Noun(actor^.name.GetText,nom,t,i)+' mu'+ss_kc+' erst '+Noun(str,acc,t,i)+' verlassen'
                       ELSE m:=dontknow;
    27 : IF actor<>NIL THEN m:=Noun(str,nom,t,i)+' wird von '+Noun(str,dat,t,i)+' gehalten'
                       ELSE m:=dontknow;
    28 : BEGIN
           CASE player^.adress OF
             du  : m:='Du h'+lae_kc+'lsts bereits zuviel';
             sie : m:='Sie halten bereits zuviel';
             ihr : m:='Ihr haltet bereits zuviel';
           END;
         END;
    29 : m:=Noun(str,nom,t,1)+' ist bereits eingeschaltet';
    30 : m:=Noun(str,nom,t,1)+' ist bereits ausgeschaltet';
    31 : m:=Noun(str,nom,t,1)+' zeigt keine Reaktion';
    32 : m:=Noun(str,nom,t,1)+' ist tot';
    33 : m:=Noun(actor^.name.GetText,nom,t,i)+' kommt nicht an '+Noun(str,acc,f,i)+' heran';
    34 : m:='Ich bin mir nicht sicher, worauf sich das Wort '+#34+str+#34+' bezieht';
    35 : BEGIN
           CASE player^.adress OF
             du  : m:='Du bist';
             sie : m:='Sie sind';
             ihr : m:='Ihr seit';
           END;
           m:=m+' zu gro'+ss_kc+' bzw. zu schwer';
         END;
    36 : m:=Noun(actor^.name.GetText,nom,t,i)+' h'+lae_kc+'lt '+Noun(str,acc,t,i)+' bereits';
    37 : m:='Vom '+ShortName(player^.inside^.name.GetText,0)+' aus geht das nicht';
    ELSE m:=dontknow;
  END;
  IF COPY(m,LENGTH(m),1)<>'?' THEN m:=m+'.';
  Print('\b'+m+'\n');
END;

{
  Standardwoerterbuch
}
PROCEDURE TGame.ReadLib;
BEGIN
  AddVerb('ber'+lue_kc+'hre;beruehre','reachable;held',touch_ev);
  AddVerb('betrete','reachable',enter_ev);
  AddVerb('dr'+lue_kc+'ck;drueck;dr'+lue_kc+'cke;druecke;bet'+lae_kc+'tige','reachable;held',press_ev);
  AddVerb('gebe;gib;reiche;biete','npc+@held;held+npc;[mir]+held',give_ev);
  AddVerb('gehe','[in]+reachable;[auf]+reachable',enter_ev);
  AddVerb('gehe','[aus]+reachable;[aus]+reachable+[raus]',leave_ev);
  AddVerb('i'+ss_kc+';iss','reachable;held',eat_ev);
  AddVerb('k'+lue_kc+'sse;k'+lue_kc+ss_kc+';kuesse;kuess','npc;[mich]',kiss_ev);
  AddVerb('lege;wirf;werfe;schmei'+ss_kc,'held+[weg]',drop_ev);
  AddVerb('lege;wirf;werfe;schmei'+ss_kc,'held+[in]+reachable',drop_ev);
  AddVerb('lege;wirf;werfe;schmei'+ss_kc,'held+[in]+held',drop_ev);
  AddVerb('lies;lese','reachable;held',read_ev);
  AddVerb('nimm;nehme','reachable;reachable+[aus]+reachable;held+[aus]+held',take_ev);
  AddVerb(loe_kc+'ffne','held;reachable;reachable+[mit]+held;held+[mit]+held',open_ev);
  AddVerb(loe_kc+'ffne','[mit]+held+@reachable',open_ev);
  AddVerb('riech;rieche','',smell_ev);
  AddVerb('riech;rieche','[an]+reachable;[an]+held;[am]+held;[am]+reachable',smell_ev);
  AddVerb('schalte','reachable+[ein";held+[ein]',switchon_ev);
  AddVerb('schalte','reachable+[aus";held+[aus]',switchoff_ev);
  AddVerb('schau;siehe','',look_ev);
  AddVerb('schlafe','',sleep_ev);
  AddVerb('schlie'+ss_kc+';schlie'+ss_kc+'e','reachable;held',close_ev);
  AddVerb('setze;setz','[dich]+[auf]+reachable;[dich]+[in]+reachable',enter_ev);
  AddVerb('setze;setz','[dich]+[aufs]+reachable;[dich]+[ins]+reachable',enter_ev);
  AddVerb('spring;springe','',jump_ev);
  AddVerb('steige;steig','[auf]+reachable;[aufs]+reachable',enter_ev);
  AddVerb('steige;steig','[in]+reachable;[ins]+reachable',enter_ev);
  AddVerb('steige;steig','[vom]+reachable;[aus]+reachable',leave_ev);
  AddVerb('tanz;tanze','',dance_ev);
  AddVerb('tanz;tanze','[mit]+npc;[mit]+[mir]',dance_ev);
  AddVerb('t'+loe_kc+'te;erschlage;meuchel','npc;npc+[mit]+held',kill_ev);
  AddVerb('trinke;trink','reachable;held',drink_ev);
  AddVerb('us;untersuche;betrachte','reachable;held',examine_ev);
  AddVerb('verlasse','reachable',leave_ev);
  AddVerb('verschlie'+ss_kc+';verschlie'+ss_kc+'e','reachable;reachable+[mit]+held',lock_ev);
  AddVerb('verschlie'+ss_kc+';verschlie'+ss_kc+'e','held;held+[mit]+held',lock_ev);
  AddVerb('verschlie'+ss_kc+';verschlie'+ss_kc+'e','[mit]+held+@reachable;[mit]+held+@held',lock_ev);
  AddVerb('warte','',wait_ev);
  AddVerb('zeige','npc+held;[mir]+held',show_ev);
  AddVerb('#ende','',quit_ev);
  AddVerb('#beschreibung;#b','',set2_ev);
  AddVerb('#inventar;#inv;#i','',inv_ev);
  AddVerb('#karte','',map_ev);
  AddVerb('#laden','',load_ev);
  AddVerb('#neu','',restart_ev);
  AddVerb('#punkte','',score_ev);
  AddVerb('#status','',set1_ev);
  AddVerb('#sichern','',save_ev);
  AddVerb('.browse','',lista_ev);
  AddVerb('.dec','noun',dec_ev);
  AddVerb('.list','noun',lists_ev);
  AddVerb('.trace','noun',trace_ev);
END;

{
  Fuegt dem Woerterbuch ein Verb hinzu
}
PROCEDURE TGame.AddVerb(_verb,_syntax : STRING; _event : BYTE);
VAR
  p1,p2 : PLib;
BEGIN
  IF pverb<>NIL THEN
  BEGIN
    p1:=pverb;
    WHILE p1^.next<>NIL DO p1:=p1^.next;
  END ELSE p1:=NIL;
  NEW(p2);
  WITH p2^ DO
  BEGIN
    verb.Init;
    verb.SetText(Lower(_verb),t);
    syntax.Init;
    IF _syntax<>'' THEN syntax.SetText(Lower(_syntax),t);
    message:=_event;
    prev:=p1;
    next:=NIL;
  END;
  IF pverb<>NIL THEN p1^.next:=p2
                ELSE pverb:=p2;
END;

{
  Entfernt alle Verben mit dem Ereignis _event aus dem Woerterbuch
}
PROCEDURE TGame.DelVerb(_event : BYTE);
VAR
  p1,p2 : PLib;
BEGIN
  p1:=pverb;
  WHILE p1<>NIL DO
  BEGIN
    p2:=p1^.next;
    IF p1^.message=_event THEN
    BEGIN
      IF p1=pverb THEN pverb:=pverb^.next;
      IF p1^.prev<>NIL THEN p1^.prev^.next:=p1^.next;
      IF p1^.next<>NIL THEN p1^.next^.prev:=p1^.prev;
      p1^.verb.Done;
      p1^.syntax.Done;
      DISPOSE(p1);
    END;
    p1:=p2;
  END;
END;

{
  Loescht das gesamte Woerterbuch
}
PROCEDURE TGame.ClearDictionary;
VAR
  p1,p2 : PLib;
BEGIN
  p1:=pverb;
  WHILE p1<>NIL DO
  BEGIN
    p2:=p1^.next;
    p1^.verb.Done;
    p1^.syntax.Done;
    DISPOSE(p1);
    p1:=p2;
  END;
  pverb:=NIL;
END;

PROCEDURE TGame.DetectNumeral(w0 : BYTE; VAR number : INTEGER; VAR ok : BOOLEAN);
VAR
  n0,error : INTEGER;
  i        : BYTE;
BEGIN
  ok:=f;
  VAL(buffer[w0],n0,error);
  IF error<>0 THEN
  BEGIN
    IF buffer[w0]<>'alle' THEN
    BEGIN
      FOR i:=2 TO 10 DO
      BEGIN
        IF Numeral(i)=buffer[w0] THEN
        BEGIN
          n0:=i;
          ok:=t;
        END;
      END;
    END ELSE BEGIN
               ok:=t;
               number:=-1;
             END;
  END ELSE ok:=t;
  IF ok THEN number:=n0;
END;

PROCEDURE TGame.QuitGame;
VAR
  m : STRING;
BEGIN
  CASE player^.adress OF
    du  : m:='Willst du das Spiel wirklich beenden? ';
    sie : m:='Wollen Sie das Spiel wirklich beenden? ';
    ihr : m:='Wollt Ihr das Spiel wirklich beenden? ';
  END;
  IF Question(m+' (j/n) ','jn')='j' THEN quit:=1;
END;

{
  Zum Sichern und Wiederherstellen des Spielstandes werden
  die variablen Daten aller Objekte als Bytes kodiert und
  Byte fuer Byte in eine untypisierte Datei geschrieben.
  So koennen leicht neue Variablen beruecksichtigt werden.
  Wegen eines Bugs in der Write Anweisung des FPC-Compilers
  kann kein File of Byte verwendet werden.
}
PROCEDURE TGame.SaveGame(n : BYTE);
VAR
  savefile : FILE;
  i        : WORD;
  p        : PBasic;
BEGIN
  {$IFNDEF delphi}
  ASSIGN(savefile,savestr+'.tt'+NumToStr(n));
  {$ELSE}
  ASSIGNFILE(savefile,savestr+'.tt'+NumToStr(n));
  {$ENDIF}
  REWRITE(savefile,1);
  IF IORESULT=0 THEN
  BEGIN
    WriteWord(savefile,time);        { Zunaechst Variablen von TGame speichern }
    player^.Store(savefile);         { dann die des Spielers }
    FOR i:=0 TO list.COUNT-1 DO  { dann die aller anderen Objekte }
    BEGIN
      p:=list.At(i);
      p^.Store(savefile);
    END;
    CLOSE(savefile);
  END ELSE Print('Spielstand kann nicht gespeichert werden');
END;

PROCEDURE TGame.LoadGame(n : BYTE);
VAR
  savefile : File;
  i        : WORD;
  p        : PBasic;
BEGIN
  {$IFNDEF delphi}
  ASSIGN(savefile,savestr+'.tt'+NumToStr(n));
  {$ELSE}
  ASSIGNFILE(savefile,savestr+'.tt'+NumToStr(n));
  {$ENDIF}
  RESET(savefile,1);
  IF IORESULT=0 THEN
  BEGIN
    ReadWord(savefile,time);
    player^.Load(savefile);
    FOR i:=0 TO list.COUNT-1 DO
    BEGIN
      p:=list.At(i);
      p^.Load(savefile);
    END;
    player^.position^.explored:=f;
    CLOSE(savefile);
  END ELSE Print('Spielstand kann nicht geladen werden');
END;

PROCEDURE TGame.UserSave;
VAR
  s        : FILE OF TSave;
  vol      : TSave;
  i,n      : BYTE;
  str      : STRING;
BEGIN
  FOR i:=1 TO maxsave DO vol[i]:='';
  {$IFNDEF delphi}
  ASSIGN(s,savestr+'.sav');
  {$ELSE}
  ASSIGNFILE(s,savestr+'.sav');
  {$ENDIF}
  RESET(s);
  READ(s,vol);
  IF IORESULT=0 THEN CLOSE(s);
  IF vol[maxsave]='' THEN
  BEGIN
    n:=0;
    FOR i:=1 TO maxsave DO IF (n=0) AND (vol[i]='') THEN n:=i;
  END ELSE n:=1;
  Print('Spielstand: ');
  Scan(str,f,f,history);
  str:=LOWER(str);
  FOR i:=1 TO maxsave DO IF str=vol[i] THEN n:=i;
  vol[n]:=str;
  {$IFNDEF delphi}
  ASSIGN(s,savestr+'.sav');
  {$ELSE}
  ASSIGNFILE(s,savestr+'.sav');
  {$ENDIF}
  REWRITE(s);
  SYSTEM.WRITE(s,vol);
  CLOSE(s);
  SaveGame(n);
END;

PROCEDURE TGame.UserLoad;
VAR
  s        : FILE OF TSave;
  vol      : TSave;
  i,n      : BYTE;
  key      : CHAR;
  chars    : STRING;
BEGIN
  FOR i:=1 TO maxsave DO vol[i]:='';
  {$IFNDEF delphi}
  ASSIGN(s,savestr+'.sav');
  {$ELSE}
  ASSIGNFILE(s,savestr+'.sav');
  {$ENDIF}
  RESET(s);
  IF IORESULT=0 THEN
  BEGIN
    READ(s,vol);
    IF IORESULT=0 THEN
    BEGIN
      CLOSE(s);
      IF vol[2]<>'' THEN
      BEGIN
        chars:='0';
        FOR i:=1 TO maxsave DO
        BEGIN
          IF vol[i]<>'' THEN
          BEGIN
            Print(NumToStr(i)+') '+vol[i]+'\n');
            chars:=chars+NumToStr(i);
          END;
        END;
        key:=Question('Spielstand ('+chars[2]+'-'+chars[LENGTH(chars)]+') oder 0 f'+lue_kc+'r Abbruch: ',chars);
        IF key<>'0' THEN n:=ORD(key)-48
                    ELSE n:=0;
      END ELSE n:=1;
      IF n>0 THEN LoadGame(n);
    END ELSE Print('Kein Spielstand gespeichert\n');
  END;
END;

PROCEDURE TGame.InitEvent(VAR event : TEvent; _what,_maxexec : BYTE; _who : PItem; _first,_second : PNoun; _data : POINTER);
BEGIN
  WITH event DO
  BEGIN
    action:=_what;
    who:=_who;
    exec:=0;
    maxexec:=_maxexec;
    first:=_first;
    second:=_second;
    data:=_data;
    return:=f;
  END;
END;

{
  Position und Behaelter des Akteurs werden fuer die
  Bestimmung des Scopes benoetigt
}
FUNCTION TGame.ActorWhere : PRoom;
BEGIN
  IF actor=NIL THEN ActorWhere:=player^.position
               ELSE ActorWhere:=actor^.location;
END;

FUNCTION TGame.ActorInside(container : PItem) : BOOLEAN;
BEGIN
  IF actor=NIL THEN ActorInside:=player^.inside=container
               ELSE ActorInside:=actor^.inside=container;
END;

{
  MetaVerb wird vor Verarbeitung von Metaverben aufgerufen und kann
  ueberschrieben werden, um Metaverben neu zu definieren.
}
FUNCTION TGame.MetaVerb(mv : BYTE) : BOOLEAN;
BEGIN
  MetaVerb:=t;
END;

{
  Funktion zum routine Token. Kann Ueberschrieben werden, um eigene
  Regeln zur Erkennung von Objekten zu bestimmen.  
}
FUNCTION TGame.MyScope(_id : WORD; _action : BYTE) : BOOLEAN;
BEGIN
  MyScope:=t;
END;

{                                                            
  Stellt fest, ob das Objekt index zu dem Token ttype passt
  _action ist eine Ereigniskonstante und kann fuer eigene
  ScopeDefinitionen verwendet werden
                            
}
FUNCTION TGame.CmpScope(index,ttype,_action : BYTE) : BOOLEAN;
VAR
  ok : BOOLEAN;
  p  : PBasic;
  i  : PItem;
BEGIN
  ok:=f;
  p:=list.At(index);
  WITH p^ DO
  BEGIN
    CASE ttype OF
      held_tt      : ok:=Scope=held_sd;
      noun_tt      : ok:=t;
      npc_tt       : IF _class=item THEN
                     BEGIN
                       i:=list.At(index);
                       ok:=(i^.Scope<>notinroom_sd) AND (i^.matter=alive);
                     END;
      reachable_tt : ok:=(Scope=reachable_sd);
      routine_tt   : ok:=MyScope(GetID,_action);
    END;
  END;
  CmpScope:=ok;
END;

{
  Artikel und Pronomen erkennen
}
FUNCTION TGame.IsArtOrPron(str : STRING) : BOOLEAN;
CONST
  ap = 'der;die;das;dem;den;der;des;ein;eine;eines;einem;in;ins;im;auf;aufs';
VAR
  i,j  : BYTE;
  ok   : BOOLEAN;
  test : TBuffer;
BEGIN
  ok:=f;
  Separate(ap,';',test,i);
  FOR j:=1 TO i DO IF str=test[j] THEN ok:=t;
  IsArtOrPron:=ok;
END;

{
  SearchNoun sucht im Eingabepuffer ab der Position w0 nach dem Namen
  eines Objekts. Ein so gefundenes Objekt muss hinsichtlich der Zahl
  seiner Kopien zu der vom Spieler genannten Anzahl passen und mit dem
  Syntaxtoken (ttype) des gefundenen Verbs (_action) uebereinstimmen.
  Informationen ueber das gefundene Objekt werden im Token t0 gespeichert.
  Stimmt das gefundene Objekt nicht mit dem geforderten Syntaxtoken
  ueberein, dann verweist pfailed fuer eine Fehlermedlung auf dieses Objekt.
}
PROCEDURE TGame.SearchNoun(VAR w0 : BYTE; t0 : BYTE; VAR tfound : BYTE;
                           ttype,_action : BYTE; VAR userstr : STRING;
                           VAR pfailed : PBasic; VAR error : BOOLEAN);
VAR
  i,j,k,l,m : WORD;
  w1,
  maxname,
  maxsub,
  numerus   : BYTE;
  name,
  words     : TBuffer;
  pa,pb     : PBasic;
  casus     : TCasus;
  def,
  ok,
  isnum,
  all       : BOOLEAN;
  sub       : STRING;
BEGIN
  w1:=w0;
  all:=f;
  userstr:='';
  WITH nounstr[t0] DO
  BEGIN
    detect:=f;
    xroom:=NIL;
    xlink:=NIL;
    xitem:=NIL;
    REPEAT;
      {
        Numeral vor Substantiv merken und ueberspringen
      }
      DetectNumeral(w1,number,isnum);
      IF isnum THEN
      BEGIN
        IF number<=10 THEN
        BEGIN
          IF number<1 THEN
          BEGIN
            all:=t;
            number:=1;
          END;
          INC(w1);
        END ELSE ParserError(7,buffer[w1],1,error)
      END;
      {
        input um naechstes eingegebenes Wort erweitern
      }
      userstr:=userstr+buffer[w1];
      {
        Schleife ueber alle Objekte
      }
      i:=0;
      WHILE (i<list.COUNT) AND (NOT(detect)) DO
      BEGIN
        pa:=list.At(i);
        Separate(pa^.name.GetText,';',name,maxname);
        {
          Schleife ueber alle Namen des aktuellen Objekts
        }
        FOR j:=1 TO maxname DO
        BEGIN
          {
            Schleife ueber bestimmte und unbestimmte Artikel
          }
          FOR k:=1 TO 2 DO
          BEGIN
            def:=k=1;
            {
              Schleife ueber Singular- und Pluralform
            }
            FOR numerus:=1 TO 2 DO
            BEGIN
              {
                Schleife ueber alle Faelle
              }
              FOR casus:=nom TO dat DO
              BEGIN
                {
                  Wenn Eingabe noch nicht erkannt
                }
                IF NOT(detect) THEN
                BEGIN
                  {
                    Artikel, Adjektiv und Nomen trennen und einzelne
                    Kombinationen mit Eingabe vergleichen
                  }
                  sub:=Noun(Lower(name[j]),casus,def,numerus);
                  FOR l:=1 TO maxbuf DO words[l]:='';
                  Separate(sub,' ',words,maxsub);
                  CASE maxsub OF
                    1 : ok:=sub=userstr;
                    2 : ok:=(sub=userstr) OR (words[2]=userstr);
                    3 : ok:=(sub=userstr) OR (words[3]=userstr) OR (words[2]+' '+words[3]=userstr) OR
                            (words[1]+' '+words[3]=userstr);
                  END;
                  {
                    Adjektiv in Eingabe suchen
                  }
                  adj:=f;
                  IF (ok) AND (maxsub>1) THEN
                  BEGIN
                    FOR l:=1 TO maxsub-1 DO
                    BEGIN
                      IF (words[l]<>#0) AND (NOT(IsArtOrPron(words[l]))) AND
                         (POS(words[l],userstr)>0) THEN adj:=t;
                    END;
                  END;
                  {
                    Wenn Objekt am Namen erkannt
                  }
                  IF (ok) AND (NOT(error)) THEN
                  BEGIN
                    {
                      Anzahl der genannten Substantive feststellen
                    }
                    IF ((all) AND (numerus=2)) OR
                       ((NOT(all)) AND (number=0) AND (numerus=2)) THEN
                    BEGIN
                      number:=0;
                      FOR l:=0 TO list.COUNT-1 DO
                      BEGIN
                        pb:=list.At(l);
                        IF (CmpName(pa^.name.GetText,pb^.name.GetText,adj)) AND
                           (pa^.Scope=pb^.Scope) THEN INC(number);
                      END;
                    END;
                    IF number=0 THEN
                    BEGIN
                      IF numerus=2 THEN number:=pa^.copies
                                   ELSE number:=1;
                    END;
                    {
                      Anzahl von Objekten mit genanntem Numerus des
                      Substantivs vergleichen
                    }
                    IF pa^.copies<number THEN
                    BEGIN
                      {
                        Wenn Numerus nicht uebereinstimmt, dann nach weiteren
                        Kopien des genannten Objekts suchen
                      }
                      l:=0;
                      FOR m:=0 TO list.COUNT-1 DO
 
                      BEGIN
                        pb:=list.At(m);
                        IF (CmpName(pb^.name.GetText,pa^.name.GetText,adj)) AND
                           (pb^.Scope=pa^.Scope) THEN INC(l);
                      END;
                      IF l<number THEN
                      BEGIN
                        sub:=Noun(name[j],nom,f,2);
                        IF NOT(adj) THEN DELETE(sub,1,POS(' ',sub));
                        ParserError(6,sub,2,error);
                      END;
                    END;
                    IF (pa^.copies>1) AND (numerus=1) AND (def) THEN
                    BEGIN
                      sub:=Noun(name[j],acc,t,1);
                      ParserError(5,InterPron(name[j],acc)+COPY(sub,POS(' ',sub),255),1,error);
                    END;
                    IF NOT(error) THEN
                    BEGIN
                      {
                        Auf Uebereinstimmung mit Token pruefen.
                      }
                      detect:=CmpScope(i,ttype,_action);
                      {
                        Wenn erkanntes Objekt nicht zum Syntaxtoken passt,
                        dann Objekt fuer Fehlermeldung merken
                      }
                      IF (NOT(detect)) AND (tfound=0) THEN
                      BEGIN
                        pfailed:=list.At(i);
                        tfound:=ttype;
                      END;
                    END;
                  END;
                END;
              END;
            END;
          END;
        END;
        INC(i);
      END;
      IF detect THEN
      BEGIN
        {
          Objekt erkannt, Klasse merken und feststellen, ob sich
          Positionen einzelner Kopien unterscheiden
        }
        CASE pa^._class OF
          room : xroom:=Adr(pa^.id);
          link : xlink:=Adr(pa^.id);
          item : xitem:=Adr(pa^.id);
        END;
      END ELSE BEGIN
                 {
                   Eingabe noch nicht erkannt,
                   Wortzaehler inkrementieren
                 }
                 userstr:=userstr+' ';
                 INC(w1);
               END;
    UNTIL (detect) OR (w1>maxwords);
    {
      Wenn erkannt, Wortzaehler auf Wort nach erkanntem
      Substantiv setzen. Andernfalls unbekanntes Substantiv
      merken, dabei Artikel und Pronomen ueberspringen
    }
    IF detect THEN w0:=w1+1
              ELSE IF IsArtOrPron(userstr) THEN userstr:=buffer[w0+1]
                                           ELSE userstr:=buffer[w0];
  END;
END;

{
  Parse interpretiert die Spielereingabe. Dabei wird zuerst festgestellt,
  ob der Spieler selber handelt, einem NPC eine Anweisung gibt oder zu
  einem NPC spricht. Anschliessend wird in der Eingabe ein Verb mit
  passender Tokenfolge gesucht. Kann die Eingabe interpretiert werden,
  dann wird das zum gefundenen Verb gehoerende Ereignis an alle betroffenen
  Objekte geschickt.
}
PROCEDURE TGame.Parse(line : STRING);
CONST
  maxsymbols = 7;
  token      : ARRAY[1..maxsymbols] OF TToken
             = ((tstr: 'held';      tnum: held_tt),
                (tstr: 'noun';      tnum: noun_tt),
                (tstr: 'npc';       tnum: npc_tt),
                (tstr: 'number';    tnum: number_tt),
                (tstr: 'quote';     tnum: quote_tt),
                (tstr: 'reachable'; tnum: reachable_tt),
                (tstr: 'routine';   tnum: routine_tt));
  dirstr     : ARRAY[north..down] OF STRING
             = ('n;norden',
                'no;nordosten',
                'o;osten',
                'so;s'+lue_kc+'dosten',
                's;s'+lue_kc+'den;sueden',
                'sw;s'+lue_kc+'dwesten;suedwesten',
                'w;westen',
                'nw;nordwesten',
                'oben;aufw'+lae_kc+'rts;aufwaerts;rauf;hoch',
                'unten;abw'+lae_kc+'rts;abwaerts;runter');
  rp          : ARRAY[0..4] OF STRING = ('ihn','sie','es','ihm','ihr');
VAR
  error,
  ok,
  goout,
  found,
  match1,
  match2,
  moresyntax      : BOOLEAN;
  vlist,
  slist,
  plist           : TBuffer;
  pdictionary,
  psearch         : PLib;
  pfailed,
  prec1,prec2     : PBasic;
  ptest           : PItem;
  event           : TEvent;
  i,j,k,l,m,n,
  tc,t1,t2,w0,w1,
  maxverb,
  maxsyntax,
  maxtoken,
  npc,
  tfound          : BYTE;
  input           : ARRAY[1..maxbuf] OF STRING;
  s1,f1,f2        : STRING;
  c               : TCasus;
  tp              : CHAR;
  d               : TDir;
  PROCEDURE ClearToken;
  VAR
    t0 : BYTE;
  BEGIN
    FOR t0:=1 TO maxbuf DO
    BEGIN
      input[t0]:='';
      WITH nounstr[t0] DO
      BEGIN
        detect:=f;
        number:=0;
        xroom:=NIL;
        xlink:=NIL;
        xitem:=NIL;
      END;
    END;
  END;
BEGIN
  ClearToken;
  {
    Komma signalisiert Kommando oder Mitteilung an NPC
  }
  i:=POS(#44,line);
  IF i>0 THEN
  BEGIN
    INSERT(' ',line,i);
    IF line[i+2]<>#32 THEN INSERT(' ',line,i+2);
    npc:=1;
  END ELSE npc:=0;
  {
    Reflexivpronomen suchen und gegen letztes Substantiv tauschen
  }
  IF (POS(#34,line)=0) AND (refpro<>NIL) THEN
  BEGIN
    FOR i:=0 TO 4 DO
    BEGIN
      j:=POS(rp[i],line);
      k:=LENGTH(rp[i]);
      IF j>1 THEN tp:=line[j-1]
             ELSE tp:=#0;
      IF (j>1) AND (tp=#32) AND ((j+k-1=LENGTH(line)) OR (COPY(line,j+k,1)=#32)) THEN
      BEGIN
        WITH refpro^ DO
        BEGIN
          IF xitem<>NIL THEN prec1:=xitem
                        ELSE IF xlink<>NIL THEN prec1:=xlink
                                           ELSE prec1:=xroom;
          s1:=prec1^.name.GetText;
          CASE s1[1] OF
            '+' : error:=(i<>0) AND (i<>3);
            '-' : error:=(i<>1) AND (i<>4);
            ELSE error:=f;
          END;
          IF NOT(error) THEN
          BEGIN
            IF i<3 THEN c:=acc
                   ELSE c:=dat;
            DELETE(line,j,LENGTH(rp[i]));
            WITH prec1^ DO INSERT(Noun(name.GetText,c,t,copies),line,j);
          END ELSE ParserError(33,rp[i],1,error);
        END;
      END;
    END;
  END;
  {
    Woerter aus Eingabestring in buffer uebertragen
  }
  Separate(Lower(line),' ',buffer,maxwords);
  IF maxwords>0 THEN
  BEGIN
    w0:=1;
    tc:=1;
    tfound:=0;
    error:=f;
    actor:=NIL;
    pfailed:=NIL;
    IF npc>0 THEN
    BEGIN
      {
        angesprochenen NPC suchen
      }
      SearchNoun(w0,tc,tfound,2,tell_ev,input[1],pfailed,error);
      IF NOT(error) THEN
      BEGIN
        {
          Kommando oder freie Rede in Anfuehrungszeichen?
        }
        IF (buffer[maxwords][1]=#34) AND
           (buffer[maxwords][LENGTH(buffer[maxwords])]=#34) THEN
        BEGIN
          npc:=2; { Freie Rede }
          DELETE(buffer[w0+1],1,1);
          DELETE(buffer[maxwords],LENGTH(buffer[maxwords]),1);
        END;
        WITH nounstr[1] DO
        BEGIN
          IF detect THEN
          BEGIN
            INC(w0);
            IF xitem<>NIL THEN
            BEGIN
              WITH xitem^ DO
              BEGIN
                i:=0;
                CASE matter OF
                  alive    : BEGIN
                                actor:=xitem;
                                IF (npc=2) AND (NOT(Has(talkable_at))) THEN i:=31;
                              END;
                  dead      : IF npc=1 THEN i:=3
                                       ELSE i:=32;
                  inanimate : IF npc=1 THEN i:=2
                                       ELSE IF NOT(Has(talkable_at)) THEN i:=31;
                END;
                IF i>0 THEN ParserError(i,name.GetText,1,error)
                       ELSE IF npc=2 THEN
                            BEGIN
                              InitEvent(event,tell_ev,1,actor,NIL,NIL,@buffer[3]);
                              actor^.HandleEvent(event);
                            END;
              END;
            END ELSE BEGIN
                       IF xroom<>NIL THEN input[1]:=xroom^.name.GetText
                                       ELSE IF xlink<>NIL THEN input[1]:=xlink^.name.GetText;
                       ParserError(2,input[1],1,error);
                     END;
          END ELSE ParserError(1,input[1],1,error);
        END;
      END;
    END;
    IF (NOT(error)) AND (npc<2) THEN
    BEGIN
      ok:=f;
      found:=f;
      pdictionary:=pverb;
      {
        Hauptschleife durchlaufen bis ein Verb gefunden wird, dessen
        Tokenliste mit der Eingabe uebereinstimmt.
      }
      WHILE (pdictionary<>NIL) AND (NOT(ok)) DO
      BEGIN
        WITH pdictionary^ DO
        BEGIN
          Separate(verb.GetText,';',vlist,maxverb);  { Synonyme trennen }
          FOR i:=1 TO maxverb DO
          BEGIN
            {
              Debug- und Metaverben erkennen
            }
            IF (vlist[i][1]='#') OR ((vlist[i][1]='.') AND (debug)) THEN
            BEGIN
              meta:=vlist[i][1]='#';
              IF NOT(meta) THEN DELETE(vlist[i],1,1);
            END ELSE meta:=f;
            IF vlist[i]=buffer[w0] THEN
            BEGIN
              {
                Wenn Verb in Eingabe gefunden
              }
              found:=t;
              IF syntax.HasText THEN   { Tokenfolge pruefen }
              BEGIN
                Separate(syntax.GetText,';',slist,maxsyntax);
                FOR j:=1 TO maxsyntax DO
                BEGIN
                  IF NOT(ok) THEN
                  BEGIN
                    WITH event DO
                    BEGIN
                      first:=NIL;
                      second:=NIL;
                    END;
                    t1:=0;
                    t2:=0;
                    ClearToken;
                    Separate(slist[j],'+',plist,maxtoken);
                    w1:=w0+1;
                    k:=0;
                    {
                      Schleife ueber einzelne Token des Verbs
                    }
                    FOR l:=1 TO maxtoken DO  
                    BEGIN
                      n:=0;
                      {
                        Token suchen und in n speichern
                      }
                      FOR m:=1 TO maxsymbols DO
                      BEGIN
                        IF (plist[l]=token[m].tstr) OR ((plist[l][1]='@') AND
                           (COPY(plist[l],2,255)=token[m].tstr)) THEN
                           n:=token[m].tnum;
                      END;
                      IF (n=quote_tt) OR (n=number_tt) THEN
                      BEGIN
                        {
                          Beliebiges Wort in eckigen Klammern
                        }
                        IF (n=quote_tt) AND (COPY(plist[l],1,1)=#91) AND
                           (COPY(plist[l],LENGTH(plist[l]),1)=#93) THEN
                        BEGIN
                          WITH nounstr[l] DO
                          BEGIN
                            detect:=buffer[w1]=COPY(plist[l],2,LENGTH(plist[l])-2);
                            input[l]:=buffer[w1];
                          END;
                        END;
                        {
                          Numeral
                        }
                        IF n=number_tt THEN WITH nounstr[l] DO DetectNumeral(w1,number,detect);
                        {
                          Weder beliebiges [Wort] noch Numeral
                        }
                        IF NOT(nounstr[l].detect) THEN
                        BEGIN
                          IF n=0 THEN
                          BEGIN
                            IF (plist[l][1]<>#91) AND (plist[l][LENGTH(plist[l])]<>#93) THEN
                               Warning('Unbekanntes Token '+plist[l]);
                          END ELSE ParserError(1,buffer[w1],1,error);
                        END ELSE INC(w1);
                      END ELSE BEGIN
                                 {
                                   Substantive in Eingabe und dazugehoerige
                                   Objekte suchen.
                                 }
                                 SearchNoun(w1,l,tfound,n,message,input[l],pfailed,error);
                                 IF NOT(error) THEN
                                 BEGIN
                                   WITH event DO
                                   BEGIN
                                     IF first=NIL THEN
                                     BEGIN
                                       t1:=n;
                                       first:=@nounstr[l];
                                     END ELSE IF second=NIL THEN
                                              BEGIN
                                                IF plist[l][1]='@' THEN
                                                BEGIN
                                                  t2:=t1;
                                                  t1:=n;
                                                  second:=first;
                                                  first:=@nounstr[l];
                                                END ELSE BEGIN
                                                           t2:=n;
                                                           second:=@nounstr[l];
                                                         END;
                                                IF first=second THEN ParserError(4,'',1,error);
                                              END ELSE ParserError(8,'',1,error);
                                   END;
                                 END;
                               END;
                      IF nounstr[l].detect THEN INC(k);
                    END;
                  END;
                  {
                    Erfolg wenn alle zum Verb gehoerenden Token mit
                    der Eingabe uebereinstimmen und alle eingebenen
                    Woerter erkannt wurden.
                  }
                  ok:=(k=maxtoken) AND (w1>maxwords);
                END;
              END ELSE IF (maxwords=1) OR ((npc=1) AND (maxwords=3)) THEN
                       BEGIN
                         WITH event DO
                         BEGIN
                           first:=NIL;
                           second:=NIL;
                         END;
                         ok:=t;
                       END ELSE BEGIN
                                  {
                                    Eingabe enthaelt fuer aktuelle Syntax
                                    zuviele Woerter, nach anderer Syntax zu
                                    gleichem Verb suchen.
                                  }
                                  moresyntax:=f;
                                  psearch:=pdictionary^.next;
                                  WHILE (psearch<>NIL) AND (NOT(moresyntax)) DO
                                  BEGIN
                                    moresyntax:=syntax.GetText=psearch^.syntax.GetText;
                                    psearch:=psearch^.next;
                                  END;
                                  IF NOT(moresyntax) THEN ParserError(1,buffer[2],1,error);
                                END;
              IF (ok) AND (NOT(error)) THEN
              BEGIN
                IF NOT(meta) THEN
                BEGIN                  
                  WITH event DO
                  BEGIN
                    {
                      Substantiv fuer Reflexivpronomen merken
                    }
                    IF refpro<>NIL THEN
                    BEGIN
                      DISPOSE(refpro);
                      refpro:=NIL;
                    END;
                    IF first<>NIL THEN
                    BEGIN
                      NEW(refpro);
                      refpro^:=first^;
                    END;
                    {
                      Nachricht an Objekte vorbereiten
                    }
                    action:=message;
                    who:=actor;
                    exec:=0;
                    data:=NIL;
                    return:=f;
                    {
                      Anzahl an Aktion beteiligter Objekte und
                      deren Namen feststellen
                    }
                    IF first<>NIL THEN
                    BEGIN
                      maxexec:=first^.number;
                      IF first^.xitem<>NIL THEN f1:=first^.xitem^.name.GetText
                                           ELSE IF first^.xlink<>NIL THEN f1:=first^.xlink^.name.GetText
                                                                     ELSE IF first^.xroom<>NIL THEN
                                                                             f1:=first^.xroom^.name.GetText;
                      IF second<>NIL THEN
                      BEGIN
                        IF second^.xitem<>NIL THEN f2:=second^.xitem^.name.GetText
                                              ELSE IF second^.xlink<>NIL THEN f2:=second^.xlink^.name.GetText
                                                                         ELSE IF second^.xroom<>NIL THEN
                                                                                 f2:=second^.xroom^.name.GetText;
                      END;
                    END ELSE BEGIN
                               maxexec:=1;
                               f1:='';
                               f2:='';
                             END;
                  END;
                  {
                    Nachricht an alle beteiligten Objekte senden
                  }
                  FOR k:=0 TO list.COUNT-1 DO
                  BEGIN
                    IF event.exec<event.maxexec THEN
                    BEGIN
                      match1:=f;
                      match2:=f;
                      WITH event DO
                      BEGIN
                        IF first<>NIL THEN  { Am Ereignis ist mindestens ein Objekt beteiligt }
                        BEGIN
                          prec1:=list.At(k);
                          IF (t1 IN [quote_tt,number_tt,noun_tt]) OR
                             ((CmpName(prec1^.name.GetText,f1,first^.adj)) AND
                             (CmpScope(k,t1,message))) THEN
                          BEGIN
                            match1:=t;
                            IF second<>NIL THEN
                            BEGIN
                              l:=0;
 
                              REPEAT;
                                prec2:=list.At(l);
                                match2:=(t2 IN [quote_tt,number_tt,noun_tt]) OR
                                        ((CmpName(prec2^.name.GetText,f2,second^.adj)) AND
                                        (CmpScope(l,t2,message)));
                                INC(l);
                              UNTIL match2;
                            END ELSE match2:=t;
                          END;
                        END ELSE BEGIN
                                   match1:=t;
                                   match2:=t;
                                   prec1:=list.At(k);
                                 END;
                      END;
                      IF (match1) AND (match2) THEN
                      BEGIN 
                        prec1^.HandleEvent(event);  
                        WITH event DO IF (return) OR (replay) THEN INC(exec);
                      END;
                    END;
                  END;
                  IF event.exec=0 THEN Warning(#34+vlist[i]+#34+' wurde nicht bearbeitet');
                END ELSE IF MetaVerb(message) THEN
                         BEGIN
                           CASE message OF
                             inv_ev     : player^.Inventory;
                             load_ev    : UserLoad;
                             map_ev     : DrawMap;
                             quit_ev    : QuitGame;
                             restart_ev : quit:=2;
                             save_ev    : UserSave;
                             score_ev   : Print(player^.RankStr);
                             set1_ev    : BEGIN
                                            IF statusline THEN
                                            BEGIN
                                              WRITELN;
                                              k:=WHEREY;
                                              WINDOW(1,1,maxcol,maxrow);
                                              GOTOXY(1,1);
                                              CLREOL;
                                              statusline:=f;
                                              GOTOXY(1,k);
                                            END ELSE BEGIN
                                                       GOTOXY(1,WHEREY-1);
                                                       statusline:=t;
                                                       DrawStatusline(f);
                                                     END;
                                          END;
                             set2_ev    : verbose:=NOT(verbose);
                           END;
                         END;
              END;
            END;
          END;
        END;
        {
          Mit naechstem Verb fortfahren
        }
        pdictionary:=pdictionary^.next;
      END;
      IF (NOT(ok)) AND (NOT(error)) THEN
      BEGIN
        {
          Wenn Eingabe mit keinem Verb uebereinstimmt, dann auf
          Richtungsangabe pruefen. Folgende Angaben werden erkannt:
          - NPC, gehe nach (Richtung)
          - NPC, (Richtung)
          - Gehe nach (Richtung)
          - (Richtung)
        }
        IF (maxwords IN [1,3,5]) AND
           (((POS(buffer[w0],'gehe,laufe')>0) AND (buffer[w0+1]='nach')) OR
           ((maxwords=1) OR ((actor<>NIL) AND (maxwords=3))))  THEN
        BEGIN
          goout:=f;
          w1:=w0+2;
          FOR d:=north TO down DO
          BEGIN
            Separate(dirstr[d],';',plist,i);
            FOR k:=1 TO i DO
            BEGIN
              IF (plist[k]=buffer[w0]) OR (plist[k]=buffer[w1]) THEN
              BEGIN
                ok:=t;
                IF ((actor=NIL) AND ((player^.inside=NIL) OR (player^.inside^.Has(moveable_at)))) OR
                   ((actor<>NIL) AND ((actor^.inside=NIL) OR (actor^.inside^.Has(moveable_at)))) THEN
                BEGIN
                  WITH player^.position^ DO
                  BEGIN
                    WITH event DO
                    BEGIN
                      action:=go_ev;
                      who:=actor;
                      exec:=1;
                      data:=@d;
                      return:=f;
                    END;
                    HandleEvent(event);
                  END;
                END ELSE goout:=t;
              END;
            END;
            IF goout THEN
            BEGIN
              IF actor=NIL THEN ParserError(25,player^.inside^.name.GetText,1,error)
                           ELSE ParserError(26,actor^.inside^.name.GetText,1,error);
            END;
          END;
        END;
        IF NOT(ok) THEN  { Auch keine Richtungsangabe erkannt }
        BEGIN
          {
            Wenn wenigstens das Verb erkannt wurde
          }
          IF found THEN
          BEGIN
            i:=maxtoken;
            WHILE (nounstr[i].detect) AND (i>1) DO DEC(i);
            WITH nounstr[i] DO
            BEGIN
              IF tfound>0 THEN
              BEGIN
                {
                  Substantiv und zugehoeriges Objekt wurden zwar gefunden,
                  stimmten aber mit gefordertem Token nicht ueberein.
                }
                k:=pfailed^.Scope;
                IF k<>notinroom_sd THEN
                BEGIN
                  CASE tfound OF
                    held_tt      : IF actor=NIL THEN
                                   BEGIN
                                     IF (k=visible_sd) AND
                                        (player^.inside<>NIL) THEN l:=37
                                        ELSE l:=17
                                   END ELSE l:=18;

                    npc_tt       : IF pfailed^._class=item THEN
                                   BEGIN
                                     ptest:=Adr(pfailed^.id);
                                     IF ptest^.matter=inanimate THEN l:=31
                                                                ELSE l:=32;
                                   END ELSE l:=9;
                    reachable_tt : IF actor=NIL THEN
                                   BEGIN
                                     IF k<>held_sd THEN l:=11
                                                   ELSE l:=12;
                                   END ELSE IF k<>held_sd THEN l:=33
                                                          ELSE l:=36;
                    routine_tt   : l:=9;

                  END;
                END ELSE l:=10;
                ParserError(l,pfailed^.name.GetText,pfailed^.copies,error);
              END ELSE BEGIN
                         WHILE (IsArtOrPron(buffer[w1])) AND (w1<=maxwords) DO INC(w1);
                         ParserError(1,buffer[w1],1,error);
                       END;
            END;
            {
              Parser versteht ueberhaupt nichts
            }
          END ELSE ParserError(4,'',1,error);
        END;
      END;
    END;
  END;
END;

PROCEDURE TGame.BeforeParsing(VAR input : STRING);
BEGIN
END;

PROCEDURE TGame.AddProlog(_str : STRING);
BEGIN
  prologue^.SetText(_str,f);
END;

PROCEDURE TGame.WriteProlog;
BEGIN
  prologue^.PrintText;
  GOTOXY(1,24);
END;

FUNCTION TGame.GetActor : PItem;
BEGIN
  GetActor:=actor;
END;

PROCEDURE TGame.SetTime(_time,_rate : WORD);
BEGIN
  time:=_time;
  rate:=_rate;
END;

PROCEDURE TGame.GetTime(VAR hour,min : BYTE);
BEGIN
  hour:=time DIV 60;
  min:=time-hour*60;
END;

{
  Wird von DrawMap aufgerufen, um ausgehend vom aktuellen Raum rekursiv
  eine Karte zu zeichnen. Eingetragen wird die Karte in die Stringliste
  von PMap. Die Karte ist dabei auf die Anzahl von Bildschirmzeilen und
  Spalten begrenzt.
}
PROCEDURE TGame.Mapping(p : PRoom; x0,y0 : SHORTINT; VAR map : PMap);
CONST
  mx : ARRAY[north..northwest] OF SHORTINT = (5,11,11,11,5,-1,-1,-1);
  my : ARRAY[north..northwest] OF SHORTINT = (-1,-1,0,1,1,1,0,-1);
  nx : ARRAY[north..northwest] OF SHORTINT = (0,12,12,12,0,-12,-12,-12);
  ny : ARRAY[north..northwest] OF SHORTINT = (-2,-2,0,2,2,2,0,-2);
  c  : ARRAY[north..northwest] OF CHAR = ('I','/','-','\','I','/','-','\');
VAR
  n1,n2 : STRING[11];
  room  : PRoom;
  i     : TDir;
  PROCEDURE XYDraw(x1,y1 : SHORTINT; str : STRING);
  VAR
    l : BYTE;
  BEGIN
    IF y1 IN [1..maxrow] THEN
    BEGIN
      l:=LENGTH(str);
      IF (x1<2) OR (x1+l>maxcol-1) THEN
      BEGIN
        WHILE str[1]='#' DO
        BEGIN
          DELETE(str,1,1);
          str:=str+'#';
        END;
        IF x1<2 THEN
        BEGIN
          IF x1+l>0 THEN
          BEGIN
            str:=COPY(str,1,x1+l);
            map^.InsStr(2,y1,str);
          END;
        END ELSE map^.InsStr(x1,y1,COPY(str,1,maxcol-x1-1));
      END ELSE map^.InsStr(x1,y1,str);
    END;
  END;
BEGIN
  WITH p^ DO
  BEGIN
    IF ((explored) OR (debug)) AND (NOT(flag)) THEN
    BEGIN
      flag:=t;
      n1:='###########';
      IF HasLight THEN n2:=Upper(COPY(ShortName(name.GetText,0),1,11))
                  ELSE n2:='##Dunkel##';
      INSERT(n2,n1,6-LENGTH(n2) DIV 2);
      XYDraw(x0,y0,n1);
      FOR i:=north TO northwest DO
      BEGIN
        IF gate[i]<>NIL THEN
        BEGIN
          XYDraw(x0+mx[i],y0+my[i],c[i]);
          IF gate[i]^.r2=p THEN room:=gate[i]^.r1
                           ELSE room:=gate[i]^.r2;
          Mapping(room,x0+nx[i],y0+ny[i],map);
        END;
      END;
    END;
  END;
END;

{
  Gibt Karte der besuchten Raeume aus
}
PROCEDURE TGame.DrawMap;
VAR
  i,j : BYTE;
  map : PMap;
BEGIN
  NEW(map,Init);
  i:=maxcol DIV 2-6;
  j:=maxrow DIV 2;
  Mapping(player^.position,i,j,map);
  ResetAll;
  map^.Show;
  DISPOSE(map,Done);
  replay:=t;
END;

PROCEDURE TGame.Browser;
CONST
  cstr : ARRAY[T_Class] OF STRING[4] = ('Room','Link','Item');
VAR
  i   : WORD;
  key : CHAR;
  p   : PBasic;
BEGIN
  i:=0;
  key:=#1;
  REPEAT;
    p:=list.At(i);
    WRITELN('Index:  '+NumToStr(i));
    WRITELN('ID:     '+NumToStr(p^.GetID));
    WRITELN('Klasse: '+cstr[p^._class]);
    p^.View;
    InversText;
    WRITE(' Weiter oder Abbruch mit [ESC] ');
    NormalText;
    WHILE (key<>esc_kc) AND (key<>#0) DO key:=READKEY;
    GOTOXY(1,WHEREY);
    CLREOL;
    GOTOXY(1,WHEREY);
    IF key=#0 THEN
    BEGIN
      key:=READKEY;
      CASE key OF
        down_kc : IF i<list.COUNT-1 THEN INC(i)
                                    ELSE i:=0;
        up_kc   : IF i>0 THEN DEC(i)
                             ELSE i:=list.COUNT-1;
        pdown_kc : IF i+5<=list.COUNT-1 THEN INC(i,5)
                                        ELSE i:=list.COUNT-1;
        pup_kc   : IF i-5>=0 THEN DEC(i,5)
                                 ELSE i:=0;
        home_kc  : i:=0;
        end_kc   : i:=list.COUNT-1;
      END;
    END;
    IF key<>esc_kc THEN WRITELN;
  UNTIL key=esc_kc;
  replay:=t;
END;

PROCEDURE TGame.Run;
VAR
  input : STRING;
  room  : PRoom;
  light : BOOLEAN;
  p     : PBasic;
  i	: WORD;
  key   : CHAR;
BEGIN
  IF player<>NIL THEN
  BEGIN
    OpenScript(savestr+'.txt');
    SaveGame(0);
    key:=#0;
    CLRSCR;
    GOTOXY(1,24);
    REPEAT;
      quit:=0;
      room:=NIL;   
      IF (prologue^.HasText) AND (key<>'f') THEN
      BEGIN
        row:=1;
        WriteProlog;
      END;
      CountItems(NIL);
      {
        Hier beginnt der Dialog mit dem Spieler
      }
      REPEAT;
        row:=1;
        IF room<>player^.position THEN  { Spieler hat Raum gewechselt }
        BEGIN
          room:=player^.position;
          room^.CountLinks;
          Countitems(player^.position);
          player^.position^.RoomDescription;
          light:=room^.HasLight;
        END ELSE IF light<>room^.HasLight THEN
            BEGIN
              DrawStatusLine(f);
              light:=room^.HasLight;
            END;
        WRITELN;
        replay:=f;
        Scan(input,t,upsize,history);  { Eingabe einlesen... }
        IF input<>'' THEN
        BEGIN
          BeforeParsing(input);        { und auswerten... }
          Parse(input);
          IF (NOT(meta)) AND (player^.state=alive_ps) THEN
          BEGIN
            FOR i:=0 TO list.COUNT-1 DO
	    BEGIN
	      p:=list.At(i);
	      p^.ObscureEvents;
              p^.Inspect;
            END;
            time:=(time+rate) MOD 1439;
            player^.IncMoves;
          END;
          IF (NOT(replay)) AND (player^.position^.explored) THEN Print('Ok\n');
        END ELSE Print('Wie bitte?\n');
      UNTIL (quit>0) OR (player^.state<>alive_ps);
      IF quit=0 THEN
      BEGIN
        WITH player^ DO
        BEGIN
          IF state=dead_ps THEN AfterLife
                           ELSE Victory;
        END;
        WRITELN;
        key:=Question('Neustart, gespeichertes Spiel fortsetzen oder beenden? (n/f/b) ','nfb');
        CASE key OF
          'n' : LoadGame(0);
          'f' : UserLoad;
          'b' : quit:=1;
        END;
      END ELSE IF quit=2 THEN LoadGame(0);
    UNTIL quit=1;
    {$IFDEF tp}
    CloseText;
    {$ENDIF}
    CloseScript;
  END ELSE BEGIN
             WRITELN('Spieler wurde noch nicht initialisiert');
             HALT;
           END;
END;

DESTRUCTOR TGame.Done;
VAR
  i : WORD;
  p : PBasic;
BEGIN
  IF refpro<>NIL THEN DISPOSE(refpro);
  prologue^.Done;
  player^.Done;
  ClearDictionary;
  FOR i:=0 TO list.COUNT-1 DO
  BEGIN
    p:=list.At(i);
    p^.Done;
  END;
END;

BEGIN
  RANDOMIZE;
  player:=NIL;
  game:=NIL;
  top:=NIL;
  savestr:='neu';
  useroption:=t;
END.
