1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517 |
- //
- // The graphics engine GLScene
- //
- unit GLS.State;
- (* Tools for managing an application-side cache of OpenGL state. *)
- (*
- TODO: Proper client-side pushing + popping of state, in OpenGL 3+ contexts,
- rather than using glPushAttrib + glPopAttrib.
- TODO: Proper support for textures, taking into account that they probably
- won't be linked to texture units in some future version of OpenGL.
- TODO: Once more of GLScene is cache-aware, enable some of the checks before
- changing OpenGL state (where we will gain a speed increase).
- DONE: Cache some relevant legacy state
- TODO: improve binding objects to binding points
- TODO: decide how to implement the new Enable* options (without going above
- 32 elements in sets if possible, which would be slower in 32bit Delphi)
- DONE: remove stTexture1D, 2D, etc from TGLState if possible, since they are
- per texture-unit + also deprecated in OpenGL 3+
- *)
- interface
- {$I Stage.Defines.inc}
- { .$DEFINE USE_CACHE_MISS_CHECK }
- uses
- Winapi.OpenGL,
- Winapi.OpenGLext,
- System.Classes,
- System.SysUtils,
- Stage.OpenGLTokens,
- Stage.VectorTypes,
- Stage.VectorGeometry,
- Stage.TextureFormat,
- Stage.Utils,
- GLS.Color;
- const
- GLS_VERTEX_ATTR_NUM = 16;
- type
- TGLStateType = (sttCurrent, sttPoint, sttLine, sttPolygon, sttPolygonStipple,
- sttPixelMode, sttLighting, sttFog, sttDepthBuffer, sttAccumBuffer,
- sttStencilBuffer, sttViewport, sttTransform, sttEnable, sttColorBuffer,
- sttHint, sttEval, sttList, sttTexture, sttScissor,
- sttMultisample);
- TGLStateTypes = set of TGLStateType;
- const
- cAllAttribBits = [low(TGLStateType) .. High(TGLStateType)];
- type
- TGLMeshPrimitive = (
- mpNOPRIMITIVE,
- mpTRIANGLES,
- mpTRIANGLE_STRIP,
- mpTRIANGLE_FAN,
- mpPOINTS,
- mpLINES,
- mpLINE_LOOP,
- mpLINE_STRIP,
- mpLINES_ADJACENCY,
- mpLINE_STRIP_ADJACENCY,
- mpTRIANGLES_ADJACENCY,
- mpTRIANGLE_STRIP_ADJACENCY,
- mpPATCHES
- );
- TGLMeshPrimitives = set of TGLMeshPrimitive;
- const
- cAllMeshPrimitive = [
- mpTRIANGLES,
- mpTRIANGLE_STRIP,
- mpTRIANGLE_FAN,
- mpPOINTS,
- mpLINES,
- mpLINE_LOOP,
- mpLINE_STRIP,
- mpLINES_ADJACENCY,
- mpLINE_STRIP_ADJACENCY,
- mpTRIANGLES_ADJACENCY,
- mpTRIANGLE_STRIP_ADJACENCY,
- mpPATCHES];
- type
- // Reflects all relevant (binary) states of OpenGL subsystem
- TGLState = (stAlphaTest, stAutoNormal,
- stBlend, stColorMaterial, stCullFace, stDepthTest, stDither,
- stFog, stLighting, stLineSmooth, stLineStipple,
- stIndexLogicOp, stColorLogicOp, stNormalize, stPointSmooth, stPointSprite,
- stPolygonSmooth, stPolygonStipple, stScissorTest, stStencilTest,
- stPolygonOffsetPoint, stPolygonOffsetLine, stPolygonOffsetFill,
- stDepthClamp);
- TGLStates = set of TGLState;
- TGLComparisonFunction = (cfNever, cfAlways, cfLess, cfLEqual, cfEqual,
- cfGreater, cfNotEqual, cfGEqual);
- TGLStencilFunction = TGLComparisonFunction;
- TGLDepthFunction = TGLComparisonFunction;
- TGLBlendFunction = (bfZero, bfOne,
- bfSrcColor, bfOneMinusSrcColor, bfDstColor, bfOneMinusDstColor,
- bfSrcAlpha, bfOneMinusSrcAlpha, bfDstAlpha, bfOneMinusDstAlpha,
- bfConstantColor, bfOneMinusConstantColor,
- bfConstantAlpha, bfOneMinusConstantAlpha,
- bfSrcAlphaSat);
- TGLDstBlendFunction = bfZero..bfOneMinusConstantAlpha;
- TGLBlendEquation = (beAdd, beSubtract, beReverseSubtract, beMin, beMax);
- TGLStencilOp = (soKeep, soZero, soReplace, soIncr, soDecr, soInvert, soIncrWrap,
- soDecrWrap);
- TGLLogicOp = (loClear, loAnd, loAndReverse, loCopy, loAndInverted, loNoOp,
- loXOr, loOr, loNor, loEquiv, loInvert, loOrReverse, loCopyInverted,
- loOrInverted, loNAnd, loSet);
- TGLQueryType = (
- qrySamplesPassed,
- qryPrimitivesGenerated,
- qryTransformFeedbackPrimitivesWritten,
- qryTimeElapsed,
- qryAnySamplesPassed);
- // Describe what kind of winding has a front face
- TGLFaceWinding = (fwCounterClockWise, fwClockWise);
- TGLPolygonMode = (pmFill, pmLines, pmPoints);
- TGLCullFaceMode = (cmFront, cmBack, cmFrontAndBack);
- // TSingleCullFaceMode = cmFront..cmBack;
- TGLColorComponent = (ccRed, ccGreen, ccBlue, ccAlpha);
- TGLColorMask = set of TGLColorComponent;
- const
- cAllColorComponents = [ccRed, ccGreen, ccBlue, ccAlpha];
- MAX_HARDWARE_LIGHT = 16;
- MAX_SHADER_LIGHT = 8;
- MAX_HARDWARE_TEXTURE_UNIT = 48;
- MAX_HARDWARE_UNIFORM_BUFFER_BINDING = 75;
- type
- TGLHintType = (hintDontCare, hintFastest, hintNicest);
- TGLLightSourceState = packed record
- Position: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- Ambient: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- Diffuse: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- Specular: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- SpotDirection: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- SpotCosCutoffExponent: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- Attenuation: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLVector;
- end;
- TGLShaderLightSourceState = packed record
- Position: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- Ambient: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- Diffuse: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- Specular: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- SpotDirection: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- SpotCosCutoffExponent: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- Attenuation: array [0 .. MAX_SHADER_LIGHT - 1] of TGLVector;
- end;
- TGLOnLightsChanged = procedure(Sender: TObject);
- TGLBufferBindingTarget = (bbtUniform, bbtTransformFeedBack);
- TUBOStates = record
- FUniformBufferBinding: Cardinal;
- FOffset: TGLintptr;
- FSize: TGLsizeiptr;
- end;
- TGLMaterialLevel = (mlAuto, mlFixedFunction, mlMultitexturing, mlSM3, mlSM4, mlSM5);
- (* Manages an application-side cache of OpenGL states and parameters.
- Purpose of this class is to eliminate redundant state and parameter
- changes, and there will typically be no more than one state cache per
- OpenGL context *)
- TGLStateCache = class
- strict private
- // Legacy state
- FFrontBackColors: array [0 .. 1, 0 .. 3] of TGLVector;
- FFrontBackShininess: array [0 .. 1] of Integer;
- FAlphaFunc: TGLComparisonFunction;
- FAlphaRef: Single;
- FPolygonBackMode: TGLPolygonMode; // Front + back have same polygon mode
- // Lighting state
- FMaxLights: Cardinal;
- FLightEnabling: array [0 .. MAX_HARDWARE_LIGHT - 1] of Boolean;
- FLightIndices: array [0 .. MAX_HARDWARE_LIGHT - 1] of TGLint;
- FLightNumber: Integer;
- FLightStates: TGLLightSourceState;
- FSpotCutoff: array [0 .. MAX_HARDWARE_LIGHT - 1] of Single;
- FShaderLightStates: TGLShaderLightSourceState;
- FShaderLightStatesChanged: Boolean;
- FColorWriting: Boolean; // TODO: change to per draw buffer (FColorWriteMask)
- FStates: TGLStates;
- FListStates: array of TGLStateTypes;
- FCurrentList: Cardinal;
- FTextureMatrixIsIdentity: array [0 .. 3] of Boolean;
- // FForwardContext: Boolean;
- FFFPLight: Boolean;
- // Vertex Array Data state
- FVertexArrayBinding: Cardinal;
- FArrayBufferBinding: Cardinal;
- FElementBufferBinding: Cardinal;
- FTextureBufferBinding: Cardinal;
- FEnablePrimitiveRestart: TGLboolean;
- FPrimitiveRestartIndex: Cardinal;
- // Transformation state
- FViewPort: TVector4i;
- FDepthRange: array [0 .. 1] of TGLclampd;
- FEnableClipDistance: array [0 .. 7] of TGLboolean;
- FEnableDepthClamp: TGLboolean;
- // Coloring state
- FClampReadColor: Cardinal; // GL_FIXED_ONLY
- FProvokingVertex: Cardinal; // GL_LAST_VERTEX_CONVENTION
- // Rasterization state
- FPointSize: TGLfloat;
- FPointFadeThresholdSize: TGLfloat;
- FPointSpriteCoordOrigin: Cardinal; // GL_UPPER_LEFT
- FLineWidth: Single;
- FLineStippleFactor: TGLint;
- FLineStipplePattern: TGLushort;
- FEnableLineSmooth: TGLboolean;
- FEnableCullFace: TGLboolean;
- FCullFaceMode: TGLCullFaceMode;
- FFrontFace: TGLFaceWinding;
- FEnablePolygonSmooth: TGLboolean;
- FPolygonMode: TGLPolygonMode;
- FPolygonOffsetFactor: TGLfloat;
- FPolygonOffsetUnits: TGLfloat;
- FEnablePolygonOffsetPoint: TGLboolean;
- FEnablePolygonOffsetLine: TGLboolean;
- FEnablePolygonOffsetFill: TGLboolean;
- // Multisample state
- FEnableMultisample: TGLboolean;
- FEnableSampleAlphaToCoverage: TGLboolean;
- FEnableSampleAlphaToOne: TGLboolean;
- FEnableSampleCoverage: TGLboolean;
- FSampleCoverageValue: TGLfloat;
- FSampleCoverageInvert: TGLboolean;
- FEnableSampleMask: TGLboolean;
- FSampleMaskValue: array [0 .. 15] of TGLbitfield;
- // Texture state
- FMaxTextureSize: Cardinal;
- FMax3DTextureSize: Cardinal;
- FMaxCubeTextureSize: Cardinal;
- FMaxArrayTextureSize: Cardinal;
- FMaxTextureImageUnits: Cardinal;
- FMaxTextureAnisotropy: Cardinal;
- FMaxSamples: Cardinal;
- FTextureBinding: array [0 .. MAX_HARDWARE_TEXTURE_UNIT - 1, TGLTextureTarget] of Cardinal;
- FTextureBindingTime: array [0 .. MAX_HARDWARE_TEXTURE_UNIT - 1, TGLTextureTarget] of Double;
- FSamplerBinding: array [0 .. MAX_HARDWARE_TEXTURE_UNIT - 1] of Cardinal;
- // Active texture state
- FActiveTexture: TGLint; // 0 .. Max_texture_units
- FActiveTextureEnabling: array [0 .. MAX_HARDWARE_TEXTURE_UNIT - 1, TGLTextureTarget] of Boolean;
- // Pixel operation state
- FEnableScissorTest: TGLboolean;
- FScissorBox: TVector4i;
- FEnableStencilTest: TGLboolean;
- FStencilFunc: TGLStencilFunction;
- FStencilValueMask: Cardinal;
- FStencilRef: TGLint;
- FStencilFail: TGLStencilOp;
- FStencilPassDepthFail: TGLStencilOp;
- FStencilPassDepthPass: TGLStencilOp;
- FStencilBackFunc: TGLStencilFunction;
- FStencilBackValueMask: Cardinal;
- FStencilBackRef: Cardinal;
- FStencilBackFail: TGLStencilOp;
- FStencilBackPassDepthPass: TGLStencilOp;
- FStencilBackPassDepthFail: TGLStencilOp;
- FEnableDepthTest: TGLboolean;
- FDepthFunc: TGLDepthFunction;
- FEnableBlend: array [0 .. 15] of TGLboolean;
- FBlendSrcRGB: TGLBlendFunction;
- FBlendSrcAlpha: TGLBlendFunction;
- FBlendDstRGB: TGLDstBlendFunction;
- FBlendDstAlpha: TGLDstBlendFunction;
- FBlendEquationRGB: TGLBlendEquation;
- FBlendEquationAlpha: TGLBlendEquation;
- FBlendColor: TGLVector;
- FEnableFramebufferSRGB: TGLboolean;
- FEnableDither: TGLboolean;
- FEnableColorLogicOp: TGLboolean;
- FLogicOpMode: TGLLogicOp;
- // Framebuffer control state
- FColorWriteMask: array [0 .. 15] of TGLColorMask;
- FDepthWriteMask: TGLboolean;
- FStencilWriteMask: Cardinal;
- FStencilBackWriteMask: Cardinal;
- FColorClearValue: TGLVector;
- FDepthClearValue: TGLfloat;
- FStencilClearValue: Cardinal;
- // Framebuffer state
- FDrawFrameBuffer: Cardinal;
- FReadFrameBuffer: Cardinal;
- // Renderbuffer state
- FRenderBuffer: Cardinal;
- // Pixels state
- FUnpackSwapBytes: TGLboolean;
- FUnpackLSBFirst: TGLboolean;
- FUnpackImageHeight: Cardinal;
- FUnpackSkipImages: Cardinal;
- FUnpackRowLength: Cardinal;
- FUnpackSkipRows: Cardinal;
- FUnpackSkipPixels: Cardinal;
- FUnpackAlignment: Cardinal;
- FPackSwapBytes: TGLboolean;
- FPackLSBFirst: TGLboolean;
- FPackImageHeight: Cardinal;
- FPackSkipImages: Cardinal;
- FPackRowLength: Cardinal;
- FPackSkipRows: Cardinal;
- FPackSkipPixels: Cardinal;
- FPackAlignment: Cardinal;
- FPixelPackBufferBinding: Cardinal;
- FPixelUnpackBufferBinding: Cardinal;
- // Program state
- FCurrentProgram: Cardinal;
- FMaxTextureUnits: Cardinal;
- FUniformBufferBinding: Cardinal;
- FUBOStates: array [TGLBufferBindingTarget, 0 .. MAX_HARDWARE_UNIFORM_BUFFER_BINDING - 1] of TUBOStates;
- // Vector + Geometry Shader state
- FCurrentVertexAttrib: array [0 .. 15] of TGLVector;
- FEnableProgramPointSize: TGLboolean;
- // Transform Feedback state
- FTransformFeedbackBufferBinding: Cardinal;
- // Hints state
- FTextureCompressionHint: TGLHintType;
- FPolygonSmoothHint: TGLHintType;
- FFragmentShaderDerivitiveHint: TGLHintType;
- FLineSmoothHint: TGLHintType;
- FMultisampleFilterHint: TGLHintType;
- // Misc state
- FCurrentQuery: array [TGLQueryType] of Cardinal;
- FCopyReadBufferBinding: Cardinal;
- FCopyWriteBufferBinding: Cardinal;
- FEnableTextureCubeMapSeamless: TGLboolean;
- FInsideList: Boolean;
- FOnLightsChanged: TGLOnLightsChanged;
- protected
- // Vertex Array Data state
- procedure SetVertexArrayBinding(const Value: Cardinal); inline;
- function GetArrayBufferBinding: Cardinal; inline;
- procedure SetArrayBufferBinding(const Value: Cardinal); inline;
- function GetElementBufferBinding: Cardinal; inline;
- procedure SetElementBufferBinding(const Value: Cardinal); inline;
- function GetEnablePrimitiveRestart: TGLboolean; inline;
- function GetPrimitiveRestartIndex: Cardinal; inline;
- procedure SetEnablePrimitiveRestart(const enabled: TGLboolean); inline;
- procedure SetPrimitiveRestartIndex(const index: Cardinal); inline;
- procedure SetTextureBufferBinding(const Value: Cardinal); inline;
- // Transformation state
- procedure SetViewPort(const Value: TVector4i); inline;
- function GetEnableClipDistance(ClipDistance: Cardinal): TGLboolean; inline;
- procedure SetEnableClipDistance(index: Cardinal; const Value: TGLboolean); inline;
- function GetDepthRangeFar: TGLclampd; inline;
- procedure SetDepthRangeFar(const Value: TGLclampd); inline;
- function GetDepthRangeNear: TGLclampd; inline;
- procedure SetDepthRangeNear(const Value: TGLclampd); inline;
- procedure SetEnableDepthClamp(const enabled: TGLboolean); inline;
- // Coloring state
- procedure SetClampReadColor(const Value: Cardinal); inline;
- procedure SetProvokingVertex(const Value: Cardinal); inline;
- // Rasterization state
- procedure SetPointSize(const Value: TGLfloat); inline;
- procedure SetPointFadeThresholdSize(const Value: TGLfloat); inline;
- procedure SetPointSpriteCoordOrigin(const Value: Cardinal); inline;
- procedure SetLineWidth(const Value: TGLfloat); inline;
- procedure SetLineStippleFactor(const Value: TGLint); inline;
- procedure SetLineStipplePattern(const Value: TGLushort); inline;
- procedure SetEnableLineSmooth(const Value: TGLboolean); inline;
- procedure SetEnableCullFace(const Value: TGLboolean); inline;
- procedure SetCullFaceMode(const Value: TGLCullFaceMode); inline;
- procedure SetFrontFace(const Value: TGLFaceWinding); inline;
- procedure SetEnablePolygonSmooth(const Value: TGLboolean); inline;
- procedure SetPolygonMode(const Value: TGLPolygonMode); inline;
- procedure SetPolygonOffsetFactor(const Value: TGLfloat); inline;
- procedure SetPolygonOffsetUnits(const Value: TGLfloat); inline;
- procedure SetEnablePolygonOffsetPoint(const Value: TGLboolean); inline;
- procedure SetEnablePolygonOffsetLine(const Value: TGLboolean); inline;
- procedure SetEnablePolygonOffsetFill(const Value: TGLboolean); inline;
- // Multisample state
- procedure SetEnableMultisample(const Value: TGLboolean); inline;
- procedure SetEnableSampleAlphaToCoverage(const Value: TGLboolean); inline;
- procedure SetEnableSampleAlphaToOne(const Value: TGLboolean); inline;
- procedure SetEnableSampleCoverage(const Value: TGLboolean); inline;
- procedure SetSampleCoverageValue(const Value: TGLfloat); inline;
- procedure SetSampleCoverageInvert(const Value: TGLboolean); inline;
- procedure SetEnableSampleMask(const Value: TGLboolean); inline;
- function GetSampleMaskValue(index: Integer): TGLbitfield; inline;
- procedure SetSampleMaskValue(index: Integer; const Value: TGLbitfield); inline;
- // Texture state
- function GetMaxTextureSize: Cardinal; inline;
- function GetMax3DTextureSize: Cardinal; inline;
- function GetMaxCubeTextureSize: Cardinal; inline;
- function GetMaxArrayTextureSize: Cardinal; inline;
- function GetMaxTextureImageUnits: Cardinal; inline;
- function GetMaxTextureAnisotropy: Cardinal; inline;
- function GetMaxSamples: Cardinal; inline;
- function GetTextureBinding(index: Integer; target: TGLTextureTarget): Cardinal; inline;
- function GetTextureBindingTime(index: Integer; target: TGLTextureTarget): Double; inline;
- procedure SetTextureBinding(index: Integer; target: TGLTextureTarget; const Value: Cardinal);
- function GetActiveTextureEnabled(target: TGLTextureTarget): Boolean; inline;
- procedure SetActiveTextureEnabled(target: TGLTextureTarget; const Value: Boolean); inline;
- function GetSamplerBinding(index: Cardinal): Cardinal; inline;
- procedure SetSamplerBinding(index: Cardinal; const Value: Cardinal); inline;
- // Active texture
- procedure SetActiveTexture(const Value: TGLint); inline;
- // Pixel operations
- procedure SetEnableScissorTest(const Value: TGLboolean); inline;
- procedure SetScissorBox(const Value: TVector4i); inline;
- procedure SetEnableStencilTest(const Value: TGLboolean); inline;
- procedure SetEnableDepthTest(const Value: TGLboolean); inline;
- procedure SetDepthFunc(const Value: TGLDepthFunction); inline;
- function GetEnableBlend(index: Integer): TGLboolean; inline;
- procedure SetEnableBlend(index: Integer; const Value: TGLboolean); inline;
- procedure SetBlendColor(const Value: TGLVector); inline;
- procedure SetEnableFramebufferSRGB(const Value: TGLboolean); inline;
- procedure SetEnableDither(const Value: TGLboolean); inline;
- procedure SetEnableColorLogicOp(const Value: TGLboolean); inline;
- procedure SetLogicOpMode(const Value: TGLLogicOp); inline;
- // Framebuffer control
- function GetColorWriteMask(index: Integer): TGLColorMask; inline;
- procedure SetColorWriteMask(index: Integer; const Value: TGLColorMask); inline;
- procedure SetDepthWriteMask(const Value: TGLboolean); inline;
- procedure SetStencilWriteMask(const Value: Cardinal); inline;
- procedure SetStencilBackWriteMask(const Value: Cardinal); inline;
- procedure SetColorClearValue(const Value: TGLVector); inline;
- procedure SetDepthClearValue(const Value: TGLfloat); inline;
- procedure SetStencilClearValue(const Value: Cardinal); inline;
- // Framebuffer
- procedure SetDrawFrameBuffer(const Value: Cardinal); inline;
- procedure SetReadFrameBuffer(const Value: Cardinal); inline;
- // Renderbuffer
- procedure SetRenderBuffer(const Value: Cardinal); inline;
- // Pixels
- procedure SetUnpackSwapBytes(const Value: TGLboolean); inline;
- procedure SetUnpackLSBFirst(const Value: TGLboolean); inline;
- procedure SetUnpackImageHeight(const Value: Cardinal); inline;
- procedure SetUnpackSkipImages(const Value: Cardinal); inline;
- procedure SetUnpackRowLength(const Value: Cardinal); inline;
- procedure SetUnpackSkipRows(const Value: Cardinal); inline;
- procedure SetUnpackSkipPixels(const Value: Cardinal); inline;
- procedure SetUnpackAlignment(const Value: Cardinal); inline;
- procedure SetPackSwapBytes(const Value: TGLboolean); inline;
- procedure SetPackLSBFirst(const Value: TGLboolean); inline;
- procedure SetPackImageHeight(const Value: Cardinal); inline;
- procedure SetPackSkipImages(const Value: Cardinal); inline;
- procedure SetPackRowLength(const Value: Cardinal); inline;
- procedure SetPackSkipRows(const Value: Cardinal); inline;
- procedure SetPackSkipPixels(const Value: Cardinal); inline;
- procedure SetPackAlignment(const Value: Cardinal); inline;
- procedure SetPixelPackBufferBinding(const Value: Cardinal);
- procedure SetPixelUnpackBufferBinding(const Value: Cardinal);
- // Program
- procedure SetCurrentProgram(const Value: Cardinal); inline;
- procedure SetUniformBufferBinding(const Value: Cardinal); inline;
- function GetMaxTextureUnits: Cardinal; inline;
- // Vector + Geometry Shader state
- function GetCurrentVertexAttrib(index: Integer): TGLVector; inline;
- procedure SetCurrentVertexAttrib(index: Integer; const Value: TGLVector); inline;
- procedure SetEnableProgramPointSize(const Value: TGLboolean); inline;
- // Transform Feedback state
- procedure SetTransformFeedbackBufferBinding(const Value: Cardinal); inline;
- // Hints
- procedure SetLineSmoothHint(const Value: TGLHintType); inline;
- procedure SetPolygonSmoothHint(const Value: TGLHintType); inline;
- procedure SetTextureCompressionHint(const Value: TGLHintType); inline;
- procedure SetFragmentShaderDerivitiveHint(const Value: TGLHintType); inline;
- procedure SetMultisampleFilterHint(const Value: TGLHintType); inline;
- // Misc
- function GetCurrentQuery(index: TGLQueryType): Cardinal; inline;
- // procedure SetCurrentQuery(Index: TQueryType; const Value: Cardinal);
- procedure SetCopyReadBufferBinding(const Value: Cardinal); inline;
- procedure SetCopyWriteBufferBinding(const Value: Cardinal); inline;
- procedure SetEnableTextureCubeMapSeamless(const Value: TGLboolean); inline;
- // Ligting
- procedure SetFFPLight(Value: Boolean); inline;
- function GetMaxLights: Integer; inline;
- function GetLightEnabling(I: Integer): Boolean; inline;
- procedure SetLightEnabling(I: Integer; Value: Boolean); inline;
- function GetLightPosition(I: Integer): TGLVector; inline;
- procedure SetLightPosition(I: Integer; const Value: TGLVector); inline;
- function GetLightSpotDirection(I: Integer): TAffineVector; inline;
- procedure SetLightSpotDirection(I: Integer; const Value: TAffineVector); inline;
- function GetLightAmbient(I: Integer): TGLVector; inline;
- procedure SetLightAmbient(I: Integer; const Value: TGLVector); inline;
- function GetLightDiffuse(I: Integer): TGLVector; inline;
- procedure SetLightDiffuse(I: Integer; const Value: TGLVector); inline;
- function GetLightSpecular(I: Integer): TGLVector; inline;
- procedure SetLightSpecular(I: Integer; const Value: TGLVector); inline;
- function GetSpotCutoff(I: Integer): Single; inline;
- procedure SetSpotCutoff(I: Integer; const Value: Single); inline;
- function GetSpotExponent(I: Integer): Single; inline;
- procedure SetSpotExponent(I: Integer; const Value: Single); inline;
- function GetConstantAtten(I: Integer): Single; inline;
- procedure SetConstantAtten(I: Integer; const Value: Single); inline;
- function GetLinearAtten(I: Integer): Single; inline;
- procedure SetLinearAtten(I: Integer; const Value: Single); inline;
- function GetQuadAtten(I: Integer): Single; inline;
- procedure SetQuadAtten(I: Integer; const Value: Single); inline;
- procedure SetForwardContext(Value: Boolean); inline;
- function GetMaterialAmbient(const aFace: TGLCullFaceMode): TGLVector; inline;
- function GetMaterialDiffuse(const aFace: TGLCullFaceMode): TGLVector; inline;
- function GetMaterialSpecular(const aFace: TGLCullFaceMode): TGLVector; inline;
- function GetMaterialEmission(const aFace: TGLCullFaceMode): TGLVector; inline;
- function GetMaterialShininess(const aFace: TGLCullFaceMode): Integer; inline;
- public
- constructor Create; virtual;
- destructor Destroy; override;
- procedure PushAttrib(const stateTypes: TGLStateTypes); inline;
- procedure PopAttrib(); inline;
- procedure Enable(const aState: TGLState);
- procedure Disable(const aState: TGLState);
- procedure PerformEnable(const aState: TGLState); inline;
- procedure PerformDisable(const aState: TGLState); inline;
- procedure SetGLState(const aState: TGLState); deprecated; inline;
- procedure UnSetGLState(const aState: TGLState); deprecated; inline;
- procedure ResetGLPolygonMode; deprecated; inline;
- procedure ResetGLMaterialColors; deprecated; inline;
- procedure ResetGLTexture(const TextureUnit: Integer); deprecated; inline;
- procedure ResetGLCurrentTexture; deprecated;
- procedure ResetGLFrontFace; deprecated;
- procedure SetGLFrontFaceCW; deprecated; inline;
- procedure ResetAll; deprecated; inline;
- // Adjusts material colors for a face
- procedure SetGLMaterialColors(const aFace: TGLCullFaceMode; const emission, Ambient, Diffuse, Specular: TGLVector;
- const shininess: Integer);
- property MaterialAmbient[const aFace: TGLCullFaceMode]: TGLVector read GetMaterialAmbient;
- property MaterialDiffuse[const aFace: TGLCullFaceMode]: TGLVector read GetMaterialDiffuse;
- property MaterialSpecular[const aFace: TGLCullFaceMode]: TGLVector read GetMaterialSpecular;
- property MaterialEmission[const aFace: TGLCullFaceMode]: TGLVector read GetMaterialEmission;
- property MaterialShininess[const aFace: TGLCullFaceMode]: Integer read GetMaterialShininess;
- // Adjusts material alpha channel for a face
- procedure SetGLMaterialAlphaChannel(const aFace: Cardinal; const alpha: TGLfloat);
- // Adjusts material diffuse color for a face
- procedure SetGLMaterialDiffuseColor(const aFace: Cardinal; const Diffuse: TGLVector);
- // Lighting states
- property FixedFunctionPipeLight: Boolean read FFFPLight write SetFFPLight;
- property MaxLights: Integer read GetMaxLights;
- property LightEnabling[Index: Integer]: Boolean read GetLightEnabling write SetLightEnabling;
- property LightPosition[Index: Integer]: TGLVector read GetLightPosition write SetLightPosition;
- property LightSpotDirection[Index: Integer]: TAffineVector read GetLightSpotDirection write SetLightSpotDirection;
- property LightAmbient[Index: Integer]: TGLVector read GetLightAmbient write SetLightAmbient;
- property LightDiffuse[Index: Integer]: TGLVector read GetLightDiffuse write SetLightDiffuse;
- property LightSpecular[Index: Integer]: TGLVector read GetLightSpecular write SetLightSpecular;
- property LightSpotCutoff[Index: Integer]: Single read GetSpotCutoff write SetSpotCutoff;
- property LightSpotExponent[Index: Integer]: Single read GetSpotExponent write SetSpotExponent;
- property LightConstantAtten[Index: Integer]: Single read GetConstantAtten write SetConstantAtten;
- property LightLinearAtten[Index: Integer]: Single read GetLinearAtten write SetLinearAtten;
- property LightQuadraticAtten[Index: Integer]: Single read GetQuadAtten write SetQuadAtten;
- function GetLightIndicesAsAddress: PGLInt;
- function GetLightStateAsAddress: Pointer;
- property LightNumber: Integer read FLightNumber;
- property OnLightsChanged: TGLOnLightsChanged read FOnLightsChanged write FOnLightsChanged;
- // Blending states
- procedure SetGLAlphaFunction(func: TGLComparisonFunction; ref: Single); inline;
- // Vertex Array Data state
- (* The currently bound array buffer (calling glVertexAttribPointer
- locks this buffer to the currently bound VBO). *)
- property VertexArrayBinding: Cardinal read FVertexArrayBinding write SetVertexArrayBinding;
- // The currently bound vertex buffer object (VAO)
- property ArrayBufferBinding: Cardinal read GetArrayBufferBinding write SetArrayBufferBinding;
- // The currently bound element buffer object (EBO)
- property ElementBufferBinding: Cardinal read GetElementBufferBinding write SetElementBufferBinding;
- // Determines whether primitive restart is turned on or off
- property EnablePrimitiveRestart: TGLboolean read GetEnablePrimitiveRestart write SetEnablePrimitiveRestart;
- // The index Value that causes a primitive restart
- property PrimitiveRestartIndex: Cardinal read GetPrimitiveRestartIndex write SetPrimitiveRestartIndex;
- // The currently bound texture buffer object (TBO)
- property TextureBufferBinding: Cardinal read FTextureBufferBinding write SetTextureBufferBinding;
- // Transformation state
- property ViewPort: TVector4i read FViewPort write SetViewPort;
- // Modifies the near + far clipping planes
- procedure SetDepthRange(const ZNear, ZFar: TGLclampd); inline;
- // The near clipping plane distance
- property DepthRangeNear: TGLclampd read GetDepthRangeNear write SetDepthRangeNear;
- // The far clipping plane distance
- property DepthRangeFar: TGLclampd read GetDepthRangeFar write SetDepthRangeFar;
- // Enables/Disables each of the clip distances, used in shaders
- property EnableClipDistance[Index: Cardinal]: TGLboolean read GetEnableClipDistance write SetEnableClipDistance;
- // Enables/Disables depth clamping
- property EnableDepthClamp: TGLboolean read FEnableDepthClamp write SetEnableDepthClamp;
- // Coloring state Controls read color clamping
- property ClampReadColor: Cardinal read FClampReadColor write SetClampReadColor;
- (* The provoking vertex used in flat shading. All the vertices of each
- primitive will the same value determined by this property. *)
- property ProvokingVertex: Cardinal read FProvokingVertex write SetProvokingVertex;
- // Rasterization state
- (* The default point size, used when EnableProgramPointSize = false *)
- property PointSize: TGLfloat read FPointSize write SetPointSize;
- // If multisampling is enabled, this can control when points are faded out
- property PointFadeThresholdSize: TGLfloat read FPointFadeThresholdSize write SetPointFadeThresholdSize;
- // The texture coordinate origin of point sprites
- property PointSpriteCoordOrigin: Cardinal read FPointSpriteCoordOrigin write SetPointSpriteCoordOrigin;
- // The line width
- property LineWidth: TGLfloat read FLineWidth write SetLineWidth;
- // The line stipple
- property LineStippleFactor: TGLint read FLineStippleFactor write SetLineStippleFactor;
- // The line stipple
- property LineStipplePattern: TGLushort read FLineStipplePattern write SetLineStipplePattern;
- // Enable/Disable line smoothing
- property EnableLineSmooth: TGLboolean read FEnableLineSmooth write SetEnableLineSmooth;
- // Enable/Disable face culling
- property EnableCullFace: TGLboolean read FEnableCullFace write SetEnableCullFace;
- // Selects which faces to cull: front, back or front+back
- property CullFaceMode: TGLCullFaceMode read FCullFaceMode write SetCullFaceMode;
- // The winding direction that indicates a front facing primitive
- property FrontFace: { Cardinal } TGLFaceWinding read FFrontFace write SetFrontFace;
- // Enables/Disables polygon smoothing.
- property EnablePolygonSmooth: TGLboolean read FEnablePolygonSmooth write SetEnablePolygonSmooth;
- // Whether polygons appear filled, lines or points
- property PolygonMode: TGLPolygonMode read FPolygonMode write SetPolygonMode;
- // Scales the maximum depth of the polygon
- property PolygonOffsetFactor: TGLfloat read FPolygonOffsetFactor write SetPolygonOffsetFactor;
- // Scales an implementation-dependent constant that relates to the usable resolution of the depth buffer
- property PolygonOffsetUnits: TGLfloat read FPolygonOffsetUnits write SetPolygonOffsetUnits;
- // Set polygon offset
- procedure SetPolygonOffset(const factor, units: TGLfloat);
- // Enable/Disable polygon offset for polygons in point mode
- property EnablePolygonOffsetPoint: TGLboolean read FEnablePolygonOffsetPoint write SetEnablePolygonOffsetPoint;
- // Enable/Disable polygon offset for polygons in line mode
- property EnablePolygonOffsetLine: TGLboolean read FEnablePolygonOffsetLine write SetEnablePolygonOffsetLine;
- // Enable/Disable polygon offset for polygons in fill mode
- property EnablePolygonOffsetFill: TGLboolean read FEnablePolygonOffsetFill write SetEnablePolygonOffsetFill;
- // Multisample state
- // Enable/Disable multisampling
- property EnableMultisample: TGLboolean read FEnableMultisample write SetEnableMultisample;
- // Enable/Disable sample alpha to coverage
- property EnableSampleAlphaToCoverage: TGLboolean read FEnableSampleAlphaToCoverage write SetEnableSampleAlphaToCoverage;
- // Enable/Disable sample alpha to one
- property EnableSampleAlphaToOne: TGLboolean read FEnableSampleAlphaToOne write SetEnableSampleAlphaToOne;
- // Enable/Disable sample coverage
- property EnableSampleCoverage: TGLboolean read FEnableSampleCoverage write SetEnableSampleCoverage;
- // Sample coverage Value
- property SampleCoverageValue: TGLfloat read FSampleCoverageValue write SetSampleCoverageValue;
- // Inverts sample coverage Value
- property SampleCoverageInvert: TGLboolean read FSampleCoverageInvert write SetSampleCoverageInvert;
- // Set sample coverage
- procedure SetSampleCoverage(const Value: TGLfloat; invert: TGLboolean);
- // Enable/Disable sample mask
- property EnableSampleMask: TGLboolean read FEnableSampleMask write SetEnableSampleMask;
- // Sample mask values
- property SampleMaskValue[Index: Integer]: TGLbitfield read GetSampleMaskValue write SetSampleMaskValue;
- // Textures
- // Textures bound to each texture unit + binding point.
- property TextureBinding[Index: Integer; target: TGLTextureTarget]: Cardinal read GetTextureBinding write SetTextureBinding;
- property TextureBindingTime[Index: Integer; target: TGLTextureTarget]: Double read GetTextureBindingTime;
- property ActiveTextureEnabled[target: TGLTextureTarget]: Boolean read GetActiveTextureEnabled write SetActiveTextureEnabled;
- property SamplerBinding[Index: Cardinal]: Cardinal read GetSamplerBinding write SetSamplerBinding;
- property MaxTextureSize: Cardinal read GetMaxTextureSize;
- property Max3DTextureSize: Cardinal read GetMax3DTextureSize;
- property MaxCubeTextureSize: Cardinal read GetMaxCubeTextureSize;
- property MaxArrayTextureSize: Cardinal read GetMaxArrayTextureSize;
- property MaxTextureImageUnits: Cardinal read GetMaxTextureImageUnits;
- property MaxTextureAnisotropy: Cardinal read GetMaxTextureAnisotropy;
- property MaxSamples: Cardinal read GetMaxSamples;
- // TODO: GL_TEXTURE_BUFFER_DATA_STORE_BINDING ?
- // Active texture
- (* The active texture unit. Valid values are 0 .. Max texture units. *)
- property ActiveTexture: TGLint read FActiveTexture write SetActiveTexture;
- // Pixel operations
- (* Enables/Disables scissor test. *)
- property EnableScissorTest: TGLboolean read FEnableScissorTest write SetEnableScissorTest;
- // The bounding box used in scissor test.
- property ScissorBox: TVector4i read FScissorBox write SetScissorBox;
- // Enables/Disables stencil test.
- property EnableStencilTest: TGLboolean read FEnableStencilTest write SetEnableStencilTest;
- (* The stencil function. Determines the comparison function to be used
- when comparing the reference + stored stencil values. *)
- property StencilFunc: TGLStencilFunction read FStencilFunc;
- // write SetStencilFunc;
- (* The stencil value mask. Masks both the reference + stored stencil values *)
- property StencilValueMask: Cardinal read FStencilValueMask;
- // write SetStencilValueMask;
- (* The stencil reference value. Clamped to 0..255 with an 8 bit stencil. *)
- property StencilRef: TGLint read FStencilRef; // write SetStencilRef;
- // The operation to perform when stencil test fails.
- property StencilFail: TGLStencilOp read FStencilFail; // write SetStencilFail;
- // The operation to perform when stencil test passes + depth test fails.
- property StencilPassDepthFail: TGLStencilOp read FStencilPassDepthFail;
- // write SetStencilPassDepthFail;
- (* The operation to perform when stencil test passes + depth test passes. *)
- property StencilPassDepthPass: TGLStencilOp read FStencilPassDepthPass;
- // write SetStencilPassDepthPass;
- (* The stencil back function. Determines the comparison function to be
- used when comparing the reference + stored stencil values on back facing primitives. *)
- property StencilBackFunc: TGLStencilFunction read FStencilBackFunc;
- // write SetStencilBackFunc;
- (* The stencil back value mask. Masks both the reference + stored stencil values. *)
- property StencilBackValueMask: Cardinal read FStencilBackValueMask;
- // write SetStencilBackValueMask;
- (* The stencil back reference value. Clamped to 0..255 with an 8 bit stencil. *)
- property StencilBackRef: Cardinal read FStencilBackRef;
- // write SetStencilBackRef;
- (* The operation to perform when stencil test fails on back facing primitives. *)
- property StencilBackFail: TGLStencilOp read FStencilBackFail;
- // write SetStencilBackFail;
- (* The operation to perform when stencil test passes + depth test fails on
- back facing primitives. *)
- property StencilBackPassDepthFail: TGLStencilOp read FStencilBackPassDepthFail;
- // write SetStencilBackPassDepthFail;
- (* The operation to perform when stencil test passes + depth test passes on
- back facing primitives. *)
- property StencilBackPassDepthPass: TGLStencilOp read FStencilBackPassDepthPass;
- // write SetStencilBackPassDepthPass;
- (* Used to set stencil Function, Reference + Mask values, for both front +
- back facing primitives. *)
- procedure SetStencilFunc(const func: TGLStencilFunction; const ref: TGLint; const mask: Cardinal); inline;
- (* Used to set stencil Function, Reference + Mask values for either the
- front or back facing primitives (or both, which is the same as calling
- SetStencilFunc). *)
- procedure SetStencilFuncSeparate(const face: TGLCullFaceMode; const func: TGLStencilFunction; const ref: TGLint;
- const mask: Cardinal); inline;
- // Used to set the StencilFail, StencilPassDepthFail + StencilPassDepthPass in one go.
- procedure SetStencilOp(const fail, zfail, zpass: TGLStencilOp); inline;
- (* Used to set the StencilFail, StencilPassDepthFail + StencilPassDepthPass
- in one go, for either front or back facing primitives. *)
- procedure SetStencilOpSeparate(const face: TGLCullFaceMode; const sfail, dpfail, dppass: TGLStencilOp); inline;
- // Enables/disables depth testing.
- property EnableDepthTest: TGLboolean read FEnableDepthTest write SetEnableDepthTest;
- (* The depth function. Used to determine whether to keep a fragment or
- discard it, depending on the current value stored in the depth buffer. *)
- property DepthFunc: TGLDepthFunction read FDepthFunc write SetDepthFunc;
- // Enables/disables blending for each draw buffer.
- property EnableBlend[Index: Integer]: TGLboolean read GetEnableBlend write SetEnableBlend;
- // The weighting factor used in blending equation, for source RGB.
- property BlendSrcRGB: TGLBlendFunction read FBlendSrcRGB;
- // write SetBlendSrcRGB;
- (* The weighting factor used in blending equation, for source alpha. *)
- property BlendSrcAlpha: TGLBlendFunction read FBlendSrcAlpha;
- // write SetBlendSrcAlpha;
- (* The weighting factor used in blending equation, for destination RGB. *)
- property BlendDstRGB: TGLDstBlendFunction read FBlendDstRGB;
- // write SetBlendDstRGB;
- (* The weighting factor used in blending equation, for destination alpha. *)
- property BlendDstAlpha: TGLDstBlendFunction read FBlendDstAlpha;
- // write SetBlendDstAlpha;
- (* Sets the weighting factors to be used by the blending equation, for both color + alpha *)
- procedure SetBlendFunc(const Src: TGLBlendFunction; const Dst: TGLDstBlendFunction); inline;
- (* Sets the weighting factors to be used by the blending equation, with
- separate values used for color + alpha components. *)
- procedure SetBlendFuncSeparate(const SrcRGB: TGLBlendFunction; const DstRGB: TGLDstBlendFunction;
- const SrcAlpha: TGLBlendFunction; const DstAlpha: TGLDstBlendFunction); inline;
- (* The blending equation. Determines how the incoming source fragment's
- RGB are combined with the destination RGB. *)
- property BlendEquationRGB: TGLBlendEquation read FBlendEquationRGB;
- // write SetBlendEquationRGB;
- (* The blending equation. Determines how the incoming source fragment's
- alpha values are combined with the destination alpha values. *)
- property BlendEquationAlpha: TGLBlendEquation read FBlendEquationAlpha;
- // write SetBlendEquationAlpha;
- // Sets the blend equation for RGB + alpha to the same value.
- procedure SetBlendEquation(const mode: TGLBlendEquation); inline;
- // Sets the blend equations for RGB + alpha separately.
- procedure SetBlendEquationSeparate(const modeRGB, modeAlpha: TGLBlendEquation); inline;
- // A constant blend color, that can be used in the blend equation.
- property BlendColor: TGLVector read FBlendColor write SetBlendColor;
- // Enables/disables framebuffer SRGB.
- property EnableFramebufferSRGB: TGLboolean read FEnableFramebufferSRGB write SetEnableFramebufferSRGB;
- // Enables/disables dithering.
- property EnableDither: TGLboolean read FEnableDither write SetEnableDither;
- // Enables/disables color logic op.
- property EnableColorLogicOp: TGLboolean read FEnableColorLogicOp write SetEnableColorLogicOp;
- // Logic op mode.
- property LogicOpMode: TGLLogicOp read FLogicOpMode write SetLogicOpMode;
- // The color write mask, for each draw buffer.
- property ColorWriteMask[Index: Integer]: TGLColorMask read GetColorWriteMask write SetColorWriteMask;
- // Set the color write mask for all draw buffers.
- procedure SetColorMask(mask: TGLColorMask); inline;
- // The depth write mask.
- property DepthWriteMask: TGLboolean read FDepthWriteMask write SetDepthWriteMask;
- // The stencil write mask.
- property StencilWriteMask: Cardinal read FStencilWriteMask write SetStencilWriteMask;
- // The stencil back write mask.
- property StencilBackWriteMask: Cardinal read FStencilBackWriteMask write SetStencilBackWriteMask;
- // The color clear value.
- property ColorClearValue: TGLVector read FColorClearValue write SetColorClearValue;
- // The depth clear value.
- property DepthClearValue: TGLfloat read FDepthClearValue write SetDepthClearValue;
- // The stencil clear value.
- property StencilClearValue: Cardinal read FStencilClearValue write SetStencilClearValue;
- // Framebuffer to be used for draw operations, 0 = default framebuffer.
- property DrawFrameBuffer: Cardinal read FDrawFrameBuffer write SetDrawFrameBuffer;
- // Framebuffer to be used for read operations, 0 = default framebuffer.
- property ReadFrameBuffer: Cardinal read FReadFrameBuffer write SetReadFrameBuffer;
- // set both draw + read framebuffer.
- procedure SetFrameBuffer(const Value: Cardinal); inline;
- // property FrameBuffer: Cardinal read FDrawFrameBuffer write SetFrameBuffer;
- // Renderbuffer currently bound render buffer.
- property RenderBuffer: Cardinal read FRenderBuffer write SetRenderBuffer;
- // Pixels
- (* Controls whether byte swapping occurs during pixel unpacking. *)
- property UnpackSwapBytes: TGLboolean read FUnpackSwapBytes write SetUnpackSwapBytes;
- // Whether unpacked data is required with LSB (least significant bit) first.
- property UnpackLSBFirst: TGLboolean read FUnpackLSBFirst write SetUnpackLSBFirst;
- // Unpack image height
- property UnpackImageHeight: Cardinal read FUnpackImageHeight write SetUnpackImageHeight;
- // Unpack skip images
- property UnpackSkipImages: Cardinal read FUnpackSkipImages write SetUnpackSkipImages;
- // Unpack row length
- property UnpackRowLength: Cardinal read FUnpackRowLength write SetUnpackRowLength;
- // Unpack skip rows
- property UnpackSkipRows: Cardinal read FUnpackSkipRows write SetUnpackSkipRows;
- // Unpack skip pixels
- property UnpackSkipPixels: Cardinal read FUnpackSkipPixels write SetUnpackSkipPixels;
- // Unpack alignment
- property UnpackAlignment: Cardinal read FUnpackAlignment write SetUnpackAlignment;
- // Controls whether byte swapping occurs during pixel packing
- property PackSwapBytes: TGLboolean read FPackSwapBytes write SetPackSwapBytes;
- // Whether packed data is required with LSB (least significant bit) first
- property PackLSBFirst: TGLboolean read FPackLSBFirst write SetPackLSBFirst;
- // Pack image height
- property PackImageHeight: Cardinal read FPackImageHeight write SetPackImageHeight;
- // Pack skip images
- property PackSkipImages: Cardinal read FPackSkipImages write SetPackSkipImages;
- // Pack row length
- property PackRowLength: Cardinal read FPackRowLength write SetPackRowLength;
- // Pack skip rows
- property PackSkipRows: Cardinal read FPackSkipRows write SetPackSkipRows;
- // Pack skip pixels
- property PackSkipPixels: Cardinal read FPackSkipPixels write SetPackSkipPixels;
- // Pack alignment
- property PackAlignment: Cardinal read FPackAlignment write SetPackAlignment;
- // Buffer bound for pixel packing (eg. ReadPixels)
- property PixelPackBufferBinding: Cardinal read FPixelPackBufferBinding write SetPixelPackBufferBinding;
- // Buffer bound for pixel unpacking (eg. Tex*Image)
- property PixelUnpackBufferBinding: Cardinal read FPixelUnpackBufferBinding write SetPixelUnpackBufferBinding;
- // Currently bound program
- property CurrentProgram: Cardinal read FCurrentProgram write SetCurrentProgram;
- property MaxTextureUnits: Cardinal read GetMaxTextureUnits;
- // Currently bound uniform buffer
- property UniformBufferBinding: Cardinal read FUniformBufferBinding write SetUniformBufferBinding;
- procedure SetBufferIndexedBinding(const Value: Cardinal; ATarget: TGLBufferBindingTarget; AIndex: Cardinal;
- ABufferSize: TGLsizeiptr); overload; inline;
- procedure SetBufferIndexedBinding(const Value: Cardinal; ATarget: TGLBufferBindingTarget; AIndex: Cardinal;
- AOffset: TGLintptr; ARangeSize: TGLsizeiptr); overload; inline;
- // Default values to be used when a vertex array is not used for that attribute
- property CurrentVertexAttrib[Index: Integer]: TGLVector read GetCurrentVertexAttrib write SetCurrentVertexAttrib;
- // Enables/disables program point size
- property EnableProgramPointSize: TGLboolean read FEnableProgramPointSize write SetEnableProgramPointSize;
- // Currently bound transform feedbac buffer
- property TransformFeedbackBufferBinding: Cardinal read FTransformFeedbackBufferBinding
- write SetTransformFeedbackBufferBinding;
- // Line smooth hint
- property LineSmoothHint: TGLHintType read FLineSmoothHint write SetLineSmoothHint;
- // Polygon smooth hint
- property PolygonSmoothHint: TGLHintType read FPolygonSmoothHint write SetPolygonSmoothHint;
- // Texture compression hint
- property TextureCompressionHint: TGLHintType read FTextureCompressionHint write SetTextureCompressionHint;
- // Fragment shader derivitive hint
- property FragmentShaderDerivitiveHint: TGLHintType read FFragmentShaderDerivitiveHint write SetFragmentShaderDerivitiveHint;
- property MultisampleFilterHint: TGLHintType read FMultisampleFilterHint write SetMultisampleFilterHint;
- // Current queries. Misc
- property CurrentQuery[Index: TGLQueryType]: Cardinal read GetCurrentQuery;
- // Begins a query of "Target" type. "Value" must be a valid query object
- procedure BeginQuery(const target: TGLQueryType; const Value: Cardinal); inline;
- // Ends current query of type "Target"
- procedure EndQuery(const target: TGLQueryType); inline;
- (* The buffer currently bound to the copy read buffer binding point, this
- is an extra binding point provided so that you don't need to overwrite
- other binding points to copy between buffers. *)
- property CopyReadBufferBinding: Cardinal read FCopyReadBufferBinding write SetCopyReadBufferBinding;
- (* The buffer currently bound to the copy write buffer binding point, this
- is an extra binding point provided so that you don't need to overwrite
- other binding points to copy between buffers. *)
- property CopyWriteBufferBinding: Cardinal read FCopyWriteBufferBinding write SetCopyWriteBufferBinding;
- // Enables/Disables seamless texture cube maps
- property EnableTextureCubeMapSeamless: TGLboolean read FEnableTextureCubeMapSeamless write SetEnableTextureCubeMapSeamless;
- // Indicates the current presence within the list
- property InsideList: Boolean read FInsideList;
- // Begin new display list
- procedure NewList(list: Cardinal; mode: Cardinal); inline;
- // End display list
- procedure EndList; inline;
- // Call display list
- procedure CallList(list: Cardinal); inline;
- // Defines the OpenGL texture matrix. Assumed texture mode is GL_MODELVIEW.
- procedure SetTextureMatrix(const matrix: TGLMatrix); inline;
- procedure ResetTextureMatrix; inline;
- procedure ResetAllTextureMatrix; inline;
- // note: needs to change to per draw-buffer
- procedure SetColorWriting(flag: Boolean); inline;
- // Inverts front face winding (CCW/CW)
- procedure InvertFrontFace; inline;
- // read only properties
- property States: TGLStates read FStates;
- // True for ignore deprecated and removed features in OpenGL 3x
- (* property ForwardContext: Boolean read FForwardContext write SetForwardContext; *)
- end;
- type
- TStateRecord = record
- GLConst: Cardinal;
- GLDeprecated: Boolean;
- end;
- const
- {$WARN SYMBOL_DEPRECATED OFF}
- cGLStateTypeToGLEnum: array [TGLStateType] of Cardinal = (
- GL_CURRENT_BIT, GL_POINT_BIT, GL_LINE_BIT, GL_POLYGON_BIT,
- GL_POLYGON_STIPPLE_BIT, GL_PIXEL_MODE_BIT, GL_LIGHTING_BIT, GL_FOG_BIT,
- GL_DEPTH_BUFFER_BIT, GL_ACCUM_BUFFER_BIT, GL_STENCIL_BUFFER_BIT,
- GL_VIEWPORT_BIT, GL_TRANSFORM_BIT, GL_ENABLE_BIT, GL_COLOR_BUFFER_BIT,
- GL_HINT_BIT, GL_EVAL_BIT, GL_LIST_BIT, GL_TEXTURE_BIT, GL_SCISSOR_BIT,
- GL_MULTISAMPLE_BIT);
- {$WARN SYMBOL_DEPRECATED ON}
- cGLStateToGLEnum: array[TGLState] of TStateRecord =
- ((GLConst: GL_ALPHA_TEST; GLDeprecated: True),
- (GLConst: GL_AUTO_NORMAL; GLDeprecated: True),
- (GLConst: GL_BLEND; GLDeprecated: False),
- (GLConst: GL_COLOR_MATERIAL; GLDeprecated: True),
- (GLConst: GL_CULL_FACE; GLDeprecated: False),
- (GLConst: GL_DEPTH_TEST; GLDeprecated: False),
- (GLConst: GL_DITHER; GLDeprecated: False),
- (GLConst: GL_FOG; GLDeprecated: True),
- (GLConst: GL_LIGHTING; GLDeprecated: True),
- (GLConst: GL_LINE_SMOOTH; GLDeprecated: True),
- (GLConst: GL_LINE_STIPPLE; GLDeprecated: True),
- (GLConst: GL_INDEX_LOGIC_OP; GLDeprecated: True),
- (GLConst: GL_COLOR_LOGIC_OP; GLDeprecated: False),
- (GLConst: GL_NORMALIZE; GLDeprecated: True),
- (GLConst: GL_POINT_SMOOTH; GLDeprecated: True),
- (GLConst: GL_POINT_SPRITE; GLDeprecated: True),
- (GLConst: GL_POLYGON_SMOOTH; GLDeprecated: True),
- (GLConst: GL_POLYGON_STIPPLE; GLDeprecated: True),
- (GLConst: GL_SCISSOR_TEST; GLDeprecated: False),
- (GLConst: GL_STENCIL_TEST; GLDeprecated: False),
- (GLConst: GL_POLYGON_OFFSET_POINT; GLDeprecated: False),
- (GLConst: GL_POLYGON_OFFSET_LINE; GLDeprecated: False),
- (GLConst: GL_POLYGON_OFFSET_FILL; GLDeprecated: False),
- (GLConst: GL_DEPTH_CLAMP; GLDeprecated: False)
- );
- cGLTexTypeToGLEnum: array[TGLTextureTarget] of Cardinal =
- (0, GL_TEXTURE_1D, GL_TEXTURE_2D, GL_TEXTURE_3D, GL_TEXTURE_1D_ARRAY,
- GL_TEXTURE_2D_ARRAY, GL_TEXTURE_RECTANGLE, GL_TEXTURE_BUFFER,
- GL_TEXTURE_CUBE_MAP, GL_TEXTURE_2D_MULTISAMPLE,
- GL_TEXTURE_2D_MULTISAMPLE_ARRAY, GL_TEXTURE_CUBE_MAP_ARRAY);
- cGLQueryTypeToGLEnum: array[TGLQueryType] of Cardinal =
- (GL_SAMPLES_PASSED, GL_PRIMITIVES_GENERATED,
- GL_TRANSFORM_FEEDBACK_PRIMITIVES_WRITTEN,
- GL_TIME_ELAPSED, GL_ANY_SAMPLES_PASSED);
- cGLStencilOpToGLEnum: array[TGLStencilOp] of Cardinal =
- (GL_KEEP, GL_ZERO, GL_REPLACE, GL_INCR, GL_DECR, GL_INVERT, GL_INCR_WRAP,
- GL_DECR_WRAP);
- cGLLogicOpToGLEnum: array[TGLLogicOp] of Cardinal =
- (GL_CLEAR, GL_AND, GL_AND_REVERSE, GL_COPY, GL_AND_INVERTED, GL_NOOP,
- GL_XOR, GL_OR, GL_NOR, GL_EQUIV, GL_INVERT, GL_OR_REVERSE,
- GL_COPY_INVERTED, GL_OR_INVERTED, GL_NAND, GL_SET);
- cGLComparisonFunctionToGLEnum: array[TGLComparisonFunction] of Cardinal =
- (GL_NEVER, GL_ALWAYS, GL_LESS, GL_LEQUAL, GL_EQUAL, GL_GREATER,
- GL_NOTEQUAL, GL_GEQUAL);
- cGLBlendFunctionToGLEnum: array[TGLBlendFunction] of Cardinal =
- (GL_ZERO, GL_ONE, GL_SRC_COLOR, GL_ONE_MINUS_SRC_COLOR, GL_DST_COLOR,
- GL_ONE_MINUS_DST_COLOR, GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA,
- GL_DST_ALPHA, GL_ONE_MINUS_DST_ALPHA, GL_CONSTANT_COLOR,
- GL_ONE_MINUS_CONSTANT_COLOR, GL_CONSTANT_ALPHA,
- GL_ONE_MINUS_CONSTANT_ALPHA, GL_SRC_ALPHA_SATURATE {valid for src only});
- cGLBlendEquationToGLEnum: array[TGLBlendEquation] of Cardinal =
- (GL_FUNC_ADD, GL_FUNC_SUBTRACT, GL_FUNC_REVERSE_SUBTRACT, GL_MIN,
- GL_MAX);
- cGLFaceWindingToGLEnum: array[TGLFaceWinding] of Cardinal =
- (GL_CCW, GL_CW);
- cGLPolygonModeToGLEnum: array[TGLPolygonMode] of Cardinal =
- (GL_FILL, GL_LINE, GL_POINT);
- cGLCullFaceModeToGLEnum: array[TGLCullFaceMode] of Cardinal =
- (GL_FRONT, GL_BACK, GL_FRONT_AND_BACK);
- cGLHintToGLEnum: array[TGLHintType] of Cardinal =
- (GL_DONT_CARE, GL_FASTEST, GL_NICEST);
- cGLBufferBindingTarget: array[TGLBufferBindingTarget] of Cardinal =
- (GL_UNIFORM_BUFFER, GL_TRANSFORM_FEEDBACK_BUFFER);
- implementation //------------------------------------------------------
- uses
- GLS.Context;
- // ------------------
- // ------------------ TGLStateCache ------------------
- // ------------------
- procedure TGLStateCache.BeginQuery(const target: TGLQueryType; const Value: Cardinal);
- begin
- Assert(FCurrentQuery[target] = 0, 'Can only have one query (of each type)' + ' running at a time');
- // Assert(glIsQuery(Value), 'Not a valid query');
- // if Value<>FCurrentQuery[Target] then
- begin
- FCurrentQuery[target] := Value;
- gl.BeginQuery(cGLQueryTypeToGLEnum[target], Value);
- end;
- end;
- constructor TGLStateCache.Create;
- var
- I: Integer;
- begin
- inherited;
- SetLength(FListStates, $FFFFF);
- FCurrentList := 0;
- // Material colors
- FFrontBackColors[0][0] := clrBlack;
- FFrontBackColors[0][1] := clrGray20;
- FFrontBackColors[0][2] := clrGray80;
- FFrontBackColors[0][3] := clrBlack;
- FFrontBackShininess[0] := 0;
- FFrontBackColors[1][0] := clrBlack;
- FFrontBackColors[1][1] := clrGray20;
- FFrontBackColors[1][2] := clrGray80;
- FFrontBackColors[1][3] := clrBlack;
- FFrontBackShininess[1] := 0;
- FAlphaFunc := cfAlways;
- // Lighting
- FFFPLight := True;
- FMaxLights := 0;
- FLightNumber := 0;
- for I := High(FLightEnabling) downto 0 do
- begin
- FLightEnabling[I] := False;
- FLightIndices[I] := 0;
- FLightStates.Position[I] := NullHmgVector;
- FLightStates.Ambient[I] := clrBlack;
- FLightStates.Diffuse[I] := clrBlack;
- FLightStates.Specular[I] := clrBlack;
- FLightStates.SpotDirection[I] := VectorMake(0.0, 0.0, -1.0, 0.0);
- FSpotCutoff[I] := 180.0;
- FLightStates.SpotCosCutoffExponent[I].X := -1;
- FLightStates.SpotCosCutoffExponent[I].Y := 0;
- FLightStates.Attenuation[I] := NullHmgVector;
- end;
- FLightStates.Diffuse[0] := clrWhite;
- FLightStates.Specular[0] := clrWhite;
- for I := High(FTextureMatrixIsIdentity) downto 0 do
- FTextureMatrixIsIdentity[I] := False;
- // FForwardContext := False;
- // Vertex Array Data state
- FVertexArrayBinding := 0;
- FTextureBufferBinding := 0;
- // Transformation state
- // FViewPort := Rect(0,0,0,0); // (0, 0, Width, Height)
- FDepthRange[0] := 0.0;
- FDepthRange[1] := 1.0;
- FillChar(FEnableClipDistance, sizeof(FEnableClipDistance), $00);
- FEnableDepthClamp := False;
- // Coloring state
- FClampReadColor := GL_FIXED_ONLY;
- FProvokingVertex := GL_LAST_VERTEX_CONVENTION;
- // Rasterization state
- FPointSize := 1.0;
- FPointFadeThresholdSize := 1.0;
- FPointSpriteCoordOrigin := GL_UPPER_LEFT;
- FLineWidth := 1.0;
- FLineStippleFactor := 1;
- FLineStipplePattern := $FFFF;
- FEnableLineSmooth := False;
- FEnableCullFace := False;
- FCullFaceMode := cmBack;
- FFrontFace := fwCounterClockWise;
- FEnablePolygonSmooth := False;
- FPolygonMode := pmFill;
- FPolygonOffsetFactor := 0.0;
- FPolygonOffsetUnits := 0.0;
- FEnablePolygonOffsetPoint := False;
- FEnablePolygonOffsetLine := False;
- FEnablePolygonOffsetFill := False;
- // Multisample state
- FEnableMultisample := True;
- FEnableSampleAlphaToCoverage := False;
- FEnableSampleAlphaToOne := False;
- FEnableSampleCoverage := False;
- FSampleCoverageValue := 1.0;
- FSampleCoverageInvert := False;
- FEnableSampleMask := False;
- FillChar(FSampleMaskValue, sizeof(FSampleMaskValue), $FF);
- // Texture state
- FillChar(FTextureBinding, sizeof(FTextureBinding), $00);
- FillChar(FActiveTextureEnabling, sizeof(FActiveTextureEnabling), $00);
- // Active texture state
- FActiveTexture := 0;
- // Pixel operation state
- FEnableScissorTest := False;
- // FScissorBox := Rect(0, 0, Width, Height);
- FEnableStencilTest := False;
- FStencilFunc := cfAlways;
- FStencilValueMask := $FFFFFFFF;
- FStencilRef := 0;
- FStencilFail := soKeep;
- FStencilPassDepthFail := soKeep;
- FStencilPassDepthPass := soKeep;
- FStencilBackFunc := cfAlways;
- FStencilBackValueMask := $FFFFFFFF;
- FStencilBackRef := 0;
- FStencilBackFail := soKeep;
- FStencilBackPassDepthPass := soKeep;
- FStencilBackPassDepthFail := soKeep;
- FEnableDepthTest := False;
- FDepthFunc := cfLess;
- FillChar(FEnableBlend, sizeof(FEnableBlend), $0);
- FBlendSrcRGB := bfOne;
- FBlendSrcAlpha := bfOne;
- FBlendDstRGB := bfZero;
- FBlendDstAlpha := bfZero;
- FBlendEquationRGB := beAdd;
- FBlendEquationAlpha := beAdd;
- FBlendColor := NullHmgVector;
- FEnableFramebufferSRGB := False;
- FEnableDither := True;
- FEnableColorLogicOp := False;
- FLogicOpMode := loCopy;
- // Framebuffer control state
- // for I := 0 to Length(FColorWriteMask) - 1 do
- // FColorWriteMask[i] := [ccRed, ccGreen, ccBlue, ccAlpha];
- FillChar(FColorWriteMask, sizeof(FColorWriteMask), $F);
- FDepthWriteMask := True;
- FStencilWriteMask := $FFFFFFFF;
- FStencilBackWriteMask := $FFFFFFFF;
- FColorClearValue := NullHmgVector;
- FDepthClearValue := 1.0;
- FStencilClearValue := 0;
- // Framebuffer state
- FDrawFrameBuffer := 0;
- FReadFrameBuffer := 0;
- // Renderbuffer state
- FRenderBuffer := 0;
- // Pixels state
- FUnpackSwapBytes := False;
- FUnpackLSBFirst := False;
- FUnpackImageHeight := 0;
- FUnpackSkipImages := 0;
- FUnpackRowLength := 0;
- FUnpackSkipRows := 0;
- FUnpackSkipPixels := 0;
- FUnpackAlignment := 4;
- FPackSwapBytes := False;
- FPackLSBFirst := False;
- FPackImageHeight := 0;
- FPackSkipImages := 0;
- FPackRowLength := 0;
- FPackSkipRows := 0;
- FPackSkipPixels := 0;
- FPackAlignment := 4;
- FPixelPackBufferBinding := 0;
- FPixelUnpackBufferBinding := 0;
- // Program state
- FCurrentProgram := 0;
- FUniformBufferBinding := 0;
- FillChar(FUBOStates[bbtUniform][0], SizeOf(FUBOStates), $00);
- // Vector + Geometry Shader state
- for I := 0 to Length(FCurrentVertexAttrib) - 1 do
- FCurrentVertexAttrib[I] := NullHmgPoint;
- FEnableProgramPointSize := False;
- // Transform Feedback state
- FTransformFeedbackBufferBinding := 0;
- // Hints state
- FTextureCompressionHint := hintDontCare;
- FPolygonSmoothHint := hintDontCare;
- FFragmentShaderDerivitiveHint := hintDontCare;
- FLineSmoothHint := hintDontCare;
- // Misc state
- FillChar(FCurrentQuery, sizeof(FCurrentQuery), $00);
- FCopyReadBufferBinding := 0;
- FCopyWriteBufferBinding := 0;
- FEnableTextureCubeMapSeamless := False;
- FInsideList := False;
- end;
- destructor TGLStateCache.Destroy;
- begin
- inherited;
- end;
- procedure TGLStateCache.EndQuery(const target: TGLQueryType);
- begin
- Assert(FCurrentQuery[target] <> 0, 'No query running');
- FCurrentQuery[target] := 0;
- gl.EndQuery(cGLQueryTypeToGLEnum[target]);
- end;
- procedure TGLStateCache.Enable(const aState: TGLState);
- begin
- { if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
- exit; }
- if not(aState in FStates) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttEnable)
- else
- Include(FStates, aState);
- {$IFDEF USE_CACHE_MISS_CHECK}
- if gl.IsEnabled(cGLStateToGLEnum[aState].GLConst) then
- GLSLogger.LogError(strStateCashMissing + 'Enable');
- {$ENDIF}
- gl.Enable(cGLStateToGLEnum[aState].GLConst);
- end;
- end;
- procedure TGLStateCache.Disable(const aState: TGLState);
- begin
- { if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
- exit; }
- if (aState in FStates) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttEnable)
- else
- Exclude(FStates, aState);
- {$IFDEF USE_CACHE_MISS_CHECK}
- if not gl.IsEnabled(cGLStateToGLEnum[aState].GLConst) then
- GLSLogger.LogError(strStateCashMissing + 'Disable');
- {$ENDIF}
- gl.Disable(cGLStateToGLEnum[aState].GLConst);
- if aState = stColorMaterial then
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- begin
- gl.Materialfv(GL_FRONT, GL_EMISSION, @FFrontBackColors[0][0]);
- gl.Materialfv(GL_FRONT, GL_AMBIENT, @FFrontBackColors[0][1]);
- gl.Materialfv(GL_FRONT, GL_DIFFUSE, @FFrontBackColors[0][2]);
- gl.Materialfv(GL_FRONT, GL_SPECULAR, @FFrontBackColors[0][3]);
- gl.Materiali(GL_FRONT, GL_SHININESS, FFrontBackShininess[0]);
- gl.Materialfv(GL_BACK, GL_EMISSION, @FFrontBackColors[1][0]);
- gl.Materialfv(GL_BACK, GL_AMBIENT, @FFrontBackColors[1][1]);
- gl.Materialfv(GL_BACK, GL_DIFFUSE, @FFrontBackColors[1][2]);
- gl.Materialfv(GL_BACK, GL_SPECULAR, @FFrontBackColors[1][3]);
- gl.Materiali(GL_BACK, GL_SHININESS, FFrontBackShininess[1]);
- end;
- end;
- end;
- procedure TGLStateCache.PerformEnable(const aState: TGLState);
- begin
- { if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
- exit; }
- Include(FStates, aState);
- gl.Enable(cGLStateToGLEnum[aState].GLConst);
- end;
- procedure TGLStateCache.PerformDisable(const aState: TGLState);
- begin
- { if cGLStateToGLEnum[aState].GLDeprecated and FForwardContext then
- exit; }
- Exclude(FStates, aState);
- gl.Disable(cGLStateToGLEnum[aState].GLConst);
- end;
- procedure TGLStateCache.PopAttrib;
- begin
- // TODO: replace with proper client side push/pop
- gl.PopAttrib();
- end;
- procedure TGLStateCache.PushAttrib(const stateTypes: TGLStateTypes);
- var
- tempFlag: Cardinal;
- I: Integer;
- begin
- // TODO: replace with proper client side push/pop
- tempFlag := 0;
- for I := Integer(Low(TGLStateType)) to Integer(high(TGLStateType)) do
- begin
- if TGLStateType(I) in stateTypes then
- begin
- tempFlag := tempFlag or cGLStateTypeToGLEnum[TGLStateType(I)];
- end;
- end;
- gl.PushAttrib(tempFlag);
- end;
- procedure TGLStateCache.SetGLMaterialColors(const aFace: TGLCullFaceMode;
- const emission, ambient, diffuse, specular: TGLVector;
- const shininess: Integer);
- var
- I: Integer;
- currentFace: Cardinal;
- begin
- { if FForwardContext then
- exit; }
- Assert((aFace = cmFront) or (aFace = cmBack), 'Only cmFront or cmBack supported');
- I := Integer(aFace);
- currentFace := cGLCullFaceModeToGLEnum[aFace];
- if FInsideList then
- begin
- gl.Materiali(currentFace, GL_SHININESS, shininess);
- gl.Materialfv(currentFace, GL_EMISSION, @emission);
- gl.Materialfv(currentFace, GL_AMBIENT, @Ambient);
- gl.Materialfv(currentFace, GL_DIFFUSE, @Diffuse);
- gl.Materialfv(currentFace, GL_SPECULAR, @Specular);
- Include(FListStates[FCurrentList], sttLighting);
- end
- else
- begin
- if (FFrontBackShininess[I] <> shininess) then
- begin
- gl.Materiali(currentFace, GL_SHININESS, shininess);
- FFrontBackShininess[I] := shininess;
- end;
- if not AffineVectorEquals(FFrontBackColors[I][0], emission) then
- begin
- gl.Materialfv(currentFace, GL_EMISSION, @emission);
- SetVector(FFrontBackColors[I][0], emission);
- end;
- if not AffineVectorEquals(FFrontBackColors[I][1], Ambient) then
- begin
- gl.Materialfv(currentFace, GL_AMBIENT, @Ambient);
- SetVector(FFrontBackColors[I][1], Ambient);
- end;
- if not VectorEquals(FFrontBackColors[I][2], Diffuse) then
- begin
- gl.Materialfv(currentFace, GL_DIFFUSE, @Diffuse);
- SetVector(FFrontBackColors[I][2], Diffuse);
- end;
- if not AffineVectorEquals(FFrontBackColors[I][3], Specular) then
- begin
- gl.Materialfv(currentFace, GL_SPECULAR, @Specular);
- SetVector(FFrontBackColors[I][3], Specular);
- end;
- end;
- end;
- procedure TGLStateCache.SetGLMaterialAlphaChannel(const aFace: Cardinal; const alpha: TGLfloat);
- var
- I: Integer;
- color: TVector4f;
- begin
- { if FForwardContext then Exit; }
- if not(stLighting in FStates) then
- begin
- // We need a temp variable, because FColor is cauched.
- gl.GetFloatv(GL_CURRENT_COLOR, @color);
- color.W := alpha;
- gl.Color4fv(@color);
- end
- else
- begin
- I := aFace - GL_FRONT;
- if (FFrontBackColors[I][2].W <> alpha) or FInsideList then
- begin
- if FInsideList then
- begin
- Include(FListStates[FCurrentList], sttLighting);
- gl.Materialfv(aFace, GL_DIFFUSE, @FFrontBackColors[I][2]);
- end
- else
- begin
- FFrontBackColors[I][2].W := alpha;
- gl.Materialfv(aFace, GL_DIFFUSE, @FFrontBackColors[I][2]);
- end;
- end;
- end;
- end;
- procedure TGLStateCache.SetGLMaterialDiffuseColor(const aFace: Cardinal; const Diffuse: TGLVector);
- var
- I: Integer;
- begin
- { if FForwardContext then Exit; }
- if not(stLighting in FStates) then
- begin
- gl.Color4fv(@Diffuse);
- end
- else
- begin
- //
- I := aFace - GL_FRONT;
- if (not VectorEquals(FFrontBackColors[I][2], Diffuse)) or FInsideList then
- begin
- if FInsideList then
- begin
- Include(FListStates[FCurrentList], sttLighting);
- gl.Materialfv(aFace, GL_DIFFUSE, @FFrontBackColors[I][2]);
- end
- else
- begin
- FFrontBackColors[I][2] := Diffuse;
- gl.Materialfv(aFace, GL_DIFFUSE, @Diffuse);
- end;
- end;
- end;
- end;
- procedure TGLStateCache.SetActiveTexture(const Value: TGLint);
- begin
- if gl.ARB_multitexture then
- if (Value <> FActiveTexture) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttTexture)
- else
- FActiveTexture := Value;
- gl.ActiveTexture(GL_TEXTURE0 + Value);
- end;
- end;
- procedure TGLStateCache.SetVertexArrayBinding(const Value: Cardinal);
- begin
- if Value <> FVertexArrayBinding then
- begin
- FVertexArrayBinding := Value;
- gl.BindVertexArray(Value);
- end;
- end;
- function TGLStateCache.GetArrayBufferBinding: Cardinal;
- begin
- Result := FArrayBufferBinding;
- end;
- procedure TGLStateCache.SetArrayBufferBinding(const Value: Cardinal);
- begin
- if (Value <> FArrayBufferBinding) or (FVertexArrayBinding <> 0) then
- begin
- FArrayBufferBinding := Value;
- gl.BindBuffer(GL_ARRAY_BUFFER, Value);
- end;
- end;
- function TGLStateCache.GetElementBufferBinding: Cardinal;
- begin
- Result := FElementBufferBinding
- end;
- procedure TGLStateCache.SetElementBufferBinding(const Value: Cardinal);
- begin
- if (Value <> FElementBufferBinding) or (FVertexArrayBinding <> 0) then
- begin
- FElementBufferBinding := Value;
- gl.BindBuffer(GL_ELEMENT_ARRAY_BUFFER, Value);
- end;
- end;
- function TGLStateCache.GetEnablePrimitiveRestart: TGLboolean;
- begin
- Result := FEnablePrimitiveRestart;
- end;
- procedure TGLStateCache.SetEnablePrimitiveRestart(const enabled: TGLboolean);
- begin
- if enabled <> FEnablePrimitiveRestart then
- begin
- FEnablePrimitiveRestart := enabled;
- if GL.NV_primitive_restart then
- begin
- if enabled then
- gl.EnableClientState(GL_PRIMITIVE_RESTART_NV)
- else
- gl.DisableClientState(GL_PRIMITIVE_RESTART_NV);
- end
- else
- begin
- if enabled then
- gl.Enable(GL_PRIMITIVE_RESTART)
- else
- gl.Disable(GL_PRIMITIVE_RESTART);
- end;
- end;
- end;
- function TGLStateCache.GetPrimitiveRestartIndex: Cardinal;
- begin
- Result := FPrimitiveRestartIndex;
- end;
- procedure TGLStateCache.SetPrimitiveRestartIndex(const index: Cardinal);
- begin
- if index <> FPrimitiveRestartIndex then
- begin
- if gl.NV_primitive_restart then
- begin
- FPrimitiveRestartIndex := index;
- gl.PrimitiveRestartIndex(index)
- end;
- end;
- end;
- procedure TGLStateCache.SetEnableProgramPointSize(const Value: TGLboolean);
- begin
- if Value <> FEnableProgramPointSize then
- begin
- FEnableProgramPointSize := Value;
- if Value then
- gl.Enable(GL_PROGRAM_POINT_SIZE)
- else
- gl.Disable(GL_PROGRAM_POINT_SIZE);
- end;
- end;
- procedure TGLStateCache.SetBlendColor(const Value: TGLVector);
- begin
- if not VectorEquals(Value, FBlendColor) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- FBlendColor := Value;
- gl.BlendColor(Value.X, Value.Y, Value.Z, Value.W);
- end;
- end;
- procedure TGLStateCache.SetBlendEquationSeparate(const modeRGB, modeAlpha: TGLBlendEquation);
- begin
- if (modeRGB <> FBlendEquationRGB) or (modeAlpha <> FBlendEquationAlpha) or FInsideList then
- begin
- FBlendEquationRGB := modeRGB;
- FBlendEquationAlpha := modeAlpha;
- gl.BlendEquationSeparate(cGLBlendEquationToGLEnum[modeRGB], cGLBlendEquationToGLEnum[modeAlpha]);
- end;
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer);
- end;
- procedure TGLStateCache.SetBlendEquation(const mode: TGLBlendEquation);
- begin
- if (mode <> FBlendEquationRGB) or (mode <> FBlendEquationAlpha) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- begin
- FBlendEquationRGB := mode;
- FBlendEquationAlpha := mode;
- end;
- gl.BlendEquation(cGLBlendEquationToGLEnum[mode]);
- end;
- end;
- procedure TGLStateCache.SetBlendFunc(const Src: TGLBlendFunction; const Dst: TGLDstBlendFunction);
- begin
- if (Src <> FBlendSrcRGB) or (Dst <> FBlendDstRGB) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- begin
- FBlendSrcRGB := Src;
- FBlendDstRGB := Dst;
- FBlendSrcAlpha := Src;
- FBlendSrcAlpha := Dst;
- end;
- gl.BlendFunc(cGLBlendFunctionToGLEnum[Src], cGLBlendFunctionToGLEnum[Dst]);
- end;
- end;
- procedure TGLStateCache.SetBlendFuncSeparate(const SrcRGB: TGLBlendFunction;
- const DstRGB: TGLDstBlendFunction; const SrcAlpha: TGLBlendFunction; const DstAlpha: TGLDstBlendFunction);
- begin
- if (SrcRGB <> FBlendSrcRGB) or (DstRGB <> FBlendDstRGB) or
- (SrcAlpha <> FBlendSrcAlpha) or (DstAlpha <> FBlendDstAlpha)
- or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- begin
- FBlendSrcRGB := SrcRGB;
- FBlendDstRGB := DstRGB;
- FBlendSrcAlpha := SrcAlpha;
- FBlendDstAlpha := DstAlpha;
- end;
- gl.BlendFuncSeparate(
- cGLBlendFunctionToGLEnum[SrcRGB],
- cGLBlendFunctionToGLEnum[DstRGB],
- cGLBlendFunctionToGLEnum[SrcAlpha],
- cGLBlendFunctionToGLEnum[DstAlpha]);
- end;
- end;
- procedure TGLStateCache.SetClampReadColor(const Value: Cardinal);
- begin
- if (Value <> FClampReadColor) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- FClampReadColor := Value;
- gl.ClampColor(GL_CLAMP_READ_COLOR, Value);
- end;
- end;
- procedure TGLStateCache.SetColorWriteMask(index: Integer; const Value: TGLColorMask);
- begin
- if FColorWriteMask[Index] <> Value then
- begin
- FColorWriteMask[Index] := Value;
- gl.ColorMaski(Index, ccRed in Value, ccGreen in Value, ccBlue in Value, ccAlpha in Value);
- end;
- end;
- procedure TGLStateCache.SetCopyReadBufferBinding(const Value: Cardinal);
- begin
- if Value <> FCopyReadBufferBinding then
- begin
- FCopyReadBufferBinding := Value;
- gl.BindBuffer(GL_COPY_READ_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetCopyWriteBufferBinding(const Value: Cardinal);
- begin
- if Value <> FCopyWriteBufferBinding then
- begin
- FCopyWriteBufferBinding := Value;
- gl.BindBuffer(GL_COPY_WRITE_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetCullFaceMode(const Value: TGLCullFaceMode);
- begin
- if (Value <> FCullFaceMode) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPolygon)
- else
- FCullFaceMode := Value;
- gl.CullFace(cGLCullFaceModeToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetCurrentProgram(const Value: Cardinal);
- begin
- if Value <> FCurrentProgram then
- begin
- FCurrentProgram := Value;
- gl.UseProgram(Value);
- end;
- end;
- procedure TGLStateCache.SetTextureBufferBinding(const Value: Cardinal);
- begin
- if Value <> FTextureBufferBinding then
- begin
- FTextureBufferBinding := Value;
- gl.BindBuffer(GL_TEXTURE_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetCurrentVertexAttrib(index: Integer; const Value: TGLVector);
- begin
- if not VectorEquals(Value, FCurrentVertexAttrib[Index]) then
- begin
- FCurrentVertexAttrib[Index] := Value;
- gl.VertexAttrib4fv(Index, @Value.X);
- end;
- end;
- procedure TGLStateCache.SetDepthClearValue(const Value: TGLfloat);
- begin
- if (Value <> FDepthClearValue) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttDepthBuffer)
- else
- FDepthClearValue := Value;
- gl.ClearDepth(Value);
- end;
- end;
- procedure TGLStateCache.SetDepthFunc(const Value: TGLDepthFunction);
- begin
- if (Value <> FDepthFunc) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttDepthBuffer)
- else
- FDepthFunc := Value;
- gl.DepthFunc(cGLComparisonFunctionToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetDepthRange(const ZNear, ZFar: TGLclampd);
- begin
- if (ZNear <> FDepthRange[0]) or (ZFar <> FDepthRange[1]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttViewport)
- else
- begin
- FDepthRange[0] := ZNear;
- FDepthRange[1] := ZFar;
- end;
- gl.DepthRange(ZNear, ZFar);
- end;
- end;
- procedure TGLStateCache.SetDepthRangeFar(const Value: TGLclampd);
- begin
- if (Value <> FDepthRange[1]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttViewport)
- else
- FDepthRange[1] := Value;
- gl.DepthRange(FDepthRange[0], Value);
- end;
- end;
- procedure TGLStateCache.SetDepthRangeNear(const Value: TGLclampd);
- begin
- if (Value <> FDepthRange[0]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttViewport)
- else
- FDepthRange[0] := Value;
- gl.DepthRange(Value, FDepthRange[1]);
- end;
- end;
- procedure TGLStateCache.SetDepthWriteMask(const Value: TGLboolean);
- begin
- if (Value <> FDepthWriteMask) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttDepthBuffer)
- else
- FDepthWriteMask := Value;
- gl.DepthMask(Value);
- end;
- end;
- procedure TGLStateCache.SetDrawFrameBuffer(const Value: Cardinal);
- begin
- if Value <> FDrawFrameBuffer then
- begin
- FDrawFrameBuffer := Value;
- gl.BindFramebuffer(GL_DRAW_FRAMEBUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetEnableBlend(index: Integer; const Value: TGLboolean);
- begin
- if FEnableBlend[Index] <> Value then
- begin
- FEnableBlend[Index] := Value;
- if Value then
- gl.Enablei(GL_BLEND, Index)
- else
- gl.Disablei(GL_BLEND, Index);
- end;
- end;
- procedure TGLStateCache.SetEnableClipDistance(index: Cardinal; const Value: TGLboolean);
- begin
- if FEnableClipDistance[Index] <> Value then
- begin
- FEnableClipDistance[Index] := Value;
- if Value then
- gl.Enable(GL_CLIP_DISTANCE0 + Index)
- else
- gl.Disable(GL_CLIP_DISTANCE0 + Index);
- end;
- end;
- procedure TGLStateCache.SetEnableColorLogicOp(const Value: TGLboolean);
- begin
- if Value <> FEnableColorLogicOp then
- begin
- FEnableColorLogicOp := Value;
- if Value then
- gl.Enable(GL_COLOR_LOGIC_OP)
- else
- gl.Disable(GL_COLOR_LOGIC_OP);
- end;
- end;
- procedure TGLStateCache.SetEnableCullFace(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableDepthClamp(const enabled: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableDepthTest(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableDither(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableFramebufferSRGB(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableLineSmooth(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableMultisample(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnablePolygonOffsetFill(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnablePolygonOffsetLine(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnablePolygonOffsetPoint(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnablePolygonSmooth(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableSampleAlphaToCoverage(const Value: TGLboolean);
- begin
- if Value <> FEnableSampleAlphaToCoverage then
- begin
- FEnableSampleAlphaToCoverage := Value;
- if Value then
- gl.Enable(GL_SAMPLE_ALPHA_TO_COVERAGE)
- else
- gl.Disable(GL_SAMPLE_ALPHA_TO_COVERAGE);
- end;
- end;
- procedure TGLStateCache.SetEnableSampleCoverage(const Value: TGLboolean);
- begin
- if Value <> FEnableSampleCoverage then
- begin
- FEnableSampleCoverage := Value;
- if Value then
- gl.Enable(GL_SAMPLE_COVERAGE)
- else
- gl.Disable(GL_SAMPLE_COVERAGE);
- end;
- end;
- procedure TGLStateCache.SetEnableSampleMask(const Value: TGLboolean);
- begin
- if Value <> FEnableSampleMask then
- begin
- FEnableSampleMask := Value;
- if Value then
- gl.Enable(GL_SAMPLE_MASK)
- else
- gl.Disable(GL_SAMPLE_MASK);
- end;
- end;
- procedure TGLStateCache.SetEnableSampleAlphaToOne(const Value: TGLboolean);
- begin
- if Value <> FEnableSampleAlphaToOne then
- begin
- FEnableSampleAlphaToOne := Value;
- if Value then
- gl.Enable(GL_SAMPLE_ALPHA_TO_ONE)
- else
- gl.Disable(GL_SAMPLE_ALPHA_TO_ONE);
- end;
- end;
- procedure TGLStateCache.SetEnableScissorTest(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetEnableStencilTest(const Value: TGLboolean);
- begin
- end;
- procedure TGLStateCache.SetFragmentShaderDerivitiveHint(const Value: TGLHintType);
- begin
- if Value <> FFragmentShaderDerivitiveHint then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttHint)
- else
- FFragmentShaderDerivitiveHint := Value;
- gl.Hint(GL_FRAGMENT_SHADER_DERIVATIVE_HINT, cGLHintToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetMultisampleFilterHint(const Value: TGLHintType);
- begin
- if GL.NV_multisample_filter_hint then
- if Value <> FMultisampleFilterHint then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttHint)
- else
- FMultisampleFilterHint := Value;
- gl.Hint(GL_MULTISAMPLE_FILTER_HINT_NV, cGLHintToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetFrameBuffer(const Value: Cardinal);
- begin
- if (Value <> FDrawFrameBuffer) or (Value <> FReadFrameBuffer) or FInsideList then
- begin
- FDrawFrameBuffer := Value;
- FReadFrameBuffer := Value;
- gl.BindFramebuffer(GL_FRAMEBUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetFrontFace(const Value: TGLFaceWinding);
- begin
- if (Value <> FFrontFace) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPolygon)
- else
- FFrontFace := Value;
- gl.FrontFace(cGLFaceWindingToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetGLAlphaFunction(func: TGLComparisonFunction; ref: Single);
- {$IFDEF USE_CACHE_MISS_CHECK}
- var
- I: Cardinal;
- E: Single;
- {$ENDIF}
- begin
- { if FForwardContext then
- exit; }
- {$IFDEF USE_CACHE_MISS_CHECK}
- gl.GetIntegerv(GL_ALPHA_TEST_FUNC, @I);
- if cGLComparisonFunctionToGLEnum[FAlphaFunc] <> I then
- GLSLogger.LogError(strStateCashMissing + 'AlphaTest function');
- gl.GetFloatv(GL_ALPHA_TEST_REF, @E);
- if FAlphaRef <> E then
- GLSLogger.LogError(strStateCashMissing + 'AlphaTest reference');
- {$ENDIF}
- if (FAlphaFunc <> func) or (FAlphaRef <> ref) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- begin
- FAlphaFunc := func;
- FAlphaRef := ref;
- end;
- gl.AlphaFunc(cGLComparisonFunctionToGLEnum[func], ref);
- end;
- end;
- function TGLStateCache.GetColorWriteMask(index: Integer): TGLColorMask;
- begin
- Result := FColorWriteMask[Index];
- end;
- function TGLStateCache.GetCurrentQuery(index: TGLQueryType): Cardinal;
- begin
- Result := FCurrentQuery[Index];
- end;
- function TGLStateCache.GetCurrentVertexAttrib(index: Integer): TGLVector;
- begin
- Result := FCurrentVertexAttrib[Index];
- end;
- function TGLStateCache.GetDepthRangeFar: TGLclampd;
- begin
- Result := FDepthRange[1];
- end;
- function TGLStateCache.GetDepthRangeNear: TGLclampd;
- begin
- Result := FDepthRange[0];
- end;
- function TGLStateCache.GetEnableBlend(index: Integer): TGLboolean;
- begin
- Result := FEnableBlend[Index];
- end;
- function TGLStateCache.GetEnableClipDistance(ClipDistance: Cardinal): TGLboolean;
- begin
- Result := FEnableClipDistance[ClipDistance];
- end;
- function TGLStateCache.GetSampleMaskValue(index: Integer): TGLbitfield;
- begin
- Result := FSampleMaskValue[Index];
- end;
- function TGLStateCache.GetMaxTextureSize: Cardinal;
- begin
- if FMaxTextureSize = 0 then
- gl.GetIntegerv(GL_MAX_TEXTURE_SIZE, @FMaxTextureSize);
- Result := FMaxTextureSize;
- end;
- function TGLStateCache.GetMaterialAmbient(const aFace: TGLCullFaceMode): TGLVector;
- begin
- Result := FFrontBackColors[ord(aFace)][1];
- end;
- function TGLStateCache.GetMaterialDiffuse(const aFace: TGLCullFaceMode): TGLVector;
- begin
- Result := FFrontBackColors[ord(aFace)][2];
- end;
- function TGLStateCache.GetMaterialEmission(const aFace: TGLCullFaceMode): TGLVector;
- begin
- Result := FFrontBackColors[ord(aFace)][0];
- end;
- function TGLStateCache.GetMaterialShininess(const aFace: TGLCullFaceMode): Integer;
- begin
- Result := FFrontBackShininess[ord(aFace)];
- end;
- function TGLStateCache.GetMaterialSpecular(const aFace: TGLCullFaceMode): TGLVector;
- begin
- Result := FFrontBackColors[ord(aFace)][3];
- end;
- function TGLStateCache.GetMax3DTextureSize: Cardinal;
- begin
- if FMax3DTextureSize = 0 then
- gl.GetIntegerv(GL_MAX_3D_TEXTURE_SIZE, @FMax3DTextureSize);
- Result := FMax3DTextureSize;
- end;
- function TGLStateCache.GetMaxCubeTextureSize: Cardinal;
- begin
- if FMaxCubeTextureSize = 0 then
- gl.GetIntegerv(GL_MAX_CUBE_MAP_TEXTURE_SIZE, @FMaxCubeTextureSize);
- Result := FMaxCubeTextureSize;
- end;
- function TGLStateCache.GetMaxArrayTextureSize: Cardinal;
- begin
- if FMaxArrayTextureSize = 0 then
- gl.GetIntegerv(GL_MAX_ARRAY_TEXTURE_LAYERS, @FMaxArrayTextureSize);
- Result := FMaxArrayTextureSize;
- end;
- function TGLStateCache.GetMaxTextureImageUnits: Cardinal;
- begin
- if FMaxTextureImageUnits = 0 then
- gl.GetIntegerv(GL_MAX_TEXTURE_IMAGE_UNITS, @FMaxTextureImageUnits);
- Result := FMaxTextureImageUnits;
- end;
- function TGLStateCache.GetMaxTextureAnisotropy: Cardinal;
- begin
- if (FMaxTextureAnisotropy = 0) and GL.EXT_texture_filter_anisotropic then
- gl.GetIntegerv(GL_MAX_TEXTURE_MAX_ANISOTROPY_EXT, @FMaxTextureAnisotropy);
- Result := FMaxTextureAnisotropy;
- end;
- function TGLStateCache.GetMaxSamples: Cardinal;
- begin
- if (FMaxSamples = 0) and GL.EXT_multisample then
- gl.GetIntegerv(GL_MAX_SAMPLES, @FMaxSamples);
- Result := FMaxSamples;
- end;
- function TGLStateCache.GetTextureBinding(index: Integer; target: TGLTextureTarget): Cardinal;
- begin
- Result := FTextureBinding[Index, target];
- end;
- function TGLStateCache.GetTextureBindingTime(index: Integer; target: TGLTextureTarget): Double;
- begin
- Result := FTextureBindingTime[Index, target];
- end;
- function TGLStateCache.GetSamplerBinding(index: Cardinal): Cardinal;
- begin
- Result := FSamplerBinding[Index];
- end;
- procedure TGLStateCache.SetSamplerBinding(index: Cardinal; const Value: Cardinal);
- begin
- if Index > High(FSamplerBinding) then
- exit;
- if (Value <> FSamplerBinding[Index]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttTexture)
- else
- FSamplerBinding[Index] := Value;
- gl.BindSampler(Index, Value);
- end;
- end;
- procedure TGLStateCache.SetTextureMatrix(const matrix: TGLMatrix);
- begin
- { if FForwardContext then
- exit; }
- if FInsideList then
- Include(FListStates[FCurrentList], sttTransform)
- else
- FTextureMatrixIsIdentity[ActiveTexture] := False;
- gl.MatrixMode(GL_TEXTURE);
- gl.LoadMatrixf(PGLFloat(@matrix.V[0].X));
- gl.MatrixMode(GL_MODELVIEW);
- end;
- procedure TGLStateCache.ResetTextureMatrix;
- begin
- { if FForwardContext then
- exit; }
- gl.MatrixMode(GL_TEXTURE);
- gl.LoadIdentity;
- FTextureMatrixIsIdentity[ActiveTexture] := True;
- gl.MatrixMode(GL_MODELVIEW);
- end;
- procedure TGLStateCache.ResetAllTextureMatrix;
- var
- I: Integer;
- lastActiveTexture: Cardinal;
- begin
- { if FForwardContext then
- exit; }
- lastActiveTexture := ActiveTexture;
- gl.MatrixMode(GL_TEXTURE);
- for I := High(FTextureMatrixIsIdentity) downto 0 do
- if not FTextureMatrixIsIdentity[I] then
- begin
- ActiveTexture := I;
- gl.LoadIdentity;
- FTextureMatrixIsIdentity[I] := True;
- end;
- gl.MatrixMode(GL_MODELVIEW);
- ActiveTexture := lastActiveTexture;
- end;
- procedure TGLStateCache.SetLineSmoothHint(const Value: TGLHintType);
- begin
- if (Value <> FLineSmoothHint) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttHint)
- else
- FLineSmoothHint := Value;
- gl.Hint(GL_LINE_SMOOTH_HINT, cGLHintToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetLineWidth(const Value: TGLfloat);
- begin
- // note: wide lines no longer deprecated (see OpenGL spec)
- if (Value <> FLineWidth) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLine)
- else
- FLineWidth := Value;
- gl.LineWidth(Value);
- end;
- end;
- procedure TGLStateCache.SetLineStippleFactor(const Value: TGLint);
- begin
- if (Value <> FLineStippleFactor) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLine)
- else
- FLineStippleFactor := Value;
- gl.LineStipple(Value, FLineStipplePattern);
- end;
- end;
- procedure TGLStateCache.SetLineStipplePattern(const Value: TGLushort);
- begin
- if (Value <> FLineStipplePattern) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLine)
- else
- FLineStipplePattern := Value;
- gl.LineStipple(FLineStippleFactor, Value);
- end;
- end;
- procedure TGLStateCache.SetLogicOpMode(const Value: TGLLogicOp);
- begin
- if (Value <> FLogicOpMode) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- FLogicOpMode := Value;
- gl.LogicOp(cGLLogicOpToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetPackAlignment(const Value: Cardinal);
- begin
- if Value <> FPackAlignment then
- begin
- FPackAlignment := Value;
- gl.PixelStoref(GL_PACK_ALIGNMENT, Value);
- end;
- end;
- procedure TGLStateCache.SetPackImageHeight(const Value: Cardinal);
- begin
- if Value <> FPackImageHeight then
- begin
- FPackImageHeight := Value;
- gl.PixelStoref(GL_PACK_IMAGE_HEIGHT, Value);
- end;
- end;
- procedure TGLStateCache.SetPackLSBFirst(const Value: TGLboolean);
- begin
- if Value <> FPackLSBFirst then
- begin
- FPackLSBFirst := Value;
- gl.PixelStorei(GL_PACK_LSB_FIRST, byte(Value));
- end;
- end;
- procedure TGLStateCache.SetPackRowLength(const Value: Cardinal);
- begin
- if Value <> FPackRowLength then
- begin
- FPackRowLength := Value;
- gl.PixelStoref(GL_PACK_ROW_LENGTH, Value);
- end;
- end;
- procedure TGLStateCache.SetPackSkipImages(const Value: Cardinal);
- begin
- if Value <> FPackSkipImages then
- begin
- FPackSkipImages := Value;
- gl.PixelStoref(GL_PACK_SKIP_IMAGES, Value);
- end;
- end;
- procedure TGLStateCache.SetPackSkipPixels(const Value: Cardinal);
- begin
- if Value <> FPackSkipPixels then
- begin
- FPackSkipPixels := Value;
- gl.PixelStoref(GL_PACK_SKIP_PIXELS, Value);
- end;
- end;
- procedure TGLStateCache.SetPackSkipRows(const Value: Cardinal);
- begin
- if Value <> FPackSkipRows then
- begin
- FPackSkipRows := Value;
- gl.PixelStoref(GL_PACK_SKIP_ROWS, Value);
- end;
- end;
- procedure TGLStateCache.SetPackSwapBytes(const Value: TGLboolean);
- begin
- if Value <> FPackSwapBytes then
- begin
- FPackSwapBytes := Value;
- gl.PixelStorei(GL_PACK_SWAP_BYTES, byte(Value));
- end;
- end;
- procedure TGLStateCache.SetPixelPackBufferBinding(const Value: Cardinal);
- begin
- if Value <> FPixelPackBufferBinding then
- begin
- FPixelPackBufferBinding := Value;
- gl.BindBuffer(GL_PIXEL_PACK_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetPixelUnpackBufferBinding(const Value: Cardinal);
- begin
- if Value <> FPixelUnpackBufferBinding then
- begin
- FPixelUnpackBufferBinding := Value;
- gl.BindBuffer(GL_PIXEL_UNPACK_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetPointFadeThresholdSize(const Value: TGLfloat);
- begin
- if (Value <> FPointFadeThresholdSize) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPoint)
- else
- FPointFadeThresholdSize := Value;
- gl.PointParameterf(GL_POINT_FADE_THRESHOLD_SIZE, Value);
- end;
- end;
- procedure TGLStateCache.SetPointSize(const Value: TGLfloat);
- begin
- if (Value <> FPointSize) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPoint)
- else
- FPointSize := Value;
- gl.PointSize(Value);
- end;
- end;
- procedure TGLStateCache.SetPointSpriteCoordOrigin(const Value: Cardinal);
- begin
- if (Value <> FPointSpriteCoordOrigin) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPoint)
- else
- FPointSpriteCoordOrigin := Value;
- gl.PointParameterf(GL_POINT_SPRITE_COORD_ORIGIN, Value);
- end;
- end;
- procedure TGLStateCache.SetPolygonMode(const Value: TGLPolygonMode);
- begin
- if (Value <> FPolygonMode) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPolygon)
- else
- begin
- FPolygonMode := Value;
- FPolygonBackMode := Value;
- end;
- gl.PolygonMode(GL_FRONT_AND_BACK, cGLPolygonModeToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetPolygonOffset(const factor, units: TGLfloat);
- begin
- if (factor <> FPolygonOffsetFactor) or (units <> FPolygonOffsetUnits) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPolygon)
- else
- begin
- FPolygonOffsetFactor := factor;
- FPolygonOffsetUnits := units;
- end;
- gl.PolygonOffset(factor, units);
- end;
- end;
- procedure TGLStateCache.SetPolygonOffsetFactor(const Value: TGLfloat);
- begin
- if (Value <> FPolygonOffsetFactor) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPolygon)
- else
- FPolygonOffsetFactor := Value;
- gl.PolygonOffset(Value, FPolygonOffsetUnits);
- end;
- end;
- procedure TGLStateCache.SetPolygonOffsetUnits(const Value: TGLfloat);
- begin
- if (Value <> FPolygonOffsetUnits) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttPolygon)
- else
- FPolygonOffsetUnits := Value;
- gl.PolygonOffset(FPolygonOffsetFactor, Value);
- end;
- end;
- procedure TGLStateCache.SetPolygonSmoothHint(const Value: TGLHintType);
- begin
- if (Value <> FPolygonSmoothHint) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttHint)
- else
- FPolygonSmoothHint := Value;
- gl.Hint(GL_POLYGON_SMOOTH_HINT, cGLHintToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetProvokingVertex(const Value: Cardinal);
- begin
- if Value <> FProvokingVertex then
- begin
- FProvokingVertex := Value;
- gl.ProvokingVertex(Value);
- end;
- end;
- procedure TGLStateCache.SetReadFrameBuffer(const Value: Cardinal);
- begin
- if Value <> FReadFrameBuffer then
- begin
- FReadFrameBuffer := Value;
- gl.BindFramebuffer(GL_READ_FRAMEBUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetRenderBuffer(const Value: Cardinal);
- begin
- if Value <> FRenderBuffer then
- begin
- FRenderBuffer := Value;
- gl.BindRenderbuffer(GL_RENDERBUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetSampleCoverage(const Value: TGLfloat; invert: TGLboolean);
- begin
- if (Value <> FSampleCoverageValue) or (invert <> FSampleCoverageInvert) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttMultisample)
- else
- begin
- FSampleCoverageValue := Value;
- FSampleCoverageInvert := invert;
- end;
- gl.SampleCoverage(Value, invert);
- end;
- end;
- procedure TGLStateCache.SetSampleCoverageInvert(const Value: TGLboolean);
- begin
- if (Value <> FSampleCoverageInvert) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttMultisample)
- else
- FSampleCoverageInvert := Value;
- gl.SampleCoverage(FSampleCoverageValue, Value);
- end;
- end;
- procedure TGLStateCache.SetSampleCoverageValue(const Value: TGLfloat);
- begin
- if (Value <> FSampleCoverageValue) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttMultisample)
- else
- FSampleCoverageValue := Value;
- gl.SampleCoverage(Value, FSampleCoverageInvert);
- end;
- end;
- procedure TGLStateCache.SetSampleMaskValue(index: Integer; const Value: TGLbitfield);
- begin
- if (FSampleMaskValue[Index] <> Value) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttMultisample)
- else
- FSampleMaskValue[Index] := Value;
- gl.SampleMaski(Index, Value);
- end;
- end;
- procedure TGLStateCache.SetScissorBox(const Value: TVector4i);
- begin
- if not VectorEquals(FScissorBox, Value) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttScissor)
- else
- FScissorBox := Value;
- gl.Scissor(Value.X, Value.Y, Value.Z, Value.W);
- end;
- end;
- procedure TGLStateCache.SetStencilBackWriteMask(const Value: Cardinal);
- begin
- if (Value <> FStencilBackWriteMask) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- FStencilBackWriteMask := Value;
- // DONE: ignore if unsupported
- if gl.VERSION_2_0 then
- gl.StencilMaskSeparate(GL_BACK, Value);
- end;
- end;
- procedure TGLStateCache.SetStencilClearValue(const Value: Cardinal);
- {$IFDEF USE_CACHE_MISS_CHECK}
- var
- I: Cardinal;
- {$ENDIF}
- begin
- {$IFDEF USE_CACHE_MISS_CHECK}
- gl.GetIntegerv(GL_STENCIL_CLEAR_VALUE, @I);
- if FStencilClearValue <> I then
- GLSLogger.LogError(strStateCashMissing + 'Stencil clear value');
- {$ENDIF}
- if (Value <> FStencilClearValue) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- FStencilClearValue := Value;
- gl.ClearStencil(Value);
- end;
- end;
- procedure TGLStateCache.SetColorClearValue(const Value: TGLVector);
- begin
- if not VectorEquals(Value, FColorClearValue) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- FColorClearValue := Value;
- gl.ClearColor(Value.X, Value.Y, Value.Z, Value.W);
- end;
- end;
- procedure TGLStateCache.SetColorMask(mask: TGLColorMask);
- var
- I: Integer;
- begin
- // it might be faster to keep track of whether all draw buffers are same
- // value or not, since using this is probably more common than setting
- // the color write mask for individual draw buffers
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- for I := low(FColorWriteMask) to high(FColorWriteMask) do
- begin
- FColorWriteMask[I] := mask;
- end;
- gl.ColorMask(ccRed in mask, ccGreen in mask, ccBlue in mask, ccAlpha in mask);
- end;
- procedure TGLStateCache.SetStencilFuncSeparate(const face: TGLCullFaceMode; const func: TGLStencilFunction; const ref: TGLint;
- const mask: Cardinal);
- {$IFDEF USE_CACHE_MISS_CHECK}
- var
- UI: Cardinal;
- I: TGLint;
- {$ENDIF}
- begin
- // if (func<>FStencilFunc) or (ref<>FStencilRef) or (mask<>FStencilValueMask)
- // or FInsideList then
- {$IFDEF USE_CACHE_MISS_CHECK}
- gl.GetIntegerv(GL_STENCIL_FUNC, @UI);
- if cGLComparisonFunctionToGLEnum[FStencilFunc] <> UI then
- GLSLogger.LogError(strStateCashMissing + 'Stencil function');
- gl.GetIntegerv(GL_STENCIL_REF, @I);
- if FStencilRef <> I then
- GLSLogger.LogError(strStateCashMissing + 'Stencil reference');
- GLSLogger.LogError(strStateCashMissing + 'Stencil function');
- gl.GetIntegerv(GL_STENCIL_VALUE_MASK, @UI);
- if FStencilValueMask <> UI then
- GLSLogger.LogError(strStateCashMissing + 'Stencil value mask');
- {$ENDIF}
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- case face of
- cmFront:
- begin
- FStencilFunc := func;
- FStencilRef := ref;
- FStencilValueMask := mask;
- end;
- cmBack:
- begin
- FStencilBackFunc := func;
- FStencilBackRef := ref;
- FStencilBackValueMask := mask;
- end;
- cmFrontAndBack:
- begin
- FStencilFunc := func;
- FStencilRef := ref;
- FStencilValueMask := mask;
- FStencilBackFunc := func;
- FStencilBackRef := ref;
- FStencilBackValueMask := mask;
- end;
- end;
- gl.StencilFuncSeparate(cGLCullFaceModeToGLEnum[face], cGLComparisonFunctionToGLEnum[func], ref, mask);
- end;
- end;
- procedure TGLStateCache.SetStencilFunc(const func: TGLStencilFunction; const ref: TGLint; const mask: Cardinal);
- begin
- if (func <> FStencilFunc) or (ref <> FStencilRef) or (mask <> FStencilValueMask) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- begin
- FStencilFunc := func;
- FStencilRef := ref;
- FStencilValueMask := mask;
- end;
- gl.StencilFunc(cGLComparisonFunctionToGLEnum[func], ref, mask);
- end;
- end;
- procedure TGLStateCache.SetStencilOp(const fail, zfail, zpass: TGLStencilOp);
- {$IFDEF USE_CACHE_MISS_CHECK}
- var
- I: Cardinal;
- {$ENDIF}
- begin
- {$IFDEF USE_CACHE_MISS_CHECK}
- gl.GetIntegerv(GL_STENCIL_FAIL, @I);
- if cGLStencilOpToGLEnum[FStencilFail] <> I then
- GLSLogger.LogError(strStateCashMissing + 'Stencil fail');
- gl.GetIntegerv(GL_STENCIL_PASS_DEPTH_FAIL, @I);
- if cGLStencilOpToGLEnum[FStencilPassDepthFail] <> I then
- GLSLogger.LogError(strStateCashMissing + 'Stencil zfail');
- gl.GetIntegerv(GL_STENCIL_PASS_DEPTH_PASS, @I);
- if cGLStencilOpToGLEnum[FStencilPassDepthPass] <> I then
- GLSLogger.LogError(strStateCashMissing + 'Stencil zpass');
- {$ENDIF}
- if (fail <> FStencilFail) or (zfail <> FStencilPassDepthFail) or (zpass <> FStencilPassDepthPass) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- begin
- FStencilFail := fail;
- FStencilPassDepthFail := zfail;
- FStencilPassDepthPass := zpass;
- end;
- gl.StencilOp(cGLStencilOpToGLEnum[fail],
- cGLStencilOpToGLEnum[zfail],
- cGLStencilOpToGLEnum[zpass]);
- end;
- end;
- procedure TGLStateCache.SetStencilOpSeparate(const face: TGLCullFaceMode; const sfail, dpfail, dppass: TGLStencilOp);
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- case face of
- cmFront:
- begin
- FStencilFail := sfail;
- FStencilPassDepthFail := dpfail;
- FStencilPassDepthPass := dppass;
- end;
- cmBack:
- begin
- FStencilBackFail := sfail;
- FStencilBackPassDepthFail := dpfail;
- FStencilBackPassDepthPass := dppass;
- end;
- cmFrontAndBack:
- begin
- FStencilFail := sfail;
- FStencilPassDepthFail := dpfail;
- FStencilPassDepthPass := dppass;
- FStencilBackFail := sfail;
- FStencilBackPassDepthFail := dpfail;
- FStencilBackPassDepthPass := dppass;
- end;
- end;
- gl.StencilOpSeparate(cGLCullFaceModeToGLEnum[face], cGLStencilOpToGLEnum[sfail], cGLStencilOpToGLEnum[dpfail],
- cGLStencilOpToGLEnum[dppass]);
- end;
- procedure TGLStateCache.SetStencilWriteMask(const Value: Cardinal);
- {$IFDEF USE_CACHE_MISS_CHECK}
- var
- I: Cardinal;
- {$ENDIF}
- begin
- {$IFDEF USE_CACHE_MISS_CHECK}
- gl.GetIntegerv(GL_STENCIL_WRITEMASK, @I);
- if FStencilWriteMask <> I then
- GLSLogger.LogError(strStateCashMissing + 'Stencil write mask');
- {$ENDIF}
- if (Value <> FStencilWriteMask) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttStencilBuffer)
- else
- FStencilWriteMask := Value;
- gl.StencilMaskSeparate(GL_FRONT, Value);
- end;
- end;
- procedure TGLStateCache.SetTextureBinding(index: Integer; target: TGLTextureTarget; const Value: Cardinal);
- var
- lastActiveTexture: Cardinal;
- begin
- if target = ttNoShape then
- exit;
- if (Value <> FTextureBinding[Index, target]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttTexture)
- else
- FTextureBinding[Index, target] := Value;
- lastActiveTexture := ActiveTexture;
- ActiveTexture := Index;
- gl.BindTexture(cGLTexTypeToGLEnum[target], Value);
- ActiveTexture := lastActiveTexture;
- end;
- FTextureBindingTime[Index, target] := AppTime;
- end;
- function TGLStateCache.GetActiveTextureEnabled(target: TGLTextureTarget): Boolean;
- begin
- Result := FActiveTextureEnabling[FActiveTexture][target];
- end;
- procedure TGLStateCache.SetActiveTextureEnabled(target: TGLTextureTarget; const Value: Boolean);
- var
- glTarget: Cardinal;
- begin
- glTarget := DecodeTextureTarget(target);
- if { FForwardContext or } not IsTargetSupported(glTarget) then
- exit;
- if (Value <> FActiveTextureEnabling[FActiveTexture][target]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttEnable)
- else
- FActiveTextureEnabling[FActiveTexture][target] := Value;
- if Value then
- gl.Enable(glTarget)
- else
- gl.Disable(glTarget);
- end;
- end;
- procedure TGLStateCache.SetTextureCompressionHint(const Value: TGLHintType);
- begin
- if (Value <> FTextureCompressionHint) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttHint)
- else
- FTextureCompressionHint := Value;
- gl.Hint(GL_TEXTURE_COMPRESSION_HINT, cGLHintToGLEnum[Value]);
- end;
- end;
- procedure TGLStateCache.SetTransformFeedbackBufferBinding(const Value: Cardinal);
- begin
- if (Value <> FTransformFeedbackBufferBinding) or FInsideList then
- begin
- FTransformFeedbackBufferBinding := Value;
- gl.BindBuffer(GL_TRANSFORM_FEEDBACK_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetEnableTextureCubeMapSeamless(const Value: TGLboolean);
- begin
- if Value <> FEnableTextureCubeMapSeamless then
- begin
- FEnableTextureCubeMapSeamless := Value;
- if Value = True then
- gl.Enable(GL_TEXTURE_CUBE_MAP_SEAMLESS)
- else
- gl.Disable(GL_TEXTURE_CUBE_MAP_SEAMLESS);
- end;
- end;
- procedure TGLStateCache.NewList(list: Cardinal; mode: Cardinal);
- var
- I: Cardinal;
- begin
- Assert(mode = GL_COMPILE, 'Compile & executing not supported by TGLStateCache');
- FCurrentList := list - 1;
- // while High(FListStates) < Integer(FCurrentList) do
- // SetLength(FListStates, 2 * Length(FListStates));
- FListStates[FCurrentList] := [];
- FInsideList := True;
- // Reset VBO binding and client attribute
- begin
- if GL.ARB_vertex_buffer_object then
- begin
- ArrayBufferBinding := 0;
- ElementBufferBinding := 0;
- for I := 0 to 15 do
- gl.DisableVertexAttribArray(I);
- end;
- gl.NewList(list, mode);
- end;
- end;
- procedure TGLStateCache.EndList;
- begin
- gl.EndList;
- FInsideList := False;
- end;
- procedure TGLStateCache.CallList(list: Cardinal);
- begin
- // while High(FListStates) < Integer(list) do
- // SetLength(FListStates, 2 * Length(FListStates));
- if FListStates[list - 1] <> [] then
- begin
- PushAttrib(FListStates[list - 1]);
- gl.CallList(list);
- PopAttrib;
- end
- else
- gl.CallList(list);
- end;
- procedure TGLStateCache.SetUniformBufferBinding(const Value: Cardinal);
- begin
- Assert(not FInsideList);
- if Value <> FUniformBufferBinding then
- begin
- FUniformBufferBinding := Value;
- gl.BindBuffer(GL_UNIFORM_BUFFER, Value);
- end;
- end;
- procedure TGLStateCache.SetBufferIndexedBinding(const Value: Cardinal;
- ATarget: TGLBufferBindingTarget; AIndex: Cardinal; ABufferSize: TGLsizeiptr);
- begin
- Assert(not FInsideList);
- if (FUBOStates[ATarget, AIndex].FUniformBufferBinding <> Value)
- or (FUBOStates[ATarget, AIndex].FOffset > 0)
- or (FUBOStates[ATarget, AIndex].FSize <> ABufferSize) then
- begin
- case ATarget of
- bbtUniform:
- FUniformBufferBinding := Value;
- bbtTransformFeedBack:
- FTransformFeedbackBufferBinding := Value;
- end;
- FUBOStates[ATarget, AIndex].FUniformBufferBinding := Value;
- FUBOStates[ATarget, AIndex].FOffset := 0;
- FUBOStates[ATarget, AIndex].FSize := ABufferSize;
- gl.BindBufferBase(cGLBufferBindingTarget[ATarget], AIndex, Value);
- end
- else
- case ATarget of
- bbtUniform: SetUniformBufferBinding(Value);
- bbtTransformFeedBack: SetTransformFeedbackBufferBinding(Value);
- end;
- end;
- procedure TGLStateCache.SetBufferIndexedBinding(const Value: Cardinal; ATarget: TGLBufferBindingTarget; AIndex: Cardinal;
- AOffset: TGLintptr; ARangeSize: TGLsizeiptr);
- begin
- Assert(not FInsideList);
- if (FUBOStates[ATarget, AIndex].FUniformBufferBinding <> Value)
- or (FUBOStates[ATarget, AIndex].FOffset <> AOffset)
- or (FUBOStates[ATarget, AIndex].FSize <> ARangeSize) then
- begin
- case ATarget of
- bbtUniform: FUniformBufferBinding := Value;
- bbtTransformFeedBack: FTransformFeedbackBufferBinding := Value;
- end;
- FUBOStates[ATarget, AIndex].FUniformBufferBinding := Value;
- FUBOStates[ATarget, AIndex].FOffset := AOffset;
- FUBOStates[ATarget, AIndex].FSize := ARangeSize;
- gl.BindBufferRange(cGLBufferBindingTarget[ATarget], AIndex, Value, AOffset, ARangeSize);
- end;
- end;
- function TGLStateCache.GetMaxTextureUnits: Cardinal;
- begin
- if FMaxTextureUnits = 0 then
- gl.GetIntegerv(GL_MAX_TEXTURE_IMAGE_UNITS_ARB, @FMaxTextureUnits);
- Result := FMaxTextureUnits;
- end;
- procedure TGLStateCache.SetUnpackAlignment(const Value: Cardinal);
- begin
- if Value <> FUnpackAlignment then
- begin
- FUnpackAlignment := Value;
- gl.PixelStoref(GL_UNPACK_ALIGNMENT, Value);
- end;
- end;
- procedure TGLStateCache.SetUnpackImageHeight(const Value: Cardinal);
- begin
- if Value <> FUnpackImageHeight then
- begin
- FUnpackImageHeight := Value;
- gl.PixelStoref(GL_UNPACK_IMAGE_HEIGHT, Value);
- end;
- end;
- procedure TGLStateCache.SetUnpackLSBFirst(const Value: TGLboolean);
- begin
- if Value <> FUnpackLSBFirst then
- begin
- FUnpackLSBFirst := Value;
- gl.PixelStorei(GL_UNPACK_LSB_FIRST, byte(Value));
- end;
- end;
- procedure TGLStateCache.SetUnpackRowLength(const Value: Cardinal);
- begin
- if Value <> FUnpackRowLength then
- begin
- FUnpackRowLength := Value;
- gl.PixelStoref(GL_UNPACK_ROW_LENGTH, Value);
- end;
- end;
- procedure TGLStateCache.SetUnpackSkipImages(const Value: Cardinal);
- begin
- if Value <> FUnpackSkipImages then
- begin
- FUnpackSkipImages := Value;
- gl.PixelStoref(GL_UNPACK_SKIP_IMAGES, Value);
- end;
- end;
- procedure TGLStateCache.SetUnpackSkipPixels(const Value: Cardinal);
- begin
- if Value <> FUnpackSkipPixels then
- begin
- FUnpackSkipPixels := Value;
- gl.PixelStoref(GL_UNPACK_SKIP_PIXELS, Value);
- end;
- end;
- procedure TGLStateCache.SetUnpackSkipRows(const Value: Cardinal);
- begin
- if Value <> FUnpackSkipRows then
- begin
- FUnpackSkipRows := Value;
- gl.PixelStoref(GL_UNPACK_SKIP_ROWS, Value);
- end;
- end;
- procedure TGLStateCache.SetUnpackSwapBytes(const Value: TGLboolean);
- begin
- if Value <> FUnpackSwapBytes then
- begin
- FUnpackSwapBytes := Value;
- gl.PixelStorei(GL_UNPACK_SWAP_BYTES, byte(Value));
- end;
- end;
- procedure TGLStateCache.SetViewPort(const Value: TVector4i);
- begin
- if not VectorEquals(Value, FViewPort) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttViewport)
- else
- FViewPort := Value;
- gl.ViewPort(Value.X, Value.Y, Value.Z, Value.W);
- end;
- end;
- procedure TGLStateCache.SetFFPLight(Value: Boolean);
- begin
- FFFPLight := Value { and not FForwardContext };
- end;
- function TGLStateCache.GetMaxLights: Integer;
- begin
- if FMaxLights = 0 then
- { if FForwardContext then
- FMaxLights := MAX_HARDWARE_LIGHT
- else }
- gl.GetIntegerv(GL_MAX_LIGHTS, @FMaxLights);
- Result := FMaxLights;
- end;
- function TGLStateCache.GetLightEnabling(I: Integer): Boolean;
- begin
- Result := FLightEnabling[I];
- end;
- procedure TGLStateCache.SetLightEnabling(I: Integer; Value: Boolean);
- var
- J, K: Integer;
- begin
- if (FLightEnabling[I] <> Value) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightEnabling[I] := Value;
- if FFFPLight then
- begin
- if Value then
- gl.Enable(GL_LIGHT0 + I)
- else
- gl.Disable(GL_LIGHT0 + I);
- end;
- K := 0;
- for J := 0 to MAX_HARDWARE_LIGHT - 1 do
- if FLightEnabling[J] then
- begin
- FLightIndices[K] := J;
- Inc(K);
- end;
- FLightNumber := K;
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetLightIndicesAsAddress: PGLInt;
- begin
- Result := @FLightIndices[0];
- end;
- function TGLStateCache.GetLightStateAsAddress: Pointer;
- var
- I, J, C: Integer;
- begin
- C := MinInteger(FLightNumber, MAX_SHADER_LIGHT);
- if FShaderLightStatesChanged then
- begin
- if C > 0 then
- begin
- if GL.VERSION_3_0 then
- begin
- Move(FLightStates.Position,
- FShaderLightStates.Position,
- SizeOf(FShaderLightStates.Position));
- Move(FLightStates.Ambient,
- FShaderLightStates.Ambient,
- SizeOf(FShaderLightStates.Ambient));
- Move(FLightStates.Diffuse,
- FShaderLightStates.Diffuse,
- SizeOf(FShaderLightStates.Diffuse));
- Move(FLightStates.Specular,
- FShaderLightStates.Specular,
- SizeOf(FShaderLightStates.Specular));
- Move(FLightStates.SpotDirection,
- FShaderLightStates.SpotDirection,
- SizeOf(FShaderLightStates.SpotDirection));
- Move(FLightStates.SpotCosCutoffExponent,
- FShaderLightStates.SpotCosCutoffExponent,
- SizeOf(FShaderLightStates.SpotCosCutoffExponent));
- Move(FLightStates.Attenuation,
- FShaderLightStates.Attenuation,
- SizeOf(FShaderLightStates.Attenuation));
- end
- else
- begin
- for I := C - 1 downto 0 do
- begin
- J := FLightIndices[I];
- FShaderLightStates.Position[I] := FLightStates.Position[J];
- FShaderLightStates.Ambient[I] := FLightStates.Ambient[J];
- FShaderLightStates.Diffuse[I] := FLightStates.Diffuse[J];
- FShaderLightStates.Specular[I] := FLightStates.Specular[J];
- FShaderLightStates.SpotDirection[I] := FLightStates.SpotDirection[J];
- FShaderLightStates.SpotCosCutoffExponent[I] := FLightStates.SpotCosCutoffExponent[J];
- FShaderLightStates.Attenuation[I] := FLightStates.Attenuation[J];
- end;
- end;
- end
- else
- FillChar(FShaderLightStatesChanged, SizeOf(FShaderLightStatesChanged), $00);
- FShaderLightStatesChanged := False;
- end;
- Result := @FShaderLightStates;
- end;
- function TGLStateCache.GetLightPosition(I: Integer): TGLVector;
- begin
- Result := FLightStates.Position[I];
- end;
- procedure TGLStateCache.SetLightPosition(I: Integer; const Value: TGLVector);
- begin
- if not VectorEquals(Value, FLightStates.Position[I]) then
- begin
- FLightStates.Position[I] := Value;
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetLightSpotDirection(I: Integer): TAffineVector;
- begin
- Result := AffineVectorMake(FLightStates.SpotDirection[I]);
- end;
- procedure TGLStateCache.SetLightSpotDirection(I: Integer; const Value: TAffineVector);
- begin
- if not VectorEquals(Value, AffineVectorMake(FLightStates.SpotDirection[I])) then
- begin
- FLightStates.SpotDirection[I] := VectorMake(Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetLightAmbient(I: Integer): TGLVector;
- begin
- Result := FLightStates.Ambient[I];
- end;
- procedure TGLStateCache.SetLightAmbient(I: Integer; const Value: TGLVector);
- begin
- if not VectorEquals(Value, FLightStates.Ambient[I]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.Ambient[I] := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_AMBIENT, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetLightDiffuse(I: Integer): TGLVector;
- begin
- Result := FLightStates.Diffuse[I];
- end;
- procedure TGLStateCache.SetLightDiffuse(I: Integer; const Value: TGLVector);
- begin
- if not VectorEquals(Value, FLightStates.Diffuse[I]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.Diffuse[I] := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_DIFFUSE, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetLightSpecular(I: Integer): TGLVector;
- begin
- Result := FLightStates.Specular[I];
- end;
- procedure TGLStateCache.SetLightSpecular(I: Integer; const Value: TGLVector);
- begin
- if not VectorEquals(Value, FLightStates.Specular[I]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.Specular[I] := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_SPECULAR, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetSpotCutoff(I: Integer): Single;
- begin
- Result := FSpotCutoff[I];
- end;
- procedure TGLStateCache.SetSpotCutoff(I: Integer; const Value: Single);
- begin
- if (Value <> FSpotCutoff[I]) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- begin
- FSpotCutoff[I] := Value;
- FLightStates.SpotCosCutoffExponent[I].X := cos(DegToRadian(Value));
- end;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_SPOT_CUTOFF, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetSpotExponent(I: Integer): Single;
- begin
- Result := FLightStates.SpotCosCutoffExponent[I].Y;
- end;
- procedure TGLStateCache.SetSpotExponent(I: Integer; const Value: Single);
- begin
- if (Value <> FLightStates.SpotCosCutoffExponent[I].Y) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.SpotCosCutoffExponent[I].Y := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_SPOT_EXPONENT, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetConstantAtten(I: Integer): Single;
- begin
- Result := FLightStates.Attenuation[I].X;
- end;
- procedure TGLStateCache.SetConstantAtten(I: Integer; const Value: Single);
- begin
- if (Value <> FLightStates.Attenuation[I].X) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.Attenuation[I].X := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_CONSTANT_ATTENUATION, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetLinearAtten(I: Integer): Single;
- begin
- Result := FLightStates.Attenuation[I].Y;
- end;
- procedure TGLStateCache.SetLinearAtten(I: Integer; const Value: Single);
- begin
- if (Value <> FLightStates.Attenuation[I].Y) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.Attenuation[I].Y := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_LINEAR_ATTENUATION, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- function TGLStateCache.GetQuadAtten(I: Integer): Single;
- begin
- Result := FLightStates.Attenuation[I].Z;
- end;
- procedure TGLStateCache.SetQuadAtten(I: Integer; const Value: Single);
- begin
- if (Value <> FLightStates.Attenuation[I].Z) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttLighting)
- else
- FLightStates.Attenuation[I].Z := Value;
- if FFFPLight then
- gl.Lightfv(GL_LIGHT0 + I, GL_QUADRATIC_ATTENUATION, @Value);
- FShaderLightStatesChanged := True;
- if Assigned(FOnLightsChanged) then
- FOnLightsChanged(Self);
- end;
- end;
- procedure TGLStateCache.SetForwardContext(Value: Boolean);
- begin
- { if Value <> FForwardContext then
- begin
- FForwardContext := Value;
- if Value then
- begin
- SetFFPlight(False);
- end;
- end;
- }
- end;
- procedure TGLStateCache.SetColorWriting(flag: Boolean);
- begin
- if (FColorWriting <> flag) or FInsideList then
- begin
- if FInsideList then
- Include(FListStates[FCurrentList], sttColorBuffer)
- else
- FColorWriting := flag;
- gl.ColorMask(flag, flag, flag, flag);
- end;
- end;
- procedure TGLStateCache.InvertFrontFace;
- begin
- if FFrontFace = fwCounterClockWise then
- FrontFace := fwClockWise
- else
- FrontFace := fwCounterClockWise;
- end;
- procedure TGLStateCache.SetGLState(const aState: TGLState);
- begin
- Enable(aState);
- end;
- procedure TGLStateCache.UnSetGLState(const aState: TGLState);
- begin
- Disable(aState);
- end;
- procedure TGLStateCache.ResetGLPolygonMode;
- begin
- gl.PolygonMode(GL_FRONT_AND_BACK, GL_FILL);
- FPolygonMode := pmFill;
- FPolygonBackMode := pmFill;
- end;
- procedure TGLStateCache.ResetGLMaterialColors;
- begin
- gl.Materialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @clrGray20);
- gl.Materialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @clrGray80);
- gl.Materialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @clrBlack);
- gl.Materialfv(GL_FRONT_AND_BACK, GL_EMISSION, @clrBlack);
- gl.Materiali(GL_FRONT_AND_BACK, GL_SHININESS, 0);
- FillChar(FFrontBackColors, SizeOf(FFrontBackColors), 127);
- FFrontBackShininess[0] := 0;
- FFrontBackShininess[1] := 0;
- end;
- procedure TGLStateCache.ResetGLTexture(const TextureUnit: Integer);
- var
- t: TGLTextureTarget;
- glTarget: Cardinal;
- begin
- gl.ActiveTexture(GL_TEXTURE0 + TextureUnit);
- for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
- begin
- glTarget := DecodeTextureTarget(t);
- if IsTargetSupported(glTarget) then
- begin
- gl.BindTexture(glTarget, 0);
- FTextureBinding[TextureUnit, t] := 0;
- end;
- end;
- gl.ActiveTexture(GL_TEXTURE0);
- FActiveTexture := 0;
- end;
- procedure TGLStateCache.ResetGLCurrentTexture;
- var
- a: TGLint;
- t: TGLTextureTarget;
- glTarget: Cardinal;
- begin
- if GL.ARB_multitexture then
- begin
- for a := MaxTextureImageUnits - 1 to 0 do
- begin
- gl.ActiveTexture(GL_TEXTURE0 + a);
- for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
- begin
- glTarget := DecodeTextureTarget(t);
- if IsTargetSupported(glTarget) then
- begin
- gl.BindTexture(glTarget, 0);
- FTextureBinding[a, t] := 0;
- end;
- end;
- end;
- end
- else
- for t := Low(TGLTextureTarget) to High(TGLTextureTarget) do
- begin
- glTarget := DecodeTextureTarget(t);
- if IsTargetSupported(glTarget) then
- begin
- gl.BindTexture(glTarget, 0);
- FTextureBinding[0, t] := 0;
- end;
- end;
- end;
- procedure TGLStateCache.ResetGLFrontFace;
- begin
- gl.FrontFace(GL_CCW);
- FFrontFace := fwCounterClockWise;
- end;
- procedure TGLStateCache.SetGLFrontFaceCW;
- begin
- if FFrontFace = fwCounterClockWise then
- begin
- gl.FrontFace(GL_CW);
- FFrontFace := fwClockWise;
- end;
- end;
- procedure TGLStateCache.ResetAll;
- begin
- {$WARN SYMBOL_DEPRECATED OFF}
- ResetGLPolygonMode;
- ResetGLMaterialColors;
- ResetGLCurrentTexture;
- ResetGLFrontFace;
- {$WARN SYMBOL_DEPRECATED ON}
- end;
- //--------------------------------------------------------------------------
- end.
|