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

Cleanup

Browse Source
This commit is contained in:
justin
2023-05-20 15:06:05 +01:00
parent 6c71e1d5bb
commit f2183e9954
25 changed files with 69 additions and 86 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Beam/Draw.hs
+1 -1
View File
@@ -11,7 +11,7 @@ drawBeam bd = case bd of
basicDrawBeam :: Beam -> Picture
basicDrawBeam bm =
setLayer BloomNoZWrite $
pictures
fold
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 20 ps
, setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
]
src/Dodge/Creature.hs.orig
+4 -11
View File
@@ -37,7 +37,7 @@ import qualified Data.Map as M
import Foreign.ForeignPtr
import Control.Concurrent
colouredEnemy col = pictures [color col $ circleSolid 10, circLine 10]
colouredEnemy col = color col $ circleSolid 10, circLine 10
spawnerCrit :: Creature
spawnerCrit = defaultCreature
@@ -155,22 +155,15 @@ addArmour = over crInv insarmour
where i = newKey xs
equipOnTop :: (Creature -> Picture) -> Creature -> Picture
--equipOnTop f cr = onLayer CrLayer $ pictures $ fst (drawEquipment cr) ++ [f cr] ++ snd (drawEquipment cr)
equipOnTop f cr = pictures [onLayer CrLayer (f cr) , drawEquipment cr]
equipOnTop f cr = onLayer CrLayer (f cr) <> drawEquipment cr
drawEquipment :: Creature -> Picture
drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
drawEquipment cr = foldMap f $ IM.toList (_crInv cr)
where f (i,it) = case it ^? itEquipPict of
Just g -> g cr i
_ -> blank
--drawEquipment :: Creature -> ([Picture],[Picture])
--drawEquipment cr = (map fst p1, map fst p2)
-- where f (k,it) = join $ (it ^? itEquipPict) <*> (pure cr) <*> (pure k)
-- picts = sortBy (compare `on` snd) $ mapMaybe f $ IM.toList (_crInv cr)
-- (p1,p2) = partition (\ x -> snd x < 0) picts
frontArmouredPict = const $ pictures [ color (greyN 0.8) $ circleSolid 20
frontArmouredPict = const $ fold [ color (greyN 0.8) $ circleSolid 20
, color red $ circLine 20
]
src/Dodge/Data/Item/Params.hs
+9
View File
@@ -76,12 +76,19 @@ data ShrinkGunStatus = FullSize | Shrunk
data PreviousArcEffect = NoPreviousArcEffect | PerturbTillBreakPreviousArc
--deriving (Eq, Ord, Show, Read) --Generic, Flat)
data GunBarrel = GunBarrel
{ _barlPos :: Point2
, _barlRot :: Float
, _barlInaccuracy :: Float
}
data GunBarrels
= MultiBarrel
{ _brlSpread :: BarrelSpread
, _brlNum :: Int
, _brlInaccuracy :: Float
}
| BarrelList [GunBarrel]
| RotBarrel
{ _brlNum :: Int
, _brlInaccuracy :: Float
@@ -109,9 +116,11 @@ makeLenses ''BarrelSpread
makeLenses ''ItemParams
makeLenses ''Nozzle
makeLenses ''GunBarrels
makeLenses ''GunBarrel
deriveJSON defaultOptions ''ShrinkGunStatus
deriveJSON defaultOptions ''PreviousArcEffect
deriveJSON defaultOptions ''Nozzle
deriveJSON defaultOptions ''BarrelSpread
deriveJSON defaultOptions ''GunBarrel
deriveJSON defaultOptions ''GunBarrels
deriveJSON defaultOptions ''ItemParams
src/Dodge/Debug/LinkDecoration.hs
+2 -2
View File
@@ -22,13 +22,13 @@ addRoomLinkDecorations rms w =
%~ IM.insertWithNewKeys (map roomLinkDecorations rms)
roomLinkDecorations :: Room -> Picture
roomLinkDecorations rm = pictures . map (linkDecoration . lnkPosDir) $ _rmLinks rm
roomLinkDecorations rm = foldMap (linkDecoration . lnkPosDir) $ _rmLinks rm
linkDecoration :: (Point2, Float) -> Picture
linkDecoration (p, a) = setLayer DebugLayer . color red $ line [p, p +.+ 20 *.* unitVectorAtAngle (a - pi / 2)]
roomPolyDecorations :: Room -> Picture
roomPolyDecorations rm = pictures . map polyWireFrame $ _rmPolys rm
roomPolyDecorations rm = foldMap polyWireFrame $ _rmPolys rm
polyWireFrame :: [Point2] -> Picture
polyWireFrame (x : xs) = setLayer DebugLayer . setDepth 50 . color green $ line $ (x : xs) ++ [x]
src/Dodge/Debug/Picture.hs
+3 -3
View File
@@ -33,13 +33,13 @@ import Dodge.Render.Label
import Dodge.WorldEvent.ThingsHit
printPoint :: Point2 -> Picture
printPoint p = color white $ uncurryV translate p $ pictures [circle 3, scale 0.05 0.05 $ text (show p)]
printPoint p = color white $ uncurryV translate p $ fold [circle 3, scale 0.05 0.05 $ text (show p)]
printRotPoint :: Float -> Point2 -> Picture
printRotPoint r p =
color white
. uncurryV translate p
$ pictures [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
$ fold [circle 3, rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: Configuration -> Camera -> [Point2]
outsideScreenPolygon cfig w = [tr, tl, bl, br]
@@ -150,7 +150,7 @@ debugDraw' cfig w bl = case bl of
Show_zone_near_point_cursor -> drawZoneNearPointCursor w
Inspect_wall -> drawInspectWalls w
Cr_awareness -> drawCreatureDisplayTexts w
Show_sound -> pictures $ M.map (soundPic cfig w) $ _playingSounds w
Show_sound -> fold $ M.map (soundPic cfig w) $ _playingSounds w
Cr_status -> drawCrInfo cfig w
Mouse_position -> drawMousePosition w
Walls_info -> drawWlIDs w
src/Dodge/EnergyBall/Draw.hs
+1 -1
View File
@@ -22,7 +22,7 @@ drawStaticBall pt =
drawFlamelet :: EnergyBall -> Picture
drawFlamelet pt =
pictures
fold
[ setLayer BloomLayer pic
, setLayer BloomNoZWrite piu
, setLayer BloomNoZWrite pi2
src/Dodge/Flame/Draw.hs
+1 -1
View File
@@ -8,7 +8,7 @@ drawFlame ::
Flame ->
Picture
drawFlame pt =
pictures
fold
[ glow
, aPic BloomNoZWrite prot2 25 (V2 (scaleChange + 1) 2) $ V4 2 (-1) (-1) 0.5
, aPic BloomNoZWrite prot 22 (V2 (scaleChange + 0.5) 1) $ V4 1 0.5 0 2
src/Dodge/Item/Draw/SPic.hs
+2 -2
View File
@@ -32,7 +32,7 @@ equipItemSPic et _ = case et of
FRONTARMOUR ->
( mempty
, setDepth 20 $
pictures
fold
[ color yellow $ thickArc 0 (pi / 2) 10 5
, color yellow $ thickArc (3 * pi / 2) (2 * pi) 10 5
]
@@ -498,7 +498,7 @@ detectorColor dt = case dt of
keyPic :: Picture
keyPic =
color green $
pictures
fold
[ translate (-4) 0 $ thickCircle 4 2
, thickLine 2 $ map toV2 [(0, 0), (8, 0), (8, -4)]
, thickLine 2 $ map toV2 [(4, 0), (4, -4)]
src/Dodge/Item/Weapon/Grenade.hs
+1 -3
View File
@@ -59,11 +59,9 @@ import Shape
grenadePic :: Int -> SPic
grenadePic time =
( colorSH (dark $ dark green) $ upperPrismPolyHalf Small Typical 5 $ polyCirc 3 5
, pictures
[ color green $ arc (degToRad $ (179 * fromIntegral time / 50) - 180 )
, color green $ arc (degToRad $ (179 * fromIntegral time / 50) - 180 )
(degToRad $ 180 - (179 * fromIntegral time / 50) )
5
]
)
--grenadeDraw :: Float -> Prop -> SPic
src/Dodge/Laser/Draw.hs
+1 -3
View File
@@ -6,9 +6,7 @@ import Picture
drawLaser :: Laser -> Picture
drawLaser pt =
setLayer BloomNoZWrite $
pictures
[ setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
]
setDepth 19.5 . color (brightX 10 1 col) $ thickLine 3 ps
where
col = _lzColor pt
ps = _lzPoints pt
src/Dodge/LinearShockwave/Draw.hs
+1 -1
View File
@@ -11,7 +11,7 @@ drawLinearShockwave :: LinearShockwave -> Picture
drawLinearShockwave lw =
setLayer BloomLayer $
setDepth 20 $
pictures $
fold $
theArc
++ [ lineCol $ zip (reverse lps) $ map (`withAlpha` white) [0, 0.05 ..]
, lineCol $ zip (reverse rps) $ map (`withAlpha` white) [0, 0.05 ..]
src/Dodge/Particle/Draw.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Picture
drawTargetLaser :: Laser -> Picture
drawTargetLaser pt =
setLayer BloomNoZWrite $
pictures
fold
[ setDepth 19 . color (brightX 0 0.5 col) $ thickLine 5 (sp : ps)
, setDepth 19.5 . color (brightX 5 1 col) $ thickLine 1 (sp : ps)
]
src/Dodge/Picture.hs
+2 -2
View File
@@ -9,7 +9,7 @@ import Picture
wedgeOfThickness :: Float -> Point2 -> Point2 -> Picture
wedgeOfThickness t x y
| x == y = blank
| otherwise = pictures
| otherwise = fold
[uncurryV translate x $ circleSolid (0.5*t)
,polygon [x +.+ n x y, x -.- n x y, y]
]
@@ -17,7 +17,7 @@ wedgeOfThickness t x y
n a b = (t*0.5) *.* errorNormalizeV 4200 (vNormal (a -.- b))
verticalPipe :: Float -> Color -> Point2 -> Float -> Float -> Picture
verticalPipe w col (V2 xx xy) za zb = pictures $ map (poly3Col . f) ps
verticalPipe w col (V2 xx xy) za zb = foldMap (poly3Col . f) ps
where
x = V3 xx xy 0
xs = map ((\(V2 a b) -> x +.+.+ V3 a b za) . toV2) [(w,0),(0,w),(-w,0),(0,-w)]
src/Dodge/Picture/SizeInvariant.hs
+1 -1
View File
@@ -65,7 +65,7 @@ fixedSizePicClampArrow ::
World ->
Picture
fixedSizePicClampArrow xbord ybord pic p cfig w =
pictures
fold
[ setLayer DebugLayer . translate x y . scale theScale theScale $ pic
, setLayer DebugLayer . color white . setDepth 20 $ arrowPic
]
src/Dodge/RadarSweep/Draw.hs
+5 -6
View File
@@ -5,16 +5,15 @@ import Geometry
import Picture
drawRadarSweep :: RadarSweep -> Picture
drawRadarSweep pt = setLayer DebugLayer $ pictures sweepPics
where
col = rsObjectColor $ _rsObject pt
p = _rsPos pt
r = _rsRad pt
sweepPics =
drawRadarSweep pt = setLayer DebugLayer $ fold
[ colHelper 0.1 $ uncurryV translate p $ thickCircle r 15
, colHelper 0.06 $ uncurryV translate p $ thickCircle (r -5) 5
, colHelper 0.03 $ uncurryV translate p $ thickCircle (r -10) 5
]
where
col = rsObjectColor $ _rsObject pt
p = _rsPos pt
r = _rsRad pt
colHelper y = color (withAlpha (y * globalAlpha) col)
globalAlpha
| x > 10 = 1
src/Dodge/Render/HUD/Carte.hs
+1 -1
View File
@@ -13,7 +13,7 @@ import Picture
drawCarte :: Configuration -> World -> Picture
drawCarte cfig w =
pictures $
fold $
toTopLeft cfig (renderListAt 0 0 locs) :
mapOverlay w
++ [mainListCursor white iPos cfig]
src/Dodge/Render/MenuScreen.hs
+1 -1
View File
@@ -23,7 +23,7 @@ drawInputMenu ::
String ->
Picture
drawInputMenu cfig title footer =
pictures
fold
[ darkenBackground cfig
, drawTitle cfig title
, drawFooterText cfig red footer
src/Dodge/Render/Outline.hs
+3 -3
View File
@@ -3,12 +3,12 @@ module Dodge.Render.Outline
import Picture
hackOutline :: Color -> Float -> Picture -> Picture
hackOutline col x pic = pictures
(map (color col)
hackOutline col x pic = foldMap
(color col)
[ translate x 0 pic
, translate (-x) 0 pic
, translate 0 x pic
, translate 0 (-x) pic
]
) <> pic
<> pic
src/Dodge/Render/Picture.hs
+2 -2
View File
@@ -78,7 +78,7 @@ mouseCursorType u
- w ^. wCam . camRot
mousePlus :: Picture
mousePlus = pictures [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
mousePlus = fold [line [V2 (-5) 0, V2 5 0], line [V2 0 (-5), V2 0 5]]
drawPlus :: Float -> Picture
drawPlus x = pictures [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
drawPlus x = fold [line [V2 (- x) 0, V2 x 0], line [V2 0 (- x), V2 0 x]]
src/Dodge/Render/ShapePicture.hs
+18 -18
View File
@@ -80,7 +80,7 @@ drawCreature cr = case _crType cr of
Barreloid{} ->
picAtCrPos1
( setDepth 20 $
pictures
fold
[ color orange $ circleSolid 10
, setDepth 0.049 . color (greyN 0.5) $ circleSolid 8
, color (greyN 0.5) $ circleSolid 8
@@ -119,25 +119,25 @@ cullPoint cfig w p
extraPics :: Configuration -> Universe -> Picture
extraPics cfig u =
pictures (_decorations lw)
fold (_decorations lw)
<> setLayer FixedCoordLayer (fixedCoordPictures u)
<> concatMapPic drawTractorBeam (_tractorBeams lw)
<> concatMapPic drawLinearShockwave (_linearShockwaves lw)
<> concatMapPic drawShockwave (_shockwaves lw)
<> concatMapPic drawLaser (_lasersToDraw lw)
<> concatMapPic drawTeslaArc (_teslaArcs lw)
<> concatMapPic drawRadarSweep (_radarSweeps lw)
<> concatMapPic drawFlame (_flames lw)
<> concatMapPic drawEnergyBall (_energyBalls lw)
<> concatMapPic drawSpark (_sparks lw)
<> concatMapPic drawBul (_bullets lw)
<> concatMapPic drawBlip (_radarBlips lw)
<> concatMapPic drawFlare (_flares lw)
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
<> concatMapPic (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
<> concatMapPic (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
<> foldMap drawTractorBeam (_tractorBeams lw)
<> foldMap drawLinearShockwave (_linearShockwaves lw)
<> foldMap drawShockwave (_shockwaves lw)
<> foldMap drawLaser (_lasersToDraw lw)
<> foldMap drawTeslaArc (_teslaArcs lw)
<> foldMap drawRadarSweep (_radarSweeps lw)
<> foldMap drawFlame (_flames lw)
<> foldMap drawEnergyBall (_energyBalls lw)
<> foldMap drawSpark (_sparks lw)
<> foldMap drawBul (_bullets lw)
<> foldMap drawBlip (_radarBlips lw)
<> foldMap drawFlare (_flares lw)
<> foldMap (dbArg (drawBeam . _bmDraw)) (_positronBeams $ _beams lw)
<> foldMap (dbArg (drawBeam . _bmDraw)) (_electronBeams $ _beams lw)
<> foldMap (dbArg (drawLightSource . _lsPict)) (_lightSources lw)
<> testPic cfig w
<> concatMapPic ppDraw (_pressPlates lw)
<> foldMap ppDraw (_pressPlates lw)
<> viewClipBounds cfig w
<> debugDraw cfig w
<> foldMap (`_debugPic` u) (_uvDebug u)
src/Dodge/Room/Foreground.hs
+1 -1
View File
@@ -42,7 +42,7 @@ highDiagonalMesh ::
Picture
highDiagonalMesh pa pb w d =
setDepth 100 $
pictures $
fold $
map (thickLine 2 . tflat2) (diagonalLinesRect pb pa w d (3 * pi / 4))
++ map (thickLine 2 . tflat2) (diagonalLinesRect pb pc (negate h) d (pi / 4))
where
src/Dodge/Targeting/Draw.hs
+2 -2
View File
@@ -47,7 +47,7 @@ targetDraw f cr _ _ = fromMaybe mempty $ do
activeTargetCursorPic :: Picture
activeTargetCursorPic =
pictures
fold
[rotate a $ line [V2 15 0, V2 10 0] <> targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
transMidLine :: Point2 -> Point2 -> Picture -> Picture
@@ -73,4 +73,4 @@ targCorner = line [V2 (x - y) x, V2 x x, V2 x (x - y)]
y = 5
targetCursorPic :: Picture
targetCursorPic = pictures [rotate a targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
targetCursorPic = fold [rotate a targCorner | a <- [0, 0.5 * pi, pi, 1.5 * pi]]
src/Dodge/Tesla/Arc/Draw.hs
+1 -1
View File
@@ -7,7 +7,7 @@ import Picture
drawTeslaArc :: TeslaArc -> Picture
drawTeslaArc pt =
setLayer BloomNoZWrite $
pictures
fold
[ setDepth 20.5 $ color (brightX 2 1 $ _taColor pt) $ thickLine 3 ps
, setDepth 20 $ color (V4 0 0 0 0.5) $ thickLine 10 ps
]
src/Picture/Base.hs
+4 -18
View File
@@ -33,9 +33,6 @@ module Picture.Base (
drawText,
centerText,
stackText,
pictures,
concatMapPic,
appendPic,
tranRot,
translate,
translate3,
@@ -50,6 +47,7 @@ module Picture.Base (
mirrorxz,
overPos,
picMap,
fold,
) where
import Color
@@ -156,18 +154,6 @@ rotate :: Float -> Picture -> Picture
{-# INLINE rotate #-}
rotate = picMap . overPos . rotate3
concatMapPic :: Foldable t => (a -> Picture) -> t a -> Picture
{-# INLINE concatMapPic #-}
concatMapPic = foldMap
appendPic :: Picture -> Picture -> Picture
{-# INLINE appendPic #-}
appendPic = (<>)
pictures :: Foldable t => t Picture -> Picture
{-# INLINEABLE pictures #-}
pictures = fold
makeArc :: Float -> Point2 -> [Point2]
{-# INLINE makeArc #-}
makeArc rad (V2 a b) = map (`rotateV` V2 0 rad) angles
@@ -246,7 +232,7 @@ lineCol = thickLineCol 1
lineThick :: Float -> [Point2] -> Picture
{-# INLINE lineThick #-}
lineThick t = pictures . f
lineThick t = fold . f
where
f (x : y : ys)
| x == y = f (x : ys)
@@ -256,7 +242,7 @@ lineThick t = pictures . f
thickLine :: Float -> [Point2] -> Picture
{-# INLINE thickLine #-}
thickLine t = pictures . f
thickLine t = fold . f
where
f (x : y : ys)
| x == y = f (x : ys)
@@ -267,7 +253,7 @@ thickLine t = pictures . f
thickLineCol :: Float -> [(Point2, RGBA)] -> Picture
{-# INLINE thickLineCol #-}
thickLineCol t = pictures . f
thickLineCol t = fold . f
where
f ((x, c) : (y, c') : ys)
| x == y = f ((x, c) : ys)
src/Polyhedra.hs
+1 -1
View File
@@ -127,7 +127,7 @@ helpPoly3D = picFormat . map f . polyToTris
f (pos,col) = Verx pos col [] BottomLayer polyNum
polysToPic :: [Polyhedra] -> Picture
polysToPic = pictures . concatMap polyToPics
polysToPic = fold . concatMap polyToPics
polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
polyToEdges = map denormalEdges . constructEdges . map (map fst) . _pyFaces