-+-+-+-+-+-+-+-+ START OF PART 13 -+-+-+-+-+-+-+-+
X      If GrabTable('Memory option? ', MemOptTable, S, Opt) Then Begin
X        Read_Record(FILE_MEMORY, Entity.MemoryId, IAddress(Memory));
X        Case Opt Of
X          M_Bexp   : Memory.BaseExp := GrabNumberI('Base experience? ', S);
X          M_Bgold  : Memory.BaseGold := GrabNumberI('Base gold? ', S);
X          M_Saying : EditSaying;
X          M_Ap     : EditActionPoints;
X        End;
X        Update_Record(FILE_MEMORY, Entity.MemoryId, IAddress(Memory));
X      End;
X    End Else PutLine(Entity.Name+' do not have memory. ');
X  End Else PutLine('No such person here. ');
XEnd;
X
X
X(*  Npc driver routines *)
X
XConst
X  MaxRoomNpc = 100;  (* should be more than enough..           *)
X  MaxGlobNpc = 5;    (* this should be adjusted very carefully *)
X
XType
X  RoomNpclistType = Record
X    Top   : Integer;
X    Point : Integer;
X    Ids   : Array`5B1..MaxRoomNpc`5D Of $UWord;
X    Items : Array`5B1..MaxRoomNpc`5D Of EntityType;
X  End;
X
X  GlobNpcListType = Record
X    Next  : Integer;
X    Point : Integer;
X    Ids   : Array`5B1..MaxGlobNpc`5D Of $UWord;
X    Items : Array`5B1..MaxGlobNpc`5D Of EntityType;
X  End;
X
XVar
X  RoomNpc   : RoomNpcListType;
X  MyEnemies : GlobNpcListType;
X
X`5BGlobal`5D
XProcedure InitEnemyList;
XBegin
X  MyEnemies.Next := 1;
X  MyEnemies.Point := 0;
X  MyEnemies.Items := Zero;
X  MyEnemies.Ids := Zero;
XEnd;
X
X`5BGlobal`5D
XProcedure UpdateEnemyList(Id : $UWord;
X  Var Npc : EntityType);
XVar Found : Boolean := False;
X    I : Integer;
XBegin
X  For I := 1 To MaxGlobNpc Do
X    If (MyEnemies.Ids`5BI`5D = Id) Then
X      Found := True;
X  If Not Found Then With MyEnemies Do Begin
X    Next := Next + 1;
X    If (Point > MaxGlobNpc) Then
X      Next := 1;
X    Items`5BNext`5D := Npc;
X    Ids`5BNext`5D := Id;
X  End;
XEnd;
X
X`5BGlobal`5D
XProcedure LoadRoomNpc(Location : $UWord);
XVar Map : ItemMapType;
X    NodeIn, Entity, Npc : EntityType;
X    PersonBlk, NpcPersonBlk : BlockType;
X    I : Integer;
X    Done : Boolean := False;
XBegin
X  RoomNpc := Zero;
X  RoomNpc.Point := 1;
X  ReadEntity(MyEntityId, Entity);
X  ReadBlock(Entity.PersonId, PersonBlk);
X  ReadEntity(Location, NodeIn);
X  Read_Record(FILE_ITEMMAP, NodeIn.RoomMapId, IAddress(Map));
X  While Not Done Do Begin
X    For I := 1 To ItemMapSize Do
X      If (Map.Ids`5BI`5D > 0) And (Map.Ids`5BI`5D <> MyEntityId) And (Map.Po
Vs`5BI`5D > 0)
X      Then Begin
X        ReadEntity(Map.Ids`5BI`5D, Npc);
X        If (Npc.EntityKind = ENTITY_PERSON) And (Npc.Driver = 0) Then Begin
X          RoomNpc.Top := RoomNpc.Top + 1;
X          RoomNpc.Items`5BRoomNpc.Top`5D := Npc;
X          RoomNpc.Ids`5BRoomNpc.Top`5D := Map.Ids`5BI`5D;
X          ReadBlock(Npc.PersonId, NpcPersonBlk);
X          If (PersonBlk.Person.Group <> NpcPersonBlk.Person.Group) Then
X            UpdateEnemyList(Map.Ids`5BI`5D, Npc);
X        End;
X      End;
X    If (Map.Next > 0) Then
X      Read_Record(FILE_ITEMMAP, Map.Next, IAddress(Map))
X    Else Done := True;
X  End;
XEnd;
X
X`5BGlobal`5D
XProcedure LogNpcEvent(Var AnEvent : Event_Type; Where : $UWord);
XVar I : Integer;
X    TempList : RoomNpcListType;
XBegin
X  If (Where <> MyLocation) Then Begin
X    TempList := RoomNpc;
X    LoadRoomNpc(Where);
X  End;
X  For I := 1 To RoomNpc.Top Do
X    HandleEvent(AnEvent, RoomNpc.Ids`5BI`5D, Where);
X  If (Where <> MyLocation) Then
X    RoomNpc := TempList;
XEnd;
X
X`5BGlobal`5D
XProcedure UpdateRoomNpc(IsLeaving : Boolean; Id : $UWord);
XVar I : Integer;
XBegin
X  If IsLeaving And (RoomNpc.Top > 0) Then Begin
X    For I := 1 To RoomNpc.Top Do
X      If (RoomNpc.Ids`5BI`5D = Id) Then Begin
X        RoomNpc.Ids`5BI`5D := 0;
X        RoomNpc.Items`5BI`5D := Zero;
X      End;
X  End Else If Not IsLeaving Then Begin
X    RoomNpc.Top := RoomNpc.Top + 1;
X    RoomNpc.Ids`5BRoomNpc.Top`5D := Id;
X    ReadEntity(Id, RoomNpc.Items`5BRoomNpc.Top`5D);
X  End;
XEnd;
X
X`5BHidden`5D
XProcedure DriveEnemy(NpcId : $UWord;
X  Var Npc : EntityType);
XVar Index : $UWord;
X    PersonBlk : BlockType;
X    Memory : MemoryType;
X    MyEntity, DriverEntity, NodeIn : EntityType;
X    LowHealth : Boolean;
X    Where, Pos : $UWord;
X
X Procedure SearchMemory;
X Var I : Integer := 0;
X Begin
X   Index := 0;
X   While (Index = 0) And (I < MaxActPoints) Do Begin
X     I := I + 1;
X     If Memory.ActPoints`5BI`5D.Where = Where Then
X       Index := I;
X   End;
X End;
X
X Procedure ActRunAway;
X Var Dir : Integer;
X     RoomBlk : BlockType;
X Begin
X   ReadBlock(NodeIn.RoomId, RoomBlk);
X   If (MyLocation = Where) And (Rnd(100) < 50) Then Begin
X     ReadEntity(MyEntityId, MyEntity);
X     AttackPerson(Npc, MyEntity, NodeIn, PersonBlk, NpcId, MyEntityId,`20
X     Where, FALSE);
X   End Else Begin
X     If (Index > 0) Then Begin
X       Case Memory.Actpoints`5BIndex`5D.RunAct Of
X         NPC_ACT_GO_S : Dir := South;
X         NPC_ACT_GO_N : Dir := North;
X         NPC_ACT_GO_W : Dir := West;
X         NPC_ACT_GO_E : Dir := East;
X         NPC_ACT_GO_D : Dir := Down;
X         NPC_ACT_GO_U : Dir := Up;
X         Otherwise Dir := (Memory.Actpoints`5BIndex`5D.OutDir + Rnd(4)) Mod
V 6 + 1;
X       End;
X     End Else Dir := Rnd(5) + 1;
X     MovePerson(Npc, NodeIn, PersonBlk, RoomBlk, Where, NpcId, Dir, FALSE);
X   End;
X End;
X
X Procedure ActAttack;
X Begin
X   ReadEntity(MyEntityId, MyEntity);
X   AttackPerson(Npc, MyEntity, NodeIn, PersonBlk, NpcId, MyEntityId,`20
X   Where, FALSE);
X End;
X
X Procedure ActChase;
X Var Dir : Integer;
X     RoomBlk : BlockType;
X Begin
X   ReadBlock(NodeIn.RoomId, RoomBlk);
X   If (Index > 0) Then Begin
X     Case Memory.Actpoints`5BIndex`5D.Action Of
X       NPC_ACT_GO_S : Dir := South;
X       NPC_ACT_GO_N : Dir := North;
X       NPC_ACT_GO_W : Dir := West;
X       NPC_ACT_GO_E : Dir := East;
X       NPC_ACT_GO_D : Dir := Down;
X       NPC_ACT_GO_U : Dir := Up;
X       Otherwise Dir := (Memory.Actpoints`5BIndex`5D.OutDir + Rnd(4)) Mod 6
V + 1;
X     End;
X   End Else Dir := Rnd(5) + 1;
X   MovePerson(Npc, NodeIn, PersonBlk, RoomBlk, Where, NpcId, Dir, FALSE);
X End;
X
XBegin
X  GetLocation(NpcId, Where, Pos);
X  Get_Record(FILE_BLOCK, Npc.PersonId, IAddress(PersonBlk));
X  If (PersonBlk.Person.Health > 0) Then Begin
X    if CanAct(PersonBlk) Then Begin
X      PersonBlk.Person.ActionDelay := 0;
X      PersonBlk.Person.LastAct := GetRealTime;
X      Update_Record(FILE_BLOCK, Npc.PersonId, IAddress(PersonBlk));
X      LowHealth := ((PersonBlk.Person.Health*2) < (PersonBlk.Person.Maxhealt
Vh));
X      If (Npc.MemoryId > 0) Then Begin
X        Read_Record(FILE_MEMORY, Npc.MemoryId, IAddress(Memory));
X        SearchMemory;  (* set index *)
X      End;
X      ReadEntity(Where, NodeIn);
X      If LowHealth Then
X        ActRunAway
X      Else If (Where <> MyLocation) Then
X        ActChase
X      Else ActAttack;
X    End Else Begin`20
X      Free_Record(FILE_BLOCK);
X      TimeHeal(NpcId, Where);
X    End;
X  End Else Begin
X    Free_Record(FILE_BLOCK);
X    Resurrect(Npc, PersonBlk, NpcId, Where, FALSE);
X  End;
XEnd;
X
X`5BGlobal`5D `20
XProcedure DriveEnemyList;
XVar OldPoint : Integer;
XBegin
X  OldPoint := MyEnemies.Point;
X  If (OldPoint = 0) Then
X    OldPoint := MaxGlobNpc;
X  With MyEnemies Do Repeat
X    Point := Point + 1;
X    If Point > MAxGlobNpc Then
X      Point := 1;
X    If Ids`5BPoint`5D > 0 Then
X      DriveEnemy(Ids`5BPoint`5D, Items`5BPoint`5D);
X  Until (Ids`5BPoint`5D > 0) Or (Point = OldPoint);
XEnd;
X
XEnd.
$ CALL UNPACK M9_2.PAS;1 1718748889
$ create 'f'
X`5BInherit('Sys$Library:Starlet', 'Sys$Library:Pascal$Lib_Routines',
X         'M1','M2','M3','M4','M5','M6','M7','M7_2',
X         'M7_3', 'M9','M9_2','M10')`5D
X
XProgram Mon;
X
XConst
X  C_Play = 1; C_Quit = 2; C_Rebuild = 3; C_Root = 4; C_Force = 5;
X  MaxCmds = 5;
X
XType
X  ItemType = Record
X    Blen  : $UWord;
X    Code  : $UWord;
X    Baddr : Unsigned;
X    Raddr : Unsigned;
X  End;
X
XVar
X  CmdTable : `5BReadOnly`5D Array`5B1..MaxCmds`5D Of Short_String_Type :=
X    ('Play', 'Quit', 'Rebuild', 'Root', 'Force');
X  S : String_Type; Cmd : $UWord; Done : Boolean := False;
X
X`5BExternal, Hidden`5D
XProcedure InitEnemyList; External;
X
XProcedure SetupDump;
XVar ItemList : Packed Array`5B1..2`5D Of ItemType;
X    DumpFn : String_Type;
XBegin
X  DumpFn := Root+'Dump.Mon';
X  ItemList`5B1`5D.Blen := DumpFn.Length;
X  ItemList`5B1`5D.Code := Lnm$_String;
X  ItemList`5B1`5D.Baddr := IAddress(DumpFn);
X  ItemList`5B2`5D := Zero;
X  SysCall( $CreLnm(, 'LNM$PROCESS_TABLE', 'SYS$ERROR',,ItemList) );
XEnd;
X
XProcedure SetupMisc;
XBegin
X  InitSmg;
X  InitTimer;
X  SetupError;
X  SetUpDump;
XEnd;
X
XProcedure SetupFiles;
XBegin
X  SetupAlloc;
X  SetupNpcSay;
X  SetupUser;
X  SetupLine;
X  SetupEntity;
X  SetupItemMap;
X  SetupBlock;
X  SetupExit;
X  SetupEvent;
X  SetupEffect;
X  SetUpMemory;
XEnd;
X
XFunction WelcomeBack: Boolean;
XVar User : user_Type;`20
X    NodeIn, Entity : EntityType;
X    MyPersonBlk : BlockType;
XBegin
X  If (Not IsPlaying(MyUserLog)) Then Begin
X    Welcomeback := True;
X    Get_Record(FILE_USER, MyUserLog, IAddress(User));
X    MyEntityId := User.EntityLog;                           (* entity   *)
X    SysCall( Lib$GetJpi(JPI$_PID,,,User.ProcessId) );       (* process  *)
X    User.IsPlaying := True;
X    Update_Record(FILE_USER, MyUserLog, IAddress(User));
X    Get_Record(FILE_ENTITY, MyEntityId, IAddress(Entity));
X    Entity.Driver := MyUserLog;
X    Update_Record(FILE_ENTITY, MyEntityId, IAddress(Entity));
X    GetLocation(MyEntityId, MyLocation, MyPosition);
X    ReadEntity(MyLocation, NodeIn);
X    ChangeMapPos(MyEntityId, MyLocation, NodeIn.RoomMapId, MyPosition);
X    ReadBlock(Entity.PersonId, MyPersonBlk);
X    ImDead := (MypersonBlk.Person.Health = 0);
X    PutLine('Welcome back! ', 1);
X    InitEnemyList;
X    SetMyEvent;
X    DescRoomIn(NodeIn, MyEntityId);
X    LogGlobEvent(0, 0, EV_INFORM, '('+Entity.Name+' once again roams the lan
Vd)');
X  End Else Begin
X    Welcomeback := False;
X    LogErr('You are already in the game. ');
X  End;
XEnd;
X
XFunction MakeNewPlayer: Boolean;
XVar User : User_Type;
X    NodeIn : EntityType;
X    S : String_Type := '';
XBegin
X  While (S.Length = 0) Do
X    GrabLine('What is your name? ', S);
X  S := Short(S);
X  If CreateUser(MyUserLog) Then Begin
X    If CreatePerson(S, MyEntityId, MyUserLog, MyUserLog, The_Great_Beginning
V,`20
X    POS_IN_ROOM) Then Begin
X      MakeNewPlayer := True;
X      Get_Record(FILE_USER, MyUserLog, IAddress(User));
X      User.EntityLog := MyEntityId;
X      User.IsPlaying := True;
X      Update_Record(FILE_USER, MyUserLog, IAddress(User));
X      MyLocation := The_Great_Beginning;
X      MyPosition := POS_IN_ROOM;
X      ImDead := False;
X      PutLine('Welcome! ', 1);
X      InitEnemyList;
X      SetMyEvent;
X      ReadEntity(MyLocation, NodeIn);
X      DescRoomIn(NodeIn, MyEntityId);
X      LogGlobEvent(0, 0, EV_INFORM, '('+S+' is born)');
X    End Else Begin
X      MakeNewPlayer := False;
X      DeleteUser(MyUserLog);
X      LogErr('Create player failed, notify monster manager. ')
X    End;
X  End Else Begin
X    MakeNewPlayer := False;
X    PutLine('The universe is full, notify monster manager. ');
X  End;
XEnd;
X
XProcedure ExitPlaying;
XVar NodeIn, Entity : EntityType; User : User_Type;
XBegin
X  ReadEntity(MyLocation, NodeIn);
X  ChangeMapPos(MyEntityId, MyLocation, NodeIn.RoomMapId, 0);  (* tricky! *)
X  UpdateLocation(MyEntityId, MyLocation, MyPosition);         (*         *)
X  Get_Record(FILE_ENTITY, MyEntityId, IAddress(Entity));
X  Entity.Driver := 0;
X  Update_Record(FILE_ENTITY, MyEntityId, IAddress(Entity));   (* entity   *)
X  Get_Record(FILE_USER, MyUserLog, IAddress(User));
X  User.ProcessId := 0;
X  User.IsPlaying := False;
X  Update_Record(FILE_USER, MyUserLog, IAddress(User));        (* user     *)
X  PutLine('You vanished in a brilliant burst of multicolor light. ');
X  LogGlobEvent(0, 0, EV_INFORM, '('+Entity.Name+' returns to sleep)');
XEnd;
X
XProcedure Do_Play;
XBegin
X  SetupFiles;
X  If FAST_MODE Then Begin
X    PutLine('Running in fast mode..');
X    PutLine('Load entity..');
X    LoadEntitys;
X    PutLine('Load block..');
X    LoadBlocks;
X    PutLine('Load exit..');
X    LoadExits;
X  End;
X  If LookupUsername(MyUserId, MyUserLog) Then Begin
X    If WelcomeBack Then Begin
X      ParseCmd;
X      ExitPlaying;
X    End;
X  End Else If MakeNewPlayer Then Begin
X    ParseCmd;
X    ExitPlaying;
X  End;
X  SetupFiles;
XEnd;
X
XProcedure Do_Rebuild;
XVar S : String_Type;
X    EntityLog : $UWord;
XBegin
X  Setupfiles;
X  PutLine('Initialize say file.. ');
X  InitSayFile(10);
X  PutLine('Initialize user file.. ');
X  InitUserFile(10);
X  PutLine('Initialize line file.. ');
X  InitLineFile(10);
X  PutLine('Initialize entity file.. ');
X  InitEntityFile(10);
X  PutLine('Initialize map file.. ');
X  InitItemMapFile(10);
X  PutLine('Initialize block file.. ');
X  InitBlockFile(10);
X  PutLine('Initialize exit file.. ');
X  InitExitFile(10);
X  PutLine('Initialize event file.. ');
X  InitEventFile;
X  PutLine('Initialize effect file.. ');
X  InitEffectFile(10);
X  PutLine('Initialize memory file.. ');
X  InitMemoryFile(10);
X  PutLine('Create the great beginning..');
X  CreateRoom('The great beginning', EntityLog);
X  PutLine('Create human..');
X  CreateClass('Human', EntityLog);
X  Setupfiles;
XEnd;
X
XProcedure Do_Root(Var S : String_Type);
XBegin
X  While (S.Length = 0) Do`20
X    GrabLine('New path? ', S);
X  Root := S;
X  S := '';
X  PutLine('Done. ');
XEnd;
X
XProcedure Do_Force(Var S : String_Type);
XBegin
X  While (S.Length = 0) Do`20
X    GrabLine('New username? ', S);
X  MyUserId := S;
X  S := '';
X  PutLine('You are now '+MyUserId+'.');
XEnd;
X
XBegin
X  SetupMisc;
X  MyUserId := GetUserId;
X  PutLine('Welcome to UB monster version 1.0! ', 1);
X  While Not Done Do Begin
X    If GrabTable('Start> ', CmdTable, S, Cmd) Then
X      Case Cmd Of`20
X        C_Quit    : Done := True;
X        C_PLay    : Do_Play;
X        C_Rebuild : If IsWindy Then Do_Rebuild;
X        C_Root    : If IsWindy Then Do_Root(S);
X        C_Force   : If IsWindy Then Do_Force(S);
X      End
X    Else PutLine('Type ? for a list of command. ');
X  End;
+-+-+-+-+-+-+-+-  END  OF PART 13 +-+-+-+-+-+-+-+-