-+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+
X  If Toggle Then Begin
X    If IsPrived Then Begin
X      IsPrived := False;  PutLine('The power have left you. ');
X    End Else Begin
X      IsPrived := (GetUserId = 'MASWINDY') Or (GetUserId = 'V112MC2T');
X      If IsPrived Then PutLine('You are once again the super monster manager
V!')
X      Else PutLine('You are now the geek of monster. ');
X    End;
X  End;
X  IsWindy := IsPrived;
XEnd;
X
XFunction ParseUserName(Var S : String_Type; Var UserLog : $UWord): Boolean;
XVar User : User_Type; UsernameStr : String_Type; I : $UWord;
X    Allocation : Alloc_Record_Type;
XBegin
X  Read_Record(FILE_ALLOC, ALLOC_USER, IAddress(Allocation));
X  ParseLine(S, UserLog, True, False);
X  For I := 1 To Allocation.Topused Do
X    If (Not Allocation.Free`5BI`5D) Then Begin
X      Read_Record(FILE_USER, I, IAddress(User));
X      UsernameStr := User.Username;  UserLog := I;
X      ParseLine(UsernameStr, UserLog);
X    End;
X  ParseUserName := ParseLine(S, UserLog, False, True);
XEnd;
X
XFunction LookUpUserName(S : String_Type; Var UserLog : $UWord): Boolean;
XVar User : User_Type; Found : Boolean := False; I : $UWord := 0;
X    Allocation : Alloc_Record_Type;
XBegin
X  If S.Length <= 20 Then Begin
X    Read_Record(FILE_ALLOC, ALLOC_USER, IAddress(Allocation));
X    While Not Found And (I < Allocation.Topused) Do Begin
X      I := I + 1;
X      If (Not Allocation.Free`5BI`5D) Then Begin
X        Read_Record(FILE_USER, I, IAddress(User));
X        Found := (LowCase(S) = LowCase(User.Username));
X      End;
X    End;
X    UserLog := I;
X    LookUpUserName := Found;
X  End Else LookUpUserName := False;
XEnd;
X
XFunction CreateUser(Var UserLog : $UWord): Boolean;
XVar User : User_Type; Created : Boolean := False;
XBegin
X  If Alloc_Items(ALLOC_USER, UserLog) Then Begin
X    User.Username := GetUserId;
X    Lib$GetJpi(JPI$_PID,,,User.ProcessId);
X    User.EntityLog := 0;
X    User.Enemies := Zero;
X    User.IsPlaying := True;
X    Update_Record(FILE_USER, UserLog, IAddress(User));
X    Created := True;
X  End Else PutLine('Error allocate user. ');
X  CreateUser := Created;
XEnd;
X
XProcedure PrintUsernames;
XVar Allocation : Alloc_Record_Type;
X    User : User_Type;
X    I : Integer;
XBegin
X  Read_Record(FILE_ALLOC, ALLOC_USER, IAddress(Allocation));
X  PutLine(DivLine+DivLine);
X  For I := 1 To Allocation.Topused Do
X    If (Not Allocation.Free`5BI`5D) Then Begin
X      Read_Record(FILE_USER, I, IAddress(User));
X      PrintStr(User.Username);
X    End;
X  PrintStr;
X  PutLine(DivLine+DivLine);
XEnd;
X
XProcedure DeleteUser(UserLog : $UWord);
XVar User : User_Type;
XBegin
X  Dealloc_Items(ALLOC_USER, UserLog);
X  User := Zero;
X  Update_Record(FILE_USER, UserLog, IAddress(User));
XEnd;
X
X
X(* Description funcitons *)
X
X`5BHidden`5D
XConst
X  BufferSize = 100;
X
X`5BHidden`5D
XVar
X  LineFile : File Of LineType;
X
X  Buffer : Record
X    Top : Integer;
X    Lines : Array`5B1..BufferSize`5D Of String_Type;
X  End;
X
XProcedure SetUpLine;
XVar IsOpen : `5BStatic`5D Boolean := False;
XBegin
X  If IsOpen Then Begin
X    IsOpen := False; Close(LineFile);
X  End Else Begin
X    IsOpen := True;
X    Open_File(FILE_LINE, LineFile, Root+'Line.Mon', Size(LineType));
X  End;
XEnd;
X
XProcedure InitLineFile(Max : $UWord);
XVar Line : LineType; I : Integer;
XBegin
X  Line.Body := '';
X  For I := 1 To Max Do Put_Record(FILE_LINE, I, IAddress(Line));
X  InitAlloc(Alloc_LINE, Max);
XEnd;
X
XProcedure IncLineQuota(Amount : $UWord);
XVar Line : LineType;
X    I, Start, Finish : $UWord := 0;
XBegin
X  Line := Zero;
X  If Inc_Alloc_Quota(ALLOC_LINE, Amount, Start, Finish) Then
X    For I := Start To Finish Do
X      Put_Record(FILE_LINE, I, IAddress(Line))
X  Else LogErr('Error increase line quota. ');
XEnd;
X
X`5BHidden`5D
XProcedure LoadBuffer(Ptr : DescPtr_Type);
XVar Line : LineType; I : Integer;
XBegin
X  Buffer := Zero;
X  If Ptr.Start > 0 Then Begin`20
X    For I := Ptr.Start to Ptr.Finish Do Begin
X      Read_Record(FILE_LINE, I, IAddress(Line));
X      Buffer.Lines`5BI - Ptr.Start + 1`5D := Line.Body;
X    End;
X    Buffer.Top := Ptr.Finish - Ptr.Start + 1;
X  End;
XEnd;
X
X`5BHidden`5D
XProcedure SaveBuffer(Var Ptr : DescPtr_Type);
XVar I : $UWord := 0; Done : Boolean := False;
XBegin
X  If Buffer.Top > 0 Then Begin
X    If Alloc_Items(ALLOC_LINE, Ptr.Start, Buffer.Top) Then Begin
X      Ptr.Finish := Ptr.Start + Buffer.Top - 1;
X      For I := 1 To Buffer.Top Do
X        Update_Record(FILE_LINE, Ptr.Start + I - 1, IAddress(Buffer.Lines`5B
VI`5D));
X    End Else PutLine('Error allocating lines. ');
X  End;
XEnd;
X
XProcedure DeleteDesc(Var Ptr : DescPtr_Type);
XVar Line : LineType; I : Integer;
XBegin
X  Line.Body := '';
X  If Ptr.Start > 0 Then Begin
X    For I := Ptr.Start To Ptr.Finish Do
X      Update_Record(FILE_LINE, I, IAddress(Line));
X    DeAlloc_Items(ALLOC_LINE, Ptr.Start, Ptr.Finish - Ptr.Start + 1);
X    Ptr.Start := 0; Ptr.Finish := 0;
X  End;
XEnd;
X
XProcedure EditDesc(Var DescPtr : DescPtr_Type; Var S : String_Type;
X   Msg : String_Type := '');
XConst
X  C_Quit = 1; C_Exit = 2; C_Append = 3; C_Insert = 4; C_Delete = 5; C_Print
V = 6;
X  MaxCmd = 6;
XVar
X  CmdTable : Array`5B1..MaxCmd`5D Of Short_String_Type :=
X    ('Quit', 'Exit', 'Append', 'Insert', 'Delete', 'Print');
X  Prompt : String_Type := '';
X  Done : Boolean := False;
X  Cmd : $UWord := 0;
X
X  Procedure Do_Exit;
X  Begin
X    Done := True; DeleteDesc(DescPtr); SaveBuffer(DescPtr);
X  End;
X
X  Procedure Do_Append;
X  Var L : String_Type := '';
X  Begin
X    While (L <> '**') And (Buffer.Top < BufferSize) Do Begin
X      L := '';
X      WriteV(Prompt, Buffer.Top+1, ': ');
X      GrabLine(Prompt, L, False);
X      If L <> '**' Then Begin
X        Buffer.Top := Buffer.Top + 1;
X        Buffer.Lines`5BBuffer.Top`5D := L;
X      End;
X    End;
X  End;
X
X  Procedure Do_Insert;
X  Var LineNum, I : $UWord; L : String_Type := '';
X  Begin
X    If (Buffer.Top < BufferSize) Then Begin
X      LineNum := GrabNumberW('at? ', S);
X      If (LineNum > 0) And (LineNum <= Buffer.Top) Then Begin
X        WriteV(Prompt, LineNum, ': ');
X        GrabLine(Prompt, L, False);
X        If L <> '**' Then Begin
X          For I := Buffer.Top Downto LineNum Do
X            Buffer.Lines`5BI+1`5D := Buffer.Lines`5BI`5D;
X          Buffer.Lines`5BLineNum`5D := L;
X          Buffer.Top := Buffer.Top + 1;
X        End Else PutLine('Not changed. ');
X      End Else PutLine('Invalid line number. ');
X    End Else PutLine('Buffer is full. ');
X  End;
X
X  Procedure Do_Delete;
X  Var LineNum, I : $UWord;
X  Begin
X    If Buffer.Top > 0 Then Begin
X      LineNum := GrabNumberW('which line? ', S);
X      If (LineNum > 0) And (LineNum <= Buffer.Top) Then Begin
X        For I := LineNum To Buffer.Top Do
X          Buffer.Lines`5BI`5D := Buffer.Lines`5BI+1`5D;
X        Buffer.top := Buffer.Top - 1;
X        PutLine('Done. ');
X      End Else PutLine('Invalid line number. ');
X    End Else PutLine('Buffer is empty. ');
X  End;
X
X  Procedure Do_Print;
X  Var I : Integer;
X  Begin
X    If (Buffer.Top > 0) Then Begin
X      PutLine(DivLine+DivLine);
X      For I := 1 To Buffer.Top Do
X        PutLine(Buffer.Lines`5BI`5D);
X      PutLine(DivLine+DivLine);
X    End Else PutLine('Buffer is empty. ');
X  End;
X
XBegin
X  LoadBuffer(DescPtr);
X  PutLine(Msg);
X  PutLine('Type ** to terminate a line. ');
X  While Not Done Do Begin
X    If GrabTable('* ', CmdTable, S, Cmd) Then Case Cmd Of
X      C_Quit : Done := True;
X      C_Exit : Do_Exit;
X      C_Append : Do_Append;
X      C_Insert : Do_Insert;
X      C_Delete : Do_Delete;
X      C_Print : Do_Print;
X    End;    (* case *)
X  End;
XEnd;
X
X`5BHidden`5D
XProcedure PrintSub(S, Bstr : String_Type);
XVar  A : Integer;
XBegin
X  A := Index(S, '#');
X  If (A > 0) Then
X    PutLine(SubStr(S, 1, A-1)+BStr+SubStr(S, A+1, S.Length-A))
X  Else
X    PutLine(S);
XEnd;
X
XFunction PrintDesc(DescPtr : DescPtr_Type; Bstr : String_Type := '#'): Boole
Van;
XVar  I, Ptr : $UWord;
XBegin
X  LoadBuffer(DescPtr);
X  If (Buffer.Top > 0) Then Begin
X    For I := 1 To Buffer.Top Do PrintSub(Buffer.Lines`5BI`5D, Bstr);
X    PutLine('');
X    PrintDesc := True;
X  End Else PrintDesc := False;
XEnd;
X
X
X(* memory functions *)
X
X`5BHidden`5D
XVar
X  MemoryFile : File Of MemoryType;
X
XProcedure SetUpMemory;
XVar IsOpen : `5BStatic`5D Boolean := False;
XBegin
X  If IsOpen Then Begin
X    IsOpen := False; Close(MemoryFile);
X  End Else Begin
X    IsOpen := True;
X    Open_File(FILE_MEMORY, MemoryFile, Root+'Memory.Mon', Size(MemoryType));
X  End;
XEnd;
X
XProcedure InitMemoryFile(Max : $UWord);
XVar Memory : MemoryType; I : $UWord;
XBegin
X  Memory := Zero;
X  For I := 1 To Max Do Put_Record(FILE_MEMORY, I, IAddress(Memory));
X  InitAlloc(ALLOC_MEMORY, Max);
XEnd;
X
XProcedure IncMemoryQuota(Amount : $UWord);
XVar Memory : MemoryType;
X    I, Start, Finish : $UWord := 0;
XBegin
X  Memory := Zero;
X  If Inc_Alloc_Quota(ALLOC_MEMORY, Amount, Start, Finish) Then
X    For I := Start To Finish Do
X      Put_Record(FILE_MEMORY, I, IAddress(Memory))
X  Else LogErr('Error increase memory quota. ');
XEnd;
X
XFunction CreateMemory(EntityLog : $UWord): Boolean;
XVar Entity : EntityType;
X    Memory : MemoryType;
X    MemoryId : $UWord := 0;
X    Created : Boolean := False;
XBegin
X  If Alloc_Items(ALLOC_MEMORY, MemoryId) Then Begin
X    Get_Record(FILE_ENTITY, EntityLog, IAddress(Entity));
X    Entity.MemoryId := MemoryId;
X    Update_Record(FILE_ENTITY, EntityLog, IAddress(Entity));
X    Memory := Zero;
X    Update_Record(FILE_MEMORY, MemoryId, IAddress(Memory));
X    Created := True;
X  End;
X  CreateMemory := Created;
XEnd;
X
XEnd.
$ CALL UNPACK M4.PAS;1 402905850
$ create 'f'
X`5BInherit('M1', 'M2', 'M3', 'M4'),
X Environment('M5')`5D
X
XModule M5;
X
X
X(* entity functions *)
X
X`5BHidden`5D
XType
X  LocationType = Record
X    NodeIn : $UWord;
X    PosIn  : $UByte;
X  End;
X
X  Entity_Type = Record     (* not to be confused with EntityType *)
X    Id     : $UWord;
X    Entity : EntityType;
X    Next   : `5EEntity_Type;
X  End;
X
X`5BHidden`5D
XVar
X  Entity_File : File Of EntityType;
X  Who_File : File Of LocationType;    (* for quick generation of who list *)
X  TopEntity : Entity_Type;            (* start of link list!              *)
X
XProcedure SetUpEntity;
XVar IsOpen : `5BStatic`5D Boolean := False;
XBegin
X  If IsOpen Then Begin
X    IsOpen := False; Close(Entity_File); Close(Who_File);
X  End Else Begin
X    IsOpen := True;
X    Open_File(FILE_ENTITY, Entity_File, Root+'Entity.Mon', Size(EntityType))
V;
X    Open_File(FILE_WHO, Who_File, Root+'Who.Mon', Size(LocationType));
X  End;
XEnd;
X
XProcedure InitEntityFile(Max : $UWord);
XVar Entity : EntityType; Location : LocationType; I : Integer;
XBegin
X  Entity := Zero; Location := Zero;
X  For I := 1 To Max Do Begin
X    Put_Record(FILE_ENTITY, I, IAddress(Entity));
X    Put_Record(FILE_WHO, I, IAddress(Location));
X  End;
X  InitAlloc(ALLOC_ENTITY, Max);
XEnd;
X
XProcedure IncEntityQuota(Amount : $UWord);
XVar Entity : EntityType;
X    Location : LocationType;
X    I, Start, Finish : $UWord := 0;
XBegin
X  Entity := Zero;
X  Location := Zero;
X  If Inc_Alloc_Quota(ALLOC_ENTITY, Amount, Start, Finish) Then
X    For I := Start To Finish Do Begin
X      Put_Record(FILE_ENTITY, I, IAddress(Entity));
X      Put_Record(FILE_WHO, I, IAddress(Entity));
X    End
X  Else LogErr('Error increase entity quota. ');
XEnd;
X
XProcedure LoadEntitys;
XVar Current, Next : `5EEntity_Type; Entity : EntityType; I : Integer;
X    Allocation : Alloc_Record_Type;
XBegin
X  TopEntity := Zero;               (* initiate entity link list  *)
X  New(Next);                       (* notice TopEntity is always *)
X  TopEntity.Next := Next;          (* empty                      *)
X  Read_Record(FILE_ALLOC, ALLOC_ENTITY, IAddress(Allocation));
X  If (Allocation.Topused > 0) Then Begin
X    For I := 1 To Allocation.Topused Do Begin
X      Current := Next;
X      Read_Record(FILE_ENTITY, I, IAddress(Entity));
X      Current`5E.Id := I;
X      Current`5E.Entity := Entity;
X      New(Next);
X      Current`5E.Next := Next;
X    End;
X  End;
X  Dispose(Current`5E.Next);         (* finiciate block link list     *)
X  Current`5E.Next := NIL;           (* dispose the unused block_type *)
XEnd;
X
XProcedure ReadEntity(EntityId : $UWord; Var Entity : EntityType);
X(*
X *  only some of the data in the record do not change
X *  when fast mode is turned on. use your own judgement
X *  while calling this procedure.
X *)
XVar I : Integer; Current : `5EEntity_Type;
XBegin
X  If FAST_MODE Then Begin
X    Current := TopEntity.Next;
X    If (Entityid > 1) Then
X      For I := 1 To (EntityId-1) Do
X        Current := Current`5E.Next;
X    Entity := Current`5E.Entity;
X  End Else Read_Record(FILE_ENTITY, EntityId, IAddress(Entity));
XEnd;
X
XProcedure PrintEntityNames(EntityKind : $UWord := 0);
XVar Allocation : Alloc_Record_Type;
X    Entity : EntityType;
X    I : Integer;
XBegin
X  Read_Record(FILE_ALLOC, ALLOC_ENTITY, IAddress(Allocation));
X  PutLine(DivLine+DivLine);
X  For I := 1 To Allocation.Topused Do
X    If (Not Allocation.Free`5BI`5D) Then Begin
X      ReadEntity(I, Entity);
X      If (Entity.EntityKind = EntityKind) Or (EntityKind = 0) Then
X        PrintStr(Entity.Name);
X    End;
X  PrintStr;
X  PutLine(DivLine+DivLine);
XEnd;
X
XProcedure UpdateLocation(EntityId, NodeIn, Pos : $UWord);
XVar Location : LocationType;
XBegin
X  Get_Record(FILE_WHO, EntityId, IAddress(Location));
X  Location.NodeIn := NodeIn;
X  Location.PosIn := Pos;
X  Update_Record(FILE_WHO, EntityId, IAddress(Location));
XEnd;
X
XProcedure GetLocation(EntityId : $UWord; Var NodeIn, Pos : $UWord);
XVar Location : LocationType;
XBegin
X  Read_Record(FILE_WHO, EntityId, IAddress(Location));
X  NodeIn := Location.NodeIn;
X  Pos := Location.PosIn;
XEnd;
X
XFunction GrabEntity(Prompt : String_Type; Var S : String_Type;
X   Var EntityId : $UWord; EntityKind : $UWord := 0): Boolean;
XVar Allocation : Alloc_Record_type; Entity : EntityType;
X    I, NameLog : $UWord; NameStr : String_Type;
XBegin
X  While (S.Length = 0) Do
X    GrabLine(Prompt, S);
X  Read_Record(FILE_ALLOC, ALLOC_ENTITY, IAddress(Allocation));
+-+-+-+-+-+-+-+-  END  OF PART 5 +-+-+-+-+-+-+-+-