33 Commits
Author SHA1 Message Date
Eric Fredricksen 17f4c78a74 v6.4.1: Fix errors attempted v6.4 launch, interplot cinematics in particular.
Also fixed the ImpressiveGuy stuff and how the plot progress bar worked for the prologue
2022-01-07 22:50:55 -08:00
Eric Fredricksen c7911ffbca Use A rather than G for roman numeral 5000 2022-01-05 13:12:41 -08:00
Eric Fredricksen e3c564529d Release candidate for pq 6.4 2022-01-05 12:42:43 -08:00
Eric Fredricksen 16c8a5b053 Beta test build for v6.4 2022-01-05 12:18:52 -08:00
Eric Fredricksen bf3619f270 Update version info, leave some stuff out of repo 2022-01-04 23:15:09 -08:00
Eric Fredricksen 861e68e477 Don't need to hang onto these in the repo 2022-01-04 23:10:24 -08:00
Eric Fredricksen f503ab75a7 Bump version, revert extension 2022-01-04 22:41:43 -08:00
Eric Fredricksen 24895486cf Invent some roman numerals, G for 5000 and T for 10,000
This'll keep the Spells list from looking like a bunch of MMMMMMs at high levels
2022-01-04 21:30:33 -08:00
Eric Fredricksen cbb3d5daac Merge branch 'pq6' of bitbucket.org:grumdrig/pq into pq6 2022-01-04 20:53:11 -08:00
Eric Fredricksen 9030d1ba58 Bump PQ version to 6.4 2022-01-04 20:52:48 -08:00
Eric Fredricksen a0e0d53739 Fix bug causing an error when the sum of squares of stats exceeded 0x7FFFFFFF. And:
Restore file extension pq.
Bump version to 6.4 (6.3 wasn't officially released but has been used in ports.)
Turbo mode for testing.
Limit the number of fancy items won to keep the Invetory not too huge
2022-01-04 20:48:35 -08:00
Eric Fredricksen 64aca6ec2f Restore original levelling schedule 2022-01-04 19:33:15 -08:00
Eric Fredricksen bf632cb99b Don't try to make file associations starting with Vista
At some point the registry key setting stopped working, not sure as of what Windows version. But this will avoid the 'Failed to set data for '' ' error
2022-01-04 19:11:29 -08:00
Eric Fredricksen d611931e37 Ignore exceptions when setting file associations, for Win 7 users
without admin privs
2012-02-14 08:41:54 -08:00
Eric Fredricksen e371be0bc4 Mention pq-web in README 2011-11-18 13:02:45 -08:00
Eric Fredricksen 07b569a7d1 I really should be looking at the markdown edits on the client side 2011-05-20 08:52:32 -07:00
Eric Fredricksen cad63aac86 Put bullets on list 2011-05-20 08:51:00 -07:00
Eric Fredricksen 86f57c02cb Switch README to markdown 2011-05-20 08:49:07 -07:00
Eric Fredricksen 082c65a863 Hide rest preamble 2011-05-20 08:45:46 -07:00
Eric Fredricksen 38e1fc3763 Mention open sourcing taking place 2011-05-20 08:36:23 -07:00
Eric Fredricksen 9396003e3f Fix ReST err 2011-05-20 08:32:40 -07:00
Eric Fredricksen c6eaa46994 Fix ReST err 2011-05-20 08:31:27 -07:00
Eric Fredricksen 6f3a72ac27 Fix ReST warning 2011-05-20 08:29:49 -07:00
Eric Fredricksen ddff883b06 More documentation. Jungle Clown. Incidental moves in forms, etc. 2010-01-13 13:21:23 -08:00
Eric Fredricksen 03468f6666 Added forensic info about 6.3 changes (which are few) 2010-01-12 16:15:25 -08:00
Eric Fredricksen 32f584559a Update README a little. Add version tags. 2010-01-12 15:41:35 -08:00
Eric Fredricksen 3d107337fd Added tag v6.0 for changeset 5785c7997168 2010-01-12 15:41:05 -08:00
Eric Fredricksen d5b41649ea Added tag v6.1 for changeset c76a4888afe5 2010-01-12 15:40:40 -08:00
Eric Fredricksen a0f0879520 Added tag v6.2 for changeset 548ea069b984 2010-01-12 15:39:57 -08:00
Eric Fredricksen ee648fd4ec latest 2007-02-20 14:44:38 +00:00
Eric Fredricksen 05718c79d9 annoying dup named file (other than case difference) 2007-02-06 06:59:04 +00:00
Eric Fredricksen 5d11926e15 some old changes to poach & pq9x that turned out to be on this sony laptop
project navigator pep-up
adding math thing for dad
2007-01-26 19:34:17 +00:00
Eric Fredricksen 9a85adf823 (contents of README)
ProgressQuest v6.3
------------------
This directory represents an ex post facto rendering of pq6 in its
various versions in svn, so that changes will be trackable thataway.

The version as of this moment in svn is 6.3

(I didn't add this file in PQ 6.0, but after that you can use this README
to trace the checkin history using svn.)
2006-12-24 21:53:08 +00:00
45 changed files with 1281 additions and 101 deletions

No files matched your search

+5
View File
@@ -0,0 +1,5 @@
*.obj
*.~*
*.bak
*.dcu
*.ddp
+5
View File
@@ -0,0 +1,5 @@
syntax: glob
*.~???
*~
*.obj
+50
View File
@@ -0,0 +1,50 @@
==================================================
Changes observed, forensically, from v6.2 to v6.3:
==================================================
New items, monsters and so forth:
Spells:
Shoelaces
History Lesson
Weapon:
Kreen
Specials:
Vulpeculum
Boring items:
writ
Monster:
Chromatic Dragon drops scales rather than mineral water
Hogbird
Races:
Hob-Hobbit replaces Greater Gnome (candidates: Gobhobbit, Hobrabbit)
Classes:
Vermineer replaces Toungeblade
Jungle Clown replaces Lowling
Config.*:
NewGuy.*:
- Races & Classes moved into Config form from code in NewGuy
Front.*
- Version bumped
- File extension bumped
Main.dfm
- Moves and resizes
Main.pas
- Cheats enabled for now
- HTTP rev number bumped
- Save ext changed
- Interplot cinematics between acts (NamedMonster & ImpressiveGuy)
- Execute named RPCs now and then ("Sir Roger the Elf")
- New leveling schedule(!)
- WinItem & WinEquip at end of each act
Info.*:
Login.*:
SelServ.*:
Web.*:
- none
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+135 -7
View File
@@ -1,7 +1,7 @@
object K: TK
Left = 335
Top = 119
Width = 572
Left = 202
Top = 129
Width = 800
Height = 567
Caption = 'K'
Color = clBtnFace
@@ -111,6 +111,34 @@ object K: TK
Height = 13
Caption = 'DefenseBad'
end
object Label15: TLabel
Left = 480
Top = 8
Width = 26
Height = 13
Caption = 'Race'
end
object Label16: TLabel
Left = 480
Top = 120
Width = 25
Height = 13
Caption = 'Class'
end
object Label17: TLabel
Left = 328
Top = 120
Width = 25
Height = 13
Caption = 'Titles'
end
object Label18: TLabel
Left = 476
Top = 428
Width = 74
Height = 13
Caption = 'Impressive titles'
end
object Spells: TMemo
Left = 8
Top = 132
@@ -124,6 +152,7 @@ object K: TK
'Sadness'
'Seasick'
'Gyp'
'Shoelaces'
'Innoculate'
'Cone of Annoyance'
'Magnetic Orb'
@@ -133,6 +162,7 @@ object K: TK
'Spectral Miasma'
'Clever Fellow'
'Lockjaw'
'History Lesson'
'Hydrophobia'
'Big Sister'
'Cone of Paste'
@@ -289,6 +319,7 @@ object K: TK
'Crankbow|6'
'Blibo|7'
'Broadsword|7'
'Kreen|7'
'Morning Star|8'
'Pole-adze|8'
'Spontoon|8'
@@ -343,7 +374,8 @@ object K: TK
'Bijou'
'Spangle'
'Gimcrack'
'Hood')
'Hood'
'Vulpeculum')
TabOrder = 6
WordWrap = False
end
@@ -495,7 +527,8 @@ object K: TK
'casket'
'nosegay'
'trinket'
'credenza')
'credenza'
'writ')
TabOrder = 9
WordWrap = False
end
@@ -571,7 +604,7 @@ object K: TK
'Brass Dragon|7|pole'
'Tin Dragon|8|*'
'Bronze Dragon|9|medal'
'Chromatic Dragon|16|mineral water'
'Chromatic Dragon|16|scale'
'Copper Dragon|8|loafer'
'Gold Dragon|8|filling'
'Green Dragon|8|*'
@@ -734,7 +767,8 @@ object K: TK
'Uruk|2|boot'
'Poroid|4|node'
'Moakum|8|frenum'
'Fly|0|*')
'Fly|0|*'
'Hogbird|3|curl')
TabOrder = 10
WordWrap = False
end
@@ -804,4 +838,98 @@ object K: TK
TabOrder = 13
WordWrap = False
end
object Races: TMemo
Left = 480
Top = 24
Width = 249
Height = 89
Lines.Strings = (
'Half Orc|HP Max'
'Half Man|CHA'
'Half Halfling|DEX'
'Double Hobbit|STR'
'Hob-Hobbit|DEX,CON'
'Low Elf|CON'
'Dung Elf|WIS'
'Talking Pony|MP Max,INT'
'Gyrognome|DEX'
'Lesser Dwarf|CON'
'Crested Dwarf|CHA'
'Eel Man|DEX'
'Panda Man|CON,STR'
'Trans-Kobold|WIS'
'Enchanted Motorcycle|MP Max'
'Will o'#39' the Wisp|WIS'
'Battle-Finch|DEX,INT'
'Double Wookiee|STR'
'Skraeling|WIS'
'Demicanadian|CON'
'Land Squid|STR,HP Max')
TabOrder = 14
end
object Klasses: TMemo
Left = 480
Top = 136
Width = 249
Height = 89
Lines.Strings = (
'Ur-Paladin|WIS,CON'
'Voodoo Princess|INT,CHA'
'Robot Monk|STR'
'Mu-Fu Monk|DEX'
'Mage Illusioner|INT,MP Max'
'Shiv-Knight|DEX'
'Inner Mason|CON'
'Fighter/Organist|CHA,STR'
'Puma Burgular|DEX'
'Runeloremaster|WIS'
'Hunter Strangler|DEX,INT'
'Battle-Felon|STR'
'Tickle-Mimic|WIS,INT'
'Slow Poisoner|CON'
'Bastard Lunatic|CON'
'Jungle Clown|DEX,CHA'
'Birdrider|WIS'
'Vermineer|INT')
TabOrder = 15
end
object Titles: TMemo
Left = 328
Top = 136
Width = 57
Height = 81
Lines.Strings = (
'Mr.'
'Mrs.'
'Sir'
'Sgt.'
'Ms.'
'Captain'
'Chief'
'Admiral'
'Saint')
TabOrder = 16
end
object ImpressiveTitles: TMemo
Left = 476
Top = 442
Width = 149
Height = 89
Lines.Strings = (
'King'
'Queen'
'Lord'
'Lady'
'Viceroy'
'Mayor'
'Prince'
'Princess'
'Chief'
'Boss'
'Archbishop'
'Baron'
'Comptroller')
TabOrder = 17
WordWrap = False
end
end
+8
View File
@@ -37,6 +37,14 @@ type
Label13: TLabel;
DefenseBad: TMemo;
Label14: TLabel;
Races: TMemo;
Label15: TLabel;
Label16: TLabel;
Klasses: TMemo;
Label17: TLabel;
Titles: TMemo;
ImpressiveTitles: TMemo;
Label18: TLabel;
end;
var
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+5 -5
View File
@@ -5,7 +5,7 @@ object FrontForm: TFrontForm
BorderIcons = []
BorderStyle = bsNone
BorderWidth = 2
ClientHeight = 251
ClientHeight = 255
ClientWidth = 452
Color = clRed
TransparentColorValue = clWhite
@@ -93,19 +93,19 @@ object FrontForm: TFrontForm
Left = 0
Top = 0
Width = 452
Height = 251
Height = 255
Align = alClient
BevelInner = bvLowered
Color = clWhite
TabOrder = 0
object Label2: TLabel
Left = 2
Top = 236
Top = 240
Width = 448
Height = 13
Align = alBottom
Alignment = taCenter
Caption = #169' 2003 Eric Fredricksen - v6.2'
Caption = #169' 2002-2022 Eric Fredricksen - v6.4.1'
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = 11382189
@@ -184,7 +184,7 @@ object FrontForm: TFrontForm
Left = 2
Top = 2
Width = 251
Height = 234
Height = 238
Align = alLeft
BevelOuter = bvNone
BorderWidth = 10
+2 -6
View File
@@ -23,10 +23,6 @@ type
Label1: TLabel;
procedure HomeLinkClick(Sender: TObject);
procedure LogoClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
@@ -40,12 +36,12 @@ uses ShellAPI, Main, Info;
procedure TFrontForm.HomeLinkClick(Sender: TObject);
begin
ShellExecute(GetDesktopWindow(), 'open', 'http://progressquest.com/', nil, '', SW_SHOW);
ShellExecute(GetDesktopWindow(), 'open', 'http://progressquest.com/', nil, '', SW_SHOW);
end;
procedure TFrontForm.LogoClick(Sender: TObject);
begin
ShellExecute(GetDesktopWindow(), 'open', 'http://progressquest.com/', nil, '', SW_SHOW);
ShellExecute(GetDesktopWindow(), 'open', 'http://progressquest.com/', nil, '', SW_SHOW);
end;
end.
+13
View File
@@ -0,0 +1,13 @@
NAME: pq6
DESCRIPTION: Progress Quest: The phenomenon
CATEGORY: games
STATUS: mature
LANGUAGE: Delphi
TAGS: Object Pascal PQ
MAIN: Main.pas
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+14 -14
View File
@@ -1,8 +1,8 @@
object MainForm: TMainForm
Left = 281
Top = 121
Left = 238
Top = 148
Width = 682
Height = 569
Height = 513
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
Caption = 'Progress Quest'
@@ -96,7 +96,7 @@ object MainForm: TMainForm
Left = 0
Top = 0
Width = 200
Height = 507
Height = 444
Align = alLeft
TabOrder = 0
object Label1: TLabel
@@ -214,7 +214,7 @@ object MainForm: TMainForm
Left = 1
Top = 271
Width = 198
Height = 203
Height = 140
Align = alClient
Columns = <
item
@@ -236,7 +236,7 @@ object MainForm: TMainForm
end
object Cheats: TPanel
Left = 1
Top = 474
Top = 411
Width = 198
Height = 32
Align = alBottom
@@ -293,7 +293,7 @@ object MainForm: TMainForm
Left = 474
Top = 0
Width = 200
Height = 507
Height = 444
Align = alRight
TabOrder = 1
object Label3: TLabel
@@ -326,7 +326,7 @@ object MainForm: TMainForm
end
object QuestBar: TProgressBar
Left = 1
Top = 490
Top = 427
Width = 198
Height = 16
Align = alBottom
@@ -377,7 +377,7 @@ object MainForm: TMainForm
Left = 1
Top = 190
Width = 198
Height = 300
Height = 237
Align = alClient
Columns = <
item
@@ -401,7 +401,7 @@ object MainForm: TMainForm
Left = 200
Top = 0
Width = 274
Height = 507
Height = 444
Align = alClient
TabOrder = 2
object InventoryLabelAlsoGameStyle: TLabel
@@ -420,7 +420,7 @@ object MainForm: TMainForm
end
object Label7: TLabel
Left = 1
Top = 477
Top = 414
Width = 272
Height = 13
Align = alBottom
@@ -450,7 +450,7 @@ object MainForm: TMainForm
Left = 1
Top = 189
Width = 272
Height = 288
Height = 225
Align = alClient
Columns = <
item
@@ -473,7 +473,7 @@ object MainForm: TMainForm
end
object EncumBar: TProgressBar
Left = 1
Top = 490
Top = 427
Width = 272
Height = 16
Align = alBottom
@@ -562,7 +562,7 @@ object MainForm: TMainForm
end
object Panel4: TPanel
Left = 0
Top = 507
Top = 444
Width = 674
Height = 35
Align = alBottom
+175 -44
View File
@@ -1,8 +1,9 @@
unit Main;
{ copyright (c)2002 Eric Fredricksen all rights reserved }
{ copyright (c)2022 Eric Fredricksen all rights reserved }
{$UNDEF CHEATS}
{$UNDEF LOGGING}
{$UNDEF TURBO}
interface
@@ -12,11 +13,15 @@ uses
const
// revs:
// 8: pq 6.4.1
// 7: pq 6.4
// 6: pq-web
// 5: pq 6.3 (no official release)
// 4: pq 6.2
// 3: pq 6.1
// 2: pq 6.0
// 1: pq 6.0, some early release I guess; don't remember
RevString = '&rev=4';
RevString = '&rev=8';
wmIconTray = WM_USER + Ord('t');
kFileExt = '.pq';
@@ -104,6 +109,9 @@ type
{$ENDIF}
procedure ExportCharSheet;
function CharSheet: String;
procedure InterplotCinematic;
function NamedMonster(level: Integer): String;
function ImpressiveGuy: String;
public
FTrayIcon: TNotifyIconData;
FReportSave: Boolean;
@@ -145,7 +153,8 @@ type
var
MainForm: TMainForm;
function Split(s: String; field: Integer): String;
function Split(s: String; field: Integer): String; overload;
function Split(s: String; field: Integer; separator: String): String; overload;
procedure Navigate(url: String);
@@ -194,15 +203,21 @@ var
kOpenCommand: String;
begin
kOpenCommand := '"' + Application.ExeName + '" "%1"';
RegWrite(HKEY_CLASSES_ROOT, kFileExt,'', kPQFileType);
RegWrite(HKEY_CLASSES_ROOT, kPQFileType, '', 'Progresss Quest saved game');
RegWrite(HKEY_CLASSES_ROOT, kPQFileType + '\DefaultIcon', '', Application.ExeName + ',0');
RegWrite(HKEY_CLASSES_ROOT, kPQFileType + '\Shell\Open', '', '&Open');
if RegRead(HKEY_CLASSES_ROOT, kPQFileType + '\Shell\Open\Command', '') <> kOpenCommand then begin
RegWrite(HKEY_CLASSES_ROOT, kPQFileType + '\Shell\Open\Command', '', kOpenCommand);
// Notify Windows Explorer to realize we added this. In case this is slow
// I don't do this unless I'm sure this one has changed.
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
try
RegWrite(HKEY_CLASSES_ROOT, kFileExt,'', kPQFileType);
RegWrite(HKEY_CLASSES_ROOT, kPQFileType, '', 'Progresss Quest saved game');
RegWrite(HKEY_CLASSES_ROOT, kPQFileType + '\DefaultIcon', '', Application.ExeName + ',0');
RegWrite(HKEY_CLASSES_ROOT, kPQFileType + '\Shell\Open', '', '&Open');
if RegRead(HKEY_CLASSES_ROOT, kPQFileType + '\Shell\Open\Command', '') <> kOpenCommand then begin
RegWrite(HKEY_CLASSES_ROOT, kPQFileType + '\Shell\Open\Command', '', kOpenCommand);
// Notify Windows Explorer to realize we added this. In case this is slow
// I don't do this unless I'm sure this one has changed.
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;
except
on Exception do begin
// Don't care
end;
end;
end;
@@ -321,7 +336,12 @@ function RandomLow(below: Integer): Integer;
begin
Result := Min(Random(below),Random(below));
end;
function PickLow(s: TStrings): String;
begin
Result := s[RandomLow(s.Count)];
end;
function Ends(s,e: String): Boolean;
begin
Result := Copy(s,1+Length(s)-Length(e),Length(e)) = e;
@@ -342,20 +362,25 @@ begin
else Result := s + 's';
end;
function Split(s: String; field: Integer): String;
function Split(s: String; field: Integer; separator: String): String;
var
p: Integer;
begin
while field > 0 do begin
p := Pos('|',s);
p := Pos(separator,s);
s := Copy(s,p+1,10000);
Dec(field);
end;
if Pos('|',s) > 0
then Result := Copy(s,1,Pos('|',s)-1)
if Pos(separator,s) > 0
then Result := Copy(s,1,Pos(separator,s)-1)
else Result := s;
end;
function Split(s: String; field: Integer): String;
begin
result := Split(s, field, '|');
end;
function Indefinite(s: String; qty: Integer): String;
begin
if qty = 1 then begin
@@ -428,11 +453,80 @@ begin
end;
end;
procedure TMainForm.InterplotCinematic;
var
nemesis: String;
i, s: Integer;
begin
case Random(3) of
0: begin
Q('task|1|Exhausted, you arrive at a friendly oasis in a hostile land');
Q('task|2|You greet old friends and meet new allies');
Q('task|2|You are privy to a council of powerful do-gooders');
Q('task|1|There is much to be done. You are chosen!');
end;
1: begin
Q('task|1|Your quarry is in sight, but a mighty enemy bars your path!');
nemesis := NamedMonster(GetI(Traits,'Level')+3);
Q('task|4|A desperate struggle commences with ' + nemesis);
s := Random(3);
for i := 1 to Random(1 + Plots.Items.Count) do begin
Inc(s, 1 + Random(2));
case s mod 3 of
0: Q('task|2|Locked in grim combat with ' + nemesis);
1: Q('task|2|' + nemesis + ' seems to have the upper hand');
2: Q('task|2|You seem to gain the advantage over ' + nemesis);
end;
end;
Q('task|3|Victory! ' + nemesis + ' is slain! Exhausted, you lose conciousness');
Q('task|2|You awake in a friendly place, but the road awaits');
end;
2: begin
nemesis := ImpressiveGuy;
Q('task|2|Oh sweet relief! You''ve reached the kind protection of ' + nemesis);
Q('task|3|There is rejoicing, and an unnerving encouter with ' + nemesis + ' in private');
Q('task|2|You forget your ' + BoringItem + ' and go back to get it');
Q('task|2|What''s this!? You overhear something shocking!');
Q('task|2|Could ' + nemesis + ' be a dirty double-dealer?');
Q('task|3|Who can possibly be trusted with this news!? -- Oh yes, of course');
end;
end;
Q('plot|2|Loading');
end;
function TMainForm.NamedMonster(level: Integer): String;
var
lev, i: Integer;
m: String;
begin
lev := 0; // shut up, compiler hint
for i := 1 to 5 do begin
m := Pick(K.Monsters.Lines);
if (Result = '') or (abs(level-StrToInt(Split(m,1))) < abs(level-lev)) then begin
Result := Split(m,0);
lev := StrToInt(Split(m,1));
end;
end;
Result := GenerateName + ' the ' + Result;
end;
function TMainForm.ImpressiveGuy: String;
begin
Result := Pick(K.ImpressiveTitles.Lines);
case Random(2) of
0: Result := 'the ' + Result + ' of the ' + Plural(Split(Pick(K.Races.Lines), 0));
1: Result := Result + ' ' + GenerateName + ' of ' + GenerateName;
end;
end;
function TMainForm.MonsterTask(var level: Integer): String;
var
qty, lev, i: Integer;
monster, m1: string;
definite: Boolean;
begin
definite := false;
for i := level downto 1 do begin
if Odds(2,5) then
Inc(level, RandSign());
@@ -442,7 +536,13 @@ begin
if Odds(1,25) then begin
// use an NPC every once in a while
monster := 'passing ' + Pick(NewGuyForm.Race.Items) + ' ' + Pick(NewGuyForm.Klass.Items);
monster := ' ' + Pick(NewGuyForm.Race.Items);
if Odds(1,2)
then monster := 'passing' + monster + ' ' + Pick(NewGuyForm.Klass.Items)
else begin
monster := PickLow(K.Titles.Lines) + ' ' + GenerateName + ' the' + monster;
definite := true;
end;
lev := level;
monster := monster + '|' + IntToStr(level) + '|*';
end else if (fQuest.Caption <> '') and Odds(1,4) then begin
@@ -501,7 +601,7 @@ begin
lev := level;
level := lev * qty;
Result := Indefinite(Result, qty);
if not definite then Result := Indefinite(Result, qty);
end;
function ProperCase(s:String):String;
@@ -554,7 +654,11 @@ begin
a := Split(fQueue.Items[0],0);
n := StrToInt(Split(fQueue.Items[0],1));
s := Split(fQueue.Items[0],2);
if a = 'task' then begin
if (a = 'task') or (a = 'plot') then begin
if a = 'plot' then begin
CompleteAct;
s := 'Loading ' + Plots.Items[Plots.Items.Count-1].Caption;
end;
Task(s, n * 1000);
fQueue.Items.Delete(0);
end else begin
@@ -619,17 +723,19 @@ begin
if SubItems.Count < 1
then SubItems.Add(value)
else SubItems[0] := value;
Selected := true;
MakeVisible(false);
end;
//list.MultiSelect := true;
//list.RowSelect := true;
//list.HideSelection := false;
list.Items[pos].Selected := true;
end;
function LevelUpTime(level: Integer): Integer;
function LevelUpTime(level: Integer): Integer; // seconds
begin
// ~20 minutes for level 1, eventually dominated by exponential
Result := Round((20.0 + IntPower(1.15,level)) * 60.0);
// ~20 minutes for level 1, eventually dominated by exponential
Result := Round((20.0 + IntPower(1.15,level)) * 60.0);
end;
procedure TMainForm.GoButtonClick(Sender: TObject);
@@ -639,16 +745,16 @@ begin
Max := LevelUpTime(1);
end;
fTask.Caption := '';
fTask.Caption := 'load';
fQuest.Caption := '';
fQueue.Items.Clear;
Task('Loading.',2000); // that dot is spotted for later...
Task('Loading',2000);
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|2|Loading');
Q('plot|2|Loading');
PlotBar.Max := 26;
with Plots.Items.Add do begin
@@ -735,10 +841,13 @@ begin
t := 0;
for i := 0 to 5 do Inc(t,Square(GetI(Stats,i)));
t := Random(t);
i := -1;
while t >= 0 do begin
Inc(i);
Dec(t,Square(GetI(Stats,i)));
if t < 0 then i := Random(Stats.Items.Count)
else begin
i := -1;
while t >= 0 do begin
Inc(i);
Dec(t,Square(GetI(Stats,i)));
end;
end;
end;
Add(Stats, Stats.Items[i].Caption, 1);
@@ -763,7 +872,9 @@ end;
procedure TMainForm.WinItem;
begin
Add(Inventory, SpecialItem, 1);
if max(250, Random(999)) < Inventory.Items.Count
then Add(Inventory, Inventory.Items[Random(Inventory.Items.Count)].Caption, 1)
else Add(Inventory, SpecialItem, 1);
end;
procedure TMainForm.CompleteQuest;
@@ -866,8 +977,14 @@ begin
end;
end;
// I V X L C D M A T P E
// 1 5 10 50 100 500 1000 5000 10000 50000 100000
function IntToRoman(n: Integer): String;
begin
while Rome(n, 10000, Result, 'T') do ;
Rome(n, 9000, Result, 'MT');
Rome(n, 5000, Result, 'A');
Rome(n, 4000, Result, 'MA');
while Rome(n, 1000, Result, 'M') do ;
Rome(n, 900, Result, 'CM');
Rome(n, 500, Result, 'D');
@@ -886,6 +1003,10 @@ end;
function RomanToInt(n: String): Integer;
begin
Result := 0;
while UnRome(n, 10000, Result, 'T') do ;
UnRome(n, 9000, Result, 'MT');
UnRome(n, 5000, Result, 'A');
UnRome(n, 4000, Result, 'MA');
while UnRome(n, 1000, Result, 'M') do ;
UnRome(n, 900, Result, 'CM');
UnRome(n, 500, Result, 'D');
@@ -914,11 +1035,14 @@ begin
StateIndex := 0;
Width := Width-1;
end;
if Items.Count > 2 then WinItem;
if Items.Count > 3 then WinEquip;
end;
SaveGame;
Brag('a');
end;
{$IFDEF LOGGING}
procedure TMainForm.Log(line: String);
var
@@ -997,7 +1121,7 @@ begin
else WrLn( ' ' + Indefinite(Items[i].Caption, GetI(Inventory,i)));
WrLn;
WrLn( '-- ' + DateTimeToStr(Now));
WrLn( '-- Progress Quest 6.2 - http://progressquest.com/');
WrLn( '-- Progress Quest 6.4 - http://progressquest.com/');
Result := f;
end;
@@ -1123,16 +1247,19 @@ var
begin
gain := Pos('kill|',fTask.Caption) = 1;
with TaskBar do begin
{$IFDEF TURBO}
Position := Max;
{$ENDIF}
if Position >= Max then begin
ClearAllSelections;
if Kill.SimpleText = 'Loading....' then Max := 0;
// gain XP / level up
if gain then with ExpBar do if Position >= Max
then LevelUp
else Position := Position + TaskBar.Max div 1000;
with ExpBar do Hint := IntToStr(Max-Position) + ' XP needed for next level';
// advance quest
if gain then if Plots.Items.Count > 1 then with QuestBar do if Position >= Max then begin
CompleteQuest;
end else if Quests.Items.Count > 0 then begin
@@ -1140,9 +1267,11 @@ begin
Hint := IntToStr(100 * Position div Max) + '% complete';
end;
with PlotBar do if Position >= Max
then CompleteAct
else Position := Position + TaskBar.Max div 1000;
// advance plot
if (PlotBar.Position >= PlotBar.Max) and gain
then InterplotCinematic
else if fTask.Caption <> 'load'
then PlotBar.Position := Math.Min(PlotBar.Position + TaskBar.Max div 1000, PlotBar.Max);
//Time.Caption := FormatDateTime('h:mm:ss',PlotBar.Position / (24.0 * 60 * 60));
PlotBar.Hint := RoughTime(PlotBar.Max-PlotBar.Position) + ' remaining';
@@ -1153,7 +1282,7 @@ begin
elapsed := LongInt(timeGetTime) - LongInt(Timer1.Tag);
if elapsed > 100 then elapsed := 100;
if elapsed < 0 then elapsed := 0;
Position := Position + elapsed;//Integer(Timer1.Interval);
Position := Position + elapsed;
end;
end;
Timer1.Tag := timeGetTime;
@@ -1173,7 +1302,7 @@ begin
FMinToTray := true;
FExportSheets := false;
MakeFileAssociations;
if Win32MajorVersion < 6 then MakeFileAssociations;
end;
procedure TMainForm.SpeedButton1Click(Sender: TObject);
@@ -1395,10 +1524,6 @@ begin
f.Free;
except
on EZCompressionError do begin
// backwards-compatibility
//m.Free;
//m := f;
//f := nil;
ShowMessage('Error loading game.');
Close;
Exit;
@@ -1508,6 +1633,12 @@ var
const
flat = 1;
begin
{$IFDEF TURBO}
Exit; // For testing multiplayer saves without hitting the server
{$ENDIF}
{$IFDEF CHEATS}
Exit; // For testing multiplayer saves without hitting the server
{$ENDIF}
if FExportSheets then
ExportCharSheet;
if GetPasskey = 0 then Exit; // not a online game!
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
Regular → Executable
+7 -6
View File
@@ -1,6 +1,6 @@
object NewGuyForm: TNewGuyForm
Left = 203
Top = 146
Left = 474
Top = 177
BorderIcons = []
BorderStyle = bsDialog
Caption = 'Progress Quest - New Character'
@@ -86,6 +86,7 @@ object NewGuyForm: TNewGuyForm
OldCreateOrder = False
Position = poScreenCenter
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
@@ -100,10 +101,10 @@ object NewGuyForm: TNewGuyForm
'Half Man'
'Half Halfling'
'Double Hobbit'
'Gobhobbit'
'Low Elf'
'Dung Elf'
'Talking Pony'
'Greater Gnome'
'Gyrognome'
'Lesser Dwarf'
'Crested Dwarf'
@@ -136,14 +137,14 @@ object NewGuyForm: TNewGuyForm
'Fighter/Organist'
'Puma Burgular'
'Runeloremaster'
'Tongueblade'
'Hunter Strangler'
'Battle-Felon'
'Tickle-Mimic'
'Slow Poisoner'
'Bastard Lunatic'
'Lowling'
'Birdrider')
'Jungle Clown'
'Birdrider'
'Vermineer')
TabOrder = 1
end
object GroupBox1: TGroupBox
Regular → Executable
+15 -1
View File
@@ -44,6 +44,7 @@ type
procedure ApplicationEvents1Minimize(Sender: TObject);
procedure GenClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure RollEm;
function GetAccount: String;
@@ -57,10 +58,11 @@ var
NewGuyForm: TNewGuyForm;
function UrlEncode(s: string): string;
function GenerateName: string;
implementation
uses Main, SelServ, StrUtils, Web;
uses Main, SelServ, StrUtils, Web, Config;
{$R *.dfm}
@@ -250,4 +252,16 @@ begin
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.
-12
View File
@@ -1,12 +0,0 @@
[contents of readme]
ProgressQuest v6.2 (probably as released)
-----------------------------------------
This directory represents an ex post facto rendering of pq6 in its
various versions in svn, so that changes will be trackable thataway.
The version as of this moment in svn is 6.2 (but I had two copies
around, so I'm not positive this is the final one, and not the previous
rev checked in)
(I didn't add this file in PQ 6.0, but after that you can use this README
to trace the checkin history using svn.)
+42
View File
@@ -0,0 +1,42 @@
ProgressQuest v6.3
==================
BUILDING
--------
Requires Delphi 6.
Requires the package in DelphiZLib.zip to be installed in Delphi, or
decompress the .obj files from there into this, the project, directory.
VCS NOTES
---------
Converted to Mercurial on 1/12/2010 & sent to
http://bitbucket.org/grumdrig/pq/ ; development will continue from
there. If at all. Source opened 5/20/11. The world ends tomorrow anyway.
This project represents an ex post facto rendering of pq6 in its
various versions in version control, so that changes will be trackable
thataway.
(I didn't add this README file in PQ 6.0, but after that you can use
this README to trace the checkin history using version control.)
Subversion revsion numbers vs. versions:
* r321 v6.3 as I found it after a couple years of inactivity
* r320 v6.2 probably as released, though I'm not totally sure
* r318 v6.2 but probably a slightly older version
* r317 v6.1
* r313 v6.0
(But these revision numbers aren't immediately accessible, if at all,
since moving to git.)
SEE ALSO
--------
The in-browser edition: this project, ported to JavaScript/HTML
https://bitbucket.org/grumdrig/pq-web
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+1 -1
View File
@@ -51,7 +51,7 @@ begin
Result := '';
conntype := INTERNET_OPEN_TYPE_DIRECT;
if proxyok then conntype := INTERNET_OPEN_TYPE_PRECONFIG;
NetHandle := InternetOpen('PQ6.2', conntype, nil, nil, 0);
NetHandle := InternetOpen('PQ6.4', conntype, nil, nil, 0);
if Assigned(NetHandle) then
begin {
if Len(username + password) > 0 then
+777
View File
@@ -0,0 +1,777 @@
{*****************************************************************************
* ZLibEx.pas *
* *
* copyright (c) 2000-2002 base2 technologies *
* copyright (c) 1997 Borland International *
* *
* revision history *
* 2002.03.15 updated to zlib version 1.1.4 *
* 2001.11.27 enhanced TZDecompressionStream.Read to adjust source *
* stream position upon end of compression data *
* fixed endless loop in TZDecompressionStream.Read when *
* destination count was greater than uncompressed data *
* 2001.10.26 renamed unit to integrate "nicely" with delphi 6 *
* 2000.11.24 added soFromEnd condition to TZDecompressionStream.Seek *
* added ZCompressStream and ZDecompressStream *
* 2000.06.13 optimized, fixed, rewrote, and enhanced the zlib.pas unit *
* included on the delphi cd (zlib version 1.1.3) *
* *
* acknowledgements *
* erik turner Z*Stream routines *
* david bennion finding the nastly little endless loop quirk with the *
* TZDecompressionStream.Read method *
* burak kalayci informing me about the zlib 1.1.4 update *
*****************************************************************************}
unit ZLibEx;
interface
uses
Sysutils, Classes;
const
ZLIB_VERSION = '1.1.4';
type
TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer;
TZFree = procedure (opaque, block: Pointer);
TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);
{** TZStreamRec ***********************************************************}
TZStreamRec = packed record
next_in : PChar; // next input byte
avail_in : Longint; // number of bytes available at next_in
total_in : Longint; // total nb of input bytes read so far
next_out : PChar; // next output byte should be put here
avail_out: Longint; // remaining free space at next_out
total_out: Longint; // total nb of bytes output so far
msg : PChar; // last error message, NULL if no error
state : Pointer; // not visible by applications
zalloc : TZAlloc; // used to allocate the internal state
zfree : TZFree; // used to free the internal state
opaque : Pointer; // private data object passed to zalloc and zfree
data_type: Integer; // best guess about the data type: ascii or binary
adler : Longint; // adler32 value of the uncompressed data
reserved : Longint; // reserved for future use
end;
{** TCustomZStream ********************************************************}
TCustomZStream = class(TStream)
private
FStream : TStream;
FStreamPos : Integer;
FOnProgress: TNotifyEvent;
FZStream : TZStreamRec;
FBuffer : Array [Word] of Char;
protected
constructor Create(stream: TStream);
procedure DoProgress; dynamic;
property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
end;
{** TZCompressionStream ***************************************************}
TZCompressionStream = class(TCustomZStream)
private
function GetCompressionRate: Single;
public
constructor Create(dest: TStream; compressionLevel: TZCompressionLevel = zcDefault);
destructor Destroy; override;
function Read(var buffer; count: Longint): Longint; override;
function Write(const buffer; count: Longint): Longint; override;
function Seek(offset: Longint; origin: Word): Longint; override;
property CompressionRate: Single read GetCompressionRate;
property OnProgress;
end;
{** TZDecompressionStream *************************************************}
TZDecompressionStream = class(TCustomZStream)
public
constructor Create(source: TStream);
destructor Destroy; override;
function Read(var buffer; count: Longint): Longint; override;
function Write(const buffer; count: Longint): Longint; override;
function Seek(offset: Longint; origin: Word): Longint; override;
property OnProgress;
end;
{** zlib public routines ****************************************************}
{*****************************************************************************
* ZCompress *
* *
* pre-conditions *
* inBuffer = pointer to uncompressed data *
* inSize = size of inBuffer (bytes) *
* outBuffer = pointer (unallocated) *
* level = compression level *
* *
* post-conditions *
* outBuffer = pointer to compressed data (allocated) *
* outSize = size of outBuffer (bytes) *
*****************************************************************************}
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer;
level: TZCompressionLevel = zcDefault);
{*****************************************************************************
* ZDecompress *
* *
* pre-conditions *
* inBuffer = pointer to compressed data *
* inSize = size of inBuffer (bytes) *
* outBuffer = pointer (unallocated) *
* outEstimate = estimated size of uncompressed data (bytes) *
* *
* post-conditions *
* outBuffer = pointer to decompressed data (allocated) *
* outSize = size of outBuffer (bytes) *
*****************************************************************************}
procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0);
{** string routines *********************************************************}
function ZCompressStr(const s: String; level: TZCompressionLevel = zcDefault): String;
function ZDecompressStr(const s: String): String;
{** stream routines *********************************************************}
procedure ZCompressStream(inStream, outStream: TStream;
level: TZCompressionLevel = zcDefault);
procedure ZDecompressStream(inStream, outStream: TStream);
{****************************************************************************}
type
EZLibError = class(Exception);
EZCompressionError = class(EZLibError);
EZDecompressionError = class(EZLibError);
implementation
{** link zlib code **********************************************************}
{$L deflate.obj}
{$L inflate.obj}
{$L infblock.obj}
{$L inftrees.obj}
{$L infcodes.obj}
{$L infutil.obj}
{$L inffast.obj}
{$L trees.obj}
{$L adler32.obj}
{*****************************************************************************
* note: do not reorder the above -- doing so will result in external *
* functions being undefined *
*****************************************************************************}
const
{** flush constants *******************************************************}
Z_NO_FLUSH = 0;
Z_PARTIAL_FLUSH = 1;
Z_SYNC_FLUSH = 2;
Z_FULL_FLUSH = 3;
Z_FINISH = 4;
{** return codes **********************************************************}
Z_OK = 0;
Z_STREAM_END = 1;
Z_NEED_DICT = 2;
Z_ERRNO = (-1);
Z_STREAM_ERROR = (-2);
Z_DATA_ERROR = (-3);
Z_MEM_ERROR = (-4);
Z_BUF_ERROR = (-5);
Z_VERSION_ERROR = (-6);
{** compression levels ****************************************************}
Z_NO_COMPRESSION = 0;
Z_BEST_SPEED = 1;
Z_BEST_COMPRESSION = 9;
Z_DEFAULT_COMPRESSION = (-1);
{** compression strategies ************************************************}
Z_FILTERED = 1;
Z_HUFFMAN_ONLY = 2;
Z_DEFAULT_STRATEGY = 0;
{** data types ************************************************************}
Z_BINARY = 0;
Z_ASCII = 1;
Z_UNKNOWN = 2;
{** compression methods ***************************************************}
Z_DEFLATED = 8;
{** return code messages **************************************************}
_z_errmsg: array[0..9] of PChar = (
'need dictionary', // Z_NEED_DICT (2)
'stream end', // Z_STREAM_END (1)
'', // Z_OK (0)
'file error', // Z_ERRNO (-1)
'stream error', // Z_STREAM_ERROR (-2)
'data error', // Z_DATA_ERROR (-3)
'insufficient memory', // Z_MEM_ERROR (-4)
'buffer error', // Z_BUF_ERROR (-5)
'incompatible version', // Z_VERSION_ERROR (-6)
''
);
ZLevels: array [TZCompressionLevel] of Shortint = (
Z_NO_COMPRESSION,
Z_BEST_SPEED,
Z_DEFAULT_COMPRESSION,
Z_BEST_COMPRESSION
);
SZInvalid = 'Invalid ZStream operation!';
{** deflate routines ********************************************************}
function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
recsize: Integer): Integer; external;
function deflate(var strm: TZStreamRec; flush: Integer): Integer;
external;
function deflateEnd(var strm: TZStreamRec): Integer; external;
{** inflate routines ********************************************************}
function inflateInit_(var strm: TZStreamRec; version: PChar;
recsize: Integer): Integer; external;
function inflate(var strm: TZStreamRec; flush: Integer): Integer;
external;
function inflateEnd(var strm: TZStreamRec): Integer; external;
function inflateReset(var strm: TZStreamRec): Integer; external;
{** zlib function implementations *******************************************}
function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
begin
GetMem(result,items * size);
end;
procedure zcfree(opaque, block: Pointer);
begin
FreeMem(block);
end;
{** c function implementations **********************************************}
procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl;
begin
FillChar(p^,count,b);
end;
procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
Move(source^,dest^,count);
end;
{** custom zlib routines ****************************************************}
function DeflateInit(var stream: TZStreamRec; level: Integer): Integer;
begin
result := DeflateInit_(stream,level,ZLIB_VERSION,SizeOf(TZStreamRec));
end;
// function DeflateInit2(var stream: TZStreamRec; level, method, windowBits,
// memLevel, strategy: Integer): Integer;
// begin
// result := DeflateInit2_(stream,level,method,windowBits,memLevel,
// strategy,ZLIB_VERSION,SizeOf(TZStreamRec));
// end;
function InflateInit(var stream: TZStreamRec): Integer;
begin
result := InflateInit_(stream,ZLIB_VERSION,SizeOf(TZStreamRec));
end;
// function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer;
// begin
// result := InflateInit2_(stream,windowBits,ZLIB_VERSION,SizeOf(TZStreamRec));
// end;
{****************************************************************************}
function ZCompressCheck(code: Integer): Integer;
begin
result := code;
if code < 0 then
begin
raise EZCompressionError.Create(_z_errmsg[2 - code]);
end;
end;
function ZDecompressCheck(code: Integer): Integer;
begin
Result := code;
if code < 0 then
begin
raise EZDecompressionError.Create(_z_errmsg[2 - code]);
end;
end;
procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer;
level: TZCompressionLevel);
const
delta = 256;
var
zstream: TZStreamRec;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);
outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255;
GetMem(outBuffer,outSize);
try
zstream.next_in := inBuffer;
zstream.avail_in := inSize;
zstream.next_out := outBuffer;
zstream.avail_out := outSize;
ZCompressCheck(DeflateInit(zstream,ZLevels[level]));
try
while ZCompressCheck(deflate(zstream,Z_FINISH)) <> Z_STREAM_END do
begin
Inc(outSize,delta);
ReallocMem(outBuffer,outSize);
zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
zstream.avail_out := delta;
end;
finally
ZCompressCheck(deflateEnd(zstream));
end;
ReallocMem(outBuffer,zstream.total_out);
outSize := zstream.total_out;
except
FreeMem(outBuffer);
raise;
end;
end;
procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
var
zstream: TZStreamRec;
delta : Integer;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);
delta := (inSize + 255) and not 255;
if outEstimate = 0 then outSize := delta
else outSize := outEstimate;
GetMem(outBuffer,outSize);
try
zstream.next_in := inBuffer;
zstream.avail_in := inSize;
zstream.next_out := outBuffer;
zstream.avail_out := outSize;
ZDecompressCheck(InflateInit(zstream));
try
while ZDecompressCheck(inflate(zstream,Z_NO_FLUSH)) <> Z_STREAM_END do
begin
Inc(outSize,delta);
ReallocMem(outBuffer,outSize);
zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
zstream.avail_out := delta;
end;
finally
ZDecompressCheck(inflateEnd(zstream));
end;
ReallocMem(outBuffer,zstream.total_out);
outSize := zstream.total_out;
except
FreeMem(outBuffer);
raise;
end;
end;
{** string routines *********************************************************}
function ZCompressStr(const s: String; level: TZCompressionLevel): String;
var
buffer: Pointer;
size : Integer;
begin
ZCompress(PChar(s),Length(s),buffer,size,level);
SetLength(result,size);
Move(buffer^,result[1],size);
FreeMem(buffer);
end;
function ZDecompressStr(const s: String): String;
var
buffer: Pointer;
size : Integer;
begin
ZDecompress(PChar(s),Length(s),buffer,size);
SetLength(result,size);
Move(buffer^,result[1],size);
FreeMem(buffer);
end;
{** stream routines *********************************************************}
procedure ZCompressStream(inStream, outStream: TStream;
level: TZCompressionLevel);
const
bufferSize = 32768;
var
zstream : TZStreamRec;
zresult : Integer;
inBuffer : Array [0..bufferSize-1] of Char;
outBuffer: Array [0..bufferSize-1] of Char;
inSize : Integer;
outSize : Integer;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);
ZCompressCheck(DeflateInit(zstream,ZLevels[level]));
inSize := inStream.Read(inBuffer,bufferSize);
while inSize > 0 do
begin
zstream.next_in := inBuffer;
zstream.avail_in := inSize;
repeat
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;
ZCompressCheck(deflate(zstream,Z_NO_FLUSH));
// outSize := zstream.next_out - outBuffer;
outSize := bufferSize - zstream.avail_out;
outStream.Write(outBuffer,outSize);
until (zstream.avail_in = 0) and (zstream.avail_out > 0);
inSize := inStream.Read(inBuffer,bufferSize);
end;
repeat
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;
zresult := ZCompressCheck(deflate(zstream,Z_FINISH));
// outSize := zstream.next_out - outBuffer;
outSize := bufferSize - zstream.avail_out;
outStream.Write(outBuffer,outSize);
until (zresult = Z_STREAM_END) and (zstream.avail_out > 0);
ZCompressCheck(deflateEnd(zstream));
end;
procedure ZDecompressStream(inStream, outStream: TStream);
const
bufferSize = 32768;
var
zstream : TZStreamRec;
zresult : Integer;
inBuffer : Array [0..bufferSize-1] of Char;
outBuffer: Array [0..bufferSize-1] of Char;
inSize : Integer;
outSize : Integer;
begin
FillChar(zstream,SizeOf(TZStreamRec),0);
ZCompressCheck(InflateInit(zstream));
inSize := inStream.Read(inBuffer,bufferSize);
while inSize > 0 do
begin
zstream.next_in := inBuffer;
zstream.avail_in := inSize;
repeat
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;
ZCompressCheck(inflate(zstream,Z_NO_FLUSH));
// outSize := zstream.next_out - outBuffer;
outSize := bufferSize - zstream.avail_out;
outStream.Write(outBuffer,outSize);
until (zstream.avail_in = 0) and (zstream.avail_out > 0);
inSize := inStream.Read(inBuffer,bufferSize);
end;
repeat
zstream.next_out := outBuffer;
zstream.avail_out := bufferSize;
zresult := ZCompressCheck(inflate(zstream,Z_FINISH));
// outSize := zstream.next_out - outBuffer;
outSize := bufferSize - zstream.avail_out;
outStream.Write(outBuffer,outSize);
until (zresult = Z_STREAM_END) and (zstream.avail_out > 0);
ZCompressCheck(inflateEnd(zstream));
end;
{** TCustomZStream **********************************************************}
constructor TCustomZStream.Create(stream: TStream);
begin
inherited Create;
FStream := stream;
FStreamPos := stream.Position;
end;
procedure TCustomZStream.DoProgress;
begin
if Assigned(FOnProgress) then FOnProgress(Self);
end;
{** TZCompressionStream *****************************************************}
constructor TZCompressionStream.Create(dest: TStream;
compressionLevel: TZCompressionLevel);
begin
inherited Create(dest);
FZStream.next_out := FBuffer;
FZStream.avail_out := SizeOf(FBuffer);
ZCompressCheck(DeflateInit(FZStream,ZLevels[compressionLevel]));
end;
destructor TZCompressionStream.Destroy;
begin
FZStream.next_in := Nil;
FZStream.avail_in := 0;
try
if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
while ZCompressCheck(deflate(FZStream,Z_FINISH)) <> Z_STREAM_END do
begin
FStream.WriteBuffer(FBuffer,SizeOf(FBuffer) - FZStream.avail_out);
FZStream.next_out := FBuffer;
FZStream.avail_out := SizeOf(FBuffer);
end;
if FZStream.avail_out < SizeOf(FBuffer) then
begin
FStream.WriteBuffer(FBuffer,SizeOf(FBuffer) - FZStream.avail_out);
end;
finally
deflateEnd(FZStream);
end;
inherited Destroy;
end;
function TZCompressionStream.Read(var buffer; count: Longint): Longint;
begin
raise EZCompressionError.Create(SZInvalid);
end;
function TZCompressionStream.Write(const buffer; count: Longint): Longint;
begin
FZStream.next_in := @buffer;
FZStream.avail_in := count;
if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
while FZStream.avail_in > 0 do
begin
ZCompressCheck(deflate(FZStream,Z_NO_FLUSH));
if FZStream.avail_out = 0 then
begin
FStream.WriteBuffer(FBuffer,SizeOf(FBuffer));
FZStream.next_out := FBuffer;
FZStream.avail_out := SizeOf(FBuffer);
FStreamPos := FStream.Position;
DoProgress;
end;
end;
result := Count;
end;
function TZCompressionStream.Seek(offset: Longint; origin: Word): Longint;
begin
if (offset = 0) and (origin = soFromCurrent) then
begin
result := FZStream.total_in;
end
else raise EZCompressionError.Create(SZInvalid);
end;
function TZCompressionStream.GetCompressionRate: Single;
begin
if FZStream.total_in = 0 then result := 0
else result := (1.0 - (FZStream.total_out / FZStream.total_in)) * 100.0;
end;
{** TZDecompressionStream ***************************************************}
constructor TZDecompressionStream.Create(source: TStream);
begin
inherited Create(source);
FZStream.next_in := FBuffer;
FZStream.avail_in := 0;
ZDecompressCheck(InflateInit(FZStream));
end;
destructor TZDecompressionStream.Destroy;
begin
inflateEnd(FZStream);
inherited Destroy;
end;
function TZDecompressionStream.Read(var buffer; count: Longint): Longint;
var
zresult: Integer;
begin
FZStream.next_out := @buffer;
FZStream.avail_out := count;
if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;
zresult := Z_OK;
while (FZStream.avail_out > 0) and (zresult <> Z_STREAM_END) do
begin
if FZStream.avail_in = 0 then
begin
FZStream.avail_in := FStream.Read(FBuffer,SizeOf(FBuffer));
if FZStream.avail_in = 0 then
begin
result := count - FZStream.avail_out;
Exit;
end;
FZStream.next_in := FBuffer;
FStreamPos := FStream.Position;
DoProgress;
end;
zresult := ZDecompressCheck(inflate(FZStream,Z_NO_FLUSH));
end;
if (zresult = Z_STREAM_END) and (FZStream.avail_in > 0) then
begin
FStream.Position := FStream.Position - FZStream.avail_in;
FStreamPos := FStream.Position;
FZStream.avail_in := 0;
end;
result := count - FZStream.avail_out;
end;
function TZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
raise EZDecompressionError.Create(SZInvalid);
end;
function TZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
buf: Array [0..8191] of Char;
i : Integer;
begin
if (offset = 0) and (origin = soFromBeginning) then
begin
ZDecompressCheck(inflateReset(FZStream));
FZStream.next_in := FBuffer;
FZStream.avail_in := 0;
FStream.Position := 0;
FStreamPos := 0;
end
else if ((offset >= 0) and (origin = soFromCurrent)) or
(((offset - FZStream.total_out) > 0) and (origin = soFromBeginning)) then
begin
if origin = soFromBeginning then Dec(offset,FZStream.total_out);
if offset > 0 then
begin
for i := 1 to offset div SizeOf(buf) do ReadBuffer(buf,SizeOf(buf));
ReadBuffer(buf,offset mod SizeOf(buf));
end;
end
else if (offset = 0) and (origin = soFromEnd) then
begin
while Read(buf,SizeOf(buf)) > 0 do ;
end
else raise EZDecompressionError.Create(SZInvalid);
result := FZStream.total_out;
end;
end.
+22
View File
@@ -0,0 +1,22 @@
New RPG rulebook: N.U.S.S.B.A.H. II (Nerfed yoU Soon Shall Be, And How (2ed))
-
New race: Gobhobbit (replaces Greater Gnome)
New class: Vermineer (replaces Toungeblade)
New weapon: Kreen (on par w/ a Broadsword)
New spells: History Lesson, Shoelaces
New ordinary quest item: writ
New fancy item: Vulpeculum
New monster: the Hogbird (Lvl 3, drops a hogbird curl)
Save extensions: pq3
Named & titled NPC victims sometimes
TODO
Cinematics between plots
Cinematics to end / begin quests
Logging
Class- and race-based effects?
More accurate item dropping?
Skills?
Options screen?
+1 -1
View File
@@ -125,5 +125,5 @@ running</i>. Your character will make <i>no</i> progress once you quit the prog
<tr><td>Alt-F4<td>Exit <b>Progress Quest</b></table>
<p>
<small>&copy:Copyright 2003
<small>&copy:Copyright 2022
<a href=mailto:grumdrig@progressquest.com>grumdrig@progressquest.com</a>
+2 -2
View File
@@ -1,5 +1,5 @@
Progress Quest version 6.2
Copyright (c) 2003 Eric Fredricksen
Progress Quest version 6.4
Copyright (c) 2022 Eric Fredricksen
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+2 -2
View File
@@ -31,5 +31,5 @@
-M
-$M16384,1048576
-K$00400000
-LE"c:\appl\delphi6\Projects\Bpl"
-LN"c:\appl\delphi6\Projects\Bpl"
-LE"c:\program files\borland\delphi6\Projects\Bpl"
-LN"c:\program files\borland\delphi6\Projects\Bpl"
Executable
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
Binary file not shown.
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
Binary file not shown.
BIN
View File
Binary file not shown.