diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 703f8b757..e6347bb59 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +--{-# LANGUAGE TupleSections #-} {- | Drawing of creatures. Takes into account damage etc. -} @@ -55,6 +55,7 @@ basicCrShape col cr = tr $ mconcat , translateSHz 25 . dm . rotdir $ scalp cr , dm . rotmdir $ feet cr , dm . rotdir $ upperBody col cr + , rotdir $ _spShape $ drawEquipment cr ] where dm = damageModSH cr diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index df65e8565..4c233d79d 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -75,9 +75,6 @@ data World = World , _playingSounds :: M.Map SoundOrigin Sound , _decorations :: IM.IntMap Picture , _foregroundShape :: Shape - --, _foregroundDecorations :: [Polyhedra] - , _foregroundDecorations :: Shape - , _foregroundEdgeVerx :: [Point3] , _corpses :: Zone [Corpse] , _clickMousePos :: !Point2 , _pathGraph :: ~(Gr Point2 Float) diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index c7e9ec6bf..9d6d09abb 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -36,7 +36,7 @@ defaultCreature = Creature , _crOldDir = 0 , _crMvDir = 0 , _crID = 1 - , _crPict = \_ _ -> (,) (mempty) blank + , _crPict = \_ _ -> (,) mempty blank , _crUpdate = \cr _ -> (Endo id , Just cr) , _crRad = 10 , _crMass = 10 @@ -200,7 +200,7 @@ defaultIt = Consumable , _itAmount = 2 , _cnEffect = const return , _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] - , _itEquipPict = \_ _ -> (,) emptySH $ blank + , _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing , _itInvDisplay = _itName , _itInvColor = blue diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 64a20cd75..c3c359335 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -80,8 +80,6 @@ defaultWorld = World , _inventoryMode = TopInventory , _lClickHammer = HammerUp , _foregroundShape = mempty - , _foregroundDecorations = mempty - , _foregroundEdgeVerx = [] , _radDistortion = [] , _gameRooms = [] , _preloadData = DummyPdata -- hack TODO remove this diff --git a/src/Dodge/Item/Equipment.hs b/src/Dodge/Item/Equipment.hs index 035ef630a..3b13498cb 100644 --- a/src/Dodge/Item/Equipment.hs +++ b/src/Dodge/Item/Equipment.hs @@ -16,7 +16,7 @@ magShield = defaultEquipment , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = (,) emptySH $ onLayer FlItLayer $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] - , _itEquipPict = \_ _ -> (,) emptySH $ blank + , _itEquipPict = \_ _ -> (,) emptySH blank , _itID = Nothing } flameShield :: Item diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 1091fd2a0..91f943a3c 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -440,15 +440,18 @@ spreadGun = defaultGun ] , _wpSpread = spreadGunSpread , _wpRange = 20 - , _itFloorPict = (,) emptySH $ onLayer FlItLayer spreadGunPic + , _itFloorPict = spreadGunPic , _itAimingSpeed = 1 , _itAimingRange = 0 - , _itEquipPict = pictureWeaponOnAim $ (,) emptySH spreadGunPic + , _itEquipPict = pictureWeaponOnAim $ spreadGunPic , _wpAmmo = basicBullet , _wpNumBarrels = 50 } -spreadGunPic :: Picture -spreadGunPic = color green $ pictures [ polygon $ map toV2[(-3,0),(3,6),(3,-6)] ] +spreadGunPic :: SPic +spreadGunPic = + ( colorSH green $ upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)] + , mempty + ) multGun :: Item multGun = defaultGun { _itName = "MULTGUN" @@ -1111,7 +1114,7 @@ autoSonar = defaultEquipment , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] - , _itEquipPict = \_ _ -> (,) emptySH $ blank + , _itEquipPict = \_ _ -> (,) emptySH blank , _itEffect = autoSonarEffect , _itID = Nothing , _itAimingSpeed = 1 @@ -1128,7 +1131,7 @@ autoRadar = defaultEquipment , _itMaxStack = 1 , _itAmount = 1 , _itFloorPict = (,) emptySH $ onLayer FlItLayer $ color yellow $ polygon $ map toV2 [(-3,-3),(-3,3),(3,3),(3,-3)] - , _itEquipPict = \_ _ -> (,) emptySH $ blank + , _itEquipPict = \_ _ -> (,) emptySH blank , _itEffect = autoRadarEffect , _itID = Nothing , _itAimingSpeed = 1 diff --git a/src/Dodge/Item/Weapon/AutoGun.hs b/src/Dodge/Item/Weapon/AutoGun.hs index 590f99fb7..218bfcd8a 100644 --- a/src/Dodge/Item/Weapon/AutoGun.hs +++ b/src/Dodge/Item/Weapon/AutoGun.hs @@ -9,14 +9,13 @@ import Dodge.Item.Weapon.ExtraEffect import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.AmmoParams import Dodge.Item.Data -import Dodge.Picture.Layer import Dodge.Item.Draw import Dodge.Item.Weapon.Bullet import Dodge.Item.Weapon.TriggerType import Dodge.SoundLogic.LoadSound import Picture import Geometry ---import ShapePicture +import ShapePicture import Shape import qualified Data.Sequence as Seq @@ -51,20 +50,23 @@ autoGun = defaultAutoGun , _wpSpread = autogunSpread , _wpRange = 20 , _itHammer = HammerUp - , _itFloorPict = (,) emptySH $ onLayer FlItLayer autoGunPic + , _itFloorPict = autoGunPic , _itAimingSpeed = 0.4 , _itAimingRange = 1 , _itZoom = defaultItZoom , _itAimZoom = defaultItZoom {_itZoomFac = 1.5} - , _itEquipPict = pictureWeaponOnAim $ (,) emptySH autoGunPic + , _itEquipPict = pictureWeaponOnAim autoGunPic , _itEffect = wpRecock , _itAttachment = ItCharMode $ Seq.fromList "MS" , _itScroll = scrollCharMode , _itInvDisplay = basicWeaponDisplay , _wpAmmo = basicBullet } -autoGunPic :: Picture -autoGunPic = color red $ polygon $ rectNESW 4 12 (-4) (-12) +autoGunPic :: SPic +autoGunPic = + ( colorSH red $ upperPrismPoly 5 $ rectNESW 4 12 (-4) (-12) + , mempty + ) autogunSpread :: Float autogunSpread = 0.07 diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 69e337ddf..295795128 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -308,7 +308,7 @@ withTempLight time rad col eff item cr = eff item cr modClock :: Int -> ChainEffect -> ChainEffect modClock n chainEff eff it cr w - | _frameClock w `mod` n == 0 = (chainEff eff) it cr w + | _frameClock w `mod` n == 0 = chainEff eff it cr w | otherwise = eff it cr w withMuzFlareI :: ChainEffect diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 39fa5dfe0..9b20904b4 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -42,7 +42,7 @@ generateLevelFromRoomList gr w = updateWallZoning . setupWorldBounds -- . initializeStaticWalls - . setupForegroundEdgeVerxs +-- . setupForegroundEdgeVerxs . placeSpots plmnts -- . addRoomPolyDecorations rs -- . addRoomLinkDecorations rs @@ -76,9 +76,6 @@ setupWorldBounds w = w <*> L.premap sndV2 L.maximum ) ps -setupForegroundEdgeVerxs :: World -> World -setupForegroundEdgeVerxs w = w & foregroundShape .~ (_foregroundDecorations w) - polyhedrasToEdges :: [Polyhedra] -> [Point3] polyhedrasToEdges = concatMap tflat4 . concatMap polyToEdges diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 4c239f921..1506cffd4 100644 --- a/src/Dodge/LevelGen.hs +++ b/src/Dodge/LevelGen.hs @@ -99,7 +99,7 @@ placeSpot ps w = case _psType ps of where (q:qs) = map (shiftPointBy (p,rot)) ps' rmCrossPaths w' = foldr (uncurry removePathsCrossing) w' $ zip (q:qs) (qs++[q]) - PutForeground sh -> w & foregroundDecorations %~ ((uncurryV translateSHf p . rotateSH rot) sh <>) + PutForeground sh -> w & foregroundShape %~ ((uncurryV translateSHf p . rotateSH rot) sh <>) PutNothing -> w PutID _ -> w --_ -> w diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 28a26aba2..e976120ea 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -106,7 +106,7 @@ doDrawing pdata w = do glDrawElements (marshalEPrimitiveMode $ _shadPrim fs) (fromIntegral nIndices) - (GL_UNSIGNED_SHORT) + GL_UNSIGNED_SHORT nullPtr --draw floor onto base buffer diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index ecc4252b2..0351b870d 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +--{-# LANGUAGE TupleSections #-} module Dodge.Room.Foreground where import Dodge.Picture diff --git a/src/Render.hs b/src/Render.hs index 170f75b61..4f5363fab 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -77,7 +77,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do glDrawElements (marshalEPrimitiveMode $ _shadPrim llss) (fromIntegral nSils) - (GL_UNSIGNED_SHORT) + GL_UNSIGNED_SHORT nullPtr cullFace $= Just Back @@ -91,7 +91,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do glDrawElements (marshalEPrimitiveMode $ _shadPrim fs) (fromIntegral nCaps) - (GL_UNSIGNED_SHORT) + GL_UNSIGNED_SHORT nullPtr --drawShader (_lightingCapShader pdata) nCaps --draw lightmap itself diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index ba517caca..6de017b34 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -48,7 +48,7 @@ pokeShape -> Ptr GLushort -- ^ edge indices pointer -> Shape -> IO (Int,Int,Int) -pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0) . fst +pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0) pokeShapeObjs :: Ptr Float @@ -96,7 +96,7 @@ topPrismEdgeIndices n = concatMap f [0..n-1] , 1 , 3 ,-1 , 2 ] where - g j = (2 * i + j) `mod` n + g j = (2 * i + j) `mod` (2*n) topPrismIndices :: Int -> [Int] topPrismIndices n = concatMap f [1..n-2] -- triangles on top face diff --git a/src/Shape.hs b/src/Shape.hs index 9dee75f27..b0aecdf7e 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -14,29 +14,23 @@ module Shape where import Geometry import Geometry.Vector3D -import Geometry.ConvexPoly import Shape.Data import Color -import Data.Bifunctor - emptySH :: Shape {-# INLINE emptySH #-} emptySH = mempty polyCirc :: Int -> Float -> [Point2] {-# INLINE polyCirc #-} -polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/(fromIntegral n)..] +polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/fromIntegral n..] upperPrismPoly :: Float -- ^ height, expected to be strictly positive -> [Point2] -> Shape {-# INLINE upperPrismPoly #-} -upperPrismPoly h ps = - ( [ShapeObj (TopPrism n) (f upps downps)] - , topEdges <> bottomEdges <> sideEdges - ) +upperPrismPoly h ps = [ShapeObj (TopPrism n) (f upps downps)] where n = length ps upps = map f' ps @@ -46,13 +40,6 @@ upperPrismPoly h ps = f _ [] = [] f' (V2 x y) = pairToSV (V3 x y h, black) f'' (V2 x y) = pairToSV (V3 x y 0, black) - topEdges = shEfromList $ concat $ zipWith makeTopEdge ps (tail ps ++ [head ps]) - makeTopEdge (V2 x y) (V2 x' y') = [V3 x y h,V3 x' y' h,V3 x y 0,V3 xcen ycen h] - V2 xcen ycen = centroid ps - bottomEdges = shEfromList $ concat $ zipWith makeBottomEdge ps (tail ps ++ [head ps]) - makeBottomEdge (V2 x' y') (V2 x y) = [V3 x y 0,V3 x' y' 0,V3 x y h,V3 xcen ycen 0] - sideEdges = shEfromList $ concat $ zipWith3 makeSideEdge ps (tail ps ++ [head ps]) (drop 2 ps ++ take 2 ps) - makeSideEdge (V2 xl yl) (V2 x y) (V2 xr yr) = [V3 x y 0, V3 x y h, V3 xr yr 0, V3 xl yl h] colorSH :: Color -> Shape -> Shape {-# INLINE colorSH #-} @@ -60,11 +47,11 @@ colorSH col = overCol $ const col overCol :: (Point4 -> Point4) -> Shape -> Shape {-# INLINE overCol #-} -overCol f = first (fmap $ overColObj f) +overCol f = fmap $ overColObj f overPos :: (Point3 -> Point3) -> Shape -> Shape {-# INLINE overPos #-} -overPos f = bimap (fmap $ overPosObj f) (fmap f) +overPos f = fmap $ overPosObj f translateSH :: Point3 -> Shape -> Shape {-# INLINE translateSH #-} @@ -84,7 +71,7 @@ rotateSH a = overPos (rotate3 a) scaleSH :: Point3 -> Shape -> Shape {-# INLINE scaleSH #-} -scaleSH !(V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c)) +scaleSH (V3 a b c) = overPos (\(V3 x y z) -> V3 (x*a) (y*b) (z*c)) overColObj :: (Point4 -> Point4) -> ShapeObj -> ShapeObj {-# INLINE overColObj #-} diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index 853a7ffd1..52814e1b9 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -6,25 +6,20 @@ module Shape.Data where import Geometry.Data + +import Control.Lens --import qualified Data.DList as DL -type Shape = ([ShapeObj], [Point3]) +type Shape = [ShapeObj] _shVertices :: Shape -> [ShapeV] {-# INLINE _shVertices #-} -_shVertices = concatMap _shVs . fst -_shEdges :: Shape -> [Point3] -{-# INLINE _shEdges #-} -_shEdges = snd +_shVertices = concatMap _shVs shVList :: Shape -> [ShapeV] {-# INLINE shVList #-} shVList = _shVertices --shVList = DL.toList . _shVertices -shEList :: Shape -> [Point3] -{-# INLINE shEList #-} -shEList = _shEdges ---shEList = DL.toList . _shEdges {-# INLINE shVfromList #-} shVfromList = id @@ -38,9 +33,7 @@ data ShapeObj = ShapeObj , _shVs :: [ShapeV] } -data ShapeType - = TopPrism Int --- | ListV +newtype ShapeType = TopPrism Int -- edges are given by four consecutive points data ShapeV = ShapeV @@ -51,7 +44,4 @@ pairToSV :: (Point3,Point4) -> ShapeV {-# INLINE pairToSV #-} pairToSV = uncurry ShapeV ---_svPos :: ShapeV -> Point3 ---_svPos = fst ---_svCol :: ShapeV -> Point4 ---_svCol = snd +makeLenses ''ShapeV