Skip to content

@NathanHowell /bar.hs secret
Last active

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
  1. NathanHowell revised this gist . 1 changed file with 25 additions and 18 deletions.
    View
    43 bar.hs
    @@ -1,10 +1,15 @@
    import Prelude
    +-- import Data.List
    +import qualified Data.Sequence as S
    +import Data.Foldable
    +import Data.Monoid
    +import Data.Traversable
    data Qt = Qt {
    - qx :: Double,
    - qy :: Double,
    - qz :: Double,
    - qw :: Double
    + qx :: {-# UNPACK #-} !Double,
    + qy :: {-# UNPACK #-} !Double,
    + qz :: {-# UNPACK #-} !Double,
    + qw :: {-# UNPACK #-} !Double
    } deriving (Show)
    qmul :: Qt -> Qt -> Qt
    @@ -21,9 +26,9 @@ axis_ang :: Vec -> Double -> Qt
    axis_ang axis ang = Qt ((vx axis) * (sin (ang/2))) ((vy axis) * (sin (ang/2))) ((vz axis) * (sin (ang/2))) (cos (ang/2))
    data Vec = Vec {
    - vx :: Double,
    - vy :: Double,
    - vz :: Double
    + vx :: {-# UNPACK #-} !Double,
    + vy :: {-# UNPACK #-} !Double,
    + vz :: {-# UNPACK #-} !Double
    } deriving (Show)
    vrot :: Qt -> Vec -> Vec
    @@ -67,11 +72,11 @@ data Pivot = Pivot {
    } deriving (Show)
    data Mesh = Mesh {
    - mesh_rot :: Qt,
    - mesh_cpos :: Vec,
    - mesh_positions :: [Double],
    - mesh_colors :: [Double],
    - mesh_indexes :: [Int]
    + mesh_rot :: !Qt,
    + mesh_cpos :: !Vec,
    + mesh_positions :: !(S.Seq Double),
    + mesh_colors :: !(S.Seq Double),
    + mesh_indexes :: !(S.Seq Int)
    } deriving (Show)
    faceIndexes :: Int -> Int -> Int -> Int -> [Int]
    @@ -86,23 +91,25 @@ faceIndexes i j w h =
    buildMesh :: [Pivot] -> Mesh
    -buildMesh pivots = foldl build_layer initial (zip [0..] pivots) where
    - initial = Mesh (Qt 0 0 0 1) (Vec 0 0 0) [] [] []
    +buildMesh pivots = foldl' build_layer initial (zip [0..] pivots) where
    + initial = Mesh (Qt 0 0 0 1) (Vec 0 0 0) S.empty S.empty S.empty
    width = length (pivot_rads (head pivots))
    height = length pivots
    depth = 3
    - build_layer step (j,pivot) = foldl build_vertexes step (zip3 [0..] (pivot_rads pivot) (pivot_cols pivot)) where
    + build_layer step (j,pivot) = foldl' build_vertexes step (zip3 [0..] (pivot_rads pivot) (pivot_cols pivot)) where
    rot = qmul (mesh_rot step) (pivot_rot pivot)
    cpos = vadd (mesh_cpos step) (vrot rot (Vec 0 0 (pivot_len pivot)))
    build_vertexes step (i,vrad,vcol) = Mesh rot cpos positions colors indexes where
    vang = ((fromIntegral i)/(fromIntegral width))*2.0*pi
    vpos = vadd cpos (vrot rot (vproj vang vrad))
    - positions = (mesh_positions step) ++ [(vx vpos),(vy vpos),(vz vpos)]
    - colors = (mesh_colors step) ++ [(r vcol),(g vcol),(b vcol)]
    - indexes = (mesh_indexes step) ++ (faceIndexes i j width height)
    + positions = (mesh_positions step) <> S.fromList [(vx vpos),(vy vpos),(vz vpos)]
    + colors = (mesh_colors step) <> S.fromList [(r vcol),(g vcol),(b vcol)]
    + indexes = (mesh_indexes step) <> S.fromList (faceIndexes i j width height)
    +mesh :: Mesh
    mesh = buildMesh
    (replicate 128
    (Pivot 1 (Qt 0 0 0 1) [1,1,1,1,1,1,1,1] [(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1)]))
    +main :: IO ()
    main = print mesh
  2. NathanHowell created this gist .
    View
    108 bar.hs
    @@ -0,0 +1,108 @@
    +import Prelude
    +
    +data Qt = Qt {
    + qx :: Double,
    + qy :: Double,
    + qz :: Double,
    + qw :: Double
    +} deriving (Show)
    +
    +qmul :: Qt -> Qt -> Qt
    +qmul a b = Qt
    + (qx a * qw b + qw a * qx b + qy a * qz b - qz a * qy b)
    + (qy a * qw b + qw a * qy b + qz a * qx b - qx a * qz b)
    + (qz a * qw b + qw a * qz b + qx a * qy b - qy a * qx b)
    + (qw a * qw b - qx a * qx b - qy a * qy b - qz a * qz b)
    +
    +qinv :: Qt -> Qt
    +qinv a = Qt (-(qx a)) (-(qy a)) (-(qz a)) (qw a)
    +
    +axis_ang :: Vec -> Double -> Qt
    +axis_ang axis ang = Qt ((vx axis) * (sin (ang/2))) ((vy axis) * (sin (ang/2))) ((vz axis) * (sin (ang/2))) (cos (ang/2))
    +
    +data Vec = Vec {
    + vx :: Double,
    + vy :: Double,
    + vz :: Double
    +} deriving (Show)
    +
    +vrot :: Qt -> Vec -> Vec
    +vrot rot vec = vec_from_qt (qmul (qmul rot (qt_from_vec vec)) (qinv rot))
    +
    +qt_from_vec :: Vec -> Qt
    +qt_from_vec a = Qt (vx a) (vy a) (vz a) 0
    +
    +vec_from_qt :: Qt -> Vec
    +vec_from_qt a = Vec (qx a) (qy a) (qz a)
    +
    +vproj :: Double -> Double -> Vec
    +vproj ang rad = Vec ((cos ang) * rad) ((sin ang) * rad) 0
    +
    +vop :: (Double -> Double -> Double) -> Vec -> Vec -> Vec
    +vop f a b = Vec (f (vx a) (vx b)) (f (vy a) (vy b)) (f (vz a) (vz b))
    +
    +vadd :: Vec -> Vec -> Vec
    +vadd = vop (+)
    +
    +vdiv :: Vec -> Vec -> Vec
    +vdiv = vop (/)
    +
    +vsub :: Vec -> Vec -> Vec
    +vsub = vop (-)
    +
    +vmul :: Vec -> Vec -> Vec
    +vmul = vop (*)
    +
    +data Col = Col {
    + r :: Double,
    + g :: Double,
    + b :: Double
    +} deriving (Show)
    +
    +data Pivot = Pivot {
    + pivot_len :: Double,
    + pivot_rot :: Qt,
    + pivot_rads :: [Double],
    + pivot_cols:: [Col]
    +} deriving (Show)
    +
    +data Mesh = Mesh {
    + mesh_rot :: Qt,
    + mesh_cpos :: Vec,
    + mesh_positions :: [Double],
    + mesh_colors :: [Double],
    + mesh_indexes :: [Int]
    +} deriving (Show)
    +
    +faceIndexes :: Int -> Int -> Int -> Int -> [Int]
    +faceIndexes i j w h =
    + if j < (h-1) then
    + let a = j*w+i
    + b = j*w+(mod (i+1) w)
    + c = (j+1)*w+i
    + d = (j+1)*w+(mod (i+1) w)
    + in [a,b,d,d,c,a]
    + else []
    +
    +
    +buildMesh :: [Pivot] -> Mesh
    +buildMesh pivots = foldl build_layer initial (zip [0..] pivots) where
    + initial = Mesh (Qt 0 0 0 1) (Vec 0 0 0) [] [] []
    + width = length (pivot_rads (head pivots))
    + height = length pivots
    + depth = 3
    + build_layer step (j,pivot) = foldl build_vertexes step (zip3 [0..] (pivot_rads pivot) (pivot_cols pivot)) where
    + rot = qmul (mesh_rot step) (pivot_rot pivot)
    + cpos = vadd (mesh_cpos step) (vrot rot (Vec 0 0 (pivot_len pivot)))
    + build_vertexes step (i,vrad,vcol) = Mesh rot cpos positions colors indexes where
    + vang = ((fromIntegral i)/(fromIntegral width))*2.0*pi
    + vpos = vadd cpos (vrot rot (vproj vang vrad))
    + positions = (mesh_positions step) ++ [(vx vpos),(vy vpos),(vz vpos)]
    + colors = (mesh_colors step) ++ [(r vcol),(g vcol),(b vcol)]
    + indexes = (mesh_indexes step) ++ (faceIndexes i j width height)
    +
    +mesh = buildMesh
    + (replicate 128
    + (Pivot 1 (Qt 0 0 0 1) [1,1,1,1,1,1,1,1] [(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1),(Col 1 1 1)]))
    +
    +main = print mesh
Something went wrong with that request. Please try again.