Hi All,
I am running Linux Ubuntu 10.10 LTS with Lazarus latest version updated
2 days ago
And WINE running Delphi 5 Enterprise Update 2 and 7 Enterprise (not sure
what update) (c) 2002
After installing D5E and D7E I used CCleaner 2.2 (in WINE) to fix the
missing file errors & registry problems.
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<General>
<MainUnit Value="0"/>
<TargetFileExt Value=""/>
<Title Value="island_maker"/>
<Icon Value="0"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|
xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T
'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh
$(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Unit0>
<Filename Value="island_maker.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="island_maker"/>
<CursorPos X="20" Y="5"/>
<TopLine Value="1"/>
<UsageCount Value="20"/>
<SyntaxHighlighter Value="Delphi"/>
</Unit0>
</Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>
Hint: Start of reading config file /etc/fpc.cfg
Hint: End of reading config file /etc/fpc.cfg
Free Pascal Compiler version 2.4.0-2 [2010/03/06] for i386
Copyright (c) 1993-2009 by Florian Klaempfl
Target OS: Linux for i386
Compiling island_maker1.lpr
island_maker1.lpr(12,1) Fatal: Syntax error, "identifier" expected but
"BEGIN" found
--
Love and Friendship, Peter Eric Williams
+61 3 6236-9675 (home or leave a message) Mobile 044-99-256-50
Proudly created in Australia. Quality Cross-Platform Games since 1970
with a Commodore PET 4016 with 16 Kilobytes of RAM (not Megabytes).
program island_maker;
uses
Forms,
Unit1 in 'set_max.pas' {Form1},
Unit2 in 'main_island.pas' {Form2},
{$R *.res}
begin
Application.Initialize;
Application.Title := 'PEWs Digital Terrain Island Maker';
Application.CreateForm(TForm2, Form2);
Application.Run;
end.
initialization
{$I main_island.lrs}
object main_island: TForm1
Left = 77
Height = 588
Top = 100
Width = 792
Caption = 'Here is your random island. It was started at * and finished at @.'
ClientHeight = 554
ClientWidth = 792
Font.Height = -11
Font.Name = 'MS Sans Serif'
Menu = MainMenu1
OnCreate = FormCreate
ParentFont = False
LCLVersion = '0.9.26'
object Memo1: TMemo
Height = 554
Width = 792
Align = alClient
Alignment = taCenter
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Times New Roman'
ParentFont = False
ScrollBars = ssBoth
TabOrder = 0
end
object MainMenu1: TMainMenu
left = 120
top = 16
object File1: TMenuItem
Caption = '&File'
object CreateaNewIsland1: TMenuItem
Caption = '&Create a New Island'
OnClick = CreateaNewIsland1Click
end
object SaveIslandtoFile1: TMenuItem
Caption = '&Save Island to File'
OnClick = SaveIslandtoFile1Click
end
end
object Options1: TMenuItem
Caption = '&Options'
object SetHorizontalMaxSize1: TMenuItem
Caption = 'Set &Maximum Size'
OnClick = SetHorizontalMaxSize1Click
end
end
end
object SaveDialog1: TSaveDialog
DefaultExt = '.txt'
Filter = 'Text Files|*.txt'
left = 168
top = 16
end
end
unit main_island;
{$MODE Delphi}
{ Digital Terrain Model Maker - Island Maker1
Language: Lazarus for Linux
Author: Peter E. Williams
Date: 22 May 2010
Version: 2.5 alpha
Ported from:
Language: Delphi 5.0 Std
Author: Peter E. Williams
Date: 2 June 2000
Version: 0.01 beta
Description: The original idea for this program was to write a random
island DTM generator which goes on a random walk defining the
_outline_ of the island. Therefore, it was my original intention
that areas of "sea" which are land-locked should in some later process
be marked as land (since the program is really only defining a
coast-line).
Island map is generated starting with a "*" and ending with a "@".
All points in between go in the sequence A..Z..1..9 and repeat. This
is simply to show the sequence in which the points were generated.
Next steps would required an expanded "map_detail" record.
The classical next steps would be to:
(a) mark land-locked water as land,
(b) randomly pick a point of land then go on a "short" random
walk to define the top of a mountain range,
(c) do same as (b) but for a valley,
(d) run an algorithm to graduate the elevation levels of land
between mountain range and valley.
(e) generate a few number of random spots and define them
as towns.
(f) do a series of "short" random walks (similar to (b)) to
define vegetation types, roads, railroads, rivers, etc.
Obviously river flows would be determined by elevation
levels. Logically roads and railroads would connect towns
[placed in (e)] so would be logical to _start_
roads/railroads random walks at these points.
I have had a good book which discusses these types of algorithms
which I bought many years ago... it's called "Games Programming".
If anyone's interested I'll be happy to post the details of it
when I get home - or I'll bring it along to the next SIG I go to.
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, LResources;
const
array_max_x = 1000;
array_max_y = 1000;
default_max_x = 90; // horizontal
default_max_y = 35; // vertical
type
TForm1 = class(TForm)
Memo1: TMemo;
MainMenu1: TMainMenu;
File1: TMenuItem;
CreateaNewIsland1: TMenuItem;
SaveIslandtoFile1: TMenuItem;
SaveDialog1: TSaveDialog;
Options1: TMenuItem;
SetHorizontalMaxSize1: TMenuItem;
procedure show_island;
procedure make_an_island;
procedure FormCreate(Sender: TObject);
procedure CreateaNewIsland1Click(Sender: TObject);
procedure SaveIslandtoFile1Click(Sender: TObject);
procedure SetHorizontalMaxSize1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Terrain_type = (Land, Sea);
map_detail = record
Terrain : Terrain_type;
Terrain_char : char;
end;
island_type = array[ 1..array_max_x, 1..array_max_y ] of
map_detail;
var
Form1: TForm1;
island : island_type;
max_x, max_y : integer;
implementation
uses set_max;
{--------------------------------------------------------------------}
procedure blank_island;
var
j,k : integer;
begin
for j := 1 to max_x do
for k := 1 to max_y do
begin
island[ j,k ].Terrain := Sea;
island[ j,k ].Terrain_char := '.';
end;
end; { blank_island }
{--------------------------------------------------------------------}
{ N
3 4 5
W 2 6 E
1 8 7
S
}
procedure define_island_outline;
var
got_good_dir : boolean;
current_x, current_y,
old_direction, new_direction,
j : integer;
max_loop : longint;
char1 : char;
begin
current_x := random( max_x ) + 1;
current_y := random( max_y ) + 1;
old_direction := 4; // north
char1 := '9'; // this will mean that the sequence starts with an "A"
island[ current_x, current_y ].Terrain := Land;
island[ current_x, current_y ].Terrain_char := '*';
max_loop := trunc( max_x * max_y / 1.575 ); // gives 2000 for 35 x 90
for j := 1 to max_loop do
begin
repeat
new_direction := random( 8 ) + 1;
got_good_dir := true;
// we don't want to go straight back where we came from
if abs(new_direction - old_direction) = 4 then
got_good_dir := false;
// next 4 tests are to keep from going outside the bounds of the map.
if (new_direction in [ 5..7 ]) and (current_x >= max_x) then
got_good_dir := false;
if (new_direction in [ 3..5 ]) and (current_y <= 1) then
got_good_dir := false;
if (new_direction in [ 1..3 ]) and (current_x <= 1) then
got_good_dir := false;
if (new_direction in [ 1,7,8 ]) and (current_y >= max_y) then
got_good_dir := false;
until got_good_dir;
case new_direction of
1..3 : current_x := current_x - 1;
5..7 : current_x := current_x + 1;
end;
case new_direction of
3..5 : current_y := current_y - 1;
1,7,8 : current_y := current_y + 1;
end;
if not ((current_x in [ 1..max_x ]) and (current_y in [ 1..max_y ])) then
begin
showmessage( 'Error [index(es) out of range]:' + #13 +
'current_x = ' + inttostr( current_x ) + #13 +
'current_y = ' + inttostr( current_y ) + #13 +
'new_direction = ' + inttostr( new_direction) + #13 +
'old_direction = ' + inttostr( old_direction) );
if current_x < 1 then
current_x := 1;
if current_x > max_x then
current_x := max_x;
if current_y < 1 then
current_y := 1;
if current_y > max_y then
current_y := max_y;
end
else
begin
// first land_char is '*', last is '@'
if j = max_loop then
island[ current_x, current_y ].Terrain_char := '@'
else
begin
if island[ current_x, current_y ].Terrain = Sea then
begin
island[ current_x, current_y ].Terrain := Land;
// land_char will be A..Z..1..9 then repeat
if char1 = '9' then
char1 := 'A'
else
char1 := chr( ord( char1 ) + 1 );
if char1 > 'Z' then
char1 := '1';
island[ current_x, current_y ].Terrain_char := char1;
old_direction := new_direction;
end; // then
end; // else
end; // else
end; // for j
end; { define_island_outline }
{--------------------------------------------------------------------}
procedure tform1.show_island;
var
temp_str1 : string;
j, k : integer;
begin
memo1.lines.clear;
for j := 1 to max_y do
begin
temp_str1 := '';
for k := 1 to max_x do
{ case island[ j, k ].Terrain of
Land : temp_str1 := temp_str1 + '*';
Sea : temp_str1 := temp_str1 + '.';
end; }
temp_str1 := temp_str1 + island[ k,j ].Terrain_char;
memo1.lines.add( temp_str1 );
end;
end; { show_island }
{--------------------------------------------------------------------}
procedure tform1.make_an_island;
begin
blank_island;
define_island_outline;
show_island;
end; { make_an_island }
{--------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
randomize;
memo1.font.Name := 'Courier New';
memo1.font.Size := 8;
max_x := default_max_x; // horizontal
max_y := default_max_y; // vertical
make_an_island;
end; { FormCreate }
{--------------------------------------------------------------------}
procedure TForm1.CreateaNewIsland1Click(Sender: TObject);
begin
make_an_island;
end; { CreateaNewIsland1Click }
{--------------------------------------------------------------------}
procedure TForm1.SaveIslandtoFile1Click(Sender: TObject);
begin
if savedialog1.execute then
memo1.Lines.SaveToFile( savedialog1.filename );
end; { SaveIslandtoFile1Click }
{--------------------------------------------------------------------}
procedure TForm1.SetHorizontalMaxSize1Click(Sender: TObject);
begin
form2 := tform2.create( nil );
try
form2.max_x.text := inttostr( max_x );
form2.max_y.text := inttostr( max_y );
if form2.showmodal = mrOK then
begin
try
max_x := strtoint( form2.max_x.text );
except
showmessage( 'Error: Value for Max_x is not a valid number.');
end;
try
max_y := strtoint( form2.max_y.text );
except
showmessage( 'Error: Value for Max_y is not a valid number.');
end;
if (max_x < 1) or (max_x > array_max_x) then
begin
max_x := default_max_x;
showmessage( 'Error: Max_x out of range.' );
end;
if (max_y < 1) or (max_y > array_max_y) then
begin
max_y := default_max_y;
showmessage( 'Error: Max_y out of range.' );
end;
end;
finally
end;
end; { SetHorizontalMaxSize1Click }
{--------------------------------------------------------------------}
initialization
{$i main_island.lrs}
end.
unit set_max;
{$MODE Delphi}
interface
uses
{Windows,} {Messages,} SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, LResources;
type
{ TForm2 }
TForm2 = class(TForm)
max_x: TEdit;
max_y: TEdit;
Label1: TLabel;
Label2: TLabel;
Cancel_button: TButton;
OK_button: TButton;
Label3: TLabel;
Label4: TLabel;
procedure OK_buttonClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
Uses Unit1;
{ TForm2 }
procedure TForm2.OK_buttonClick(Sender: TObject);
begin
CreateaNewIsland1Click(Sender);
end;
initialization
{$i set_max.lrs}
end.
--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
