justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Fix tile rendering

Browse Source
This commit is contained in:
justin
2021-09-07 10:53:39 +01:00
parent 6ecd739d6f
commit 45bbf9b005
14 changed files with 66 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Tile.hs
+4 -4
View File
@@ -4,12 +4,12 @@ module Data.Tile
import Geometry.Data
import Control.Lens
data Tile = Tile
{ _tilePoly :: [Point2]
, _tileCenter :: Point2
, _tileX :: Point2
, _tileY :: Point2
, _tileZ :: Float
, _tileZero :: Point2 -- ^ point in the world where tile texture is 0,0
, _tileX :: Point2 -- ^ vector in the X direction (1,0)
, _tileZ :: Float
}
deriving (Eq, Ord, Show)
makeLenses ''Tile
src/Dodge/Data.hs
+4 -3
View File
@@ -292,7 +292,7 @@ data Item
, _itZoom :: ItZoom
, _itAimZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Picture
, _itScroll :: Float -> Creature -> World -> World
, _itScroll :: Float -> Creature -> Item -> Item
, _itIdentity :: ItemIdentity
, _itAttachment :: ItAttachment
, _itID :: Maybe Int
@@ -372,8 +372,9 @@ data Item
, _itInvColor :: Color
, _itEffect :: ItEffect
, _itHammer :: HammerPosition
, _itScrollUp :: Int -> World -> World
, _itScrollDown :: Int -> World -> World
, _itScroll :: Float -> Creature -> Item -> Item
-- , _itScrollUp :: Int -> World -> World
-- , _itScrollDown :: Int -> World -> World
, _itAimStance :: AimStance
}
| NoItem
src/Dodge/Default.hs
+1 -1
View File
@@ -57,7 +57,7 @@ defaultCreature = Creature
, _crTarget = Nothing
, _crMvTarget= Nothing
, _crGroup = LoneWolf
, _crMvType = NoMvType
, _crMvType = defaultAimMvType
}
defaultChaseMvType :: CrMvType
defaultChaseMvType = ChaseMvType
src/Dodge/Event.hs
+4 -5
View File
@@ -27,7 +27,7 @@ import Preload.Update
import qualified IntMapHelp as IM
import Control.Lens
import Data.Maybe
--import Data.Maybe
--import Data.Char
--import Data.List
--import Data.Function (on)
@@ -91,10 +91,9 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
| rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
| otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
(_, TopInventory)
| rbDown -> fromMaybe (closeObjScrollDir y w) $ (yourItem w ^? itScroll)
<*> pure y
<*> pure (you w)
<*> pure w
| rbDown -> case yourItem w ^? itScroll of
Nothing -> closeObjScrollDir y w
Just f -> w & creatures . ix 0 . crInv . ix (_crInvSel $ you w) %~ f y (you w)
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> swapInvDir yi $ dirInvPos yi w
| otherwise -> dirInvPos yi w
src/Dodge/Item/Attachment.hs
+22 -42
View File
@@ -1,8 +1,7 @@
module Dodge.Item.Attachment
( charFiringStratI
, scrollCharMode
, decreaseFuse
, increaseFuse
, changeFuse
)
where
import Dodge.Data
@@ -18,27 +17,25 @@ import qualified Data.IntMap.Strict as IM
scrollCharMode
:: Float -- ^ Amount scrolled
-> Creature
-> World
-> World
scrollCharMode x cr
| x > 0 = incCharMode (_crInvSel cr)
| x < 0 = decCharMode (_crInvSel cr)
-> Item
-> Item
scrollCharMode x _
| x > 0 = incCharMode
| x < 0 = decCharMode
| otherwise = id
incCharMode
:: Int -- ^ Inventory selection
-> World
-> World
incCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . itCharMode %~ cycleL
:: Item
-> Item
incCharMode = itAttachment . itCharMode %~ cycleL
where
cycleL (x :<| xs) = xs |> x
cycleL xs = xs
decCharMode
:: Int -- ^ Inventory selection
-> World
-> World
decCharMode i = creatures . ix 0 . crInv . ix i . itAttachment . itCharMode %~ cycleR
:: Item
-> Item
decCharMode = itAttachment . itCharMode %~ cycleR
where
cycleR (xs :|> x) = x <| xs
cycleR xs = xs
@@ -59,32 +56,15 @@ charFiringStratI strats eff item cr w = case w ^? creatures . ix cid . crInv
where
cid = _crID cr
increaseFuse
:: Int -- ^ Old fuse time
-> Int -- ^ Inventory item reference (I believe)
-> World
-> World
increaseFuse fuse itid w = w
& creatures . ix 0 . crInv . ix itid %~
( itScrollUp .~ decreaseFuse newTime )
. (itScrollDown .~ increaseFuse newTime )
. ( itAttachment .~ ItFuse newTime )
. ( itAimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} )
changeFuse
:: Float -- ^ Old fuse time
-> Creature -- ^ Inventory item reference (I believe)
-> Item
-> Item
changeFuse scrollAmount _ it = it
& ( itAttachment .~ ItFuse newTime )
& ( itAimZoom .~ defaultItZoom{_itZoomMax = zm, _itZoomMin = zm} )
where
newTime = min (fuse + 5) 90
zm = 50 / fromIntegral newTime
decreaseFuse
:: Int -- ^ Old fuse time
-> Int -- ^ Inventory item reference (I believe)
-> World
-> World
decreaseFuse fuse itid w = w
& creatures . ix 0 . crInv . ix itid %~
( itScrollUp .~ decreaseFuse newTime )
. ( itScrollDown .~ increaseFuse newTime )
. ( itAttachment .~ ItFuse newTime )
. ( itAimZoom .~ defaultItZoom {_itZoomMax = zm, _itZoomMin = zm} )
where
newTime = max (fuse - 5) 20
oldTime = _itFuseTime $ _itAttachment it
newTime = min 90 $ max 20 $ oldTime - round (5 * scrollAmount)
zm = 50 / fromIntegral newTime
src/Dodge/Item/Weapon.hs
+9 -12
View File
@@ -528,18 +528,16 @@ longGun = defaultGun
longGunPic :: Picture
longGunPic = pictures [color orange $ polygon $ rectNESW 2 12 (-2) (-12) ]
zoomLongGun :: Float -> Creature -> World -> World
zoomLongGun x cr
| x > 0 = startZoomInLongGun (_crInvSel cr)
| x < 0 = startZoomOutLongGun (_crInvSel cr)
zoomLongGun :: Float -> Creature -> Item -> Item
zoomLongGun x _
| x > 0 = startZoomInLongGun
| x < 0 = startZoomOutLongGun
| otherwise = id
startZoomInLongGun :: Int -> World -> World
startZoomInLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5)
startZoomOutLongGun :: Int -> World -> World
startZoomOutLongGun _ w = w & creatures . ix 0 . crInv . ix (_crInvSel (_creatures w IM.! 0))
. itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5)
startZoomInLongGun :: Item -> Item
startZoomInLongGun = itAttachment . scopeZoomChange %~ \x -> max 5 (x + 5)
startZoomOutLongGun :: Item -> Item
startZoomOutLongGun = itAttachment . scopeZoomChange %~ \x -> min (-5) (x-5)
poisonSprayer :: Item
poisonSprayer = defaultAutoGun
{ _itName = "POISON"
@@ -828,8 +826,7 @@ grenade = Throwable
, _itInvDisplay = basicWeaponDisplay
, _itEffect = wpRecock
, _itHammer = HammerUp
, _itScrollUp = decreaseFuse fuseTime
, _itScrollDown = increaseFuse fuseTime
, _itScroll = changeFuse
, _itAimStance = OneHand
}
where
src/Dodge/Item/Weapon/Bezier.hs
+1 -1
View File
@@ -37,7 +37,7 @@ bezierGun = defaultGun
, _itFloorPict = onLayer FlItLayer bezierGunPic
, _itEquipPict = pictureWeaponOnAim bezierGunPic
, _itAttachment = NoItAttachment
, _itScroll = removeItTarget 0
, _itScroll = \_ _ -> removeItTarget
, _itHammer = HammerUp
, _itEffect = rbSetTarget
, _itZoom = defaultItZoom
src/Dodge/Item/Weapon/Targeting.hs
+3 -6
View File
@@ -3,7 +3,7 @@ module Dodge.Item.Weapon.Targeting
import Dodge.Data
import Control.Lens
import qualified Data.IntMap.Strict as IM
--import qualified Data.IntMap.Strict as IM
useTargetPos
:: (Maybe Point2 -> Creature -> World -> World)
-> Creature
@@ -13,8 +13,5 @@ useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just
Nothing -> w
Just (g,_) -> f (g w) cr w
removeItTarget :: Int -> Float -> Creature -> World -> World
removeItTarget i _ _ w = w & creatures . ix i . crInv . ix itRef . itTargeting .~ Nothing
where
cr = _creatures w IM.! i
itRef = _crInvSel cr
removeItTarget :: Item -> Item
removeItTarget = itTargeting .~ Nothing
src/Dodge/Room.hs
+1 -1
View File
@@ -228,7 +228,7 @@ roomOctogon = defaultRoom
, _rmPath = allPairs $ map fst lnks
, _rmPS = []
, _rmBound = [map toV2 [(-20,30),(20,30),(60,70),(60,110),(20,150),(-20,150),(-60,110),(-60,70)] ]
, _rmFloor = [oTile poly 7]
, _rmFloor = [makeTileFromPoly poly 7]
}
where
poly = map toV2 [(-20,40),(20,40),(50,70),(50,110),(20,140),(-20,140),(-50,110),(-50,70)]
src/Dodge/Room/AddTile.hs
+2 -2
View File
@@ -9,7 +9,7 @@ import Control.Lens
addTile :: Float -> Room -> Room
addTile z r
| not (null (_rmFloor r)) || null rp = r
| otherwise = r & rmFloor .~ [oTile poly z]
| otherwise = r & rmFloor .~ [makeTileFromPoly poly z]
where
rp = _rmPolys r
poly = convexHull $ concat rp
poly = orderPolygon . convexHull $ concat rp
src/Dodge/Room/Corridor.hs
+1 -1
View File
@@ -16,7 +16,7 @@ corridor = defaultRoom
, _rmPath = concatMap (doublePair . (,) (V2 20 60) . fst) lnks
, _rmPS = []
, _rmBound = [ rectNSWE 50 30 0 40 ]
, _rmFloor = [oTile poly 2]
, _rmFloor = [makeTileFromPoly poly 2]
}
where
poly = rectNSWE 80 0 0 40
src/Dodge/Room/Link.hs
+2 -3
View File
@@ -73,9 +73,8 @@ shiftRoomBy shift r = r
& rmBound %~ fmap (map (shiftPointBy shift))
& rmFloor %~ map
( (tilePoly %~ map (shiftPointBy shift))
. (tileCenter %~ shiftPointBy shift )
. (tileX %~ shiftPointBy shift )
. (tileY %~ shiftPointBy shift )
. (tileZero %~ shiftPointBy shift )
. (tileX %~ shiftPointBy shift )
)
shiftLinkBy
src/Dodge/Room/Procedural.hs
+3 -4
View File
@@ -53,10 +53,9 @@ roomRect x y xn yn = defaultRoom
, _rmBound = [rectNSWE (y+5) (-5) (-5) (x+5)]
, _rmFloor = [Tile
{ _tilePoly = rectNSWE y 0 0 x
, _tileCenter = V2 0 0
, _tileX = V2 50 0
, _tileY = V2 0 50
, _tileZ = 16
, _tileZero = V2 0 0
, _tileX = V2 1 0
, _tileZ = 16
} ]
}
where
src/Tile.hs
+9 -15
View File
@@ -8,7 +8,7 @@ tToRender :: Tile -> [(Point3,Point3)]
tToRender t = polyToTris $ zip ps3 coords3
where
ps = _tilePoly t
coords = map (calcTexCoord (_tileCenter t) (_tileX t) (_tileY t)) ps
coords = map (calcTexCoord (_tileZero t) (_tileX t)) ps
ps3 = map (addToV2 0) ps
coords3 = map (addToV2 (_tileZ t)) coords
@@ -21,29 +21,23 @@ 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 = V2
( magV (projV (p -.- cen) x) / magV x )
( magV (projV (p -.- cen) y) / magV y )
calcTexCoord c p x = V2 (0.02 * dotV (p -.- c) xdir) (0.02 * dotV (p -.- c) ydir)
where
x = x' -.- cen
y = y' -.- cen
xdir = x -.- c
ydir = vNormal xdir
oTile
makeTileFromPoly
:: [Point2]
-> Float
-> Tile
oTile poly z = Tile
makeTileFromPoly poly z = Tile
{ _tilePoly = poly
, _tileCenter = c
, _tileX = x
, _tileY = y
, _tileZero = c
--, _tileXY = c +.+ xdir +.+ vNormal xdir
, _tileX = c +.+ (normalizeV $ (poly !! 1) -.- c)
, _tileZ = z
}
where
c = head poly
xdir = 50 *.* normalizeV (poly !! 1 -.- c)
x = c +.+ xdir
y = c +.+ vNormal xdir