{ Summary: Race routines ## $Id: race.pas,v 1.10 2004/04/03 16:03:48 druid Exp $ } unit race; interface uses SysUtils, mudsystem, constants, strip, util, dtypes, fsys; type GBodyPart = class private _name : string; _description : string; _char_message, _room_message : string; public constructor Create(); published property name : string read _name write _name; property description : string read _description write _description; property char_message : string read _char_message write _char_message; property room_message : string read _room_message write _room_message; end; GRace = class private node : GListNode; _name, _short, _description : string; _str_bonus, _con_bonus, _dex_bonus, _int_bonus, _wis_bonus : integer; _def_alignment : integer; _max_skills, _max_spells : integer; _save_poison, _save_cold, _save_para, _save_breath, _save_spell : integer; _abilities : GDLinkedList; _bodyparts : GHashTable; _convert : boolean; str_max, con_max, dex_max, int_max, wis_max : integer; public constructor Create(); destructor Destroy(); override; property name : string read _name; property short : string read _short; property description : string read _description; property str_bonus : integer read _str_bonus; property con_bonus : integer read _con_bonus; property dex_bonus : integer read _dex_bonus; property int_bonus : integer read _wis_bonus; property wis_bonus : integer read _int_bonus; property max_skills : integer read _max_skills; property max_spells : integer read _max_spells; property save_poison : integer read _save_poison; property save_cold : integer read _save_cold; property save_para : integer read _save_para; property save_breath : integer read _save_breath; property save_spell : integer read _save_spell; property def_alignment : integer read _def_alignment; property abilities : GDLinkedList read _abilities; property bodyparts : GHashTable read _bodyparts; property convert : boolean read _convert; end; var raceList : GDLinkedList; procedure loadRaces(); procedure initRaces(); procedure cleanupRaces(); function findRace(const name : string) : GRace; implementation uses LibXmlParser, console, chars, skills; { GBodypart constructor } constructor GBodyPart.Create(); begin inherited Create; name := 'bodypart'; description := 'bodypart'; char_message := 'You wear $p on your bodypart,'; room_message := '$n wears $p on $s bodypart,'; end; { GRace constructor } constructor GRace.Create(); begin inherited Create; _convert := false; _name := ''; _short := ''; _description := ''; _def_alignment := 0; // fill in default values _str_bonus := 0; _con_bonus := 0; _dex_bonus := 0; _int_bonus := 0; _wis_bonus := 0; _save_poison := 0; _save_cold := 0; _save_para := 0; _save_breath := 0; _save_spell := 0; _max_skills := 10; _max_spells := 10; _abilities := GDLinkedList.Create(); _abilities.ownsObjects := false; _bodyparts := GHashTable.Create(32); end; { GRace destructor } destructor GRace.Destroy(); begin _abilities.clear(); _abilities.Free(); _bodyparts.clear(); _bodyparts.Free(); inherited Destroy(); end; // Load the bodyparts procedure loadBodyParts(parser : TXmlParser; race : GRace); var bodypart : GBodyPart; begin bodypart := GBodyPart.Create(); while (parser.Scan()) do case parser.CurPartType of // Here the parser tells you what it has found ptContent: begin if (prep(parser.CurName) = 'NAME') then bodypart.name := parser.CurContent else if (prep(parser.CurName) = 'DESCRIPTION') then bodypart.description := parser.CurContent else if (prep(parser.CurName) = 'CHAR_MESSAGE') then bodypart.char_message := parser.CurContent else if (prep(parser.CurName) = 'ROOM_MESSAGE') then bodypart.room_message := parser.CurContent; end; ptEndTag: begin if (prep(parser.CurName) = 'BODYPART') then begin race.bodyparts[bodypart.name] := bodypart; exit; end; end; end; end; procedure loadStatMax(parser : TXmlParser; race : GRace); begin while (parser.Scan()) do case parser.CurPartType of // Here the parser tells you what it has found ptContent: begin if (prep(parser.CurName) = 'INT') then race.int_max := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'WIS') then race.wis_max := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'DEX') then race.dex_max := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'STR') then race.str_max := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'CON') then race.con_max := StrToInt(parser.CurContent); end; ptEndTag: begin if (prep(parser.CurName) = 'STATMAX') then exit; end; end; end; // Load the bonuses procedure loadBonus(parser : TXmlParser; race : GRace); begin while (parser.Scan()) do case parser.CurPartType of // Here the parser tells you what it has found ptContent: begin if (prep(parser.CurName) = 'INT') then race._int_bonus := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'WIS') then race._wis_bonus := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'DEX') then race._dex_bonus := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'STR') then race._str_bonus := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'CON') then race._con_bonus := StrToInt(parser.CurContent); end; ptEndTag: begin if (prep(parser.CurName) = 'BONUS') then exit; end; end; end; // Load the saves procedure loadSaves(parser : TXmlParser; race : GRace); begin while (parser.Scan()) do case parser.CurPartType of // Here the parser tells you what it has found ptContent: begin if (prep(parser.CurName) = 'POISON') then race._save_poison := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'COLD') then race._save_cold := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'PARA') then race._save_para := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'BREATH') then race._save_breath := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'SPELL') then race._save_spell := StrToInt(parser.CurContent); end; ptEndTag: begin if (prep(parser.CurName) = 'SAVES') then exit; end; end; end; { Summary: Loads all .xml racefiles } procedure loadRaces(); var t : TSearchRec; parser : TXmlParser; race : GRace; sk : GSkill; begin race := nil; parser := TXmlParser.Create(); parser.Normalize := true; if (FindFirst('races' + PathDelimiter + '*.xml', faAnyFile, t) = 0) then repeat parser.LoadFromFile('races' + PathDelimiter + t.name); if (parser.Source <> 'races' + PathDelimiter + t.name) then writeConsole('Could not load ' + t.name) else begin parser.StartScan(); while (parser.Scan()) do case parser.CurPartType of // Here the parser tells you what it has found ptStartTag: begin if (prep(parser.CurName) = 'RACE') then race := GRace.Create() else if (prep(parser.CurName) = 'BODYPART') then loadBodyParts(parser, race) else if (prep(parser.CurName) = 'STATMAX') then loadStatMax(parser, race) else if (prep(parser.CurName) = 'BONUS') then loadBonus(parser, race) else if (prep(parser.CurName) = 'SAVES') then loadSaves(parser, race); end; ptContent: begin if (prep(parser.CurName) = 'NAME') then begin race._name := cap(parser.CurContent); writeConsole(' Race: ' + race.name); end else if (prep(parser.CurName) = 'SHORT') then race._short := cap(parser.CurContent) else if (prep(parser.CurName) = 'ALIGNMENT') then race._def_alignment := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'CONVERT') then race._convert := StrToBool(parser.CurContent) else if (prep(parser.CurName) = 'SKILLS') then race._max_skills := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'SPELLS') then race._max_spells := StrToInt(parser.CurContent) else if (prep(parser.CurName) = 'ABILITY') then begin sk := findSkill(parser.CurContent); if (sk <> nil) then race.abilities.add(sk) else bugreport('loadRaces', 'race.pas', 'Unknown skill ' + parser.CurContent); end else if (prep(parser.CurName) = 'DESCRIPTION') then race._description := parser.CurContent; end; ptEndTag: // Process End-Tag here (Parser.CurName) begin if (prep(parser.CurName) = 'RACE') then race.node := raceList.insertLast(race); end; end; end; until (FindNext(t) <> 0); FindClose(t); parser.Free(); end; // Find race by name / short name function findRace(const name : string) : GRace; var iterator : GIterator; race : GRace; begin Result := nil; iterator := raceList.iterator(); while (iterator.hasNext()) do begin race := GRace(iterator.next); if (comparestr(prep(name), prep(race.name)) = 0) or (comparestr(prep(name), prep(race.short)) = 0) then begin Result := race; break; end; end; iterator.Free(); end; procedure initRaces(); begin raceList := GDLinkedList.Create(); end; procedure cleanupRaces(); begin raceList.clear(); raceList.Free(); end; end.