-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X MyLocation := NewLocation; X ReadEntity(MyLocation, NodeIn); X PutToken(MyEntityId, MyLocation, NodeIn.RoomMapId, OldPos, TRUE); X SetMyEvent; X DescRoomIn(NodeIn, MyEntityId, Brief, TRUE, TRUE); X End; X End Else PutLine('*poof*'); XEnd; X XProcedure Do_Say(Var S : String_Type); XBegin X LogEvent(MyEntityId, 0, EV_SAY, MyLocation, S, FALSE); X S := ''; XEnd; X XProcedure Do_Sheet(Var NodeIn : EntityType; Var S : String_Type); XVar Target : $UWord := 0; X S1 : String_Type; XBegin X S1 := S; X If ParsePeopleHere(NodeIn, S1, Target, IsWindy, IsWindy) Then Begin X S := S1; X If IsWindy Then X ShowSheet(Target) X Else PutLine('You are not prived. '); X End Else Begin X ShowSheet(MyEntityId); X End; XEnd; X XProcedure Do_Takeoff(Var S : String_Type); XVar Entity, Obj : EntityType; X PersonBlk : BlockType; X ObjId : $UWord := 0; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If (S.Length = 0) Then GrabLine('Take off what? ', S); X If ParseEquip(Entity, S, ObjId) Then Begin X ReadEntity(ObjId, Obj); X TakeoffObj(Entity, Obj, PersonBlk, MyEntityId, MyLocation, ObjId, TRUE V); X End Else PutLine('You are not holding such object. '); X End; XEnd; X XProcedure Do_Whereis(Var S : String_Type); XVar AnEntity, RoomEntity : EntityType; X EntityId, Where, Pos : $UWord := 0; XBegin X If GrabEntity('Where is what? ', S, EntityId) Then Begin X ReadEntity(EntityId, AnEntity); X GetLocation(EntityId, Where, Pos); X If (Where > 0) Then X ReadEntity(Where, RoomEntity) X Else RoomEntity.Name := 'Void'; X PutLine(AnEntity.Name+' is in '+RoomEntity.Name+'.'); X End; XEnd; X XProcedure Do_Who; XVar Allocation : Alloc_Record_Type; User : User_Type; X Entity, Class, NodeIn : EntityType; X PersonBlk : BlockType; X I : Integer; X Loc, Pos : $UWord; X S : String_Type; XBegin X Read_Record(FILE_ALLOC, ALLOC_USER, IAddress(Allocation)); X PutLine('Name Level Class Location '); 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 If (User.IsPlaying) Then Begin X ReadEntity(User.EntityLog, Entity); X Read_Record(FILE_BLOCK, Entity.PersonId, IAddress(PersonBlk)); X ReadEntity(PersonBlk.Person.Class, Class); X GetLocation(User.EntityLog, Loc, Pos); X ReadEntity(Loc, NodeIn); X WriteV(S, PersonBlk.Person.Level:0); X PutLine(PadStr(Entity.Name, 20)+PadStr(S, 10)+PadStr(Class.Name, 20) V+ X NodeIn.Name); X End; X End; X PutLine(DivLine+DivLine); XEnd; X XProcedure Do_Wield(Var S : String_Type); XVar Entity, Obj : EntityType; X PersonBlk : BlockType; X ObjId : $UWord := 0; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If (S.Length = 0) Then GrabLine('Wield what? ', S); X If ParseHold(Entity, S, ObjId) Then Begin X ReadEntity(ObjId, Obj); X If (Obj.ObjKind = OBJ_WEAPON) Then X WieldWeapon(Entity, Obj, PersonBlk, MyEntityId, MyLocation, ObjId, T VRUE) X Else If (Obj.ObjKind = OBJ_ARMOR) Then X WearArmor(Entity, Obj, PersonBlk, MyEntityId, MyLocation, ObjId, TRU VE) X Else PutLine('You can''t wield '+Obj.Name+'.'); X End Else PutLine('You are not holding such object. '); X End; XEnd; X XProcedure Do_Brief; XBegin X Brief := Not Brief; X If Brief Then X PutLine('Brief description.') X Else PutLine('Verbose description. '); XEnd; X XProcedure ParseCmd; XConst X C_Attack = 1; C_Block = 2; C_Build = 3; C_Cast = 4; X C_Down = 5; C_Defend = 6; C_Drop = 7; C_Dropgold = 8; X C_East = 9; C_Get = 10; C_Getgold = 11; C_Inventory = 12; X C_Look = 13; C_Memory = 14; C_North = 15; C_Ping = 16; X C_Poof = 17; C_Photo = 18; C_Priv = 19; C_Quit = 20; X C_South = 21; C_Source = 22; C_Sheet = 23; C_Say = 24; X C_Steal = 25; C_Takeoff = 26; C_Up = 27; C_West = 28; X C_Who = 29; C_Wield = 30; C_Brief = 31; C_Bash = 32; X C_Hide = 33; C_Search = 34; C_Whereis = 35; X MaxCmds = 35; XVar X CmdTable : `5BReadonly`5D Array`5B1..MaxCmds`5D Of Short_String_Type :=`20 X ('Attack', 'Block', 'Build', 'Cast', X 'Down', 'Defend', 'Drop', 'Drop gold', X 'East', 'Get', 'Get gold', 'Inventory', X 'Look', 'Memory', 'North', 'Ping', X 'Poof', 'Photo', 'Priv', 'Quit', X 'South', 'Source', 'Sheet', 'Say', X 'Steal', 'Takeoff', 'Up', 'West', X 'Who', 'Wield', 'Brief', 'Bash', X 'Hide', 'Search', 'Where is'); X S, OldS : String_Type := ''; Cmd : $UWord; X Done : Boolean := False; X NodeIn : EntityType; XBegin X InPlay := True; X While Not Done Do Begin X If (S.Length = 0) Then Begin X While (S.Length = 0) Do Begin X GrabLine('> ', S); X If (S = '?') Then Begin X PutLine(DivLine+DivLine); X PrintTable(CmdTable); X S := ''; X PutLine(DivLine+DivLine); X End; X End; X If (S = '.') Then X S := OldS X Else X OldS := S; X End; X If (S`5B1`5D = '''') Then Begin X S := SubStr(S, 2, S.Length - 1); X Do_Say(S); X End Else If ParseTable(CmdTable, S, Cmd) Then Begin X ReadEntity(MyLocation, NodeIn); X GetLocation(MyEntityId, MyLocation, MyPosition); X Case Cmd Of X C_Attack : Do_Attack(NodeIn, S); X C_Block : Do_Block(NodeIn, S); X C_Build : If IsWindy Then Do_Build(NodeIn, S, MyLocation); X C_Cast : Do_Cast(NodeIN, S); X C_Down : Do_Move(NodeIn, DOWN); X C_Defend : Do_Defend(S); X C_Drop : Do_Drop(NodeIn, S); X C_DropGold : Do_DropGold(NodeIn, S); X C_East : Do_Move(NodeIn, EAST); X C_Get : Do_Get(NodeIn, S); X C_GetGold : Do_GetGold(NodeIn, S); X C_Inventory: Do_Inventory(NodeIn, S); X C_Look : Do_Look(NodeIn, S); X C_Memory : PutLine('Not yet implemented. '); X C_North : Do_Move(NodeIn, NORTH); X C_Ping : Do_Ping(NodeIn, S); X C_Poof : Do_Poof(NodeIn, S); X C_Photo : Do_Photo(S); X C_Priv : IsWindy(TRUE); X C_Quit : Done := True; X C_South : Do_Move(NodeIn, SOUTH); X C_Source : Do_Source(S); X C_Sheet : Do_Sheet(NodeIn, S); X C_Say : Do_Say(S); X C_Steal : PutLine('Not yet implemented. '); X C_Takeoff : Do_TakeOff(S); X C_Up : Do_Move(NodeIn, UP); X C_West : Do_Move(NodeIn, WEST); X C_Who : Do_Who; X C_Wield : Do_Wield(S); X C_Brief : Do_Brief; X C_Bash : PutLine('Not yet implemented. '); X C_Hide : PutLine('Not yet implemented. '); X C_Search : PutLine('Not yet implemented. '); X C_Whereis : Do_Whereis(S); X End; (* case *) X End Else PutLine('Type ? for a list of command. '); X End; X InPlay := False; XEnd; X XEnd. $ CALL UNPACK M10.PAS;1 1025498404 $ create 'f' X`5BInherit('Sys$Library:Starlet', X 'M1'), X Environment('M2')`5D X XModule M2; X X X(* Error Function *) X XConst X ErrFn = 'DISK$USERDISK1:`5BMAS0.MASMONST.DATAFILES.MONSTERII`5DError.Mon'; X XVar X ErrMsg : Long_String_Type; X ErrFile : `5BHidden`5D Text; X XProcedure SetupError; XVar IsOpen : `5BStatic`5D Boolean := False; XBegin X If IsOpen Then Begin X IsOpen := False; Close(ErrFile); X End Else Begin X Open(ErrFile, ErrFn, History := Unknown, Sharing := ReadWrite); X Extend(ErrFile); X IsOpen := True; X End; XEnd; X XProcedure LogErr(S : Long_String_Type); XVar Dstr, Tstr : Packed Array`5B1..11`5D Of Char; XBegin X PutLine(S); X Date(Dstr); Time(TStr); X S := Dstr + ' ' + Tstr + ' ' + S; X WriteLn(ErrFile, S); XEnd; X X X(* RMS functions *) X XConst X FILE_ALLOC = 1; FILE_SAY = 2; FILE_USER = 3; FILE_LINE = 4; X FILE_ENTITY = 5; FILE_BLOCK = 6; FILE_ITEMMAP = 7; FILE_EXIT = 8; X FILE_EVENT = 9; FILE_WHO = 10; FILE_EFFECT = 11; FILE_MEMORY = 12; X MaxFiles = 13; X X ALLOC_SAY = 1; ALLOC_USER = 2; ALLOC_LINE = 3; ALLOC_ENTITY = 4; X ALLOC_BLOCK = 5; ALLOC_ITEMMAP = 6; ALLOC_EXIT = 7; ALLOC_EFFECT = 8; X ALLOC_MEMORY = 9; X MaxAllocation = 9; X X Wait_Time = 20; X X`5BHidden`5D XType X Unsafe_File = `5BUnsafe`5D File Of Char; X Ptr_To_Fab = `5EFab$Type; X Ptr_To_Rab = `5ERab$Type; X XVar X Fnames : Array`5B1..MaxFiles`5D Of Short_String_Type := ( X 'Allocation file', 'Say file', 'User file', 'Line file', X 'Entity file', 'Block file', 'Item map file', 'Exit file', X 'Event file', 'Location file', 'Effect file', 'Memory file', X ''); X X Allocnames : Array`5B1..MaxAllocation`5D Of Short_String_Type := ( X 'Say', 'User', 'Line', 'Entity', 'Block', X 'Item map', 'Exit', 'Effect', 'Memory'); X X`5BHidden`5D XVar X Fab_Ptrs : Array`5B1..MaxFiles`5D Of Ptr_To_Fab; X Rab_ptrs : Array`5B1..MaxFiles`5D Of Ptr_To_Rab; X Rms_Status : Unsigned; X X`5BExternal, Hidden`5D XFunction Pas$Fab(VAR F : UnSafe_File) : Ptr_To_Fab; Extern; X X`5BExternal, Hidden`5D XFunction Pas$Rab(VAR F : Unsafe_File) : Ptr_To_Rab; Extern; X XProcedure Open_File(F_Id : $UWord; Var F : Unsafe_File; Fn : String_Type; X Rsz : $UWord); XBegin X Open(F, Fn, History := Unknown, Access_Method := Direct, Sharing := ReadWr Vite); X Fab_Ptrs`5BF_Id`5D := Pas$Fab(F); X Rab_Ptrs`5BF_Id`5D := Pas$Rab(F); X Rab_Ptrs`5BF_Id`5D`5E.RAB$W_RSZ := Rsz; XEnd; X XProcedure Get_Record(F_Id : $UWord; R_Id, R : `5BLong, Unsafe`5D Unsigned); XBegin X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_RAC := RAB$C_KEY; X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_TMO := Wait_Time; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_ROP := RAB$M_WAT + RAB$M_TMO; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_UBF := R; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_KBF := IAddress(R_Id); X Rms_Status := $GET(Rab_Ptrs`5BF_Id`5D`5E); X If Rms_Status <> RMS$_NORMAL Then Begin X WriteV(ErrMsg, 'Error Get Record ', FNames`5BF_Id`5D, ' ', Rms_Status); X LogErr(ErrMsg); X Halt; X End; XEnd; X XProcedure Put_Record(F_Id : $UWord; R_Id, R : `5BLong, Unsafe`5D Unsigned); XBegin X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_RAC := RAB$C_KEY; X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_TMO := Wait_Time; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_ROP := RAB$M_UIF + RAB$M_WAT + RAB$M_TMO; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_RBF := R; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_KBF := IAddress(R_Id); X Rms_Status := $Put(Rab_Ptrs`5BF_Id`5D`5E); X If Rms_Status <> RMS$_NORMAL Then Begin X WriteV(ErrMsg, 'Error Put Record ', FNames`5BF_Id`5D, ' ', Rms_Status); X LogErr(ErrMsg); X Halt; X End; XEnd; X XProcedure Update_Record(F_Id : $UWord; R_Id, R : `5BLong, Unsafe`5D Unsigned V); XBegin X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_RAC := RAB$C_KEY; X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_TMO := Wait_Time; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_ROP := RAB$M_RLK + RAB$M_WAT + RAB$M_TMO; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_RBF := R; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_KBF := IAddress(R_Id); X Rms_Status := $Find(Rab_Ptrs`5BF_Id`5D`5E); X Rms_Status := $Update(Rab_Ptrs`5BF_Id`5D`5E); X If Rms_Status <> RMS$_NORMAL Then Begin X WriteV(ErrMsg, 'Error Update Record ', FNames`5BF_Id`5D, ' ', Rms_Status V); X LogErr(ErrMsg); X Halt; X End; XEnd; X XProcedure Free_Record(F_Id : $UWord); XBegin X Rms_Status := $RELEASE(Rab_Ptrs`5BF_Id`5D`5E); X If Rms_Status <> RMS$_NORMAL Then Begin X WriteV(ErrMsg, 'Error Free Record ', FNames`5BF_Id`5D, ' ', Rms_Status); X LogErr(ErrMsg); X End; XEnd; X XProcedure Read_Record(F_Id : $UWord; R_Id, R : `5BLong, Unsafe`5D Unsigned); XBegin X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_RAC := RAB$C_KEY; X Rab_Ptrs`5BF_Id`5D`5E.RAB$B_TMO := Wait_Time; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_ROP := RAB$M_NLK + RAB$M_WAT + RAB$M_TMO; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_UBF := R; X Rab_Ptrs`5BF_Id`5D`5E.RAB$L_KBF := IAddress(R_Id); X Rms_Status := $GET(Rab_Ptrs`5BF_Id`5D`5E); X If Rms_Status <> RMS$_NORMAL Then Begin X WriteV(ErrMsg, 'Error Read Record ', FNames`5BF_Id`5D, ' ', Rms_Status); X LogErr(ErrMsg); X Halt; X End; XEnd; X X X(* Allocation functions *) X XConst X Max_Alloc_Item = 20000; X Default_Root = 'DISK$USERDISK1:`5BMAS0.MASMONST.DATAFILES.MONSTERII`5D'; X XType X Alloc_Record_Type = Packed Record X Top, Topused, Used : $UWord; X Free : Packed Array`5B1..Max_Alloc_Item`5D Of Boolean; X End; X XVar X Root : String_Type := Default_Root; X Alloc_File : File Of Alloc_Record_Type; X XProcedure SetUpAlloc; XVar IsOpen : `5BStatic`5D Boolean := False; XBegin X If IsOpen Then Begin X IsOpen := False; Close(Alloc_File); X End Else Begin X IsOpen := True; X Open_File(FILE_ALLOC, Alloc_File, Root+'Alloc.Mon', Size(Alloc_Record_Ty Vpe)); X End; XEnd; X XProcedure InitAlloc(Id, Max : $UWord); XVar Alloc_Record : Alloc_Record_Type; I : Integer; XBegin X Alloc_Record.Top := Max; X Alloc_Record.Topused := 0; X Alloc_Record.Used := 0; X For I := 1 to Max_Alloc_Item do Alloc_Record.Free`5Bi`5D := True; X Put_Record(FILE_ALLOC, Id, IAddress(Alloc_Record)); XEnd; X X`5BHidden`5D XFunction Allocated(Var At : $UWord; Amount : $UWord; X Var Alloc_Record : Alloc_Record_Type): Boolean; XVar Going : Boolean := True; I : $UWord := 0; XBegin X While Going And (I < Amount) Do Begin X Going := Alloc_Record.Free`5BAt + I`5D; X I := I + 1; X End; X If Not Going Then At := At + I; X Allocated := Going; XEnd; X XFunction Alloc_Items(Id : $UWord; Var Log : $UWord; X Amount : $UWord := 1): Boolean; XVar Alloc_Record : Alloc_Record_Type; Done, Found : Boolean := False; X I, C : $UWord := 1; XBegin X Get_Record(FILE_ALLOC, Id, IAddress(Alloc_Record)); X While Not Done Do Begin X If Allocated(I, Amount, Alloc_Record) Then Begin X Log := I; X Found := True; X For C := 0 To Amount - 1 Do X Alloc_Record.Free`5BLog+C`5D := False; X Alloc_Record.Used := Alloc_Record.Used + Amount; X If (Alloc_Record.Used > Alloc_Record.Topused) Then X Alloc_Record.Topused := Alloc_Record.Used; X Update_Record(FILE_ALLOC, Id, IAddress(Alloc_Record)); X End; X Done := Found Or (I >= Alloc_Record.Top); `20 X End; X If Not Found Then Free_Record(FILE_ALLOC); X Alloc_Items := Found; XEnd; X XProcedure Dealloc_Items(Id, Num : $UWord; Amount : $UWord := 1); +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+-