-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X Var S : String_Type; Var Index : $UWord): Boolean; XBegin X While S.Length = 0 Do Begin X GrabLine(Prompt, S); X If S='?' Then Begin X PutLine(DivLine+DivLine); X PrintTable(Table); X PutLine(DivLine+DivLine); X S := ''; X End; X End; X GrabTable := ParseTable(table, S, Index); XEnd; X X(* Timer function *) X XFunction GetRealTime: $UQuad; XVar TimerVal : $UQuad; XBegin X SysCall($GeTTim(TimerVal)); GetRealTime := TimerVal; XEnd; X XFunction AddRealTime(Sec : Real; TimerVal : $UQuad): $UQuad; XVar TimerVal1, TimerVal2 : $UQUad; XBegin X SysCall( Lib$CvtF_To_Internal_Time(LIB$K_DELTA_SECONDS_F, Sec, TimerVal1)) V; X SysCall( lib$Add_Times(TimerVal, TimerVal1, TimerVal2)); X AddRealTime := TimerVal2; XEnd; X XFunction GetTick: Integer; XVar TimerVal : $UQuad; Sec : Real; XBegin X SysCall(Lib$Stat_Timer(1, TimerVal, TimerContext)); X SysCall(Lib$CvtF_From_Internal_Time(LIB$K_DELTA_SECONDS_F, Sec, TimerVal)) V; X GetTick := Trunc(Sec*10); XEnd; X XFunction DiffInTick(T1, T2 : $UQuad): Integer; XVar T3 : $UQuad; Sec : Real; XBegin X If (T1.Q2 > T2.Q2) Or ((T1.Q2 = T2.Q2) And (T1.Q1 > T2.Q1)) Then Begin X SysCall( Lib$Sub_Times(T1, T2, T3)); X SysCall( Lib$CvtF_From_Internal_Time(LIB$K_DELTA_SECONDS_F, Sec, T3) ); X DiffinTick := Trunc(Sec*10); X End Else DiffInTick := 0; XEnd; X X(* Utility function *) X XProcedure Do_Photo(Var S : String_Type); XVar Fn : String_Type; XBegin X If Not OutputToFile Then Begin X While S.Length = 0 Do GrabLine('File name? ', S); X Fn := S; S := ''; X Open(OutPutFile, Fn, History := UnKnown); X Rewrite(OutputFile); X OutPutToFile := True; X(* If (Status(OutputFile) = 0) Then OutputToFile := True X Else PutLine('Error open file: '+fn); *) X End; XEnd; X XProcedure Do_Source(Var S : String_Type); XVar Fn : String_Type; XBegin X If Not InputFromFile Then Begin X While S.Length = 0 Do GrabLine('File name? ', S); X Fn := S; S := ''; X Open(InputFile, Fn, History := Old, Error := Continue); X Reset(InputFile, Error := Continue); X If (Status(InputFile) = 0) Then InputFromFile := True X Else PutLine('Error open file: '+fn); X End; XEnd; X X(* Initialization function *) X XProcedure InitSmg; XBegin X SysCall( Smg$Create_Virtual_Keyboard(Kbd_Id) ); X SysCall( $Assign('SYS$OUTPUT', OutChan) ); XEnd; X XProcedure InitTimer; XBegin X Seed := Clock; X TimerContext := 0; X SysCall(Lib$Init_Timer(TimerContext)); XEnd; X XEnd. $ CALL UNPACK M1.PAS;1 1903022990 $ create 'f' X`5BInherit('M1','M2','M3','M4','M5','M6','M7','M7_2', X 'M7_3','M9'), X Environment('M10')`5D X XModule M10; X XVar X Brief : Boolean := False; X X`5BHidden`5D XFunction IcanAct(Var S : String_Type; Var Me : EntityType; X Var PersonBlk : BlockType): Boolean; XBegin X ReadEntity(MyEntityId, Me); X Read_Record(FILE_BLOCK, Me.PersonId, IAddress(PersonBlk)); X If (PersonBlk.Person.Health = 0) Then Begin X IcanAct := False; X S := ''; X PutLine('You are dead! '); X End Else IcanAct := True; XEnd; X X`5BHidden`5D XFunction ParseEntityHere(Var NodeIn : EntityType; Var S : String_Type; X Var Target : $UWord): Boolean; XVar Done, SeeHidden, SeeInvisi : Boolean := False; X Map : ItemMapType; XBegin X SeeHidden := IsWindy; X SeeInvisi := IsWindy; X ParseLine(S, Target, TRUE, FALSE); X Read_Record(FILE_ITEMMAP, NodeIn.RoomMapId, IAddress(Map)); X While Not Done Do Begin X ParseMap(Map, 0, POS_IN_ROOM); X ParseMap(Map, 0, POS_OBJ_HERE); X ParseMap(Map, 0, POS_GUARD_N); X ParseMap(Map, 0, POS_GUARD_S); X ParseMap(Map, 0, POS_GUARD_E); X ParseMap(Map, 0, POS_GUARD_W); X ParseMap(Map, 0, POS_GUARD_U); X ParseMap(Map, 0, POS_GUARD_D); X If SeeHidden Then Begin X ParseMap(Map, 0, POS_HIDDEN); X ParseMap(Map, 0, POS_OBJ_HIDE); X End; X If SeeInvisi Then Begin X ParseMap(Map, 0, POS_INVISI); X End; X If (Map.Next > 0) Then X Read_Record(FILE_ITEMMAP, Map.Next, IAddress(Map)) X Else Done := True; X End; X ParseEntityHere := ParseLine(S, Target, FALSE, TRUE); XEnd; X X`5BHidden`5D XFunction ParseHold(Var Entity : EntityType; Var S : String_Type; X Var ObjId : $UWord): Boolean; XVar Done : Boolean := False; X Map : ItemMapType; XBegin X ParseLine(S, ObjId, TRUE, FALSE); X Read_Record(FILE_ITEMMAP, Entity.InvenId, IAddress(Map)); X While Not Done Do Begin X ParseMap(Map, 0, POS_INVEN); X If (Map.Next > 0) Then X Read_Record(FILE_ITEMMAP, Map.Next, IAddress(Map)) X Else Done := True; X End; X ParseHold := ParseLine(S, ObjId, FALSE, TRUE); XEnd; X X`5BHidden`5D XFunction ParseEquip(Var Entity : EntityType; Var S : String_Type; X Var ObjId : $UWord): Boolean; XVar Done : Boolean := False; X Map : ItemMapType; XBegin X ParseLine(S, ObjId, TRUE, FALSE); X Read_Record(FILE_ITEMMAP, Entity.InvenId, IAddress(Map)); X While Not Done Do Begin X ParseMap(Map, 0, POS_WEAPON); X ParseMap(Map, 0, POS_ARMOR); X If (Map.Next > 0) Then X Read_Record(FILE_ITEMMAP, Map.Next, IAddress(Map)) X Else Done := True; X End; X ParseEquip := ParseLine(S, ObjId, FALSE, TRUE); XEnd; X X X(* command functions *) X XProcedure Do_Attack(Var NodeIn : EntityType; Var S : String_Type); XVar Entity, TargEntity : EntityType; X PersonBlk : BlockType; X Target : $UWord; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If ParseEntityHere(NodeIn, S, Target) Then Begin X ReadEntity(Target, TargEntity); X If (TargEntity.EntityKind = ENTITY_PERSON) Then Begin X AttackPerson(Entity, TargEntity, NodeIn, PersonBlk, MyEntityId, X Target, MyLocation, TRUE); X End Else PutLine('You want to attack what? '); X End Else PutLine('No such person can be seen here. '); X End; XEnd; X XProcedure Do_Block(Var NodeIn : EntityType; Var S : String_Type); XVar Entity : EntityType; X PersonBlk : BlockType; X Dir, NewPos, Guardian : $UWord := 0; X X Procedure SetNewPos; X Begin X Case Dir Of X NORTH : NewPos := POS_GUARD_N; X SOUTH : NewPos := POS_GUARD_S; X WEST : NewPos := POS_GUARD_W; X EAST : NewPos := POS_GUARD_E; X UP : NewPos := POS_GUARD_U; X DOWN : NewPos := POS_GUARD_D; X End; X End; X XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If (S.Length = 0) Then Begin X If (MyPosition=POS_GUARD_N) Or (MyPosition=POS_GUARD_S) Or X (MyPosition=POS_GUARD_W) Or (MyPosition=POS_GUARD_E) Or X (MyPosition=POS_GUARD_U) Or (MyPosition=POS_GUARD_D) Then Begin X ChangeMapPos(MyEntityId, MyLocation, NodeIn.RoomMapId, POS_IN_ROOM); X PutLine('You are no longer blocking the exit. '); X End Else PutLine('You are not blocking any exit. '); X End Else If ParseTable(DirTable, S, Dir) Then Begin X If (Not LookUpMap(Guardian, NodeIn.RoomMapId, 0, FALSE, TRUE, NewPos)) X Then Begin X SetNewPos; X ChangeMapPos(MyEntityId, MyLocation, NodeIn.RoomMapId, NewPos); X PutLine('You are now blocking '+DirTable`5BDir`5D+' exit! '); X End Else If (Guardian = MyEntityId) Then X PutLine('You are blocking that exit! ') X Else PutLine('Someone else already blocked '+DirTable`5BDir`5D+' exit. V '); X End Else PutLine('you can''t block that. '); X End; XEnd; X XProcedure Do_Cast(Var NodeIn : EntityType; Var S : String_Type); XVar Entity, Spell : EntityType; X PersonBlk : BlockType; X SpellId, Target, Dir : $UWord := 0; X Continue : Boolean := True; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If GrabEntity('Spell? ', S, SpellId, ENTITY_SPELL) Then Begin X ReadEntity(SpellId, Spell); X If Not HaveEffect(Spell.CastEffect, Entity, PersonBlk, TRUE, FALSE) X Then Begin X If (Spell.SpellFlags`5BSP_GET_DIR`5D) And (Spell.Power > 0) Then Beg Vin X If S.Length = 0 Then GrabLine('Direction? ', S); X Continue := ParseTable(DirTable, S, Dir); X End; X If (Spell.SpellFlags`5BSP_AREA_EFF`5D) Then X Target := ALL_TARGET X Else If (Spell.SpellFlags`5BSP_GET_PNAME`5D) Then Begin X If (Spell.SpellFlags`5BSP_GET_DIR`5D) And (Spell.Power > 0) Then B Vegin X If S.Length = 0 Then GrabLine('At who? ', S); X Continue := ParsePeopleHere(NodeIn, S, Target, IsWindy, IsWindy) X End Else Continue := GrabEntity('At who? ', S, Target, ENTITY_PERS VON); X End Else If (Spell.SpellFlags`5BSP_GET_ONAME`5D) Then Begin X If (Spell.SpellFlags`5BSP_GET_DIR`5D) And (Spell.Power > 0) Then B Vegin X If S.Length = 0 Then GrabLine('At what? ', S); X Continue := ParseObjHere(NodeIn, S, Target, IsWindy); X End Else Continue := GrabEntity('At what? ', S, Target, ENTITY_OBJ VECT); X End; X If Continue Then Begin X CastSpell(Entity, NodeIn, Spell, PersonBlk, MyEntityId, MyLocation V, X SpellId, Target, Dir, TRUE); X End Else PutLine(Spell.Name+' fizzled. '); X End; X End Else PutLine('I don''t remember that spell. '); X End; XEnd; X XProcedure Do_Defend(Var S : String_Type); XVar Entity : EntityType; X PersonBlk : BlockType; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X Get_Record(FILE_BLOCK, Entity.PersonId, IAddress(PersonBlk)); X PersonBlk.Person.Stats`5BSTAT_DEFEND`5D := Not X PersonBlk.Person.Stats`5BSTAT_DEFEND`5D; X Update_Record(FILE_BLOCK, Entity.PersonId, IAddress(PersonBlk)); X If (PersonBlk.Person.Stats`5BSTAT_DEFEND`5D) Then X PutLine('You are now in defensive mode. ') X Else PutLine('You are no longer in defensive mode. '); X End; XEnd; X XProcedure Do_Drop(Var NodeIn : EntityType; Var S : String_Type); XVar Entity : EntityType; X PersonBlk : BlockType; X ObjId : $UWord := 0; X S1 : String_Type; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If (S.Length = 0) Then GrabLine('drop what? ', S); X S1 := S; X If ParseHold(Entity, S1, ObjId) Then Begin X S := S1; X DropObj(Entity, NodeIn, PersonBlk, MyEntityId, MyLocation, ObjId, TRUE V); X End Else If ParseEquip(Entity, S, ObjId) Then X PutLine('You must take it off first. ') X Else PutLine('You are not holding such object. '); X End; XEnd; X XProcedure Do_DropGold(Var NodeIn : EntityType; Var S : String_Type); XVar Entity : EntityType; X PersonBlk, RoomBlk : BlockType; X Amount : Integer; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X Amount := GrabNumberI('How much? ', S); X If (Amount > 0) Then Begin X DropGold(Entity, NodeIn, PersonBlk, RoomBlk, MyEntityId,`20 X MyLocation, Amount, TRUE, IsWindy); X End Else PutLine('ok. '); X End; XEnd; X XProcedure Do_Get(Var NodeIn : EntityType; Var S : String_Type); XVar Entity : EntityType; X PersonBlk : BlockType; X ObjId : $UWord := 0; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If (S.Length = 0) Then GrabLine('get what? ', S); X If ParseObjHere(NodeIn, S, ObjId, IsWindy) Then Begin X GetObj(Entity, NodeIn, PersonBlk, MyEntityId, MyLocation, ObjId, TRUE) V; X End Else PutLine('No such object can be seen here. '); X End; XEnd; X XProcedure Do_GetGold(Var NodeIn : EntityType; Var S : String_Type); XVar Entity : EntityType; X PersonBlk, RoomBlk : BlockType; X Amount : Integer; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X Amount := GrabNumberI('How much? ', S); X If (Amount > 0) Then Begin X GetGold(Entity, NodeIn, PersonBlk, RoomBlk, MyEntityId, X MyLocation, Amount, TRUE); X End Else PutLine('ok. '); X End; XEnd; X XProcedure Do_Inventory(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 ShowInventory(Target); X End Else Begin X ShowInventory(MyEntityId); X End; XEnd; X `20 XProcedure Do_Look(Var NodeIn : EntityType; Var S : String_Type); XVar S1 : String_Type; X Target, Dir : $UWord := 0; X SeeHidden, SeeInvisi : Boolean := False; XBegin X S1 := S; X If ParseEntityHere(NodeIn, S1, Target) Then Begin X S := S1; X DescEntity(Target); X End Else Begin X S1 := S; X SeeHidden := IsWindy; X SeeInvisi := IsWindy; X If ParseTable(DirTable, S1, Dir) Then Begin X S := S1; X DescThere(NodeIn,MyLocation,MyEntityId,Dir,Brief,SeeHidden,SeeInvisi); X End Else Begin X DescRoomIn(NodeIn, MyEntityId, Brief, SeeHidden, SeeInvisi); X End; X End; XEnd; X XProcedure Do_Move(Var NodeIn : EntityType; Dir : $UWord); XVar Entity : EntityType; X PersonBlk, RoomBlk : BlockType; X MoveHidden, MoveInvisi : Boolean; X Loc, Pos : $UWord; X S : String_Type := ''; XBegin X If IcanAct(S, Entity, PersonBlk) Then Begin X If (MyPosition = POS_HIDDEN) Then X MoveHidden := IsWindy X Else If (MyPosition = POS_INVISI) Then X MoveInvisi := IsWindy; X ReadBlock(NodeIn.RoomId, RoomBlk); X If MovePerson(Entity, NodeIn, PersonBlk, RoomBlk, MyLocation, X MyEntityId, Dir, TRUE, MoveHidden, MoveInvisi) Then Begin X SetMyEvent; X ReadEntity(MyLocation, NodeIn); X DescRoomIn(NodeIn, MyEntityId, Brief, IsWindy, IsWindy); X End; X End; XEnd; X XProcedure Do_Ping(Var NodeIn : EntityType; Var S : String_Type); XVar Targ : EntityType; X Target, TLoc, TPos : $UWord := 0; XBegin X If ParsePeopleHere(NodeIn, S, Target, IsWindy, IsWindy) Then Begin X Read_Record(FILE_ENTITY, Target, IAddress(Targ)); X If (Targ.Driver > 0) Then Begin X If IsPlaying(Targ.Driver) Then X PutLine(Targ.Name+' is alive and well. ') X Else Begin X GetLocation(Target, TLoc, TPos); X ChangeMapPos(Target, MyLocation, NodeIn.RoomMapId, 0); X UpdateLocation(Target, TLoc, TPos); X PutLine(Targ.Name+' shimmers and vanishes into thin air. '); X End; X End Else PutLine(Targ.Name+' is a random character. '); X End Else PutLine('No such person can be seen here. '); XEnd; X XProcedure Do_Poof(Var NodeIn : EntityTYpe; X Var S : String_Type); XVar NewLocation, OldPos : $UWord := 0; XBegin X If IsWindy Then Begin X If GrabEntity('Where? ', S, NewLocation, ENTITY_ROOM) Then Begin X TakeToken(MyEntityId, NodeIn.RoomMapId, OldPos); +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+-