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-01-13 16:10:41 +00:00
parent 60943953a6
commit 5f871264d4
1 changed files with 116 additions and 148 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Item/Draw/SPic.hs
+116 -148
View File
@@ -1,17 +1,19 @@
module Dodge.Item.Draw.SPic where module Dodge.Item.Draw.SPic (
itemSPic,
) where
import qualified Linear.Quaternion as Q
import Dodge.Item.AmmoPosition
import Color import Color
import qualified Data.Map.Strict as M
import Data.Maybe import Data.Maybe
import Dodge.Data.Item import Dodge.Data.Item
import Dodge.Item.AmmoPosition
import Dodge.Item.Weapon.FractionLoaded import Dodge.Item.Weapon.FractionLoaded
import Geometry import Geometry
import LensHelp import LensHelp
import qualified Linear.Quaternion as Q
import Picture import Picture
import Shape import Shape
import ShapePicture import ShapePicture
import qualified Data.Map.Strict as M
itemSPic :: Item -> SPic itemSPic :: Item -> SPic
itemSPic it = itemSPic it =
@@ -63,29 +65,28 @@ ammoPosition itm hit = case hit of
FLATSHIELD -> NoAmmoPosition FLATSHIELD -> NoAmmoPosition
FORCEFIELDGUN -> NoAmmoPosition FORCEFIELDGUN -> NoAmmoPosition
TORCH -> NoAmmoPosition TORCH -> NoAmmoPosition
-- note that this uses a hard coded value from brlSpread
BANGSTICK i -> bangStickAmmoPos i itm BANGSTICK i -> bangStickAmmoPos i itm
PISTOL -> Magazine (V3 5 2 0) lhs PISTOL -> Magazine (V3 5 2 0) lhs
REVOLVER -> revolverAmmoPos REVOLVER -> revolverAmmoPos
REVOLVERX _ -> revolverAmmoPos REVOLVERX _ -> revolverAmmoPos
MACHINEPISTOL -> Magazine (V3 5 2 0) lhs MACHINEPISTOL -> Magazine (V3 5 2 0) lhs
AUTOPISTOL -> Magazine (V3 5 2 0) lhs AUTOPISTOL -> Magazine (V3 5 2 0) lhs
SMG -> Magazine (V3 7 (-2) 0 ) rhs SMG -> Magazine (V3 7 (-2) 0) rhs
BANGCONE -> NoAmmoPosition BANGCONE -> NoAmmoPosition
BLUNDERBUSS -> NoAmmoPosition BLUNDERBUSS -> NoAmmoPosition
GRAPECANNON _ -> NoAmmoPosition GRAPECANNON _ -> NoAmmoPosition
MINIGUNX _ -> NoAmmoPosition MINIGUNX _ -> NoAmmoPosition
VOLLEYGUN i -> volleygunAmmoPos i VOLLEYGUN i -> volleygunAmmoPos i
RIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)] RIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
REPEATER -> Magazine (V3 10 (-2) 0 ) rhs REPEATER -> Magazine (V3 10 (-2) 0) rhs
AUTORIFLE -> Magazine (V3 10 (-2) 0 ) rhs AUTORIFLE -> Magazine (V3 10 (-2) 0) rhs
BURSTRIFLE -> Magazine (V3 10 (-2) 0 ) rhs BURSTRIFLE -> Magazine (V3 10 (-2) 0) rhs
BANGROD -> NoAmmoPosition BANGROD -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
ELEPHANTGUN -> NoAmmoPosition ELEPHANTGUN -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
AMR -> Magazine (V3 10 (-2) 0 ) rhs AMR -> Magazine (V3 10 (-2) 0) rhs
AUTOAMR -> Magazine (V3 10 (-2) 0 ) rhs AUTOAMR -> Magazine (V3 10 (-2) 0) rhs
SNIPERRIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)] SNIPERRIFLE -> Bullets [(V3 5 0 3, Q.axisAngle (V3 1 0 0) 0)]
MACHINEGUN -> Magazine (V3 10 (-2) 0 ) rhs MACHINEGUN -> Magazine (V3 10 (-2) 0) rhs
FLAMESPITTER -> NoAmmoPosition FLAMESPITTER -> NoAmmoPosition
FLAMETHROWER -> NoAmmoPosition FLAMETHROWER -> NoAmmoPosition
FLAMETORRENT -> NoAmmoPosition FLAMETORRENT -> NoAmmoPosition
@@ -113,25 +114,29 @@ ammoPosition itm hit = case hit of
rhs = Q.axisAngle (V3 1 0 0) 0 rhs = Q.axisAngle (V3 1 0 0) 0
bangStickAmmoPos :: Int -> Item -> AmmoPosition bangStickAmmoPos :: Int -> Item -> AmmoPosition
bangStickAmmoPos i itm = Bullets bangStickAmmoPos i itm =
[ (rotate3z a (V3 5 0 3), Q.axisAngle (V3 0 0 1) a) | a <- map f [0..i - 1]] Bullets
[(rotate3z a (V3 5 0 3), Q.axisAngle (V3 0 0 1) a) | a <- map f [0 .. i - 1]]
where where
f n = barrelspread * fromIntegral n f n =
- 0.5 * barrelspread * fromIntegral (_brlNum (_gunBarrels (_itParams itm)) -1) barrelspread * fromIntegral n
- 0.5 * barrelspread * fromIntegral (_brlNum (_gunBarrels (_itParams itm)) -1)
barrelspread = itm ^?! itParams . gunBarrels . brlSpread . spreadAngle barrelspread = itm ^?! itParams . gunBarrels . brlSpread . spreadAngle
volleygunAmmoPos :: Int -> AmmoPosition volleygunAmmoPos :: Int -> AmmoPosition
volleygunAmmoPos i = Bullets volleygunAmmoPos i =
[(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0..i-1] ] Bullets
[(V3 5 (f n) 3, Q.axisAngle (V3 1 0 0) 0) | n <- [0 .. i -1]]
where where
f n = fromIntegral n * 5 - ((fromIntegral i - 1)*2.5) f n = fromIntegral n * 5 - ((fromIntegral i - 1) * 2.5)
revolverAmmoPos :: AmmoPosition revolverAmmoPos :: AmmoPosition
revolverAmmoPos = Bullets revolverAmmoPos =
[( V3 5 0 1 + Q.rotate q (V3 0 0 2), q) | q <- qs] Bullets
[(V3 5 0 1 + Q.rotate q (V3 0 0 2), q) | q <- qs]
where where
qs = [Q.axisAngle (V3 1 0 0) (f i) | i <- [1 .. 6::Int]] qs = [Q.axisAngle (V3 1 0 0) (f i) | i <- [1 .. 6 :: Int]]
f i = fromIntegral i * pi/3 + pi/6 f i = fromIntegral i * pi / 3 + pi / 6
heldItemSPic :: HeldItemType -> Item -> SPic heldItemSPic :: HeldItemType -> Item -> SPic
heldItemSPic ht it = case ht of heldItemSPic ht it = case ht of
@@ -139,43 +144,26 @@ heldItemSPic ht it = case ht of
FORCEFIELDGUN -> defSPic FORCEFIELDGUN -> defSPic
TORCH -> noPic torchShape TORCH -> noPic torchShape
BANGSTICK i -> noPic $ baseStickShapeX it i <> addBullets it BANGSTICK i -> noPic $ baseStickShapeX it i <> addBullets it
--BANGSTICK i -> noPic $ baseStickShapeX it i <> stickClip it
--PISTOL -> noPic $ baseStickShape <> makeTinClipAt pi (V3 5 2 0) it
PISTOL -> noPic $ baseStickShape <> addTinClip it PISTOL -> noPic $ baseStickShape <> addTinClip it
--REVOLVER -> noPic $ baseStickShape <> revolverClip it
--REVOLVERX _ -> noPic $ baseStickShape <> revolverClip it
REVOLVER -> noPic $ baseStickShape <> addBullets it REVOLVER -> noPic $ baseStickShape <> addBullets it
REVOLVERX _ -> noPic $ baseStickShape <> addBullets it REVOLVERX _ -> noPic $ baseStickShape <> addBullets it
MACHINEPISTOL -> noPic $ baseStickShape <> addTinClip it MACHINEPISTOL -> noPic $ baseStickShape <> addTinClip it
AUTOPISTOL -> noPic $ baseStickShape <> addTinClip it AUTOPISTOL -> noPic $ baseStickShape <> addTinClip it
--SMG -> noPic (baseSMGShape <> makeTinClipAt 0 (V3 7 (-2) 0) it)
SMG -> noPic $ baseSMGShape <> addTinClip it SMG -> noPic $ baseSMGShape <> addTinClip it
BANGCONE -> BANGCONE -> noPic $ bangConeShape 5
noPic $ BLUNDERBUSS -> noPic $ bangConeShape 20
colorSH cyan $ GRAPECANNON _ -> noPic $ bangConeShape 20
upperPrismPoly 3 (rectXH 5 2)
<> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 5 15)
BLUNDERBUSS ->
noPic $
colorSH cyan $
upperPrismPoly 3 (rectXH 20 2)
<> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 20 30)
GRAPECANNON _ ->
noPic $
colorSH cyan $
upperPrismPoly 3 (rectXH 20 2)
<> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) 20 30)
MINIGUNX i -> miniGunXPictItem i it MINIGUNX i -> miniGunXPictItem i it
VOLLEYGUN i -> volleyGunSPic i it <> noPic (addBullets it) VOLLEYGUN i -> noPic $ volleyGunShape i <> addBullets it
RIFLE -> noPic $ baseRifleShape <> addBullets it -- makeSingleClipAt (V3 5 0 3) it RIFLE -> noPic $ baseRifleShape <> addBullets it
REPEATER -> noPic $ baseRifleShape <> addTinClip it REPEATER -> noPic $ baseRifleShape <> addTinClip it
AUTORIFLE -> noPic $ baseRifleShape <> addTinClip it AUTORIFLE -> noPic $ baseRifleShape <> addTinClip it
BURSTRIFLE -> noPic $ baseRifleShape <> addTinClip it BURSTRIFLE -> noPic $ baseRifleShape <> addTinClip it
BANGROD -> noPic $ baseRodShape <> makeSingleClipAt (V3 5 0 3) it BANGROD -> noPic $ baseRodShape <> addBullets it
ELEPHANTGUN -> noPic $ baseAMRShape <> makeSingleClipAt (V3 5 0 3) it ELEPHANTGUN -> noPic $ baseAMRShape <> addBullets it
AMR -> noPic $ baseAMRShape <> addTinClip it AMR -> noPic $ baseAMRShape <> addTinClip it
AUTOAMR -> noPic $ baseAMRShape <> addTinClip it AUTOAMR -> noPic $ baseAMRShape <> addTinClip it
SNIPERRIFLE -> noPic $ baseAMRShape <> makeSingleClipAt (V3 5 0 3) it SNIPERRIFLE -> noPic $ baseAMRShape <> addBullets it
MACHINEGUN -> noPic $ baseAMRShape <> addTinClip it MACHINEGUN -> noPic $ baseAMRShape <> addTinClip it
FLAMESPITTER -> flamerPic it FLAMESPITTER -> flamerPic it
FLAMETHROWER -> flamerPic it FLAMETHROWER -> flamerPic it
@@ -230,17 +218,11 @@ baseStickShapeX it i = foldMap f [0 .. i -1]
baseStickShape :: Shape baseStickShape :: Shape
baseStickShape = colorSH green $ upperPrismPoly 3 $ rectXH 10 2 baseStickShape = colorSH green $ upperPrismPoly 3 $ rectXH 10 2
stickClip :: Item -> Shape bangConeShape :: Float -> Shape
stickClip it = case it ^? itUse . heldConsumption . laLoaded of bangConeShape x =
Just x | x > 0 -> foldMap f [0 .. x -1] colorSH cyan $
_ -> mempty upperPrismPoly 3 (rectXH x 2)
where <> upperPrismPoly 6 (reverse $ rectNSWE 4 (-4) x (10 + x))
f i = rotateSH ang $ translateSH (V3 5 0 3) $ upperPrismPoly 2 $ square 1.5
where
ang =
barrelspread * fromIntegral i
- 0.5 * barrelspread * fromIntegral (_brlNum (_gunBarrels (_itParams it)) -1)
barrelspread = it ^?! itParams . gunBarrels . brlSpread . spreadAngle
defSPic :: SPic defSPic :: SPic
defSPic = noPic $ colorSH green $ upperPrismPoly 3 $ square 4 defSPic = noPic $ colorSH green $ upperPrismPoly 3 $ square 4
@@ -255,34 +237,12 @@ shatterGunSPic =
xa = 1 xa = 1
xb = 9 xb = 9
defCane :: Item -> SPic
defCane it = noPic $ baseCaneShape <> makeSingleClipAt (V3 5 0 3) it
baseCaneShape :: Shape baseCaneShape :: Shape
baseCaneShape = colorSH red $ upperPrismPoly 3 $ rectXH 15 1.5 baseCaneShape = colorSH red $ upperPrismPoly 3 $ rectXH 15 1.5
baseRifleShape :: Shape baseRifleShape :: Shape
baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2 baseRifleShape = colorSH red $ upperPrismPoly 3 $ rectXH 25 2
makeSingleClipAt :: Point3 -> Item -> Shape
makeSingleClipAt p it = case it ^? itUse . heldConsumption . laLoaded of
Just 0 -> mempty
_ -> translateSH p $ colorSH midcol (upperPrismPoly 1 $ reverse
(rectNSWE 0.2 (- 2) (-1) 1)) <> tip <> foot
where
midcol = maybe black bulletEffectColor
(it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
tip = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0.2 (- 0.2) 1 2
foot = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 1.1 $
reverse $
rectNSWE 0.2 (- 0.2) (-2) (-1)
addBullets :: Item -> Shape addBullets :: Item -> Shape
addBullets itm = fromMaybe mempty $ do addBullets itm = fromMaybe mempty $ do
x <- itm ^? itUse . heldConsumption . laLoaded x <- itm ^? itUse . heldConsumption . laLoaded
@@ -291,23 +251,37 @@ addBullets itm = fromMaybe mempty $ do
return $ foldMap (uncurry (drawBullet itm)) ps return $ foldMap (uncurry (drawBullet itm)) ps
drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape drawBullet :: Item -> Point3 -> Q.Quaternion Float -> Shape
drawBullet itm p q = translateSH p $ overPosSH (Q.rotate q) $ colorSH midcol (upperPrismPoly 0.2 $ reverse drawBullet itm p q =
(rectNSWE 0.2 (- 0.2) (-1) 1)) <> tip <> foot translateSH p $
overPosSH (Q.rotate q) $
colorSH
midcol
( upperPrismPoly 0.2 $
reverse
(rectNSWE 0.2 (- 0.2) (-1) 1)
)
<> tip
<> foot
where where
midcol = maybe black bulletEffectColor midcol =
(itm ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect) maybe
black
bulletEffectColor
(itm ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
tip = fromMaybe mempty $ do tip = fromMaybe mempty $ do
ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 0.2 $ return $
reverse $ colorSH (bulletPayloadColor ebt) $
rectNSWE 0.2 (- 0.2) 1 2 upperPrismPoly 0.2 $
reverse $
rectNSWE 0.2 (- 0.2) 1 2
foot = fromMaybe mempty $ do foot = fromMaybe mempty $ do
ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory ebt <- itm ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 0.2 $ return $
reverse $ colorSH (bulletTrajColor ebt) $
rectNSWE 0.2 (- 0.2) (-2) (-1) upperPrismPoly 0.2 $
reverse $
rectNSWE 0.2 (- 0.2) (-2) (-1)
addTinClip :: Item -> Shape addTinClip :: Item -> Shape
addTinClip itm = fromMaybe mempty $ do addTinClip itm = fromMaybe mempty $ do
@@ -319,24 +293,38 @@ addTinClip itm = fromMaybe mempty $ do
makeTinClip :: Item -> Shape makeTinClip :: Item -> Shape
makeTinClip it = makeTinClip it =
colorSH midcol (upperPrismPoly 1 ( colorSH
reverse $ midcol
rectNSWE 0 (- y) (-1) 1)) <> tips <> tails ( upperPrismPoly
1
( reverse $
rectNSWE 0 (- y) (-1) 1
)
)
<> tips
<> tails
where where
midcol = maybe black bulletEffectColor midcol =
(it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect) maybe
black
bulletEffectColor
(it ^? itUse . heldConsumption . laAmmoType . amBullet . buEffect)
y = fromIntegral y' * 0.3 y = fromIntegral y' * 0.3
y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laLoaded y' = fromMaybe 0 $ it ^? itUse . heldConsumption . laLoaded
tips = fromMaybe mempty $ do tips = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buSpawn
return $ colorSH (bulletPayloadColor ebt) $ upperPrismPoly 1.1 $ return $
reverse $ colorSH (bulletPayloadColor ebt) $
rectNSWE 0 (- y) 1 2 upperPrismPoly 1.1 $
reverse $
rectNSWE 0 (- y) 1 2
tails = fromMaybe mempty $ do tails = fromMaybe mempty $ do
ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory ebt <- it ^? itUse . heldConsumption . laAmmoType . amBullet . buTrajectory
return $ colorSH (bulletTrajColor ebt) $ upperPrismPoly 1.1 $ return $
reverse $ colorSH (bulletTrajColor ebt) $
rectNSWE 0 (- y) (-2) (-1) upperPrismPoly 1.1 $
reverse $
rectNSWE 0 (- y) (-2) (-1)
bulletEffectColor :: BulletEffect -> Color bulletEffectColor :: BulletEffect -> Color
bulletEffectColor x = case x of bulletEffectColor x = case x of
@@ -347,9 +335,9 @@ bulletEffectColor x = case x of
bulletTrajColor :: BulletTrajectory -> Color bulletTrajColor :: BulletTrajectory -> Color
bulletTrajColor x = case x of bulletTrajColor x = case x of
BasicBulletTrajectory -> black BasicBulletTrajectory -> black
BezierTrajectory {} -> chartreuse BezierTrajectory{} -> chartreuse
FlechetteTrajectory {} -> white FlechetteTrajectory{} -> white
MagnetTrajectory {} -> yellow MagnetTrajectory{} -> yellow
bulletPayloadColor :: BulletSpawn -> Color bulletPayloadColor :: BulletSpawn -> Color
bulletPayloadColor x = case x of bulletPayloadColor x = case x of
@@ -366,29 +354,16 @@ energyBallColor ebt = case ebt of
ConcBall -> white ConcBall -> white
FlashBall -> yellow FlashBall -> yellow
volleyGunSPic :: Int -> Item -> SPic volleyGunShape :: Int -> Shape
volleyGunSPic i it = volleyGunShape i =
noPic $ colorSH
colorSH red
red ( foldMap
( foldMap ( (\y -> upperPrismPoly 3 $ map (+.+ V2 0 y) $ rectXH 15 2)
( (\y -> upperPrismPoly 3 $ map (+.+ V2 0 y) $ rectXH 15 2) . (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))
. (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))
)
[0 .. i -1]
) )
-- <> caneClipX i it [0 .. i -1]
)
caneClipX :: Int -> Item -> Shape
caneClipX i it = case it ^? itUse . heldConsumption . laLoaded of
Just la
| la > 0 ->
foldMap
( (\y -> translateSH (V3 5 0 3) . upperPrismPoly 1 $ map (+.+ V2 0 y) $ square 1.5)
. (\k -> fromIntegral k * 5 - ((fromIntegral i - 1) * 2.5))
)
[0 .. la -1]
_ -> mempty
miniGunXPictItem :: Int -> Item -> SPic miniGunXPictItem :: Int -> Item -> SPic
miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _heldConsumption (_itUse it)) miniGunXPictItem i it = miniGunXPict i spin (_laLoaded $ _heldConsumption (_itUse it))
@@ -413,15 +388,8 @@ miniGunXPict i spin _ =
-- . upperPrismPoly 2 -- . upperPrismPoly 2
-- $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5)) -- $ rectNESW (negate $ 3 + 0.25 * x) y 3 (y-5))
baseSonicShape :: Shape --baseSonicShape :: Shape
baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2 --baseSonicShape = colorSH rose $ upperPrismPoly 3 $ rectXH 25 2
revolverClip :: Item -> Shape
revolverClip it = case it ^? itUse . heldConsumption . laLoaded of
Just al | al > 0 -> translateSH (V3 5 0 1) $ foldMap f [1 .. al]
_ -> mempty
where
f i = rotateSHx (fromIntegral i * pi / 3 + pi / 6) . translateSH (V3 0 0 2) $ upperPrismPoly 1 $ square 1
baseSMGShape :: Shape baseSMGShape :: Shape
baseSMGShape = colorSH green $ upperPrismPoly 3 $ rectXH 20 2 baseSMGShape = colorSH green $ upperPrismPoly 3 $ rectXH 20 2
@@ -531,14 +499,14 @@ keyPic =
, thickLine 2 $ map toV2 [(4, 0), (4, -4)] , thickLine 2 $ map toV2 [(4, 0), (4, -4)]
] ]
latchkeyPic :: Picture --latchkeyPic :: Picture
latchkeyPic = --latchkeyPic =
color yellow $ -- color yellow $
pictures -- pictures
[ 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)]
] -- ]
legsSPic :: Color -> SPic legsSPic :: Color -> SPic
legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPoly 3 $ rectWH 2 2 legsSPic col = noPic $ translateSH (V3 0 4 0) $ colorSH col $ upperPrismPoly 3 $ rectWH 2 2