This is an ex post facto rendering of pq6 in its various versions in

svn, so that changes will be trackable thataway.

As checked in, right here, this is PQ 6.0

chaff/Unit1.pas

@@ -0,0 +1,682 @@
+unit Unit1;
+
+interface
+
+uses
+  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+  Dialogs, ComCtrls, StdCtrls, ExtCtrls, Buttons, ImgList;
+
+type
+  TForm1 = class(TForm)
+    Panel1: TPanel;
+    Label1: TLabel;
+    Traits: TListView;
+    Equips: TListView;
+    Panel3: TPanel;
+    Label3: TLabel;
+    QuestBar: TProgressBar;
+    Stats: TListView;
+    Label2: TLabel;
+    PlotBar: TProgressBar;
+    Plots: TListView;
+    Quests: TListView;
+    Panel2: TPanel;
+    Label4: TLabel;
+    Spells: TListView;
+    Label5: TLabel;
+    Inventory: TListView;
+    Panel4: TPanel;
+    Kill: TStatusBar;
+    Label6: TLabel;
+    ExpBar: TProgressBar;
+    KillBar: TProgressBar;
+    Timer1: TTimer;
+    GoButton: TButton;
+    EncumBar: TProgressBar;
+    Label7: TLabel;
+    Button1: TButton;
+    ImageList1: TImageList;
+    Button2: TButton;
+    procedure GoButtonClick(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure SpeedButton1Click(Sender: TObject);
+    procedure FormShow(Sender: TObject);
+    procedure Button1Click(Sender: TObject);
+  private
+    procedure Task(caption: String; msec: Integer);
+    procedure Dequeue;
+    procedure Q(s: string);
+    function TaskDone: Boolean;
+    procedure CompleteQuest;
+    procedure M(level: Integer; name, spoor: String);
+    procedure CompleteAct;
+    procedure RollCharacter;
+    procedure S(name: String);
+    procedure WinEquip;
+    procedure WinSpell;
+    procedure WinStat;
+    procedure WinItem;
+    procedure Aa(var list: TStrings; item: String);
+  public
+    procedure Put(list: TListView; key: String; value: String); overload;
+    procedure Put(list: TListView; pos: Integer; value: String); overload;
+    procedure Put(list: TListView; key: String; value: Integer); overload;
+    procedure Add(list: TListView; key: String; value: Integer); overload;
+    function Get(list: TListView; key: String): String; overload;
+    function Get(list: TListView; index: Integer): String; overload;
+    function GetI(list: TListView; key: String): Integer; overload;
+    function GetI(list: TListView; index: Integer): Integer; overload;
+    function Sum(list: TListView): Integer;
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+uses Unit2, Math;
+
+{$R *.dfm}
+
+const
+  MonsterMax = 16;
+
+var
+  fMonsters: array[1..MonsterMax] of TStrings;
+  fWeapons, fOffenseAttrib, fArmors, fDefenseAttrib, fShields, fSpellList: TStrings;
+  fTask: String;
+  fQuest: String;
+  fQueue: TStrings;
+
+procedure TForm1.Q(s: string);
+begin
+  if fQueue = nil then fQueue := TStringList.Create;
+  fQueue.Add(s);
+  Dequeue;
+end;
+
+function TForm1.TaskDone: Boolean;
+begin
+  with KillBar do
+    Result := Position >= Max;
+end;
+
+function Odds(chance, outof: Integer): Boolean;
+begin
+  Result := Random(outof) < chance;
+end;
+
+function RandSign(): Integer;
+begin
+  Result := Random(2) * 2 - 1;
+end;
+
+function Pick(s: TStrings): String;
+begin
+  Result := s[Random(s.Count)];
+end;
+
+function PickLow(s: TStrings): String;
+begin
+  Result := s[Min(Random(s.Count),Random(s.Count))];
+end;
+
+function Ends(s,e: String): Boolean;
+begin
+  Result := Copy(s,1+Length(s)-Length(e),Length(e)) = e;
+end;
+
+function Plural(s: String): String;
+begin
+  if Ends(s,'y')
+  then Result := Copy(s,1,Length(s)-1) + 'ies'
+  else if Ends(s,'ch')
+  then Result := s + 'es'
+  else if Ends(s,'f')
+  then Result := Copy(s,1,Length(s)-1) + 'ves'
+  else Result := s + 's';
+end;
+
+function Split(s: String; field: Integer): String;
+var
+  p: Integer;
+begin
+  while field > 0 do begin
+    p := Pos('|',s);
+    s := Copy(s,p+1,10000);
+    Dec(field);
+  end;
+  if Pos('|',s) > 0
+  then Result := Copy(s,1,Pos('|',s)-1)
+  else Result := s;
+end;
+
+function MonsterTask(var level: Integer): String;
+var
+  qty, lev, i: Integer;
+begin
+  lev := level;
+  for i := 1 to level do begin
+    if Odds(2,3) then
+      Inc(lev, RandSign());
+    if Odds(2,5) then
+      Inc(level, RandSign());
+  end;
+  if lev < 1 then lev := 1;
+  if lev > MonsterMax then lev := MonsterMax;
+  if level < 1 then level := 1;
+
+  fTask := Pick(fMonsters[lev]);
+  Result := Split(fTask,0);
+  fTask := 'kill|' + fTask;
+
+  qty := 1;
+  case level-lev of
+    -3: Result := 'Fœtal ' + Result;
+    -2: Result := 'Very Sick ' + Result;
+    -1: Result := 'Lesser ' + Result;
+    0: ; // that's fine
+    1: Result := 'Greater ' + Result;
+    2: Result := 'War ' + Result;
+    3: Result := 'Über ' + Result;
+  else
+    if lev = 2 * level
+    then Result := 'Half ' + Result
+    else if lev * 2 = level
+    then Result := 'Double ' + Result
+    else begin
+      if lev > level then begin
+        lev := lev div 2;
+        Result := 'Leper ' + Result;
+      end;
+      qty := (level + (lev div 2)) div 2;
+      if qty < 1 then qty := 1;
+      level := level * qty;
+    end;
+  end;
+
+  if qty = 1 then begin
+    if Pos(Result[1], 'AEIOUaeiou') > 0
+    then Result := 'an ' + Result
+    else Result := 'a ' + Result;
+  end else begin
+    Result := IntToStr(qty) + ' ' + Plural(Result);
+  end;
+end;
+
+procedure TForm1.Dequeue;
+var
+  s, a: String;
+  n, l: Integer;
+begin
+  while TaskDone do begin
+    if Split(fTask,0) = 'kill' then begin
+      if Split(fTask,3) <> '' then
+        Add(Inventory,Split(fTask,1) + ' ' + Split(fTask,3),1);
+    end else if fTask = 'sell' then with Inventory do begin
+      while Items.Count > 1 do begin
+        Tag := GetI(Inventory,Items.Count-1);
+        Items.Delete(Items.Count-1);
+        Add(Inventory,'Gold',Tag);
+      end;
+    end;
+    fTask := '';
+    if (fQueue.Count > 0) then begin
+      a := Split(fQueue[0],0);
+      n := StrToInt(Split(fQueue[0],1));
+      s := Split(fQueue[0],2);
+      if a = 'task' then begin
+        Task(s, n * 1000);
+        fQueue.Delete(0);
+      end else begin
+        raise Exception.Create('bah!');
+      end;
+    end else with Encumbar do if Position >= Max then begin
+      Task('Heading to market to sell loot',4 * 1000);
+      fTask := 'sell';
+    end else begin
+      n := GetI(Traits,'Level');
+      l := n;
+      s := MonsterTask(n);
+      n := (2 * Form2.GameStyle.Position * n * 1000) div l;
+      Task('Executing ' + s, n);
+    end;
+  end;
+end;
+
+function IndexOf(list: TListView; key: String): Integer;
+var
+  i: Integer;
+begin
+  for i := 0 to list.Items.Count-1 do    if list.Items.Item[i].Caption = key then begin
+      Result := i;
+      Exit;
+    end;
+  with list.Items.Add do begin
+    Result := Index;
+    Caption := key;
+  end;
+end;
+
+procedure TForm1.Put(list: TListView; key, value: String);
+begin
+  Put(list, IndexOf(list,key), value);
+end;
+
+procedure TForm1.Put(list: TListView; key: String; value: Integer);
+begin
+  Put(list,key,IntToStr(value));
+  if key = 'CON' then
+    Encumbar.Max := value;
+  if list = Inventory then
+    Encumbar.Position := Sum(Inventory) - GetI(Inventory,'Gold');
+end;
+
+procedure TForm1.Put(list: TListView; pos: Integer; value: String);
+begin
+  with list.Items.Item[pos] do begin
+    if SubItems.Count < 1
+    then SubItems.Add(value)
+    else SubItems[0] := value;
+  end;
+end;
+
+procedure TForm1.GoButtonClick(Sender: TObject);
+begin
+  with ExpBar do begin
+    Position := 0;
+    Max := 20 * 60; // 20 minutes for level 1...
+  end;
+
+  Task('Loading...',1000);
+  Q('task|10|Experiencing an enigmatic and foreboding night vision');
+  Q('task|6|Much is revealed about that wise old bastard you''d underestimated');
+  Q('task|6|A shocking series of events leaves you alone and bewildered, but resolute');
+  Q('task|4|Drawing upon an unexpected reserve of determination, you set out on a long and dangerous journey');
+  Q('task|1|Loading...');
+
+  PlotBar.Max := 27;
+  with Plots.Items.Add do begin
+    Caption := 'Prologue';
+    StateIndex := 0;
+  end;
+
+  Timer1.Enabled := True;
+end;
+
+procedure TForm1.WinSpell;
+begin
+  Add(Spells,PickLow(fSpellList),1);
+end;
+
+procedure TForm1.WinEquip;
+var
+  pos, qual, plus, attrib, attribmax: Integer;
+  name: String;
+  stuff, better: TStrings;
+begin
+  qual := Max(Random(GetI(Traits,'Level')),Random(1+GetI(Traits,'Level')));
+  pos := Random(Equips.Items.Count);
+  case pos of
+    0: begin stuff := fWeapons; better := fOffenseAttrib; end;
+    1: begin stuff := fShields; better := fDefenseAttrib; end;
+  else begin stuff := fArmors; better := fDefenseAttrib; end;
+  end;
+  if qual > stuff.Count - 1 then
+    qual := stuff.Count - 1;
+  name := stuff[qual];
+  plus := GetI(Traits,'Level') - qual;
+  attribmax := Min(plus, better.Count);
+  while (plus > 0) and (attribmax >= 0) and Odds(1,2) do begin
+    attrib := Random(attribmax+1);
+    name := better[attrib] + ' ' + name;
+    Dec(plus, attrib);
+    attribmax := Max(plus, attrib - 1);
+  end;
+  if plus <> 0 then name := IntToStr(plus) + ' ' + name;
+  if plus > 0 then name := '+' + name;
+
+  Put(Equips, pos, name);
+end;
+
+procedure TForm1.WinStat;
+begin
+  Add(Stats, Stats.Items[Random(Stats.Items.Count)].Caption, 1);
+end;
+
+procedure TForm1.WinItem;
+begin
+  Add(Inventory, 'Special Item', 1);
+end;
+
+procedure TForm1.CompleteQuest;
+var
+  lev, i: Integer;
+begin
+  with QuestBar do begin
+    Position := 0;
+    Max := 50 + Random(100);
+  end;
+  with Quests do begin
+    if Items.Count > 0 then begin
+      Items[Items.Count-1].StateIndex := 1;
+      case Random(4) of
+        0: WinSpell;
+        1: WinEquip;
+        2: WinStat;
+        3: WinItem;
+      end;
+    end;
+    lev := GetI(Traits,'Level');
+    for i := lev downto 1 do
+      if Odds(1,3) then
+        Inc(lev,RandSign());
+    if lev > MonsterMax then lev := MonsterMax - Random(2);
+    if lev < 1 then lev := 1;
+    with Items.Add do begin
+      fQuest := Pick(fMonsters[lev]);
+      Caption := 'Exterminate ' + Plural(Split(fQuest,0));
+      StateIndex := 0;
+      MakeVisible(false);
+    end;
+    Width := Width - 1; // trigger a column resize
+  end;
+end;
+
+function Rome(var n: Integer; dn: Integer; var s: String; ds: String): Boolean;
+begin
+  Result := (n >= dn);
+  if Result then begin
+    n := n - dn;
+    s := s + ds;
+  end;
+end;
+
+function IntToRoman(n: Integer): String;
+begin
+  while Rome(n, 1000, Result, 'M') do ;
+  Rome(n, 900, Result, 'CM');
+  Rome(n, 500, Result, 'D');
+  Rome(n, 400, Result, 'CD');
+  while Rome(n, 100, Result, 'C') do ;
+  Rome(n, 90, Result, 'XC');
+  Rome(n, 50, Result, 'L');
+  Rome(n, 40, Result, 'XL');
+  while Rome(n, 10, Result, 'X') do ;
+  Rome(n, 9, Result, 'IX');
+  Rome(n, 5, Result, 'V');
+  Rome(n, 4, Result, 'IV');
+  while Rome(n, 1, Result, 'I') do ;
+end;
+
+procedure TForm1.CompleteAct;
+begin
+  PlotBar.Position := 0;
+  with Plots do begin
+    Items[Items.Count-1].StateIndex := 1;
+    PlotBar.Max := 60 * 60 * (10 + 5 * Items.Count); // 10 hrs + 5/act
+    Items.Add.Caption := 'Act ' + IntToRoman(Items.Count);
+  end;
+end;
+
+procedure TForm1.Task(caption: String; msec: Integer);
+begin
+  Kill.SimpleText := caption + '...';
+  with KillBar do begin
+    Position := 0;
+    Max := msec;
+  end;
+end;
+
+procedure TForm1.Add(list: TListView; key: String; value: Integer);
+begin
+  Put(list, key, value + GetI(list,key));
+end;
+
+function TForm1.Get(list: TListView; key: String): String;
+begin
+  Result := Get(list, IndexOf(list,key));
+end;
+
+function TForm1.Get(list: TListView; index: Integer): String;
+begin
+  with list.Items.Item[index] do begin
+    if SubItems.Count < 1
+    then Result := ''
+    else Result := SubItems[0];
+  end;
+end;
+
+function TForm1.GetI(list: TListView; key: String): Integer;
+begin
+  Result := StrToIntDef(Get(list,key),0);
+end;
+
+function TForm1.GetI(list: TListView; index: Integer): Integer;
+begin
+  Result := StrToIntDef(Get(list,index),0);
+end;
+
+function TForm1.Sum(list: TListView): Integer;
+var
+  i: Integer;
+begin
+  Result := 0;
+  for i := 0 to list.Items.Count - 1 do
+    Inc(Result, GetI(list,i));
+end;
+
+procedure PutLast(list: TListView; value: String);
+begin
+  if list.Items.Count > 0 then
+  with list.Items.Item[list.Items.Count-1] do begin
+    if SubItems.Count < 1
+    then SubItems.Add(value)
+    else SubItems[0] := value;
+  end;
+end;
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+begin
+  with KillBar do begin
+    if Position >= Max then begin
+      if Kill.SimpleText = 'Loading...' then Max := 0;
+
+      with ExpBar do if Position >= Max then begin
+        Position := 0;
+        Max := (Max * 3) div 2;
+        Add(Traits,'Level',1);
+      end else
+        Position := Position + KillBar.Max div 1000;
+
+      if Plots.Items.Count > 1 then
+        with QuestBar do if Position >= Max then begin
+          CompleteQuest;
+        end else if Quests.Items.Count > 0 then
+          Position := Position + KillBar.Max div 1000;
+
+      with PlotBar do if Position >= Max
+      then CompleteAct
+      else Position := Position + KillBar.Max div 1000;
+
+      Dequeue();
+    end else with KillBar do
+      Position := Position + Integer(Timer1.Interval);
+  end;
+end;
+
+procedure TForm1.M(level: Integer; name, spoor: String);
+begin
+  fMonsters[level].Add(name + '|' + IntToStr(level) + '|' + spoor);
+end;
+
+procedure TForm1.S(name: String);
+begin
+  fSpellList.Add(name);
+end;
+
+procedure TForm1.Aa(var list: TStrings; item: String);
+begin
+  if list = nil then
+    list := TStringList.Create;
+  list.Add(item);
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+var
+  i: Integer;
+begin
+  QuestBar.Position := 0;
+  PlotBar.Position := 0;
+  KillBar.Position := 0;
+  ExpBar.Position := 0;
+  Encumbar.Position := 0;
+  fSpellList := TStringList.Create;
+  for i := 1 to MonsterMax do
+    fMonsters[i] := TStringList.Create;
+  M(1,'Wasp','Stinger');
+  M(1,'Rat','Whiskers');
+  M(1,'Bunny','Ear');
+  M(1,'Moth','Dust');
+  M(1,'Beagle','Collar');
+  M(1,'Midge','');
+  M(2,'Ostrich','Beak');
+  M(2,'Billy Goat','Beard');
+  M(2,'Bat','Wing');
+  M(2,'Koala','Heart');
+  M(3,'Wolf','Paw');
+  M(3,'Gnome','Skull');
+  M(3,'Kobold','Penis');
+  M(3,'Whippet','Collar');
+  M(4,'Orc','Shoe');
+  M(5,'Uruk','Boot');
+  M(6,'Tiger','Stripe');
+  M(7,'Lich','Mascara');
+  M(8,'Mummy','Chapeu');
+  M(9,'Vampire','Pancreas');
+  M(10,'Slime','Slime');
+  M(11,'Giant','Pants');
+  M(12,'Bugbear','Fang');
+  M(13,'Owlbear','Tuft');
+  M(14,'Basilisk','Gallstone');
+  M(15,'Cockatrice','Cock');
+  M(16,'Dragon','Scale');
+
+  S('Slime Finger');
+  S('Rabbit Punch');
+  S('Hastiness');
+  S('Good Mood');
+  S('Sadness');
+  S('Seasick');
+  S('Magnetic Orb');
+  S('Invisible Hands');
+  S('Revolting Cloud');
+  S('Aqueous Humor');
+  S('Spectral Miasma');
+  S('Zymarx''s Wild Illusion');
+  S('Clever Fellow I');
+  S('Clever Fellow II');
+  S('Nestor''s Sweeping Concept');
+  S('Holy Batpole');
+  S('Braingate');
+  S('Eye of the Troglodyte');
+  S('Curse Name');
+  S('Vitreous Humor');
+  S('Roger''s Grand Illusion');
+  S('Clomdor''s Plastic Window');
+  S('Covet');
+  S('Astral Miasma');
+  S('Spectral Clamshell');
+  S('Acrid Hands');
+  S('Animate Tunic');
+  S('Ursine Armor');
+  S('Holy Roller');
+  S('Curse Family');
+  S('Infinite Confusion');
+
+  Aa(fShields, 'Pie Plate');
+  Aa(fShields, 'Buckler');
+  Aa(fShields, 'Tower Shield');
+
+  Aa(fArmors, 'Lace');
+  Aa(fArmors, 'Macrame');
+  Aa(fArmors, 'Burlap');
+  Aa(fArmors, 'Canvas');
+  Aa(fArmors, 'Flannel');
+  Aa(fArmors, 'Chamois');
+  Aa(fArmors, 'Pleathers');
+  Aa(fArmors, 'Leathers');
+  Aa(fArmors, 'Chainmail');
+  Aa(fArmors, 'Platemail');
+
+  Aa(fWeapons, 'Stick');
+  Aa(fWeapons, 'Broken Bottle');
+  Aa(fWeapons, 'Shiv');
+  Aa(fWeapons, 'Bowie Knife');
+  Aa(fWeapons, 'Claw Hammer');
+  Aa(fWeapons, 'Andiron');
+  Aa(fWeapons, 'Hatchet');
+  Aa(fWeapons, 'Crowbar');
+  Aa(fWeapons, 'Longiron');
+  Aa(fWeapons, 'Zip Gun');
+  Aa(fWeapons, 'Broadsword');
+  Aa(fWeapons, 'Longsword');
+  Aa(fWeapons, 'Poleax');
+  Aa(fWeapons, 'Bandyclef');
+
+  Aa(fDefenseAttrib, 'Studded');
+  Aa(fDefenseAttrib, 'Banded');
+  Aa(fDefenseAttrib, 'Gilded');
+  Aa(fDefenseAttrib, 'Festooned');
+  Aa(fDefenseAttrib, 'Holy');
+  Aa(fDefenseAttrib, 'Cambric');
+  Aa(fDefenseAttrib, 'Fine');
+  Aa(fDefenseAttrib, 'Impressive');
+
+  Aa(fOffenseAttrib, 'Polished');
+  Aa(fOffenseAttrib, 'Pronged');
+  Aa(fOffenseAttrib, 'Steely');
+  Aa(fOffenseAttrib, 'Bloodied');
+  Aa(fOffenseAttrib, 'Dancing');
+  Aa(fOffenseAttrib, 'Invisible');
+  Aa(fOffenseAttrib, 'Vorpal');
+end;
+
+procedure TForm1.SpeedButton1Click(Sender: TObject);
+begin
+  KillBar.Position := KillBar.Max;
+end;
+
+procedure TForm1.RollCharacter;
+begin
+  if mrOk = Form2.ShowModal then ;
+  with Form2 do begin
+    Put(Traits,'Name',Name.Text);
+    Put(Traits,'Race',Race.Items[Race.ItemIndex]);
+    Put(Traits,'Class',Klass.Items[Klass.ItemIndex]);
+    Put(Traits,'Level',1);
+    Put(Stats,'STR',STR.Tag);
+    Put(Stats,'CON',CON.Tag);
+    Put(Stats,'DEX',DEX.Tag);
+    Put(Stats,'INT',INT.Tag);
+    Put(Stats,'WIS',WIS.Tag);
+    Put(Stats,'CHA',CHA.Tag);
+    Put(Stats,'HP Max',Random(8) + CON.Tag div 6);
+    Put(Stats,'MP Max',Random(8) + INT.Tag div 6);
+    Put(Equips,'Weapon','Sharp Stick');
+    Put(Inventory,'Gold',0);
+  end;
+end;
+
+procedure TForm1.FormShow(Sender: TObject);
+begin
+  RollCharacter;
+end;
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  Add(Traits,'Level',1);
+end;
+
+end.