{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-cse #-} {-# OPTIONS_HADDOCK hide #-} -------------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.OpenGL.GLU.ErrorsInternal -- Copyright : (c) Sven Panne 2002-2019 -- License : BSD3 -- -- Maintainer : Sven Panne -- Stability : stable -- Portability : portable -- -- This is a purely internal module corresponding to some parts of section 2.5 -- (GL Errors) of the OpenGL 2.1 specs and chapter 8 (Errors) of the GLU specs. -- -------------------------------------------------------------------------------- module Graphics.Rendering.OpenGL.GLU.ErrorsInternal ( Error(..), ErrorCategory(..), getErrors, recordErrorCode, recordInvalidEnum, recordInvalidValue, recordOutOfMemory ) where import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) import Graphics.GLU import Graphics.GL import System.IO.Unsafe ( unsafePerformIO ) -------------------------------------------------------------------------------- -- | GL\/GLU errors consist of a general error category and a description of -- what went wrong. data Error = Error ErrorCategory String deriving ( Eq, Ord, Show ) -- | General GL\/GLU error categories data ErrorCategory = ContextLost | InvalidEnum | InvalidValue | InvalidOperation | InvalidFramebufferOperation | OutOfMemory | StackOverflow | StackUnderflow | TableTooLarge | TesselatorError | NURBSError deriving ( Eq, Ord, Show ) makeError :: GLenum -> Error makeError c -- GL errors | c == GL_CONTEXT_LOST = Error ContextLost "context lost" | c == GL_INVALID_ENUM = Error InvalidEnum "invalid enumerant" | c == GL_INVALID_VALUE = Error InvalidValue "invalid value" | c == GL_INVALID_OPERATION = Error InvalidOperation "invalid operation" | c == GL_INVALID_FRAMEBUFFER_OPERATION = Error InvalidFramebufferOperation "invalid framebuffer operation" | c == GL_OUT_OF_MEMORY = Error OutOfMemory "out of memory" | c == GL_STACK_OVERFLOW = Error StackOverflow "stack overflow" | c == GL_STACK_UNDERFLOW = Error StackUnderflow "stack underflow" | c == GL_TABLE_TOO_LARGE = Error TableTooLarge "table too large" -- GLU errors | c == GLU_INVALID_ENUM = Error InvalidEnum "invalid enumerant" | c == GLU_INVALID_VALUE = Error InvalidValue "invalid value" | c == GLU_INVALID_OPERATION = Error InvalidOperation "invalid operation" | c == GLU_OUT_OF_MEMORY = Error OutOfMemory "out of memory" -- GLU tesselator error | c == GLU_TESS_ERROR1 = Error TesselatorError "gluTessBeginPolygon() must precede a gluTessEndPolygon()" | c == GLU_TESS_ERROR2 = Error TesselatorError "gluTessBeginContour() must precede a gluTessEndContour()" | c == GLU_TESS_ERROR3 = Error TesselatorError "gluTessEndPolygon() must follow a gluTessBeginPolygon()" | c == GLU_TESS_ERROR4 = Error TesselatorError "gluTessEndContour() must follow a gluTessBeginContour()" | c == GLU_TESS_ERROR5 = Error TesselatorError "a coordinate is too large" | c == GLU_TESS_ERROR6 = Error TesselatorError "need combine callback" | c == GLU_TESS_ERROR7 = Error TesselatorError "tesselation error 7" | c == GLU_TESS_ERROR8 = Error TesselatorError "tesselation error 8" -- GLU NUBRS errors | c == GLU_NURBS_ERROR1 = Error NURBSError "spline order un-supported" | c == GLU_NURBS_ERROR2 = Error NURBSError "too few knots" | c == GLU_NURBS_ERROR3 = Error NURBSError "valid knot range is empty" | c == GLU_NURBS_ERROR4 = Error NURBSError "decreasing knot sequence knot" | c == GLU_NURBS_ERROR5 = Error NURBSError "knot multiplicity greater than order of spline" | c == GLU_NURBS_ERROR6 = Error NURBSError "gluEndCurve() must follow gluBeginCurve()" | c == GLU_NURBS_ERROR7 = Error NURBSError "gluBeginCurve() must precede gluEndCurve()" | c == GLU_NURBS_ERROR8 = Error NURBSError "missing or extra geometric data" | c == GLU_NURBS_ERROR9 = Error NURBSError "can't draw piecewise linear trimming curves" | c == GLU_NURBS_ERROR10 = Error NURBSError "missing or extra domain data" | c == GLU_NURBS_ERROR11 = Error NURBSError "missing or extra domain data" | c == GLU_NURBS_ERROR12 = Error NURBSError "gluEndTrim() must precede gluEndSurface()" | c == GLU_NURBS_ERROR13 = Error NURBSError "gluBeginSurface() must precede gluEndSurface()" | c == GLU_NURBS_ERROR14 = Error NURBSError "curve of improper type passed as trim curve" | c == GLU_NURBS_ERROR15 = Error NURBSError "gluBeginSurface() must precede gluBeginTrim()" | c == GLU_NURBS_ERROR16 = Error NURBSError "gluEndTrim() must follow gluBeginTrim()" | c == GLU_NURBS_ERROR17 = Error NURBSError "gluBeginTrim() must precede gluEndTrim()" | c == GLU_NURBS_ERROR18 = Error NURBSError "invalid or missing trim curve" | c == GLU_NURBS_ERROR19 = Error NURBSError "gluBeginTrim() must precede gluPwlCurve()" | c == GLU_NURBS_ERROR20 = Error NURBSError "piecewise linear trimming curve referenced twice" | c == GLU_NURBS_ERROR21 = Error NURBSError "piecewise linear trimming curve and nurbs curve mixed" | c == GLU_NURBS_ERROR22 = Error NURBSError "improper usage of trim data type" | c == GLU_NURBS_ERROR23 = Error NURBSError "nurbs curve referenced twice" | c == GLU_NURBS_ERROR24 = Error NURBSError "nurbs curve and piecewise linear trimming curve mixed" | c == GLU_NURBS_ERROR25 = Error NURBSError "nurbs surface referenced twice" | c == GLU_NURBS_ERROR26 = Error NURBSError "invalid property" | c == GLU_NURBS_ERROR27 = Error NURBSError "gluEndSurface() must follow gluBeginSurface()" | c == GLU_NURBS_ERROR28 = Error NURBSError "intersecting or misoriented trim curves" | c == GLU_NURBS_ERROR29 = Error NURBSError "intersecting trim curves" | c == GLU_NURBS_ERROR30 = Error NURBSError "UNUSED" | c == GLU_NURBS_ERROR31 = Error NURBSError "unconnected trim curves" | c == GLU_NURBS_ERROR32 = Error NURBSError "unknown knot error" | c == GLU_NURBS_ERROR33 = Error NURBSError "negative vertex count encountered" | c == GLU_NURBS_ERROR34 = Error NURBSError "negative byte-stride encounteed" | c == GLU_NURBS_ERROR35 = Error NURBSError "unknown type descriptor" | c == GLU_NURBS_ERROR36 = Error NURBSError "null control point reference" | c == GLU_NURBS_ERROR37 = Error NURBSError "duplicate point on piecewise linear trimming curve" -- Something went terribly wrong... | otherwise = error "makeError" -------------------------------------------------------------------------------- -- This seems to be a common Haskell hack nowadays: A plain old global variable -- with an associated getter and mutator. Perhaps some language/library support -- is needed? {-# NOINLINE theRecordedErrors #-} theRecordedErrors :: IORef ([GLenum],Bool) theRecordedErrors = unsafePerformIO (newIORef ([], True)) getRecordedErrors :: IO ([GLenum],Bool) getRecordedErrors = readIORef theRecordedErrors setRecordedErrors :: ([GLenum],Bool) -> IO () setRecordedErrors = writeIORef theRecordedErrors -------------------------------------------------------------------------------- getGLErrors :: IO [GLenum] getGLErrors = getGLErrorsAux [] where getGLErrorsAux acc = do errorCode <- glGetError if isError errorCode then getGLErrorsAux (errorCode : acc) else return $ reverse acc isError :: GLenum -> Bool isError = (/= GL_NO_ERROR) -------------------------------------------------------------------------------- getErrors :: IO [Error] getErrors = map makeError `fmap` getErrorCodesAux (const ([], True)) recordErrorCode :: GLenum -> IO () recordErrorCode e = do -- We don't need the return value because this calls setRecordedErrors _ <- getErrorCodesAux (\es -> (if null es then [e] else [], False)) return () recordInvalidEnum :: IO () recordInvalidEnum = recordErrorCode GL_INVALID_ENUM recordInvalidValue :: IO () recordInvalidValue = recordErrorCode GL_INVALID_VALUE recordOutOfMemory :: IO () recordOutOfMemory = recordErrorCode GL_OUT_OF_MEMORY -- ToDo: Make this thread-safe getErrorCodesAux :: ([GLenum] -> ([GLenum],Bool)) -> IO [GLenum] getErrorCodesAux f = do (recordedErrors, useGLErrors) <- getRecordedErrors glErrors <- getGLErrors let es = if useGLErrors then recordedErrors ++ glErrors else recordedErrors setRecordedErrors (f es) return es