(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.)
This commit is contained in:
Eric Fredricksen
2006-12-24 21:53:08 +00:00
parent 5e7e820533
commit 9a85adf823
28 changed files with 1106 additions and 69 deletions
BIN
View File
Binary file not shown.
+133 -7
View File
@@ -1,7 +1,7 @@
object K: TK
Left = 335
Top = 119
Width = 572
Left = 457
Top = 331
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,96 @@ 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'
'Lowling|WIS'
'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')
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.
+7 -7
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' 2003 Eric Fredricksen - v6.3'
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
@@ -4499,8 +4499,8 @@ object FrontForm: TFrontForm
end
end
object OpenDialog1: TOpenDialog
DefaultExt = 'pq'
Filter = 'Progress Quest games|*.pq'
DefaultExt = 'pq3'
Filter = 'Progress Quest games|*.pq3'
Left = 476
Top = 240
end
-4
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
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 = 265
Top = 0
Width = 682
Height = 569
Height = 568
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 = 501
Align = alLeft
TabOrder = 0
object Label1: TLabel
@@ -214,7 +214,7 @@ object MainForm: TMainForm
Left = 1
Top = 271
Width = 198
Height = 203
Height = 197
Align = alClient
Columns = <
item
@@ -236,7 +236,7 @@ object MainForm: TMainForm
end
object Cheats: TPanel
Left = 1
Top = 474
Top = 468
Width = 198
Height = 32
Align = alBottom
@@ -293,7 +293,7 @@ object MainForm: TMainForm
Left = 474
Top = 0
Width = 200
Height = 507
Height = 501
Align = alRight
TabOrder = 1
object Label3: TLabel
@@ -326,7 +326,7 @@ object MainForm: TMainForm
end
object QuestBar: TProgressBar
Left = 1
Top = 490
Top = 484
Width = 198
Height = 16
Align = alBottom
@@ -377,7 +377,7 @@ object MainForm: TMainForm
Left = 1
Top = 190
Width = 198
Height = 300
Height = 294
Align = alClient
Columns = <
item
@@ -401,7 +401,7 @@ object MainForm: TMainForm
Left = 200
Top = 0
Width = 274
Height = 507
Height = 501
Align = alClient
TabOrder = 2
object InventoryLabelAlsoGameStyle: TLabel
@@ -420,7 +420,7 @@ object MainForm: TMainForm
end
object Label7: TLabel
Left = 1
Top = 477
Top = 471
Width = 272
Height = 13
Align = alBottom
@@ -450,7 +450,7 @@ object MainForm: TMainForm
Left = 1
Top = 189
Width = 272
Height = 288
Height = 282
Align = alClient
Columns = <
item
@@ -473,7 +473,7 @@ object MainForm: TMainForm
end
object EncumBar: TProgressBar
Left = 1
Top = 490
Top = 484
Width = 272
Height = 16
Align = alBottom
@@ -562,7 +562,7 @@ object MainForm: TMainForm
end
object Panel4: TPanel
Left = 0
Top = 507
Top = 501
Width = 674
Height = 35
Align = alBottom
+118 -22
View File
@@ -1,7 +1,7 @@
unit Main;
{ copyright (c)2002 Eric Fredricksen all rights reserved }
{$UNDEF CHEATS}
{$DEFINE CHEATS}
{$UNDEF LOGGING}
interface
@@ -12,13 +12,14 @@ uses
const
// revs:
// 5: pq 6.3
// 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=5';
wmIconTray = WM_USER + Ord('t');
kFileExt = '.pq';
kFileExt = '.pq3';
type
TMainForm = class(TForm)
@@ -104,6 +105,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 +149,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);
@@ -322,6 +327,11 @@ 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 +352,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 +443,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 protection of the good ' + 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|1|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 := Result + ' of the ' + Pick(K.Races.Lines);
1: Result := Result + ' 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 +526,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 +591,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 +644,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
@@ -626,10 +720,10 @@ begin
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 per level
Result := 20 * level * 60;
end;
procedure TMainForm.GoButtonClick(Sender: TObject);
@@ -915,10 +1009,13 @@ begin
Width := Width-1;
end;
end;
WinItem;
WinEquip;
SaveGame;
Brag('a');
end;
{$IFDEF LOGGING}
procedure TMainForm.Log(line: String);
var
@@ -1128,11 +1225,13 @@ begin
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,8 +1239,9 @@ begin
Hint := IntToStr(100 * Position div Max) + '% complete';
end;
with PlotBar do if Position >= Max
then CompleteAct
// advance plot
if gain then with PlotBar do if Position >= Max
then InterplotCinematic
else Position := Position + TaskBar.Max div 1000;
//Time.Caption := FormatDateTime('h:mm:ss',PlotBar.Position / (24.0 * 60 * 60));
@@ -1153,7 +1253,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;
@@ -1231,7 +1331,7 @@ end;
const
KUsage =
'Usage: pq [flags] [game.pq]'#10 +
'Usage: pq [flags] [game.pq3]'#10 +
#10 +
'Flags:'#10 +
' -no-backup Do not make a backup file when saving the game'#10 +
@@ -1395,10 +1495,6 @@ begin
f.Free;
except
on EZCompressionError do begin
// backwards-compatibility
//m.Free;
//m := f;
//f := nil;
ShowMessage('Error loading game.');
Close;
Exit;
BIN
View File
Binary file not shown.
+6 -5
View File
@@ -1,6 +1,6 @@
object NewGuyForm: TNewGuyForm
Left = 203
Top = 146
Left = 693
Top = 336
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')
'Birdrider'
'Vermineer')
TabOrder = 1
end
object GroupBox1: TGroupBox
+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.
+3 -6
View File
@@ -1,12 +1,9 @@
[contents of readme]
ProgressQuest v6.2 (probably as released)
-----------------------------------------
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.2 (but I had two copies
around, so I'm not positive this is the final one, and not the previous
rev checked in)
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.)
BIN
View File
Binary file not shown.
BIN
View File
Binary file not shown.
+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.
BIN
View File
Binary file not shown.
+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?
BIN
View File
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.