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

Merge branch 'master' of ssh://git.xkjq.uk:30001/justin/dodge

Browse Source
This commit is contained in:
Ross
2021-03-21 17:53:01 +00:00
parent 3cfbf3dacc 279f928375
commit b91f056d63
52 changed files with 350 additions and 394 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/AIs.hs
+1 -17
View File
@@ -39,22 +39,6 @@ import Foreign.ForeignPtr
import Control.Concurrent
---}
--killCr :: World -> (World -> World) -> Creature -> ((World -> World,StdGen), Maybe Creature)
--killCr w f cr = ((g . f, _randGen w),Nothing)
-- where crBeforeDeath = colCrWall w $ cr
-- addCorpse = insertNewKey $ uncurry translate (_crPos crBeforeDeath)
-- $ rotate (radToDeg (_crDir cr))
-- (_crCorpse cr)
-- maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
-- insertIt = case maybeIt of
-- Just it -> createItemAt (offset +.+ _crPos crBeforeDeath)
-- (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0})
-- Nothing -> id
-- offset = _crRad cr *.* unitVectorAtAngle rot
-- (rot,_) = randomR (-pi,pi) $ _randGen w
-- g = stopSoundFrom (CrWeaponSound (_crID cr)) . over decorations addCorpse . insertIt
factionIs :: Faction -> Creature -> Bool
factionIs f c = (_faction $ _crState $ c) == f
@@ -1888,7 +1872,7 @@ spCrRadFac = 8^2
yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature)
yourControl w (f,g) cr = ( (mouseActionsWorld (_mouseButtons w) . f, g)
, Just $ mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
, Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr
)
where strafeSpeed = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed)
speed = 3 * equipFactor
src/Dodge/Base.hs
+1 -3
View File
@@ -386,9 +386,7 @@ collidePointWalkable p1 p2 ws = any (isJust
. ( \(x:y:_) -> intersectSegSeg' p1 p2 x y)
. _wlLine
) unwalkableWalls
where unwalkableWalls = IM.filter notDoor ws
notDoor (AutoDoor {}) = False
notDoor _ = True
where unwalkableWalls = IM.filter (fromMaybe True . (^? doorPathable)) ws
furthestPointWalkable :: Point2 -> Point2 -> IM.IntMap Wall -> Point2
furthestPointWalkable p1 p2 ws = head $ (sortBy (compare `on` dist p1) $ IM.elems
src/Dodge/CreatureAction.hs
+7 -1
View File
@@ -207,7 +207,13 @@ reloadWeapon cid w =
$ set ( itRef . wpReloadState) rT w
_ -> Nothing
crAutoReload :: Creature -> Creature
crAutoReload cr = case cr ^? crInv . ix (_crInvSel cr) . wpLoadedAmmo of
Just 0 -> cr & crInv . ix (_crInvSel cr) . wpReloadState %~ (`fromMaybe` reloadT)
& crInv . ix (_crInvSel cr) . wpLoadedAmmo %~ (`fromMaybe` maxA)
_ -> cr
where reloadT = cr ^? crInv . ix (_crInvSel cr) . wpReloadTime
maxA = cr ^? crInv . ix (_crInvSel cr) . wpMaxAmmo
createItemAt :: Point2 -> FloorItem -> World -> World
createItemAt p it w = over floorItems (IM.insert i (set flItPos p
src/Dodge/Data.hs
+2 -19
View File
@@ -547,15 +547,6 @@ data Wall
, _blHP :: Int
, _wlIsSeeThrough :: Bool
}
| AutoDoor
{ _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _wlCastShadow :: Bool
}
| Door
{ _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World
@@ -563,6 +554,7 @@ data Wall
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _doorPathable :: Bool
}
| Block
{ _wlLine :: [Point2]
@@ -574,17 +566,8 @@ data Wall
, _blHP :: Int
, _wlIsSeeThrough :: Bool
, _blVisible :: Bool
, _blShadows :: [Int]
, _blDegrades :: [Int]
, _wlCastShadow :: Bool
}
| MultiBlock
{ _wlLine :: [Point2]
, _wlID :: Int
, _wlColor :: Color
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _subWalls :: [Wall]
, _blShadows :: [Int]
}
data ForceField = FF { _ffLine :: [Point2] , _ffID :: Int
src/Dodge/Floor.hs
+1 -1
View File
@@ -32,7 +32,7 @@ lev1 = do
(
[return $ return $ Right deadEndRoom
]
++ [slowDoorRoom]
++ [roomMiniIntro]
++ [return $ connectRoom corridor
,return $ connectRoom door]
++ firstWeapon
src/Dodge/Item/Weapon.hs
+25 -19
View File
@@ -62,6 +62,7 @@ pistol = Weapon
, _wpFireState = 0
, _wpFire = shootWithSound 0
. withRandomDir 0.1
. withMuzFlare
. withVelWthHiteff (30,0) 2
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
, _wpSpread = 0.02
@@ -124,17 +125,19 @@ autoGun = defaultGun
, _itInvDisplay = displayAutoGun
}
autoFireMode = shootWithSound (fromIntegral autoGunSound)
$ withRecoil 40
$ torqueBefore 0.05
$ withRandomDir (autogunSpread/2)
$ withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
. withRecoil 40
. torqueBefore 0.05
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
singleFireMode = shootWithSound (fromIntegral autoGunSound)
$ withRecoil 40
$ torqueAfter 0.03
$ withRandomDir (autogunSpread/2)
$ withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
. withRecoil 40
. torqueAfter 0.03
. withRandomDir (autogunSpread/2)
. withMuzFlare
. withVelWthHiteff (50,0) 3
$ threeEff' bulHitCr' bulHitWall' bulHitFF'
incMode :: Int -> World -> World
incMode _ w
@@ -422,9 +425,10 @@ hvAutoGun = defaultAutoGun
, _itEquipPict = drawWeapon $ color orange $ polygon $ rectNESW 5 5 (-5) (-5)
}
where mkHvBul = withSound (fromIntegral longGunSound)
$ withThinSmoke
$ withVelWthHiteff (80,0) 6
$ threeEff'
. withThinSmoke
. withMuzFlare
. withVelWthHiteff (80,0) 6
$ threeEff'
hvBulHitCr' hvBulHitWall' bulHitFF'
ltAutoGun = defaultAutoGun
@@ -436,7 +440,8 @@ ltAutoGun = defaultAutoGun
, _wpReloadState = 0
, _wpFireRate = 4
, _wpFireState = 0
, _wpFire = shootWithSound 0 . withRandomDir 0.3 $ withVelWthHiteff (30,0) 2 bulletEffect'
, _wpFire = shootWithSound 0 . withRandomDir 0.3
. withMuzFlare $ withVelWthHiteff (30,0) 2 bulletEffect'
, _wpSpread = 0.5
, _wpRange = 20
, _itFloorPict = onLayer FlItLayer $ color green $ pictures [polygon $ rectNSWE 4 (-4) (-4) 0
@@ -463,6 +468,7 @@ miniGun = defaultAutoGun
, _wpFire = withWarmUp 50 . torqueBefore 0.03 . withSidePush 50 . withRecoil 15
. withRandomDir 0.1
. withRandomOffset 9
. withMuzFlare
$ withVelWthHiteff (30,0) 2 bulletEffect'
, _wpSpread = autogunSpread
, _wpRange = 20
@@ -555,11 +561,11 @@ longGun = defaultGun
, _wpFireRate = 100
, _wpFireState = 0
, _wpFire = shootWithSound (fromIntegral longGunSound)
$ withThickSmoke
$ torqueAfter 0.05
$ withVelWthHiteff (60,0) 6
$ threeEff'
hvBulHitCr' hvBulHitWall' bulHitFF'
. withThickSmoke
. torqueAfter 0.05
. withMuzFlare
. withVelWthHiteff (60,0) 6
$ threeEff' hvBulHitCr' hvBulHitWall' bulHitFF'
, _wpSpread = 0.0
, _wpRange = 200
src/Dodge/Item/Weapon/TriggerType.hs
+3 -3
View File
@@ -94,7 +94,7 @@ shoot f cid w | fireCondition = over (pointerToItem . wpLoadedAmmo) (\ammo -> am
reloadCondition = _wpLoadedAmmo item == 0
withMuzFlare :: (Int -> World -> World) -> Int -> World -> World
withMuzFlare f cid w = over tempLightSources (tLightAt 4 pos :)
withMuzFlare f cid w = over tempLightSources (tLightAt 3 pos :)
. lowLightAt pos2 $ f cid w
where cr = _creatures w IM.! cid
dir = _crDir cr
@@ -112,8 +112,8 @@ withRandomDir acc f cid w = over (creatures . ix cid . crDir) (\d -> d - a)
withVelWthHiteff :: Point2 -> Float -> HitEffect' -> Int -> World -> World
withVelWthHiteff vel width hiteff cid w
= over particles' ((:) newbul)
. over tempLightSources ((:) (tLightAt 4 pos))
. lowLightAt pos2
-- . over tempLightSources ((:) (tLightAt 4 pos))
-- . lowLightAt pos2
$ set randGen g
w
where cr = _creatures w IM.! cid
src/Dodge/LevelGen.hs
-1
View File
@@ -181,7 +181,6 @@ putWindowBlock a b w = removePathsCrossing a b $ foldr makeBlockAt w $ zip ps ns
, _blVisible = seen
, _blShadows = shadows
, _blDegrades = degradeHP
, _wlCastShadow = False
}
f = IM.insert k0 l . IM.insert k1 t . IM.insert k2 r . IM.insert k3 b
in over walls f w
src/Dodge/LevelGen/AutoDoor.hs
+4 -27
View File
@@ -24,15 +24,8 @@ autoDoorAt a b wls = IM.union wls $ IM.fromList $ zip is $ mkAutoDoor a b is
is = [i..]
mkAutoDoor :: Point2 -> Point2 -> [Int] -> [Wall]
mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
mkAutoDoor pl pr xs = addSound $ zipWith3 (autoDoorPane [pl,pr])
xs
[ True
, False
, True
, True
, False
, True
]
[ [pld,hwd,hw,pl]
, [hwd,hwu]
, [hwu,plu,pl,hw]
@@ -68,24 +61,8 @@ mkAutoDoor pl pr xs = addSound $ zipWith4 (autoDoorPane [pl,pr])
| otherwise = dm w
where wp = (_wlLine $ _walls w IM.! (head xs)) !! 1
drawAutoDoor :: Wall -> Drawing
drawAutoDoor wl = onLayerL [levLayer WlLayer, layer2]
$ pictures [color c $ polygon [x,x +.+ n2,y +.+ n2, y]
,color (dark c) $ line [x,y]
]
where
(x:y:_) = _wlLine wl
c = _wlColor wl
nm = errorNormalizeV 543 (y -.- x)
t = 5 *.* nm
n = vNormal t
n2 = 3 *.* n
layer2 | _wlIsSeeThrough wl = 0
| isJust $ wl ^? doorMech = 1
| otherwise = 2
autoDoorPane :: [Point2] -> Int -> Bool -> [Point2] -> [Point2] -> Wall
autoDoorPane trigL n castShad closedPos openPos = AutoDoor
autoDoorPane :: [Point2] -> Int -> [Point2] -> [Point2] -> Wall
autoDoorPane trigL n closedPos openPos = Door
{ _wlLine = closedPos
, _wlID = n
, _doorMech = dm
@@ -93,7 +70,7 @@ autoDoorPane trigL n castShad closedPos openPos = AutoDoor
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _wlCastShadow = castShad
, _doorPathable = True
}
where
a = closedPos !! 0
src/Dodge/LevelGen/Block.hs
-2
View File
@@ -97,7 +97,6 @@ addBlockNoShadow (p:ps) hp col isSeeThrough degradability hasAllShadows w
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlCastShadow = bool
}
) is lines shadowList
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
@@ -131,7 +130,6 @@ addBlock (p:ps) hp col isSeeThrough degradability w
, _blVisible = True
, _blShadows = []
, _blDegrades = degradability
, _wlCastShadow = True
}
) is lines
wallInZone wl | dist (_wlLine wl !! 0) (_wlLine wl !! 1) <= 2*zoneSize
src/Dodge/LevelGen/TriggerDoor.hs
+1 -1
View File
@@ -116,7 +116,7 @@ triggerDoorPane c cond n closedPos openPos = Door
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
-- , _doorLine = [a,b,a',b']
, _doorPathable = False
}
where
a = closedPos !! 0
src/Dodge/Prototypes.hs
+3 -2
View File
@@ -29,14 +29,14 @@ basicWall = Wall { _wlLine = [(0,0),(50,0)]
, _wlSeen = False
, _wlIsSeeThrough = False
}
basicAutoDoor = AutoDoor { _wlLine = [(0,0),(50,0)]
basicAutoDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _doorMech = id
, _wlColor = light $ dim $ dim $ dim $ yellow
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _wlCastShadow = True
, _doorPathable = True
}
basicDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0
@@ -45,6 +45,7 @@ basicDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _doorPathable = False
}
basicCreature :: Creature
basicCreature = Creature
src/Dodge/Rendering.hs
+39 -106
View File
@@ -27,10 +27,8 @@ import qualified Data.Set as S
-- }}}
fixedCoordPictures :: World -> Picture
fixedCoordPictures w = pictures
-- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
[ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen
--, onLayer InvLayer $ activeObjectText w
, onLayer InvLayer $ closeObjectTexts w
]
where scaler = scale (2 / _windowX w) (2 / _windowY w)
@@ -57,7 +55,6 @@ fixedCoordPictures w = pictures
]
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
worldPictures :: World -> Picture
worldPictures w
= pictures $ concat [ decPicts
@@ -70,9 +67,8 @@ worldPictures w
, ptPicts'
, afterPtPicts'
, wlPicts'
-- , wallShadows
, wlPicts
, smokeShadows
-- , itLabels
, ppLabels
, btLabels
, testPic w
@@ -86,11 +82,10 @@ worldPictures w
ppPicts = map ppDraw (IM.elems (_pressPlates w))
crPicts = map crDraw $ IM.elems $ _creatures w
clPicts = map clDraw $ IM.elems $ _clouds w
wallShadows = map (drawWallShadow w) $ wallShadowsToDraw w
smokeShadows = map (drawSmokeShadow w) $ _smoke w
wlPicts = map drawWall (wallsToDraw w)
wlPicts' = map (drawWall' w) (wallsToDraw w)
itFloorPicts = map (drawItem) (IM.elems (_floorItems w))
wlPicts = map drawWallFloor (wallFloorsToDraw w)
wlPicts' = map (drawWallFace w) (wallShadowsToDraw w)
itFloorPicts = map drawItem (IM.elems (_floorItems w))
yourPos = _crPos $ you w
yourRot = _crDir $ you w
yourRad = _crRad $ you w
@@ -122,8 +117,8 @@ worldPictures w
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
testPic :: World -> [Picture]
testPic w = --[blank]
[setLayer 1 $ onLayerL [99] $ bezierQuad white red 5 5 (00,00) (300,305) (50,000) ]
testPic w = [blank]
-- [setLayer 1 $ onLayerL [99] $ bezierQuad white red 5 5 (00,00) (300,305) (50,000) ]
-- $ uncurry translate (mouseWorldPos w)
@@ -198,8 +193,8 @@ mapWall wl =
(x:y:_) = _wlLine wl
c = _wlColor wl
wallsToDraw :: World -> [Wall]
wallsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
wallFloorsToDraw :: World -> [Wall]
wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
where onScreen wall = lineOnScreen w (_wlLine wall)
isVisible wl | wl ^? blVisible == Just False = False
| otherwise = onScreen wl
@@ -244,23 +239,14 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
drawWall :: Wall -> Drawing
drawWall (Wall {_wlIsSeeThrough = False, _wlLine = ps, _wlColor = c})
= onLayerL [levLayer WlLayer, 2] $ color c $ polygon $ ps
drawWall wl = case _wlDraw wl of
-- Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon $ _wlLine wl
Nothing -> onLayerL [levLayer WlLayer, layer2] $ color c $ polygon [x,x +.+ n2,y +.+ n2, y]
Just d -> d wl
drawWallFloor :: Wall -> Picture
drawWallFloor wl = if _wlIsSeeThrough wl
then onLayerL [levLayer WlLayer] $ color c $ polygon [x,x +.+ n2,y+.+n2, y]
else blank
where
(x:y:_) = _wlLine wl
c = _wlColor wl
t = 5 *.* errorNormalizeVDR (y -.- x)
n = vNormal t
n2 = 3 *.* n
layer2 | _wlIsSeeThrough wl = 0
| isJust $ wl ^? doorMech = 1
| otherwise = 2
-- wallOrdering wl = (not $ _wlIsSeeThrough wl, not $ isJust $ wl ^? doorMech)
n2 = 15 *.* (vNormal . errorNormalizeVDR $ y -.- x)
errorNormalizeVDR :: Point2 -> Point2
errorNormalizeVDR (0,0) = error $ "problem with function: errorNormalizeVDR in DodgeRendering"
@@ -311,67 +297,39 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
where sp = screenPolygon w
sps = zip sp (tail sp ++ [head sp])
drawWall' :: World -> Wall -> Drawing
drawWall' w wall
drawWallFace :: World -> Wall -> Picture
drawWallFace w wall
| isRHS sightFrom x y = blank
| otherwise = colorAndLayer $ polygon $ points
where
colorAndLayer | _wlIsSeeThrough wall = setLayer 2
. onLayerL [levLayer ShadowLayer]
. color (withAlpha 0.2 $ _wlColor wall)
| otherwise = setLayer 2
. onLayerL [levLayer ShadowLayer,2]
. onLayerL [levLayer ShadowLayer,3]
. color (withAlpha 0.5 $ _wlColor wall)
| otherwise = setLayer 0
. onLayerL [levLayer ShadowLayer,l]
. color (_wlColor wall)
(x:y:_) = _wlLine wall
ps = linePointsBetween x y
ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps
p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps
points = extendConeToScreenEdge w sightFrom (x,y)
sightFrom = _cameraCenter w
corns = screenPolygon w
borders = filter g $ zip corns (tail corns ++ [head corns])
g (a,b) = isLHS a b sightFrom
borderps = mapMaybe f borders ++ mapMaybe f' borders ++ shadowedCorners
coneTop = nub $ concatMap (\(a,b) -> [a,b]) $ borders
shadowedCorners = filter isShadowed coneTop
isShadowed p = isLHS sightFrom x p && isRHS sightFrom y p
f (bpa,bpb) = intersectSegLineFrom' bpa bpb x (head p's)
f' (bpa,bpb) = intersectSegLineFrom' bpa bpb y (last p's)
points = orderPolygon (borderps ++ ps)
--points = orderPolygon (borderps ++ p's)
l = case wall of
Door {} -> 1
_ -> 2
drawWallShadow :: World -> Wall -> Drawing
drawWallShadow w wall
| isRHS sightFrom x y = blank
| otherwise = colorAndLayer $ polygon $ points
where
colorAndLayer | _wlIsSeeThrough wall = setLayer 2
. onLayerL [levLayer ShadowLayer]
. color (withAlpha 0.2 $ _wlColor wall)
| otherwise = setLayer 1
. onLayerL [levLayer ShadowLayer,2]
. color black
(x:y:_) = _wlLine wall
ps = linePointsBetween x y
ds = map (\p -> safeNormalizeV (p -.- sightFrom)) ps
p's = zipWith (\d x -> (15 *.* d) +.+ x) ds ps
sightFrom = _cameraCenter w
corns = screenPolygon w
borders = filter g $ zip corns (tail corns ++ [head corns])
g (a,b) = isLHS a b sightFrom
borderps = mapMaybe f borders ++ mapMaybe f' borders ++ shadowedCorners
coneTop = nub $ concatMap (\(a,b) -> [a,b]) $ borders
shadowedCorners = filter isShadowed coneTop
isShadowed p = isLHS sightFrom x p && isRHS sightFrom y p
f (bpa,bpb) = intersectSegLineFrom' bpa bpb x (head p's)
f' (bpa,bpb) = intersectSegLineFrom' bpa bpb y (last p's)
points = orderPolygon (borderps ++ p's)
-- the following assumes that the point a is inside the screen
-- it still works otherwise, but it might intersect two points:
-- it is not obvious which will be returned
intersectLinefromScreen :: World -> Point2 -> Point2 -> Maybe Point2
intersectLinefromScreen w a b = listToMaybe
. mapMaybe (\(x,y) -> intersectSegLineext x y a b)
. makeLoopPairs
$ screenPolygon w
linePointsBetween :: Point2 -> Point2 -> [Point2]
linePointsBetween p p' | d > 99 = map (\m -> p +.+ fromIntegral m *.* p'') [0..n-1] ++ [p']
| otherwise = [p,p']
where d = dist p p'
n = ceiling $ d / 50
p'' = (1/fromIntegral n) *.* (p' -.- p)
extendConeToScreenEdge :: World -> Point2 -> (Point2,Point2) -> [Point2]
extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
where borderPs = mapMaybe (intersectLinefromScreen w c) [x,y]
cornerPs = filter (pointIsInCone c (x,y)) $ screenPolygon w
wallScreenIntersect = mapMaybe (uncurry $ intersectSegSeg' x y)
. makeLoopPairs $ screenPolygon w
displayInv :: Int -> World -> Picture
displayInv n w = pictures $ zipWith (translate (15-halfWidth w))
@@ -397,10 +355,6 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
&& hasLOS (_btPos bt) (_crPos (you w)) w
&& _btState bt /= BtNoLabel
= pictures
--[ scale (2/_windowX w) (2/_windowY w)
-- . t
-- . translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
-- $ scale 0.1 0.1 $ text $ _btText bt
[ tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
@@ -429,10 +383,6 @@ drawItemName :: World -> FloorItem -> Picture
drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
&& hasLOS (_flItPos flIt) (_crPos (you w)) w
= pictures
--[ scale (2/_windowX w) (2/_windowY w)
-- . t
-- . translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
-- $ scale 0.1 0.1 $ text $ nameOfItem
[ tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
@@ -444,11 +394,6 @@ drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
nameOfItem = _itName $ _flIt flIt
zoom = _cameraZoom w
ringPict :: Drawing
ringPict = onLayer LabelLayer $ dShadCol white $ pictures [line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
,line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
dShadCol :: Color -> Picture -> Picture
dShadCol c p = pictures $
[ color black $ uncurry translate (1.2,-1.2) p
@@ -496,22 +441,10 @@ displayHP n w = translate (halfWidth w-80) (halfHeight w-20) $
wallsForGloom :: World -> [(Point2,Point2)]
wallsForGloom w = map (linePairs . _wlLine) $ filter (not . _wlIsSeeThrough)
$ filter wallCastsShadow
$ IM.elems $ wallsNearZones (zoneOfDoubleScreen w) w
where linePairs (x:y:_) = (x,y)
wallCastsShadow wl = case wl ^? wlCastShadow of
Just b -> b
Nothing -> True
lightsForGloom' :: World -> [(Point4)]
lightsForGloom' w = map getLS (IM.elems $ _lightSources w) ++ map getTLS (_tempLightSources w)
where getLS ls = ( fst $ ssls ls, snd $ ssls ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( fst $ sstls ls,snd $ sstls ls, _tlsRad ls, _tlsIntensity ls)
ss' v = rotateV (0 - _cameraRot w) (v -.- _cameraPos w)
ss'' (a,b) = (a*2*zoom / _windowX w,b*2*zoom / _windowY w)
ss = ss'' . ss'
ssls = _lsPos
sstls = _tlsPos
-- ssls = ss . _lsPos
-- sstls = ss . _tlsPos
zoom = _cameraZoom w
where getLS ls = ( fst $ _lsPos ls, snd $ _lsPos ls, _lsRad ls , _lsIntensity ls)
getTLS ls = ( fst $ _tlsPos ls,snd $ _tlsPos ls, _tlsRad ls, _tlsIntensity ls)
src/Dodge/Update.hs
+1 -2
View File
@@ -4,7 +4,7 @@ import Dodge.Data
import Dodge.Base
import Dodge.WallCreatureCollisions
import Dodge.LevelGen.Block
import Dodge.Camera
import Dodge.Update.Camera
import Dodge.SoundLogic
import Dodge.Inventory
@@ -91,7 +91,6 @@ updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
wallEvents :: World -> World
wallEvents w = IM.foldr (_doorMech) w ( IM.filter (\d -> case d of
Door {} -> True
AutoDoor {} -> True
BlockAutoDoor {} -> True
_ -> False) ( _walls w))
src/Dodge/Camera.hs → src/Dodge/Update/Camera.hs
+13 -17
View File
@@ -1,4 +1,4 @@
module Dodge.Camera where
module Dodge.Update.Camera where
import Dodge.Data
import Dodge.Base
@@ -35,7 +35,6 @@ moveCamera w = w & cameraPos .~ idealPos
idealOffset = rotateV (_cameraRot w) (aimRangeFactor * aimingMult *.* _mousePos w)
currentOffset = currentPos -.- camCenter
idealPos = camCenter +.+ rotateV (_cameraRot w)
-- (aimRangeFactor * aimTimeFactor *.* _mousePos w)
(aimRangeFactor * aimingMult *.* _mousePos w)
currentPos = _cameraPos w
camCenter = ypos +.+ scope
@@ -45,9 +44,6 @@ moveCamera w = w & cameraPos .~ idealPos
sightFrom | isCam = camCenter
| otherwise = ypos
updateScopeZoom :: World -> World
updateScopeZoom w
| SDL.ButtonRight `S.member` _mouseButtons w = case w ^? scppoint of
@@ -99,7 +95,7 @@ zoomOutLongGun w | currentZoom > 0.5 = over (wpPointer . itAttachment . _Just .
Just currentZoom = wp ^? itAttachment . _Just . scopeZoom
currentCursorDisplacement = fromJust $ _itAttachment wp
rotCam = rotateCameraL . rotateCameraR . zoomCamIn . zoomCamOut . zoomCam
rotCam = rotateCameraL . rotateCameraR . zoomCamIn . zoomCamOut . autoZoomCam
rotateCameraL :: World -> World
rotateCameraL w | SDL.KeycodeQ `S.member` _keys w
@@ -122,16 +118,13 @@ zoomCamOut w | SDL.KeycodeK `S.member` _keys w
= w {_cameraZoom = max (_cameraZoom w - 0.01) 0.01}
| otherwise = w
-- the 395 here limits the max zoom out, is 25 less than the current screen
-- size, thus matches up with it
zoomCam :: World -> World
--zoomCam w = w
zoomCam w = over cameraZoom changeZoom w
autoZoomCam :: World -> World
autoZoomCam w = over cameraZoom changeZoom w
where maxViewDistance = 800
camPos = _cameraCenter w
camRot = _cameraRot w
wallZoom = min (halfWidth w / (horizontalMax+10) )
(halfHeight w / (verticalMax+10) )
wallZoom = min (halfWidth w / (horizontalMax+50) )
(halfHeight w / (verticalMax+50) )
idealZoom | SDL.ButtonRight `S.member` _mouseButtons w
= scZoom *
(
@@ -143,10 +136,13 @@ zoomCam w = over cameraZoom changeZoom w
= min (fromMaybe 20 $ yourItem w ^? itZoom . itZoomMax)
$ max (fromMaybe 0.2 (yourItem w ^? itZoom . itZoomMin))
(wallZoom * fromMaybe 1 (yourItem w ^? itZoom . itZoomFac))
changeZoom curZoom | curZoom > idealZoom + 0.01 = 0.05 * (19*curZoom + idealZoom)
| curZoom < idealZoom - 0.01 = 0.05 * (19*curZoom + idealZoom)
| otherwise = idealZoom
-- zs = take 20 [-maxViewDistance,0 - 0.9*maxViewDistance..]
changeZoom curZoom
| curZoom > idealZoom + 0.01 = ((zoomOutSpeed-1)*curZoom + idealZoom) / zoomOutSpeed
| curZoom < idealZoom - 0.01 = ((zoomInSpeed-1)*curZoom + idealZoom) / zoomInSpeed
| otherwise = idealZoom
-- these speeds are inverted, larger means slower
zoomInSpeed = 25
zoomOutSpeed = 15
zs = take 9 [-maxViewDistance,0 - 0.8*maxViewDistance..]
rRays = rotF [( maxViewDistance,y) | y <- zs]
lRays = rotF [(-maxViewDistance,y) | y <- zs]