From 14a6aa4c488bcd2d49103cbee1424b2769d77ce0 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 12 Aug 2016 14:05:45 +0200 Subject: Initial import --- orig/pq/NewGuy.pas | 267 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 267 insertions(+) create mode 100755 orig/pq/NewGuy.pas (limited to 'orig/pq/NewGuy.pas') diff --git a/orig/pq/NewGuy.pas b/orig/pq/NewGuy.pas new file mode 100755 index 0000000..72ae5c9 --- /dev/null +++ b/orig/pq/NewGuy.pas @@ -0,0 +1,267 @@ +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. -- cgit v1.2.3