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

Add general smooth scrolling, move camera into world

Browse Source
This commit is contained in:
justin
2023-03-26 20:09:00 +01:00
parent 73e742e1a2
commit 07a1d71039
32 changed files with 154 additions and 131 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Collide.hs
+1 -1
View File
@@ -132,7 +132,7 @@ allVisibleWalls :: World -> [(Point2, Wall)]
{-# INLINE allVisibleWalls #-}
allVisibleWalls w = concatMap (flip (visibleWalls vPos) w . (+.+ vPos)) $ nRays 15
where
vPos = w ^. cWorld . cwCam . camViewFrom
vPos = w ^. wCam . camViewFrom
overlapCircWalls ::
Point2 ->
src/Dodge/Base/Coordinate.hs
+3 -3
View File
@@ -15,9 +15,9 @@ import Geometry
--worldPosToScreenNorm :: Configuration -> World -> Point2 -> Point2
--worldPosToScreenNorm cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
-- where
-- doTranslate p = p -.- (w ^. cWorld . lWorld . cwCam . cwcCenter)
-- doZoom p = (w ^. cWorld . lWorld . cwCam . cwcZoom) *.* p
-- doRotate p = rotateV (negate (w ^. cWorld . lWorld . cwCam . cwcRot)) p
-- doTranslate p = p -.- (w ^. cWorld . lWorld . wCam . cwcCenter)
-- doZoom p = (w ^. cWorld . lWorld . wCam . cwcZoom) *.* p
-- doRotate p = rotateV (negate (w ^. cWorld . lWorld . wCam . cwcRot)) p
{- | Transform world coordinates to scaled screen coordinates.
- These have to be scaled according to the size of the window to get actual screen positions.
src/Dodge/Bullet.hs
+1 -1
View File
@@ -82,7 +82,7 @@ useAmmoParams it cr w =
return $ FlechetteTrajectory tpos
BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
tpos <- cr ^? crTargeting . ctPos . _Just
return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam))
return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. wCam))
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
src/Dodge/Creature/Action/Blink.hs
+3 -3
View File
@@ -26,7 +26,7 @@ blinkActionMousePos cr w =
& inverseShockwaveAt cpos 40 2 2
where
cid = _crID cr
p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
p1 = mouseWorldPos (w ^. input) (w ^. wCam)
cpos = _crPos cr
--p2 = bouncePoint (const True) 1 cpos p1 w
p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w)
@@ -70,7 +70,7 @@ unsafeBlinkAction cr w
wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
return (isLHS mwp `uncurry` _wlLine wl)
cid = _crID cr
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
cpos = _crPos cr
blinkShockwave ::
@@ -96,7 +96,7 @@ blinkActionFail cr w =
distR = 120
distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
cid = _crID cr
p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
p1 = mouseWorldPos (w ^. input) (w ^. wCam)
cpos = _crPos cr
p2 = bouncePoint (const True) 1 cpos p1 w
r = 1.5 * _crRad cr
src/Dodge/Creature/Picture/Awareness.hs
+2 -2
View File
@@ -28,8 +28,8 @@ creatureDisplayText w cr =
cr
where
lw = w ^. cWorld . lWorld
campos = w ^. cWorld . cwCam . camViewFrom
theScale = 0.15 / (w ^. cWorld . cwCam . camZoom)
campos = w ^. wCam . camViewFrom
theScale = 0.15 / (w ^. wCam . camZoom)
cpos = _crPos cr
v = cpos -.- campos
(V2 x y) = campos +.+ v +.+ _crRad cr *.* normalizeV v
src/Dodge/Creature/YourControl.hs
+5 -5
View File
@@ -75,15 +75,15 @@ wasdWithAiming w speed cr
| otherwise = crMvForward speed
theTurn cr' = creatureTurnTowardDir (_crMvAim cr') 0.2 cr'
movDir = wasdDir w
dir = fmap ((w ^. cWorld . cwCam . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. cWorld . cwCam . camRot) $ normalizeV movDir
dir = fmap ((w ^. wCam . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. wCam . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. cWorld . cwCam . camRot) )
(argV (_mousePos (_input w)) + (w ^. wCam . camRot) )
$ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- _crPos cr
return . argV $ mouseWorldPos (w ^. input) (w ^. wCam) -.- _crPos cr
aimTurn :: Float -> Creature -> Creature
aimTurn a cr = creatureTurnTowardDir a (x * 0.2) cr
@@ -120,7 +120,7 @@ pressedMBEffectsTopInventory pkeys w
| isDown SDL.ButtonLeft && isDown SDL.ButtonRight && inTopInv = useItem (you w) w
| isDown SDL.ButtonLeft && inTopInv = doTopInvLeftClick (you w) w
| isDown SDL.ButtonMiddle =
w & cWorld . cwCam . camRot -~ rotation
w & wCam . camRot -~ rotation
& input . clickMousePos .~ _mousePos (_input w)
| otherwise = w
where
src/Dodge/Data/CWorld.hs
-1
View File
@@ -24,7 +24,6 @@ import Data.Graph.Inductive
data CWorld = CWorld
{ _lWorld :: LWorld
, _cwCam :: Camera
, _cwGen :: CWGen
, _cClock :: Int
, _seenWalls :: IS.IntSet
src/Dodge/Data/Input.hs
+2 -1
View File
@@ -23,6 +23,7 @@ data Input = Input
, _mouseButtons :: M.Map MouseButton Int -- counts number of frames held down
, _scrollAmount :: Int
, _previousScrollAmount :: Int
, _smoothScrollAmount :: Int
, _lLine :: (Point2, Point2)
, _rLine :: (Point2, Point2)
, _lrLine :: (Point2, Point2)
@@ -31,7 +32,7 @@ data Input = Input
, _clickMousePos :: Point2 -- is this in world or screen coords?
, _clickPos :: M.Map MouseButton Point2 -- updates when mouse button is pressed
, _heldPos :: M.Map MouseButton Point2 -- updates when mouse button is held
-- ideally, lags ONE FRAME BEHIND the stored mouse position
-- lags ONE FRAME BEHIND the stored mouse position
, _textInput :: [Either TermSignal Char]
, _scrollTestFloat :: Float
, _scrollTestInt :: Int
src/Dodge/Data/World.hs
+1
View File
@@ -51,6 +51,7 @@ data World = World
, _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
, _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
, _gsZoning :: IntMap (IntMap IntSet)
, _wCam :: Camera
}
data TimeFlowStatus
src/Dodge/Debug/Picture.hs
+6 -6
View File
@@ -39,11 +39,11 @@ lineOnScreenCone cfig w p1 p2 =
|| pointInPolygon p2 sp
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
where
sp' = screenPolygon cfig (w ^. cWorld . cwCam)
vp = w ^. cWorld . cwCam . camViewFrom
sp' = screenPolygon cfig (w ^. wCam)
vp = w ^. wCam . camViewFrom
sp
| pointInPolygon vp sp' = sp'
| otherwise = orderPolygon ((w ^. cWorld . cwCam . camViewFrom) : sp')
| otherwise = orderPolygon ((w ^. wCam . camViewFrom) : sp')
sps = zip sp (tail sp ++ [head sp])
pointOnScreen :: Configuration -> Camera -> Point2 -> Bool
@@ -56,13 +56,13 @@ drawWallFace cfig w wall
where
(x, y) = _wlLine wall
points = extendConeToScreenEdge cfig w sightFrom (x, y)
sightFrom = w ^. cWorld . cwCam . camViewFrom
sightFrom = w ^. wCam . camViewFrom
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2, Point2) -> [Point2]
extendConeToScreenEdge cfig w c (x, y) = orderPolygon $ wallScreenIntersect ++ [x, y] ++ borderPs ++ cornerPs
where
borderPs = mapMaybe (intersectLinefromScreen cfig w c) [x, y]
scpoly = reverse $ screenPolygon cfig (w ^. cWorld . cwCam)
scpoly = reverse $ screenPolygon cfig (w ^. wCam)
cornerPs = filter (pointIsInCone c (x, y)) scpoly
wallScreenIntersect =
mapMaybe (uncurry $ intersectSegSeg y ((2 *.* y) -.- x))
@@ -77,4 +77,4 @@ intersectLinefromScreen cfig w a b =
listToMaybe
. mapMaybe (\(x, y) -> intersectSegLineFrom x y b (b +.+ b -.- a))
. loopPairs
$ screenPolygon cfig (w ^. cWorld . cwCam)
$ screenPolygon cfig (w ^. wCam)
src/Dodge/Default/World.hs
+3 -2
View File
@@ -23,6 +23,7 @@ defaultInput =
, _mouseMoving = False
, _scrollAmount = 0
, _previousScrollAmount = 0
, _smoothScrollAmount = 0
, _lrLine = (0, 0)
, _lLine = (0, 0)
, _rLine = (0, 0)
@@ -36,6 +37,7 @@ defaultWorld :: World
defaultWorld =
World
{ _cWorld = defaultCWorld
, _wCam = defaultCWCam
, _pastWorlds = mempty
, _timeFlow = NormalTimeFlow
, _input = defaultInput
@@ -82,8 +84,7 @@ defaultCWCam =
defaultCWorld :: CWorld
defaultCWorld =
CWorld
{ _cwCam = defaultCWCam
, _lWorld = defaultLWorld
{ _lWorld = defaultLWorld
, _cwGen = defaultCWGen
, _cClock = 0
, _seenWalls = mempty
src/Dodge/Event/Input.hs
+11 -6
View File
@@ -1,5 +1,6 @@
-- | Capture input events, store them in structures for later use.
-- Should not update the world other than this.
{- | Capture input events, store them in structures for later use.
Should not update the world other than this.
-}
module Dodge.Event.Input (
handleKeyboardEvent,
handleTextInput,
@@ -12,6 +13,7 @@ import Dodge.Data.Config
import Dodge.Data.Input
import LensHelp
import SDL
--import qualified Data.Map.Strict as M
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
@@ -23,8 +25,9 @@ handleTextInput text = textInput %~ (++ map Right text)
handleKeyboardEvent :: KeyboardEventData -> Input -> Input
handleKeyboardEvent kev = case keyboardEventKeyMotion kev of
Released -> pressedKeys . at scode .~ Nothing
Pressed -> (pressedKeys . at scode ?~ val)
. addTermSignal scode
Pressed ->
(pressedKeys . at scode ?~ val)
. addTermSignal scode
where
val
| keyboardEventRepeat kev = LongPress
@@ -50,14 +53,16 @@ handleMouseMotionEvent mmev cfig =
(0.5 * windowYFloat cfig - fromIntegral y)
handleMouseWheelEvent :: MouseWheelEventData -> Input -> Input
handleMouseWheelEvent mwev = scrollAmount +~ fromIntegral y
handleMouseWheelEvent mwev =
(scrollAmount +~ fromIntegral y)
where
V2 _ y = mouseWheelEventPos mwev
handleMouseButtonEvent :: MouseButtonEventData -> Input -> Input
handleMouseButtonEvent mbev = case mouseButtonEventMotion mbev of
Released -> mouseButtons . at thebutton .~ Nothing
Pressed -> mouseButtons . at thebutton ?~ 1 -- note that mouse button events are NOT repeating
where
-- pointtothebutton = mouseButtons . at thebutton
-- pointtothebutton = mouseButtons . at thebutton
thebutton = mouseButtonEventButton mbev
src/Dodge/HeldUse.hs
+2 -2
View File
@@ -349,7 +349,7 @@ useMod hm = case hm of
directedTelPos _ cr w = (p, a)
where
p = fromMaybe (_crPos cr) $ cr ^? crTargeting . ctPos . _Just
a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- p)
a = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- p)
moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
modcrpos x cr =
cr & crDir %~ tweenAngles x (_crOldDir cr)
@@ -513,7 +513,7 @@ shootTeslaArc it cr w =
useForceFieldGun :: Item -> Creature -> World -> World
useForceFieldGun itm cr w = fromMaybe w $ do
a <- cr ^? crTargeting . ctPos . _Just
let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
let mwp = mouseWorldPos (w ^. input) (w ^. wCam)
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
wlline = (a, b)
return $
src/Dodge/Initialisation.hs
+1 -1
View File
@@ -16,7 +16,7 @@ splashScreen =
initialWorld :: World
initialWorld =
defaultWorld
& cWorld . cwCam . camZoom .~ 10
& wCam . camZoom .~ 10
& cWorld . lWorld . creatures .~ IM.fromList [(0, startCr)]
& cWorld . lWorld . worldEvents .~ SoundStart BackgroundSound (V2 0 0) foamSprayFadeOutS Nothing :
[MakeStartCloudAt (V3 x y 5) | x <- [-5, -4 .. 5], y <- [-5, -4 .. 5]]
src/Dodge/Item/Weapon/BatteryGuns.hs
+2 -2
View File
@@ -149,7 +149,7 @@ circleLaser it cr w
| otherwise = w
where
cpos = _crPos cr
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
phasev = _phaseV . _itParams $ _crInv cr IM.! itRef
@@ -169,7 +169,7 @@ shootDualLaser it cr w =
gap = _dbGap . _itParams $ it
posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
mwp'
| dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
| otherwise = mwp
src/Dodge/Item/Weapon/TriggerType.hs
+6 -6
View File
@@ -589,7 +589,7 @@ torqueBefore torque feff item cr w
w
& randGen .~ g
& cWorld . lWorld . creatures . ix cid . crDir +~ rot
& cWorld . cwCam . camRot +~ rot
& wCam . camRot +~ rot
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where
cid = _crID cr
@@ -610,7 +610,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
w
& randGen .~ g
& cWorld . lWorld . creatures . ix cid . crDir +~ rot'
& cWorld . cwCam . camRot +~ rot'
& wCam . camRot +~ rot'
| otherwise = feff item cr $ set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot') w
where
cid = _crID cr
@@ -623,7 +623,7 @@ torqueBeforeAtLeast minTorque exTorque feff item cr w
withTorqueAfter :: ChainEffect
withTorqueAfter feff item cr w
-- | cid == 0 = rotateScope $ set randGen g $ over cameraRot (+rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . cwCam . camRot) (+ rot) $ feff item cr w
| cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) $ feff item cr w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) $ feff item cr w
where
cid = _crID cr
@@ -661,7 +661,7 @@ sideEffectOnFrame i sf f it cr w =
torqueSideEffect :: Float -> Item -> Creature -> World -> World
torqueSideEffect torque _ cr w
| cid == 0 = set randGen g $ over (cWorld . cwCam . camRot) (+ rot) w
| cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where
cid = _crID cr
@@ -708,12 +708,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss
& crPos %~ (+.+ pos)
& crDir .~ thedir pos
thedir pos
| dist (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) (_crPos cr) < aimingMuzzlePos cr item =
| dist (mouseWorldPos (w ^. input) (w ^. wCam)) (_crPos cr) < aimingMuzzlePos cr item =
argV
( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
-.- (_crPos cr +.+ pos)
)
| otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- (_crPos cr +.+ pos))
| otherwise = argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- (_crPos cr +.+ pos))
duplicateItem :: (Item -> [Item]) -> ChainEffect
duplicateItem fit eff itm cr w = foldr f w (fit itm)
src/Dodge/Layout.hs
+1 -1
View File
@@ -57,7 +57,7 @@ generateLevelFromRoomList gr' w =
randomCompass :: World -> World
randomCompass w = w & cWorld . cwCam . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
randomCompass w = w & wCam . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
-- note the order of traversal of the rooms is important
-- hence the reverse
src/Dodge/Luse.hs
+1 -1
View File
@@ -113,7 +113,7 @@ boostPoint x cr w = case mayp2 of
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
mayp2 = bouncePoint (const True) 1 cpos p1 w
addBoostShockwave ::
src/Dodge/Picture/SizeInvariant.hs
+6 -6
View File
@@ -5,7 +5,7 @@ module Dodge.Picture.SizeInvariant
import Control.Lens
import Data.Maybe
import Dodge.Base.Window
import Dodge.Data.CWorld
import Dodge.Data.World
import Dodge.Data.Config
import Geometry
import Picture
@@ -62,7 +62,7 @@ fixedSizePicClampArrow ::
Picture ->
Point2 ->
Configuration ->
CWorld ->
World ->
Picture
fixedSizePicClampArrow xbord ybord pic p cfig w =
pictures
@@ -70,16 +70,16 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
, setLayer DebugLayer . color white . setDepth 20 $ arrowPic
]
where
winps = screenPolygon cfig (w ^. cwCam)
bords = screenPolygonBord xbord ybord cfig (w ^. cwCam)
winps = screenPolygon cfig (w ^. wCam)
bords = screenPolygonBord xbord ybord cfig (w ^. wCam)
borderPoint = intersectSegPolyFirst campos p bords
windowPoint = intersectSegPolyFirst campos p winps
arrowPic = case borderPoint of
Nothing -> blank
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
(V2 x y) = fromMaybe p borderPoint
campos = w ^. cwCam . camCenter
theScale = 1 / (w ^. cwCam . camZoom)
campos = w ^. wCam . camCenter
theScale = 1 / (w ^. wCam . camZoom)
--absClamp ::
-- -- | clamping value, assumed positive
src/Dodge/Projectile/Update.hs
+1 -1
View File
@@ -97,7 +97,7 @@ setRemoteDir cid itid pj w = w & cWorld . lWorld . projectiles . ix (_prjID pj)
| SDL.ButtonRight `M.member` _mouseButtons (_input w)
&& w ^? cWorld . lWorld . creatures . ix cid . crManipulation . manObject . inInventory . ispItem
== w ^? cWorld . lWorld . itemLocations . ix itid . ipInvID
= (w ^. cWorld . cwCam . camRot) + argV (_mousePos (_input w))
= (w ^. wCam . camRot) + argV (_mousePos (_input w))
| otherwise = _prjDir pj
doThrust :: Proj -> World -> World
src/Dodge/Render.hs
+5 -5
View File
@@ -49,13 +49,13 @@ doDrawing' win pdata u = do
checkGLError
let w = _uvWorld u
cfig = _uvConfig u
rot = w ^. cWorld . cwCam . camRot
camzoom = w ^. cWorld . cwCam . camZoom
trans = w ^. cWorld . cwCam . camCenter
rot = w ^. wCam . camRot
camzoom = w ^. wCam . camZoom
trans = w ^. wCam . camCenter
wins = V2 (windowXFloat cfig) (windowYFloat cfig)
(windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
lightPoints = lightsToRender cfig (w ^. cWorld . cwCam) (w ^. cWorld . lWorld)
viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . camViewFrom
lightPoints = lightsToRender cfig (w ^. wCam) (w ^. cWorld . lWorld)
viewFroms@(V2 vfx vfy) = w ^. wCam . camViewFrom
shadV = _pictureShaders pdata
nFls = w ^. cWorld . numberFloorVerxs
-- bind as much data into vbos as feasible at this point
src/Dodge/Render/Picture.hs
+2 -2
View File
@@ -76,8 +76,8 @@ mouseCursorType u
a = fromMaybe 0 $ do
cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
return . toClosestMultiple (pi / 32) $
argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
- w ^. cWorld . cwCam . camRot
argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
- w ^. wCam . camRot
mousePlus :: Picture
mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
src/Dodge/Render/ShapePicture.hs
+24 -24
View File
@@ -83,7 +83,7 @@ drawSweep cr w = fromMaybe mempty $ do
cdir = _crDir cr
rot = campos ^. camRot
p = _crPos cr
campos = w ^. cWorld . cwCam
campos = w ^. wCam
theinput = w ^. input
mwp = mouseWorldPos theinput campos
@@ -134,8 +134,8 @@ shiftDraw' fpos fdir fdraw x =
cullPoint :: Configuration -> World -> Point2 -> Bool
cullPoint cfig w p
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . camBoundBox)
| otherwise = dist (w ^. cWorld . cwCam . camCenter) p < (w ^. cWorld . cwCam . camViewDistance)
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. wCam . camBoundBox)
| otherwise = dist (w ^. wCam . camCenter) p < (w ^. wCam . camViewDistance)
extraPics :: Configuration -> Universe -> Picture
extraPics cfig u =
@@ -185,7 +185,7 @@ debugDraw' cfig w bl = case bl of
Close_shape_culling -> mempty
Bound_box_screen -> mempty
Show_ms_frame -> mempty
View_boundaries -> viewBoundaries (w ^. cWorld)
View_boundaries -> viewBoundaries w
Show_bound_box -> drawBoundingBox w
Show_wall_search_rays -> drawWallSearchRays w
Show_dda_test -> drawDDATest w
@@ -197,7 +197,7 @@ debugDraw' cfig w bl = case bl of
Inspect_wall -> drawInspectWalls w
Cr_awareness -> drawCreatureDisplayTexts w
Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
Cr_status -> drawCrInfo cfig (w ^. cWorld)
Cr_status -> drawCrInfo cfig w
Mouse_position -> drawMousePosition w
Walls_info -> drawWlIDs w
Pathing -> drawPathing cfig w
@@ -243,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do
drawWallsNearCursor :: World -> Picture
drawWallsNearCursor w =
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCam $ _cWorld w)) w
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_wCam w)) w
where
f wl = color rose $ thickLine 3 [a, b]
where
@@ -307,13 +307,13 @@ drawFarWallDetect w =
)
$ getViewpoints p (_cWorld w)
where
p = w ^. cWorld . cwCam . camViewFrom
p = w ^. wCam . camViewFrom
drawZoneNearPointCursor :: World -> Picture
drawZoneNearPointCursor w =
foldMap (drawZoneCol orange 50) ps
where
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
ps = [zoneOfPoint 50 mwp]
drawDDATest :: World -> Picture
@@ -321,8 +321,8 @@ drawDDATest w =
foldMap (drawZoneCol orange 50) ps
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. cWorld . cwCam . camViewFrom
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
cvf = w ^. wCam . camViewFrom
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
ps = zoneOfSeg 50 cvf mwp
drawZoneCol :: Color -> Float -> V2 Int -> Picture
@@ -342,7 +342,7 @@ drawWallSearchRays w = foldMap (f . fst) $ allVisibleWalls w
setLayer DebugLayer $
color yellow $
uncurryV translate p (circle 5)
<> line [w ^. cWorld . cwCam . camViewFrom, p]
<> line [w ^. wCam . camViewFrom, p]
testPic :: Configuration -> World -> Picture
testPic _ _ = mempty
@@ -350,7 +350,7 @@ testPic _ _ = mempty
drawBoundingBox :: World -> Picture
drawBoundingBox w = setLayer DebugLayer $ color green $ line $ (x : xs) ++ [x]
where
(x : xs) = w ^. cWorld . cwCam . camBoundBox
(x : xs) = w ^. wCam . camBoundBox
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
@@ -371,11 +371,11 @@ mcSPic mc =
rotateSP (_mcDir mc) (drawMachine mc)
soundPic :: Configuration -> World -> Sound -> Picture
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig w
where
p = _soundPos s
thePic =
rotate (w ^. cWorld . cwCam . camRot)
rotate (w ^. wCam . camRot)
. scale theScale theScale
. centerText
. soundToOnomato
@@ -391,7 +391,7 @@ drawMousePosition w =
. text
$ shortPoint2 mwp
where
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
drawWlIDs :: World -> Picture
drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
@@ -404,7 +404,7 @@ drawWlIDs w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls
. text
$ show $ _wlID wl
where
p = worldPosToScreen (w ^. cWorld . cwCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
p = worldPosToScreen (w ^. wCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
edgeToPic :: [Point2] -> PathEdge -> Picture
edgeToPic poly pe
@@ -417,7 +417,7 @@ edgeToPic poly pe
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCam)) . (^?! _3)) (FGL.labEdges gr)
foldMap (edgeToPic (screenPolygon cfig (w ^. wCam)) . (^?! _3)) (FGL.labEdges gr)
<> foldMap dispInc (graphToIncidence gr)
where
dispInc (p, n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
@@ -448,23 +448,23 @@ crDisplayInfo cfig cam cr
fpreShow :: (Show a, Functor f) => String -> f a -> f String
fpreShow str = fmap (((rightPad 7 '.' str ++ "...") ++) . show)
drawCrInfo :: Configuration -> CWorld -> Picture
drawCrInfo :: Configuration -> World -> Picture
drawCrInfo cfig w =
setLayer FixedCoordLayer $
renderInfoListsAt (2 * hw - 400) 0 cfig cam $
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. cWorld . lWorld . creatures
where
cam = w ^. cwCam
cam = w ^. wCam
hw = halfWidth cfig
viewBoundaries :: CWorld -> Picture
viewBoundaries :: World -> Picture
viewBoundaries w =
setLayer DebugLayer $
color green (foldMap (polygonWire . _grBound) grs)
<> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w)
<> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p (_cWorld w))
where
p = w ^. cwCam . camViewFrom
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
p = w ^. wCam . camViewFrom
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen $ _cWorld w)
viewClipBounds :: Configuration -> World -> Picture
viewClipBounds cfig w
src/Dodge/SoundLogic.hs
+2 -2
View File
@@ -163,9 +163,9 @@ soundAngle p w
. radToDeg
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCam . camRot)
$ argV (vNormal (p -.- earPos)) - (w ^. wCam . camRot)
where
earPos = w ^. cWorld . cwCam . camViewFrom
earPos = w ^. wCam . camViewFrom
{- | Uses the first free origin from a list.
Does nothing if all origins are already creating sounds.
src/Dodge/Targeting.hs
+4 -4
View File
@@ -49,7 +49,7 @@ targetRBCreatureUp cr w
. filter (canseepos . _crPos)
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
updatePos t' = t' & ctPos .~ posFromMaybeID (_ctID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
@@ -61,7 +61,7 @@ targetRBCreatureUp cr w
targetCursorUpdate :: World -> CreatureTargeting -> CreatureTargeting
targetCursorUpdate w ct =
ct
& ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
& ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. wCam)
& ctActive .~ True
& ctType ?~ TargetCursor
@@ -69,7 +69,7 @@ targetRBPressUpdate :: World -> CreatureTargeting -> CreatureTargeting
targetRBPressUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
t
& ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) Just
& ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. wCam)) Just
& ctActive .~ True
& ctType ?~ TargetRBPress
| otherwise =
@@ -100,7 +100,7 @@ targetLaserUpdate cr w t
where
(mp, _) = reflectLaserAlong 0.2 sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- sp)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. wCam) -.- sp)
addLaserPic =
cWorld . lWorld . lasers
.:~ LaserStart
src/Dodge/Targeting/Draw.hs
+2 -2
View File
@@ -26,7 +26,7 @@ targetDistanceDraw :: Creature -> Configuration -> World -> Picture
targetDistanceDraw cr _ w = fromMaybe mempty $ do
p <- cr ^? crTargeting . ctPos . _Just
let p1 = worldPosToScreen cam p
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
p2 = worldPosToScreen cam mwp
thecol = if dist p mwp > 100 then red else white
return .
@@ -35,7 +35,7 @@ targetDistanceDraw cr _ w = fromMaybe mempty $ do
line [p1, p2]
<> transMidLine p1 p2 (scale 0.1 0.1 . text . shortShow $ dist p mwp)
where
cam = w ^. cWorld . cwCam
cam = w ^. wCam
targetDraw :: Picture -> Creature -> Configuration -> World -> Picture
targetDraw f cr _ _ = fromMaybe mempty $ do
src/Dodge/TestString.hs
+7 -5
View File
@@ -1,6 +1,7 @@
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.TestString where
import Dodge.SmoothScroll
import HelpNum
import Dodge.Base.Coordinate
import Geometry.Vector
@@ -16,9 +17,10 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^. uvWorld . input . mouseButtons
, show $ u ^. uvWorld . input . heldPos]
-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCam)
testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount
, show $ getSmoothScrollValue (u ^. uvWorld . input)
]
-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam)
-- (u ^. uvWorld . cWorld . lWorld)
-- , show a
-- , show $ u ^. uvWorld . input . mousePos
@@ -30,8 +32,8 @@ testStringInit u = [show $ u ^. uvWorld . input . mouseButtons
-- w = u ^. uvWorld
-- a = fromMaybe 0 $ do
-- cpos <- w ^? cWorld . lWorld . creatures . ix 0 . crPos
-- return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
-- - w ^. cWorld . cwCam . camRot
-- return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. wCam) -.- cpos)
-- - w ^. wCam . camRot
--[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
src/Dodge/Update.hs
+20 -11
View File
@@ -8,6 +8,7 @@ module Dodge.Update (updateUniverse) where
--import Dodge.InputFocus
import Dodge.SmoothScroll
import Color
import Control.Applicative
import Data.List
@@ -74,15 +75,21 @@ updateUniverse u =
. maybeOpenTerminal
. over (uvWorld . input . textInput) (const mempty)
. updateUniverseMid
. updateUseInput -- this should be pushed inside when the universe is paused etc
-- OR the keys should be tested "in game", so to speak
. updateUseInput -- this should be pushed inside when the universe is paused etc
-- OR the keys should be tested "in game", so to speak
. over uvWorld (updateCamera cfig)
. over (uvWorld . input) updateScrollTestValue
. over (uvWorld . cWorld . cClock) (+ 1)
. updateUniverseFirst
$ u
where
cfig = u ^. uvConfig
updateUniverseFirst :: Universe -> Universe
updateUniverseFirst u =
u
& uvWorld . input . smoothScrollAmount %~ calcSmoothScroll (u ^. uvWorld . input . scrollAmount)
& over (uvWorld . input) updateScrollTestValue
& over (uvWorld . cWorld . cClock) (+ 1)
updateWorldEventFlags :: Universe -> Universe
updateWorldEventFlags u =
(uvWorld . worldEventFlags .~ mempty)
@@ -105,11 +112,12 @@ gotoTerminal w = case _uvScreenLayers w of
_ -> w & uvScreenLayers .:~ InputScreen mempty "Enter command"
updateUniverseLast :: Universe -> Universe
updateUniverseLast u = u
& uvWorld . input . pressedKeys . each %~ f
& uvWorld . input . mouseMoving .~ False
& uvWorld . input . mouseButtons . each +~ 1
& uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
updateUniverseLast u =
u
& uvWorld . input . pressedKeys . each %~ f
& uvWorld . input . mouseMoving .~ False
& uvWorld . input . mouseButtons . each +~ 1
& uvWorld . input . heldPos %~ M.union (fmap (const mp) (u ^. uvWorld . input . mouseButtons))
where
mp = u ^. uvWorld . input . mousePos
f LongPress = LongPress
@@ -141,7 +149,7 @@ timeFlowUpdate u = case u ^. uvWorld . timeFlow of
DeathTime{} -> u
PausedTimeFlow _ itmloc -> over uvWorld (pauseTime itmloc) u
where
debugcamera = CamInGame /= (u ^. uvWorld . cWorld . cwCam . camControl)
debugcamera = CamInGame /= (u ^. uvWorld . wCam . camControl)
pauseTime :: Int -> World -> World
pauseTime itmloc w
@@ -262,6 +270,7 @@ advanceScrollAmount u =
u
& uvWorld . input . previousScrollAmount .~ _scrollAmount (_input $ _uvWorld u)
& uvWorld . input . scrollAmount .~ 0
& uvWorld . input . smoothScrollAmount %~ advanceSmoothScroll
updatePastWorlds :: World -> World
updatePastWorlds w = w & pastWorlds %~ (forceFoldable . take 100 . ((w ^. cWorld . lWorld) :))
@@ -287,7 +296,7 @@ zoneClouds :: World -> World
zoneClouds w = w & clZoning .~ foldl' (flip zoneCloud) mempty (w ^. cWorld . lWorld . clouds)
updateWorldSelect' :: World -> World
updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCam)) w
updateWorldSelect' w = over input (updateWorldSelect (w ^. wCam)) w
updateWorldSelect :: Camera -> Input -> Input
updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of
src/Dodge/Update/Camera.hs
+26 -21
View File
@@ -5,6 +5,7 @@ module Dodge.Update.Camera (
updateCamera,
) where
import Dodge.SmoothScroll
import SDL (MouseButton (..))
import Dodge.Base.Coordinate
import Dodge.InputFocus
@@ -28,7 +29,7 @@ import qualified SDL
{- Update the screen camera rotation and position, including any in rold scope/remote camera modifiers;
update where your avatar's view is from. -}
updateCamera :: Configuration -> World -> World
updateCamera cfig w = case w ^. cWorld . cwCam . camControl of
updateCamera cfig w = case w ^. wCam . camControl of
CamInGame -> updateInGameCamera cfig w
CamFloat -> updateFloatingCamera cfig w
CamPan -> w
@@ -36,9 +37,9 @@ updateCamera cfig w = case w ^. cWorld . cwCam . camControl of
updateFloatingCamera :: Configuration -> World -> World
updateFloatingCamera cfig w = w
& updateBounds cfig
& cWorld . cwCam %~ setViewDistance cfig
& cWorld . cwCam %~ translateFloatingCamera theinput
& cWorld . cwCam %~ zoomFloatingCamera theinput
& wCam %~ setViewDistance cfig
& wCam %~ translateFloatingCamera theinput
& wCam %~ zoomFloatingCamera theinput
where
theinput = w ^. input
@@ -54,14 +55,18 @@ translateFloatingCamera theinput cam = fromMaybe cam $ do
return $ cam & camCenter +~ thetran
& camViewFrom +~ thetran
zoomFloatingCamera :: Input -> Camera -> Camera
zoomFloatingCamera theinput cam = cam
& camZoom *~ (zoomSpeed ^^ negate (getSmoothScrollValue theinput))
-- & camZoom *~ (zoomSpeed ^^ negate (theinput ^. smoothScrollAmount))
updateInGameCamera :: Configuration -> World -> World
updateInGameCamera cfig w =
w
& updateBounds cfig
& over (cWorld . cwCam) (setViewDistance cfig)
& cWorld . cwCam %~ moveZoomCamera cfig (w ^. input) (you w)
& over (wCam) (setViewDistance cfig)
& wCam %~ moveZoomCamera cfig (w ^. input) (you w)
& updateScopeZoom
& rotateCamera cfig
@@ -129,7 +134,7 @@ updateScopeZoom' i w
wppointer = cWorld . lWorld . creatures . ix 0 . crInv . ix i . itScope
resetscope (ZoomScope _ _ _ defz bl) = ZoomScope (V2 0 0) 0 defz defz bl
resetscope otherAtt = otherAtt
mp = rotateV (w ^. cWorld . cwCam . camRot) $ _mousePos (_input w)
mp = rotateV (w ^. wCam . camRot) $ _mousePos (_input w)
doScopeZoom :: Point2 -> Scope -> Scope
doScopeZoom mp sc = case sc ^? scopeZoomChange of
@@ -194,25 +199,25 @@ rotateToOverlappingWall w =
p = _crPos (you w)
doWallRotate :: Wall -> World -> World
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCam . camRot)
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. wCam . camRot)
where
rotateUsing a
| b - b' > 0.01 = w & cWorld . cwCam . camRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cwCam . camRot -~ 0.01
| b - b' > 0.01 = w & wCam . camRot +~ 0.01
| b - b' < negate 0.01 = w & wCam . camRot -~ 0.01
| otherwise = w
where
--b = a * (2 / pi)
b = a * (4 / pi)
b' = fromIntegral (round b :: Int)
rotateCameraBy :: Float -> CWorld -> CWorld
rotateCameraBy :: Float -> World -> World
rotateCameraBy x w =
w
& cwCam . camRot +~ x
& rotateanyscope
& wCam . camRot +~ x
& cWorld %~ rotateanyscope
where
rotateanyscope = fromMaybe id $ do
i <- w ^? lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
i <- w ^? cWorld . lWorld . creatures . ix 0 . crManipulation . manObject . inInventory . ispItem
return $ lWorld . creatures . ix 0 . crInv . ix i
. itScope
. scopePos
@@ -221,8 +226,8 @@ rotateCameraBy x w =
rotateCamera :: Configuration -> World -> World
rotateCamera cfig w
| keydown SDL.ScancodeQ && keydown SDL.ScancodeE = w
| keydown SDL.ScancodeQ = over cWorld (rotateCameraBy 0.025) w
| keydown SDL.ScancodeE = over cWorld (rotateCameraBy (-0.025)) w
| keydown SDL.ScancodeQ = (rotateCameraBy 0.025) w
| keydown SDL.ScancodeE = (rotateCameraBy (-0.025)) w
| otherwise = ifConfigWallRotate cfig w
where
keydown scode = scode `M.member` _pressedKeys (_input w) && not (inInputFocus w)
@@ -249,7 +254,7 @@ farWallDistDirection p w =
boundPoints $
map f $ getViewpoints p (_cWorld w)
where
f q = (rotateV (negate (w ^. cWorld . cwCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
f q = (rotateV (negate (w ^. wCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
wls q = filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
@@ -257,7 +262,7 @@ findBoundDists :: Configuration -> World -> (Float, Float, Float, Float)
findBoundDists cfig w
| debugOn Bound_box_screen cfig = (hh, - hh, hw, - hw)
-- | otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . camPos . camCenter) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCam . camViewFrom) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. wCam . camViewFrom) w
where
hw = halfWidth cfig
hh = halfHeight cfig
@@ -265,8 +270,8 @@ findBoundDists cfig w
updateBounds :: Configuration -> World -> World
updateBounds cfig w =
w
& cWorld . cwCam . camBoundDist .~ bdists
& cWorld . cwCam . camBoundBox
.~ map ((+.+ w ^. cWorld . cwCam . camCenter) . rotateV (w ^. cWorld . cwCam . camRot)) (rectNSWE n s w' e)
& wCam . camBoundDist .~ bdists
& wCam . camBoundBox
.~ map ((+.+ w ^. wCam . camCenter) . rotateV (w ^. wCam . camRot)) (rectNSWE n s w' e)
where
bdists@(n, s, e, w') = findBoundDists cfig w
src/Dodge/Update/Scroll.hs
+1 -1
View File
@@ -30,7 +30,7 @@ updateWheelEvent yi w = case w ^. hud . hudElement of
(_, EquipOptions{}) -> w & rbOptions %~ scrollRBOption yi
(Nothing, _) -> closeObjScrollDir y w
(Just f, _) -> doHeldScroll f y (you w) w
| lbDown -> w & cWorld . cwCam . camZoom +~ y
| lbDown -> w & wCam . camZoom +~ y
| invKeyDown -> changeSwapSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ scrollAugInvSel yi w
DisplayInventory {_subInventory = ExamineInventory mi}
src/Dodge/WorldEffect.hs
+1 -1
View File
@@ -58,7 +58,7 @@ accessTerminal mtmid w = case mtmid of
torqueCr :: Float -> Int -> World -> World
torqueCr x cid w
| cid == 0 = set randGen g $ over (cWorld . cwCam . camRot) (+ rot) w
| cid == 0 = set randGen g $ over (wCam . camRot) (+ rot) w
| otherwise = set randGen g $ over (cWorld . lWorld . creatures . ix cid . crDir) (+ rot) w
where
(rot, g) = randomR (- x, x) $ _randGen w
src/Dodge/WorldEvent/Cloud.hs
+2 -2
View File
@@ -63,7 +63,7 @@ makeStartCloudAt :: Point3 -> World -> World
makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
shellTrailCloud :: Int -> Float -> Point3 -> World -> World
shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 30
shellTrailCloud age fadet = makeCloudAt (CloudColor (3 / 2) fadet (greyN 0.5)) 15 age 30
makeFlamerSmokeAt :: Point3 -> World -> World
makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
@@ -73,4 +73,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
spawnSmokeAtCursor :: World -> World
spawnSmokeAtCursor w = shellTrailCloud 400 100 (V3 x y 20) w
where
V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
V2 x y = mouseWorldPos (w ^. input) (w ^. wCam)