almost complete type overhaul, working relative rotation

app/Main.hs

@@ -6,31 +6,25 @@ 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))
-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 (
   Event (eventPayload),
   EventPayload (KeyboardEvent, QuitEvent),
-  Hint (HintRenderScaleQuality),
-  HintPriority (DefaultPriority),
   InitFlag (InitVideo),
   InputMotion (Pressed, Released),
   KeyboardEventData (keyboardEventKeyMotion, keyboardEventKeysym),
   Keysym (keysymKeycode),
-  OpenGLConfig (glMultisampleSamples),
   Point (P),
   Renderer,
   V2 (V2),
   V3 (V3),
   V4 (V4),
   Window,
-  WindowConfig (WindowConfig, windowGraphicsContext, windowInitialSize),
+  WindowConfig (windowGraphicsContext, windowInitialSize),
   WindowGraphicsContext (OpenGLContext),
   clear,
   createRenderer,
@@ -47,17 +41,15 @@ import SDL (
   present,
   quit,
   rendererDrawColor,
-  setHintWithPriority,
-  waitEvent,
   windowSize,
   ($=),
  )
 import SDL.Input.Keyboard.Codes
 import System.IO.Unsafe (unsafePerformIO)
-import Text.Printf (PrintfType, printf)
+import Text.Printf (printf)
 
 fps :: Int
-fps = 1
+fps = 60
 
 data LoggingState = On | Off
 
@@ -102,6 +94,29 @@ main = do
   logPrint logState $ to2D $ V3 0.75 0.5 2
   logPutStrLn logState ""
 
+  let tmpPoint =
+        Lines
+          ( [ Line (p3 0 0 0, p3 1 0 0)
+            ],
+            p3 0 0 0
+          )
+  let movedPoint = move (Right (V3 0 0 1 :: V3 Float)) tmpPoint
+  let rotatedPoint = rotate X Z (pi / 2) movedPoint
+  let rotatedPoint2 = rotate X Z (-(pi / 2)) rotatedPoint
+  let movedBackPoint = move (Right (V3 0 0 (-1) :: V3 Float)) rotatedPoint2
+  putStr "tmpPoint: "
+  print tmpPoint
+  putStr "movedPoint: "
+  print movedPoint
+  putStr "debugGetCenteredObject movedPoint: "
+  print $ debugGetCenteredObject movedPoint
+  putStr "rotatedPoint: "
+  print rotatedPoint
+  putStr "rotatedPoint2: "
+  print rotatedPoint2
+  putStr "movedBackPoint: "
+  print movedBackPoint
+
   initialize [InitVideo]
 
   window <-
@@ -132,6 +147,8 @@ 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
+  move :: Either (V2 Float) (V3 Float) -> a -> a
+  movePrecise :: a -> a -> a
 
 data Pointrel = P2 Point2D | P3 Point3D deriving (Show)
 
@@ -151,12 +168,18 @@ toP3 (P2 pnt) = let oldvec = toList pnt in V3 (head oldvec) (last oldvec) 0
 
 instance Drawable Pointrel where
   draw window renderer (P3 pnt) = draw window renderer $ P2 $ to2D pnt
-  draw window renderer pnt = get $ windowSize window >>= drawPoint renderer . flip tosdl pnt
+  draw window renderer pnt = get (windowSize window) >>= drawPoint renderer . flip tosdl pnt
+  move (Left d2) (P2 p2D) = P2 $ p2D + d2
+  move (Right d3) (P2 p2D) = P3 $ (\x -> V3 (head x) (last x) (0 :: Float)) (toList p2D) + d3
+  move (Left d2) (P3 p3D) = P3 $ (\x -> V3 (head x) (last x) (0 :: Float)) (toList d2) + p3D
+  move (Right d3) (P3 p3D) = P3 $ p3D + d3
+  movePrecise a (P2 b) = move (Left b) a
+  movePrecise a (P3 b) = move (Right b) a
   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
 
-newtype Line = Line (Pointrel, Pointrel)
+newtype Line = Line (Pointrel, Pointrel) deriving (Show)
 toLines :: [(Pointrel, Pointrel)] -> [Line]
 toLines = map Line
 unLine :: Line -> (Pointrel, Pointrel)
@@ -164,32 +187,68 @@ unLine (Line points) = points
 
 instance Drawable Line where
   draw window renderer (Line points) = get (windowSize window) >>= (\size -> uncurry (drawLine renderer) $ bimap (tosdl size) (tosdl size) points)
+  move a (Line (b, c)) = Line (move a b, move a c)
+  movePrecise (Line (a1, b1)) (Line (a2, b2)) = Line (movePrecise a1 a2, movePrecise b1 b2)
+  absRotate dir1 dir2 ang (Line line) = Line $ bimap (absRotate dir1 dir2 ang) (absRotate dir1 dir2 ang) line
+  rotate dir1 dir2 ang (Line (P2 p_1, P2 p_2)) = let mid = (p_1 + p_2) / 2 in move (Left mid) $ absRotate dir1 dir2 ang $ Line (P2 (p_1 - mid), P2 (p_2 - mid))
+  rotate dir1 dir2 ang (Line (P2 _p_1, P3 p_2)) =
+    let
+      p_1 = toP3 (P2 _p_1)
+      mid = (p_1 + p_2) / 2
+     in
+      move (Right mid) $ absRotate dir1 dir2 ang $ Line (P3 (p_1 - mid), P3 (p_2 - mid))
+  rotate dir1 dir2 ang (Line (P3 p_1, P2 _p_2)) =
+    let
+      p_2 = toP3 (P2 _p_2)
+      mid = (p_1 + p_2) / 2
+     in
+      move (Right mid) $ absRotate dir1 dir2 ang $ Line (P3 (p_1 - mid), P3 (p_2 - mid))
+  rotate dir1 dir2 ang (Line (P3 p_1, P3 p_2)) = let mid = (p_1 + p_2) / 2 in move (Right mid) $ absRotate dir1 dir2 ang $ Line (P3 (p_1 - mid), P3 (p_2 - mid))
 
-data Object = Lines [Line] | Points [Pointrel]
+data Object = Lines ([Line], Pointrel) | Points ([Pointrel], Pointrel) deriving (Show)
 
 instance Drawable Object where
-  draw window renderer (Lines obj) = mapM_ (draw window renderer) obj
+  draw window renderer (Lines (obj, _)) = mapM_ (draw window renderer) obj
-  draw window renderer (Points obj) = mapM_ (draw window renderer) obj
+  draw window renderer (Points (obj, _)) = mapM_ (draw window renderer) obj
+  move a (Lines (b, c)) = Lines (map (move a) b, move a c)
+  move a (Points (b, c)) = Points (map (move a) b, move a c)
+  movePrecise _ = id
+  absRotate dir1 dir2 ang (Lines (obj, center)) = Lines (map (absRotate dir1 dir2 ang) obj, center)
+  absRotate dir1 dir2 ang (Points (obj, center)) = Points (map (absRotate dir1 dir2 ang) obj, center)
+  rotate dir1 dir2 ang (Lines (obj, P3 center)) = move (Right center) $ absRotate dir1 dir2 ang $ Lines (map (move $ Right $ center * (-1)) obj, p3 0 0 0)
+  rotate dir1 dir2 ang (Lines (obj, P2 center)) = move (Left center) $ absRotate dir1 dir2 ang $ Lines (map (move $ Left $ center * (-1)) obj, p2 0 0)
+  rotate dir1 dir2 ang (Points (obj, P3 center)) = move (Right center) $ absRotate dir1 dir2 ang $ Points (map (move $ Right $ center * (-1)) obj, p3 0 0 0)
+  rotate dir1 dir2 ang (Points (obj, P2 center)) = move (Left center) $ absRotate dir1 dir2 ang $ Points (map (move $ Left $ center * (-1)) obj, p2 0 0)
+
+debugGetCenteredObject :: Object -> Object
+debugGetCenteredObject (Lines (obj, P3 center)) = Lines (map (move $ Right $ center * (-1)) obj, P3 center)
+debugGetCenteredObject (Lines (obj, P2 center)) = Lines (map (move $ Left $ center * (-1)) obj, P2 center)
+debugGetCenteredObject (Points (obj, P3 center)) = Points (map (move $ Right $ center * (-1)) obj, P3 center)
+debugGetCenteredObject (Points (obj, P2 center)) = Points (map (move $ Left $ center * (-1)) obj, P2 center)
 
 {- FOURMOLU_DISABLE -}
 square :: Object
-square = Lines $ toLines [
+square =
-    (p3 (-0.5) (-0.5) (-0.5), p3   0.5  (-0.5) (-0.5)),
+  Lines
-    (p3 (-0.5) (-0.5) (-0.5), p3 (-0.5)   0.5  (-0.5)),
+    ( toLines
-    (p3 (-0.5) (-0.5) (-0.5), p3 (-0.5) (-0.5)   0.5),
+        [ (p3 (-1) (-1) 0, p3   1   (-1) 0),
+          (p3 (-1) (-1) 0, p3 (-1)    1  0),
+          (p3 (-1) (-1) 0, p3 (-1)  (-1) 2),
 
-    (p3   0.5    0.5  (-0.5), p3   0.5    0.5    0.5),
+          (p3   1    1  0, p3   1     1  2),
-    (p3   0.5    0.5  (-0.5), p3   0.5  (-0.5) (-0.5)),
+          (p3   1    1  0, p3   1   (-1) 0),
-    (p3   0.5    0.5  (-0.5), p3 (-0.5)   0.5  (-0.5)),
+          (p3   1    1  0, p3 (-1)    1  0),
 
-    (p3 (-0.5)   0.5    0.5, p3    0.5    0.5    0.5),
+          (p3 (-1)   1  2, p3    1    1  2),
-    (p3 (-0.5)   0.5    0.5, p3  (-0.5) (-0.5)   0.5),
+          (p3 (-1)   1  2, p3  (-1) (-1) 2),
-    (p3 (-0.5)   0.5    0.5, p3  (-0.5)   0.5  (-0.5)),
+          (p3 (-1)   1  2, p3  (-1)   1  0),
 
-    (p3   0.5  (-0.5)   0.5, p3    0.5    0.5    0.5),
+          (p3   1  (-1) 2, p3    1    1  2),
-    (p3   0.5  (-0.5)   0.5, p3  (-0.5) (-0.5)   0.5),
+          (p3   1  (-1) 2, p3  (-1) (-1) 2),
-    (p3   0.5  (-0.5)   0.5, p3    0.5  (-0.5) (-0.5))
+          (p3   1  (-1) 2, p3    1  (-1) 0)
-  ]
+        ],
+      p3 0 0 1
+    )
 {- FOURMOLU_ENABLE -}
 
 data Direction = X | Y | Z
@@ -200,7 +259,7 @@ _rotate X Y ang pnt =
    in V3 ((x * c) - (y * s)) ((x * s) + (y * c)) z
 _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))
+   in V3 ((x * c) + (z * s)) y ((z * c) - (s * x))
 _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))
@@ -249,30 +308,32 @@ loop renderer window = do
 
   rendererDrawColor renderer $= V4 0 0 0 255
 
-  size <- get $ windowSize window
+  -- size <- get $ windowSize window
 
-  oldObjs <- readIORef objects
+  -- oldObjs <- readIORef objects
 
-  -- readIORef delta >>= writeIORef delta . (+ (0.25 / fromIntegral fps))
+  -- readIORef delta >>= writeIORef delta . (+ (0.05 / fromIntegral fps))
-  readIORef delta >>= writeIORef delta . (+ (0.05 / 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)))))
   -- readIORef objects >>= (writeIORef objects . map (second (map (bimap (P3 . rotate X Z ang . toP3) (P3 . rotate X Z ang . toP3)))))
 
-  rotated <- readIORef objects <&> map (map (bimap (P3 . rotate X Z ang . toP3) (P3 . rotate X Z ang . toP3)) . snd)
+  rotated <- readIORef objects <&> map snd -- <&> map (rotate Y Z ang . snd)
+  mapM_ (logPrint logState) rotated
   -- let rotated = map (map (bimap (P3 . rotate X Y ang . toP3) (P3 . rotate X Z ang . toP3))) rotated1
-  let moved = map (map (bimap (P3 . (+) (V3 0 0 tmpDelta) . toP3) (P3 . (+) (V3 0 0 tmpDelta) . toP3))) rotated
+  let moved = map (move (Right (V3 0 0 tmpDelta))) rotated
+  mapM_ (logPrint logState) moved
 
-  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_ (bimapM_ (putStr . flip (++) " " . show . toP3) (print . toP3))) moved
-  mapM_ (mapM_ (uncurry (drawLine renderer) . bimap (tosdl size) (tosdl size))) moved
+  mapM_ (draw window renderer . rotate Y Z ang . rotate X Y ang . rotate X Z ang) moved
+  -- mapM_ (draw window renderer) moved
 
   present renderer
 
+  writeIORef delta $ (+) tmpDelta $ 0.25 / fromIntegral fps
   unless (or stop) continue
  where
   continue = threadDelay (1000000 `div` fps) >> loop renderer window
@@ -286,8 +347,8 @@ loop renderer window = do
  -}
 to2D :: Point3D -> Point2D
 to2D pointin
-  | last vec == 0 = to2D $ pointin * V3 1 (-1) 1
+  | last vec == 0 = to2D $ pointin + V3 0 0 0.01
-  | otherwise = V2 (head vec / last vec) (vec !! 1 / last vec)
+  | otherwise = V2 (head vec / last vec) ((vec !! 1) / last vec)
  where
   vec = toList pointin