From f2183e9954bfd95b57481e054db97d5300c3ef5e Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 20 May 2023 15:06:05 +0100 Subject: [PATCH] Cleanup --- src/Dodge/Beam/Draw.hs | 2 +- src/Dodge/Creature.hs.orig | 15 ++++--------- src/Dodge/Data/Item/Params.hs | 9 ++++++++ src/Dodge/Debug/LinkDecoration.hs | 4 ++-- src/Dodge/Debug/Picture.hs | 6 ++--- src/Dodge/EnergyBall/Draw.hs | 2 +- src/Dodge/Flame/Draw.hs | 2 +- src/Dodge/Item/Draw/SPic.hs | 4 ++-- src/Dodge/Item/Weapon/Grenade.hs | 4 +--- src/Dodge/Laser/Draw.hs | 4 +--- src/Dodge/LinearShockwave/Draw.hs | 2 +- src/Dodge/Particle/Draw.hs | 2 +- src/Dodge/Picture.hs | 4 ++-- src/Dodge/Picture/SizeInvariant.hs | 2 +- src/Dodge/RadarSweep/Draw.hs | 11 +++++---- src/Dodge/Render/HUD/Carte.hs | 2 +- src/Dodge/Render/MenuScreen.hs | 2 +- src/Dodge/Render/Outline.hs | 6 ++--- src/Dodge/Render/Picture.hs | 4 ++-- src/Dodge/Render/ShapePicture.hs | 36 +++++++++++++++--------------- src/Dodge/Room/Foreground.hs | 2 +- src/Dodge/Targeting/Draw.hs | 4 ++-- src/Dodge/Tesla/Arc/Draw.hs | 2 +- src/Picture/Base.hs | 22 ++++-------------- src/Polyhedra.hs | 2 +- 25 files changed, 69 insertions(+), 86 deletions(-) diff --git a/src/Dodge/Beam/Draw.hs b/src/Dodge/Beam/Draw.hs index e70ae6c25..8c5f1c2a8 100644 --- a/src/Dodge/Beam/Draw.hs +++ b/src/Dodge/Beam/Draw.hs @@ -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 ] diff --git a/src/Dodge/Creature.hs.orig b/src/Dodge/Creature.hs.orig index faa64db2e..307d2eec1 100644 --- a/src/Dodge/Creature.hs.orig +++ b/src/Dodge/Creature.hs.orig @@ -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 ] diff --git a/src/Dodge/Data/Item/Params.hs b/src/Dodge/Data/Item/Params.hs index 7180aca43..c288f23ea 100644 --- a/src/Dodge/Data/Item/Params.hs +++ b/src/Dodge/Data/Item/Params.hs @@ -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 diff --git a/src/Dodge/Debug/LinkDecoration.hs b/src/Dodge/Debug/LinkDecoration.hs index 8b5c91298..845ec70b2 100644 --- a/src/Dodge/Debug/LinkDecoration.hs +++ b/src/Dodge/Debug/LinkDecoration.hs @@ -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] diff --git a/src/Dodge/Debug/Picture.hs b/src/Dodge/Debug/Picture.hs index ee15a771b..ee6fea96c 100644 --- a/src/Dodge/Debug/Picture.hs +++ b/src/Dodge/Debug/Picture.hs @@ -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 diff --git a/src/Dodge/EnergyBall/Draw.hs b/src/Dodge/EnergyBall/Draw.hs index cc561abc9..ee8dae689 100644 --- a/src/Dodge/EnergyBall/Draw.hs +++ b/src/Dodge/EnergyBall/Draw.hs @@ -22,7 +22,7 @@ drawStaticBall pt = drawFlamelet :: EnergyBall -> Picture drawFlamelet pt = - pictures + fold [ setLayer BloomLayer pic , setLayer BloomNoZWrite piu , setLayer BloomNoZWrite pi2 diff --git a/src/Dodge/Flame/Draw.hs b/src/Dodge/Flame/Draw.hs index 0567b6a8a..4359d5f73 100644 --- a/src/Dodge/Flame/Draw.hs +++ b/src/Dodge/Flame/Draw.hs @@ -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 diff --git a/src/Dodge/Item/Draw/SPic.hs b/src/Dodge/Item/Draw/SPic.hs index d3bf21323..bc7d928d7 100644 --- a/src/Dodge/Item/Draw/SPic.hs +++ b/src/Dodge/Item/Draw/SPic.hs @@ -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)] diff --git a/src/Dodge/Item/Weapon/Grenade.hs b/src/Dodge/Item/Weapon/Grenade.hs index f79e380de..0d5170008 100644 --- a/src/Dodge/Item/Weapon/Grenade.hs +++ b/src/Dodge/Item/Weapon/Grenade.hs @@ -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 diff --git a/src/Dodge/Laser/Draw.hs b/src/Dodge/Laser/Draw.hs index 96103d3a3..0f1a28eed 100644 --- a/src/Dodge/Laser/Draw.hs +++ b/src/Dodge/Laser/Draw.hs @@ -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 diff --git a/src/Dodge/LinearShockwave/Draw.hs b/src/Dodge/LinearShockwave/Draw.hs index d8477dcfc..82ee0b892 100644 --- a/src/Dodge/LinearShockwave/Draw.hs +++ b/src/Dodge/LinearShockwave/Draw.hs @@ -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 ..] diff --git a/src/Dodge/Particle/Draw.hs b/src/Dodge/Particle/Draw.hs index da575f768..d4c3072ab 100644 --- a/src/Dodge/Particle/Draw.hs +++ b/src/Dodge/Particle/Draw.hs @@ -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) ] diff --git a/src/Dodge/Picture.hs b/src/Dodge/Picture.hs index 5f776ed57..74c1a4e7a 100644 --- a/src/Dodge/Picture.hs +++ b/src/Dodge/Picture.hs @@ -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)] diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs index a36d5622b..5d4e58cbc 100644 --- a/src/Dodge/Picture/SizeInvariant.hs +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -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 ] diff --git a/src/Dodge/RadarSweep/Draw.hs b/src/Dodge/RadarSweep/Draw.hs index e13a94eb9..baa63974e 100644 --- a/src/Dodge/RadarSweep/Draw.hs +++ b/src/Dodge/RadarSweep/Draw.hs @@ -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 diff --git a/src/Dodge/Render/HUD/Carte.hs b/src/Dodge/Render/HUD/Carte.hs index 8d05fc6ec..de7155475 100644 --- a/src/Dodge/Render/HUD/Carte.hs +++ b/src/Dodge/Render/HUD/Carte.hs @@ -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] diff --git a/src/Dodge/Render/MenuScreen.hs b/src/Dodge/Render/MenuScreen.hs index ec872a4e8..91210eb3e 100644 --- a/src/Dodge/Render/MenuScreen.hs +++ b/src/Dodge/Render/MenuScreen.hs @@ -23,7 +23,7 @@ drawInputMenu :: String -> Picture drawInputMenu cfig title footer = - pictures + fold [ darkenBackground cfig , drawTitle cfig title , drawFooterText cfig red footer diff --git a/src/Dodge/Render/Outline.hs b/src/Dodge/Render/Outline.hs index f2072ecc8..04deac78d 100644 --- a/src/Dodge/Render/Outline.hs +++ b/src/Dodge/Render/Outline.hs @@ -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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index b9354241e..27e27c9c0 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -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]] diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index be54f1e7b..4d3c93f79 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -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) diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index 58313f37e..6b1831aac 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -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 diff --git a/src/Dodge/Targeting/Draw.hs b/src/Dodge/Targeting/Draw.hs index 5d7cc95a7..b1f054ec4 100644 --- a/src/Dodge/Targeting/Draw.hs +++ b/src/Dodge/Targeting/Draw.hs @@ -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]] diff --git a/src/Dodge/Tesla/Arc/Draw.hs b/src/Dodge/Tesla/Arc/Draw.hs index daa901379..271845f45 100644 --- a/src/Dodge/Tesla/Arc/Draw.hs +++ b/src/Dodge/Tesla/Arc/Draw.hs @@ -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 ] diff --git a/src/Picture/Base.hs b/src/Picture/Base.hs index 1147d1732..49e4f1e92 100644 --- a/src/Picture/Base.hs +++ b/src/Picture/Base.hs @@ -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) diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 0e655c4ab..8a8ec4f0e 100644 --- a/src/Polyhedra.hs +++ b/src/Polyhedra.hs @@ -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