-+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+
XVar Alloc_Record : Alloc_Record_Type; I : $UWord;
XBegin
X  Get_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
X  For I := 0 To Amount - 1 Do
X    Alloc_Record.Free`5BNum+I`5D := True;
X  Alloc_Record.Used := Alloc_Record.Used - Amount;
X  Update_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
XEnd;
X
XProcedure Alloc_Slot(Id, Slot : $UWord; IsFree : Boolean);
X(*
X *  This procedure should only be called from debugging
X *  or packing utilities. Be careful!
X *)
XVar  Alloc_Record : Alloc_Record_Type;
XBegin
X  Get_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
X  Alloc_Record.Free`5BSlot`5D := IsFree;
X  Update_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
XEnd;
X
XFunction Inc_Alloc_Quota(Id, Amount : $UWord;
X   Var Start, Finish : $UWord): Boolean;
XVar Alloc_Record : Alloc_Record_Type;
XBegin
X  Get_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
X  If Alloc_Record.Top + Amount > Max_Alloc_Item Then Begin
X    Free_Record(FILE_ALLOC);
X    Inc_Alloc_Quota := False;
X  End Else Begin
X    Start := Alloc_Record.Top + 1;
X    Finish := Alloc_Record.Top + Amount;
X    Alloc_Record.Top := Finish;
X    Update_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
X    Inc_Alloc_Quota := True;
X  End;
XEnd;
X
XProcedure Print_Alloc(Id : $UWord);
XVar Alloc_Record : Alloc_Record_Type; I, J : $UWord := 1; S : String_Type :=
V '';
XBegin
X  Read_Record(FILE_ALLOC, Id, IAddress(Alloc_Record));
X  WriteV(S, '   Used: ', Alloc_Record.Used:0,
X            '   Top used: ', Alloc_Record.Topused:0,
X            '   Max: ', Alloc_Record.Top:0);
X  PutLine(S);
X  PutLine(DivLine+DivLine);
X  While I <= Alloc_Record.Top Do Begin
X    Writev(S, I:5, ': '); J := 1;
X    While (J <= 50) And (I <= Alloc_Record.Top) Do Begin
X      If Alloc_Record.Free`5BI`5D Then S := S + '0'
X      Else S := S + '1';
X      If (J Mod 10) = 0 Then S := S + ' ';
X      I := I + 1; J := J + 1;
X    End;
X    Putline(S);
X  End;
X  PutLine(DivLine+DivLine);
XEnd;
X
XProcedure Show_Alloc;
XVar Allocation : Alloc_Record_Type;
X    I : Integer;
X    S : String_Type;
XBegin
X  PutLine('                           Top      Used  Top used  ');
X  PutLine(DivLine+DivLine);
X  For I := 1 To MaxAllocation Do Begin
X    Read_Record(FILE_ALLOC, I, IAddress(Allocation));
X    WriteV(S, PadStr(Allocnames`5BI`5D, 20), Allocation.Top:10,
X    Allocation.Used:10, Allocation.Topused:10);
X    PutLine(S);
X  End;
X  PutLine(DivLine+DivLine);
XEnd;
X
XEnd.
$ CALL UNPACK M2.PAS;1 1248049371
$ create 'f'
X`5BInherit('M1', 'M2'),
X Environment('M3')`5D
X
XModule M3;
X
XConst
X  MaxExitFlag = 32;
X
X  NORTH = 1;
X  SOUTH = 2;
X  WEST  = 3;
X  EAST  = 4;
X  UP    = 5;
X  DOWN  = 6;
X  MaxRoomExits = 6;
X
X  ROOM_ENV_SHOP = 1;
X  ROOM_ENV_SANC = 2;
X  MaxRoomEnv = 64;
X
X  MaxActPoints = 10;
X
X  MaxNpcSaying = 10;
X
X  ATT_STR = 1;
X  ATT_INT = 2;
X  ATT_WIS = 3;
X  ATT_CHA = 4;
X  ATT_DEX = 5;
X  ATT_CON = 6;
X  MaxPersonAttri = 6;
X
X  STAT_R_FIRE = 1;
X  STAT_R_COLD = 2;
X  STAT_R_ELEC = 3;
X  STAT_R_ACID = 4;
X  STAT_DEFEND = 5;
X  STAT_WORN_ARMOR = 5;
X  MaxPersonStats = 64;
X
X  OBJ_WEAPON = 1;
X  OBJ_ARMOR  = 2;
X  MaxObjKind = 2;
X
X  SP_GET_PNAME = 1;
X  SP_GET_ONAME = 2;
X  SP_GET_MSG   = 3;
X  SP_GET_DIR   = 4;
X  SP_AREA_EFF  = 5;
X  SP_RND_DIR   = 6;
X  MaxSpellFlags = 8;
X
X  SPELL_NORMAL = 1;
X  SPELL_INFORM = 2;
X  MaxSpellKind = 2;
X
X  ItemMapSize = 20;
X
X  ENTITY_ROOM = 1;
X  ENTITY_PERSON = 2;
X  ENTITY_OBJECT = 3;
X  ENTITY_SPELL = 4;
X  ENTITY_CLASS = 5;
X  MaxEntityKind = 5;
X
X  POS_IN_ROOM  = 1;  (* people in room *)
X  POS_HIDDEN   = 2;
X  POS_INVISI   = 3;
X  POS_GUARD_S  = 4;
X  POS_GUARD_N  = 5;
X  POS_GUARD_W  = 6;
X  POS_GUARD_E  = 7;
X  POS_GUARD_U  = 8;
X  POS_GUARD_D  = 9;
X  POS_INVEN    = 10;  (* obj hold        *)
X  POS_ARMOR    = 11;  (* weapon wield    *)
X  POS_WEAPON   = 12;  (* armor wield     *)
X  POS_OBJ_HERE = 13;  (* object in room  *)
X  POS_OBJ_SALE = 14;  (* object for sale *)
X  POS_OBJ_HIDE = 15;  (* object hidden   *)
X  MaxPos = 15;
X
X  ADD = 1;
X  DELETE = 2;
X
X  MaxLevel = 41;
X
X  GLOB_LOCATION = 65535;
X  ALL_TARGET = 65535;
X
X  EV_INFORM = 1;
X  EV_MOVE_IN = 2;
X  EV_MOVE_OUT = 3;
X  EV_MOVE_FAIL = 4;
X  EV_ATTACK = 5;
X  EV_HEALTH = 6;
X  EV_KILLED = 7;
X  EV_SAY = 8;
X  EV_CAST = 9;
X  EV_FREEZE = 10;
X  EV_TELEPORT = 11;
X
X  MaxEnemies = 5;
X  MaxActivePlayer = 100;
X
XType
X  (*  Npc saying  *)
X  NpcSayType = Record
X    KeyWord : String_Type;
X    Saying  : String_Type;
X  End;
X
X  (*  user type  *)
X  User_Type = Record
X    Username  : Short_String_Type;
X    ProcessId : Unsigned;
X    EntityLog : $UWord;
X    Enemies   : Array`5B1..MaxEnemies`5D Of $UWord;
X    IsPlaying : Boolean;
X  End;
X
X  (*  Description Pointer Type  *)
X  DescPtr_Type = Record
X    Start, Finish : $UWord;
X  End;
X
X  LineType = Record
X    Body : String_Type;
X  End;
X
X  (*  Effect Pointer Type  *)
X  EffPtr_Type = Record
X    FromEff, ToEff : $UWord;
X  End;
X
X  (* Effect Type *)
X  Effect_Type = Record
X    Effect : $UWord;
X    Parm1, Parm2 : $UWord;
X  End;
X
X  (*  Entity Type  *)
X  EntityType = Record
X    Name   : Short_String_Type;   (* my name! *)
X    EntityKind : $UWord;          (* what kind of entity am I? *)
X    Case Integer Of
X      ENTITY_ROOM:
X        (RoomId    : $UWord;
X         RoomMapId : $UWord);
X      ENTITY_PERSON:
X        (Owner    : $UWord;
X         Driver   : $UWord;
X         PersonId : $UWord;
X         InvenId  : $UWord;
X         MemoryId : $UWord);
X      ENTITY_OBJECT:
X        (ObjKind    : $UWord;
X         GetEffect  : EffPtr_Type;
X         WornEffect : EffPtr_Type;
X         UseEffect  : EffPtr_Type;
X         AttEffect  : EffPtr_Type);
X      ENTITY_SPELL:
X        (SpellEffect : EffPtr_Type;
X         CastEffect  : EffPtr_Type;
X         SpellFlags  : Packed Array`5B1..MaxSpellFlags`5D Of Boolean;
X         Power       : $UWord;
X         Spellkind   : $UWord);
X      ENTITY_CLASS:
X        (Homeroom    : $UWord;
X         Group       : $UWord;
X         ClassEffect : EffPtr_Type);
X  End;
X
X  (*  Exit Type  *)
X  ExitType = Record
X    Node : Array`5B1..2`5D Of $UWord;
X    Dire : Array`5B1..2`5D Of $UByte;
X    SuccDesc : Array`5B1..2`5D Of DescPtr_Type;
X    FailDesc : Array`5B1..2`5D Of DescPtr_Type;
X    InDesc   : Array`5B1..2`5D Of DescPtr_Type;  (* into the room desc *)
X    OutDesc  : Array`5B1..2`5D Of DescPtr_Type;  (* out of room desc *)
X    Effect   : EffPtr_Type;
X    ExitFlag : Packed Array`5B1..MaxExitFlag`5D Of Boolean;
X  End;
X
X  (*  Room Type  *)
X  RoomType = Record
X    GoldHere  : Integer;
X    RoomClass : $UWord;
X    NameDis   : $UByte;
X    MainDesc  : DescPtr_Type;
X    ExitDesc  : DescPtr_Type;
X    MagicDesc : DescPtr_Type;
X    ExitAlias : Short_String_Type;
X    AliasDir  : $UByte;
X    Exits : Array`5B1..MaxRoomExits`5D Of $UWord;
X    Env : Packed Array`5B1..MaxRoomEnv`5D Of Boolean;
X  End;
X
X  (*  Memory Type *)
X  ActPointsType = Record
X    Where : $UWord;
X    Position : $UByte;   (* My favorite position *)
X    Action   : $UByte;   (* Act like I'm real *)
X    RunAct   : $UByte;   (* What do I do when I'm chased? *)
X    OutDir   : $UByte;   (* Don't go this way! I might get lost *)
X  End;
X
X  MemoryType = Record
X    BaseExp, BaseGold : Integer;
X    Kills, Killed : Integer;
X    ActPoints : Array`5B1..MaxActPoints`5D Of ActPointsType;
X    NpcSaying : Array`5B1..MaxNpcSaying`5D Of $UWord;
X  End;
X
X  (*  Person Type  *)
X  PersonType = Record
X    Group, Class, Home : $UWord;
X    Exp, Gold : Integer;
X    Level, Health, Mana : $UWord;
X    Weapon : $UWord;         (* hack for faster game *)
X    ArmorClass : $UWord;
X    ActionDelay : $UWord;    (* Freeze! *)
X    LastAct  : $UQuad;
X    LastHeal : $UQuad;
X    Stats : Packed Array`5B1..MaxPersonStats`5D Of Boolean;
X    Attributes : Array`5B1..MaxPersonAttri`5D Of $Word;
X    MaxHealth, MaxMana, MaxSpeed : $Word;
X  End;
X
X  (*  Item Map Type  *)
X  ItemMapType = Record
X    Ids  : Packed Array`5B1..ItemMapSize`5D Of $UWord;
X    Pos  : Packed Array`5B1..ItemMapSize`5D Of $UByte;
X    Next : $UWord;
X  End;
X
X  (*  Block Type  *)
X  BlockType = Record
X    Case Integer Of
X      1: (Room : RoomType);
X      2: (Person : PersonType);
X  End;
X
XVar
X  FAST_MODE : Boolean := False;
X
X  DirTable : `5BReadOnly`5D Array`5B1..MaxRoomExits`5D Of Short_String_Type
V := (
X    'north', 'south', 'west', 'east', 'up', 'down');
X
X  RevDirTable : `5BReadOnly`5D Array`5B1..MaxRoomExits`5D Of Short_String_Ty
Vpe := (
X    'South', 'North', 'East', 'West', 'Down', 'Up');
X
X  PersonAttritable : `5BReadOnly`5D Array`5B1..MaxPersonAttri`5D Of Short_St
Vring_Type := (
X    'Strength', 'Intelligence', 'Wisdom', 'Charisma', 'Dexterity',
X    'Constitution');
X
X  EntityKindTable : `5BReadOnly`5D Array`5B1..MaxEntityKind`5D Of Short_Stri
Vng_Type := (
X    'Room', 'Person', 'Object', 'Spell', 'Class');
X
X  ObjKindTable : `5BReadOnly`5D Array`5B1..MaxObjKind`5D Of Short_String_Typ
Ve := (
X    'Weapon', 'Armor');
X
X  SpellKindTable : `5BReadOnly`5D Array`5B1..MaxSpellKind`5D Of Short_String
V_Type := (
X    'Normal', 'Inform');
X
X  PosTable : `5BReadOnly`5D Array`5B1..MaxPos`5D Of Short_String_Type := (
X    'People in room', 'Hidden',          'Invisible',
X    'Guardian South', 'Guardian North',  'Guardian West',
X    'Guardian East',  'Guardian Up',     'Guardian Down',
X    'Inventory',      'Armor',           'Weapon',`20
X    'Object in room', 'Object for sale', 'Object hidden'
X    );
X
X  LevelExpTable : `5BReadOnly`5D Array`5B1..MaxLevel`5D Of Integer := (
X    12,        20,        34,        58,        100,
X    170,       290,       490,       840,       1240,
X    2100,      3600,      6000,      10200,     16200,
X    27000,     42000,     72000,     120000,    200000,
X    340000,    580000,    1000000,   1800000,   3200000,
X    5000000,   7000000,   10500000,  14000000,  20000000,
X    30000000,  42000000,  56000000,  80000000,  110000000,
X    150000000, 200000000, 280000000, 400000000, 600000000,
X    1200000000
X    );
X
X  AddTable : `5BReadOnly`5D Array`5B1..2`5D Of Short_String_Type := (
X    'Add', 'Delete');
X
X  The_Great_Beginning : $UWord := 1;
X
X  InPlay : Boolean := False;
X
X  MyUserLog : $UWord := 0;
X  MyUserId  : Short_String_Type := '';
X
XEnd.
$ CALL UNPACK M3.PAS;1 1534471595
$ create 'f'
X`5BInherit('Sys$Library:Starlet', 'Sys$Library:Pascal$Lib_Routines',
X         'M1', 'M2', 'M3'),
X Environment('M4')`5D
X
XModule M4;
X
X
X(* NPC Say functions *)
X
X`5BHidden`5D
XVar
X  SayFile : File Of NpcSayType;
X
XProcedure SetUpNpcSay;
XVar IsOpen : `5BStatic`5D Boolean := False;
XBegin
X  If IsOpen Then Begin
X    IsOpen := False; Close(SayFile);
X  End Else Begin
X    IsOpen := True;
X    Open_File(FILE_SAY, SayFile, Root+'Say.Mon', Size(NpcSayType));
X  End;
XEnd;
X
XProcedure InitSayFile(Max : $UWord);
XVar  NpcSay : NpcSayType;  I : Integer;
XBegin
X  NpcSay := Zero;
X  For I := 1 To Max Do Put_Record(FILE_SAY, I, IAddress(NpcSay));
X  InitAlloc(ALLOC_SAY, Max);
XEnd;
X
XProcedure IncSayQuota(Amount : $UWord);
XVar Say : NpcSayType;
X    I, Start, Finish : $UWord := 0;
XBegin
X  Say := Zero;
X  If Inc_Alloc_Quota(ALLOC_SAY, Amount, Start, Finish) Then
X    For I := Start To Finish Do
X      Put_Record(FILE_SAY, I, IAddress(Say))
X  Else LogErr('Error increase say quota. ');
XEnd;
X
XFunction CreateSay(Var Id : $UWord; KeyWord : String_Type;
X   Saying : String_Type): Boolean;
XVar  NpcSay : NpcSayType;  Created : Boolean := False;
XBegin
X  If Alloc_Items(ALLOC_SAY, Id) Then Begin
X    Get_Record(FILE_SAY, Id, IAddress(NpcSay));
X    NpcSay.KeyWord := KeyWord;
X    NpcSay.Saying  := Saying;
X    Update_Record(FILE_SAY, Id, IAddress(NpcSay));
X    Created := True;
X  End Else PutLine('Error allocate say. ');
X  CreateSay := Created;
XEnd;
X
XFunction ParseKeyWord(Var S : String_Type; Var Id : $UWord): Boolean;
XVar  NpcSay : NpcSayType; Keyword : String_Type; I : $UWord;
X     Allocation : Alloc_Record_Type;
XBegin
X  Read_Record(FILE_ALLOC, ALLOC_SAY, IAddress(Allocation));
X  ParseLine(S, Id, True, False);
X  For I := 1 To Allocation.Topused Do
X    If (Not Allocation.Free`5BI`5D) Then Begin
X      Read_Record(FILE_SAY, I, IAddress(NpcSay));
X      Keyword := NpcSay.Keyword;  Id := I;
X      ParseLine(Keyword, Id);
X    End;
X  ParseKeyword := ParseLine(S, Id, False, True);
XEnd;
X
X
X(* User function *)
X
X`5BHidden`5D
XVar
X  UserFile : File Of User_Type;
X
XProcedure SetUpUser;
XVar IsOpen : `5BStatic`5D Boolean := False;
XBegin
X  If IsOpen Then Begin
X    IsOpen := False; Close(UserFile);
X  End Else Begin
X    IsOpen := True;
X    Open_File(FILE_USER, UserFile, Root+'User.Mon', Size(User_Type));
X  End;
XEnd;
X
XProcedure InitUserFile(Max : $UWord);
XVar User : User_Type; I : $UWord;
XBegin
X  User := Zero;
X  For I := 1 To Max Do Put_Record(FILE_USER, I, IAddress(User));
X  InitAlloc(ALLOC_USER, Max);
XEnd;
X
XProcedure IncUserQuota(Amount : $UWord);
XVar User : User_Type;
X    I, Start, Finish : $UWord := 0;
XBegin
X  User := Zero;
X  If Inc_Alloc_Quota(ALLOC_USER, Amount, Start, Finish) Then
X    For I := Start To Finish Do
X      Put_Record(FILE_USER, I, IAddress(User))
X  Else LogErr('Error increase user quota. ');
XEnd;
X
XFunction GetUserId: Short_String_Type;
XVar Username : Packed Array`5B1..12`5D Of Char;
XBegin
X  Syscall( Lib$GetJpi(JPI$_USERNAME,,,,Username) );
X  GetUserId := Trim(Username);
XEnd;
X
XFunction IsPlaying(UserId : $UWord): Boolean;
XVar  User : User_Type;
XBegin
X  Read_Record(FILE_USER, UserId, IAddress(User));
X  If User.IsPlaying Then Begin
X    IF (Lib$GetJpi(JPI$_PID, User.ProcessId) = SS$_NONEXPR) Then Begin
X      User.IsPlaying := False;
X      Update_Record(FILE_USER, UserId, IAddress(User));
X      IsPlaying := False;
X    End Else IsPlaying := True;
X  End Else IsPlaying := False;
XEnd;
X
XFunction IsWindy(Toggle : Boolean := False): Boolean;
XVar FirstCall : `5BStatic`5D Boolean := True; IsPrived : `5BStatic`5D Boolea
Vn := False;
XBegin
X  If FirstCall Then Begin
X    FirstCall := False;
X    IsPrived := (GetUserId = 'MASWINDY') Or (GetUserId = 'V112MC2T');
X  End;
+-+-+-+-+-+-+-+-  END  OF PART 4 +-+-+-+-+-+-+-+-