-
Notifications
You must be signed in to change notification settings - Fork 0
/
uOpenGL.pas
1725 lines (1507 loc) · 58.7 KB
/
uOpenGL.pas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
unit uOpenGL;
interface
uses Windows, OpenGL, uConst, uFrustum, uTexture, uFont, uCamera, uSkyBox;
const
{===== ERROR CONSTANTS =====}
error_GetDC = -1;
error_ChoosePixelFormat = -2; //describePixelFormat erbij nog ?..
error_SetPixelFormat = -3;
error_MakeRC = -4;
error_MakeCurrent = -5;
error_CreatingTexture = -6;
error_GenList = -7;
// DefaultFogColor : TGLArrayf4 = (0.1, 0.1, 0.1, 1.0);
DefaultFogColor : TGLArrayf4 = (1.0, 1.0, 1.0, 1.0);
const
// Projectie Typen
ptOrthogonal = 1;
ptPerspective = 2;
ptFrustum = 3;
type
TRightAngle = (Angle0=0,Angle90=90,Angle180=180,Angle270=270);
// een rectangle met floating point boundries (in bereik[0.0 .. 1.0])
TFRect = record
// padding (percentages van de gehele venster-breedte & -hoogte)
top, left, bottom, right: Single;
// vaste padding waarden (in pixels)
pxTop, pxLeft, pxBottom, pxRight: Integer;
end;
TProjection = record
ProjectionType: integer;
Width, Height: integer;
Center: TPoint;
// De padding (tussen venster en viewport)
// (waarden in bereik[0..1])
// Dit zijn percentages van de gehele viewport-breedte & -hoogte.
// Een waarde van 0.5 voor .left zorgt ervoor dat er aan de linkerkant
// langs de viewport een ruimte open is, die de helft van het venster breed is.
ViewPortRect: TFRect;
//
Left,Right,
Bottom,Top,
zNear,zFar: Extended;
FOVY: Extended;
end;
POGL = ^TOGL;
TOGL = class(TObject)
private
// Camera's
local_Camera: TCamera; // de camera voor intern OpenGL gebruik
// tbv. de properties
local_WinHandle: HWND; // Windows handle Form
local_DC: HDC; // Windows handle Device-Context
local_RC: HGLRC; // OpenGL handle Render-Context
local_Width, // huidige form breedte
local_Height: integer; // huidige form hoogte
local_Active, // actief
local_Paused, // gepauzeerd
local_FullScreen, // volledig scherm
local_Fog: boolean; // mist
local_Projection: TProjection; // projectie
local_FPS, // het aantal beelden per seconde
local_FPSCount: integer; //
local_LastFrameTime: single; // de tijdsduur die nodig was om het laatste beeld te renderen
PerformanceFreq, PerformanceCount, LastPerformanceCount: Int64;
IsSetupFor2D: boolean; // ingesteld op 2D??
// de camera(-rotatie) met de muis besturen
local_MouseLook: boolean;
//-- /properties
Palette : hPalette; //OpenGL palette
local_VSync,
OldVSync: GLint; // de instelling van de VSync opvragen om te herstellen na afloop App.
N_TextureUnits: Integer; //aantal texture units aanwezig..
procedure SetupFullScreen(State: boolean); // van/naar volledig scherm omschakelen
procedure SetupFog(State: boolean); overload; // mist in/uitschakelen
procedure Init; // OpenGL instellingen
// tbv. de properties
{procedure SetWinHandle(const Value: HWND);}
function GetActive : Boolean;
{procedure SetActive(const Value: boolean);}
procedure SetPaused(const Value: boolean);
procedure SetFullScreen(const Value: boolean);
procedure SetMouseLook(const Value: boolean);
procedure SetFog(const Value: boolean);
function GetCenter: TPoint;
function GetHeight: integer;
function GetWidth: integer;
// OpenGL EXTENSIONS
procedure GetExtensionProcs;
//
published
property WinHandle: HWND read local_WinHandle;
property DC: HDC read local_DC;
property RC: HGLRC read local_RC;
property Active: boolean read GetActive;
property Paused: boolean read local_Paused write SetPaused;
property FullScreen: boolean read local_FullScreen write SetFullScreen;
property MouseLook: boolean read local_MouseLook write SetMouseLook;
property Fog: boolean read local_Fog write SetFog;
property Width: integer read GetWidth; // breedte van het hele grafische scherm
property Height: integer read GetHeight; // hoogte van het hele grafische scherm
property Center: TPoint read GetCenter; // centrum van het hele grafische scherm
public
// objecten
Frustum: TFrustum; // het frustum
Textures: TObjTexture; // textures
Fonts: TGLFonts; // lettertypen
Camera: PCamera; // Een pointer naar de camera
SkyBox: TSkyBox; // de SkyBox
// this.object
constructor Create;
destructor Destroy; override;
// reset camera naar de lokale camera
procedure ResetCamera;
// projectie
procedure SetupViewPort(aProjection: TProjection);
procedure Resize(NewWidth, NewHeight: integer);
procedure SetupProjection; overload;
procedure SetupProjection(Width,Height: integer; fLeft,fRight,fBottom,fTop,fNear,fFar: Extended); overload; //frustum
procedure SetupProjection(Width,Height: integer; FOVY, pNear,pFar: Extended); overload; //perspective
procedure SetupProjection(Width,Height: integer; oLeft,oRight,oBottom,oTop: Extended); overload; //ortho
procedure SetupProjectionPicking(const X,Y, W,H: integer);
procedure SetupFor2D;
// omzetten van 2D scherm-coordinaten (/form-coords) naar 3D object-coordinaten.
procedure ScreenToObjectCoords(const ScreenX, ScreenY: integer; var X,Y,Z: GLdouble);
// een ray-richting berekenen van vector door muis-cursorpos van near-plane naar far-plane
// (tbv. selecteren van dingen in de 3D-wereld)
procedure CalcMouseRay(const ScreenX,ScreenY: integer; var X,Y,Z: GLdouble);
// fullscreen
procedure ToggleFullScreen;
//de camera(-rotatie) met de muis besturen
procedure ToggleMouseLook;
// fog
procedure SetupFog(Mode: Cardinal; Density, StartDepth,EndDepth: Single; const FogColor: TGLArrayf4; Hint: Cardinal); overload;
procedure SetupFog(Density, StartDepth, EndDepth: Single; const FogColor: TGLArrayf4); overload;
procedure ToggleFog;
// OpenGL in-/uit-schakelen
procedure Enable(WindowHandle: HWND); // OpenGL inschakelen
procedure Disable; // OpenGL uitschakelen
procedure DoBufferSwap; // doublebuffer swap
procedure MakeCurrent; // rendercontext actief maken
procedure ReportErrorAndQuit(ErrorCode: integer);
// OpenGL EXTENSIONS
function ExtensionSupported(Ext: string) : boolean;
procedure PushMatrices; // push de projection- & modelview-matrices
procedure PopMatrices; // pop de modelview- & projection-matrices
// Windows fonts 3D & 2D
procedure PrintXY(X,Y: integer; const Value: string; R,G,B: Single); overload;
procedure PrintXY(FontIndex:integer; X,Y: integer; const Value: string; R,G,B: Single); overload;
procedure PrintLine(Row: integer; const Value: string; VAlign: TLineVAlignment; R,G,B: Single); overload;
procedure PrintLine(FontIndex:integer; Row: integer; const Value: string; VAlign: TLineVAlignment; R,G,B: Single); overload;
// monitor refresh rate control
function MonitorRefreshRate: Integer;
function GetVSync(var OnOff: boolean) : boolean; //resultaat = true als het instellen is gelukt, anders false
function SetVSync(OnOff: boolean) : boolean; overload; //resultaat = true als het instellen is gelukt, anders false
function SetVSync(OnOff: integer) : boolean; overload; //resultaat = true als het instellen is gelukt, anders false
procedure ToggleVSync;
//
function GetMaxTextureUnits : GLint;
// FPS meting
procedure FPSTimer; // de routine die elke seconde dient te worden aangeroepen
procedure MeasureFPS; // de routine die na elke frame-render dient te worden aangeroepen
function GetFPS : integer;
function GetLastFrameTime : single;
//=== sub-routines die werken met 2D scherm-coördinaten
// 2D vlakken tekenen (met alpha-blending)
procedure AlphaRectangle2D(Rectangle: TRect; R,G,B,A: Single); overload;
procedure AlphaRectangle2D(Rectangle: TRect; R,G,B,A: Single; BlendSRC,BlendDST: Cardinal); overload;
// 2D vlakken tekenen (met texture)
procedure TexturedRectangle2D(Rectangle: TRect; R,G,B,A: Single; TextureHandle: GLuint; AngleCCW: TRightAngle); overload;
// 2D vlakken tekenen (met texture en een masker)
procedure TexturedRectangle2D(Rectangle: TRect; R,G,B,A: Single; TextureHandle, MaskHandle: GLuint; AngleCCW: TRightAngle); overload;
// 2D vlak met kleuren verloop
procedure ColoredRectangle2D(Rectangle:TRect; Rtop,Gtop,Btop,Rbottom,Gbottom,Bbottom:Single); overload;
procedure ColoredRectangle2D(Rectangle:TRect; ColorTop,ColorBottom: dword); overload;
// 2D punt tekenen
procedure Point2D(ScrPx_X, ScrPx_Y: integer; R,G,B,A: Single; PointSize: single);
// 2D lijn tekenen
procedure Line2D(ScrP1,ScrP2: TPoint; R,G,B,A: Single; LineWidth: single);
end;
// OpenGL 1.2, 1.4, 1.5 & 2.0 constanten, functies & procedures
type
PGLvoid = Pointer;
GLintptrARB = Integer;
PGLintptrARB = ^GLintptrARB;
GLsizeiptrARB = Integer;
PGLsizeiptrARB = ^GLsizeiptrARB;
GLUquadric = record end; PGLUquadric = ^GLUquadric;
GLUquadricObj = GLUquadric; PGLUquadricObj = PGLUquadric; // backwards compatibility:
const
// Multi-texturing
GL_MAX_TEXTURE_UNITS_ARB = $84E2;
GL_TEXTURE0_ARB = $84C0;
GL_TEXTURE0 = $84C0;
GL_TEXTURE1_ARB = $84C1;
GL_TEXTURE1 = $84C1;
GL_TEXTURE2_ARB = $84C2;
GL_TEXTURE2 = $84C2;
GL_TEXTURE3_ARB = $84C3;
GL_TEXTURE3 = $84C3;
// Fog extensions
GL_FOG_COORDINATE_SOURCE_EXT = $8450;
GL_FOG_COORDINATE_SOURCE = $8450;
GL_FOG_COORD_SOURCE = $8450;
GL_FOG_COORD_SRC = $8450;
GL_FOG_COORDINATE_EXT = $8451;
GL_FOG_COORDINATE = $8451;
GL_FOG_COORD = $8451;
GL_FRAGMENT_DEPTH = $8452;
GL_CURRENT_FOG_COORDINATE = $8453;
GL_CURRENT_FOG_COORD = $8453;
GL_FOG_COORDINATE_ARRAY_TYPE = $8454;
GL_FOG_COORD_ARRAY_TYPE = $8454;
GL_FOG_COORDINATE_ARRAY_STRIDE = $8455;
GL_FOG_COORD_ARRAY_STRIDE = $8455;
GL_FOG_COORDINATE_ARRAY_POINTER = $8456;
GL_FOG_COORD_ARRAY_POINTER = $8456;
GL_FOG_COORDINATE_ARRAY = $8457;
GL_FOG_COORD_ARRAY = $8457;
GL_VERTEX_ARRAY = $8074;
GL_NORMAL_ARRAY = $8075;
GL_COLOR_ARRAY = $8076;
GL_INDEX_ARRAY = $8077;
GL_TEXTURE_COORD_ARRAY = $8078;
GL_CLAMP_TO_EDGE = $812F; // GL 1.2
GL_POLYGON_OFFSET_UNITS = $2A00;
GL_POLYGON_OFFSET_POINT = $2A01;
GL_POLYGON_OFFSET_LINE = $2A02;
GL_POLYGON_OFFSET_FILL = $8037;
GL_POLYGON_OFFSET_FACTOR = $8038;
GL_COMBINE = $8570;
GL_COMBINE_RGB = $8571;
GL_COMBINE_ALPHA = $8572;
GL_RGB_SCALE = $8573;
GL_ADD_SIGNED = $8574;
GL_INTERPOLATE = $8575;
GL_CONSTANT = $8576;
GL_PRIMARY_COLOR = $8577;
GL_PREVIOUS = $8578;
GL_SOURCE0_RGB = $8580;
GL_SOURCE1_RGB = $8581;
GL_SOURCE2_RGB = $8582;
GL_SOURCE0_ALPHA = $8588;
GL_SOURCE1_ALPHA = $8589;
GL_SOURCE2_ALPHA = $858A;
GL_OPERAND0_RGB = $8590;
GL_OPERAND1_RGB = $8591;
GL_OPERAND2_RGB = $8592;
GL_OPERAND0_ALPHA = $8598;
GL_OPERAND1_ALPHA = $8599;
GL_OPERAND2_ALPHA = $859A;
GL_SUBTRACT = $84E7;
//
GL_COMBINE_EXT = $8570;
GL_COMBINE_RGB_EXT = $8571;
GL_COMBINE_ALPHA_EXT = $8572;
GL_RGB_SCALE_EXT = $8573;
GL_ADD_SIGNED_EXT = $8574;
GL_INTERPOLATE_EXT = $8575;
GL_CONSTANT_EXT = $8576;
GL_PRIMARY_COLOR_EXT = $8577;
GL_PREVIOUS_EXT = $8578;
GL_SOURCE0_RGB_EXT = $8580;
GL_SOURCE1_RGB_EXT = $8581;
GL_SOURCE2_RGB_EXT = $8582;
GL_SOURCE0_ALPHA_EXT = $8588;
GL_SOURCE1_ALPHA_EXT = $8589;
GL_SOURCE2_ALPHA_EXT = $858A;
GL_OPERAND0_RGB_EXT = $8590;
GL_OPERAND1_RGB_EXT = $8591;
GL_OPERAND2_RGB_EXT = $8592;
GL_OPERAND0_ALPHA_EXT = $8598;
GL_OPERAND1_ALPHA_EXT = $8599;
GL_OPERAND2_ALPHA_EXT = $859A;
//
GL_COMBINE_ARB = $8570;
GL_COMBINE_RGB_ARB = $8571;
GL_COMBINE_ALPHA_ARB = $8572;
GL_SOURCE0_RGB_ARB = $8580;
GL_SOURCE1_RGB_ARB = $8581;
GL_SOURCE2_RGB_ARB = $8582;
GL_SOURCE0_ALPHA_ARB = $8588;
GL_SOURCE1_ALPHA_ARB = $8589;
GL_SOURCE2_ALPHA_ARB = $858A;
GL_OPERAND0_RGB_ARB = $8590;
GL_OPERAND1_RGB_ARB = $8591;
GL_OPERAND2_RGB_ARB = $8592;
GL_OPERAND0_ALPHA_ARB = $8598;
GL_OPERAND1_ALPHA_ARB = $8599;
GL_OPERAND2_ALPHA_ARB = $859A;
GL_RGB_SCALE_ARB = $8573;
GL_ADD_SIGNED_ARB = $8574;
GL_INTERPOLATE_ARB = $8575;
GL_SUBTRACT_ARB = $84E7;
GL_CONSTANT_ARB = $8576;
GL_PRIMARY_COLOR_ARB = $8577;
GL_PREVIOUS_ARB = $8578;
GL_CONSTANT_COLOR_EXT = $8001;
GL_ONE_MINUS_CONSTANT_COLOR_EXT = $8002;
GL_CONSTANT_ALPHA = $8003;
GL_ONE_MINUS_CONSTANT_ALPHA = $8004;
GL_CONSTANT_ALPHA_EXT = $8003;
GL_ONE_MINUS_CONSTANT_ALPHA_EXT = $8004;
GL_LIGHT_MODEL_COLOR_CONTROL = $81F8;
GL_SINGLE_COLOR = $81F9;
GL_SEPARATE_SPECULAR_COLOR = $81FA;
// cube maps
NORMAL_MAP_ARB = $8511;
REFLECTION_MAP_ARB = $8512;
TEXTURE_CUBE_MAP_ARB = $8513;
TEXTURE_BINDING_CUBE_MAP_ARB = $8514;
TEXTURE_CUBE_MAP_POSITIVE_X_ARB = $8515;
TEXTURE_CUBE_MAP_NEGATIVE_X_ARB = $8516;
TEXTURE_CUBE_MAP_POSITIVE_Y_ARB = $8517;
TEXTURE_CUBE_MAP_NEGATIVE_Y_ARB = $8518;
TEXTURE_CUBE_MAP_POSITIVE_Z_ARB = $8519;
TEXTURE_CUBE_MAP_NEGATIVE_Z_ARB = $851A;
PROXY_TEXTURE_CUBE_MAP_ARB = $851B;
MAX_CUBE_MAP_TEXTURE_SIZE_ARB = $851C;
// vertex buffer objects
GL_BUFFER_SIZE_ARB = $8764;
GL_BUFFER_USAGE_ARB = $8765;
GL_ARRAY_BUFFER_ARB = $8892;
GL_ELEMENT_ARRAY_BUFFER_ARB = $8893;
GL_ARRAY_BUFFER_BINDING_ARB = $8894;
GL_ELEMENT_ARRAY_BUFFER_BINDING_ARB = $8895;
GL_VERTEX_ARRAY_BUFFER_BINDING_ARB = $8896;
GL_NORMAL_ARRAY_BUFFER_BINDING_ARB = $8897;
GL_COLOR_ARRAY_BUFFER_BINDING_ARB = $8898;
GL_INDEX_ARRAY_BUFFER_BINDING_ARB = $8899;
GL_TEXTURE_COORD_ARRAY_BUFFER_BINDING_ARB = $889A;
GL_EDGE_FLAG_ARRAY_BUFFER_BINDING_ARB = $889B;
GL_SECONDARY_COLOR_ARRAY_BUFFER_BINDING_ARB = $889C;
GL_FOG_COORDINATE_ARRAY_BUFFER_BINDING_ARB = $889D;
GL_WEIGHT_ARRAY_BUFFER_BINDING_ARB = $889E;
GL_VERTEX_ATTRIB_ARRAY_BUFFER_BINDING_ARB = $889F;
GL_READ_ONLY_ARB = $88B8;
GL_WRITE_ONLY_ARB = $88B9;
GL_READ_WRITE_ARB = $88BA;
GL_BUFFER_ACCESS_ARB = $88BB;
GL_BUFFER_MAPPED_ARB = $88BC;
GL_BUFFER_MAP_POINTER_ARB = $88BD;
GL_STREAM_DRAW_ARB = $88E0;
GL_STREAM_READ_ARB = $88E1;
GL_STREAM_COPY_ARB = $88E2;
GL_STATIC_DRAW_ARB = $88E4;
GL_STATIC_READ_ARB = $88E5;
GL_STATIC_COPY_ARB = $88E6;
GL_DYNAMIC_DRAW_ARB = $88E8;
GL_DYNAMIC_READ_ARB = $88E9;
GL_DYNAMIC_COPY_ARB = $88EA;
procedure glPolygonOffset(factor, units: GLfloat); stdcall; external 'opengl32.dll';
procedure glArrayElement(i: GLint); stdcall; external 'opengl32.dll';
// procedure glDrawRangeElements(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); stdcall; external 'opengl32.dll';
procedure glDrawElements(mode: GLenum; count: GLsizei; atype: GLenum; indices: Pointer); stdcall; external 'opengl32.dll';
procedure glDrawArrays(mode: GLenum; first: GLint; count: GLsizei); stdcall; external 'opengl32.dll';
procedure glVertexPointer(size: GLint; atype: GLenum; stride : GLsizei; const pointer: Pointer); stdcall; external 'opengl32.dll';
procedure glNormalPointer(atype: GLenum; stride: GLsizei; data: pointer); stdcall; external 'opengl32.dll';
procedure glColorPointer(size: GLint; atype: GLenum; stride: GLsizei; const pointer: Pointer); stdcall; external 'opengl32.dll';
procedure glTexCoordPointer(size: GLint; atype: GLenum; stride : GLsizei; const pointer: Pointer); stdcall; external 'opengl32.dll';
procedure glEnableClientState(id: GLuint); stdcall; external 'opengl32.dll';
procedure glDisableClientState(id: GLuint); stdcall; external 'opengl32.dll';
procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external 'opengl32.dll';
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external 'opengl32.dll';
function glIsTexture(texture: GLuint): GLboolean; stdcall; external 'opengl32.dll';
procedure glDeleteTextures(n: GLsizei; textures: PGLuint); stdcall; external 'opengl32.dll';
function gluBuild2DMipmaps(Target: GLenum; Components, Width, Height: GLint; Format, atype: GLenum; Data: Pointer): GLint; stdcall; external 'glu32.dll';
(*
function gluNewQuadric : PGLUquadric; stdcall; external 'glu32.dll';
procedure gluDeleteQuadric(state: PGLUquadric); stdcall; external 'glu32.dll';
procedure gluPartialDisk(quadObject: PGLUquadric; innerRadius, outerRadius: GLdouble; slices, loops: GLint; startAngle, sweepAngle : GLdouble); stdcall; external 'glu32.dll';
*)
var // Extensions
glFogCoordfEXT : procedure(coord: GLfloat); stdcall = nil;
// WGL_EXT_swap_control
wglSwapIntervalEXT : function(interval: GLint) : Boolean; stdcall = nil;
wglGetSwapIntervalEXT : function : GLint; stdcall = nil;
// multi-texturing
glClientActiveTextureARB : procedure(target: GLenum); stdcall = nil;
glActiveTextureARB : procedure(target: GLenum); stdcall = nil;
glMultiTexCoord2f : procedure(target: GLenum; s: GLfloat; t: GLfloat); stdcall = nil;
glMultiTexCoord2fv : procedure(target: GLenum; const v: PGLfloat); stdcall = nil;
//
glDrawRangeElements : procedure(mode: GLenum; start: GLuint; _end: GLuint; count: GLsizei; _type: GLenum; const indices: PGLvoid); stdcall = nil;
glBlendColorEXT : procedure(red: GLclampf; green: GLclampf; blue: GLclampf; alpha: GLclampf); stdcall = nil;
// vertex buffer objects
glGenBuffersARB : procedure(n: GLsizei; buffers: PGLuint); stdcall = nil;
glIsBufferARB : function(buffer: GLuint): GLboolean; stdcall = nil;
glBindBufferARB : procedure(target: GLenum; buffer: GLuint); stdcall = nil;
glDeleteBuffersARB : procedure(n: GLsizei; const buffers: PGLuint); stdcall = nil;
glBufferDataARB : procedure(target: GLenum; size: GLsizeiptrARB; const data: PGLvoid; usage: GLenum); stdcall = nil;
glBufferSubDataARB : procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; const data: PGLvoid); stdcall = nil;
glGetBufferSubDataARB : procedure(target: GLenum; offset: GLintptrARB; size: GLsizeiptrARB; data: PGLvoid); stdcall = nil;
glMapBufferARB : function(target: GLenum; access: GLenum): PGLvoid; stdcall = nil;
glUnmapBufferARB : function(target: GLenum): GLboolean; stdcall = nil;
glGetBufferParameterivARB : procedure(target: GLenum; pname: GLenum; params: PGLint); stdcall = nil;
glGetBufferPointervARB : procedure(target: GLenum; pname: GLenum; params: PGLvoid); stdcall = nil;
var OGL: TOGL;
implementation
uses Forms, Types, uCalc;
{ TOGL }
//-- properties lezen en aanpassen/schijven
{procedure TOGL.SetWinHandle(const Value: HWND);
begin
if Value <> local_WinHandle then begin
if Active then begin
Disable; // OpenGL uitschakelen..
FullScreen := false; // evt. de volledige scherm modus uitschakelen..
end;
local_WinHandle := Value;
end;
end;}
function TOGL.GetActive: Boolean;
begin
local_Active := ((local_DC<>0) and (local_RC<>0));
Result := local_Active;
end;
{procedure TOGL.SetActive(const Value: boolean);
begin
if Value <> local_Active then
local_Active := Value;
end;}
procedure TOGL.SetPaused(const Value: boolean);
begin
if Value <> local_Paused then
local_Paused := Value;
end;
procedure TOGL.SetFullScreen(const Value: boolean);
begin
if not Active then Exit;
if Value <> local_FullScreen then begin
local_FullScreen := Value;
SetupFullScreen(local_FullScreen);
end;
end;
procedure TOGL.SetMouseLook(const Value: boolean);
begin
if Value <> local_MouseLook then local_MouseLook := Value;
end;
procedure TOGL.ToggleMouseLook;
begin
local_MouseLook := not local_MouseLook;
end;
procedure TOGL.SetFog(const Value: boolean);
begin
if not Active then Exit;
if Value <> local_Fog then begin
local_Fog := Value;
SetupFog(local_Fog);
end;
end;
function TOGL.GetWidth: integer;
begin
Result := local_Projection.Width;
end;
function TOGL.GetHeight: integer;
begin
Result := local_Projection.Height;
end;
function TOGL.GetCenter: TPoint;
begin
Result := local_Projection.Center;
end;
//-- /properties
constructor TOGL.Create;
begin
// Object initiëren
inherited;
// Data initialiseren
local_WinHandle := 0; // nog geen Window-handle toegewezen..
local_DC := 0; // nog geen Device-Context toegewezen..
local_RC := 0; // nog geen RenderContext toegewezen..
local_Width := 0; // form breedte
local_Height := 0; // form hoogte
local_Active := false; // OpenGL niet actief
local_Paused := false; // niet gepauzeerd
local_FullScreen := false; // windowed
local_Fog := false; // mist uitschakelen
local_VSync := 1; // standaard Vertical Retrace Sync aan
OldVSync := local_VSync;
local_FPS := 0; // 0 beelden per seconde
local_FPSCount := 0; //
local_LastFrameTime := 0.0; // de tijdsduur die nodig was om het laatste beeld te renderen
PerformanceCount := 0;
QueryPerformanceFrequency(PerformanceFreq);
local_MouseLook := false;
with local_Projection do begin // Projectie
ProjectionType := ptPerspective;
Width := local_Width;
Height := local_Height;
//FOVY := 65.0;
FOVY := GetAngleFOV(MaxViewDistance, MaxViewDistance);
zNear := 1.0;
zFar := MaxViewDistance;
Center := Point(0,0);
// De padding (tussen venster en viewport)
// (waarden in bereik[0..1])
// Dit zijn percentages van de gehele viewport-breedte & -hoogte.
// Een waarde van 0.5 voor .left zorgt ervoor dat er aan de linkerkant
// langs de viewport een ruimte open is, die de helft van het venster breed is.
ViewPortRect.top := 0.0;
ViewPortRect.left := 0.0;
ViewPortRect.bottom := 0.0;
ViewPortRect.right := 0.0;
// de vaste padding waarden (in pixels)
ViewPortRect.pxTop := 0;
ViewPortRect.pxLeft := 0;
ViewPortRect.pxBottom := 0;
ViewPortRect.pxRight := 0;
end;
N_TextureUnits := -1; //ongeldige waarde
IsSetupFor2D := false; //niet in 2D-mode
// objecten instantieren
Frustum := TFrustum.Create; // het frustum-object
Textures := TObjTexture.Create; // textures-object
Fonts := TGLFonts.Create; // lettertypen-object
local_Camera := TCamera.Create; // het camera-object
Camera := @local_Camera; // gebruik local_Camera als de huidige camera
SkyBox := TSkyBox.Create(self); // SkyBox-object
(*
// Extensions
glFogCoordfEXT := nil;
wglSwapIntervalEXT := nil;
wglGetSwapIntervalEXT := nil;
glClientActiveTextureARB := nil;
glActiveTextureARB := nil;
glMultiTexCoord2f := nil;
glMultiTexCoord2fv := nil;
glBlendColorEXT := nil;
*)
end;
destructor TOGL.Destroy;
begin
// Data finaliseren
SkyBox.Free; // SkyBox-object
if local_Camera<>nil then begin
local_Camera.Free; // het local_camera-object
local_Camera := nil;
end;
if Camera<>nil then begin
// Camera.Free; // het camera-object
Camera := nil;
end;
Fonts.Free; // lettertypen
Textures.Free; // het texture-object
Frustum.Free; // het frustum-object
Disable; // evt. OpenGL uitschakelen..
// Object finaliseren
inherited;
end;
procedure TOGL.ResetCamera;
begin
Camera := @local_Camera; // gebruik local_Camera als de huidige camera
end;
procedure TOGL.Enable(WindowHandle: HWND);
var pfd: PIXELFORMATDESCRIPTOR;
iFormat: integer;
f,c: integer;
aRect: TRect;
begin
if Active then Exit; //al actief? dan niet nog eens activeren..
// Zoek het form met handle WindowHandle, en bepaal de dimensies..
(* for f:=0 to Screen.FormCount-1 do
if Screen.Forms[f].Handle = WindowHandle then begin
local_Width := Screen.Forms[f].Width;
local_Height := Screen.Forms[f].Height;
Break;
end;*)
GetWindowRect(WindowHandle, aRect);
local_Width := aRect.Right - aRect.Left;
local_Height := aRect.Bottom - aRect.Top;
// De DeviceContext (DC) opvragen
local_WinHandle := WindowHandle;
local_DC := GetDC(local_WinHandle);
if (local_DC=0) then ReportErrorAndQuit(error_GetDC);
// Het pixelformat voor de DC instellen
ZeroMemory(@pfd, sizeof(pfd));
pfd.nSize := sizeof(pfd);
pfd.nVersion := 1;
pfd.dwFlags := (PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER);
pfd.iPixelType := PFD_TYPE_RGBA;
pfd.cColorBits := 32; //8 bits per bitplane
pfd.cDepthBits := 24; //24-bits Z-buffer
pfd.cStencilBits := 1; //1 bit stencil-buffer
pfd.iLayerType := PFD_MAIN_PLANE;
iFormat := ChoosePixelFormat(DC,@pfd);
if (iFormat=0) then ReportErrorAndQuit(error_ChoosePixelFormat);
if (not SetPixelFormat(local_DC, iFormat, @pfd)) then ReportErrorAndQuit(error_SetPixelFormat);
// Het palette instellen
{setupPalette(DC);}
// De RenderContext instellen
local_RC := wglCreateContext(local_DC);
if (local_RC=0) then ReportErrorAndQuit(error_MakeRC);
if (not wglMakeCurrent(local_DC,local_RC)) then ReportErrorAndQuit(error_MakeCurrent);
// De OpenGL-DLL entry-points opvragen voor de extensions
GetExtensionProcs;
// OpenGL instellingen
Init;
end;
procedure TOGL.Disable;
begin
if Active then begin // OpenGL actief? dan uitschakelen..
// evt. aangemaakte textures wissen..
Textures.DeleteTextures;
// evt. aangemaakte font displaylists wissen..
{ Fonts.DeleteFont;}
// OpenGL RC vrijgeven
wglMakeCurrent(0,0);
wglDeleteContext(local_RC);
// het palette vrijgeven
if (Palette<>0) then DeleteObject(Palette);
// De DeviceContext vrijgeven
ReleaseDC(WinHandle, local_DC);
end;
FullScreen := false; // evt. de volledige scherm modus uitschakelen..
local_DC := 0;
local_RC := 0;
// VSync herstellen
if ExtensionSupported('WGL_EXT_swap_control') then wglSwapIntervalEXT(OldVSync);
local_VSync := OldVSync;
end;
procedure TOGL.DoBufferSwap;
begin
// Ook een bufferswap als OpenGL is gepauzeerd..
if Active then SwapBuffers(local_DC);
end;
procedure TOGL.MakeCurrent;
begin
if (local_DC=0) or (local_RC=0) then ReportErrorAndQuit(error_MakeCurrent);
if (not wglMakeCurrent(local_DC,local_RC)) then ReportErrorAndQuit(error_MakeCurrent);
end;
function TOGL.ExtensionSupported(Ext: string): boolean;
var s: string;
begin
s := glGetString(GL_EXTENSIONS);
Result := (Pos(Ext, s)>0);
end;
procedure TOGL.GetExtensionProcs;
begin
glDrawRangeElements := wglGetProcAddress('glDrawRangeElements');
// de OpenGL-DLL procedure entry-points opvragen voor de extensions
if ExtensionSupported('EXT_fog_coord') then
glFogCoordfEXT := wglGetProcAddress('glFogCoordfEXT');
if ExtensionSupported('WGL_EXT_swap_control') then begin
wglSwapIntervalEXT := wglGetProcAddress('wglSwapIntervalEXT');
wglGetSwapIntervalEXT := wglGetProcAddress('wglGetSwapIntervalEXT');
// de huidige VSync instelling onthouden
OldVSync := wglGetSwapIntervalEXT;
end;
// GL_ARB_multitexture
if ExtensionSupported('GL_ARB_multitexture') then begin
glClientActiveTextureARB := wglGetProcAddress('glClientActiveTextureARB');
glActiveTextureARB := wglGetProcAddress('glActiveTextureARB');
glMultiTexCoord2f := wglGetProcAddress('glMultiTexCoord2f');
glMultiTexCoord2fv := wglGetProcAddress('glMultiTexCoord2fv');
end;
// GL_EXT_blend_color
if ExtensionSupported('GL_EXT_blend_color') then begin
glBlendColorEXT := wglGetProcAddress('glBlendColorEXT');
end;
// GL_ARB_vertex_buffer_object
if ExtensionSupported('GL_ARB_vertex_buffer_object') then begin
glGenBuffersARB := wglGetProcAddress('glGenBuffersARB');
glIsBufferARB := wglGetProcAddress('glIsBufferARB');
glBindBufferARB := wglGetProcAddress('glBindBufferARB');
glDeleteBuffersARB := wglGetProcAddress('glDeleteBuffersARB');
glBufferDataARB := wglGetProcAddress('glBufferDataARB');
glBufferSubDataARB := wglGetProcAddress('glBufferSubDataARB');
glGetBufferSubDataARB := wglGetProcAddress('glGetBufferSubDataARB');
glMapBufferARB := wglGetProcAddress('glMapBufferARB');
glUnmapBufferARB := wglGetProcAddress('glUnmapBufferARB');
glGetBufferParameterivARB := wglGetProcAddress('glGetBufferParameterivARB');
glGetBufferPointervARB := wglGetProcAddress('glGetBufferPointervARB');
end;
end;
procedure TOGL.Init;
begin
if not Active then Exit;
// Verticale beeldscherm refresh uitschakelen
SetVSync(local_VSync);
//het aantal texture units bepalen
GetMaxTextureUnits;
// projectie instellen
SetupProjection;
// mist standaard inschakelen..
// SetupFog(GL_EXP, 0.0001, MaxViewDistance/2,MaxViewDistance, DefaultFogColor, GL_FASTEST);
// SetupFog(GL_LINEAR, 1.0, 0.0,1.0, DefaultFogColor, GL_FASTEST);
SetupFog(GL_LINEAR, 0.3, 1000.0,5000.0, DefaultFogColor, GL_FASTEST);
SetupFog(local_Fog);
// fonts
// Fonts.CreateFontDLs(local_DC, local_RC, 'Arial', 12, false); //2D-Arial 12px
// Fonts.CreateFontDLs(local_DC, local_RC, 'Courier New', 14, false); //2D-Arial 12px
Fonts.AddFont(local_DC, local_RC, 'Courier New', 14, false);
Fonts.AddFont(local_DC, local_RC, 'Arial', 12, false);
// Z-Buffer (diepte)
glDepthFunc(GL_LESS);
glDepthRange(0.0, 1.0); // near far
glDepthMask(GL_TRUE); // depth-buffer is writable
glEnable(GL_DEPTH_TEST);
// culling
glFrontFace(GL_CCW);
glCullFace(GL_BACK);
glEnable(GL_CULL_FACE);
// form achtergrond
glPolygonMode(GL_FRONT, GL_FILL);
{glPolygonOffset(1.0, 1.0);}
glDisable(GL_POLYGON_OFFSET_FILL);
glClearDepth(1.0);
glClearColor(0.0, 0.0, 0.0, 0.0);
glColorMask(GL_TRUE, GL_TRUE, GL_TRUE, GL_FALSE);
glDrawBuffer(GL_FRONT_AND_BACK);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT {or GL_STENCIL_BUFFER_BIT} );
glDrawBuffer(GL_BACK);
// render-performance
glHint(GL_POINT_SMOOTH_HINT, GL_NICEST); //GL_FASTEST, GL_NICEST, GL_DONT_CARE
glHint(GL_LINE_SMOOTH_HINT, GL_NICEST);
glHint(GL_POLYGON_SMOOTH_HINT, GL_NICEST);
{glHint(GL_FOG_HINT, GL_NICEST);}
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //moet zijn GL_NICEST in-game..
glDisable(GL_NORMALIZE); // normalen gebruik ik zelf
glShadeModel(GL_SMOOTH);
glDisable(GL_DITHER);
glDisable(GL_BLEND); // blending uit
// environment-mapping
glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP);
glDisable(GL_TEXTURE_GEN_S);
glDisable(GL_TEXTURE_GEN_T);
//
DoBufferSwap;
end;
procedure TOGL.ReportErrorAndQuit(ErrorCode: integer);
var s : PChar;
begin
case ErrorCode of
error_GetDC : s:='The device-context could not be determined';
error_ChoosePixelFormat : s:='The pixel-format could not be determined.';
error_SetPixelFormat : s:='The pixel-format could not be set.';
error_MakeRC : s:='The render-context could not be made.';
error_MakeCurrent : s:='The render-context could not be made current.';
error_CreatingTexture : s:='A texture could not be created.';
error_GenList : s:='A compiled list could not be created';
else
s := 'OpenGL Error';
end;
MessageBox(WindowFromDC(DC), s, 'OpenGL Error', MB_ICONERROR or MB_OK);
if ErrorCode<>error_CreatingTexture then PostQuitMessage(ErrorCode);
end;
//--- VSync --------------------------------------------------------------------
function TOGL.MonitorRefreshRate: Integer;
var Desktop: HDC;
begin
Desktop := GetDC(0);
Result := GetDeviceCaps(Desktop, VREFRESH);
ReleaseDC(0, Desktop);
end;
function TOGL.GetVSync(var OnOff: boolean): boolean;
begin
Result := ExtensionSupported('WGL_EXT_swap_control');
if Result then OnOff := (local_VSync=1);
end;
function TOGL.SetVSync(OnOff: boolean): boolean;
begin
Result := ExtensionSupported('WGL_EXT_swap_control');
if Result then begin
if OnOff then begin
local_VSync := 1;
wglSwapIntervalEXT(1);
end else begin
local_VSync := 0;
wglSwapIntervalEXT(0);
end;
end;
end;
function TOGL.SetVSync(OnOff: integer): boolean;
begin
Result := SetVSync(OnOff<>0);
end;
procedure TOGL.ToggleVSync;
begin
if ExtensionSupported('WGL_EXT_swap_control') then begin
// de huidige VSync instelling onthouden
if local_VSync = 0 then begin
local_VSync := 1;
wglSwapIntervalEXT(1);
end else begin
local_VSync := 0;
wglSwapIntervalEXT(0);
end;
end;
end;
//-- FPS meting ----------------------------------------------------------------
procedure TOGL.FPSTimer;
begin
local_FPS := local_FPSCount; //gemiddelde FPS de afgelopen seconde
local_FPSCount := 0; //opnieuw tellen..
end;
procedure TOGL.MeasureFPS;
var Interval: Int64;
begin
//het gemiddeld aantal FPS berekenen (per seconde)
Inc(local_FPSCount);
//tijdsduur laatste frame-render (in seconden)
QueryPerformanceCounter(PerformanceCount);
Interval := PerformanceCount - LastPerformanceCount;
local_LastFrameTime := 1/(PerformanceFreq / Interval);
//timing
LastPerformanceCount := PerformanceCount;
end;
function TOGL.GetFPS: integer;
begin
Result := local_FPS;
end;
function TOGL.GetLastFrameTime: single;
begin
Result := local_LastFrameTime;
end;
//--
function TOGL.GetMaxTextureUnits: GLint;
begin
if not Active then
Result := -1
else begin
glGetIntegerv(GL_MAX_TEXTURE_UNITS_ARB, @N_TextureUnits);
Result := N_TextureUnits;
end;
end;
//--- Projection ---------------------------------------------------------------
procedure TOGL.SetupViewPort(aProjection: TProjection);
var Left,Top, Right,Bottom, W,H: Integer;
begin
// viewport berekenen
Left := Round(aProjection.ViewPortRect.left * aProjection.Width);
Bottom := Round(aProjection.ViewPortRect.top * aProjection.Height); //!
Right := Round(aProjection.ViewPortRect.right * aProjection.Width);
Top := Round(aProjection.ViewPortRect.bottom * aProjection.Height); //!
W := aProjection.Width - Right - Left;
H := aProjection.Height - Bottom - Top;
W := W - aProjection.ViewPortRect.pxLeft - aProjection.ViewPortRect.pxRight;
H := H - aProjection.ViewPortRect.pxTop - aProjection.ViewPortRect.pxBottom;
Left := Left + aProjection.ViewPortRect.pxLeft;
Top := Top + aProjection.ViewPortRect.pxTop;
// en instellen
glViewPort(Left,Top, W,H);
end;
procedure TOGL.Resize(NewWidth, NewHeight: integer);
begin
if (NewWidth=local_Projection.Width) and (NewHeight=local_Projection.Height) then Exit;
//projectie
local_Projection.Width := NewWidth;
local_Projection.Height := NewHeight;
local_Projection.Center := Point(NewWidth div 2, NewHeight div 2);
//form
local_Width := NewWidth;
local_Height := NewHeight;
SetupProjection;
end;
procedure TOGL.SetupProjection;
begin
if not Active then Exit;
// De huidige projectie instellen/herstellen
with local_Projection do begin
case ProjectionType of
ptOrthogonal: SetupProjection(Width,Height, Left,Right, Bottom,Top);
ptPerspective: SetupProjection(Width,Height, FOVY, zNear,zFar);
ptFrustum: SetupProjection(Width,Height, Left,Right, Bottom,Top, zNear,zFar);
end;
end;
(*
// de frustum clip-planes herberekenen
Frustum.ClipPlanesFromFrustum;
*)
IsSetupFor2D := false;
end;
procedure TOGL.SetupProjection(Width, Height: integer; oLeft,oRight, oBottom,oTop: Extended);
begin