diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 81061a174..6b68f0ea3 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -1,4 +1,6 @@ -module Main where +module Main + ( main + ) where import Loop import Dodge.Data import Dodge.Initialisation @@ -31,6 +33,7 @@ import qualified Data.Map.Strict as M main :: IO () main = do + -- load the config to get the window size and position con <- loadDodgeConfig let sizex = floor $ _windowX con sizey = floor $ _windowY con @@ -39,22 +42,21 @@ main = do setupLoop 20 (sizex,sizey) - (posx,posy) + (Just (posx,posy)) theCleanup - (firstWorldLoad (sizex,sizey)) + (firstWorldLoad con) theUpdateStep (flip handleEvent) theCleanup :: World -> IO () theCleanup w = SDL.cursorVisible $= True >> cleanUpPreload (_preloadData w) -firstWorldLoad :: (Int,Int) -> IO World -firstWorldLoad (sizex,sizey) = do +firstWorldLoad :: Configuration -> IO World +firstWorldLoad theConfig = do SDL.cursorVisible $= False theKeyConfig <- loadKeyConfig - theConfig <- loadDodgeConfig pdata <- doPreload >>= applyWorldConfig theConfig - w <- fmap (setWindowSize sizex sizey . (keyConfig .~ theKeyConfig) . (config .~ theConfig)) firstWorld + w <- fmap ((keyConfig .~ theKeyConfig) . (config .~ theConfig)) firstWorld return $ w & preloadData .~ pdata theUpdateStep :: World -> IO World @@ -88,25 +90,18 @@ doSideEffects w = do doPreload :: IO PreloadData doPreload = do + rData <- preloadRender lChunks <- loadSounds lMusic <- loadMusic - let sData = SoundData {_loadedChunks = lChunks} - mData = MusicData {_loadedMusic = lMusic} Mix.playMusic Mix.Forever (lMusic IM.! 0) - rData <- preloadRender - return $ PreloadData + return PreloadData { _renderData = rData - , _soundData = sData - , _musicData = mData + , _soundData = SoundData {_loadedChunks = lChunks} + , _musicData = MusicData {_loadedMusic = lMusic} , _frameTimer = 0 } -checkForGlErrors :: IO () -checkForGlErrors = do - errs <- errors - unless (null errs) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs) - -setWindowSize :: Int -> Int -> World -> World -setWindowSize x y w = w - & config . windowX .~ fromIntegral x - & config . windowY .~ fromIntegral y +--checkForGlErrors :: IO () +--checkForGlErrors = do +-- errs <- errors +-- unless (null errs) $ putStrLn $ "GLerror during doLoop: " ++ unwords (map show errs) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 0c2e6ae62..6c2ae9f49 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -59,7 +59,7 @@ handleMouseButtonEvent mbev w = case mouseButtonEventMotion mbev of where but = mouseButtonEventButton mbev -{- | Sets window position in config. -} +{- | Sets window position in config. -} handleWindowMoveEvent :: WindowMovedEventData -> World -> Maybe World handleWindowMoveEvent mev w = Just $ w & config . windowPosX .~ fromIntegral x @@ -67,7 +67,7 @@ handleWindowMoveEvent mev w = Just $ w where P (V2 x y) = windowMovedEventPosition mev -{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -} +{- | Resets the world window size, and resizes the fbo that gets the light map drawn into it. -} handleResizeEvent :: WindowSizeChangedEventData -> World -> Maybe World handleResizeEvent sev w = Just . set (config . windowX) (fromIntegral x) diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index e3c4bd5ab..a39ee009a 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -10,7 +10,6 @@ import Dodge.Item.Data import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.UseEffect import Dodge.Item.Attachment.Data -import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit import Dodge.Picture.Layer import Dodge.Creature.Test @@ -52,6 +51,7 @@ bezierRecock = ItInvEffect _ -> it & itAttachment .~ NoItAttachment {- | Creates a laser scope and recocks the weapon. +TODO add the laser scope! -} itemLaserScopeEffect :: ItEffect itemLaserScopeEffect @@ -63,7 +63,6 @@ itemLaserScopeEffect | invid == _crInvSel cr && crIsAiming' cr = w & particles %~ (:) (makeLaserScope sp ep reloadFrac) & creatures . ix (_crID cr) . crInv . ix invid . itHammer %~ moveHammerUp - & laserScopeTargetGlow col glowPoint | otherwise = w where p = _crPos cr @@ -74,14 +73,14 @@ itemLaserScopeEffect ep = case listToMaybe $ thingsHitLongLine sp xp w of Just (pos,_) -> pos Nothing -> xp - glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of - Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl - _ -> ep -.- 2 *.* unitVectorAtAngle d + --glowPoint = case listToMaybe $ thingsHitLongLine sp xp w of + -- Just (pos,E3x2 wl) -> pos +.+ 2 *.* wallNormal wl + -- _ -> ep -.- 2 *.* unitVectorAtAngle d it = (cr ^. crInv) IM.! invid reloadFrac | _wpLoadedAmmo it == 0 = 1 | otherwise = fromIntegral (_wpReloadState it) / fromIntegral (_wpReloadTime it) - col = mixColors reloadFrac (1-reloadFrac) red green + --col = mixColors reloadFrac (1-reloadFrac) red green {- | Automatically send out radar pulses that detect walls. -} autoRadarEffect :: ItEffect autoRadarEffect = ItInvEffect {_itInvEffect = f 50 ,_itEffectCounter = 0 } diff --git a/src/Dodge/Particle/Bullet/HitEffect.hs b/src/Dodge/Particle/Bullet/HitEffect.hs index 26256d2fa..420844a43 100644 --- a/src/Dodge/Particle/Bullet/HitEffect.hs +++ b/src/Dodge/Particle/Bullet/HitEffect.hs @@ -30,7 +30,7 @@ bulHitCr :: Particle -> Point2 -> Creature -> World -> World bulHitCr bt p cr w | crIsArmouredFrom p cr = createSparkCol 8 colID p1 (argV (p1 -.- p) + d1) . addDamageArmoured $ w - | otherwise = addDamage . makeHitSound . flashEff $ w + | otherwise = addDamage . makeHitSound $ w where sp = head $ _btTrail' bt bulVel = _btVel' bt @@ -39,7 +39,6 @@ bulHitCr bt p cr w addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ ) addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10) - flashEff = over worldEvents (bloodFlashAt p . ) cid = _crID cr (d1,_) = randomR (-0.7,0.7) $ _randGen w colID = _btColor' bt @@ -48,7 +47,7 @@ bulHitCr bt p cr w bulBounceArmCr' :: Particle -> Point2 -> Creature -> World -> World bulBounceArmCr' bt p cr w | crIsArmouredFrom p cr = addBouncer . addDamageArmoured $ w - | otherwise = addDamage . makeHitSound . flashEff $ w + | otherwise = addDamage . makeHitSound $ w where sp = head $ _btTrail' bt bulVel = _btVel' bt @@ -57,7 +56,6 @@ bulBounceArmCr' bt p cr w addDamage = creatures . ix cid . crState . crDamage %~ ((Piercing 100 sp p ep : mvDams) ++ ) addDamageArmoured = creatures . ix cid . crState . crDamage %~ (mvDams ++) makeHitSound = soundMultiFrom [CrHitSound 0] p hit1S (Just 10) - flashEff = over worldEvents ((.) $ bloodFlashAt p) cid = _crID cr newDir = safeNormalizeV (p -.- _crPos cr) pOut = p +.+ 2 *.* newDir diff --git a/src/Dodge/WorldEvent.hs b/src/Dodge/WorldEvent.hs index 046723718..3d03a2ca3 100644 --- a/src/Dodge/WorldEvent.hs +++ b/src/Dodge/WorldEvent.hs @@ -12,19 +12,15 @@ import Dodge.Particle.Bullet.Draw import Dodge.Particle.Bullet.Update import Dodge.WorldEvent.Flash import Dodge.WorldEvent.ThingsHit ---import Dodge.WorldEvent.HelperParticle import Dodge.WorldEvent.Cloud import Dodge.WorldEvent.HitEffect import Dodge.WorldEvent.Explosion import Dodge.WorldEvent.SpawnParticle ---import Dodge.WorldEvent.Shockwave import Dodge.LightSources.Lamp import Dodge.Creature.State.Data import Dodge.Data import Dodge.Data.DamageType ---import Dodge.Base import Geometry ---import Picture import Control.Lens import System.Random diff --git a/src/Dodge/WorldEvent/Flash.hs b/src/Dodge/WorldEvent/Flash.hs index 1fa79ecb0..4f963e3a6 100644 --- a/src/Dodge/WorldEvent/Flash.hs +++ b/src/Dodge/WorldEvent/Flash.hs @@ -1,14 +1,20 @@ {- | Flashes. projected naming conventions: three base types of light: -glare : "low lighting", draws lines around creatures and walls -flare : coloured light drawn on top of picture in fixed shapes -light : removal of shadows +glare : Draws color onto surfaces (not done) +flare : coloured light drawn in space, fixed shapes +light : removal of shadows (onto surfaces) duration (subject to modification): flash : short, abrupt changes in alpha glow : continuous, potentially long, fading, slow changes in alpha flicker : potentially long, moving, abrupt changes in alpha -} module Dodge.WorldEvent.Flash + ( sparkFlashAt + , explosionFlashAt + , laserGunFlashAt + , teslaGunFlashAt + , lowLightDirected + ) where import Dodge.Data --import Dodge.Base @@ -22,33 +28,13 @@ import Geometry import Data.Maybe (maybeToList) import Control.Lens -glareAt :: Int -> Float -> Float -> Color -> Int -> Float -> Point2 -> World -> World -glareAt t len wdth col nrays rad p w = foldr (glareLine' t len wdth col p) w ps - where - ps = map (p +.+) $ nRaysRad nrays rad - -{- White flash. -} -sparkFlashAt :: Point2 -> World -> World -sparkFlashAt = - glareAt 2 10 5 (withAlpha 0.05 white) 20 30 - -{- Red flash. -} -bloodFlashAt :: Point2 -> World -> World -bloodFlashAt p = - over particles (flashFlareAt red 0.4 p : ) - . glareAt 2 10 5 (withAlpha 0.05 red) 20 30 p - {- Cyan flash. -} teslaGunFlashAt :: Point2 -> World -> World -teslaGunFlashAt p = - over particles (flashFlareAt cyan 0.3 p : ) - . glareAt 2 10 5 (withAlpha 0.1 cyan) 20 30 p +teslaGunFlashAt = flareCircleAt cyan 0.7 {- Yellow flash. -} laserGunFlashAt :: Point2 -> World -> World -laserGunFlashAt p = - over particles (flashFlareAt yellow 0.2 p : ) - . glareAt 2 10 5 (withAlpha 0.05 yellow) 20 30 p +laserGunFlashAt = flareCircleAt yellow 0.2 glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++) @@ -77,12 +63,14 @@ lowLightPic len wdth col (a,b) w = case thingsHit a b w of _ -> blank where setCol = color col . setDepth (-0.5) . setLayer 2 -flashFlareAt :: Color -> Float -> Point2 -> Particle -flashFlareAt col alphax (V2 x y) = Particle - { _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y - $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30 - , _ptUpdate = ptTimer' 1 - } +flareCircleAt :: Color -> Float -> Point2 -> World -> World +flareCircleAt col alphax (V2 x y) = particles %~ (theFlareCircle :) + where + theFlareCircle = Particle + { _ptDraw = const $ setLayer 2 . setDepth 20 . translate x y + $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30 + , _ptUpdate = ptTimer' 1 + } explosionFlashAt :: Point2 -> World -> World explosionFlashAt p = over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p) @@ -91,27 +79,9 @@ explosionFlashAt p = over tempLightSources ((:) $ tLightTimedIntensity 20 150 i | x < 10 = 1 / (10 - fromIntegral x) | otherwise = 1 -flameGlareAt :: Point2 -> World -> World -flameGlareAt = glareAt 1 10 5 (withAlpha 0.05 orange) 8 40 - lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World lowLightDirected col a b angles w = foldr (\angle w' -> glareLine' 2 10 5 col a (a +.+ rotateV angle b) w') w angles - -muzzleFlashAt :: Point2 -> World -> World -muzzleFlashAt p = over particles (muzzleFlashPt p : ) - . glareAt 2 10 5 (withAlpha 0.5 white) 20 30 p - -muzzleFlashPt :: Point2 -> Particle -muzzleFlashPt (V2 x y) = Particle - { _ptDraw = const $ setDepth 0 - . setLayer 2 - . translate x y - $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20 - , _ptUpdate = ptTimer' 1 - } - -laserScopeTargetGlow :: Color -> Point2 -> World -> World -laserScopeTargetGlow col = glareAt 2 3 1 (withAlpha 0.1 col) 15 5 - +sparkFlashAt :: Point2 -> World -> World +sparkFlashAt _ = id diff --git a/src/Geometry.hs b/src/Geometry.hs index 067141cf9..d062c3dc0 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -15,7 +15,6 @@ module Geometry , module Geometry.Bezier , module Geometry.Vector , module Geometry.LHS - --, module Geometry.Zone ) where import Geometry.Data @@ -23,7 +22,6 @@ import Geometry.Intersect import Geometry.Bezier import Geometry.Vector import Geometry.LHS ---import Geometry.Zone import Data.Maybe import Data.List @@ -236,7 +234,6 @@ prependTwo _ [] = [] prependTwo _ [_] = [] prependTwo sep (x:y:xs) = sep : x : y : prependTwo sep (y:xs) - -- | Return n equidistant points on a circle with a radius of 600. nRays :: Int -> [Point2] nRays n = take n $ iterate (rotateV (2*pi/fromIntegral n)) (V2 600 0) @@ -349,8 +346,6 @@ reflectInParam x line vec = rAng = rotateV angle vec p = x *.* errorClosestPointOnLine 3 (V2 0 0) (vNormal line) rAng in rAng -.- p ---reflectIn' :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 ---reflectIn' l1 l2 v1 v2 = v1 +.+ reflectIn (l1 -.- l2) (v2 -.- v1) isOnSeg :: Point2 -> Point2 -> Point2 -> Bool isOnSeg l1 l2 p = @@ -452,17 +447,6 @@ arcStepwisePositive ssize a cen v = (cen +.+) . (`rotateV` v) <$> rots n :: Int n = ceiling (a * magV v / ssize) ---nPointsOnCirc :: Int -> Float -> [Point2] ---nPointsOnCirc n rad = take n $ iterate (rotateV (2*pi/fromIntegral n)) (rad,0) - ---lineInPolygon :: Point2 -> Point2 -> [Point2] -> Bool ---lineInPolygon a b ps = --- pointInPolygon a ps --- || pointInPolygon b ps --- || any (isJust . uncurry (intersectSegSeg' a b)) pss --- where --- pss = zip ps (tail ps ++ [head ps]) - -- | Given a list of points, returns pairs of points linking the points into a -- loop. makeLoopPairs :: [Point2] -> [(Point2,Point2)] diff --git a/src/Loop.hs b/src/Loop.hs index 6a5d606fa..63962b4d7 100644 --- a/src/Loop.hs +++ b/src/Loop.hs @@ -19,17 +19,17 @@ import qualified Graphics.Rendering.OpenGL as GL setupLoop :: Int -- ^ Target seconds per frame -> (Int,Int) -- ^ The window size. - -> (Int,Int) -- ^ The window position. + -> Maybe (Int,Int) -- ^ The window position. -> (world -> IO ()) -- ^ Function for cleaning up parameters, applied when exiting loop. -> IO world -- ^ Initial simulation state. -> (world -> IO world) -- ^ update, called once per frame. Allows for side effects such as rendering. -> (world -> Event -> Maybe world) -- ^ SDL Event handling, once per frame. Evaluating 'Nothing' exits the loop. -> IO () -setupLoop spf (xSize,ySize) (xPos,yPos) paramCleanup ioStartWorld sideEffects eventFn = do +setupLoop spf (xSize,ySize) winpos paramCleanup ioStartWorld sideEffects eventFn = do initializeAll bracket - (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize xPos yPos)) + (createWindow (T.pack "Simple Game Loop") (winConfig xSize ySize winpos)) destroyWindow $ \window -> bracket (glCreateContext window) @@ -78,13 +78,17 @@ applyEventIO fn mw e = case eventPayload e of -> GL.viewport $= (GL.Position 0 0,GL.Size x y) >> return (mw >>= \w -> fn w e) _ -> return $ mw >>= flip fn e -- | Create an OpenGL SDL window configuration with a given x and y size. -winConfig :: Int -> Int -> Int -> Int -> WindowConfig -winConfig x y px py = defaultWindow +winConfig :: Int -> Int -> Maybe (Int, Int) -> WindowConfig +winConfig x y winpos = defaultWindow { windowGraphicsContext = OpenGLContext $ defaultOpenGL { glProfile = Core Normal 4 3 , glColorPrecision = V4 8 8 8 8 } - , windowPosition = Absolute (P (V2 (fromIntegral px) (fromIntegral py))) + , windowPosition = theWinPos , windowInitialSize = V2 (fromIntegral x) (fromIntegral y) , windowResizable =True } + where + theWinPos = case winpos of + Just (px,py) -> Absolute (P (V2 (fromIntegral px) (fromIntegral py))) + Nothing -> Wherever diff --git a/src/Polyhedra/Data.hs b/src/Polyhedra/Data.hs index 353b59b73..0a1f6eee7 100644 --- a/src/Polyhedra/Data.hs +++ b/src/Polyhedra/Data.hs @@ -21,6 +21,5 @@ newtype Polyhedra = Polyhedron newtype VF a = VF { _vertices :: M.Map a (Point3, [[a]]) } - makeLenses ''Polyhedra makeLenses ''VF diff --git a/src/Polyhedra/Geodesic.hs b/src/Polyhedra/Geodesic.hs index ca4e903d8..a1b6b66d6 100644 --- a/src/Polyhedra/Geodesic.hs +++ b/src/Polyhedra/Geodesic.hs @@ -71,9 +71,3 @@ facesToVF faces = foldr f M.empty vs vs = nub $ concat faces f v = M.insert v (g v) g v = map (tail . rotateTo (== v)) $ filter (elem v) faces - ---triPyramid :: VF ---triPyramid = VF - ---dual :: VF a -> VF [a] ---dual vf = diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index c3989b4e7..f145d3b98 100644 --- a/src/Preload/Render.hs +++ b/src/Preload/Render.hs @@ -15,8 +15,6 @@ import Framebuffer.Setup import Data.Preload.Render import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) ---import Graphics.GL.Core43 ---import Control.Lens import Control.Monad import Foreign import qualified Data.Vector.Mutable as MV diff --git a/src/Preload/Update.hs b/src/Preload/Update.hs index 42ecf4c9e..2389e9602 100644 --- a/src/Preload/Update.hs +++ b/src/Preload/Update.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Preload.Update - (pdataResizeUpdate + ( pdataResizeUpdate ) where import Data.Preload import Framebuffer.Update @@ -39,4 +39,3 @@ renderDataResizeUpdate xsize ysize xfull yfull rdata = do bbShad <- makeByteStringShaderUsingVAO "bloomBlur" [(vert,bbVert),(frag,bbFrag')] ETriangleStrip (_fullscreenShader rdata) return (rdata' {_bloomBlurShader = bbShad}) - diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 467f4fc11..586656c5f 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -9,14 +9,11 @@ module Shader.AuxAddition import Shader.Data import Data.List.Extra ---import Foreign import Codec.Picture import qualified Data.Vector.Storable as V import Control.Lens import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Graphics.GL.Core43 ---import Graphics.GL.Groups ---import Text.RawString.QQ -- I am not sure if this assumes that the shader is constructed directly before -- the texture is added... @@ -45,7 +42,6 @@ vaddTextureNoFilter texturePath shad = do let wtex = fromIntegral $ imageWidth tex htex = fromIntegral $ imageHeight tex glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex - --withArray texData $ \ptr -> do V.unsafeWith (imageData tex) $ \ptr -> do glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} diff --git a/src/Shader/Bind.hs b/src/Shader/Bind.hs index 500599cf5..88a6bbc5c 100644 --- a/src/Shader/Bind.hs +++ b/src/Shader/Bind.hs @@ -5,7 +5,6 @@ module Shader.Bind ) where import Shader.Data import Shader.Parameters ---import Shader.ExtraPrimitive import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T) import Foreign hiding (rotate) diff --git a/src/Shader/ExtraPrimitive.hs b/src/Shader/ExtraPrimitive.hs index 802e232d5..261a3df2c 100644 --- a/src/Shader/ExtraPrimitive.hs +++ b/src/Shader/ExtraPrimitive.hs @@ -6,6 +6,7 @@ import Graphics.GL.Types import Graphics.GL.Tokens marshalEPrimitiveMode :: EPrimitiveMode -> GLenum +{-# INLINABLE marshalEPrimitiveMode #-} marshalEPrimitiveMode x = case x of EPoints -> GL_POINTS ELines -> GL_LINES diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 26dc469cd..eeffe8e90 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -1,12 +1,9 @@ ---{-# LANGUAGE TupleSections #-} ---{-# LANGUAGE BangPatterns #-} module Shader.Poke ( pokeVerxs , pokeLayVerxs , pokeArrayOff , pokePoint33s , pokeShape - , pokePoint3s , pokeWallsWindowsFloor ) where import Shader.Data @@ -23,11 +20,6 @@ import qualified Data.Vector.Unboxed.Mutable as UMV import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Fusion.Stream.Monadic as VS import Control.Monad.Primitive ---import Control.Parallel.Strategies ---import System.Environment ---import Control.Monad.Parallel as MP ---import Control.Monad ---import qualified Data.DList as DL pokeVerxs :: MV.MVector (PrimState IO) FullShader @@ -186,16 +178,6 @@ pokeJustV ptr counts sh = do V3 a b c = _svPos sh V4 d e f g = _svCol sh -pokePoint3s :: Ptr Float -> VS.Stream IO Point3 -> IO Int -pokePoint3s ptr = VS.foldlM' (pokePoint3 ptr) 0 - -pokePoint3 :: Ptr Float -> Int -> Point3 -> IO Int -pokePoint3 ptr n (V3 a b c) = do - pokeElemOff ptr (n * 3) a - pokeElemOff ptr (n * 3 + 1) b - pokeElemOff ptr (n * 3 + 2) c - return $ n + 1 - pokeLayVerxs :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index 52814e1b9..d745698f9 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -8,10 +8,7 @@ module Shape.Data import Geometry.Data import Control.Lens ---import qualified Data.DList as DL - type Shape = [ShapeObj] - _shVertices :: Shape -> [ShapeV] {-# INLINE _shVertices #-} _shVertices = concatMap _shVs @@ -43,5 +40,4 @@ data ShapeV = ShapeV pairToSV :: (Point3,Point4) -> ShapeV {-# INLINE pairToSV #-} pairToSV = uncurry ShapeV - makeLenses ''ShapeV diff --git a/src/Sound/Data.hs b/src/Sound/Data.hs index 1a95ed673..1ba202080 100644 --- a/src/Sound/Data.hs +++ b/src/Sound/Data.hs @@ -8,17 +8,14 @@ import Control.Lens import Geometry.Data import Data.Word (Word8) import Data.Int (Int16) - data SoundStatus = JustStartedPlaying | Playing | ToStart | ToContinueStart deriving (Eq,Ord,Show) - newtype SoundID = SoundID { _getSoundID :: Int } deriving (Eq,Ord,Show) - newtype SoundData = SoundData {_loadedChunks :: IM.IntMap Mix.Chunk } @@ -32,6 +29,5 @@ data Sound = Sound , _soundChunkID :: SoundID } deriving (Eq,Ord,Show) - makeLenses ''SoundData makeLenses ''Sound