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

Start to generalise text input to "terminal signal" input

Browse Source
This commit is contained in:
justin
2023-03-26 13:57:26 +01:00
parent cfb0a49059
commit 082ce9c9a1
39 changed files with 171 additions and 165 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 . cwCamPos . camViewFrom
vPos = w ^. cWorld . cwCam . camViewFrom
overlapCircWalls ::
Point2 ->
src/Dodge/Base/Coordinate.hs
+3 -3
View File
@@ -5,7 +5,7 @@ module Dodge.Base.Coordinate (
) where
import Control.Lens
import Dodge.Data.CamPos
import Dodge.Data.Camera
import Dodge.Data.HUD
import Dodge.Data.Input
import Geometry
@@ -22,7 +22,7 @@ import Geometry
- These have to be scaled according to the size of the window to get actual screen positions.
- This allows for line thicknesses etc to correspond to pixel sizes.
-}
worldPosToScreen :: CamPos -> Point2 -> Point2
worldPosToScreen :: Camera -> Point2 -> Point2
worldPosToScreen cam =
rotateV (negate $ cam ^. camRot)
. ((cam ^. camZoom) *.*)
@@ -42,7 +42,7 @@ cartePosToScreen thehud = doRotate . doZoom . doTranslate
--crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
-- | The mouse position in world coordinates.
mouseWorldPos :: Input -> CamPos -> Point2
mouseWorldPos :: Input -> Camera -> Point2
mouseWorldPos inp cam =
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos inp)
src/Dodge/Base/Window.hs
+3 -3
View File
@@ -7,13 +7,13 @@ module Dodge.Base.Window (
screenBox,
) where
import Dodge.Data.CamPos
import Dodge.Data.Camera
import Dodge.Data.Config
import Geometry
import Control.Lens
-- | A box covering the screen in world coordinates
screenPolygon :: Configuration -> CamPos -> [Point2]
screenPolygon :: Configuration -> Camera -> [Point2]
screenPolygon cfig w = map (scTran . scRot . scZoom) $ screenBox cfig
where
scRot = rotateV (w ^. camRot)
@@ -29,7 +29,7 @@ screenPolygonBord ::
-- | Y border
Float ->
Configuration ->
CamPos ->
Camera ->
[Point2]
screenPolygonBord xbord ybord cfig w = [tr, tl, bl, br]
where
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 . cwCamPos))
return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam))
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 . cwCamPos)
p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos)
p1 = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos . camViewFrom
theScale = 0.15 / (w ^. cWorld . cwCamPos . camZoom)
campos = w ^. cWorld . cwCam . camViewFrom
theScale = 0.15 / (w ^. cWorld . cwCam . 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 . cwCamPos . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. cWorld . cwCamPos . camRot) $ normalizeV movDir
dir = fmap ((w ^. cWorld . cwCam . camRot) +) (safeArgV movDir)
movAbs = rotateV (w ^. cWorld . cwCam . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = fromMaybe
(argV (_mousePos (_input w)) + (w ^. cWorld . cwCamPos . camRot) )
(argV (_mousePos (_input w)) + (w ^. cWorld . cwCam . camRot) )
$ do
itRef <- cr ^? crManipulation . manObject . inInventory . ispItem
_ <- cr ^? crInv . ix itRef . itScope . scopePos
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- _crPos cr
return . argV $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- _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 . cwCamPos . camRot -~ rotation
w & cWorld . cwCam . camRot -~ rotation
& input . clickMousePos .~ _mousePos (_input w)
| otherwise = w
where
src/Dodge/Data/CWorld.hs
+3 -3
View File
@@ -6,7 +6,7 @@
module Dodge.Data.CWorld (
module Dodge.Data.CWorld,
module Dodge.Data.LWorld,
module Dodge.Data.CamPos
module Dodge.Data.Camera
) where
import Data.Tile
@@ -18,13 +18,13 @@ import Data.Aeson.TH
--import Dodge.Data.GenParams
import Dodge.GameRoom
import Geometry.ConvexPoly
import Dodge.Data.CamPos
import Dodge.Data.Camera
import qualified Data.IntSet as IS
import Data.Graph.Inductive
data CWorld = CWorld
{ _lWorld :: LWorld
, _cwCamPos :: CamPos
, _cwCam :: Camera
, _cwGen :: CWGen
, _cClock :: Int
, _seenWalls :: IS.IntSet
src/Dodge/Data/CamPos.hs
-28
View File
@@ -1,28 +0,0 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.CamPos where
import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Geometry.Data
data CamPos = CamPos
{ _camCenter :: Point2
, _camRot :: Float
, _camZoom :: Float -- smaller values zoom out
, _camItemZoom :: Float
, _camDefaultZoom :: Float
, _camViewFrom :: Point2
, _camViewDistance :: Float
, _camBoundBox :: [Point2]
, _camBoundDist :: (Float, Float, Float, Float) -- NSEW, S and W negative
}
makeLenses ''CamPos
concat
<$> mapM
(deriveJSON defaultOptions)
[ ''CamPos ]
src/Dodge/Data/Input.hs
+19 -5
View File
@@ -1,24 +1,27 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Input where
import Control.Lens
import qualified Data.Map.Strict as M
import Geometry.Data
import SDL (MouseButton, Scancode)
data PressType = InitialPress
data PressType
= InitialPress
| ShortPress
| LongPress
deriving (Eq,Show)
deriving (Eq, Show)
data Input = Input
{ _mousePos :: Point2 -- in pixels, from the center of the screen
, _mouseMoving :: Bool
, _pressedKeys :: M.Map Scancode PressType
, _mouseButtons :: M.Map MouseButton Bool -- shortpress False, repeatpress True
, _scrollAmount :: Int
, _scrollAmount :: Int
, _previousScrollAmount :: Int
, _lLine :: (Point2, Point2)
, _rLine :: (Point2, Point2)
@@ -26,9 +29,20 @@ data Input = Input
, _lSelect :: Point2
, _rSelect :: Point2
, _clickMousePos :: Point2
, _textInput :: String
, _textInput :: [Either TermSignal Char]
, _scrollTestFloat :: Float
, _scrollTestInt :: Int
}
data TermSignal
= TSescape
| TSreturn
| TSbackspace
| TSdelete
| TStab
| TSleft
| TSright
| TSup
| TSdown
makeLenses ''Input
src/Dodge/Debug/Picture.hs
+8 -8
View File
@@ -17,7 +17,7 @@ printRotPoint r p =
. uncurryV translate p
$ pictures [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: Configuration -> CamPos -> [Point2]
outsideScreenPolygon :: Configuration -> Camera -> [Point2]
outsideScreenPolygon cfig w = [tr, tl, bl, br]
where
scRot = rotateV (w ^. camRot)
@@ -39,14 +39,14 @@ lineOnScreenCone cfig w p1 p2 =
|| pointInPolygon p2 sp
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
where
sp' = screenPolygon cfig (w ^. cWorld . cwCamPos)
vp = w ^. cWorld . cwCamPos . camViewFrom
sp' = screenPolygon cfig (w ^. cWorld . cwCam)
vp = w ^. cWorld . cwCam . camViewFrom
sp
| pointInPolygon vp sp' = sp'
| otherwise = orderPolygon ((w ^. cWorld . cwCamPos . camViewFrom) : sp')
| otherwise = orderPolygon ((w ^. cWorld . cwCam . camViewFrom) : sp')
sps = zip sp (tail sp ++ [head sp])
pointOnScreen :: Configuration -> CamPos -> Point2 -> Bool
pointOnScreen :: Configuration -> Camera -> Point2 -> Bool
pointOnScreen cfig w p = pointInPolygon p $ screenPolygon cfig w
drawWallFace :: Configuration -> World -> Wall -> Picture
@@ -56,13 +56,13 @@ drawWallFace cfig w wall
where
(x, y) = _wlLine wall
points = extendConeToScreenEdge cfig w sightFrom (x, y)
sightFrom = w ^. cWorld . cwCamPos . camViewFrom
sightFrom = w ^. cWorld . cwCam . 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 . cwCamPos)
scpoly = reverse $ screenPolygon cfig (w ^. cWorld . cwCam)
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 . cwCamPos)
$ screenPolygon cfig (w ^. cWorld . cwCam)
src/Dodge/Default/World.hs
+4 -3
View File
@@ -62,9 +62,9 @@ defaultCWGen =
, _cwgRoomClipping = []
}
defaultCWCam :: CamPos
defaultCWCam :: Camera
defaultCWCam =
CamPos
Camera
{ _camCenter = V2 0 0
, _camRot = 0
, _camZoom = 1
@@ -74,12 +74,13 @@ defaultCWCam =
, _camItemZoom = 1
, _camBoundBox = square 100
, _camBoundDist = (100, -100, 100, -100)
, _camControl = CamInGame
}
defaultCWorld :: CWorld
defaultCWorld =
CWorld
{ _cwCamPos = defaultCWCam
{ _cwCam = defaultCWCam
, _lWorld = defaultLWorld
, _cwGen = defaultCWGen
, _cClock = 0
src/Dodge/Event/Input.hs
+12 -3
View File
@@ -1,4 +1,5 @@
-- | Deals with events that only affect Input.
-- | Capture input events, store them in structures for later use.
-- Should not update the world other than this.
module Dodge.Event.Input (
handleKeyboardEvent,
handleTextInput,
@@ -15,19 +16,27 @@ import SDL
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
-- dealt with separately
handleTextInput :: String -> Input -> Input
handleTextInput text = textInput %~ (++ text)
handleTextInput text = textInput %~ (++ map Right text)
-- | Handles keyboard press and release.
handleKeyboardEvent :: KeyboardEventData -> Input -> Input
handleKeyboardEvent kev = case keyboardEventKeyMotion kev of
Released -> pressedKeys . at scode .~ Nothing
Pressed -> pressedKeys . at scode ?~ val
Pressed -> (pressedKeys . at scode ?~ val)
. addTermSignal scode
where
val
| keyboardEventRepeat kev = LongPress
| otherwise = InitialPress
scode = (keysymScancode . keyboardEventKeysym) kev
addTermSignal :: Scancode -> Input -> Input
addTermSignal sc = case sc of
ScancodeBackspace -> textInput .:~ Left TSbackspace
ScancodeEscape -> textInput .:~ Left TSescape
ScancodeReturn -> textInput .:~ Left TSreturn
_ -> id
handleMouseMotionEvent :: MouseMotionEventData -> Configuration -> Input -> Input
handleMouseMotionEvent mmev cfig =
set mousePos themousepos
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 . cwCamPos) -.- p)
a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- 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 . cwCamPos)
let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos . camZoom .~ 10
& cWorld . cwCam . 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 . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos . camRot +~ rot
& cWorld . cwCam . 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 . cwCamPos . camRot +~ rot'
& cWorld . cwCam . 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 . cwCamPos . camRot) (+ rot) $ feff item cr w
| cid == 0 = set randGen g $ over (cWorld . cwCam . 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 . cwCamPos . camRot) (+ rot) w
| cid == 0 = set randGen g $ over (cWorld . cwCam . 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 . cwCamPos)) (_crPos cr) < aimingMuzzlePos cr item =
| dist (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) (_crPos cr) < aimingMuzzlePos cr item =
argV
( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
-.- (_crPos cr +.+ pos)
)
| otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos) -.- (_crPos cr +.+ pos))
| otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- (_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 . cwCamPos . camRot .~ (takeOne [0, 0.5 * pi, pi, 1.5 * pi] & evalState $ _randGen w)
randomCompass w = w & cWorld . cwCam . 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 . cwCamPos) -.- cpos)
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
mayp2 = bouncePoint (const True) 1 cpos p1 w
addBoostShockwave ::
src/Dodge/Menu.hs
+12 -10
View File
@@ -219,18 +219,20 @@ displayControls = titleOptionsNoWrite "CONTROLS" $ map (Toggle id . const . uncu
listControls :: [(String, String)]
listControls =
[ ("wasd", "MOVEMENT")
, ("[rmb]", "AIM")
, ("[rmb+lmb]", "SHOOT/USE/EQUIP SELECTED")
, ("[lmb]", "USE EQUIPPED")
, ("[wheelscroll]", "SELECT ITEM")
, ("[space]", "PICKUP ITEM")
[ ("w|a|s|d", "MOVEMENT")
, ("<rmb>", "AIM")
, ("<rmb>&<lmb>", "SHOOT/USE/EQUIP SELECTED")
, ("<lmb>", "USE EQUIPPED")
, ("<wheelscroll>", "SELECT ITEM")
, ("<space>", "PICKUP ITEM")
, ("m", "DISPLAY MAP")
, ("f", "DROP ITEM")
, ("c", "COMBINE ITEMS")
, ("x", "EXAMINE ITEMS")
, ("c[esc]", "PAUSE")
, ("qe", "ROTATE CAMERA")
, ("F5", "QUICKSAVE")
, ("F9", "QUICKLOAD")
, ("c|<esc>", "PAUSE AND DISPLAY MENU")
, ("q|e", "ROTATE CAMERA")
, ("<F2>", "PAUSE AND FLOAT CAMERA")
, ("<F3>", "PAUSE AND PAN CAMERA")
, ("<F5>", "QUICKSAVE")
, ("<F9>", "QUICKLOAD")
]
src/Dodge/Picture/SizeInvariant.hs
+6 -6
View File
@@ -13,7 +13,7 @@ import Picture
--fixedSizePicAt ::
-- Picture ->
-- Point2 ->
-- CamPos ->
-- Camera ->
-- Picture
--fixedSizePicAt pic p w =
-- setLayer DebugLayer
@@ -35,7 +35,7 @@ import Picture
-- Picture ->
-- Point2 ->
-- Configuration ->
-- CamPos ->
-- Camera ->
-- Picture
--fixedSizePicClamp xbord ybord pic p cfig w =
-- setLayer DebugLayer
@@ -70,16 +70,16 @@ fixedSizePicClampArrow xbord ybord pic p cfig w =
, setLayer DebugLayer . color white . setDepth 20 $ arrowPic
]
where
winps = screenPolygon cfig (w ^. cwCamPos)
bords = screenPolygonBord xbord ybord cfig (w ^. cwCamPos)
winps = screenPolygon cfig (w ^. cwCam)
bords = screenPolygonBord xbord ybord cfig (w ^. cwCam)
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 ^. cwCamPos . camCenter
theScale = 1 / (w ^. cwCamPos . camZoom)
campos = w ^. cwCam . camCenter
theScale = 1 / (w ^. cwCam . 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 . cwCamPos . camRot) + argV (_mousePos (_input w))
= (w ^. cWorld . cwCam . 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 . cwCamPos . camRot
camzoom = w ^. cWorld . cwCamPos . camZoom
trans = w ^. cWorld . cwCamPos . camCenter
rot = w ^. cWorld . cwCam . camRot
camzoom = w ^. cWorld . cwCam . camZoom
trans = w ^. cWorld . cwCam . camCenter
wins = V2 (windowXFloat cfig) (windowYFloat cfig)
(windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
lightPoints = lightsToRender cfig (w ^. cWorld . cwCamPos) (w ^. cWorld . lWorld)
viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCamPos . camViewFrom
lightPoints = lightsToRender cfig (w ^. cWorld . cwCam) (w ^. cWorld . lWorld)
viewFroms@(V2 vfx vfy) = w ^. cWorld . cwCam . camViewFrom
shadV = _pictureShaders pdata
nFls = w ^. cWorld . numberFloorVerxs
-- bind as much data into vbos as feasible at this point
src/Dodge/Render/InfoBox.hs
+3 -3
View File
@@ -4,14 +4,14 @@ module Dodge.Render.InfoBox
) where
import Dodge.Base
import Dodge.Data.CamPos
import Dodge.Data.Camera
import Dodge.Data.Config
import Dodge.Render.Connectors
import Dodge.Render.List
import Geometry
import Picture
renderInfoListAt :: Float -> Float -> Configuration -> CamPos -> (Point2, [String]) -> Picture
renderInfoListAt :: Float -> Float -> Configuration -> Camera -> (Point2, [String]) -> Picture
renderInfoListAt x y cfig cam (p, ss) =
renderListAt x y cfig (zip ss (repeat white))
<> color white (lConnect (V2 (x - hw) (hh -25 - y)) (worldPosToScreen cam p))
@@ -20,7 +20,7 @@ renderInfoListAt x y cfig cam (p, ss) =
hw = halfWidth cfig
hh = halfHeight cfig
renderInfoListsAt :: Float -> Float -> Configuration -> CamPos -> [(Point2, [String])] -> Picture
renderInfoListsAt :: Float -> Float -> Configuration -> Camera -> [(Point2, [String])] -> Picture
renderInfoListsAt x y cfig w =
fst . foldr f (mempty, 0)
where
src/Dodge/Render/Lights.hs
+2 -2
View File
@@ -5,13 +5,13 @@ module Dodge.Render.Lights (
import Data.List (sortOn)
import Data.Maybe
import Dodge.Data.LWorld
import Dodge.Data.CamPos
import Dodge.Data.Camera
import Dodge.Data.Config
import Geometry
import qualified IntMapHelp as IM
import Control.Lens
lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)]
lightsToRender :: Configuration -> Camera -> LWorld -> [(Point3, Float, Point3)]
{-# INLINE lightsToRender #-}
lightsToRender cfig campos w = take (fromEnum $ cfig ^. graphics_num_shadow_casters) $
sortOn (\(_,x,_) -> negate x) $
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 . cwCamPos) -.- cpos)
- w ^. cWorld . cwCamPos . camRot
argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
- w ^. cWorld . cwCam . camRot
mousePlus :: Picture
mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
src/Dodge/Render/ShapePicture.hs
+17 -17
View File
@@ -83,7 +83,7 @@ drawSweep cr w = fromMaybe mempty $ do
cdir = _crDir cr
rot = campos ^. camRot
p = _crPos cr
campos = w ^. cWorld . cwCamPos
campos = w ^. cWorld . cwCam
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 . cwCamPos . camBoundBox)
| otherwise = dist (w ^. cWorld . cwCamPos . camCenter) p < (w ^. cWorld . cwCamPos . camViewDistance)
| debugOn Close_shape_culling cfig = pointInPolygon p (w ^. cWorld . cwCam . camBoundBox)
| otherwise = dist (w ^. cWorld . cwCam . camCenter) p < (w ^. cWorld . cwCam . camViewDistance)
extraPics :: Configuration -> Universe -> Picture
extraPics cfig u =
@@ -243,7 +243,7 @@ drawWallsNearYou w = fromMaybe mempty $ do
drawWallsNearCursor :: World -> Picture
drawWallsNearCursor w =
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCamPos $ _cWorld w)) w
setLayer DebugLayer $ foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_cwCam $ _cWorld 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 . cwCamPos . camViewFrom
p = w ^. cWorld . cwCam . camViewFrom
drawZoneNearPointCursor :: World -> Picture
drawZoneNearPointCursor w =
foldMap (drawZoneCol orange 50) ps
where
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos . camViewFrom
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
cvf = w ^. cWorld . cwCam . camViewFrom
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos . camViewFrom, p]
<> line [w ^. cWorld . cwCam . 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 . cwCamPos . camBoundBox
(x : xs) = w ^. cWorld . cwCam . camBoundBox
ppDraw :: PressPlate -> Picture
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
@@ -375,7 +375,7 @@ soundPic cfig w s = fixedSizePicClampArrow 50 50 thePic p cfig (w ^. cWorld)
where
p = _soundPos s
thePic =
rotate (w ^. cWorld . cwCamPos . camRot)
rotate (w ^. cWorld . cwCam . camRot)
. scale theScale theScale
. centerText
. soundToOnomato
@@ -391,7 +391,7 @@ drawMousePosition w =
. text
$ shortPoint2 mwp
where
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
p = worldPosToScreen (w ^. cWorld . cwCam) $ 0.5 *.* uncurry (+.+) (_wlLine wl)
edgeToPic :: [Point2] -> PathEdge -> Picture
edgeToPic poly pe
@@ -417,13 +417,13 @@ edgeToPic poly pe
drawPathing :: Configuration -> World -> Picture
drawPathing cfig w =
setLayer DebugLayer $
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCamPos)) . (^?! _3)) (FGL.labEdges gr)
foldMap (edgeToPic (screenPolygon cfig (w ^. cWorld . cwCam)) . (^?! _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
gr = w ^. cWorld . pathGraph
crDisplayInfo :: Configuration -> CamPos -> Creature -> Maybe (Point2, [String])
crDisplayInfo :: Configuration -> Camera -> Creature -> Maybe (Point2, [String])
crDisplayInfo cfig cam cr
| _crID cr == 0 = Nothing
| crOnScreen =
@@ -454,7 +454,7 @@ drawCrInfo cfig w =
renderInfoListsAt (2 * hw - 400) 0 cfig cam $
mapMaybe (crDisplayInfo cfig cam) $ IM.elems $ w ^. lWorld . creatures
where
cam = w ^. cwCamPos
cam = w ^. cwCam
hw = halfWidth cfig
viewBoundaries :: CWorld -> Picture
@@ -463,7 +463,7 @@ viewBoundaries w =
color green (foldMap (polygonWire . _grBound) grs)
<> color yellow (foldMap (\q -> line [p, q]) $ getViewpoints p w)
where
p = w ^. cwCamPos . camViewFrom
p = w ^. cwCam . camViewFrom
grs = filter (pointInOrOnPolygon p . _grBound) (_cwgGameRooms $ _cwGen w)
viewClipBounds :: Configuration -> World -> Picture
src/Dodge/SoundLogic.hs
+2 -2
View File
@@ -163,9 +163,9 @@ soundAngle p w
. radToDeg
. normalizeAngle
. (+ pi)
$ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCamPos . camRot)
$ argV (vNormal (p -.- earPos)) - (w ^. cWorld . cwCam . camRot)
where
earPos = w ^. cWorld . cwCamPos . camViewFrom
earPos = w ^. cWorld . cwCam . 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 . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos)
& ctPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
& 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 . cwCamPos)) Just
& ctPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)) 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 . cwCamPos) -.- sp)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- 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 . cwCamPos)
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
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 . cwCamPos
cam = w ^. cWorld . cwCam
targetDraw :: Picture -> Creature -> Configuration -> World -> Picture
targetDraw f cr _ _ = fromMaybe mempty $ do
src/Dodge/TestString.hs
+3 -3
View File
@@ -15,7 +15,7 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM
testStringInit :: Universe -> [String]
testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCamPos)
testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . cwCam)
(u ^. uvWorld . cWorld . lWorld)
, show a
, show $ u ^. uvWorld . input . mousePos
@@ -27,8 +27,8 @@ testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld
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 . cwCamPos) -.- cpos)
- w ^. cWorld . cwCamPos . camRot
return . toClosestMultiple (pi/ 8) $ argV (mouseWorldPos (w ^. input) (w ^. cWorld . cwCam) -.- cpos)
- w ^. cWorld . cwCam . 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
+4 -3
View File
@@ -74,7 +74,8 @@ updateUniverse u =
. maybeOpenTerminal
. over (uvWorld . input . textInput) (const mempty)
. updateUniverseMid
. updateUseInput
. 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)
@@ -281,9 +282,9 @@ 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 . cwCamPos)) w
updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . cwCam)) w
updateWorldSelect :: CamPos -> Input -> Input
updateWorldSelect :: Camera -> Input -> Input
updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of
(Just False, Nothing) ->
inp & lLine . _1 .~ mwp
src/Dodge/Update/Camera.hs
+21 -15
View File
@@ -26,15 +26,21 @@ 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 =
updateCamera cfig w = case w ^. cWorld . cwCam . camControl of
CamInGame -> updateInGameCamera cfig w
CamFloat -> w
CamPan -> w
updateInGameCamera :: Configuration -> World -> World
updateInGameCamera cfig w =
w
& updateBounds cfig
& over (cWorld . cwCamPos) (setViewDistance cfig)
& cWorld . cwCamPos %~ moveZoomCamera cfig (w ^. input) (you w)
& over (cWorld . cwCam) (setViewDistance cfig)
& cWorld . cwCam %~ moveZoomCamera cfig (w ^. input) (you w)
& updateScopeZoom
& rotateCamera cfig
moveZoomCamera :: Configuration -> Input -> Creature -> CamPos -> CamPos
moveZoomCamera :: Configuration -> Input -> Creature -> Camera -> Camera
moveZoomCamera cfig theinput cr campos =
campos
& camCenter .~ newcen
@@ -98,7 +104,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 . cwCamPos . camRot) $ _mousePos (_input w)
mp = rotateV (w ^. cWorld . cwCam . camRot) $ _mousePos (_input w)
doScopeZoom :: Point2 -> Scope -> Scope
doScopeZoom mp sc = case sc ^? scopeZoomChange of
@@ -163,11 +169,11 @@ rotateToOverlappingWall w =
p = _crPos (you w)
doWallRotate :: Wall -> World -> World
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCamPos . camRot)
doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cWorld . cwCam . camRot)
where
rotateUsing a
| b - b' > 0.01 = w & cWorld . cwCamPos . camRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cwCamPos . camRot -~ 0.01
| b - b' > 0.01 = w & cWorld . cwCam . camRot +~ 0.01
| b - b' < negate 0.01 = w & cWorld . cwCam . camRot -~ 0.01
| otherwise = w
where
--b = a * (2 / pi)
@@ -177,7 +183,7 @@ doWallRotate wl w = rotateUsing $ (argV . uncurry (-.-) $ _wlLine wl) - (w ^. cW
rotateCameraBy :: Float -> CWorld -> CWorld
rotateCameraBy x w =
w
& cwCamPos . camRot +~ x
& cwCam . camRot +~ x
& rotateanyscope
where
rotateanyscope = fromMaybe id $ do
@@ -208,7 +214,7 @@ clipZoom ::
Float
clipZoom = min 20 . max 0.2
setViewDistance :: Configuration -> CamPos -> CamPos
setViewDistance :: Configuration -> Camera -> Camera
setViewDistance cfig w =
w & camViewDistance
.~ sqrt (halfWidth cfig ** 2 + halfHeight cfig ** 2) / (w ^. camZoom)
@@ -218,7 +224,7 @@ farWallDistDirection p w =
boundPoints $
map f $ getViewpoints p (_cWorld w)
where
f q = (rotateV (negate (w ^. cWorld . cwCamPos . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
f q = (rotateV (negate (w ^. cWorld . cwCam . camRot)) . (-.- p)) (foldl' findPoint q (wls q))
wls q = filter wlIsOpaque $ wlsNearSeg p q w
findPoint q = fromMaybe q . uncurry (intersectSegSeg p q) . _wlLine
@@ -226,7 +232,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 . cwCamPos . camViewFrom) w
| otherwise = fromMaybe (0, 0, 0, 0) $ farWallDistDirection (w ^. cWorld . cwCam . camViewFrom) w
where
hw = halfWidth cfig
hh = halfHeight cfig
@@ -234,8 +240,8 @@ findBoundDists cfig w
updateBounds :: Configuration -> World -> World
updateBounds cfig w =
w
& cWorld . cwCamPos . camBoundDist .~ bdists
& cWorld . cwCamPos . camBoundBox
.~ map ((+.+ w ^. cWorld . cwCamPos . camCenter) . rotateV (w ^. cWorld . cwCamPos . camRot)) (rectNSWE n s w' e)
& cWorld . cwCam . camBoundDist .~ bdists
& cWorld . cwCam . camBoundBox
.~ map ((+.+ w ^. cWorld . cwCam . camCenter) . rotateV (w ^. cWorld . cwCam . camRot)) (rectNSWE n s w' e)
where
bdists@(n, s, e, w') = findBoundDists cfig w
src/Dodge/Update/Input/InGame.hs
+3 -3
View File
@@ -8,6 +8,7 @@ import qualified Data.Map.Strict as M
import Data.Maybe
import Dodge.Base.You
import Dodge.Button.Event
import Dodge.Camera
import Dodge.Creature.Action
import Dodge.Data.Combine
import Dodge.Data.Universe
@@ -46,9 +47,6 @@ updateUseInputInGame h u = case h of
(uvWorld . worldEventFlags . at InventoryChange ?~ ()) . maybeExitCombine $
over uvWorld (tryCombine sss) u
& uvWorld . worldEventFlags . at CombineInventoryChange ?~ ()
-- _ -> case regexFocus w of
-- Nothing -> M.foldlWithKey' updateKeyInGame u pkeys
-- Just (filtpoint,selpoint,i) -> u & uvWorld . p %~ doRegexInput
_
| inInvRegex (u ^. uvWorld) ->
u & uvWorld . hud . hudElement . diSections %~ doRegexInput u (-1)
@@ -108,6 +106,8 @@ updateKeyInGame uv sc pt = case pt of
updateInitialPressInGame :: Universe -> Scancode -> Universe
updateInitialPressInGame uv sc = case sc of
ScancodeF2 -> pauseAndFloatCam uv
ScancodeF3 -> pauseAndPanCam uv
ScancodeF5 -> doQuicksave uv
ScancodeF9 -> doQuickload uv
ScancodeEscape -> pauseGame uv
src/Dodge/Update/Input/Text.hs
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Update.Input.Text (
doTextInputOver',
) where
import Data.Either
import Data.Char
import Dodge.Data.Universe
import LensHelp
@@ -13,7 +14,7 @@ doTextInputOver p u = doTextInputOver' u p u
doTextInputOver' :: Universe -> ASetter' a String -> a -> a
doTextInputOver' u p x =
x & p %~ (++ map toUpper str)
x & p %~ (++ map toUpper (rights str))
& checkBackspace
where
str = u ^. uvWorld . input . textInput
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 . cwCamPos . camZoom +~ y
| lbDown -> w & cWorld . cwCam . 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 . cwCamPos . camRot) (+ rot) w
| cid == 0 = set randGen g $ over (cWorld . cwCam . 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
+1 -1
View File
@@ -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 . cwCamPos)
V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
src/Dodge/Zoning/World.hs
+2 -2
View File
@@ -2,11 +2,11 @@ module Dodge.Zoning.World
( zoneOfSight
) where
import Dodge.Data.CamPos
import Dodge.Data.Camera
import Geometry.Data
import Control.Lens
zoneOfSight :: Float -> CamPos -> [Int2]
zoneOfSight :: Float -> Camera -> [Int2]
zoneOfSight s w =
[ V2 a b
| a <- [minimum xs .. maximum xs]