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

Merge branch 'master' into testing

Browse Source
This commit is contained in:
Ross
2021-04-01 23:00:14 +01:00
parent 5e885b879b cbcc0f700b
commit fdebeb9aba
20 changed files with 290 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+6 -5
View File
@@ -280,6 +280,12 @@ zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f
$ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
where f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
{-# INLINE zoneOfLine' #-}
zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
where (x,y) = zoneOfPoint a
(x',y') = zoneOfPoint b
--zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f
-- $ digitalLine (zoneOfPoint (aa-n,ab-n)) (zoneOfPoint (ba-n,bb-n))
-- where f (x,y) = [(p,r) | p <-[x,x+1] , r<-[y,y+1]]
@@ -294,11 +300,6 @@ expandLine xs = IM.map expandSet
--expandSet s = s
where mk = IS.findMax s
zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
{-# INLINE zoneOfLine' #-}
zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
where (x,y) = zoneOfPoint a
(x',y') = zoneOfPoint b
--zoneOfLine a b = concatMap zoneNearPoint $ divideLine (2 * zoneSize) a b
--zoneOfLine a b = concatMap zoneNearPoint $ divideLine zoneSize a b
src/Dodge/Creature.hs
+1
View File
@@ -254,6 +254,7 @@ startCr = defaultCreature
(
[pistol
,blinkGun
,spawnGun lamp
,flameGrenade
,teslaGrenade
,autoGun
src/Dodge/Creature/Inanimate.hs
+2 -1
View File
@@ -5,6 +5,7 @@ import Dodge.Base
import Dodge.Default
import Dodge.CreatureState
import Dodge.LightSources
import Dodge.WorldEvent.Flash
import Dodge.WorldEvent.Sound
@@ -34,7 +35,7 @@ updateLamp :: Int -> CRUpdate
updateLamp i = unrandUpdate handleLS internalUpdate
where
handleLS cr w
| _crHP cr < 0 = mkSoundBreakGlass w & lightSources %~ IM.delete i
| _crHP cr < 0 = explosionFlashAt (_crPos cr) $ mkSoundBreakGlass w & lightSources %~ IM.delete i
| otherwise = w & lightSources . ix i . lsPos .~ _crPos cr
internalUpdate cr
| _crHP cr < 0 = Nothing
src/Dodge/Item/Weapon.hs
+22 -1
View File
@@ -82,6 +82,7 @@ pistol = Weapon
, _itInvColor = white
}
defaultGun = pistol
defaultAutoGun = autoGun {_itScrollUp = const id
, _itScrollDown = const id, _itInvDisplay = basicWeaponDisplay}
effectGun :: String -> (Int -> World -> World) -> Item
@@ -900,13 +901,14 @@ aFlame a cid w
w
where
(a2,g) = randomR (-0.1,0.1) (_randGen w)
(t,_) = randomR (99,101) (_randGen w)
angle = min flamerAngle $ max (-flamerAngle) (a + a2)
cr = (_creatures w IM.! cid)
dir = _crDir cr + angle
pos = _crPos cr +.+ ((_crRad cr + 2.9) *.* unitVectorAtAngle (_crDir cr))
w1 = set randGen g w
vel = (_crPos cr -.- _crOldPos cr) +.+ 4 *.* unitVectorAtAngle dir
insertFlame = makeFlame pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
insertFlame = makeFlame t pos vel (Just cid) -- . makeFlame pos2 vel (Just cid)
resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire)
(shoot $ aFlame angle)
@@ -1942,4 +1944,23 @@ makeLaserScope p ep d relFrac = Particle'
spawnGun :: Creature -> Item
spawnGun cr = defaultGun
{ _itName = "SPAWNER"
, _wpMaxAmmo = 1
, _wpLoadedAmmo = 1
, _wpReloadTime = 80
, _wpReloadState = 0
, _wpFireRate = 100
, _wpFire = spawnCrNextTo cr
}
spawnCrNextTo :: Creature -> Int -> World -> World
spawnCrNextTo cr i w = w & creatures %~ IM.insert k newCr
where
k = newKey $ _creatures w
sCr = _creatures w IM.! i
newCr = cr
& crID .~ k
& crPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
& crOldPos .~ _crPos sCr +.+ unitVectorAtAngle (_crDir sCr)
src/Dodge/Render.hs
+122
View File
@@ -0,0 +1,122 @@
module Dodge.Render
( module Dodge.Render.Picture
, doDrawing
, doDrawing'
)
where
import Dodge.Data
import Dodge.Base
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Dodge.Render.Picture
import Dodge.Render.PerspectiveMatrix
import Geometry
import Picture
import Shader
import Picture.Render
import Picture.Preload
import Data.Graph.Inductive.Query.DFS
import Data.Graph.Inductive.Graph
import Control.Monad.State
import Data.List
import Data.Bifunctor
import Foreign (Word32)
import Data.Function
import Control.Applicative
import Control.Lens
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import qualified Data.Set as S
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
import qualified SDL
doDrawing :: RenderData -> World -> IO (Word32)
doDrawing pdata w = do
sTicks <- SDL.ticks
clear [ColorBuffer,DepthBuffer]
let rot = _cameraRot w
zoom = _cameraZoom w
trans@(tranx,trany) = _cameraCenter w
wins@(winx,winy) = (_windowX w,_windowY w)
wallPointsCol = wallsPointsAndCols w
windowPoints = wallsWindows w
lightPoints = lightsForGloom' w
viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
pic = worldPictures w
wallPoints = map fst wallPointsCol
setCommonUniforms pdata rot zoom trans wins
depthFunc $= Just Less
pmat <- (newMatrix RowMajor $ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
-- clear [DepthBuffer]
depthFunc $= Just Always
renderBackground pdata rot zoom trans wins
depthFunc $= Just Lequal
renderWalls pdata wallPointsCol pmat
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
-- depthFunc $= Just Lequal
renderFoldable pdata $ picToLTree (Just 0) pic
-- reset blend so that light map doesn't apply
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderFoldable pdata $ picToLTree (Just 1) pic
-- set drawing for on top
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
renderFoldable pdata $ picToLTree (Just 2) pic
depthMask $= Disabled
renderWalls pdata windowPoints pmat
depthMask $= Enabled
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
----------------------
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
eTicks <- SDL.ticks
return (eTicks - sTicks)
doDrawing' :: RenderData -> World -> IO (Word32)
doDrawing' pdata w = do
bindFramebuffer Framebuffer $= defaultFramebufferObject
sTicks <- SDL.ticks
clear [ColorBuffer,DepthBuffer]
let rot = _cameraRot w
zoom = _cameraZoom w
trans@(tranx,trany) = _cameraCenter w
wins@(winx,winy) = (_windowX w,_windowY w)
wallPointsCol = wallsPointsAndCols w
windowPoints = wallsWindows w
lightPoints = lightsForGloom' w
viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
pic = worldPictures w
wallPoints = map fst wallPointsCol
pmat <- (newMatrix RowMajor
$ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
setCommonUniforms pdata rot zoom trans wins
depthMask $= Disabled
renderBackground pdata rot zoom trans wins
depthMask $= Enabled
blend $= Enabled
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
-- not sure why renderWalls and setWallDepth aren't combined
renderWalls pdata wallPointsCol pmat
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
depthFunc $= Just Lequal
renderFoldable pdata $ picToLTree (Just 0) pic
renderFoldable pdata $ picToLTree (Just 1) pic
renderFoldable pdata $ picToLTree (Just 2) pic
eTicks <- SDL.ticks
return (eTicks - sTicks)
src/Dodge/Rendering/HUD.hs → src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module Dodge.Rendering.HUD
module Dodge.Render.HUD
where
import Dodge.Data
src/Dodge/Rendering/MenuScreen.hs → src/Dodge/Render/MenuScreen.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module Dodge.Rendering.MenuScreen
module Dodge.Render.MenuScreen
( menuScreen
)
where
src/Dodge/Render/PerspectiveMatrix.hs
+50
View File
@@ -0,0 +1,50 @@
module Dodge.Render.PerspectiveMatrix
where
import Dodge.Data
import Geometry
import Linear.Matrix
import Linear.V4
import Graphics.Rendering.OpenGL (GLfloat)
perspectiveMatrix :: World -> [GLfloat]
perspectiveMatrix w =
let rot = _cameraRot w
zoom = _cameraZoom w
(tranx,trany) = _cameraCenter w
(winx,winy) = (_windowX w,_windowY w)
(viewFromx,viewFromy) = _cameraViewFrom w
scalMat = Linear.Matrix.transpose $ V4
(V4 (2*zoom/winx) 0 0 (0::GLfloat))
(V4 0 (2*zoom/winy) 0 0)
(V4 0 0 0.5 0) --scaled to make walls shorter
(V4 0 0 0 1)
rotMat = Linear.Matrix.transpose $
V4 (V4 (cos rot) (sin (-rot)) 0 0)
(V4 (sin rot) (cos rot) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
tranMat3 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-tranx) (-trany) 0 1)
tranMat2 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
perMat = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 1)
(V4 0 0 0 1)
tranMat1 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-viewFromx) (-viewFromy) 0 1)
wmat = scalMat !*! rotMat !*! tranMat2 !*! perMat !*! tranMat1
vToL (V4 a b c d) = [a,b,c,d]
in concatMap vToL $ vToL wmat
src/Dodge/Rendering.hs → src/Dodge/Render/Picture.hs
+4 -16
View File
@@ -1,29 +1,17 @@
module Dodge.Rendering where
-- imports {{{
module Dodge.Render.Picture
where
import Dodge.Data
import Dodge.Base
--import Dodge.Inventory
import Dodge.Rendering.HUD
import Dodge.Rendering.MenuScreen
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Geometry
import Picture
import Data.Graph.Inductive.Query.DFS
import Data.Graph.Inductive.Graph
import Control.Monad.State
import Data.List
import Data.Bifunctor
import Data.Function
import Control.Applicative
import Control.Lens
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import qualified Data.Set as S
worldPictures :: World -> Picture
worldPictures w = pictures $ concat
src/Dodge/Update.hs
+5 -2
View File
@@ -71,8 +71,11 @@ updateLightSources w = set tempLightSources (catMaybes tlss) w'
updateProjectiles w = IM.foldr' _pjUpdate w $ _projectiles w
updateParticles' :: World -> World
updateParticles' w = set particles' (catMaybes ps) w'
where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
updateParticles' w =
--set particles' [] w
set particles' (catMaybes ps) w'
where
(w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
updateCreatures :: World -> World
updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
src/Dodge/WallCreatureCollisions.hs
+3 -4
View File
@@ -40,18 +40,17 @@ wallBuffer = 3
-- the following tests whether or not a point is on a wall, and if so pushes it
-- out from the wall
-- If the resultant push out is itself on another wall, the original point is
-- returned
-- this is then repeated if the point ends up on a new wall
collideWalls :: Float -> Point2 -> [[Point2]] -> Point2 -> Point2
collideWalls rad cp1 walls cp2
= case (listToMaybe.mapMaybe (pushOutFromWall rad cp2)) walls of
Nothing -> cp2
Just cp3 -> case (listToMaybe.reverse.mapMaybe (pushOutFromWall rad cp3)) walls of
Nothing -> cp3
Just cp4 -> cp1
Just cp4 -> cp4
-- pushes a point out from a list of walls
-- if multiple new points occur, chooses the one closest to the orignal pointjk
-- if multiple new points occur, chooses the one closest to the orignal point
pushOutFromWalls :: Float -> [[Point2]] -> Point2 -> Point2
pushOutFromWalls rad walls p =
fromMaybe p
src/Dodge/WorldEvent/Flash.hs
+1 -1
View File
@@ -59,7 +59,7 @@ glareBetween t len wdth col a b w
lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
lowLightPic len wdth col (a,b) w
= case thingsHitLongLine a b w of
= case thingsHit a b w of
((p, E3x2 wall):_)
-> setCol . lineOfThickness wdth $ [alongLineBy len p wa, alongLineBy len p wb]
where x = len *.* (normalizeV $ wa -.- wb)
src/Dodge/WorldEvent/SpawnParticle.hs
+3 -2
View File
@@ -37,8 +37,8 @@ aFlameParticle t pos vel maycid = Pt'
, _btHitEffect' = destroyOnImpact (doFlameDam 1) noEff noEff
}
makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World
makeFlame pos vel maycid = over particles' (aFlameParticle 100 pos vel maycid : )
makeFlame :: Int -> Point2 -> Point2 -> Maybe Int -> World -> World
makeFlame t pos vel maycid = over particles' (aFlameParticle t pos vel maycid : )
drawFlame :: Point2 -> Particle' -> Picture
drawFlame rotd pt = thePic
@@ -167,6 +167,7 @@ moveFlamelet w pt
& btPassThrough' .~ Nothing
& btVel' .~ 0.8 *.* vel
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
-- damcrs = w
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ Flaming 3 sp ep ep)
src/Dodge/WorldEvent/ThingsHit.hs
+1
View File
@@ -17,6 +17,7 @@ thingsHit sp ep w
where
hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)