diff --git a/app/Main.hs b/app/Main.hs index a055f8e..c75103c 100644 --- a/app/Main.hs +++ b/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 -p3 x y z = P3 (V3 x y z) +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 + 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 = - [ (p3 (-0.5) (-0.5) (-0.5), p3 0.5 (-0.5) (-0.5)), +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), @@ -155,36 +182,34 @@ 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)), - - - (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), + (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 X Y ang pnt = +_rotate :: Direction -> Direction -> Float -> Point3D -> Point3D +_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 Z X a p = rotate X 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 Y Y _ _ = error "cant't rotate around 2 axis simultaniously" -rotate Z Z _ _ = error "cant't rotate around 2 axis simultaniously" +_rotate Y X a p = _rotate X Y a p +_rotate Z X a p = _rotate X 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 Y Y _ _ = 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 - logPutStrLn logState "" - 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)) + -- readIORef delta >>= writeIORef delta . (+ (0.25 / 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))))) @@ -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