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

Separate out concrete part of world

Browse Source
This commit is contained in:
justin
2022-07-25 12:10:50 +01:00
parent 3354d108be
commit b2efbd2b3e
134 changed files with 933 additions and 930 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Debug/LinkDecoration.hs
+2 -2
View File
@@ -14,11 +14,11 @@ import Geometry.Vector
import Control.Lens
addRoomPolyDecorations :: [Room] -> World -> World
addRoomPolyDecorations rms w = w & decorations %~
addRoomPolyDecorations rms w = w & cWorld . decorations %~
IM.insertWithNewKeys (map roomPolyDecorations rms)
addRoomLinkDecorations :: [Room] -> World -> World
addRoomLinkDecorations rms w = w & decorations %~
addRoomLinkDecorations rms w = w & cWorld . decorations %~
IM.insertWithNewKeys (map roomLinkDecorations rms)
roomLinkDecorations :: Room -> Picture
src/Dodge/Debug/Picture.hs
+6 -6
View File
@@ -19,10 +19,10 @@ printRotPoint r p = color white
outsideScreenPolygon :: Configuration -> World -> [Point2]
outsideScreenPolygon cfig w = [tr,tl,bl,br]
where
scRot = rotateV (_cameraRot w)
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
scRot = rotateV (_cameraRot (_cWorld w))
scZoom p | _cameraZoom (_cWorld w) /= 0 = (1/_cameraZoom (_cWorld w)) *.* p
| otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ _cameraCenter w
scTran p = p +.+ _cameraCenter (_cWorld w)
tr = f 3 3
tl = f (-3) 3
br = f 3 (-3)
@@ -37,9 +37,9 @@ lineOnScreenCone cfig w p1 p2 = pointInPolygon p1 sp
|| any (isJust . uncurry (intersectSegSeg p1 p2)) sps
where
sp' = screenPolygon cfig w
vp = _cameraViewFrom w
vp = _cameraViewFrom (_cWorld w)
sp | pointInPolygon vp sp' = sp'
| otherwise = orderPolygon (_cameraViewFrom w : sp')
| otherwise = orderPolygon (_cameraViewFrom (_cWorld w) : sp')
sps = zip sp (tail sp ++ [head sp])
pointOnScreen :: Configuration -> World -> Point2 -> Bool
@@ -52,7 +52,7 @@ drawWallFace cfig w wall
where
(x,y) = _wlLine wall
points = extendConeToScreenEdge cfig w sightFrom (x,y)
sightFrom = _cameraViewFrom w
sightFrom = _cameraViewFrom (_cWorld w)
extendConeToScreenEdge :: Configuration -> World -> Point2 -> (Point2,Point2) -> [Point2]
extendConeToScreenEdge cfig w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] ++ borderPs ++ cornerPs
src/Dodge/Debug/Terminal.hs
+12 -12
View File
@@ -31,16 +31,16 @@ applyTerminalString ss = case ss of
applyTerminalCommand :: String -> Universe -> Universe
applyTerminalCommand s = case s of
"NOCLIP" -> uvConfig . debug_booleans . at Noclip %~ toggleJust
"LOADME" -> (uvWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LOADME" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ stackedInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"LM" -> applyTerminalCommand "LOADME"
"LT" -> applyTerminalCommand "LOADTEST"
['L',x] -> (uvWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" -> (uvWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . creatures . ix 0 . crInvCapacity .~ 50)
['L',x] -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ IM.fromList (zip [0..] $ inventoryX x))
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
"GODON" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Crystal
"GODOFF" -> uvWorld . cWorld . creatures . ix 0 . crMaterial .~ Flesh
"LOADTEST" -> (uvWorld . cWorld . creatures . ix 0 . crInv .~ testInventory)
. (uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ 50)
_ -> id
--applyTerminalString' ('s': 'e': 't': '_': 'h': 'p': ' ': hp)
-- | isNothing (readMaybe hp :: Maybe Int) = id
@@ -85,10 +85,10 @@ applySetTerminalString :: String -> Universe -> Universe
applySetTerminalString [] = id
applySetTerminalString var = case key' of
"" -> showTerminalError ("set "++var) ("Unable to read as argument as float: " ++ val)
"hp" -> uvWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"mass" -> uvWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
"hp" -> uvWorld . cWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"invcap" -> uvWorld . cWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
"mass" -> uvWorld . cWorld . creatures . ix 0 . crMass .~ fromJust val'
"mvspeed" -> uvWorld . cWorld . creatures . ix 0 . crMvType .mvSpeed .~ fromJust val'
_ -> showTerminalError ("set "++var) ("Invalid set command: " ++ key) -- never reached?
where
(key, val) = getSplitString var