Add trajectory to grenades, various refactoring

src/Shape.hs

@@ -4,6 +4,8 @@ module Shape
     , translateSH
     , emptySH
     , upperPrismPoly
+    , upperPrismPolyHalf
+    , prismPoly
     , polyCirc
     , translateSHz
     , translateSHf
@@ -25,6 +27,23 @@ polyCirc :: Int -> Float -> [Point2]
 {-# INLINE polyCirc #-}
 polyCirc n x = map (\a -> rotateV a (V2 x 0)) $ take (n*2) [0,pi/fromIntegral n..]
 
+-- very "unsafe": be careful with the inputs
+-- length of polys must be the same
+-- points should be correctly ordered so that
+-- polys form a prism-like object with quad faces between them
+prismPoly 
+    :: [Point3] 
+    -> [Point3] 
+    -> Shape
+{-# INLINE prismPoly #-}
+prismPoly upps downps = [ShapeObj (TopPrism n) (f upps downps)]
+  where
+    n = length upps
+    f (a:as) (b:bs) = g a:g b:f as bs
+    f [] _ = []
+    f _ [] = []
+    g p = ShapeV p black
+
 upperPrismPoly 
     :: Float    -- ^ height, expected to be strictly positive
     -> [Point2] 
@@ -41,6 +60,22 @@ upperPrismPoly h ps = [ShapeObj (TopPrism n) (f upps downps)]
     f' (V2 x y) = pairToSV (V3 x y h, black)
     f'' (V2 x y) = pairToSV (V3 x y 0, black)
 
+upperPrismPolyHalf
+    :: Float    -- ^ height, expected to be strictly positive
+    -> [Point2] 
+    -> Shape
+{-# INLINE upperPrismPolyHalf #-}
+upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (f upps downps)]
+  where
+    n = length ps
+    upps = map f' ps
+    downps = map f'' ps
+    f (a:as) (b:bs) = a:b:f as bs
+    f [] _ = []
+    f _ [] = []
+    f' (V2 x y) = pairToSV (V3 (0.5 * x) (0.5 * y) h, black)
+    f'' (V2 x y) = pairToSV (V3 x y 0, black)
+
 colorSH :: Color -> Shape -> Shape
 {-# INLINE colorSH #-}
 colorSH col = overCol $ const col