cube-0.2.0: tests/test.hs

{-#LANGUAGE OverloadedStrings#-}
{-#LANGUAGE FlexibleContexts#-}
{-#LANGUAGE TemplateHaskell#-}
{-#LANGUAGE QuasiQuotes#-}
{-#LANGUAGE ScopedTypeVariables#-}

import Test.Hspec
import Language.Cube
import Graphics.Formats.STL

-- | Generate house which is for demo.
house :: Block Cube
house = let house''  = (house' + square)*line
        in rfmap (12 * dz +) house''
  where
    house' :: Block Cube
    house' = block $ [cube 1 x y| x<-[-10..10], y<-[-10..10], y < x , y < (-x)]
    
    square :: Block Cube
    square = rfmap ((+) (-12 * dz)) $ block $ [cube 1 x y| x<-[-5..5], y<-[-5..5]]
    
    line :: Block Cube
    line = block $ [cube x 0 0 | x<-[-5..5]]

main :: IO ()
main = 
  hspec $ do
    describe "Cube(quoternion)" $ do
      it "dx" $ do
        cube 1 0 0 `shouldBe` dx
      it "dy" $ do
        cube 0 1 0 `shouldBe` dy
      it "dz" $ do
        cube 0 0 1 `shouldBe` dz
      it "dx +  dx" $ do
        dx + dx `shouldBe` cube 2 0 0 
      it "2 * dx" $ do
        2 * dx `shouldBe` cube 2 0 0 
      it "-2 * dx" $ do
        (-2) * dx `shouldBe` cube (-2) 0 0 
      it "route pi/2" $ do
        (dR (pi/2) dz dx) `shouldBe` cube 0 1 0
      it "route pi" $ do
        (dR (pi) dz dx) `shouldBe` cube (-1) 0 0
      it "route 3*pi/2" $ do
        (dR (3*pi/2) dz dx) `shouldBe` cube 0 (-1) 0
      it "route 2*pi" $ do
        (dR (2*pi) dz dx) `shouldBe` cube 1 0 0
      it "multi" $ do
        dx * dy `shouldBe` (dz :: Cube)
      it "multi" $ do
        dy * dx `shouldBe` (-dz :: Cube)
    describe "Block" $ do
      it "dx" $ do
        block [dx,dx] `shouldBe` (block [dx] :: Block Cube)
      it "dx+dy" $ do
        block [dx] + block [dy] `shouldBe` (block [dx,dy] :: Block Cube)
      it "[dx,dy]-dy" $ do
        block [dx,dy] - block [dy] `shouldBe` (block [dx] :: Block Cube)
      it "convolution(dx * [-2*dx,2*dx])" $ do
        block [dx] * block [-2*dx,2*dx] `shouldBe` (block [-dx,3*dx] :: Block Cube)
    describe "Compaction" $ do
      it "num triangle of one block" $ do
        length (triangles (toSTL (block [dx] :: Block Cube))) `shouldBe` 12
      it "num triangle of two block" $ do
        length (triangles (toSTL (block [dx,2*dx] :: Block Cube))) `shouldBe` 20
      it "flip triangle" $ do
        (flipTriangle (Triangle Nothing ((5.0,0,0),(1,0,0),(2,0,0)))) `shouldBe` (Triangle Nothing ((5.0,0,0),(2,0,0),(1,0,0)))
    describe "ToSTL" $ do
      it "Block Cube" $ do
        writeFileStl "tmp.stl" (block [dx] :: Block Cube) `shouldReturn` ()
        writeFileStl "house.stl" house `shouldReturn` ()