-+-+-+-+-+-+-+-+ START OF PART 9 -+-+-+-+-+-+-+-+ X End Else PutLine('No such object can be seen here. '); X End; X X Procedure ChangeExit; X Const X E_Succ_Desc = 1; E_Fail_Desc = 2; E_In_Desc = 3; E_Out_Desc = 4; X E_Effect = 5; E_Flags = 6; X MaxExitOpt = 6; X Var X ExitOptTable : Array`5B1..MaxExitOpt`5D Of Short_String_Type := ( X 'success desc', 'fail desc', 'into room desc', X 'out of room desc', 'pass effect', 'flags'); X EntityLog, Dir, Index, Opt : $UWord := 0; X AnExit : ExitType; X Begin X If GrabEntity('Room? ', S, EntityLog, ENTITY_ROOM) Then Begin X If GrabTable('Exit direction? ', DirTable, S, Dir) Then Begin X ReadEntity(EntityLog, Entity); X ReadBlock(Entity.RoomId, Block); X If (Block.Room.Exits`5BDir`5D > 0) Then Begin X Read_Record(FILE_EXIT, Block.Room.Exits`5BDir`5D, IAddress(AnExit)) V; X If (AnExit.Node`5B1`5D = EntityLog) And (AnExit.Dire`5B1`5D = Dir) V Then X Index := 1 X Else Index := 2; (* cross my finger.. *) X If GrabTable('Exit option? ', ExitOptTable, S, Opt) Then Begin X Case Opt Of X E_Succ_Desc : EditDesc(AnExit.SuccDesc`5BIndex`5D, S); X E_Fail_Desc : EditDesc(AnExit.FailDesc`5BIndex`5D, S); X E_In_Desc : EditDesc(AnExit.InDesc`5BIndex`5D, S); X E_Out_Desc : EditDesc(AnExit.OutDesc`5BIndex`5D, S); X E_Effect : EditEffect(AnExit.Effect, S); X E_Flags : PutLine('Not yet implemented. '); X End; X Update_Record(FILE_EXIT, Block.Room.Exits`5BDir`5D, IAddress(AnEx Vit)); X End Else PutLine('Type ? for a list of exit options. '); X End Else PutLine('There is no exit at that direction. '); X End Else PutLine('error parsing direction. '); X End Else PutLine('There is no such room. '); X End; X X Procedure ChangeClass; X Const X C_Homeroom = 1; C_Group = 2; C_Effect = 3; MaxClassOpt = 3; X Var X ClassOptTable : Array`5B1..MaxClassOpt`5D Of Short_String_Type := ( X 'Homerooom', 'Group', 'Class effect'); X ClassId, Opt : $UWord := 0; X Begin X If GrabEntity('Class? ', S, ClassId, ENTITY_CLASS) Then Begin X If GrabTable('Class option? ', ClassOptTable, S, Opt) Then Begin X ReadEntity(ClassId, Entity); X Case Opt Of X C_Homeroom : If Not GrabEntity('Homeroom? ', S, Entity.Homeroom, X ENTITY_ROOM) Then PutLine('Error parsing home room name. '); X C_Group : Entity.Group := GrabNumberW('Group? ', S); X C_Effect : EditEffect(Entity.ClassEffect, S); X End; X Update_Record(FILE_ENTITY, ClassId, IAddress(Entity)); X End Else PutLine('Type ? for a list of class option. '); X End Else PutLine('No such class. '); X End; X XBegin X If GrabTable('Change what? ', BuildTable, S, Cmd) Then X Case Cmd Of X B_ROOM : ChangeRoom; X B_PERSON : ChangePerson; X B_SPELL : ChangeSpell; X B_OBJECT : ChangeObject; X B_EXIT : ChangeExit; X B_CLASS : ChangeClass; X B_USER : PutLine('Not yet implemented. '); X B_MEMORY : ChangeMemory(S, Where); X End X Else PutLine('Type ? for list of command. '); XEnd; X XProcedure Do_Create(Var S : String_Type; Where, MapId : $UWord); XVar Cmd : $UWord := 0; X ExitId, EntityLog : $UWord := 0; X FromLoc, ToLoc, FromDir, ToDir : $UWord := 0; X NameStr : Short_String_Type; X X Procedure DoCreateExit; X Begin X If GrabEntity('Exit from? ', S, FromLoc, ENTITY_ROOM) Then Begin X If GrabEntity('Exit to? ', S, ToLoc, ENTITY_ROOM) Then Begin X If Not GrabTable('From direction? ', DirTable, S, FromDir) Then X FromDir := 0; X If CanLink(FromLoc, FromDir) Then Begin X If Not GrabTable('To direction? ', DirTable, S, ToDir) Then X ToDir := 0; X If CanLink(ToLoc, ToDir) Then Begin X If CreateExit(ExitId, FromLoc, ToLoc, FromDir, ToDir) Then Begin X LinkRooms(ExitId, FromLoc, ToLoc, FromDir, ToDir); X PutLine('Exit created. '); X End; X End Else PutLine('Exit already exist in second room. '); X End Else PutLine('Exit already exist in first room. '); X End Else PutLine('Second room not found. ') X End Else PutLine('First room not found. '); X End; X X Procedure DoCreateEntity; X Begin X While S.Length = 0 Do GrabLine('Name? ', S); X NameStr := Short(S); X S := ''; X Case Cmd Of X B_ROOM : X If CreateRoom(NameStr, EntityLog) Then X PutLine('Room created. ') X Else PutLine('Room creation failed. '); X B_PERSON : X If CreatePerson(NameStr, EntityLog, 0, 0, Where, MapId) Then X PutLine('Person created. ') X Else PutLine('Person creation failed. '); X B_OBJECT : X If CreateObject(NameStr, EntityLog, Where, MapId) Then X PutLine('Object created. ') X Else PutLine('Object creation failed. '); X B_SPELL : X If CreateSpell(NameStr, EntityLog) Then X PutLine('Spell created. ') X Else PutLine('Spell creation failed. '); X B_CLASS : X If CreateClass(NameStr, EntityLog) Then X PutLine('Class created. ') X Else PutLine('Class creation failed. '); X End (* case *) X End; X X Procedure DoCreateMemory; X Var NodeIn : EntityType; X Begin X ReadEntity(Where, NodeIn); X If (S.Length = 0) Then GrabLine('Person name? ', S); X If ParsePeopleHere(NodeIn, S, EntityLog) Then Begin X If CreateMemory(EntityLog) Then X PutLine('Done. ') X Else PutLine('Create memory failed. '); X End Else PutLine('No such person can be seen here. '); X End; X XBegin X If GrabTable('Create what? ', BuildTable, S, Cmd) Then X Case Cmd Of X B_ROOM, B_PERSON, B_OBJECT, B_SPELL, B_CLASS : DoCreateEntity; X B_EXIT : DoCreateExit; X B_USER : PutLine('Use force and play commands at Start> prompt. '); X B_MEMORY : DoCreateMemory; X End X Else PutLine('Type ? for a list of create options. '); XEnd; X XProcedure ListExits; XVar Allocation : Alloc_Record_Type; X AnExit : ExitType; X FromRoom, ToRoom : EntityType; X FromDir, ToDir : Short_String_Type; X L : String_Type; X I : Integer; XBegin X PutLine(DivLine+DivLine); X Read_Record(FILE_ALLOC, ALLOC_EXIT, IAddress(Allocation)); X For I := 1 To Allocation.Topused Do X If (Not Allocation.Free`5BI`5D) Then Begin X ReadExit(I, AnExit); X If AnExit.Node`5B1`5D > 0 Then X ReadEntity(AnExit.Node`5B1`5D, FromRoom) X Else FromRoom.Name := 'Void'; X If AnExit.Node`5B2`5D > 0 Then X ReadEntity(AnExit.Node`5B2`5D, ToRoom) X Else ToRoom.Name := 'Void'; X If AnExit.Dire`5B1`5D > 0 Then X FromDir := DirTable`5BAnExit.Dire`5B1`5D`5D X Else FromDir := ''; X If AnExit.Dire`5B2`5D > 0 Then X ToDir := DirTable`5BAnExit.Dire`5B2`5D`5D X Else ToDir := ''; X WriteV(L, 'Exit ', I:5, ': ', PadStr(FromRoom.Name, 20), ' ', X PadStr(FromDir, 6), ' ', PadStr(ToRoom.Name, 20), ' ', PadStr(ToDir, 6 V)); X PutLine(L); X End; X PutLine(DivLine+DivLine); XEnd; X XProcedure Do_List(Var S : String_Type); XVar Cmd : $UWord := 0; XBegin X If GrabTable('List what? ', BuildTable, S, Cmd) Then X Case Cmd Of X B_ROOM : PrintEntityNames(ENTITY_ROOM); X B_PERSON : PrintEntityNames(ENTITY_PERSON); X B_OBJECT : PrintEntityNames(ENTITY_OBJECT); X B_SPELL : PrintEntityNames(ENTITY_SPELL); X B_CLASS : PrintEntityNames(ENTITY_CLASS); X B_EXIT : ListExits; X B_USER : PrintUsernames; X B_MEMORY : PutLine('Not yet implemented. '); X End X Else PutLine('Type ? for a list of list options. '); XEnd; X XProcedure Do_Show(Var S : String_Type); XBegin X PutLine('Not yet implmented. '); XEnd; X XProcedure Do_Quota(Var S : String_Type); XConst X C_Show = 1; C_Increase = 2; C_Decrease = 3; C_Set = 4; C_Quit = 5; X C_Print = 6; X MaxCmd = 6; XVar X CmdTable : Array`5B1..MaxCmd`5D Of Short_String_Type := ( X 'Show', 'Increase', 'Decrease', 'Set', 'Quit', 'Print'); X Cmd, Opt : $UWord := 0; X Done : Boolean := False; X X Procedure DoIncAlloc; X Var Amount : $UWord; X Begin X Amount := GrabNumberW('Increase by how much? ', S); X If Amount > 0 Then X Case Opt Of X ALLOC_SAY : IncSayQuota(Amount); X ALLOC_USER : IncUserQuota(Amount); X ALLOC_LINE : IncLineQuota(Amount); X ALLOC_ENTITY : IncEntityQuota(Amount); X ALLOC_ITEMMAP : IncItemMapQuota(Amount); X ALLOC_BLOCK : IncBlockQuota(Amount); X ALLOC_EXIT : IncExitQuota(Amount); X ALLOC_EFFECT : IncEffectQuota(Amount); X ALLOC_MEMORY : IncMemoryQuota(Amount); X End X Else PutLine('Quota unchanged. '); X End; X XBegin X While Not Done Do Begin X If GrabTable('Quota> ', CmdTable, S, Cmd) Then Begin X If (Cmd = C_Quit) Then X Done := True X Else If (Cmd = C_Show) Then X Show_Alloc X Else Begin X If GrabTable('Allocation item? ', Allocnames, S, Opt) Then X Case Cmd Of X C_Increase : DoIncAlloc; X C_Print : Print_Alloc(Opt); X C_Decrease : PutLine('Not yet implemented. '); X C_Set : PutLine('Not yet implemented. '); X End X Else PutLine('Type ? for a list of allocation item. '); X End; X End Else PutLine('Type ? for a list of quota command. '); X End; XEnd; X XProcedure Do_Build(Var NodeIn : EntityType; Var S : String_Type; X Where : $UWord); XConst X C_CHANGE = 1; C_CREATE = 2; C_DELETE = 3; C_QUIT = 4; C_LIST = 5;`20 X C_SHOW = 6; C_QUOTA = 7; X MaxCmd = 7; XVar X CmdTable : Array`5B1..MaxCmd`5D Of Short_String_Type := ( X 'Change', 'Create', 'Delete', 'Quit', 'List', 'Show', 'Quota'); X Cmd : $UWord := 0; X Done : Boolean := False; XBegin X If FAST_MODE Then PutLine('Fast mode is on, be careful. '); X While Not Done Do Begin X If GrabTable('Build> ', CmdTable, S, Cmd) Then X Case Cmd Of X C_CHANGE : Do_Change(S, Where, NodeIn.RoomMapId); X C_CREATE : Do_Create(S, Where, NodeIn.RoomMapId); X C_DELETE : PutLine('Not yet implmented. '); X C_QUIT : Done := True; X C_LIST : Do_List(S); X C_SHOW : Do_Show(S); X C_QUOTA : Do_Quota(S); X End X Else PutLine('Type ? for a list of build commands. '); X End; XEnd; X XEnd. $ CALL UNPACK M7.PAS;1 409116070 $ create 'f' X`5BInherit('M1', 'M2', 'M3', 'M4', 'M5', 'M6'), X Environment('M7_2')`5D X XModule M7_2; X X X(* text output functions *) X XFunction HealthLevel(Health, MaxHealth : Integer): $UWord; XBegin X Case (Health*100 Div MaxHealth) Of X 0 : HealthLevel := 0; X 1..20 : HealthLevel := 1; X 21..40 : HealthLevel := 2; X 41..60 : HealthLevel := 3; X 61..80 : HealthLevel := 4; X 81..99 : HealthLevel := 5; X 100 : HealthLevel := 6; X Otherwise HealthLevel := 7; X End; XEnd; X XProcedure DescHealth(S : Short_String_Type; HealthLev : Integer; X IsYou : Boolean); XBegin X If IsYou Then X Case HealthLev Of X 0: PutLine('You are dead! '); X 1: PutLine('You are near death! '); X 2: PutLine('You are in critical condition, and very weak! '); X 3: PutLine('You are very badly wounded! '); X 4: PutLine('You have some serious wounds. '); X 5: PutLine('You have some minor wounds. '); X 6: PutLine('You are in perfect health. '); X 7: PutLine('You are in exceptional health. '); X Otherwise PutLine('You are in bogus health, notify monster manager. ') V; X End X Else X Case HealthLev Of X 0: PutLine(S+' is dead! '); X 1: PutLine(S+' seems to be dead! '); X 2: PutLine(S+' is in critical condition, and very weak! '); X 3: PutLine(S+' is very badly wounded! '); X 4: PutLine(S+' has some serious wounds. '); X 5: PutLine(S+' has some minor wounds. '); X 6: PutLine(S+' is in perfect health. '); X 7: PutLine(S+' is in exceptional health. '); X Otherwise PutLine(S+' is in bogus health, notify monster manager. '); X End; XEnd; X XProcedure DescAttack(S1, S2 : Short_String_Type; X S3 : Short_String_Type := ''); XBegin X If (S3.Length = 0) Then`20 X Case Rnd(2) Of X 0: PutLine(S1+' dealt a crushing blow to '+S2+'! '); X 1: PutLine(S1+' crashed into '+S2+' with lightning speed! '); X 2: PutLine(S2+' doubles over from the blow from '+S1+'! '); X End XEnd; X XProcedure DescSpellAttack(Name1, Name2, SpellName : Short_String_Type; X IsRemote, HitAll : Boolean); XBegin X If IsRemote And HitAll Then X PutLine('A '+SpellName+' flew into the room and hits everybody! ') X Else If IsRemote Then X PutLine('A '+SpellName+' flew into the room and hits '+Name2+'! ') X Else If HitAll Then X PutLine(Name1+' cast a '+SpellName+' and hits everybody! ') X Else X PutLine(Name1+' cast a '+SpellName+' at '+Name2+'! '); XEnd; X X`5BHidden`5D XProcedure PrintPeopleHere(Var Map : ItemMapType; Me : $UWord); XVar Entity : EntityType; I : Integer; XBegin X For I := 1 To ItemMapSize Do X If (Map.Pos`5BI`5D = POS_IN_ROOM) And (Map.Ids`5BI`5D <> Me) Then Begin X ReadEntity(Map.Ids`5BI`5D, Entity); X PutLine(Entity.Name+' is here. '); X End; XEnd; X X`5BHidden`5D XProcedure PrintObjHere(Var Map : ItemMapType); XVar Entity : EntityType; I : Integer; XBegin X For I := 1 To ItemMapSize Do X If (Map.Pos`5BI`5D = POS_OBJ_HERE) Then Begin X ReadEntity(Map.Ids`5BI`5D, Entity); X PutLine('There is a(n) '+Entity.Name+' here. '); X End; XEnd; X X`5BHidden`5D XProcedure PrintObjSale(Var Map : ItemMapType); XVar Entity : EntityType; I : Integer; XBegin X For I := 1 To ItemMapSize Do X If (Map.Pos`5BI`5D = POS_OBJ_SALE) Then Begin X ReadEntity(Map.Ids`5BI`5D, Entity); X PutLine(Entity.Name+' is for sale here. '); X End; XEnd; X X`5BHidden`5D XProcedure PrintObjHidden(Var Map : ItemMapType); XVar Entity : EntityType; I : Integer; XBegin X For I := 1 To ItemMapSize Do X If (Map.Pos`5BI`5D = POS_OBJ_HIDE) Then Begin X ReadEntity(Map.Ids`5BI`5D, Entity); X PutLine(Entity.Name+' is hidden here. '); X End; XEnd; X X`5BHidden`5D XProcedure PrintGuardianHere(Var Map : ItemMapType; Me : $UWord); XVar Entity : EntityType; I : Integer; XBegin X For I := 1 To ItemMapSize Do +-+-+-+-+-+-+-+- END OF PART 9 +-+-+-+-+-+-+-+-