Unfinished graphic adventure engine attempt

age.pas

{
adventure game engine 1.0

file format: AGE.INI

[rooms]
<room#>, <room name>, <gfxfile>, <exits>, <flags>
<room description line 1>
    .
    .
<room description line n>
!end

[objects]
<obj#>, <short name>, <alias>, <long name>, <where>, <flags>
<object description line 1>
.
.
<object description line n>
!end

[npcs]
<npc#>, <short name>, <alias>, <long name>, <where>, <flags>
<npc desc line 1>
.
.
<npc desc line n>
<<magic word>>
<response line n>
!end

}

uses

XTypes,XGfx,qText,XGif2,Graph,XErr,XBuf,XStream,Strings,XStr,XIO,Objects;

type

  PRoom = ^TRoom;
  TRoom = record
    Number  : longint;
    Name    : FnameStr;
    gfxfile : string[12];
    exits   : string;
    flags   : longint;
    Desc    : PChar;
  end;

  PObj = ^TObj;
  TObj = record
    Number : longint;
    ShortName : FnameStr;
    Alias     : FnameStr;
    LongName  : FnameStr;
    GfxFile   : string[12];
    Weight    : longint;
    Where     : longint;
    Flags     : longint;
    Desc      : PChar;
  end;

  PNPC = ^TNPC;
  TNPC = record
    Number : longint;
    ShortName : FnameStr;
    Alias     : FnameStr;
    LongName  : FnameStr;
    GfxFile   : string[12];
    Sex       : byte;
    where     : longint;
    Flags     : longint;
    Desc      : PChar;
  end;

  PRoomColl = ^TRoomColl;
  TRoomColl = object(TCollection)
    procedure FreeItem(item:pointer);virtual;
  end;

  PObjColl = ^TObjColl;
  TObjColl = object(TCollection)
    procedure FreeItem(item:pointer);virtual;
  end;

  PNPCColl = ^TNPCColl;
  TNPCColl = object(TCollection)
    procedure FreeItem(item:pointer);virtual;
  end;

  TCmd = record
    Cmd : string[40];
    Val : word;
  end;

  PInventory = ^TInventory;
  TInventory = record
    Obj      : PObj;
    Next     : PInventory;
  end;

  TSexArray = array[1..3] of string[3];

const

  iniFile  : string[12] = 'AGE.INI';
  fontFile : string[12] = 'TIMPANI.FNT';

  lineheight  = 11;
  linecolor   : byte = 128;

  maxCap      = 15000;

  RoomList : PRoomColl = NIL;
  ObjList  : PObjColl = NIL;
  NPCList  : PNPCColl = NIL;
  Inventory : PInventory = NIL;

  currentRoom : longint = 1;

  curX : integer = 0;
  curY : integer = 0;

  cmd_Look  = 1;
  cmd_Info  = 2;
  cmd_Quit  = 3;
  cmd_North = 4;
  cmd_South = 5;
  cmd_East  = 6;
  cmd_West  = 7;
  cmd_Up    = 8;
  cmd_Down  = 9;
  cmd_Help  = 10;
  cmd_Exits = 11;
  cmd_Go    = 12;
  cmd_Get   = 13;
  cmd_Inventory = 14;
  cmd_Drop      = 15;
  cmd_Tell      = 16;

  sexNormal : TSexArray = ('he','she','it');
  sexTo     : TSexArray = ('him','her','it');

  maxcmds = 19;
  cmds : array[1..maxcmds] of TCmd = (
    (Cmd:'?'     ; Val:cmd_Help),
    (Cmd:'GET'   ; Val:cmd_Get),
    (cmd:'TAKE'  ; Val:cmd_Get),
    (cmd:'DROP'  ; Val:cmd_Drop),
    (cmd:'PUT'   ; Val:cmd_Drop),
    (cmd:'TELL'  ; Val:cmd_Tell),
    (cmd:'INVENTORY*'; Val:cmd_Inventory),
    (Cmd:'EXITS' ; Val:cmd_Exits),
    (Cmd:'LOOK'  ; Val:cmd_Look),
    (Cmd:'EXAMINE'; Val:cmd_Look),
    (Cmd:'INFO'  ; Val:cmd_Info),
    (Cmd:'QUIT'  ; Val:cmd_Quit),
    (Cmd:'NORTH*'; Val:cmd_North),
    (Cmd:'SOUTH*'; Val:cmd_South),
    (Cmd:'EAST*' ; Val:cmd_East),
    (Cmd:'WEST*' ; Val:cmd_West),
    (Cmd:'UP*'   ; Val:cmd_Up),
    (Cmd:'DOWN*' ; Val:cmd_Down),
    (Cmd:'GO'    ; Val:cmd_Go)
  );

procedure VESADriverProc;external;
{$L VESA}

procedure TRoomColl.FreeItem;
begin
  StrDispose(PRoom(item)^.Desc);
  Dispose(PRoom(item));
end;

procedure TObjColl.FreeItem;
begin
  StrDispose(PObj(item)^.Desc);
  Dispose(PObj(item));
end;

procedure TNPCColl.FreeItem;
begin
  StrDispose(PNPC(item)^.Desc);
  Dispose(PNPC(item));
end;

procedure PutIt(var line; x,y:integer);far;
var
  n:integer;
begin
  for n:=0 to 319 do PutPixel(n,x+100,byte(PChar(@line)[n]));
end;

procedure Error(h,b:FnameStr);
begin
  asm
    mov ax,3
    int 10h
  end;
  writeln(h+': '+b);
  halt;
end;

procedure ShowGIF(what:FnameStr);
var
  temp:array[0..767] of byte;
  Pal:TRGBPalette absolute GifPalette;
  count:word;
  total:word;
  best:byte;
  hebe:word;
  code:integer;
  err:FnameStr;
begin
  if not XFileExists(what) then Error('ShowGIF',what+' doesn''t exist');
  GifOutLineProc := PutIt;
  code := LoadGIF(what);
  case code of
    BadFile,BadRead : err := 'Error reading file';
    UnexpectedEOF   : err := 'Premature end of file';
    BadCode,BadFirstCode : err := 'Invalid code encountered';
    NoFile               : err := 'File open error';
    BadSymbolSize : err := 'Invalid symbol size';
    else err := '';
  end; {cae}
  if err <> '' then Error('ShowGIF',err+' ('+what+')');
  XGfx.SetPalette(Pal);
  count := 0;
  total := 0;
  best  := 0;
  while count < 767 do begin
    hebe := GifPalette[count]+GifPalette[count+1]+GifPalette[count+2];
    if hebe > total then begin
      total := hebe;
      best := count div 3;
    end;
    inc(count,3);
  end;
  lineColor := best;
end;

procedure Init;
var
  T:TDosStream;
  line:longint;
  procedure LinErr(what:string);
  begin
    XAbort(what+' line '+l2s(line));
  end;

  procedure Go(where:FnameStr);
  var
    s:String;
  begin
    FastUpper(where);
    T.Seek(0);
    T.Reset;
    line := 0;
    while T.GetPos < T.GetSize do begin
      SReadln(T,s);
      inc(line);
      Strip(s);
      FastUpper(s);
      if s <> '' then if s[1] <> ';' then
      if (s[1] = '[') then begin
        if s[length(s)] <> ']' then LinErr(''']'' missing');
        if copy(s,2,length(s)-2) = where then exit;
      end;
    end;
    XAbort('section not found');
  end;

  function ReadDesc:PChar;
  var
    w:word;
    temp:pointer;
    s:string;
    P:PChar;
  begin
    ReadDesc := NIL;
    w := 0;
    P := NIL;
    while T.GetPos < T.GetSize do begin
      SReadln(T,s);
      inc(line);
      {if T.Status <> stOK then LinErr('missing !end');}
      Strip(s);
      if Upper(s) = '!END' then break;
      s := s + #32;
      if P = NIL then begin
        GetMem(P,length(s)+1);
        Move32(s[1],P[0],length(s));
        P[length(s)] := #0;
        w := length(s)+1;
      end else begin
        GetMem(temp,w);
        Move32(P^,temp^,w);
        StrDispose(P);
        GetMem(P,w+length(s));
        Move32(temp^,P^,w);
        FreeMem(temp,w);
        Move32(s[1],P[w-1],length(s));
        P[w+length(s)-1] := #0;
        inc(w,length(s));
      end;
    end;
    if upper(s) <> '!END' then LinErr('missing !end');
    ReadDesc := P;
  end;

  procedure CheckFile(afile:FnameStr);
  begin
    if afile = '' then exit;
    if not XFileExists(afile) then XAbort(afile+' is missing!!');
  end;

  procedure ReadRooms;
  var
    s:string;
    P:PRoom;
    b:byte;
  begin
    New(RoomList,Init(10,10));
    while T.GetPos < T.GetSize do begin
      SReadln(T,s);
      inc(line);
      Strip(s);
      if s = '' then continue;
      if s[1] = ';' then continue;
      if s[1] = '[' then break;
      New(P);
      P^.Number  := s2l(GetParse(s,',',1));
      P^.Name    := GetParse(s,',',2);
      P^.GfxFile := GetParse(s,',',3);
      CheckFile(P^.GfxFile);
      P^.Exits   := GetParse(s,',',4);
      FastUpper(P^.Exits);
      P^.Flags   := 0; {!!!!}
      P^.Desc    := ReadDesc;
      RoomList^.Insert(P);
    end;
  end;

  procedure ReadObjects;
  var
    s:string;
    P:PObj;
    b:byte;
  begin
    New(ObjList,Init(10,10));
    while T.GetPos < T.GetSize do begin
      SReadln(T,s);
      inc(line);
      Strip(s);
      if s = '' then continue;
      if s[1] = ';' then continue;
      if s[1] = '[' then break;
      New(P);
      P^.Number  := s2l(GetParse(s,',',1));
      P^.ShortName    := GetParse(s,',',2);
      P^.Alias := GetParse(s,',',3);
      FastUpper(P^.Alias);
      P^.LongName   := GetParse(s,',',4);
      P^.GfxFile    := Getparse(s,',',5);
      CheckFile(P^.GfxFile);
      P^.Weight  := s2l(GetParse(s,',',6));
      P^.Where   := s2l(GetParse(s,',',7));
      P^.Flags   := 0; {!!!!}
      P^.Desc    := ReadDesc;
      ObjList^.Insert(P);
    end;
  end;

  procedure ReadNPCs;
  var
    s:string;
    P:PNPC;
    b:byte;
    a:string[1];
  begin
    New(NPCList,Init(10,10));
    while T.GetPos < T.GetSize do begin
      SReadln(T,s);
      inc(line);
      Strip(s);
      if s = '' then continue;
      if s[1] = ';' then continue;
      if s[1] = '[' then break;
      New(P);
      P^.Number  := s2l(GetParse(s,',',1));
      P^.ShortName    := GetParse(s,',',2);
      P^.Alias := GetParse(s,',',3);
      FastUpper(P^.Alias);
      P^.LongName   := GetParse(s,',',4);
      P^.GfxFile    := GetParse(s,',',5);
      CheckFile(P^.GfxFile);
      a := GetParse(s,',',6);
      case upcase(a[1]) of
        'M' : P^.Sex := 1;
        'F' : P^.Sex := 2;
        else P^.Sex := 3;
      end; {case}
      P^.Where      := s2l(GetParse(s,',',7));
      P^.Flags   := 0; {!!!!}
      P^.Desc    := ReadDesc;
      NPCList^.Insert(P);
    end;
  end;
begin
  write('init '+iniFile+'...');
  T.Init(iniFile,stOpenRead);
  if T.Status <> stOK then XAbort('failed') else ok;

  write('  reading rooms...');
  Go('rooms');
  ReadRooms;
  ok;

  write('  reading objects...');
  Go('objects');
  ReadObjects;
  ok;

  write('  reading NPCs...');
  Go('npcs');
  ReadNPCs;
  ok;
  T.Done;
end;

procedure InitFOnt;
var
  T:TDosStream;
  Font:pointer;
begin
  write('loading '+fontFile+'...');
  T.Init('C:\BP\XLIB\FONTS\'+fontFile,stOpenRead);
  if T.Status <> stOK then begin
    T.Done;
    T.Init(fontFile,stOpenRead);
    if T.Status <> stOK then XAbort('not found');
  end;
  GetMem(font,T.getSize);
  T.Read(font^,T.GetSize);
  T.Done;
  ok;
end;

procedure CrLf;
var
  imagebuf:Pointer;
  bufsize:word;
begin
  inc(cury,lineHeight);
  if cury+lineHeight > 100 then begin
    bufSize := 640*99;
    GetMem(imagebuf,bufSize);
    GetImage(0,300+lineHeight,
    Scroll(0,lineHeight,319,100,0,0,0,0,320,320);
    XRectFill(0,100-lineHeight,319,100,0,0);
    dec(cury,lineHeight);
  end;
  curx := 0;
end;

procedure Out(s:string);
var
  b:byte;
  width:byte;
  sub:string;
  lastpos:byte;
begin
  sub := '';
  lastpos := 0;
  for b:=1 to length(s) do begin
    sub := sub + s[b];
    if curx+XStrWidth(sub) > 319 then begin
      XBgPrintf(curx,cury,0,linecolor,0,copy(sub,1,lastpos-1));
      sub := copy(s,lastpos+1,b-lastpos);
      CrLf;
    end else if s[b] = #32 then lastpos := b;
  end;
  if sub <> '' then curx := XBgPrintf(curx,cury,0,linecolor,0,sub);
end;

procedure Outln(s:string);
begin
  Out(s);
  CrLf;
end;

function GetRoom(whichroom:integer):PRoom;
var
  n:integer;
  P:PRoom;
begin
  for n:=0 to RoomList^.Count-1 do begin
    P := RoomList^.At(n);
    if P^.Number = whichroom then begin
      GetRoom := P;
      exit;
    end;
  end;
  Error('GetRoom','Room '+l2s(whichroom)+' doesn''t exist');
end;

function GetSex(asex:char; usage:TSexArray):string;
begin
  case asex of
    'M' : GetSex := usage[1];
    'F' : GetSex := usage[2];
    else GetSex := usage[3];
  end; {case}
end;

procedure ShowExits(whichroom:longint);
var
  P:PRoom;
  s:string;
  procedure isexit(c:char; n:string);
  begin
    if pos(c,P^.Exits) > 0 then s := s + n + ',';
  end;
begin
  P := GetRoom(whichroom);
  s := '';
  isexit('N','north');
  isexit('S','south');
  isexit('E','east');
  isexit('W','west');
  isexit('U','up');
  isexit('D','down');
  if s = '' then Outln(' There''s no way out!') else begin
    if s[length(s)] = ',' then s[length(s)] := '.';
    Outln(#32+'Exits lead to '+s);
  end;
end;

procedure ShowObjects;
var
  n:integer;
  P:PObj;
  s:string;
  last:string;
  lastpos:byte;
  b:byte;
begin
  last := '';
  s := '';
  for n:=0 to ObjList^.Count-1 do begin
    P := ObjList^.At(n);
    if P^.Where = currentRoom then begin
      s := s + P^.LongName+', ';
      last := P^.LongName;
    end;
  end;
  if s = '' then exit;
  Out('You see ');
  dec(byte(s[0]),2);
  lastpos := 1;
  for b:=1 to length(s) do if s[b] = ',' then lastpos := b;
  if lastpos = 1 then Outln(s+'.') else Outln(copy(s,1,lastpos-1)+' and '+copy(s,lastpos+2,255)+'.');
end;

procedure ShowNPCS;
var
  n:integer;
  P:PNPC;
begin
  for n:=0 to NPCList^.Count-1 do begin
    P := NPCList^.At(n);
    if P^.Where = currentRoom then Outln(P^.LongName+' stands here.');
  end;
end;

procedure ShowRoom(whichroom:longint);
var
  P:PRoom;
  s:string;
  w:word;
begin
  P := GetRoom(whichroom);
  if P^.GfxFile <> '' then ShowGIF(P^.GfxFile) else XRectFill(0,100,320,401,0,0);
  Outln(P^.Name);
  s := '';
  w := 0;
  if P^.Desc = NIL then Error('SetRoom','Room '+l2s(whichroom)+' doesn''t have description');
  while P^.Desc[w] <> #0 do begin
    s := s + P^.Desc[w];
    if length(s) = 255 then begin
      Out(s);
      s := '';
    end;
    inc(w);
  end;
  if s <> '' then Out(s);
  ShowExits(whichRoom);
  ShowObjects;
  ShowNPCS;
  CrLf;
end;

procedure ShowObject(P:PObj);
var
  s:string;
  w:word;
begin
  if P^.GfxFile <> '' then ShowGIF(P^.GfxFile);
  s := '';
  w := 0;
  if P^.Desc = NIL then Error('ShowObject','Object '+l2s(P^.Number)+' doesn''t have description');
  while P^.Desc[w] <> #0 do begin
    s := s + P^.Desc[w];
    if length(s) = 255 then begin
      Out(s);
      s := '';
    end;
    inc(w);
  end;
  if s <> '' then Out(s);
  CrLf;
end;

procedure ShowNPC(P:PNPC);
var
  s:string;
  w:word;
begin
  if P^.GfxFile <> '' then ShowGIF(P^.GfxFile);
  s := '';
  w := 0;
  if P^.Desc = NIL then Error('ShowNPCect','NPC '+l2s(P^.Number)+' doesn''t have description');
  while (P^.Desc[w] <> #0) and (P^.Desc[w] <> '<') do begin
    s := s + P^.Desc[w];
    if length(s) = 255 then begin
      Out(s);
      s := '';
    end;
    inc(w);
  end;
  if s <> '' then Out(s);
  CrLf;
end;

procedure SetRoom(whichroom:longint);
begin
  currentRoom := whichroom;
  ShowRoom(currentRoom);
end;

function getInput:string;
var
  s:string;
  c:char;
  procedure putcursor;
  var
    ox:integer;
  begin
    ox := curx;
    Out('_');
    XRectFill(curx,cury,319,cury+lineheight-1,0,0);
    curx := ox;
  end;
begin
  s := '';
  putcursor;
  repeat
    c := qGetChar;
    case c of
      #8 : if length(s) > 0 then begin
             dec(curx,XStrWidth(s[length(s)]));
             putcursor;
             dec(byte(s[0]));
           end;
      #13 : begin
              XRectFill(curx,cury,319,cury+lineheight-1,0,0);
              CrLf;
              GetInput := s;
              exit;
            end;
      #32..#127 : if length(s) < 60 then begin
                    s := s + c;
                    Out(c);
                    putcursor;
                  end;
    end; {case}
  until false;
end;

procedure Go(where:word);
var
  P:PRoom;
  b:byte;
  how:string;
  function cmd2char:char;
  begin
    case where of
      cmd_North : cmd2char := 'N';
      cmd_South : cmd2char := 'S';
      cmd_East  : cmd2char := 'E';
      cmd_West  : cmd2char := 'W';
      cmd_Up    : cmd2char := 'U';
      cmd_Down  : cmd2char := 'D';
      else Error('cmd2char','invalid direction');
    end; {Case}
  end;
begin
  P := GetRoom(currentRoom);
  b := pos(cmd2char,P^.Exits);
  if b = 0 then begin
    Outln('You can''t go that direction');
    exit;
  end;
  how := copy(P^.Exits,b+1,255);
  b := pos(' ',how);
  if b > 0 then how := copy(how,1,b-1);
  SetRoom(s2l(how));
end;

procedure Info;
begin
  Outln('AGE 1.0 - (c) 1996 SSG');
  Outln('Total free heap = '+l2s(MemAvail));
  Outln('Maximum available block = '+l2s(MaxAvail));
end;

procedure Help;
var
  n:word;
begin
  Outln('Available commands:');
  for n:=1 to maxcmds-1 do Out(lower(cmds[n].cmd)+', ');
  Outln(lower(cmds[maxcmds].cmd));
end;

function Cmd2Num(what:FnameStr):word;
var
  last:word;
  n2:word;
  function Occurences:word;
  var
    total:word;
    n:word;
  begin
    total := 0;
    for n:=1 to maxcmds do if pos(what,cmds[n].Cmd) = 1 then begin
      inc(total);
      last := n;
    end;
    Occurences := total;
  end;
begin
  cmd2Num := $FFFF;
  if length(what) = 1 then for n2:=1 to maxcmds do if pos('*',cmds[n2].Cmd) > 0 then begin
    if what[1] = cmds[n2].Cmd[1] then begin
      Cmd2Num := cmds[n2].Val;
      exit;
    end;
  end;
  if Occurences = 1 then Cmd2Num := cmds[last].Val;
end;

function GetObj(objname:FnameStr; room:longint):PObj;
var
  n:integer;
  P:PObj;
  temp:string;
  b:byte;
begin
  GetObj := NIL;
  FastUpper(objname);
  for n:=0 to ObjList^.Count-1 do begin
    P := ObjList^.At(n);
    if (room = P^.Where) then begin
      if (objname = Upper(P^.ShortName)) or (objname = P^.Alias) then begin
        GetObj := P;
        exit;
      end;
      b := pos(' ',P^.Alias);
      temp := P^.Alias;
      if b > 0 then while temp <> '' do begin
         if objname = GetParse(temp,' ',1) then begin
           GetObj := P;
           exit;
         end;
         b := pos(' ',temp);
         if b = 0 then temp := '' else temp := copy(temp,b+1,255);
      end;
    end;
  end;
end;

function GetNPC(NPCname:FnameStr):PNPC;
var
  n:integer;
  P:PNPC;
  temp:string;
  b:byte;
begin
  GetNPC := NIL;
  FastUpper(NPCname);
  for n:=0 to NPCList^.Count-1 do begin
    P := NPCList^.At(n);
    if (currentRoom = P^.Where) then begin
      if (NPCname = Upper(P^.ShortName)) or (NPCname = P^.Alias) then begin
        GetNPC := P;
        exit;
      end;
      b := pos(' ',P^.Alias);
      temp := P^.Alias;
      if b > 0 then while temp <> '' do begin
         if NPCname = GetParse(temp,' ',1) then begin
           GetNPC := P;
           exit;
         end;
         b := pos(' ',temp);
         if b = 0 then temp := '' else temp := copy(temp,b+1,255);
      end;
    end;
  end;
end;

procedure Get(obj:PObj);
var
  n:integer;
  P:PInventory;
  p2:PInventory;
  totalweight:longint;
  procedure heavy;
  begin
    Outln('HInggg... Heavier than ever');
  end;
begin
  obj^.Where := -1;
  totalweight := 0;
  if Inventory = NIL then begin
    if Obj^.Weight > maxCap then begin
      heavy;
      exit;
    end;
    New(Inventory);
    Inventory^.Obj := obj;
    Inventory^.Next := NIL;
  end else begin
    P := Inventory;
    while P^.Next <> NIL do begin
      inc(totalWeight,P^.Obj^.Weight);
      P := P^.Next;
    end;
    if totalWeight+Obj^.Weight > maxCap then begin
      heavy;
      exit;
    end;
    New(p2);
    P^.Next := p2;
    p2^.obj := obj;
    p2^.Next := NIL;
  end;
  Outln('You take '+obj^.Shortname+' gently. ');
end;

procedure ShowInventory;
var
  P:PInventory;
  totalWeight:longint;
  birim:FnameStr;
begin
  P := Inventory;
  if P = NIL then Outln('You''re broke.') else begin
    Out('You''re carrying ');
    totalWeight := 0;
    while P <> NIL do begin
      inc(totalWeight,P^.Obj^.Weight);
      if P^.Next <> NIL then Out(P^.Obj^.ShortName+', ')
                        else if P <> Inventory then Out('and '+P^.Obj^.ShortName+'. ')
                                else Out('just '+P^.Obj^.ShortName+'. ');
      P := P^.Next;
    end;
    if totalWeight < 1000 then birim := 'grams' else begin
      birim := 'kgs';
      totalWeight := totalWeight div 1000;
    end;
    Out('It''s getting '+l2s(totalWeight)+' '+birim+'. ');
    if (birim = 'kgs') and (totalWeight > 10) then Outln('whoa!!') else CrLf;
  end;
end;

procedure GetAll;
var
  n:integer;
  P:PObj;
begin
  for n:=0 to ObjList^.Count-1 do begin
    P := ObjList^.At(n);
    if P^.Where = currentRoom then Get(P);
  end;
end;

procedure Drop(what:PObj);
var
  P:PInventory;
  pp:PInventory;
begin
  P := Inventory;
  if P = NIL then Error('Drop','No inventory');
  pp := NIL;
  while P <> NIL do begin
    if P^.Obj = what then begin
      if P = NIL then begin
        Inventory := P^.Next;
        exit;
      end else begin
        pp^.Next := P^.Next;
      end;
    end;
  end;
end;

procedure Tell(whom:PNPC; what:string);
var
  P:PChar;
  p2:PChar;
  s:string;
  n:byte;
begin
  Strip(what);
  Outln('You tell '+sexTo[whom^.Sex]+' '''+what+'''.');
  if StrPos(whom^.Desc,'<') <> NIL then begin
    P := StrScan(whom^.Desc,'<');
    inc(word(P));
    repeat
      p2 := StrScan(P,'>');
      if p2 = NIL then Error('Tell','''>'' is missing in description of NPC '+l2s(whom^.Number));
      byte(s[0]) := (word(p2)-word(p));
      Move32(p^,s[1],length(s));
      FastUpper(s);
      for n:=1 to GetByteCount(s[1],length(s),32)+1 do if pos(GetParse(s,' ',n),upper(what)) > 0 then begin
        Out(sexNormal[whom^.Sex]+' says ''');
        inc(word(p2));
        P := StrScan(p2,'<');
        if P = NIL then P := StrEnd(p2);
        if P = NIL then Error('Tell','Unterminated string');
        dec(word(P));
        s := '';
        while p2 <> p do begin
          s := s + p2[0];
          if length(s) = 255 then begin
            Out(s);
            s := '';
          end;
          inc(word(P2));
        end;
        if s <> '' then Out(s);
        Out('''.');
        CrLf;
        exit;
      end;
      P := StrScan(p2,'<');
      if P <> NIL then inc(word(P));
    until P = NIL;
  end;
  Outln(sexNormal[whom^.Sex]+' just ignores you.');
end;

procedure Run;
var
  cmd:FnameStr;
  param:FnameStr;
  b:byte;
  w:word;
  P:PObj;
  Pn:PNPC;
begin
  SetRoom(1);
  repeat
    Out('> ');
    cmd := GetInput;
    Strip(cmd);
    if cmd = '' then continue;
    b := pos(' ',cmd);
    if b > 0 then begin
      param := copy(cmd,b+1,255);
      cmd := copy(cmd,1,b-1);
    end else param := '';
    w := Cmd2Num(Upper(cmd));
    case w of
      cmd_Info  : Info;
      cmd_North,cmd_South,cmd_East,cmd_West,cmd_Up,cmd_Down : Go(w);
      cmd_Quit  : exit;
      cmd_Help  : Help;
      cmd_Look  : if param = '' then ShowRoom(currentRoom) else begin
                    P := GetObj(param,currentRoom);
                    if P = NIL then begin
                      P := GetObj(param,-1);
                      if P = NIL then begin
                        Pn := GetNPC(param);
                        if Pn = NIL then Outln('Look what??')
                                    else ShowNPC(Pn);
                      end else ShowObject(P);
                    end else ShowObject(P);
                  end;
      cmd_Exits : ShowExits(currentRoom);
      cmd_Go    : case upcase(Param[1]) of
                    'N' : Go(cmd_North);
                    'S' : Go(cmd_South);
                    'E' : Go(cmd_East);
                    'W' : Go(cmd_West);
                    'U' : Go(cmd_Up);
                    'D' : Go(cmd_Down);
                    else Outln('What? What direction? What the hell?');
                  end; {case}
      cmd_Get   : if param  <> '' then begin
                    if param = 'ALL' then GetAll;
                    P := GetObj(param,currentRoom);
                    if P = NIL then begin
                      P := PObj(GetNPC(param));
                      if P = NIL then Outln('I can''t see it here??')
                                 else Outln('That would be rude');
                    end else Get(P);
                  end else Outln('Get what?');
      cmd_Inventory : ShowInventory;
      cmd_Drop      : if param <> '' then begin
                        P := GetObj(param,-1);
                        if P = NIL then Outln('You don''t carry it');
                        Drop(P);
                      end else outLn('Drop what??');
      cmd_Tell : if param <> '' then begin
                   b := pos(' ',param);
                   if b > 0 then begin
                     Pn := GetNPC(copy(param,1,b-1));
                     if Pn = NIL then Outln('You don''t see '+param+' here.')
                       else Tell(Pn,copy(param,b+1,255));
                   end else Outln('Tell what??');
                 end else Outln('Tell whom??');
      else Outln('Huh?');
    end; {case}
  until false;
end;

procedure InitGFX;
var
  gd,gm:integer;
begin
  (*InitFont;
  XSetMode(XMode320x400,320);
  XSetSplitScreen(300);
  XTextInit;
  XSetFont(2); {user defined}
  XSetRGB(lineColor,40,40,40);*)
  gd := RegisterBGIDriver(@VESADriverProc);
  gm := 0;
  InitGraph(gd,gm,'');
  if GraphResult <> grOK then XAbort(GraphErrorMsg(graphResult));
end;

begin
  asm
    mov ax,3
    int 10h
  end;
  writeln('Adventure Game Engine (AGE) 1.0');
  writeln('Copyright (c) 1996 SSG / PAWS!'#13#10);
  write('init error handler...');
  InitXErr;
  ok;
  Init;
  InitGFX;
  Run;
  asm
    mov ax,3
    int 10h
  end;
end.