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