diff --git a/src/Data/Tile.hs b/src/Data/Tile.hs new file mode 100644 index 000000000..1d4bb544d --- /dev/null +++ b/src/Data/Tile.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TemplateHaskell #-} +module Data.Tile + where +import Geometry.Data + +import Control.Lens +data Tile = Tile + { _tilePoly :: [Point2] + , _tileCenter :: Point2 + , _tileX :: Point2 + , _tileY :: Point2 + , _tileZ :: Float + } +makeLenses ''Tile diff --git a/src/Dodge/Creature/State/Data.hs b/src/Dodge/Creature/State/Data.hs index 1372a5b16..1e2d1a7cb 100644 --- a/src/Dodge/Creature/State/Data.hs +++ b/src/Dodge/Creature/State/Data.hs @@ -2,7 +2,8 @@ {-# LANGUAGE StrictData #-} module Dodge.Creature.State.Data where -import Geometry +--import Geometry +import Geometry.Data import Dodge.Data.DamageType --import Dodge.Creature.Stance.Data import Picture.Data diff --git a/src/Dodge/Data/DamageType.hs b/src/Dodge/Data/DamageType.hs index 006f7595f..7f6332cf4 100644 --- a/src/Dodge/Data/DamageType.hs +++ b/src/Dodge/Data/DamageType.hs @@ -6,7 +6,8 @@ creatures. -} module Dodge.Data.DamageType where -import Geometry +--import Geometry +import Geometry.Data import Control.Lens diff --git a/src/Dodge/Default/Room.hs b/src/Dodge/Default/Room.hs new file mode 100644 index 000000000..470bea4e7 --- /dev/null +++ b/src/Dodge/Default/Room.hs @@ -0,0 +1,13 @@ +module Dodge.Default.Room + where +import Dodge.Room.Data + +defaultRoom :: Room +defaultRoom = Room + { _rmPolys = [] + , _rmLinks = [] + , _rmPath = [] + , _rmPS = [] + , _rmBound = [] + , _rmFloor = [] + } diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 3ab5e7d48..be7cfb883 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -10,6 +10,8 @@ import Dodge.Item.Data import Picture import Geometry import Picture.Texture +import Data.Tile +import Tile import System.Random import qualified Data.IntMap.Strict as IM @@ -37,17 +39,23 @@ defaultWorld = World , _wallsZone = IM.empty , _forceFields = IM.empty , _floorItems = IM.empty - , _floorTiles = - let x = 200 - y = 0.9 - z = 16 - r = 4 - in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)] - [(20,100 + 20,y) - ,( x,100 + 20,y) - ,( x,100 + x,y) - ,(20,100 + x,y) - ] + , _floorTiles = tToRender $ Tile + { _tilePoly = rectNSWE 200 0 0 200 + , _tileCenter = (0,0) + , _tileX = (100,0) + , _tileY = (0,100) + , _tileZ = 16 + } +-- let x = 200 +-- y = 0.9 +-- z = 16 +-- r = 8 +-- in tileToRender [(0,0,z),(r,0,z),(r,r,z),(0,r,z)] +-- [(20,100 + 20,y) +-- ,( x,100 + 20,y) +-- ,( x,100 + x,y) +-- ,(20,100 + x,y) +-- ] , _randGen = mkStdGen 2 , _mousePos = (0,0) , _testString = [] diff --git a/src/Dodge/Layout.hs b/src/Dodge/Layout.hs index 748941d72..14fabac11 100644 --- a/src/Dodge/Layout.hs +++ b/src/Dodge/Layout.hs @@ -14,6 +14,8 @@ import Geometry import Dodge.Room.Link import qualified IntMapHelp as IM --import Dodge.Debug.LinkDecoration +import Picture.Data +import Tile import Control.Monad.State import Control.Lens @@ -30,6 +32,7 @@ generateLevelFromRoomList gr w = updateWallZoning -- . addRoomPolyDecorations rs -- . addRoomLinkDecorations rs $ w { _walls = wallsFromRooms rs + , _floorTiles = floorsFromRooms rs } where plmnts = concatMap _rmPS rs @@ -89,6 +92,9 @@ wallsFromRooms = where f i (x,y) = defaultWall {_wlLine = (x,y) , _wlID = i} +floorsFromRooms :: [Room] -> [RenderType] +floorsFromRooms = concatMap (concatMap tToRender . _rmFloor) + divideWall :: Wall -> [Wall] divideWall wl = let (a,b) = _wlLine wl diff --git a/src/Dodge/Layout/Tree/Shift.hs b/src/Dodge/Layout/Tree/Shift.hs index e98d51dc5..bf8c7b5b9 100644 --- a/src/Dodge/Layout/Tree/Shift.hs +++ b/src/Dodge/Layout/Tree/Shift.hs @@ -9,6 +9,7 @@ import Dodge.Room.Data import Dodge.Room.Link import Dodge.Layout.Tree.Polymorphic import Geometry +import Geometry.Data import Data.Tree import Data.Sequence hiding (zipWith) diff --git a/src/Dodge/Picture.hs b/src/Dodge/Picture.hs index ca9b2dfde..c3ca72e3e 100644 --- a/src/Dodge/Picture.hs +++ b/src/Dodge/Picture.hs @@ -4,6 +4,7 @@ Creates uniform sizes and commands for the Dodge modules. -} module Dodge.Picture where import Geometry +import Geometry.Data import Picture diff --git a/src/Dodge/RandomHelp.hs b/src/Dodge/RandomHelp.hs index 240867b1d..ac109968e 100644 --- a/src/Dodge/RandomHelp.hs +++ b/src/Dodge/RandomHelp.hs @@ -3,7 +3,7 @@ Helpers for random generation. -} module Dodge.RandomHelp where import Geometry ---import Geometry.Data +import Geometry.Data import System.Random import Control.Monad.State diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index f09740933..dbfea6bf5 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -11,7 +11,8 @@ import Dodge.Base --import Dodge.Render.MenuScreen import Dodge.Render.Picture --import Dodge.Render.PerspectiveMatrix -import Geometry +--import Geometry +import Geometry.Data --import Picture import Picture.Render import Data.Preload.Render diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 2dda0ed97..cf40e872d 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -7,6 +7,7 @@ import Dodge.Picture.Layer import Dodge.Render.HUD import Dodge.Render.MenuScreen import Geometry +import Geometry.Data import Picture --import Dodge.Creature.YourControl diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index 6849087c0..37e81140a 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -6,6 +6,7 @@ module Dodge.Room , module Dodge.Room.Corridor ) where import Dodge.Data +import Dodge.Default.Room import Dodge.Item.Weapon import Dodge.Item.Weapon.AutoGun import Dodge.Item.Weapon.Launcher @@ -43,7 +44,7 @@ import Data.Tree --import qualified Data.IntMap.Strict as IM roomC :: Float -> Float -> Room -roomC x y = Room +roomC x y = defaultRoom { _rmPolys = [rectNSWE y 0 0 x] , _rmLinks = lnks , _rmPath = [] @@ -59,7 +60,7 @@ roomC x y = Room ] roomPadCut :: [Point2] -> Point2 -> Room -roomPadCut ps p = Room +roomPadCut ps p = defaultRoom { _rmPolys = [ps] , _rmLinks = [(p,0),((0,0),pi)] , _rmPath = [((0,0),p)] @@ -212,7 +213,7 @@ roomCenterPillar = changeLinkTo ((\p -> dist p (120,0) < 10) . fst) ] roomOctogon :: Room -roomOctogon = Room +roomOctogon = defaultRoom { _rmPolys = [[(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)] ] , _rmLinks = lnks @@ -338,7 +339,7 @@ critInDeadEnd :: Room critInDeadEnd = set rmPS [sPS (0,0) 0 randC1] deadEndRoom deadEndRoom :: Room -deadEndRoom = Room +deadEndRoom = defaultRoom { _rmPolys = [rectNSWE 40 (-20) (-20) 20 ] , _rmLinks = lnks diff --git a/src/Dodge/Room/Airlock.hs b/src/Dodge/Room/Airlock.hs index bdfe961d6..84e3e0a32 100644 --- a/src/Dodge/Room/Airlock.hs +++ b/src/Dodge/Room/Airlock.hs @@ -5,6 +5,7 @@ module Dodge.Room.Airlock where import Dodge.Room.Data import Dodge.Room.Placement +import Dodge.Default.Room import Dodge.Data import Dodge.LevelGen.Data import Dodge.LevelGen.Switch @@ -18,7 +19,7 @@ import Control.Monad.State import Control.Lens airlockOneWay :: Int -> Room -airlockOneWay n = Room +airlockOneWay n = defaultRoom { _rmPolys = [rectNSWE 90 0 0 40] , _rmLinks = lnks , _rmPath = [] @@ -49,7 +50,7 @@ Straight airlock -} airlock0 :: Int -- ^ Door id -> Room -airlock0 n = Room +airlock0 n = defaultRoom { _rmPolys = [ rectNSWE 100 0 0 40 , rectNSWE 65 35 (-40) 20 @@ -78,7 +79,7 @@ airlock0 n = Room airlock90 :: Int -- ^ Door id -> Room -airlock90 n = Room +airlock90 n = defaultRoom { _rmPolys = [ rectNSWE 100 10 10 100 , rectNSWE 20 0 20 60 @@ -120,7 +121,7 @@ airlock90 n = Room airlockCrystal :: Int -- ^ Door id -> Room -airlockCrystal n = Room +airlockCrystal n = defaultRoom { _rmPolys = [ rectNSWE 140 0 0 40 , orderPolygon diff --git a/src/Dodge/Room/Boss.hs b/src/Dodge/Room/Boss.hs index 50513ce6f..43b253647 100644 --- a/src/Dodge/Room/Boss.hs +++ b/src/Dodge/Room/Boss.hs @@ -4,6 +4,7 @@ Rooms containing particularly challenging creatures, that may drop useful loot. module Dodge.Room.Boss where import Dodge.Data +import Dodge.Default.Room import Dodge.Room.Data import Dodge.Room.Procedural import Dodge.Room.Placement @@ -23,7 +24,7 @@ import System.Random roomGlassOctogon :: Float -- ^ Size -> Room -roomGlassOctogon x = Room +roomGlassOctogon x = defaultRoom { _rmPolys = [rectNSWE x (-x) (-x) x ,rectNSWE 0 (-(x + 40)) (-20) 20 ] @@ -74,7 +75,7 @@ roomCross :: Float -- ^ First width/2 -> Float -- ^ Second width/2 -> Room -roomCross x y = Room +roomCross x y = defaultRoom { _rmPolys = [rectNSWE y (-y) (-x) x ,rectNSWE (-x) x y (-y) ] @@ -112,7 +113,7 @@ roomShuriken x y = , (x,y) , (0,x) ] ] - corner = Room + corner = defaultRoom { _rmPolys = ps , _rmLinks = [((x-1,y-20),negate $ pi/2)] , _rmPath = [] @@ -136,7 +137,7 @@ roomTwistCross x y z = ] , rectNSWE (x-5) 0 0 (x-5) ] - corner = Room + corner = defaultRoom { _rmPolys = ps , _rmLinks = [((z,y-20), pi/2)] , _rmPath = [] diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 39ab86498..ffb5beb8c 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -1,11 +1,12 @@ module Dodge.Room.Corridor where import Dodge.Room.Data +import Dodge.Default.Room import Geometry {- | First exit due north, two other exits at angles next to this. Entrance from south. -} corridor :: Room -corridor = Room +corridor = defaultRoom { _rmPolys = [rectNSWE 80 0 0 40 --{ _rmPolys = [rectNSWE 90 (-10) 0 40 -- ,[(0,80), (0,80) +.+ rotateV (pi/3) (40,0),(40,80)] @@ -25,7 +26,7 @@ corridor = Room ] {- | Debug drop-in copy of corridor -} corridorDebug :: Room -corridorDebug = Room +corridorDebug = defaultRoom { _rmPolys = [ rectNSWE 80 0 0 40 --, [ (0,0), (0,200) , (200,100)] @@ -44,7 +45,7 @@ corridorDebug = Room ,((20,10) ,pi) ] corridorN :: Room -corridorN = Room +corridorN = defaultRoom { _rmPolys = [rectNSWE 80 0 0 40 ] , _rmLinks = lnks @@ -58,7 +59,7 @@ corridorN = Room pth = doublePair ((20,70),(20,10)) tEast :: Room -tEast = Room +tEast = defaultRoom { _rmPolys = [rectNSWE 80 0 (-20) 20 ,rectNSWE 80 40 (-40) 40 ] @@ -72,7 +73,7 @@ tEast = Room ,((0,10),pi) ] tWest :: Room -tWest = Room +tWest = defaultRoom { _rmPolys = [rectNSWE 80 0 (-20) 20 ,rectNSWE 80 40 (-40) 40 ] diff --git a/src/Dodge/Room/Data.hs b/src/Dodge/Room/Data.hs index a0478bad0..2c5d70701 100644 --- a/src/Dodge/Room/Data.hs +++ b/src/Dodge/Room/Data.hs @@ -3,7 +3,9 @@ module Dodge.Room.Data where import Dodge.LevelGen.Data -import Geometry +--import Geometry +import Geometry.Data +import Data.Tile import Control.Lens @@ -22,5 +24,6 @@ data Room = Room , _rmPath :: [(Point2, Point2)] , _rmPS :: [Placement] , _rmBound :: [ [Point2] ] + , _rmFloor :: [Tile] } makeLenses ''Room diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 1fa6fc549..5cae90db6 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -6,12 +6,13 @@ module Dodge.Room.Door import Geometry import Dodge.Room.Data import Dodge.LevelGen.Data +import Dodge.Default.Room --import Control.Monad.State --import System.Random door :: Room -door = Room +door = defaultRoom { _rmPolys = [rectNSWE 40 0 0 40] , _rmLinks = lnks , _rmPath = [((20,35),(20,5))] diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 2b021123e..d093ef9e3 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -12,6 +12,8 @@ import Dodge.LevelGen.Data import Dodge.Room.Data import Dodge.RandomHelp import Geometry +import Geometry.Data +import Data.Tile import System.Random import Control.Monad.State @@ -64,13 +66,18 @@ shiftRoomToLink l r (p,a) = last $ _rmLinks r shiftRoomBy :: (Point2,Float) -> Room -> Room -shiftRoomBy shift r = - over rmPolys (fmap (map (shiftPointBy shift))) - $ over rmLinks (fmap (shiftLinkBy shift)) - $ over rmPath (map (shiftPathPointBy shift)) - $ over rmPS (fmap (shiftPSBy shift)) - $ over rmBound (fmap (map (shiftPointBy shift))) - r +shiftRoomBy shift r = r + & rmPolys %~ fmap (map (shiftPointBy shift)) + & rmLinks %~ fmap (shiftLinkBy shift) + & rmPath %~ map (shiftPathPointBy shift) + & rmPS %~ fmap (shiftPSBy shift) + & rmBound %~ fmap (map (shiftPointBy shift)) + & rmFloor %~ map + ( (tilePoly %~ map (shiftPointBy shift)) + . (tileCenter %~ shiftPointBy shift ) + . (tileX %~ shiftPointBy shift ) + . (tileY %~ shiftPointBy shift ) + ) shiftLinkBy :: (Point2,Float) diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index 4f716584a..1862c7858 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -4,6 +4,7 @@ module Dodge.Room.LongDoor where import Dodge.Data +import Dodge.Default.Room import Dodge.Room.Data import Dodge.Room.Placement import Dodge.Room.Link @@ -29,7 +30,7 @@ twinSlowDoorRoom -> Float -- ^ Half height -> Float -- ^ Inner width -> Room -twinSlowDoorRoom drID w h x = Room +twinSlowDoorRoom drID w h x = defaultRoom { _rmPolys = ps , _rmLinks = [ ((w,h/2) , negate $ pi/2) diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index d95377b7c..6d974b72d 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -11,6 +11,7 @@ import Dodge.Data import Dodge.Room.Data import Dodge.Room.Placement import Dodge.Room.Link +import Dodge.Default.Room import Dodge.Item.Consumable import Dodge.Item.Equipment import Dodge.Item.Weapon @@ -21,6 +22,7 @@ import Dodge.Creature --import Dodge.Default import Geometry import Picture +import Data.Tile import Data.List import Data.Function (on) @@ -40,12 +42,19 @@ roomRect -> Int -- ^ Number of links on vertical walls -> Int -- ^ Number of links on horizontal walls -> Room -roomRect x y xn yn = Room +roomRect x y xn yn = defaultRoom { _rmPolys = [rectNSWE y 0 0 x ] , _rmLinks = lnks , _rmPath = concatMap doublePair pth , _rmPS = [sPS (x/2,y/2) 0 putLamp] , _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)] + , _rmFloor = [Tile + { _tilePoly = rectNSWE y 0 0 x + , _tileCenter = (0,0) + , _tileX = (50,0) + , _tileY = (0,50) + , _tileZ = 16 + } ] } where yd = (y - 40) / fromIntegral yn @@ -88,7 +97,7 @@ linksAndPath lnks subpth = subpth ++ concatMap linkClosest lnks {- Combines two rooms into one room. Combines into one big bound, concatenates the rest. -} combineRooms :: Room -> Room -> Room -combineRooms r r' = Room +combineRooms r r' = defaultRoom { _rmPolys = _rmPolys r ++ _rmPolys r' , _rmLinks = _rmLinks r ++ _rmLinks r' , _rmPath = _rmPath r ++ _rmPath r' @@ -130,7 +139,7 @@ fourthWall w = do , blockLine (-29,w) (0,w/2) ] ] - pure $ Room + pure $ defaultRoom { _rmPolys = [ [(0,0),(w,w),(-w,w)] ] , _rmLinks = [((0,w), 0)] , _rmPath = [((0,w),(0,0)),((0,0),(0,w))] @@ -175,7 +184,7 @@ fourthCornerWall w = do , blockLine (0,w) (0,w*2) ] ] - pure $ Room + pure $ defaultRoom { _rmPolys = [ [(0,0),(w,w),(0,2*w),(-w,w)] ] , _rmLinks = [((w/2,3*w/2), negate $ pi/4) @@ -233,7 +242,7 @@ centerVaultRoom n w h d = do weDoors = rectNSWE 20 (-20) (d + 20) (negate (d +20)) centerPoly = rectWdthHght (d - 20) (d - 20) polys = centerPoly : nsDoors : weDoors : take 4 (iterate (map vNormal) northPoly) - return $ Room + return $ defaultRoom { _rmPolys = polys , _rmLinks = [((0,h),0) diff --git a/src/Dodge/Room/RoadBlock.hs b/src/Dodge/Room/RoadBlock.hs index 13d48995f..7f9872ceb 100644 --- a/src/Dodge/Room/RoadBlock.hs +++ b/src/Dodge/Room/RoadBlock.hs @@ -4,6 +4,7 @@ Connecting rooms designed with a pass-through technique in mind. module Dodge.Room.RoadBlock where import Geometry +import Dodge.Default.Room import Dodge.Room.Data import Dodge.Room.Link import Dodge.Room.Placement @@ -29,7 +30,7 @@ litCorridor90 = do h <- state $ randomR (500,800) let poly = rectNSWE h 0 0 40 poly2 = rectNSWE (h-60) (h-100) (-60) 5 - pure $ Room + pure $ defaultRoom { _rmPolys = [poly,poly2] , _rmLinks = [ ((40,h - 80), -pi/2) , ((20, 0), pi) diff --git a/src/Dodge/Room/Treasure.hs b/src/Dodge/Room/Treasure.hs index 01de338c0..b73e79231 100644 --- a/src/Dodge/Room/Treasure.hs +++ b/src/Dodge/Room/Treasure.hs @@ -4,11 +4,12 @@ Typically dead ends. -} module Dodge.Room.Treasure where -import Geometry import Dodge.Data import Dodge.Room.Data import Dodge.Room.Placement +import Dodge.Default.Room import Dodge.LevelGen.Data +import Geometry --import Data.List import Control.Monad.State @@ -21,7 +22,7 @@ triLootRoom :: Float -- Width -> Float -- Height -> State g Room -triLootRoom w h = pure $ Room +triLootRoom w h = pure $ defaultRoom { _rmPolys = [ tri , base ] diff --git a/src/Geometry.hs b/src/Geometry.hs index 72fb022fb..e23e74fa6 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -10,7 +10,7 @@ Line refers to a line defined by two points, and extends beyond the two points. -} module Geometry ( module Geometry - , module Geometry.Data +-- , module Geometry.Data , module Geometry.Intersect , module Geometry.Bezier , module Geometry.Vector @@ -225,6 +225,13 @@ polysOverlap _ _ = False -- a second list. anyPolyssIntersect :: [[Point2]] -> [[Point2]] -> Bool anyPolyssIntersect x y = or $ polysIntersect <$> x <*> y + +-- split a list into triples, forms triangles from a polygon +polyToTris :: [s] -> [s] +{-# INLINE polyToTris #-} +polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as)) +polyToTris _ = [] + -- | 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)) (600,0) diff --git a/src/Geometry/Vector.hs b/src/Geometry/Vector.hs index 710525dcd..0c1b3f28c 100644 --- a/src/Geometry/Vector.hs +++ b/src/Geometry/Vector.hs @@ -149,4 +149,8 @@ projV :: Point2 -> Point2 -> Point2 -projV fromv onv = (fromv `dotV` onv) / (onv `dotV` onv) *.* onv +projV fromv onv + | den == 0 = error "tried projecting onto zero vector" + | otherwise = (fromv `dotV` onv) / den *.* onv + where + den = onv `dotV` onv diff --git a/src/MatrixHelper.hs b/src/MatrixHelper.hs index 17042ed80..46cb3d489 100644 --- a/src/MatrixHelper.hs +++ b/src/MatrixHelper.hs @@ -2,7 +2,8 @@ module MatrixHelper ( perspectiveMatrix , isoMatrix ) where -import Geometry +--import Geometry +import Geometry.Data import Linear.Matrix import Linear.V4 diff --git a/src/Picture.hs b/src/Picture.hs index e7985d609..2457068d8 100644 --- a/src/Picture.hs +++ b/src/Picture.hs @@ -46,7 +46,7 @@ module Picture ) where import Geometry ---import Geometry.Data +import Geometry.Data import Picture.Data --import Data.Bifunctor diff --git a/src/Picture/Render.hs b/src/Picture/Render.hs index f9e6382bb..7b9c7b6dd 100644 --- a/src/Picture/Render.hs +++ b/src/Picture/Render.hs @@ -4,14 +4,14 @@ Rendering of a picture. -} module Picture.Render where - import Shader import Shader.Data import Shader.Poke --import MatrixHelper import Data.Preload.Render import Picture.Data -import Geometry +--import Geometry +import Geometry.Data --import Control.Lens import Control.Monad diff --git a/src/Picture/Texture.hs b/src/Picture/Texture.hs index e17adce73..117dbfb5f 100644 --- a/src/Picture/Texture.hs +++ b/src/Picture/Texture.hs @@ -1,7 +1,9 @@ module Picture.Texture where import Geometry.Data +--import Geometry import Picture.Data +--import Data.Tile tileToRender :: [Point3] -> [Point3] -> [RenderType] tileToRender [a,b,c,d] [x,y,z,w] = @@ -13,3 +15,4 @@ tileToRender [a,b,c,d] [x,y,z,w] = , Render3x3 (w,d) ] tileToRender _ _ = undefined + diff --git a/src/Picture/Tree.hs b/src/Picture/Tree.hs index 9b72f1d35..53c87d363 100644 --- a/src/Picture/Tree.hs +++ b/src/Picture/Tree.hs @@ -5,6 +5,7 @@ module Picture.Tree where import Picture.Data import Geometry +import Geometry.Data import Data.Bifunctor import Data.List @@ -68,11 +69,6 @@ white, black :: Color white = (1,1,1,1) black = (0,0,0,1) -polyToTris :: [s] -> [s] -{-# INLINE polyToTris #-} -polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as)) -polyToTris _ = [] - scaleT :: (Float,Float) -> (Point3,Point4,Point3) -> (Point3,Point4,Point3) {-# INLINE scaleT #-} scaleT (x,y) (a,b,(o,s,t)) = (a,b,(o,s*x,t*y)) diff --git a/src/Shader/AuxAddition.hs b/src/Shader/AuxAddition.hs index 875dc1c57..1e096ede0 100644 --- a/src/Shader/AuxAddition.hs +++ b/src/Shader/AuxAddition.hs @@ -37,7 +37,7 @@ addTextureArray texturePath shad = do let tex = convertRGBA8 cmap textureOb <- genObjectName textureBinding Texture2DArray $= Just textureOb - let texData = tilesToLine 128 32 8 . + let texData = tilesToLine 128 8 . V.toList $ imageData tex --wtex = fromIntegral $ imageWidth tex --htex = fromIntegral $ imageHeight tex @@ -50,12 +50,11 @@ addTextureArray texturePath shad = do -- I am completely unclear on why this works with its current parameters tilesToLine - :: Int -- ^ Tile width - -> Int -- ^ Tile height - -> Int -- ^ Number of tiles per line + :: Int -- ^ Parameter a + -> Int -- ^ Parameter b -> [a] -> [a] -tilesToLine w h n = concat . concat . transpose . chunksOf n . chunksOf w +tilesToLine w n = concat . concat . transpose . chunksOf n . chunksOf w addUniforms :: [String] -> FullShader -> IO (FullShader) addUniforms uniStrings shad = do diff --git a/src/Tile.hs b/src/Tile.hs new file mode 100644 index 000000000..8c8328220 --- /dev/null +++ b/src/Tile.hs @@ -0,0 +1,31 @@ +module Tile + where +import Data.Tile +import Geometry +import Geometry.Data +import Picture.Data + +tToRender :: Tile -> [RenderType] +tToRender t = map Render3x3 $ polyToTris $ zip ps3 coords3 + where + ps = _tilePoly t + coords = map (calcTexCoord (_tileCenter t) (_tileX t) (_tileY t)) ps + ps3 = map (mkTrip (0.9)) ps + coords3 = map (mkTrip (_tileZ t)) coords + +mkTrip :: c -> (a,b) -> (a,b,c) +mkTrip z (x,y) = (x,y,z) + +calcTexCoord + :: Point2 -- ^ tile (0,0) + -> Point2 -- ^ tile (1,0) + -> Point2 -- ^ tile (0,1) + -> Point2 -- ^ world point + -> Point2 +calcTexCoord cen x' y' p = + ( magV (projV (p -.- cen) x) / magV x + , magV (projV (p -.- cen) y) / magV y + ) + where + x = x' -.- cen + y = y' -.- cen