summaryrefslogtreecommitdiff
path: root/Backend/GL/Data.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Backend/GL/Data.hs')
-rw-r--r--Backend/GL/Data.hs113
1 files changed, 0 insertions, 113 deletions
diff --git a/Backend/GL/Data.hs b/Backend/GL/Data.hs
deleted file mode 100644
index 2c6e596..0000000
--- a/Backend/GL/Data.hs
+++ /dev/null
@@ -1,113 +0,0 @@
1module Backend.GL.Data where
2
3import Control.Applicative
4import Control.Monad
5import Data.ByteString.Char8 (ByteString)
6import Data.IORef
7import Data.List as L
8import Data.Maybe
9import Data.Trie as T
10import Foreign
11--import qualified Data.IntMap as IM
12import qualified Data.Map as Map
13import qualified Data.Set as Set
14import qualified Data.Vector as V
15import qualified Data.Vector.Storable as SV
16
17--import Control.DeepSeq
18
19import Graphics.Rendering.OpenGL.Raw.Core33
20import Data.Word
21import Codec.Picture
22import Codec.Picture.Types
23
24import Backend.GL.Type
25import Backend.GL.Util
26
27-- Buffer
28compileBuffer :: [Array] -> IO Buffer
29compileBuffer arrs = do
30 let calcDesc (offset,setters,descs) (Array arrType cnt setter) =
31 let size = cnt * sizeOfArrayType arrType
32 in (size + offset, (offset,size,setter):setters, ArrayDesc arrType cnt offset size:descs)
33 (bufSize,arrSetters,arrDescs) = foldl' calcDesc (0,[],[]) arrs
34 bo <- alloca $! \pbo -> glGenBuffers 1 pbo >> peek pbo
35 glBindBuffer gl_ARRAY_BUFFER bo
36 glBufferData gl_ARRAY_BUFFER (fromIntegral bufSize) nullPtr gl_STATIC_DRAW
37 forM_ arrSetters $! \(offset,size,setter) -> setter $! glBufferSubData gl_ARRAY_BUFFER (fromIntegral offset) (fromIntegral size)
38 glBindBuffer gl_ARRAY_BUFFER 0
39 return $! Buffer (V.fromList $! reverse arrDescs) bo
40
41updateBuffer :: Buffer -> [(Int,Array)] -> IO ()
42updateBuffer (Buffer arrDescs bo) arrs = do
43 glBindBuffer gl_ARRAY_BUFFER bo
44 forM arrs $ \(i,Array arrType cnt setter) -> do
45 let ArrayDesc ty len offset size = arrDescs V.! i
46 when (ty == arrType && cnt == len) $
47 setter $! glBufferSubData gl_ARRAY_BUFFER (fromIntegral offset) (fromIntegral size)
48 glBindBuffer gl_ARRAY_BUFFER 0
49
50bufferSize :: Buffer -> Int
51bufferSize = V.length . bufArrays
52
53arraySize :: Buffer -> Int -> Int
54arraySize buf arrIdx = arrLength $! bufArrays buf V.! arrIdx
55
56arrayType :: Buffer -> Int -> ArrayType
57arrayType buf arrIdx = arrType $! bufArrays buf V.! arrIdx
58
59-- Texture
60
61-- FIXME: Temporary implemenation
62compileTexture2DRGBAF :: Bool -> Bool -> DynamicImage -> IO TextureData
63compileTexture2DRGBAF = compileTexture2DRGBAF' False
64
65compileTexture2DRGBAF' :: Bool -> Bool -> Bool -> DynamicImage -> IO TextureData
66compileTexture2DRGBAF' isSRGB isMip isClamped bitmap' = do
67 let bitmap = case bitmap' of
68 ImageRGB8 i@(Image w h _) -> bitmap' -- pixelFoldMap (\(PixelRGB8 r g b) -> [PixelRGBA8 r g b maxBound]) i
69 ImageRGBA8 i@(Image w h _) -> bitmap' -- pixelFoldMap (\(PixelRGBA8 r g b a) -> [PixelRGBA8 r g b a]) i
70 ImageYCbCr8 i@(Image w h _) -> ImageRGB8 $ convertImage i -- $ Image w h $ SV.fromList $ pixelFoldMap (\p -> let PixelRGB8 r g b = convertPixel p in [PixelRGBA8 r g b maxBound]) i
71 ImageCMYK16 _ -> error "compileTexture2DRGBAF: ImageCMYK16"
72 ImageCMYK8 _ -> error "compileTexture2DRGBAF: ImageCMYK8"
73 ImageRGBA16 _ -> error "compileTexture2DRGBAF: ImageRGBA16"
74 ImageRGBF _ -> error "compileTexture2DRGBAF: ImageRGBF"
75 ImageRGB16 _ -> error "compileTexture2DRGBAF: ImageRGB16"
76 ImageYA16 _ -> error "compileTexture2DRGBAF: ImageYA16"
77 ImageYA8 _ -> error "compileTexture2DRGBAF: ImageYA8"
78 ImageYF _ -> error "compileTexture2DRGBAF: ImageYF"
79 ImageY16 _ -> error "compileTexture2DRGBAF: ImageY16"
80 ImageY8 _ -> error "compileTexture2DRGBAF: ImageY8"
81 _ -> error "compileTexture2DRGBAF: unknown image"
82
83 glPixelStorei gl_UNPACK_ALIGNMENT 1
84 to <- alloca $! \pto -> glGenTextures 1 pto >> peek pto
85 glBindTexture gl_TEXTURE_2D to
86 let (width,height) = bitmapSize bitmap
87 bitmapSize (ImageRGB8 (Image w h _)) = (w,h)
88 bitmapSize (ImageRGBA8 (Image w h _)) = (w,h)
89 bitmapSize _ = error "unsupported image type :("
90 withBitmap (ImageRGB8 (Image w h v)) f = SV.unsafeWith v $ f (w,h) 3 0
91 withBitmap (ImageRGBA8 (Image w h v)) f = SV.unsafeWith v $ f (w,h) 4 0
92 withBitmap _ _ = error "unsupported image type :("
93 wrapMode = case isClamped of
94 True -> gl_CLAMP_TO_EDGE
95 False -> gl_REPEAT
96 (minFilter,maxLevel) = case isMip of
97 False -> (gl_LINEAR,0)
98 True -> (gl_LINEAR_MIPMAP_LINEAR, floor $ log (fromIntegral $ max width height) / log 2)
99 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_S $ fromIntegral wrapMode
100 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_WRAP_T $ fromIntegral wrapMode
101 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $ fromIntegral minFilter
102 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $ fromIntegral gl_LINEAR
103 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_BASE_LEVEL 0
104 glTexParameteri gl_TEXTURE_2D gl_TEXTURE_MAX_LEVEL $ fromIntegral maxLevel
105 withBitmap bitmap $ \(w,h) nchn 0 ptr -> do
106 let internalFormat = fromIntegral $ if isSRGB then (if nchn == 3 then gl_SRGB8 else gl_SRGB8_ALPHA8) else (if nchn == 3 then gl_RGB8 else gl_RGBA8)
107 dataFormat = fromIntegral $ case nchn of
108 3 -> gl_RGB
109 4 -> gl_RGBA
110 _ -> error "unsupported texture format!"
111 glTexImage2D gl_TEXTURE_2D 0 internalFormat (fromIntegral w) (fromIntegral h) 0 dataFormat gl_UNSIGNED_BYTE $ castPtr ptr
112 when isMip $ glGenerateMipmap gl_TEXTURE_2D
113 return $ TextureData to
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 03:02:30 +0000