diff --git a/src/Data/Tile.hs b/src/Data/Tile.hs index 5977c8b01..9d984f6ec 100644 --- a/src/Data/Tile.hs +++ b/src/Data/Tile.hs @@ -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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 8239d1e12..9fabc4481 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 7dd5d19d8..48ae74d34 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -57,7 +57,7 @@ defaultCreature = Creature , _crTarget = Nothing , _crMvTarget= Nothing , _crGroup = LoneWolf - , _crMvType = NoMvType + , _crMvType = defaultAimMvType } defaultChaseMvType :: CrMvType defaultChaseMvType = ChaseMvType diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index a030d7b12..126a5a70f 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -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 diff --git a/src/Dodge/Item/Attachment.hs b/src/Dodge/Item/Attachment.hs index 64cf85438..5b6600ea3 100644 --- a/src/Dodge/Item/Attachment.hs +++ b/src/Dodge/Item/Attachment.hs @@ -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 diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 5ee3e5526..d72928514 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 74be75cb8..b6f7e3056 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -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 diff --git a/src/Dodge/Item/Weapon/Targeting.hs b/src/Dodge/Item/Weapon/Targeting.hs index bdeff2587..075e49afe 100644 --- a/src/Dodge/Item/Weapon/Targeting.hs +++ b/src/Dodge/Item/Weapon/Targeting.hs @@ -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 diff --git a/src/Dodge/Room.hs b/src/Dodge/Room.hs index b14e6ba7f..c5f682d8d 100644 --- a/src/Dodge/Room.hs +++ b/src/Dodge/Room.hs @@ -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)] diff --git a/src/Dodge/Room/AddTile.hs b/src/Dodge/Room/AddTile.hs index 57327a767..6bce770aa 100644 --- a/src/Dodge/Room/AddTile.hs +++ b/src/Dodge/Room/AddTile.hs @@ -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 diff --git a/src/Dodge/Room/Corridor.hs b/src/Dodge/Room/Corridor.hs index 5a720d7b1..875eb3b5c 100644 --- a/src/Dodge/Room/Corridor.hs +++ b/src/Dodge/Room/Corridor.hs @@ -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 diff --git a/src/Dodge/Room/Link.hs b/src/Dodge/Room/Link.hs index 934e2fe88..e77a4df40 100644 --- a/src/Dodge/Room/Link.hs +++ b/src/Dodge/Room/Link.hs @@ -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 diff --git a/src/Dodge/Room/Procedural.hs b/src/Dodge/Room/Procedural.hs index e1af3be3a..bfc398a10 100644 --- a/src/Dodge/Room/Procedural.hs +++ b/src/Dodge/Room/Procedural.hs @@ -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 diff --git a/src/Tile.hs b/src/Tile.hs index 984910342..d8af055af 100644 --- a/src/Tile.hs +++ b/src/Tile.hs @@ -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