diff --git a/noise/noise.pas b/noise/noise.pas new file mode 100644 index 000000000..2196be0c1 --- /dev/null +++ b/noise/noise.pas @@ -0,0 +1,56 @@ +unit noise; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +interface + +uses + Classes, SysUtils; + +function IntNoise(x: Integer): Double; + +function Linear_Interpolate(a, b, x: Double): Double; +function Cosine_Interpolate(a, b, x: Double): Double; +function Cubic_Interpolate(v0, v1, v2, v3, x: Double): Double; + +implementation + +function IntNoise(x: Integer): Double; +var + xl: Integer; +begin + xl := (x shl 13) xor x; + Result := (xl * (xl * xl * 15731 + 789221) + 1376312589) and $7fffffff; + Result := 1.0 - (Result / 1073741824.0); +end; + +function Linear_Interpolate(a, b, x: Double): Double; +begin + Result := a * (1-x) + b * x; +end; + +function Cosine_Interpolate(a, b, x: Double): Double; +var + f, ft: Double; +begin + ft := x * Pi; + f := (1.0 - cos(ft)) * 0.5; + Result := a * (1 - f) + b * f; +end; + +function Cubic_Interpolate(v0, v1, v2, v3, x: Double): Double; +var + P, Q, R, S: Double; +begin + P := (v3 - v2) - (v0 - v1); + Q := (v0 - v1) - P; + R := v2 - v0; + S := v1; + + Result := P * x * x * x + Q * x * x + R * x + S; +end; + +end. + diff --git a/noise/noise1d.dpr b/noise/noise1d.dpr new file mode 100644 index 000000000..2711dbcf7 --- /dev/null +++ b/noise/noise1d.dpr @@ -0,0 +1,113 @@ +program noise1d; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + {$ifdef fpc} + Interfaces, // this includes the LCL widgetset + {$endif} + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + noise; + +type + + { TMainWindow } + + TMainWindow = class(TForm) + private + { private declarations } + SelectInterpolation: TComboBox; + procedure DoPaint(Sender: TObject); + procedure DoRefresh(Sender: TObject); + function NormalizeNoise(x: Double): Integer; + public + { public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + +var + vMainWindow: TMainWindow; + +{ TMainWindow } + +procedure TMainWindow.DoPaint(Sender: TObject); +var + i, j, interpolation: Integer; +begin + { Draws rulers } + Canvas.MoveTo(25, 25 ); + Canvas.LineTo(25, 275); + Canvas.LineTo(275, 275); + + { Draws 12 points and the interpolation between them } + for i := 0 to 11 do + begin + Canvas.Ellipse(i * 20 + 25 + 1, NormalizeNoise(IntNoise(i)) + 1, + i * 20 + 25 - 1, NormalizeNoise(IntNoise(i)) - 1); + + if (i = 11) then Continue; + + for j := 1 to 19 do + begin + case SelectInterpolation.ItemIndex of + 0: interpolation := Linear_Interpolate(NormalizeNoise(IntNoise(i)), NormalizeNoise(IntNoise(i + 1)), j / 20); + 1: interpolation := Cosine_Interpolate(NormalizeNoise(IntNoise(i)), NormalizeNoise(IntNoise(i + 1)), j / 20); + else + interpolation := Cubic_Interpolate(NormalizeNoise(IntNoise(i - 1)), + NormalizeNoise(IntNoise(i)), NormalizeNoise(IntNoise(i + 1)), + NormalizeNoise(IntNoise(i + 2)), j / 20); + end; + + Canvas.Pixels[i * 20 + 25 + j, interpolation] := clBlack; + end; + end; +end; + +procedure TMainWindow.DoRefresh(Sender: TObject); +begin + Repaint; +end; + +function TMainWindow.NormalizeNoise(x: Double): Integer; +begin + Result := Round( 25 + (x + 1.0) * 125 ); +end; + +constructor TMainWindow.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Position := poScreenCenter; + Width := 300; + Height := 300; + Caption := 'Noise 1D'; + + OnPaint := DoPaint; + + SelectInterpolation := TComboBox.Create(Self); + SelectInterpolation.Parent := Self; + SelectInterpolation.Items.Add('Linear Interpolation'); + SelectInterpolation.Items.Add('Cosine Interpolation'); + SelectInterpolation.Items.Add('Cubic Interpolation'); + SelectInterpolation.Left := 100; + SelectInterpolation.Width := 200; + SelectInterpolation.ItemIndex := 0; + + SelectInterpolation.OnChange := DoRefresh; +end; + +destructor TMainWindow.Destroy; +begin + + inherited Destroy; +end; + +begin + Application.Initialize; + Application.CreateForm(TMainWindow, vMainWindow); + Application.Run; +end. + diff --git a/noise/noise1d.lpi b/noise/noise1d.lpi new file mode 100644 index 000000000..e7d117815 --- /dev/null +++ b/noise/noise1d.lpi @@ -0,0 +1,131 @@ + + + + + + + + + + + <ActiveEditorIndexAtStart Value="0"/> + </General> + <VersionInfo> + <ProjectVersion Value=""/> + <Language Value=""/> + <CharSet Value=""/> + </VersionInfo> + <PublishOptions> + <Version Value="2"/> + <DestinationDirectory Value="$(TestDir)\publishedproject\"/> + <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="7"> + <Unit0> + <Filename Value="noise1d.dpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="noise1d"/> + <CursorPos X="40" Y="76"/> + <TopLine Value="58"/> + <EditorIndex Value="0"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + </Unit0> + <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"/> + <IsPartOfProject Value="True"/> + <UnitName Value="noise"/> + <CursorPos X="1" Y="18"/> + <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> + <JumpHistory Count="0" HistoryIndex="-1"/> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <PathDelim Value="\"/> + <SearchPaths> + <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/> + </SearchPaths> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </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> diff --git a/noise/perlin1d.dpr b/noise/perlin1d.dpr new file mode 100644 index 000000000..5f92da3e3 --- /dev/null +++ b/noise/perlin1d.dpr @@ -0,0 +1,170 @@ +program perlin1d; + +{$ifdef fpc} + {$mode delphi} +{$endif} + +uses + {$ifdef fpc} + Interfaces, // this includes the LCL widgetset + {$endif} + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + noise; + +type + + { TMainWindow } + + TMainWindow = class(TForm) + private + { private declarations } + G1, G2, G3, G4: array of double; + SelectInterpolation: TComboBox; + procedure DoPaint(Sender: TObject); + procedure DoRefresh(Sender: TObject); + procedure DoPaintGraph(Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer); + procedure DoCalculateNoise(Graph: array of Double; WL, NPoints: Integer); + function NormalizeNoise(x: Double; Amplitude: Integer): Integer; + public + { public declarations } + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + end; + +var + vMainWindow: TMainWindow; + +{ TMainWindow } + +procedure TMainWindow.DoPaint(Sender: TObject); +begin + SetLength(G1, 20 * 12); + DoCalculateNoise(G1, 20, 12); + DoPaintGraph(G1, 25, 25, 20, 250, 12); + +{ SetLength(G3, 40 * 6); + DoPaintGraph(G2, 325, 25, 40, 125, 6); + + SetLength(G3, 80 * 3); + DoPaintGraph(G3, 25, 325, 80, 62, 3);} +end; + +procedure TMainWindow.DoRefresh(Sender: TObject); +begin + Repaint; +end; + +{******************************************************************* +* TMainWindow.DoCalculateNoise () +* +* DESCRIPTION: Creates a array with a 1D Noise plus interpolation +* +* PARAMETERS: Graph - Array to store the points +* WL - Wavelength in units. +* Those are filled with interpolation +* NPoints - Number of Noise points to be created +* +*******************************************************************} +procedure TMainWindow.DoCalculateNoise(Graph: array of Double; WL, NPoints: Integer); +var + i, j: Integer; + interpolation: Double; +begin + for i := 0 to NPoints - 1 do + begin + Graph[i * WL] := IntNoise(i); + + if (i = NPoints - 1) then Continue; + + for j := 1 to WL - 1 do + begin + case SelectInterpolation.ItemIndex of + 0: interpolation := Linear_Interpolate(IntNoise(i), IntNoise(i + 1), j / WL); + 1: interpolation := Cosine_Interpolate(IntNoise(i), IntNoise(i + 1), j / WL); + else + interpolation := Cubic_Interpolate(IntNoise(i - 1), IntNoise(i), + IntNoise(i + 1), IntNoise(i + 2), j / WL); + end; + + Graph[i * WL + j] := interpolation; + end; + end; +end; + +{******************************************************************* +* TMainWindow.DoPaintGraph () +* +* DESCRIPTION: Draws a graphic that represents a 1D Noise function +* +* PARAMETERS: Graph - Array to store the points +* StartX - Starting X position for the graphic +* StartY - Starting Y position for the graphic +* WL - Wavelength in pixels +* A - Amplitude in pixels +* NPoints - Number of points to be drawn +* +*******************************************************************} +procedure TMainWindow.DoPaintGraph(Graph: array of Double; StartX, StartY, WL, A, NPoints: Integer); +var + i, j: Integer; +begin + { Draws rulers } + Canvas.MoveTo(StartX, StartY ); + Canvas.LineTo(StartX, StartY + 250); + Canvas.LineTo(StartX + 250, StartY + 250); + + { Draws NPoints points and the interpolation between them } + for i := 0 to NPoints - 1 do + begin + Canvas.Ellipse(i * WL + StartX + 1, NormalizeNoise(Graph[i], A) + StartY + 1, + i * WL + StartX - 1, NormalizeNoise(Graph[i], A) + StartY - 1); + + if (i = NPoints - 1) then Continue; + + for j := 1 to WL - 1 do + begin + Canvas.Pixels[i * WL + StartX + j, NormalizeNoise(Graph[i * WL + j], A) + StartY] := clBlack; + end; + end; +end; + +function TMainWindow.NormalizeNoise(x: Double; Amplitude: Integer): Integer; +begin + Result := Round( 125 + x * Amplitude / 2 ); +end; + +constructor TMainWindow.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + Position := poScreenCenter; + Width := 600; + Height := 600; + Caption := 'Perlin Noise 1D'; + + OnPaint := DoPaint; + + SelectInterpolation := TComboBox.Create(Self); + SelectInterpolation.Parent := Self; + SelectInterpolation.Items.Add('Linear Interpolation'); + SelectInterpolation.Items.Add('Cosine Interpolation'); + SelectInterpolation.Items.Add('Cubic Interpolation'); + SelectInterpolation.Left := 100; + SelectInterpolation.Width := 200; + SelectInterpolation.ItemIndex := 0; + + SelectInterpolation.OnChange := DoRefresh; +end; + +destructor TMainWindow.Destroy; +begin + + inherited Destroy; +end; + +begin + Application.Initialize; + Application.CreateForm(TMainWindow, vMainWindow); + Application.Run; +end. + diff --git a/noise/perlin1d.lpi b/noise/perlin1d.lpi new file mode 100644 index 000000000..3c7e60633 --- /dev/null +++ b/noise/perlin1d.lpi @@ -0,0 +1,210 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="\"/> + <Version Value="5"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + </Flags> + <MainUnit Value="0"/> + <IconPath Value="./"/> + <TargetFileExt Value=".exe"/> + <ActiveEditorIndexAtStart Value="0"/> + </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> + <Units Count="5"> + <Unit0> + <Filename Value="perlin1d.dpr"/> + <IsPartOfProject Value="True"/> + <CursorPos X="1" Y="41"/> + <TopLine Value="29"/> + <EditorIndex Value="0"/> + <UsageCount Value="21"/> + <Loaded Value="True"/> + </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> + <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> + <CompilerOptions> + <Version Value="5"/> + <PathDelim Value="\"/> + <SearchPaths> + <OtherUnitFiles Value="$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\;$(LazarusDir)\lcl\units\$(TargetCPU)-$(TargetOS)\$(LCLWidgetType)\"/> + <SrcPath Value="$(LazarusDir)\lcl\;$(LazarusDir)\lcl\interfaces\$(LCLWidgetType)\"/> + </SearchPaths> + <CodeGeneration> + <Generate Value="Faster"/> + </CodeGeneration> + <Other> + <CompilerPath Value="$(CompPath)"/> + </Other> + </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>