partial rewrite of type logic

app/Main.hs

@@ -1,14 +1,17 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (unless)
+import Control.Monad.IO.Class (MonadIO)
 import Data.Bifoldable (bimapM_)
 import Data.Bifunctor (Bifunctor (bimap, second))
 import Data.Foldable (Foldable (toList))
 import Data.Functor ((<&>))
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Kind (Type)
 import Data.StateVar (StateVar (StateVar), makeStateVar, mapStateVar)
 import Foreign.C (CInt)
 import SDL (
@@ -37,6 +40,7 @@ import SDL (
   defaultWindow,
   destroyWindow,
   drawLine,
+  drawPoint,
   get,
   initialize,
   pollEvents,
@@ -53,7 +57,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import Text.Printf (PrintfType, printf)
 
 fps :: Int
-fps = 144
+fps = 1
 
 data LoggingState = On | Off
 
@@ -124,11 +128,19 @@ type Point3D = V3 Float
 
 type Line3D = (Point3D, Point3D)
 
+class Drawable a where
+  draw :: (MonadIO m, Functor m) => Window -> Renderer -> a -> m ()
+  absRotate :: Direction -> Direction -> Float -> a -> a
+  rotate :: Direction -> Direction -> Float -> a -> a
+
 data Pointrel = P2 Point2D | P3 Point3D deriving (Show)
 
 p2 :: Float -> Float -> Pointrel
 p2 x y = P2 (V2 x y)
 
+p3 :: Float -> Float -> Float -> Pointrel
+p3 x y z = P3 (V3 x y z)
+
 toP2 :: Pointrel -> Point2D
 toP2 (P2 pnt) = pnt
 toP2 (P3 pnt) = to2D pnt
@@ -137,17 +149,32 @@ toP3 :: Pointrel -> Point3D
 toP3 (P3 pnt) = pnt
 toP3 (P2 pnt) = let oldvec = toList pnt in V3 (head oldvec) (last oldvec) 0
 
-p3 :: Float -> Float -> Float -> Pointrel
+instance Drawable Pointrel where
-p3 x y z = P3 (V3 x y z)
+  draw window renderer (P3 pnt) = draw window renderer $ P2 $ to2D pnt
+  draw window renderer pnt = get $ windowSize window >>= drawPoint renderer . flip tosdl pnt
+  absRotate dir1 dir2 ang (P3 pnt) = P3 $ _rotate dir1 dir2 ang pnt
+  absRotate dir1 dir2 ang pnt = P3 $ _rotate dir1 dir2 ang $ toP3 pnt
+  rotate _ _ _ = id
 
-type Line = (Pointrel, Pointrel)
+newtype Line = Line (Pointrel, Pointrel)
+toLines :: [(Pointrel, Pointrel)] -> [Line]
+toLines = map Line
+unLine :: Line -> (Pointrel, Pointrel)
+unLine (Line points) = points
 
-type Object = [Line]
+instance Drawable Line where
+  draw window renderer (Line points) = get (windowSize window) >>= (\size -> uncurry (drawLine renderer) $ bimap (tosdl size) (tosdl size) points)
+
+data Object = Lines [Line] | Points [Pointrel]
+
+instance Drawable Object where
+  draw window renderer (Lines obj) = mapM_ (draw window renderer) obj
+  draw window renderer (Points obj) = mapM_ (draw window renderer) obj
 
 {- FOURMOLU_DISABLE -}
 square :: Object
-square =
+square = Lines $ toLines [
-  [ (p3 (-0.5) (-0.5) (-0.5), p3   0.5  (-0.5) (-0.5)),
+    (p3 (-0.5) (-0.5) (-0.5), p3   0.5  (-0.5) (-0.5)),
     (p3 (-0.5) (-0.5) (-0.5), p3 (-0.5)   0.5  (-0.5)),
     (p3 (-0.5) (-0.5) (-0.5), p3 (-0.5) (-0.5)   0.5),
 
@@ -159,32 +186,30 @@ square =
     (p3 (-0.5)   0.5    0.5, p3  (-0.5) (-0.5)   0.5),
     (p3 (-0.5)   0.5    0.5, p3  (-0.5)   0.5  (-0.5)),
 
-
     (p3   0.5  (-0.5)   0.5, p3    0.5    0.5    0.5),
     (p3   0.5  (-0.5)   0.5, p3  (-0.5) (-0.5)   0.5),
     (p3   0.5  (-0.5)   0.5, p3    0.5  (-0.5) (-0.5))
-
   ]
 {- FOURMOLU_ENABLE -}
 
 data Direction = X | Y | Z
 
-rotate :: Direction -> Direction -> Float -> Point3D -> Point3D
+_rotate :: Direction -> Direction -> Float -> Point3D -> Point3D
-rotate X Y ang pnt =
+_rotate X Y ang pnt =
   let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
    in V3 ((x * c) - (y * s)) ((x * s) + (y * c)) z
-rotate X Z ang pnt =
+_rotate X Z ang pnt =
   let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
    in V3 ((x * c) - (z * s)) y ((x * s) + (z * c))
-rotate Y Z ang pnt =
+_rotate Y Z ang pnt =
   let (c, s, toRotate, x, y, z) = (cos ang, sin ang, toList pnt, head toRotate, toRotate !! 1, last toRotate)
    in V3 x ((y * c) - (z * s)) ((y * s) + (z * c))
-rotate Y X a p = rotate X Y a p
+_rotate Y X a p = _rotate X Y a p
-rotate Z X a p = rotate X Z a p
+_rotate Z X a p = _rotate X Z a p
-rotate Z Y a p = rotate Y Z a p
+_rotate Z Y a p = _rotate Y Z a p
-rotate X X _ _ = error "cant't rotate around 2 axis simultaniously"
+_rotate X X _ _ = error "cant't rotate around 2 axis simultaniously"
-rotate Y Y _ _ = error "cant't rotate around 2 axis simultaniously"
+_rotate Y Y _ _ = error "cant't rotate around 2 axis simultaniously"
-rotate Z Z _ _ = error "cant't rotate around 2 axis simultaniously"
+_rotate Z Z _ _ = error "cant't rotate around 2 axis simultaniously"
 
 _rotateprint :: LoggingState -> Float -> Point3D -> IO ()
 _rotateprint On ang pnt =
@@ -228,15 +253,8 @@ loop renderer window = do
 
   oldObjs <- readIORef objects
 
-  mapM_ (mapM_ (bimapM_ (logPutStr logState . flip (++) " " . show . toP3) (logPrint logState . toP3)) . snd) oldObjs
+  -- readIORef delta >>= writeIORef delta . (+ (0.25 / fromIntegral fps))
-  logPutStrLn logState ""
+  readIORef delta >>= writeIORef delta . (+ (0.05 / fromIntegral fps))
-  logPutStrLn logState "rotateprint"
-  mapM_ (mapM_ (bimapM_ (rotateprint pi . toP3) (rotateprint pi . toP3)) . snd) oldObjs
-  logPutStrLn logState "rotateprint"
-
-  logPutStrLn logState ""
-
-  readIORef delta >>= writeIORef delta . (+ (0.25 / fromIntegral fps))
   tmpDelta <- readIORef delta
   let ang = 2 * pi * tmpDelta
   -- readIORef objects >>= (writeIORef objects . map (second (map (bimap (P3 . (+) (V3 0 0 delta) . toP3) (P3 . (+) (V3 0 0 delta) . toP3)))))
@@ -249,6 +267,8 @@ loop renderer window = do
   readIORef objects >>= mapM_ (mapM_ (logPrint logState) . snd)
   logPutStrLn logState ""
 
+  -- putStr "\ESC[H\ESC[2J"
+  mapM_ (mapM_ (bimapM_ (putStr . flip (++) " " . show . toP3) (print . toP3))) moved
   mapM_ (mapM_ (uncurry (drawLine renderer) . bimap (tosdl size) (tosdl size))) moved
 
   present renderer
@@ -265,7 +285,11 @@ loop renderer window = do
  - and finally from 0..2 to 0..1
  -}
 to2D :: Point3D -> Point2D
-to2D = (\vec -> V2 (head vec / last vec) (vec !! 1 / last vec)) . toList
+to2D pointin
+  | last vec == 0 = to2D $ pointin * V3 1 (-1) 1
+  | otherwise = V2 (head vec / last vec) (vec !! 1 / last vec)
+ where
+  vec = toList pointin
 
 {-
  - size `toIntegral`
@@ -276,5 +300,5 @@ to2D = (\vec -> V2 (head vec / last vec) (vec !! 1 / last vec)) . toList
  - return it in point form
  -}
 tosdl :: V2 CInt -> Pointrel -> Point V2 CInt
-tosdl size (P2 rel) = P $ fmap round $ fmap fromIntegral size * (1 - (rel + 1) / 2)
+tosdl size (P2 rel) = P $ fmap round $ fmap fromIntegral size * (1 - ((rel + 1) / 2))
 tosdl size (P3 rel) = tosdl size $ P2 $ to2D rel