LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   A simple shader that adds an outline to an object. 
6

7
   Limitations:  
8
       1. Object can be transparent (color alpha < 1) if it doesn't
9
                   overlap itself. Texture transparency doesn't work.
10
       2. Doesn't work with objects (e.g. TGLFreeForm) having it's own
11
                   color array.
12
       3. Doesn't Works with visible backfaces.
13

14
    History :  
15
       12/02/11 - Yar - Added skipping shader when enabled stencil test to avvoid conflict with shadow volume
16
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
17
       22/04/10 - Yar - Fixes after GLState revision
18
       05/03/10 - DanB - More state added to TGLStateCache
19
       06/06/07 - DaStr - Added $I GLScene.inc
20
                             Added GLColor to uses (BugtrackerID = 1732211)
21
       25/02/07 - DaStr - Moved registration to GLSceneRegister.pas
22
       05/06/04 - NelC - Fixed bug with textured object
23
       14/12/03 - NelC - Removed BlendLine, automatically determine if blend
24
       20/10/03 - NelC - Removed unnecessary properties. Shader now honors
25
                            rci.ignoreMaterials.
26
       04/09/03 - NelC - Converted into a component from the TOutlineShader
27
                            in the multipass demo.
28
    
29
}
30
unit GLOutlineShader;
31

32
interface
33

34
{$I GLScene.inc}
35

36
uses
37
  Classes, GLMaterial, GLCrossPlatform, GLColor, GLRenderContextInfo;
38

39
type
40

41
  // TGLOutlineShader
42
  //
43
  TGLOutlineShader = class(TGLShader)
44
  private
45
     
46
    FPassCount: integer;
47
    FLineColor: TGLColor;
48
    FOutlineSmooth: Boolean;
49
    FOutlineWidth: Single;
50

51
    procedure SetOutlineWidth(v: single);
52
    procedure SetOutlineSmooth(v: boolean);
53

54
  protected
55
     
56
    procedure DoApply(var rci: TGLRenderContextInfo; Sender: TObject); override;
57
    function DoUnApply(var rci: TGLRenderContextInfo): Boolean; override;
58

59
  public
60
     
61
    constructor Create(AOwner: TComponent); override;
62
    destructor Destroy; override;
63

64
  published
65
     
66
    property LineColor: TGLColor read FLineColor write FLineColor;
67
    { Line smoothing control }
68
    property LineSmooth: Boolean read FOutlineSmooth write SetOutlineSmooth
69
      default false;
70
    property LineWidth: Single read FOutlineWidth write SetOutlineWidth;
71
  end;
72

73
  // ------------------------------------------------------------------
74
  // ------------------------------------------------------------------
75
  // ------------------------------------------------------------------
76
implementation
77
// ------------------------------------------------------------------
78
// ------------------------------------------------------------------
79
// ------------------------------------------------------------------
80

81
uses OpenGLTokens, GLContext, GLState, GLTextureFormat;
82

83
// ------------------
84
// ------------------ TGLOutlineShader ------------------
85
// ------------------
86

87
// Create
88
//
89

90
constructor TGLOutlineShader.Create(AOwner: TComponent);
91
begin
92
  inherited;
93
  FOutlineSmooth := False;
94
  FOutLineWidth := 2;
95
  FLineColor := TGLColor.CreateInitialized(Self, clrBlack);
96
  ShaderStyle := ssLowLevel;
97
end;
98

99
// Destroy
100
//
101

102
destructor TGLOutlineShader.Destroy;
103
begin
104
  FLineColor.Free;
105
  inherited;
106
end;
107

108
// DoApply
109
//
110

111
procedure TGLOutlineShader.DoApply(var rci: TGLRenderContextInfo; Sender:
112
  TObject);
113
begin
114
  // We first draw the object as usual in the first pass. This allows objects
115
  // with color alpha < 1 to be rendered correctly with outline.
116
  FPassCount := 1;
117
end;
118

119
// DoUnApply
120
//
121

122
function TGLOutlineShader.DoUnApply(var rci: TGLRenderContextInfo): Boolean;
123
begin
124
  if rci.ignoreMaterials or (stStencilTest in rci.GLStates.States) then
125
  begin
126
    Result := False;
127
    Exit;
128
  end;
129
  case FPassCount of
130
    1:
131
      with rci.GLStates do
132
      begin
133
        // Now set up to draw the outline in the second pass
134

135
        Disable(stLighting);
136

137
        if FOutlineSmooth then
138
        begin
139
          LineSmoothHint := hintNicest;
140
          Enable(stLineSmooth);
141
        end
142
        else
143
          Disable(stLineSmooth);
144

145
        if FOutlineSmooth or (FlineColor.Alpha < 1) then
146
        begin
147
          Enable(stBlend);
148
          SetBlendFunc(bfSrcAlpha, bfOneMinusSrcAlpha);
149
        end
150
        else
151
          Disable(stBlend);
152

153
        GL.Color4fv(FlineColor.AsAddress);
154
        LineWidth := FOutlineWidth;
155
        Disable(stLineStipple);
156
        PolygonMode := pmLines;
157
        CullFaceMode := cmFront;
158
        DepthFunc := cfLEqual;
159
        ActiveTextureEnabled[ttTexture2D] := False;
160

161
        FPassCount := 2;
162
        Result := True; // go for next pass
163
      end;
164
    2:
165
      with rci.GLStates do
166
      begin
167
        // Restore settings
168
        PolygonMode := pmFill;
169
        CullFaceMode := cmBack;
170
        DepthFunc := cfLequal;
171
        Result := False; // we're done
172
      end;
173
  else
174
    Assert(False);
175
    Result := False;
176
  end;
177
end;
178

179
// SetOutlineWidth
180
//
181

182
procedure TGLOutlineShader.SetOutlineWidth(v: single);
183
begin
184
  if FOutlineWidth <> v then
185
  begin
186
    FOutlineWidth := v;
187
    NotifyChange(self);
188
  end;
189
end;
190

191
// SetOutlineSmooth
192
//
193

194
procedure TGLOutlineShader.SetOutlineSmooth(v: boolean);
195
begin
196
  if FOutlineSmooth <> v then
197
  begin
198
    FOutlineSmooth := v;
199
    NotifyChange(self);
200
  end;
201
end;
202

203
end.
204

205