partial rewrite of type logic
This commit is contained in:
parent
9c6f8eedc5
commit
2eecc8990e
1 changed files with 60 additions and 36 deletions
84
app/Main.hs
84
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),
|
||||
|
||||
|
|
@ -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 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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue