paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Improved Perlin Noise code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@42 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2006-12-25 18:29:00 +00:00
parent 9855a9f624
commit 42867fef5f
4 changed files with 40 additions and 252 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
noise/noise1d.dpr
View File

@ -53,12 +53,11 @@ begin
for j := 1 to 19 do for j := 1 to 19 do
begin begin
case SelectInterpolation.ItemIndex of case SelectInterpolation.ItemIndex of
0: interpolation := Linear_Interpolate(NormalizeNoise(IntNoise(i)), NormalizeNoise(IntNoise(i + 1)), j / 20); 0: interpolation := NormalizeNoise(Linear_Interpolate(IntNoise(i), IntNoise(i + 1), j / 20));
1: interpolation := Cosine_Interpolate(NormalizeNoise(IntNoise(i)), NormalizeNoise(IntNoise(i + 1)), j / 20); 1: interpolation := NormalizeNoise(Cosine_Interpolate(IntNoise(i), IntNoise(i + 1), j / 20));
else else
interpolation := Cubic_Interpolate(NormalizeNoise(IntNoise(i - 1)), interpolation := NormalizeNoise(Cubic_Interpolate(IntNoise(i - 1),
NormalizeNoise(IntNoise(i)), NormalizeNoise(IntNoise(i + 1)), IntNoise(i), IntNoise(i + 1), IntNoise(i + 2), j / 20));
NormalizeNoise(IntNoise(i + 2)), j / 20);
end; end;
Canvas.Pixels[i * 20 + 25 + j, interpolation] := clBlack; Canvas.Pixels[i * 20 + 25 + j, interpolation] := clBlack;

78
noise/noise1d.lpi
View File

@ -1,23 +1,20 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="\"/> <PathDelim Value="/"/>
<Version Value="5"/> <Version Value="5"/>
<General> <General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=""/> <TargetFileExt Value=""/>
<Title Value="noise1d"/> <Title Value="noise1d"/>
<ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo> </VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IgnoreBinaries Value="False"/> <IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
@ -25,7 +22,7 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="1"> <RequiredPackages Count="1">
@ -33,70 +30,23 @@
<PackageName Value="LCL"/> <PackageName Value="LCL"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="7"> <Units Count="2">
<Unit0> <Unit0>
<Filename Value="noise1d.dpr"/> <Filename Value="noise1d.dpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="noise1d"/> <UnitName Value="noise1d"/>
<CursorPos X="40" Y="76"/>
<TopLine Value="58"/>
<EditorIndex Value="0"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="..\lazarus\lcl\forms.pp"/>
<UnitName Value="Forms"/>
<CursorPos X="19" Y="599"/>
<TopLine Value="583"/>
<UsageCount Value="10"/>
</Unit1>
<Unit2>
<Filename Value="..\lazarus\lcl\controls.pp"/>
<UnitName Value="Controls"/>
<CursorPos X="22" Y="43"/>
<TopLine Value="28"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="..\lazarus\lcl\lclclasses.pp"/>
<UnitName Value="LCLClasses"/>
<CursorPos X="3" Y="32"/>
<TopLine Value="15"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="noise.pas"/> <Filename Value="noise.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="noise"/> <UnitName Value="noise"/>
<CursorPos X="1" Y="18"/> </Unit1>
<TopLine Value="1"/>
<EditorIndex Value="1"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
</Unit4>
<Unit5>
<Filename Value="animated_clouds\noise1d.lpr"/>
<UnitName Value="noise1d"/>
<CursorPos X="1" Y="1"/>
<TopLine Value="1"/>
<UsageCount Value="10"/>
</Unit5>
<Unit6>
<Filename Value="..\lazarus\lcl\stdctrls.pp"/>
<UnitName Value="StdCtrls"/>
<CursorPos X="14" Y="318"/>
<TopLine Value="303"/>
<UsageCount Value="10"/>
</Unit6>
</Units> </Units>
<JumpHistory Count="0" HistoryIndex="-1"/>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths> <SearchPaths>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/> <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>
@ -112,20 +62,4 @@
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging>
<BreakPoints Count="1">
<Item1>
<Source Value="..\lazarus\lcl\include\bitmap.inc"/>
<Line Value="765"/>
</Item1>
</BreakPoints>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG> </CONFIG>

36
noise/perlin1d.dpr
View File

@ -22,8 +22,8 @@ type
SelectInterpolation: TComboBox; SelectInterpolation: TComboBox;
procedure DoPaint(Sender: TObject); procedure DoPaint(Sender: TObject);
procedure DoRefresh(Sender: TObject); procedure DoRefresh(Sender: TObject);
procedure DoPaintGraph(Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer); procedure DoPaintGraph(var Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer);
procedure DoCalculateNoise(Graph: array of Double; WL, NPoints: Integer); procedure DoCalculateNoise(var Graph: array of Double; WL, NPoints: Integer);
function NormalizeNoise(x: Double; Amplitude: Integer): Integer; function NormalizeNoise(x: Double; Amplitude: Integer): Integer;
public public
{ public declarations } { public declarations }
@ -37,16 +37,30 @@ var
{ TMainWindow } { TMainWindow }
procedure TMainWindow.DoPaint(Sender: TObject); procedure TMainWindow.DoPaint(Sender: TObject);
var
i: Integer;
begin begin
SetLength(G1, 20 * 12); SetLength(G1, 20 * 12);
DoCalculateNoise(G1, 20, 12); DoCalculateNoise(G1, 20, 12);
DoPaintGraph(G1, 25, 25, 20, 250, 12); DoPaintGraph(G1, 25, 25, 20, 250, 12);
Canvas.TextOut(60, 15, '1st Harmonic');
{ SetLength(G3, 40 * 6); SetLength(G2, 10 * 24);
DoPaintGraph(G2, 325, 25, 40, 125, 6); DoCalculateNoise(G2, 10, 24);
DoPaintGraph(G2, 325, 25, 10, 125, 24);
Canvas.TextOut(460, 15, '2nd Harmonic');
SetLength(G3, 80 * 3); SetLength(G3, 5 * 48);
DoPaintGraph(G3, 25, 325, 80, 62, 3);} DoCalculateNoise(G3, 5, 48);
DoPaintGraph(G3, 25, 325, 5, 62, 48);
Canvas.TextOut(60, 315, '3rd Harmonic');
{ The 4th graphic is a the sum of the first 3, using the amplitudes to
ponderate the values }
SetLength(G4, 20 * 12);
for i := 0 to 20 * 12 - 1 do G4[i] := ( G1[i] * 250 + G2[i] * 125 + G3[i] * 62 ) / (250 + 125 + 62);
DoPaintGraph(G4, 325, 325, 20, 250, 12);
Canvas.TextOut(460, 315, 'Perlin Noise');
end; end;
procedure TMainWindow.DoRefresh(Sender: TObject); procedure TMainWindow.DoRefresh(Sender: TObject);
@ -65,7 +79,7 @@ end;
* NPoints - Number of Noise points to be created * NPoints - Number of Noise points to be created
* *
*******************************************************************} *******************************************************************}
procedure TMainWindow.DoCalculateNoise(Graph: array of Double; WL, NPoints: Integer); procedure TMainWindow.DoCalculateNoise(var Graph: array of Double; WL, NPoints: Integer);
var var
i, j: Integer; i, j: Integer;
interpolation: Double; interpolation: Double;
@ -104,7 +118,7 @@ end;
* NPoints - Number of points to be drawn * NPoints - Number of points to be drawn
* *
*******************************************************************} *******************************************************************}
procedure TMainWindow.DoPaintGraph(Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer); procedure TMainWindow.DoPaintGraph(var Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer);
var var
i, j: Integer; i, j: Integer;
begin begin
@ -116,8 +130,8 @@ begin
{ Draws NPoints points and the interpolation between them } { Draws NPoints points and the interpolation between them }
for i := 0 to NPoints - 1 do for i := 0 to NPoints - 1 do
begin begin
Canvas.Ellipse(i * WL + StartX + 1, NormalizeNoise(Graph[i], A) + StartY + 1, Canvas.Ellipse(i * WL + StartX + 1, NormalizeNoise(Graph[i * WL], A) + StartY + 1,
i * WL + StartX - 1, NormalizeNoise(Graph[i], A) + StartY - 1); i * WL + StartX - 1, NormalizeNoise(Graph[i * WL], A) + StartY - 1);
if (i = NPoints - 1) then Continue; if (i = NPoints - 1) then Continue;
@ -149,7 +163,7 @@ begin
SelectInterpolation.Items.Add('Linear Interpolation'); SelectInterpolation.Items.Add('Linear Interpolation');
SelectInterpolation.Items.Add('Cosine Interpolation'); SelectInterpolation.Items.Add('Cosine Interpolation');
SelectInterpolation.Items.Add('Cubic Interpolation'); SelectInterpolation.Items.Add('Cubic Interpolation');
SelectInterpolation.Left := 100; SelectInterpolation.Left := 200;
SelectInterpolation.Width := 200; SelectInterpolation.Width := 200;
SelectInterpolation.ItemIndex := 0; SelectInterpolation.ItemIndex := 0;

169
noise/perlin1d.lpi
View File

@ -1,7 +1,7 @@
<?xml version="1.0"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="\"/> <PathDelim Value="/"/>
<Version Value="5"/> <Version Value="5"/>
<General> <General>
<Flags> <Flags>
@ -9,19 +9,16 @@
<MainUnitHasCreateFormStatements Value="False"/> <MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/> <MainUnitHasTitleStatement Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <IconPath Value="./"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/> <ProjectVersion Value=""/>
<Language Value=""/>
<CharSet Value=""/>
</VersionInfo> </VersionInfo>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions> </PublishOptions>
@ -31,158 +28,18 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<Units Count="5"> <Units Count="1">
<Unit0> <Unit0>
<Filename Value="perlin1d.dpr"/> <Filename Value="perlin1d.dpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<CursorPos X="1" Y="41"/>
<TopLine Value="29"/>
<EditorIndex Value="0"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1>
<Filename Value="noise.pas"/>
<UnitName Value="noise"/>
<CursorPos X="14" Y="36"/>
<TopLine Value="25"/>
<EditorIndex Value="1"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\lazarus\lcl\lclclasses.pp"/>
<UnitName Value="LCLClasses"/>
<CursorPos X="13" Y="26"/>
<TopLine Value="19"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="..\..\fpc\rtl\inc\mathh.inc"/>
<CursorPos X="12" Y="29"/>
<TopLine Value="28"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="..\..\fpc\rtl\inc\systemh.inc"/>
<CursorPos X="14" Y="96"/>
<TopLine Value="94"/>
<UsageCount Value="10"/>
</Unit4>
</Units> </Units>
<JumpHistory Count="26" HistoryIndex="25">
<Position1>
<Filename Value="perlin1d.dpr"/>
<Caret Line="13" Column="48" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="perlin1d.dpr"/>
<Caret Line="128" Column="1" TopLine="112"/>
</Position2>
<Position3>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="33" TopLine="54"/>
</Position3>
<Position4>
<Filename Value="perlin1d.dpr"/>
<Caret Line="78" Column="8" TopLine="65"/>
</Position4>
<Position5>
<Filename Value="perlin1d.dpr"/>
<Caret Line="71" Column="16" TopLine="59"/>
</Position5>
<Position6>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="33" TopLine="54"/>
</Position6>
<Position7>
<Filename Value="perlin1d.dpr"/>
<Caret Line="144" Column="23" TopLine="129"/>
</Position7>
<Position8>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="14" TopLine="54"/>
</Position8>
<Position9>
<Filename Value="perlin1d.dpr"/>
<Caret Line="25" Column="26" TopLine="69"/>
</Position9>
<Position10>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="21" TopLine="49"/>
</Position10>
<Position11>
<Filename Value="perlin1d.dpr"/>
<Caret Line="62" Column="64" TopLine="49"/>
</Position11>
<Position12>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="33" TopLine="54"/>
</Position12>
<Position13>
<Filename Value="noise.pas"/>
<Caret Line="14" Column="28" TopLine="1"/>
</Position13>
<Position14>
<Filename Value="noise.pas"/>
<Caret Line="38" Column="15" TopLine="13"/>
</Position14>
<Position15>
<Filename Value="noise.pas"/>
<Caret Line="26" Column="42" TopLine="13"/>
</Position15>
<Position16>
<Filename Value="noise.pas"/>
<Caret Line="38" Column="14" TopLine="25"/>
</Position16>
<Position17>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="33" TopLine="54"/>
</Position17>
<Position18>
<Filename Value="perlin1d.dpr"/>
<Caret Line="62" Column="1" TopLine="54"/>
</Position18>
<Position19>
<Filename Value="perlin1d.dpr"/>
<Caret Line="4" Column="16" TopLine="1"/>
</Position19>
<Position20>
<Filename Value="perlin1d.dpr"/>
<Caret Line="67" Column="7" TopLine="54"/>
</Position20>
<Position21>
<Filename Value="perlin1d.dpr"/>
<Caret Line="41" Column="17" TopLine="28"/>
</Position21>
<Position22>
<Filename Value="perlin1d.dpr"/>
<Caret Line="86" Column="49" TopLine="66"/>
</Position22>
<Position23>
<Filename Value="perlin1d.dpr"/>
<Caret Line="84" Column="11" TopLine="69"/>
</Position23>
<Position24>
<Filename Value="perlin1d.dpr"/>
<Caret Line="82" Column="83" TopLine="69"/>
</Position24>
<Position25>
<Filename Value="perlin1d.dpr"/>
<Caret Line="95" Column="28" TopLine="78"/>
</Position25>
<Position26>
<Filename Value="perlin1d.dpr"/>
<Caret Line="94" Column="68" TopLine="69"/>
</Position26>
</JumpHistory>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths> <SearchPaths>
<OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\;$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)\"/> <OtherUnitFiles Value="$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)/"/>
<SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/> <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/"/>
</SearchPaths> </SearchPaths>
<CodeGeneration> <CodeGeneration>
<Generate Value="Faster"/> <Generate Value="Faster"/>
@ -191,20 +48,4 @@
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Debugging>
<BreakPoints Count="1">
<Item1>
<Source Value="..\lazarus\lcl\include\bitmap.inc"/>
<Line Value="765"/>
</Item1>
</BreakPoints>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG> </CONFIG>