DELPHI : GW Build manager (décembre 2007)

J'ai pas mal joué à Guildwars, un jeu multi-joueurs en ligne.

Pour mieux gérer ses "builds" (la barre de compétence disponible en jeu), j'ai créé un outil pour cela.

Il a pas mal servi à la communauté.

Apercu du programme

Morceau de code concernant la gestion binaire des templates de builds

Je mets ce bout de code ici directement car je sais que cela peut intéresser certains qui voudraient implémenter cet algorithme ailleurs. A vous de le traduire dans le langage de votre choix.

unit UTemplate;

interface
uses
  strutils, common, params, uIntList, sysutils, classes, dialogs, msxml;
  const
    Codes64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

type TTemplate=class
  private       
    offset: integer;
    function GetIndex(s:char):integer;
  public
    Code: string;
    Bin: string;
    IDProf1: integer;
    IDProf2: integer;
    Prof1: string;
    Prof2: string;
    NbAttr: integer;
    SizeAttr: integer;
    SkillSize: integer;
    BinDump : string;
    Attributes :TStringList;
    AttributesValue :TIntegerList;
    SkillsID :TIntegerList;
    CodeOK: boolean;
    procedure setProf(P1, P2: string);
    function binval(S,D: string): integer;
    function tronque(S: string;n:integer): string;
    procedure CodeToBin;
    procedure BinToCode;
    procedure Analyse;
    procedure RAZ;
    procedure MakeBuild;
    constructor Create;
    destructor Destroy;
    function GWBBCode: string;
    function BBCode: string;
    function valbin(I, N: integer;D:string): string;
end;

implementation         
//-------------------------------------------------------
procedure TTemplate.setProf(P1, P2: string);
begin
  idprof1 := GetProfIdByAbbr(p1);
  prof1 := p1;                  
  if idprof1=0 then prof1 := '';
  idprof2 := GetProfIdByAbbr(p2);
  prof2 := p2;
  if idprof2=0 then prof2 := '';
end;
//-------------------------------------------------------
destructor TTemplate.Destroy;
begin
  Attributes.Free;
  AttributesValue.Free;
  SkillsID.Free;
end;
//-------------------------------------------------------
constructor TTemplate.Create;
begin
  Attributes := TStringList.Create;
  AttributesValue := TIntegerList.Create;
  SkillsID := TIntegerList.Create;
  RAZ;
end;
//-------------------------------------------------------
function TTemplate.tronque(S: string;n:integer): string;
begin
  result := MidStr(S, n+1, length(s)-n);
end;
//-------------------------------------------------------
function TTemplate.binval(S, D: string): integer;
const CRLF = #13#10;
var r : string;
begin
  r := strrev(s);
  result := bintoint(r);
  BinDump := BinDump+r+','+IntToStr(result)+','+IntToStr(offset)+','+D+CRLF;
  offset := offset + length(s);
end;
//-------------------------------------------------------
function TTemplate.valbin(I, N: integer; D:string): string;
var
  B, C: string;
begin
  B := StrRev(IntToBin(I));
  Result := B + StrRepeat('0', N-Length(B));
  BinDump := BinDump+Result+','+IntToStr(i)+','+IntToStr(offset)+','+D+CRLF;
  offset := offset + length(Result);
end;
//-------------------------------------------------------
procedure TTemplate.RAZ;
var i:integer;
begin
  IDProf1 := 0;
  IDProf2 := 0;
  Prof1 := '';
  Prof2 := '';
  NbAttr := 0;   
  SizeAttr := 0;
  SkillSize := 0;
  BinDump := '0111000000,-,0,Header'+CRLF;
  offset := 10;
  Attributes.Clear;
  AttributesValue.Clear;
  SkillsID.Clear;
  for i := 0 to 7 do SkillsID.Add(0);
  CodeOk := false;
end;                       
//-------------------------------------------------------
procedure TTemplate.MakeBuild;
var
  i, max, n: integer;
begin
  BinDump := '0111000000,-,0,Header'+CRLF;
  offset := 10;
  Bin:= '0111000000';
  Bin := Bin + valbin(IDProf1, 4, 'Prof 1');
  Bin := Bin + valbin(IDProf2, 4, 'Prof 2');
  Bin := Bin + valbin(Attributes.Count, 4, 'Attributes number');
  Bin := Bin + valbin(2, 4, 'Attributes size +4'); // valeur 4+2 -> 6
  for i := 0 to Attributes.Count - 1 do begin
    Bin := Bin + valbin(GetAttrIdByAbbr(Attributes[i]), 6, 'Attribute #'+Str(i+1));
    Bin := Bin + valbin(AttributesValue[i], 4, 'Attribute value');
  end;
  // choppe le max des id pour adapter la longueur
  max := 0;
  for i := 0 to 7 do begin
    if i<SkillsID.Count then
      if SKillsID[i]>max then max := SKillsID[i];
  end;
  n:= 0;
  while max<>0 do begin
    max := ToInt(max/2);
    n:= n+1;
  end;
  if n=0 then n:= 11;
  Bin := Bin + valbin(n-8, 4, 'Skills size +8');
  for i := 0 to 7 do begin
    if i<SkillsID.Count then
      Bin := Bin + valbin(SKillsID[i], n, 'Skill #'+Str(i+1))
    else
      Bin := Bin + valbin(0, n, 'Skill #'+Str(i+1));
  end;
  BinToCode;
end;
//-------------------------------------------------------
procedure TTemplate.Analyse;
var
  B, AttrName, SkillName: string;
  i, IDAttr, AttrValue, IDSkill: integer;
begin
  RAZ;
  CodeToBin;
  B := Bin;
  // Handle the new format (i.e leading '0111')
  if MidStr(B, 1, 4)='0111' then B := tronque(B, 4);
  // at least 22 bits
  if Length(B)<23 then Exit;
  // 6 first bits should be 000000
  if MidStr(B, 1, 6)<>'000000' then Exit;
  B := tronque(B, 6);
  // Primary prof
  IDProf1 := binval(MidStr(B, 1, 4), 'Prof 1');
  Prof1 := GetProfById(IDProf1);
  if Prof1='' then Exit;  
  // Secondary prof
  IDProf2 := binval(MidStr(B, 5, 4), 'Prof 2');
  Prof2 := GetProfById(IDProf2);
  if Prof2='' then Exit;
  // Attributes
  NbAttr := binval(MidStr(B, 9, 4), 'Attributes number');
  SizeAttr := 4 + binval(MidStr(B, 13, 4), 'Attributes size +4');
  B := tronque(B, 16);
  for i := 0 to NbAttr - 1 do begin
    if Length(B)<4+SizeAttr then Exit;
    // attribute name
    IDAttr := binval(MidStr(B, 1, SizeAttr), 'Attribute #'+Str(i+1));
    AttrName := GetAttrById(IDAttr);
    if AttrName='' then Exit;
    // attribute value       
    AttrValue := binval(MidStr(B, SizeAttr+1, 4), 'Attribute value');
    Attributes.Add(AttrName);
    AttributesValue.Add(AttrValue);
    B := tronque(B, 4+SizeAttr);
  end;
  // Skills    
  if Length(B)<4 then Exit;
  SkillSize := 8+binval(MidStr(B, 1, 4), 'Skill size +8');
  B := tronque(B, 4);
  for i := 0 to 7 do begin  
    if Length(B)<SkillSize then Exit;
    IDSkill := binval(MidStr(B, 1, SkillSize), 'Skill #'+Str(i+1));
    B := tronque(B, SkillSize);
    SkillsID[i] := IDSkill;
  end;
  Bin := B;
  CodeOK := True;
end;                                   
//-------------------------------------------------------
function TTemplate.BBCode: string;
var
  i: integer;
  Skill: IXMLDOMNode;
begin
  Result := 'Profession = [b][u]';
  if Prof1=Prof2 then
    Result := Result+Prof1
  else
    Result := Result+Prof1+'/'+Prof2;
  Result := Result+'[/u][/b]'+CRLF+CRLF;

  for i := 0 to Attributes.Count - 1 do begin
    Result := Result+GetAttributeNomByAbbr(Attributes[i])+' = '+IntToStr(AttributesValue[i])+CRLF;
  end;

  Result := Result+CRLF+'Code = [b]'+Code+'[/b]'+CRLF+CRLF;

  Result := Result+GetLangItem('skills')+' :'+CRLF;
  for i := 0 to SkillsID.Count-1 do begin
    Skill := GetSkillById(SkillsID[i]);
    Result := Result+' '+IntToStr(i+1)+'. ';
    if Skill=nil then
      Result := Result+CRLF
    else begin
      if Skill_Get_Elite(skill)=1 then
        Result := Result+'[b]'+Skill_Get_Name(Skill)+'[/b]'+CRLF
      else
        Result := Result+Skill_Get_Name(Skill)+CRLF;
    end;
  end;
end;
//-------------------------------------------------------
function TTemplate.GWBBCode: string;
var
  i: integer;
  Skill: IXMLDOMNode;
begin
  if Prof1=Prof2 then
    Result := '[build prof='+Prof1
  else
    Result := '[build prof='+Prof1+'/'+Prof2;
  for i := 0 to Attributes.Count - 1 do begin
    Result := Result+' '+Attributes[i]+'='+IntToStr(AttributesValue[i]);
  end;
  Result := Result+']';
  for i := 0 to SkillsID.Count-1 do begin
    Skill := GetSkillById(SkillsID[i]);
    if Skill=nil then
      Result := Result+'[Unknown skill id '+IntToStr(SkillsID[i])+']'
    else
      Result := Result+'['+Skill_Get_Name_Id(Skill)+']';
  end;
  Result := Result+'[/build]';
end;
//-------------------------------------------------------
function TTemplate.GetIndex(s:char):integer;
var
  i,n: integer;
begin
  Result := -1;
  n := length(Codes64);
  for I := 1 to n do
    if Codes64[i]=s then begin
      Result := i-1;
      break;
    end;
end;
//-------------------------------------------------------
procedure TTemplate.CodeToBin;
var
  i, n, v: integer;
  b : string;
begin
  Bin := '';
  n := length(Code);
  for I := 1 to n do begin
    v:= GetIndex(code[i]);
    if v < 0 then begin
      Bin := '';
      break;
    end;
    b := StrRev(IntToBin(v));
    Bin := Bin + b + StrRepeat('0', 6-Length(B));
  end;
end;
//-------------------------------------------------------
procedure TTemplate.BinToCode;
var
  n : integer;
  b, digit : string;
begin
  Code := '';
  if (length(Bin) mod 6)=0 then
    b := bin
  else
    b := Bin+StrRepeat('0', 6-(length(Bin) mod 6));
  while Length(B)>0 do begin
    digit := midStr(b, 1, 6);
    b := MidStr(b, 7, Length(B)-6);
    n := BinToInt(StrRev(digit));
    Code := Code+Codes64[n+1];
  end;
end;
//-------------------------------------------------------



end.

Téléchargement

Vous pouvez télécharger le binaire, tous les sources, les installeurs, les différentes version, etc... Libre à vous de jouer avec.

GWBuildManager.zip (27.78 Mo)

_Delphi.zip (434.85 Ko) (dépendances utilisées par le projet principal)