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/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