LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Creates a single strand of hair using verlet classes. Can be used to simulate
6
   ropes, fur or hair.
7

8
	 History :  
9
       29/05/08 - DaStr - Added $I GLScene.inc
10
       06/03/04 - MF - Creation
11
    
12
}
13
unit GLVerletHairClasses;
14

15
interface
16

17
{$I GLScene.inc}
18

19
uses
20
  Classes, SysUtils,
21
  GLVerletTypes, GLVectorTypes, GLVectorLists, GLVectorGeometry;
22

23
type
24
  TVHStiffness = (vhsFull, vhsSkip1Node, vhsSkip2Node, vhsSkip3Node,
25
    vhsSkip4Node, vhsSkip5Node, vhsSkip6Node, vhsSkip7Node, vhsSkip8Node,
26
    vhsSkip9Node);
27
  TVHStiffnessSet = set of TVHStiffness;
28

29
  TGLVerletHair = class
30
  private
31
    FNodeList: TVerletNodeList;
32
    FLinkCount: integer;
33
    FRootDepth: single;
34
    FVerletWorld: TGLVerletWorld;
35
    FHairLength: single;
36
    FData: pointer;
37
    FStiffness: TVHStiffnessSet;
38
    FStiffnessList : TList;
39
    function GetAnchor: TVerletNode;
40
    function GetRoot: TVerletNode;
41
    function GetLinkLength: single;
42
    procedure AddStickStiffness(const ANodeSkip : integer);
43
    procedure SetStiffness(const Value: TVHStiffnessSet);
44
  public
45
    procedure BuildHair(const AAnchorPosition, AHairDirection: TAffineVector);
46

47
    procedure BuildStiffness;
48
    procedure ClearStiffness;
49
    procedure Clear;
50

51
    constructor Create(const AVerletWorld : TGLVerletWorld;
52
      const ARootDepth, AHairLength : single; ALinkCount : integer;
53
      const AAnchorPosition, AHairDirection : TAffineVector;
54
      const AStiffness : TVHStiffnessSet);
55

56
    destructor Destroy; override;
57

58
    property NodeList : TVerletNodeList read FNodeList;
59
    property VerletWorld : TGLVerletWorld read FVerletWorld;
60

61
    property RootDepth : single read FRootDepth;
62
    property LinkLength : single read GetLinkLength;
63
    property LinkCount : integer read FLinkCount;
64
    property HairLength : single read FHairLength;
65

66
    property Stiffness : TVHStiffnessSet read FStiffness write SetStiffness;
67

68
    property Data : pointer read FData write FData;
69

70
    { Anchor should be nailed down to give the hair stability }
71
    property Anchor : TVerletNode read GetAnchor;
72

73
    { Root should be nailed down to give the hair stability }
74
    property Root : TVerletNode read GetRoot;
75
  end;
76

77
implementation
78

79
{ TGLVerletHair }
80

81
procedure TGLVerletHair.AddStickStiffness(const ANodeSkip: integer);
82
var
83
  i : integer;
84
begin
85
  for i := 0 to NodeList.Count-(1+ANodeSkip*2) do
86
    FStiffnessList.Add(VerletWorld.CreateStick(NodeList[i], NodeList[i+2*ANodeSkip]));
87
end;
88

89
procedure TGLVerletHair.BuildHair(const AAnchorPosition, AHairDirection: TAffineVector);
90
var
91
  i : integer;
92
  Position : TAffineVector;
93
  Node, PrevNode : TVerletNode;
94
  Direction : TAffineVector;
95
begin
96
  Clear;
97

98
  Direction := VectorNormalize(AHairDirection);
99

100
  // Fix the root of the hair
101
  Position := VectorAdd(AAnchorPosition, VectorScale(Direction, -FRootDepth));
102
  Node := VerletWorld.CreateOwnedNode(Position);
103
  NodeList.Add(Node);
104
  Node.NailedDown := true;
105
  PrevNode := Node;
106

107
  // Now add the links in the hair
108
  for i := 0 to FLinkCount-1 do
109
  begin
110
    Position := VectorAdd(AAnchorPosition, VectorScale(Direction, HairLength * (i/LinkCount)));
111

112
    Node := VerletWorld.CreateOwnedNode(Position);
113
    NodeList.Add(Node);
114

115
    // first one is the anchor
116
    if i=0 then
117
      Node.NailedDown := true
118
    else
119
      // Create the hair link
120
      VerletWorld.CreateStick(PrevNode, Node);
121

122
    PrevNode := Node;
123
  end;
124

125
  // Now we must stiffen the hair with either sticks or springs
126
  BuildStiffness;
127
end;
128

129
procedure TGLVerletHair.BuildStiffness;
130
var
131
  i : integer;
132
begin
133
  ClearStiffness;
134

135
  if vhsFull in FStiffness then
136
  begin
137
    for i := 1 to 100 do
138
      AddStickStiffness(i);
139
      
140
    exit;
141
  end;
142

143
  if vhsSkip1Node in FStiffness then AddStickStiffness(1);
144
  if vhsSkip2Node in FStiffness then AddStickStiffness(2);
145
  if vhsSkip3Node in FStiffness then AddStickStiffness(3);
146
  if vhsSkip4Node in FStiffness then AddStickStiffness(4);
147
  if vhsSkip5Node in FStiffness then AddStickStiffness(5);
148
  if vhsSkip6Node in FStiffness then AddStickStiffness(6);
149
  if vhsSkip7Node in FStiffness then AddStickStiffness(7);
150
  if vhsSkip8Node in FStiffness then AddStickStiffness(8);
151
  if vhsSkip9Node in FStiffness then AddStickStiffness(9);
152
end;
153

154
procedure TGLVerletHair.Clear;
155
var
156
  i : integer;
157
begin
158
  ClearStiffness;
159
  for i := FNodeList.Count-1 downto 0 do
160
    FNodeList[i].Free;
161

162
  FNodeList.Clear;
163
  FStiffnessList.Clear;
164
end;
165

166
procedure TGLVerletHair.ClearStiffness;
167
var
168
  i : integer;
169
begin
170
  for i := 0 to FStiffnessList.Count-1 do
171
    TVerletConstraint(FStiffnessList[i]).Free;
172

173
  FStiffnessList.Clear;
174
end;
175

176
constructor TGLVerletHair.Create(const AVerletWorld : TGLVerletWorld;
177
      const ARootDepth, AHairLength : single; ALinkCount : integer;
178
      const AAnchorPosition, AHairDirection : TAffineVector;
179
      const AStiffness : TVHStiffnessSet);
180
begin
181
  FVerletWorld := AVerletWorld;
182
  FRootDepth := ARootDepth;
183
  FLinkCount := ALinkCount;
184
  FHairLength := AHairLength;
185

186
  FNodeList := TVerletNodeList.Create;
187
  FStiffness := AStiffness;
188
  FStiffnessList := TList.Create;
189

190
  BuildHair(AAnchorPosition, AHairDirection);
191
end;
192

193
destructor TGLVerletHair.Destroy;
194
begin
195
  Clear;
196
  FreeAndNil(FNodeList);
197
  FreeAndNil(FStiffnessList);
198
  inherited;
199
end;
200

201
function TGLVerletHair.GetAnchor: TVerletNode;
202
begin
203
  result := NodeList[1];
204
end;
205

206
function TGLVerletHair.GetLinkLength: single;
207
begin
208
  if LinkCount>0 then
209
    result := HairLength / LinkCount
210
  else
211
    result := 0;
212
end;
213

214
function TGLVerletHair.GetRoot: TVerletNode;
215
begin
216
  result := NodeList[0];
217
end;
218

219
procedure TGLVerletHair.SetStiffness(const Value: TVHStiffnessSet);
220
begin
221
  FStiffness := Value;
222
  BuildStiffness;
223
end;
224

225
end.
226