ProgressQuest/NewGuy.pas

unit NewGuy;
{ copyright (c)2002 Eric Fredricksen all rights reserved }

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, AppEvnts, NMURL;

type
  TNewGuyForm = class(TForm)
    Race: TRadioGroup;
    Klass: TRadioGroup;
    Label2: TLabel;
    STR: TPanel;
    Label3: TLabel;
    CON: TPanel;
    Label4: TLabel;
    DEX: TPanel;
    Label5: TLabel;
    INT: TPanel;
    Label6: TLabel;
    WIS: TPanel;
    Label7: TLabel;
    CHA: TPanel;
    Reroll: TButton;
    GroupBox1: TGroupBox;
    Label8: TLabel;
    Total: TPanel;
    Sold: TButton;
    Unroll: TButton;
    Name: TLabeledEdit;
    OldRolls: TListBox;
    Button2: TButton;
    PoorCodeDesign: TNMURL;
    Account: TLabeledEdit;
    Password: TLabeledEdit;
    ApplicationEvents1: TApplicationEvents;
    Gen: TButton;
    procedure RerollClick(Sender: TObject);
    procedure UnrollClick(Sender: TObject);
    procedure SoldClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure GenClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure RollEm;
    function GetAccount: String;
    function GetPassword: String;
    procedure ParseSoldResponse(body: String);
  public
    function Go: Boolean;
  end;

var
  NewGuyForm: TNewGuyForm;

function UrlEncode(s: string): string;
function GenerateName: string;

implementation

uses Main, SelServ, StrUtils, Web, Config;

{$R *.dfm}

function UrlEncode(s: string): string;
begin
  NewGuyForm.PoorCodeDesign.InputString := s;
  Result := NewGuyForm.PoorCodeDesign.Encode;
end;

procedure Roll(stat: TPanel);
begin
  stat.Tag := 3 + Random(6) + Random(6) + Random(6);
  stat.Caption := IntToStr(stat.Tag);
end;

function Choose(n, k: Integer): Real;
var
  d, i: Longint;
begin
  Result := n;
  d := 1;
  for i := 2 to k do begin
    Result := Result * (1+n-i);
    d := d * i;
  end;
  Result := Result / d;
end;

procedure TNewGuyForm.RollEm;
begin
  ReRoll.Tag := RandSeed;
  Roll(STR);
  Roll(CON);
  Roll(DEX);
  Roll(INT);
  Roll(WIS);
  Roll(CHA);
  Total.tag := STR.Tag + Con.Tag + DEX.Tag + Int.Tag + Wis.Tag + CHA.Tag;
  Total.Caption := IntToStr(Total.Tag);
  if Total.Tag >= (63+18) then Total.Color := clRed
  else if Total.Tag > (4 * 18) then Total.Color := clYellow
  else if Total.Tag <= (63-18) then Total.Color := clGray
  else if Total.Tag < (3 * 18) then Total.Color := clSilver
  else Total.Color := clWhite;
end;

procedure TNewGuyForm.RerollClick(Sender: TObject);
begin
  OldRolls.Items.Insert(0, IntToStr(ReRoll.Tag));
  Unroll.Enabled := true;
  RollEm;
end;

function TNewGuyForm.Go: Boolean;
begin
  Tag := 1;
  Result := mrOk = ShowModal;
end;

procedure TNewGuyForm.FormShow(Sender: TObject);
begin
  if Tag > 0 then begin
    Tag := 0;
    Caption := 'Progress Quest - New Character';
    if MainForm.GetHostName <> '' then
      Caption := Caption + ' [' + MainForm.GetHostName + ']';
    Randomize;
    RollEm;
    with Race do
      ItemIndex := Random(Items.Count);
    with Klass do
      ItemIndex := Random(Items.Count);
  end;
end;

procedure TNewGuyForm.UnrollClick(Sender: TObject);
begin
  RandSeed := StrToInt(OldRolls.Items[0]);
  OldRolls.Items.Delete(0);
  Unroll.Enabled := OldRolls.Items.Count > 0;
  RollEm;
end;

procedure TNewGuyForm.ParseSoldResponse(body: String);
begin
  if (LowerCase(Split(body,0)) = 'ok') then begin
    MainForm.SetPasskey(Split(body,1));
    MainForm.SetLogin(GetAccount);
    MainForm.SetPassword(GetPassword);
    ModalResult := mrOk;
  end else begin
    ShowMessage(body);
  end;
end;

function TNewGuyForm.GetAccount: String;
begin
  Result := '';
  if Account.Visible then Result := Account.Text;
end;

function TNewGuyForm.GetPassword: String;
begin
  Result := '';
  if Password.Visible then Result := Password.Text;
end;

procedure TNewGuyForm.SoldClick(Sender: TObject);
var url, args: String;
begin
  if MainForm.GetHostAddr = ''
  then ModalResult := mrOk
  else begin
    try
      Screen.Cursor := crHourglass;
      try
        if (MainForm.Label8.Tag and 16) = 0
        then url := MainForm.GetHostAddr
        else url := 'http://www.progressquest.com/create.php?';
        // url := StringReplace(url, '.com/', '.com/dev/', []);
        if (GetAccount <> '') or (GetPassword <> '') then
          url := StuffString(url, 8, 0, GetAccount+':'+GetPassword+'@');
        args := 'cmd=create' +
                '&name=' + UrlEncode(Name.Text) +
                '&realm=' + UrlEncode(MainForm.GetHostName) +
                RevString;
        ParseSoldResponse(DownloadString(url + args));
      except
        on EWebError do begin
          ShowMessage('Error connecting to server');
        end;
      end;
    finally
      Screen.Cursor := crDefault;
    end;
  end;
end;

{
procedure TNewGuyForm.ServerAboutToSend(Sender: TObject);
begin
  Server.SendHeader.Values['Content-Type'] := 'text/plain';
  Server.SendHeader.Values['Motto'] := MainForm.GetMotto;
  Server.SendHeader.Values['Guild'] := MainForm.GetGuild;
end;
 }

procedure TNewGuyForm.ApplicationEvents1Minimize(Sender: TObject);
begin
  MainForm.MinimizeIt;
end;

function GenerateName: string;
const
  KParts: array [0..2] of string = (
    'br|cr|dr|fr|gr|j|kr|l|m|n|pr||||r|sh|tr|v|wh|x|y|z',
    'a|a|e|e|i|i|o|o|u|u|ae|ie|oo|ou',
    'b|ck|d|g|k|m|n|p|t|v|x|z');
var
  i: Integer;

  function Pick(s: string): string;
  var
    count, i: Integer;
  begin
    count := 1;
    for i := 0 to Length(s)-1 do
      if s[i] = '|' then Inc(count);
    Result := Split(s, Random(count));
  end;
begin
  for i := 0 to 5 do
    Result := Result + Pick(KParts[i mod 3]);
  Result := UpperCase(Copy(Result,1,1)) + Copy(Result,2,Length(Result));
end;

procedure TNewGuyForm.GenClick(Sender: TObject);
begin
  Name.Text := GenerateName;
end;

procedure TNewGuyForm.FormActivate(Sender: TObject);
begin
  if Name.Text = '' then begin
    GenClick(Sender);
    Name.SetFocus;
  end;
end;

procedure TNewGuyForm.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  Race.Items.Clear;
  for i := 0 to K.Races.Lines.Count-1 do
    Race.Items.Add(Split(K.Races.Lines[i],0));
  Klass.Items.Clear;
  for i := 0 to K.Klasses.Lines.Count-1 do
    Klass.Items.Add(Split(K.Klasses.Lines[i],0));
end;

end.