-+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+ X ParseLine(S, EntityId, TRUE, FALSE); 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 Begin X NameLog := I; X NameStr := Entity.Name; X ParseLine(NameStr, NameLog); X End; X End; X GrabEntity := ParseLine(S, EntityId, FALSE, TRUE); XEnd; X X X(* Item map functions *) X X`5BHidden`5D XVar X ItemMapFile : File Of ItemMapType; X XProcedure SetUpItemMap; XVar IsOpen : `5BStatic`5D Boolean := False; XBegin X If IsOpen Then Begin X IsOpen := False; Close(ItemMapFile); X End Else Begin X IsOpen := True; X Open_File(FILE_ITEMMAP, ItemMapFile, Root+'ItemMap.Mon', Size(ItemMapTyp Ve)); X End; XEnd; X XProcedure InitItemMapFile(Max : $UWord); XVar ItemMap : ItemMapType; I : Integer; XBegin X ItemMap := Zero; X For I := 1 To Max Do Put_Record(FILE_ITEMMAP, I, IAddress(ItemMap)); X InitAlloc(ALLOC_ITEMMAP, Max); XEnd; X XProcedure IncItemMapQuota(Amount : $UWord); XVar ItemMap : ItemMapType; X I, Start, Finish : $UWord := 0; XBegin X ItemMap := Zero; X If Inc_Alloc_Quota(ALLOC_ITEMMAP, Amount, Start, Finish) Then X For I := Start To Finish Do X Put_Record(FILE_ITEMMAP, I, IAddress(ItemMap)) X Else LogErr('Error increase item map quota. '); XEnd; X XFunction FindToken(EntityLog, MapId : $UWord; Var FoundIn : $UWord): Boolean V; XVar ItemMap : ItemMapType; I : $UWord := 0; X Found, Done : Boolean := False; XBegin X Read_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X While Not Found And Not Done Do Begin X I := I + 1;`20 X Found := (ItemMap.Ids`5BI`5D = EntityLog); X Done := (I = ItemMapSize); X End; X If Not Found And (ItemMap.Next > 0) Then X Found := FindToken(EntityLog, ItemMap.Next, FoundIn); X FoundIn := MapId; X FindToken := Found; XEnd; X XFunction TakeToken(Id, MapId : $UWord; Var Pos : $UWOrd): Boolean; XVar ItemMap : ItemMapType; Done, Found : Boolean := False; I : Integer := 0 V; XBegin X Get_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X While Not Done And Not Found Do Begin X I := I + 1; X Found := (ItemMap.Ids`5BI`5D = Id); X Done := (I = ItemMapSize); X End; X If Found Then Begin X Pos := ItemMap.Pos`5BI`5D; X ItemMap.Ids`5BI`5D := 0; X ItemMap.Pos`5BI`5D := 0; X Update_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X End Else Begin X Free_Record(FILE_ITEMMAP); X If (ItemMap.Next > 0) Then X Found := TakeToken(Id, ItemMap.Next, Pos); X End; X TakeToken := Found; XEnd; X XFunction PutToken(Id, Loc, MapId, Pos : $UWord; More : Boolean): Boolean; XVar ItemMap : ItemMapType; Done, Found : Boolean := False; I : Integer := 0 V; XBegin X Get_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X While Not Done And Not Found Do Begin X I := I + 1; X Found := (ItemMap.Ids`5BI`5D = 0); X Done := (I = ItemMapSize); X End; X If Found Then Begin X ItemMap.Ids`5BI`5D := Id; X ItemMap.Pos`5BI`5D := Pos; X Update_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X UpdateLocation(Id, Loc, Pos); X End Else If More Then Begin X If (ItemMap.Next > 0) Then Begin X Free_Record(FILE_ITEMMAP); X Found := PutToken(Id, Loc, ItemMap.Next, Pos, More) X End Else If Alloc_Items(ALLOC_ITEMMAP, ItemMap.Next) Then Begin X Update_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X Found := PutToken(Id, Loc, ItemMap.Next, Pos, More); X End Else Free_Record(FILE_ITEMMAP); X End; X PutToken := Found; XEnd; X XFunction LookUpMap(Var Val : $UWord; MapId, Id : $UWord; X IdOnly, PosOnly : Boolean; X P1, P2, P3, P4, P5, P6, P7, P8, P9, P10, P11, P12 : $UWord := 0): Boolean V; XVar Map : ItemMapType; I : Integer; Done, Found, PosMatch : Boolean := Fals Ve; X X Procedure FindOne; X Begin X With Map Do Begin X If IdOnly Then Begin X Found := (Ids`5BI`5D = Id); X Val := Pos`5BI`5D; X End Else Begin X PosMatch := (Pos`5BI`5D=P1) Or (Pos`5BI`5D=P2) Or (Pos`5BI`5D=P3) Or X (Pos`5BI`5D=P4) Or (Pos`5BI`5D=P5) Or (Pos`5BI`5D=P6) Or (Pos`5BI`5D= VP7) Or X (Pos`5BI`5D=P8) Or (Pos`5BI`5D=P9) Or (Pos`5BI`5D=P10) Or (Pos`5BI`5D V=P11) Or X (Pos`5BI`5D=P12); X If PosOnly Then Begin X Found := PosMatch; X Val := Ids`5BI`5D; X End Else Begin X Found := (PosMatch And (Map.Ids`5BI`5D = Id)); X Val := 0; X End; X End; X End; X End; X XBegin X Read_Record(FILE_ITEMMAP, MapId, IAddress(Map)); X While Not Done Do Begin X I := 0; X While (I < ItemmapSize) And Not Found Do Begin X I := I + 1; X If (Map.Ids`5BI`5D > 0) And (Map.Pos`5BI`5D > 0) Then X FindOne; X End; X If Not Found And (Map.Next > 0) Then X Read_Record(FILE_ITEMMAP, Map.Next, IAddress(Map)) X Else Done := True; X End; X LookUpMap := Found; XEnd; X XProcedure ParseMap(Var Map : ItemMapType; Excpt, OldPos : $UWord := 0); XVar Entity : EntityType; I : $UWord; X NameStr : String_Type; NameLog : $UWord; XBegin X With Map Do Begin X For I := 1 To ItemMapSize Do X If (Ids`5BI`5D > 0) And (Ids`5BI`5D <> Excpt) And (Pos`5BI`5D > 0) The Vn X If (Pos`5BI`5D = OldPos) Or (OldPos = 0) Then Begin X ReadEntity(Ids`5BI`5D, Entity); X NameLog := Ids`5BI`5D; X NameStr := Entity.Name; X ParseLine(NameStr, NameLog); X End; X End; XEnd; X XFunction ChangeMapPos(Id, Loc, MapId, NewPos : $UWord): Boolean; XVar Done, Found : Boolean := False; Map : ItemMapType; X I : Integer := 0;`20 XBegin X Get_Record(FILE_ITEMMAP, MapId, IAddress(Map)); X While Not Done Do Begin X While Not Found And (I < ItemMapSize) Do Begin X I := I + 1; X If (Map.Ids`5BI`5D = Id) Then Begin X Found := True; X Map.Pos`5BI`5D := NewPos; X Update_Record(FILE_ITEMMAP, MapId, IAddress(Map)); X UpdateLocation(Id, Loc, NewPos); X End; X End; X If Not Found And (Map.Next > 0) Then Begin X Free_Record(FILE_ITEMMAP); X MapId := Map.Next; X Get_Record(FILE_ITEMMAP, MapId, IAddress(Map)); X End Else Begin X Done := True; X If Not Found Then Free_Record(FILE_ITEMMAP); X End; X End; X ChangeMapPos := Found; XEnd; X XProcedure PrintItemMap(MapId : $UWord); XVar ItemMap : ItemMapType; L : String_Type; I : Integer; XBegin X Read_Record(FILE_ITEMMAP, MapId, IAddress(ItemMap)); X PutLine(DivLine+DivLine); X For I := 1 To ItemMapSize Do Begin X If (ItemMap.Ids`5BI`5D = 0) Then X WriteV(L, ' Slot: ',I:0) X Else X WriteV(L, ' Slot: ',I:0,' Id: ',ItemMap.Ids`5BI`5D:0,' Position: ',Pos VTable`5BItemMap.Pos`5BI`5D`5D); X PutLine(L); X End; X WriteV(L, ' Next: ', ItemMap.Next:0); X PutLine(L); X PutLine(DivLine+DivLine); XEnd; X X X(* Block functions *) X X`5BHidden`5D XType X Block_Type = Record (* not to be confused with BlockType *) X Id : $UWord; X Block : BlockType; X Next : `5EBlock_Type; X End; X X`5BHidden`5D XVar X BlockFile : File Of BlockType; X TopBlock : Block_Type; (* start of link list! *) X XProcedure SetUpBlock; XVar IsOpen : `5BStatic`5D Boolean := False; XBegin X If IsOpen Then Begin X IsOpen := False; Close(BlockFile); X End Else Begin X IsOpen := True; X Open_File(FILE_BLOCK, BlockFile, Root+'Block.Mon', Size(BlockType)); X End; XEnd; X XProcedure InitBlockFile(Max : $UWord); XVar Block : BlockType; I : Integer; XBegin X Block := Zero; X For I := 1 To Max Do Put_Record(FILE_BLOCK, I, IAddress(Block)); X InitAlloc(ALLOC_BLOCK, Max); XEnd; X XProcedure IncBlockQuota(Amount : $UWord); XVar Block : BlockType; X I, Start, Finish : $UWord := 0; XBegin X Block := Zero; X If Inc_Alloc_Quota(ALLOC_BLOCK, Amount, Start, Finish) Then X For I := Start To Finish Do X Put_Record(FILE_BLOCK, I, IAddress(Block)) X Else LogErr('Error increase block quota. '); XEnd; X XProcedure LoadBlocks; XVar Current, Next : `5EBlock_Type; Block : BlockType; I : Integer; X Allocation : Alloc_Record_Type; XBegin X TopBlock := Zero; (* initiate block link list *) X New(Next); (* notice TopBlock is always *) X TopBlock.Next := Next; (* empty *) X Read_Record(FILE_ALLOC, ALLOC_BLOCK, 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_BLOCK, I, IAddress(Block)); X Current`5E.Id := I; X Current`5E.Block := Block; 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 ReadBlock(BlockId : $UWord; Var Block : BlockType); 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 : `5EBlock_Type; XBegin X If FAST_MODE Then Begin X Current := TopBlock.Next; X If (BlockId > 1) Then X For I := 1 To (BlockId-1) Do X Current := Current`5E.Next; X Block := Current`5E.Block; X End Else Read_Record(FILE_BLOCK, BlockId, IAddress(Block)); XEnd; X X X(* Exit functions *) X X`5BHidden`5D XType X Exit_Type = Record (* not to be confused with ExitType *) X Id : $UWord; X Exit : ExitType; X Next : `5EExit_Type; X End; X X`5BHidden`5D XVar X ExitFile : File Of ExitType; X TopExit : Exit_Type; X XProcedure SetUpExit; XVar IsOpen : `5BStatic`5D Boolean := False; XBegin X If IsOpen Then Begin X IsOpen := False; Close(ExitFile); X End Else Begin X IsOpen := True; X Open_File(FILE_EXIT, ExitFile, Root+'Exit.Mon', Size(ExitType)); X End; XEnd; X XProcedure InitExitFile(Max : $UWord); XVar Exit : ExitType; I : Integer; XBegin X Exit := Zero; X For I := 1 To Max Do Put_Record(FILE_EXIT, I, IAddress(Exit)); X InitAlloc(ALLOC_EXIT, Max); XEnd; X XProcedure IncExitQuota(Amount : $UWord); XVar Exit : ExitType; X I, Start, Finish : $UWord := 0; XBegin X Exit := Zero; X If Inc_Alloc_Quota(ALLOC_EXIT, Amount, Start, Finish) Then X For I := Start To Finish Do X Put_Record(FILE_EXIT, I, IAddress(Exit)) X Else LogErr('Error increase exit quota. '); XEnd; X XProcedure LoadExits; XVar Current, Next : `5EExit_Type; Exit : ExitType; I, Max : Integer; X Allocation : Alloc_Record_Type; XBegin X TopExit := Zero; (* initiate exit link list *) X New(Next); (* notice TopExit is always *) X TopExit.Next := Next; (* empty *) X Read_Record(FILE_ALLOC, ALLOC_EXIT, 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_EXIT, I, IAddress(Exit)); X Current`5E.Id := I; X Current`5E.Exit := Exit; X New(Next); X Current`5E.Next := Next; X End; X End; X Dispose(Current`5E.Next); (* finiciate exit link list *) X Current`5E.Next := NIL; (* dispose the unused exit_type *) XEnd; X XProcedure ReadExit(ExitId : $UWord; Var Exit : ExitType); 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 : `5EExit_Type; XBegin X If FAST_MODE Then Begin X Current := TopExit.Next; X If (ExitId > 1) Then X For I := 1 To (Exitid-1) Do X Current := Current`5E.Next; X Exit := Current`5E.Exit; X End Else Read_Record(FILE_EXIT, ExitId, IAddress(Exit)); XEnd; X XFunction CreateExit(Var ExitId : $UWord; X FromLoc, ToLoc, FromDir, ToDir : $UWord := 0): Boolean; XVar Exit : ExitType; Created : Boolean := False; XBegin X If Alloc_Items(ALLOC_EXIT, ExitId) Then Begin X Exit := Zero; X Exit.Node`5B1`5D := FromLoc; Exit.Dire`5B1`5D := FromDir; X Exit.Node`5B2`5D := ToLoc; Exit.Dire`5B2`5D := ToDir; X Update_Record(FILE_EXIT, ExitId, IAddress(Exit)); X Created := True; X End Else LogErr('Error allocate Exit. '); X CreateExit := Created; XEnd; X XProcedure DeleteExit(ExitId : $UWord); XVar Exit : ExitType; XBegin X Exit := Zero; X Update_Record(FILE_EXIT, ExitId, IAddress(Exit)); X Dealloc_Items(ALLOC_EXIT, ExitId); XEnd; X X X(* room functions *) X XFunction CreateRoom(Name : Short_String_Type; X Var EntityLog : $UWord): Boolean; XVar Entity : EntityType; X RoomBlock : BlockType; X RoomMap : ItemMapType; X RoomId, RoomMapId : $UWord; X Created : Boolean := False; XBegin X If Alloc_Items(ALLOC_BLOCK, RoomId) Then Begin X If Alloc_Items(ALLOC_ITEMMAP, RoomMapId) Then Begin X If Alloc_Items(ALLOC_ENTITY, EntityLog) Then Begin X Entity.Name := Name; X Entity.EntityKind := ENTITY_ROOM; X Entity.RoomId := RoomId; X Entity.RoomMapId := RoomMapId; X Update_Record(FILE_ENTITY, EntityLog, IAddress(Entity)); X RoomBlock := Zero; X Update_Record(FILE_BLOCK, RoomId, IAddress(RoomBlock)); X RoomMap := Zero; X Update_Record(FILE_ITEMMAP, RoomMapId, IAddress(RoomMap)); X Created := True; X UpdateLocation(EntityLog, 0, 0); X End Else Begin X Dealloc_Items(ALLOC_ITEMMAP, RoomMapId); X Dealloc_Items(ALLOC_BLOCK, RoomId); X End; X End Else Dealloc_Items(ALLOC_BLOCK, RoomId); X End; X CreateRoom := Created; XEnd; X X X(* create person functions *) X XFunction DefaultPerson: PersonType; XVar Person: PersonType; I : Integer; XBegin X With Person Do Begin X Group := 1; X Class := 2; (* 1 = the great beginning 2 = human .. *) X Home := The_Great_Beginning; X Exp := 1; X Gold := Rnd(20); X Level := 0; X Weapon := 0; X ArmorClass := 0; X ActionDelay := 0; X LastAct := GetRealTime; X LastHeal := GetRealTime; X Stats := Zero; X For I := 1 to MaxPersonAttri Do X Attributes`5BI`5D := 6 + Rnd(6) + Rnd(4); X MaxHealth := 12 + Rnd(8) + Rnd(4); X MaxMana := 6 + Rnd(4) + Rnd(2); X MaxSpeed := 100 + Rnd(40) + Rnd(20); X Health := MaxHealth; +-+-+-+-+-+-+-+- END OF PART 6 +-+-+-+-+-+-+-+-