LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   A shader that renders hidden (back-faced) lines differently from visible
6
   (front) lines. Polygon offset is used to displace fragments depths a little
7
   so that there is no z-fighting in rendering the same geometry multiple times.
8

9
    History :  
10
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
11
       22/04/10 - Yar - Fixes after GLState revision
12
       05/03/10 - DanB - More state added to TGLStateCache
13
       06/06/07 - DaStr - Added $I GLScene.inc
14
                             Added GLColor to uses (BugtrackerID = 1732211)
15
       25/02/07 - DaStr - Moved registration to GLSceneRegister.pas
16
       25/09/04 - NelC - Fixed bug of disabled blend (thx Carlos)
17
       05/02/04 - NelC - Fixed memory leak in TGLHiddenLineShader.Destroy (thx Achim Hammes)
18
       13/12/03 - NelC - Added SurfaceLit, ShadeModel
19
       05/12/03 - NelC - Added ForceMaterial
20
       03/12/03 - NelC - Creation. Modified from the HiddenLineShader in
21
                            the multipass demo.
22
    
23
}
24
unit GLHiddenLineShader;
25

26
interface
27

28
{$I GLScene.inc}
29

30
uses
31
  Classes,
32
  GLMaterial, OpenGLTokens, GLCrossPlatform, GLScene, GLColor,
33
  GLBaseClasses, GLRenderContextInfo, GLState, GLContext;
34

35
type
36
  TGLLineSettings = class(TGLUpdateAbleObject)
37
  private
38
     
39
    FColor: TGLColor;
40
    FWidth: Single;
41
    FPattern: TGLushort;
42

43
    FForceMaterial: Boolean;
44

45
    procedure SetPattern(const value: TGLushort);
46
    procedure SetColor(const v: TGLColor);
47
    procedure SetWidth(const Value: Single);
48
    procedure SetForceMaterial(v: boolean);
49

50
  public
51
     
52
    constructor Create(AOwner: TPersistent); override;
53
    destructor Destroy; override;
54
    procedure Apply(var rci: TGLRenderContextInfo);
55
    procedure UnApply(var rci: TGLRenderContextInfo);
56

57
  published
58
     
59
    property Width: Single read FWidth write SetWidth;
60
    property Color: TGLColor read FColor write SetColor;
61
    property Pattern: TGLushort read FPattern write SetPattern default $FFFF;
62
    { Set ForceMaterial to true to enforce the application of the line settings
63
       for objects that sets their own color, line width and pattern. }
64
    property ForceMaterial: Boolean read FForceMaterial write SetForceMaterial
65
      default false;
66
  end;
67

68
  TGLHiddenLineShader = class(TGLShader)
69
  private
70
    FPassCount: integer;
71

72
    FLineSmooth: Boolean;
73
    FSolid: Boolean;
74

75
    FBackGroundColor: TGLColor;
76

77
    FFrontLine: TGLLineSettings;
78
    FBackLine: TGLLineSettings;
79

80
    FLighting: Boolean;
81
    FShadeModel: TGLShadeModel;
82

83
    procedure SetlineSmooth(v: boolean);
84
    procedure SetSolid(v: boolean);
85
    procedure SetBackgroundColor(AColor: TGLColor);
86
    procedure SetLighting(v: boolean);
87
    procedure SetShadeModel(const val: TGLShadeModel);
88

89
  protected
90
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
91
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
92

93
  public
94
     
95
    constructor Create(AOwner: TComponent); override;
96
    destructor Destroy; override;
97

98
  published
99
     
100
    property FrontLine: TGLLineSettings read FFrontLine write FFrontLine;
101
    property BackLine: TGLLineSettings read FBackLine write FBackLine;
102
    { Line smoothing control }
103
    property LineSmooth: Boolean read FlineSmooth write SetlineSmooth default
104
      false;
105
    { Solid controls if you can see through the front-line wireframe. }
106
    property Solid: Boolean read FSolid write SetSolid default false;
107
    { Color used for solid fill. }
108
    property BackgroundColor: TGLColor read FBackgroundColor write
109
      SetBackgroundColor;
110
    { When Solid is True, determines if lighting or background color is used. }
111
    property SurfaceLit: Boolean read FLighting write SetLighting default true;
112
    { Shade model.
113
       Default is "Smooth". }
114
    property ShadeModel: TGLShadeModel read FShadeModel write SetShadeModel
115
      default smDefault;
116
  end;
117

118
  // ------------------------------------------------------------------
119
  // ------------------------------------------------------------------
120
  // ------------------------------------------------------------------
121
implementation
122
// ------------------------------------------------------------------
123
// ------------------------------------------------------------------
124
// ------------------------------------------------------------------
125
// ------------------
126
// ------------------ TGLLineSettings ------------------
127
// ------------------
128

129
// Create
130
//
131

132
constructor TGLLineSettings.Create(AOwner: TPersistent);
133
begin
134
  inherited;
135
  FColor := TGLColor.Create(Self);
136
  FColor.Initialize(clrGray20);
137
  FWidth := 2;
138
  Pattern := $FFFF;
139
  ForceMaterial := false;
140
end;
141

142
// Destroy
143
//
144

145
destructor TGLLineSettings.Destroy;
146
begin
147
  FColor.Free;
148
  inherited;
149
end;
150

151
// SetPattern
152
//
153

154
procedure TGLLineSettings.SetPattern(const value: TGLushort);
155
begin
156
  if FPattern <> value then
157
  begin
158
    FPattern := Value;
159
    NotifyChange(self);
160
  end;
161
end;
162

163
// SetColor
164
//
165

166
procedure TGLLineSettings.SetColor(const v: TGLColor);
167
begin
168
  FColor.Color := v.Color;
169
  NotifyChange(Self);
170
end;
171

172
// SetWidth
173
//
174

175
procedure TGLLineSettings.SetWidth(const Value: Single);
176
begin
177
  FWidth := Value;
178
  NotifyChange(Self);
179
end;
180

181
var
182
  IgnoreMatSave: boolean;
183

184
  // Apply
185
  //
186

187
procedure TGLLineSettings.Apply(var rci: TGLRenderContextInfo);
188
begin
189
  rci.GLStates.LineWidth := Width;
190
  GL.Color4fv(Color.AsAddress);
191
  if Pattern <> $FFFF then
192
  begin
193
    rci.GLStates.Enable(stLineStipple);
194
    rci.GLStates.LineStippleFactor := 1;
195
    rci.GLStates.LineStipplePattern := Pattern;
196
  end
197
  else
198
    rci.GLStates.Disable(stLineStipple);
199

200
  if ForceMaterial then
201
  begin
202
    IgnoreMatSave := rci.ignoreMaterials;
203
    rci.ignoreMaterials := true;
204
  end;
205
end;
206

207
// UnApply
208
//
209

210
procedure TGLLineSettings.UnApply(var rci: TGLRenderContextInfo);
211
begin
212
  if ForceMaterial then
213
    rci.ignoreMaterials := IgnoreMatSave;
214
end;
215

216
// SetForceMaterial
217
//
218

219
procedure TGLLineSettings.SetForceMaterial(v: boolean);
220
begin
221
  if FForceMaterial <> v then
222
  begin
223
    FForceMaterial := v;
224
    NotifyChange(self);
225
  end;
226
end;
227

228
// ------------------
229
// ------------------ TGLHiddenLineShader ------------------
230
// ------------------
231

232
// Create
233
//
234

235
constructor TGLHiddenLineShader.Create(AOwner: TComponent);
236
begin
237
  inherited;
238
  FFrontLine := TGLLineSettings.Create(self);
239
  FBackLine := TGLLineSettings.Create(self);
240
  FSolid := false;
241

242
  FBackgroundColor := TGLColor.Create(Self);
243
  FBackgroundColor.Initialize(clrBtnFace);
244

245
  FLineSmooth := False;
246
  FLighting := true;
247
  FShadeModel := smDefault;
248
end;
249

250
// Destroy
251
//
252

253
destructor TGLHiddenLineShader.Destroy;
254
begin
255
  FFrontLine.Free;
256
  FBackLine.Free;
257
  FBackgroundColor.Free;
258
  inherited;
259
end;
260

261
// DoApply
262
//
263

264
procedure TGLHiddenLineShader.DoApply(var rci: TGLRenderContextInfo; Sender:
265
  TObject);
266
begin
267
  FPassCount := 1;
268

269
  if solid then
270
    with rci.GLStates do
271
    begin
272
      // draw filled front faces in first pass
273
      PolygonMode := pmFill;
274
      CullFaceMode := cmBack;
275

276
      if FLighting then
277
      begin
278
        case ShadeModel of
279
          smDefault, smSmooth: GL.ShadeModel(GL_SMOOTH);
280
          smFlat: GL.ShadeModel(GL_FLAT);
281
        end
282
      end
283
      else
284
      begin
285
        Disable(stLighting);
286
        GL.Color4fv(FBackgroundColor.AsAddress); // use background color
287
      end;
288
      // enable and adjust polygon offset
289
      Enable(stPolygonOffsetFill);
290
    end
291
  else
292
    with rci.GLStates do
293
    begin
294
      Disable(stLighting);
295
      // draw back lines in first pass
296
      FBackLine.Apply(rci);
297
      CullFaceMode := cmFront;
298
      PolygonMode := pmLines;
299
      // enable and adjust polygon offset
300
      Enable(stPolygonOffsetLine);
301
    end;
302

303
  rci.GLStates.SetPolygonOffset(1, 2);
304
end;
305

306
// DoUnApply
307
//
308

309
function TGLHiddenLineShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean;
310

311
  procedure SetLineSmoothBlend;
312
  begin
313
    with rci.GLStates do
314
    begin
315
      LineStippleFactor := 1;
316
      LineStipplePattern := $FFFF;
317
      if LineSmooth then
318
      begin
319
        LineSmoothHint := hintNicest;
320
        Enable(stLineSmooth);
321
      end
322
      else
323
        Disable(stLineSmooth);
324

325
      if LineSmooth or (FBackLine.FColor.Alpha < 1)
326
        or (FFrontLine.FColor.Alpha < 1) then
327
      begin
328
        Enable(stBlend);
329
        SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
330
      end
331
      else
332
        Disable(stBlend);
333
    end;
334
  end;
335

336
begin
337
  case FPassCount of
338
    1:
339
      with rci.GLStates do begin
340
        // draw front line in 2nd pass
341
        FPassCount := 2;
342

343
        FBackLine.UnApply(rci);
344
        FFrontLine.Apply(rci);
345

346
        SetLineSmoothBlend;
347

348
        if solid and FLighting then
349
          Disable(stLighting);
350

351
        PolygonMode := pmLines;
352
        CullFaceMode := cmBack;
353

354
        if solid then
355
          rci.GLStates.Disable(stPolygonOffsetFill)
356
        else
357
          rci.GLStates.Disable(stPolygonOffsetLine);
358

359
        Result := True;
360
      end;
361
    2:
362
      begin
363
        FFrontLine.UnApply(rci);
364
        rci.GLStates.PolygonMode := pmFill;
365
        Result := false;
366
      end;
367
  else
368
    Assert(False);
369
    Result := False;
370
  end;
371
end;
372

373
// SetBackgroundColor
374
//
375

376
procedure TGLHiddenLineShader.SetBackgroundColor(AColor: TGLColor);
377
begin
378
  FBackgroundColor.Color := AColor.Color;
379
  NotifyChange(Self);
380
end;
381

382
// SetlineSmooth
383
//
384

385
procedure TGLHiddenLineShader.SetlineSmooth(v: boolean);
386
begin
387
  if FlineSmooth <> v then
388
  begin
389
    FlineSmooth := v;
390
    NotifyChange(self);
391
  end;
392
end;
393

394
// SetLighting
395
//
396

397
procedure TGLHiddenLineShader.SetLighting(v: boolean);
398
begin
399
  if FLighting <> v then
400
  begin
401
    FLighting := v;
402
    NotifyChange(self);
403
  end;
404
end;
405

406
// SetSolid
407
//
408

409
procedure TGLHiddenLineShader.SetSolid(v: boolean);
410
begin
411
  if FSolid <> v then
412
  begin
413
    FSolid := v;
414
    NotifyChange(self);
415
  end;
416
end;
417

418
// SetShadeModel
419
//
420

421
procedure TGLHiddenLineShader.SetShadeModel(const val: TGLShadeModel);
422
begin
423
  if FShadeModel <> val then
424
  begin
425
    FShadeModel := val;
426
    NotifyChange(Self);
427
  end;
428
end;
429

430
end.
431

432