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

Reify block drawing

Browse Source
This commit is contained in:
justin
2022-07-25 01:27:39 +01:00
parent 486c203fa2
commit c3a5b9d5be
15 changed files with 85 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Room/Tanks.hs
+7 -5
View File
@@ -14,7 +14,6 @@ import Dodge.Base.CardinalPoint
--import Padding
import Color
import Shape
import ShapePicture
import LensHelp
import Geometry
@@ -32,14 +31,17 @@ randomTank = takeOne $ map (\f -> f (dim orange) orange)
, tankSquareDec plusDecoration
]
-- dup with randEdgeTanks?
randEdgeTank :: RandomGen g => State g Placement
randEdgeTank = do
edge <- takeOne cardList
basetank <- randomTank
return $ basetank
& plType . putBlock . blDraw
%~ fmap (<> noPic ( colorSH orange (verticalPipe 80
<> horPipe 80 0 (70 *.* cardVec edge))))
%~ ( \bd -> BlockDraws [bd, BlockDrawBlSh (BlShConst $ colorSH orange (verticalPipe 80
<> horPipe 80 0 (70 *.* cardVec edge)))] )
-- %~ fmap (<> noPic ( colorSH orange (verticalPipe 80
-- <> horPipe 80 0 (70 *.* cardVec edge))))
-- 70 is a guess, the true value depends on the distance to the wall
& plSpot .~ rprBool (\rp _ -> _rpPlacementUse rp == 0
&& rpOffPathFromEdge (PathFromEdge edge 0) rp)
@@ -50,8 +52,8 @@ randEdgeTanks i = do
basetank <- randomTank
return $ replicate i $ basetank
& plType . putBlock . blDraw
%~ fmap (<> noPic ( colorSH orange (verticalPipe 80
<> horPipe 80 0 (70 *.* cardVec edge))))
%~ ( \bd -> BlockDraws [bd, BlockDrawBlSh (BlShConst $ colorSH orange (verticalPipe 80
<> horPipe 80 0 (70 *.* cardVec edge)))] )
-- 70 is a guess, the true value depends on the distance to the wall
& plSpot .~ rprBool (\rp _ -> _rpPlacementUse rp == 0
&& rpOffPathFromEdge (PathFromEdge edge 0) rp)