{-# LANGUAGE MultiWayIf #-}

module AronGraphic where

import           Control.Concurrent (threadDelay)
import           Control.Monad                        (unless, when)
import           Control.Monad
import           Data.IORef
import           Data.Maybe
import           Data.Set                             (Set, delete, fromList)
                 
import qualified                            Data.Set         as S
import qualified                            Data.List        as L
import Graphics.Rendering.OpenGL            as               GL
import Graphics.Rendering.OpenGL.GLU.Matrix as               GM
import qualified                            Graphics.UI.GLFW as FW
import qualified                            Graphics.UI.GLUT as GLUT

import           System.Exit
import           System.IO
import           System.Random
import           GHC.Real
import           Data.Complex

import Control.Lens
    ( Field1(_1), Field2(_2), Field3(_3), Field4(_4), (<&>), (^.) )
import qualified Data.Vector as VU
import           AronModule
import qualified Text.Printf as PR
import Data.Typeable (typeOf)
                 
-- import qualified Data.Vector.Unboxed as VU
-- Unboxed only support
{-|
Unboxed Arrays: Data.Vector.Unboxed

    Bool
    ()
    Char
    Double
    Float
    Int
    Int8, 16, 32, 64
    Word
    Word8, 16, 32, 64
    Complex a's, where 'a' is in Unbox
    Tuple types, where the elements are unboxable
-}



--import Linear.V3
--import Linear.V3(cross)
--import Linear.Vector
--import Linear.Matrix
--import Linear.Projection as P
--import Linear.Metric(norm, signorm)

-- epsilon_ = 0.00001

lightDiffuse ::Color4 GLfloat
lightDiffuse :: Color4 GLfloat
lightDiffuse = GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
0.6 GLfloat
1.0 GLfloat
0.5 GLfloat
0.6

lightAmbient ::Color4 GLfloat
lightAmbient :: Color4 GLfloat
lightAmbient = GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
0.0 GLfloat
0.0 GLfloat
1.0 GLfloat
1.0

lightPosition ::Vertex4 GLfloat
lightPosition :: Vertex4 GLfloat
lightPosition = GLfloat -> GLfloat -> GLfloat -> GLfloat -> Vertex4 GLfloat
forall a. a -> a -> a -> a -> Vertex4 a
Vertex4 GLfloat
1.0 GLfloat
1.0 GLfloat
1.2 GLfloat
0.0

lightSpecular ::Color4 GLfloat
lightSpecular :: Color4 GLfloat
lightSpecular = GLfloat -> GLfloat -> GLfloat -> GLfloat -> Color4 GLfloat
forall a. a -> a -> a -> a -> Color4 a
Color4 GLfloat
1.0 GLfloat
0.7 GLfloat
1.0 GLfloat
0.8

{-|
    === KEY: draw string, render string

    @
    GL.scale (1/scaleFont :: GL.GLdouble) (1/scaleFont) 1
    GLUT.renderString GLUT.Roman str

    strWidth <- GLUT.stringWidth GLUT.Roman str
    strHeight <- GLUT.stringHeight GLUT.Roman str
    @
-}
scaleFont::GLdouble
scaleFont :: GLdouble
scaleFont = GLdouble
3000.0
                
-- | --------------------------------------------------------------------------------
-- | Fri Dec  7 14:35:38 2018
-- | three colors: data Color3 a = Color3 !a !a !a
-- | Add more colors: Sun 27 Jun 23:56:15 2021 
red :: Color3 GLdouble
red   = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
1 GLdouble
0 GLdouble
0 :: Color3 GLdouble
green :: Color3 GLdouble
green = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0 GLdouble
1 GLdouble
0 :: Color3 GLdouble
blue :: Color3 GLdouble
blue  = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0 GLdouble
0 GLdouble
1 :: Color3 GLdouble
white :: Color3 GLdouble
white = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
1 GLdouble
1 GLdouble
1 :: Color3 GLdouble
black :: Color3 GLdouble
black = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0 GLdouble
0 GLdouble
0 :: Color3 GLdouble
gray :: Color3 GLdouble
gray  = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0.47 GLdouble
0.47 GLdouble
0.47 :: Color3 GLdouble
gray1 :: Color3 GLdouble
gray1  = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0.8 GLdouble
0.8 GLdouble
0.8 :: Color3 GLdouble
cyan :: Color3 GLdouble
cyan    = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0 GLdouble
1 GLdouble
1 :: Color3 GLdouble
magenta :: Color3 GLdouble
magenta = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
1.0 GLdouble
0 GLdouble
1.0 :: Color3 GLdouble
yellow :: Color3 GLdouble
yellow  = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
1.0 GLdouble
1.0 GLdouble
0 :: Color3 GLdouble
color1 :: Color3 GLdouble
color1 = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0 GLdouble
0.3 GLdouble
0.9 :: Color3 GLdouble
color2 :: Color3 GLdouble
color2 = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0.5 GLdouble
0.3 GLdouble
0.9 :: Color3 GLdouble
color3 :: Color3 GLdouble
color3 = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0.2 GLdouble
0.3 GLdouble
0.2 :: Color3 GLdouble
color4 :: Color3 GLdouble
color4 = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0.2 GLdouble
0.0 GLdouble
0.2 :: Color3 GLdouble
color5 :: Color3 GLdouble
color5 = GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3 GLdouble
0.1 GLdouble
0.4 GLdouble
0.8 :: Color3 GLdouble

data SegEndPt = No      -- no pt, just a segment
                | End   -- end pt
                | Beg   -- begin pt
                | Both  -- begin and end pts
                | Cen   -- center pt
                | All   -- all pts: begin, end and ceneter

--   /\
--   | ccw
--    -->
--   | cw
--   V
-- | counter clockwise | clock wise
data NormalDir = NCCW | NCW deriving (NormalDir -> NormalDir -> Bool
(NormalDir -> NormalDir -> Bool)
-> (NormalDir -> NormalDir -> Bool) -> Eq NormalDir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalDir -> NormalDir -> Bool
$c/= :: NormalDir -> NormalDir -> Bool
== :: NormalDir -> NormalDir -> Bool
$c== :: NormalDir -> NormalDir -> Bool
Eq)


{-|
    === Compute the distance between two points

    \( v = (x, y, z) \)

    \( \| v \| = \sqrt{ x^2 + y^2 + z^2} = \sqrt{ v \cdot v} \)

    >let v1 = Vertex3 1 2 3
    >let v2 = Vertex3 2 3 4
    >dist v1 v2
-}
dist::(Floating a) => Vertex3 a -> Vertex3 a -> a
dist :: Vertex3 a -> Vertex3 a -> a
dist (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x0)a -> a -> a
forall a. Floating a => a -> a -> a
**a
2 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0)a -> a -> a
forall a. Floating a => a -> a -> a
**a
2 a -> a -> a
forall a. Num a => a -> a -> a
+ (a
z1 a -> a -> a
forall a. Num a => a -> a -> a
- a
z0)a -> a -> a
forall a. Floating a => a -> a -> a
**a
2
  
{-|
    === Compute the distance between two points

    * Same as 'dist'

    \( v = (x, y, z) \)

    \( \| v \| = \sqrt{ x^2 + y^2 + z^2} = \sqrt{ v \cdot v} \)

    >let v1 = Vertex3 1 2 3
    >let v2 = Vertex3 2 3 4
    >distX v1 v2
-}
distX::(Floating a) => Vertex3 a -> Vertex3 a -> a
distX :: Vertex3 a -> Vertex3 a -> a
distX = Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist

{-|
    === Compute the norm-squared

    \( v = (x, y, z)\)

    \( |v|^2 = x^2 + y^2 + z^2 \)

    >let v1 = Vertex3 1 2 3
    >let v2 = Vertex3 2 3 4
    >sqdist v1 v2
-}
sqdist::Vertex3 GLfloat-> Vertex3 GLfloat-> GLfloat
sqdist :: Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
sqdist (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) (Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1) = (GLfloat
x1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
x0)GLfloat -> GLfloat -> GLfloat
forall a. Floating a => a -> a -> a
**GLfloat
2 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ (GLfloat
y1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
y0)GLfloat -> GLfloat -> GLfloat
forall a. Floating a => a -> a -> a
**GLfloat
2 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ (GLfloat
z1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
z0)GLfloat -> GLfloat -> GLfloat
forall a. Floating a => a -> a -> a
**GLfloat
2

{-|
   === KEY: dot product of two Vector3
-}
dot3ve::(Num a)=>Vector3 a-> Vector3 a-> a
dot3ve :: Vector3 a -> Vector3 a -> a
dot3ve (Vector3 a
x a
y a
z) (Vector3 a
x' a
y' a
z') = Vertex3 a -> Vertex3 a -> a
forall a. Num a => Vertex3 a -> Vertex3 a -> a
dot3vx (a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z) (a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x' a
y' a
z')

-- | dot product for Vertex3
dot3vx::(Num a)=>Vertex3 a-> Vertex3 a-> a
dot3vx :: Vertex3 a -> Vertex3 a -> a
dot3vx (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a
x0a -> a -> a
forall a. Num a => a -> a -> a
*a
x1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y0a -> a -> a
forall a. Num a => a -> a -> a
*a
y1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
z0a -> a -> a
forall a. Num a => a -> a -> a
*a
z1

{-|
    === KEY: add vertex to vector, vector to vertex, translate vectex to other vectex, affine transform

    NOTE: Points and Vectors in afine space

    0 + vector      => vector
    vextex + vector => vextex
    vextex - vectex => vector
    0      -      0 => 0 vector
-}
(+:)::(Num a)=>Vertex3 a-> Vector3 a-> Vertex3 a
+: :: Vertex3 a -> Vector3 a -> Vertex3 a
(+:) (Vertex3 a
x0 a
y0 a
z0) (Vector3 a
x1 a
y1 a
z1) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
z1)

  
{-|
    === KEY: vertex to vector, vector from two Vertex3, vector = Vertex3 - Vertex3
-}
(-:)::(Num a)=>Vertex3 a-> Vertex3 a-> Vector3 a
-- (-:) (Vertex3 x0 y0 z0) (Vertex3 x1 y1 z1) = Vector3 (x0 - x1) (y0 - y1) (z0 - z1)
-: :: Vertex3 a -> Vertex3 a -> Vector3 a
(-:) (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x0) (a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0) (a
z1 a -> a -> a
forall a. Num a => a -> a -> a
- a
z0)

(⊥)::Vector3 GLfloat -> Vector3 GLfloat
⊥ :: Vector3 GLfloat -> Vector3 GLfloat
(⊥) (Vector3 GLfloat
x GLfloat
y GLfloat
z) = GLfloat -> GLfloat -> GLfloat -> Vector3 GLfloat
forall a. a -> a -> a -> Vector3 a
Vector3 GLfloat
y (-GLfloat
x) GLfloat
z

{-|
   === KEY: perpendicular vector

   URL: <http://xfido.com/image/perpendicular_vector.svg perpendicular_vector >
-}
perpcw::(Num a)=>Vector3 a->Vector3 a
perpcw :: Vector3 a -> Vector3 a
perpcw (Vector3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
y (-a
x) a
z
  
{-|
   === KEY: perpendicular vector

   URL: <http://xfido.com/image/perpendicular_vector.svg perpendicular_vector >
-}
perpccw::(Num a)=>Vector3 a->Vector3 a
perpccw :: Vector3 a -> Vector3 a
perpccw (Vector3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (-a
y) a
x a
z


-- KEY: operator symbol, symbol operator, math operator
{-|
   === KEY: Scalar multiplies a vector
-}
(*:)::(Num a)=>a-> Vector3 a-> Vector3 a
*: :: a -> Vector3 a -> Vector3 a
(*:) a
k (Vector3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
x) (a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
y) (a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
z)

(/:)::(Num a, Fractional a)=> Vector3 a -> Integer -> Vector3 a
/: :: Vector3 a -> Integer -> Vector3 a
(/:) (Vector3 a
x a
y a
z) Integer
n = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
x' a
y' a
z'
  where
    x' :: a
x' = a
x a -> a -> a
forall a. Fractional a => a -> a -> a
/ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fi Integer
n
    y' :: a
y' = a
y a -> a -> a
forall a. Fractional a => a -> a -> a
/ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fi Integer
n
    z' :: a
z' = a
z a -> a -> a
forall a. Fractional a => a -> a -> a
/ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fi Integer
n

{-|
  KEY: scalar multiplies vertex, vertex multiplies scalar
-}
(**:)::(Num a) => a -> Vertex3 a -> Vertex3 a
**: :: a -> Vertex3 a -> Vertex3 a
(**:) a
a (Vertex3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
x) (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
y) (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
z)

{--
(**:)::GLfloat -> Vertex3 GLfloat-> Vertex3 GLfloat
(**:) t (Vertex3 x0 y0 z0) = Vertex3 (t*x0) (t*y0) (t*z0)
--}

(×) :: (Num a) => a -> [a] -> [a]
× :: a -> [a] -> [a]
(×) a
a = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> a
forall a. Num a => a -> a -> a
*a
a)
  
(××) :: (Num a) => a -> [[a]] -> [[a]]
×× :: a -> [[a]] -> [[a]]
(××) a
a = (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [a]) -> [[a]] -> [[a]])
-> ((a -> a) -> [a] -> [a]) -> (a -> a) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map) (a -> a -> a
forall a. Num a => a -> a -> a
*a
a)

(*>:)::(Num a) => a -> Vertex3 a -> Vertex3 a
*>: :: a -> Vertex3 a -> Vertex3 a
(*>:) a
k (Vertex3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
x) (a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
y) (a
ka -> a -> a
forall a. Num a => a -> a -> a
*a
z)
  
{--
(*>:)::GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
(*>:) k (Vertex3 x y z) = Vertex3 (k*x) (k*y) (k*z)
--}
  
(>>:)::(Num a) => a -> Vector3 a -> Vector3 a
>>: :: a -> Vector3 a -> Vector3 a
(>>:) a
a (Vector3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
x) (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
y) (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
z)
  
{--
(>>:)::GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
(>>:) k (Vector3 x y z) = Vector3 (k*x) (k*y) (k*z)

(.>)::Int
(.>) = 3
--}

-- | dot product  odot
-- (⊙)::Vector3 GLfloat -> Vector3 GLfloat -> GLfloat
-- (⊙) (Vector3 x0 y0 z0) (Vector3 x1 y1 z1) = (x0*x1) + (y0*y1) + (z0*z1)

(∈)::(Num a, Ord a)=>a -> [a]-> Bool
∈ :: a -> [a] -> Bool
(∈) a
a [a
b, a
c] = a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
b Bool -> Bool -> Bool
&& a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
c

-- (∘)::(Num a)=>a-> Vector3 a-> Vector3 a
-- (∘) k (Vector3 x y z) = Vector3 (k*x) (k*y) (k*z)


(∎)::GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
∎ :: GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
(∎) GLfloat
k (Vector3 GLfloat
x GLfloat
y GLfloat
z) = GLfloat -> GLfloat -> GLfloat -> Vector3 GLfloat
forall a. a -> a -> a -> Vector3 a
Vector3 (GLfloat
kGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
z) (GLfloat
kGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
y) (GLfloat
kGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
z)

v2x::(Num a)=>Vector3 a-> Vertex3 a
v2x :: Vector3 a -> Vertex3 a
v2x (Vector3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z

x2v::(Num a)=>Vertex3 a-> Vector3 a
x2v :: Vertex3 a -> Vector3 a
x2v (Vertex3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
x a
y a
z

-- Tue Jan  1 17:57:32 2019
-- remove it
--smulv::GLfloat -> Vector3 GLfloat ->Vector3 GLfloat
--smulv k (Vector3 x y z) = Vector3 (k*x) (k*y) (k*z)

-- | Shorten realToFrac
--rf::(Real a, Fractional b) => a -> b
--rf = realToFrac



{-|
    === Form a __skew symmetric matrix__ from \( \color{red}{Vertex3}  \)
    __cross product__ of a x b = [a] b where [a] is skew symmetric matrix from vector a
    colIndex x rowIndex = [c][r]

    >Vertex3 a1 a2 a3

    \[
     \begin{bmatrix}
            0    & -a_3 & a_2 \\
            a_3  & 0    & -a_1 \\
            -a_2 & a_1  & 0 \\
     \end{bmatrix}
    \]

-}
skew::(Num a)=>Vertex3 a->[[a]]
skew :: Vertex3 a -> [[a]]
skew (Vertex3 a
a1 a
a2 a
a3) = [
                            [a
0,     -a
a3, a
a2],
                            [a
a3,    a
0,  -a
a1],
                            [-a
a2,   a
a1,   a
0]
                          ]


{-|
    * deprecated,

    Use 'skewVec', better name

    === Form a __skew symmetric matrix__ from \( \color{red}{Vector3}  \)
    __cross product__ of a x b = [a] b where [a] is skew symmetric matrix from vector a
    colIndex x rowIndex = [c][r]

    >Vertex3 a1 a2 a3

    \[
     \begin{bmatrix}
            0    & -a_3 & a_2 \\
            a_3  & 0    & -a_1 \\
            -a_2 & a_1  & 0 \\
     \end{bmatrix}
    \]
-}
skew'::(Num a)=>Vector3 a-> [[a]]
skew' :: Vector3 a -> [[a]]
skew' (Vector3 a
x a
y a
z) = [
                         [a
0,     -a
z, a
y],
                         [a
z,    a
0,  -a
x],
                         [-a
y,   a
x,   a
0]
                        ]
  
{-|
    === Form a __skew symmetric matrix__ from \( \color{red}{Vector3}  \)
    __cross product__ of a x b = [a] b where [a] is skew symmetric matrix from vector a
    colIndex x rowIndex = [c][r]

    >Vertex3 a1 a2 a3

    \[
     \begin{bmatrix}
            0    & -a_3 & a_2 \\
            a_3  & 0    & -a_1 \\
            -a_2 & a_1  & 0 \\
     \end{bmatrix}
    \]
-}  
skewVec::(Num a)=>Vector3 a-> [[a]]
skewVec :: Vector3 a -> [[a]]
skewVec (Vector3 a
x a
y a
z) = [
                           [a
0,  -a
z, a
y ],
                           [a
z,  a
0,  -a
x],
                           [-a
y, a
x,  a
0 ]
                          ]
{--
{-|
  === KEY: Cross product of two vectors. unicode code

  * The direction is determinated by the the Right Hand Rule
-}
(⊗)::(Num a) => Vector3 a -> Vector3 a -> Vector3 a
(⊗) v0@(Vector3 a1 a2 a3) v1@(Vector3 b1 b2 b3) = Vector3 x y z
                    where
                        vs = [
                              [b1],
                              [b2],
                              [b3]
                             ]
                        -- form a skew matrix from v0
                        sk = skew' v0
                        -- cross product: v0 ⊗ v1
                        vc  = multiMat sk vs
                        ls = join vc
                        x  = head ls
                        y  = (head . tail) ls
                        z  = last ls
--}
  

{-|
  === KEY: Cross product of two vectors. unicode code

  * The direction is determinated by the the Right Hand Rule

  NOTE: deprecated, use 'crossF'
-}  
(⊗)::(Num a, Eq a) => Vector3 a -> Vector3 a -> Maybe (Vector3 a)
⊗ :: Vector3 a -> Vector3 a -> Maybe (Vector3 a)
(⊗) = Vector3 a -> Vector3 a -> Maybe (Vector3 a)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
crossX

  
{-|

  === KEY: Cross product of two vectors. unicode code

  * The directin is determinated by the the Right Hand Rule

  NOTE: deprecated, use 'crossF'
-}
cross::(Num a, Eq a)=> Vector3 a -> Vector3 a -> Maybe (Vector3 a)
cross :: Vector3 a -> Vector3 a -> Maybe (Vector3 a)
cross = Vector3 a -> Vector3 a -> Maybe (Vector3 a)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
crossX
  
{-|
  === KEY: Cross product of two vectors. unicode code
  NOTE: deprecated, use 'crossF'
-}
crossX :: (Num a, Eq a) => Vector3 a -> Vector3 a -> Maybe (Vector3 a)
crossX :: Vector3 a -> Vector3 a -> Maybe (Vector3 a)
crossX v :: Vector3 a
v@(Vector3 a
x a
y a
z) v' :: Vector3 a
v'@(Vector3 a
x' a
y' a
z') = Bool
isZero Bool -> Maybe (Vector3 a) -> Maybe (Vector3 a) -> Maybe (Vector3 a)
forall a. Bool -> a -> a -> a
? Maybe (Vector3 a)
forall a. Maybe a
Nothing (Maybe (Vector3 a) -> Maybe (Vector3 a))
-> Maybe (Vector3 a) -> Maybe (Vector3 a)
forall a b. (a -> b) -> a -> b
$ Vector3 a -> Maybe (Vector3 a)
forall a. a -> Maybe a
Just (a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
x0 a
y0 a
z0) 
  where
    vs :: [[a]]
vs = [[a
x'], [a
y'], [a
z']]
    sk :: [[a]]
sk = Vector3 a -> [[a]]
forall a. Num a => Vector3 a -> [[a]]
skewVec Vector3 a
v
    vc :: [[a]]
vc = [[a]] -> [[a]] -> [[a]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat [[a]]
sk [[a]]
vs
    ls :: [a]
ls = [[a]] -> [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[a]]
vc
    x0 :: a
x0 = [a] -> a
forall a. [a] -> a
head [a]
ls
    y0 :: a
y0 = ([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail) [a]
ls
    z0 :: a
z0 = [a] -> a
forall a. [a] -> a
last [a]
ls
    isZero :: Bool
isZero = a
x0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
y0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
&& a
z0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0

{-|

  === KEY: Cross product using 'Fractional' 

  DATE: Thu 14 Mar 20:14:11 2024 

  NOTE: epsilon = 1e-12 

  * The direction is determinated by the the Right Hand Rule

  NOTE: do not use 'cross' and 'crossX' 
-}
crossF :: Vector3 GLdouble -> Vector3 GLdouble -> Maybe (Vector3 GLdouble)
-- crossF :: (Fractional a, Eq a, Ord a) => Vector3 a -> Vector3 a -> Maybe (Vector3 a)
crossF :: Vector3 GLdouble -> Vector3 GLdouble -> Maybe (Vector3 GLdouble)
crossF v :: Vector3 GLdouble
v@(Vector3 GLdouble
x GLdouble
y GLdouble
z) v' :: Vector3 GLdouble
v'@(Vector3 GLdouble
x' GLdouble
y' GLdouble
z') = Bool
isZero Bool
-> Maybe (Vector3 GLdouble)
-> Maybe (Vector3 GLdouble)
-> Maybe (Vector3 GLdouble)
forall a. Bool -> a -> a -> a
? Maybe (Vector3 GLdouble)
forall a. Maybe a
Nothing (Maybe (Vector3 GLdouble) -> Maybe (Vector3 GLdouble))
-> Maybe (Vector3 GLdouble) -> Maybe (Vector3 GLdouble)
forall a b. (a -> b) -> a -> b
$ Vector3 GLdouble -> Maybe (Vector3 GLdouble)
forall a. a -> Maybe a
Just (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
x0 GLdouble
y0 GLdouble
z0) 
  where
    eps :: GLdouble
eps = GLdouble
1e-12 
    vs :: [[GLdouble]]
vs = [[GLdouble
x'], [GLdouble
y'], [GLdouble
z']]
    sk :: [[GLdouble]]
sk = Vector3 GLdouble -> [[GLdouble]]
forall a. Num a => Vector3 a -> [[a]]
skewVec Vector3 GLdouble
v
    vc :: [[GLdouble]]
vc = [[GLdouble]] -> [[GLdouble]] -> [[GLdouble]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat [[GLdouble]]
sk [[GLdouble]]
vs
    ls :: [GLdouble]
ls = [[GLdouble]] -> [GLdouble]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[GLdouble]]
vc
    x0 :: GLdouble
x0 = [GLdouble] -> GLdouble
forall a. [a] -> a
head [GLdouble]
ls
    y0 :: GLdouble
y0 = ([GLdouble] -> GLdouble
forall a. [a] -> a
head ([GLdouble] -> GLdouble)
-> ([GLdouble] -> [GLdouble]) -> [GLdouble] -> GLdouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GLdouble] -> [GLdouble]
forall a. [a] -> [a]
tail) [GLdouble]
ls
    z0 :: GLdouble
z0 = [GLdouble] -> GLdouble
forall a. [a] -> a
last [GLdouble]
ls
    isZero :: Bool
isZero = GLdouble -> GLdouble
forall a. Num a => a -> a
abs GLdouble
x0 GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
< GLdouble
eps Bool -> Bool -> Bool
&& GLdouble -> GLdouble
forall a. Num a => a -> a
abs GLdouble
y0 GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
< GLdouble
eps Bool -> Bool -> Bool
&& GLdouble -> GLdouble
forall a. Num a => a -> a
abs GLdouble
z0 GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
< GLdouble
eps
    
{-|
    === Check whether four points are coplanar
-}
isCoplanar::Vertex3 GLfloat ->Vertex3 GLfloat ->Vertex3 GLfloat ->Vertex3 GLfloat -> Bool
isCoplanar :: Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
isCoplanar Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 = Bool
nis0 Bool -> Bool -> Bool
&& Bool
nis1 Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? Vector3 GLfloat -> GLfloat
forall a. Floating a => Vector3 a -> a
norm Vector3 GLfloat
vn GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== GLfloat
0.0 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
False
                where
                  nis0 :: Bool
nis0 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                  nis1 :: Bool
nis1 = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                  v0 :: Vector3 GLfloat
v0  = Vertex3 GLfloat
q0 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0 -- p0 -> q0
                  v1 :: Vector3 GLfloat
v1  = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0 -- p0 -> q1
                  v2 :: Vector3 GLfloat
v2  = Vertex3 GLfloat
q0 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p1 -- p1 -> q0
                  v3 :: Vector3 GLfloat
v3  = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p1 -- p1 -> q1
                  v01' :: Vector3 GLfloat
v01' = case Vector3 GLfloat -> Vector3 GLfloat -> Maybe (Vector3 GLfloat)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
cross Vector3 GLfloat
v0 Vector3 GLfloat
v1 of
                                  Maybe (Vector3 GLfloat)
Nothing -> [Char] -> Vector3 GLfloat
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: three pts p0 q0 q1, it might be colinear"
                                  Just Vector3 GLfloat
v  -> Vector3 GLfloat
v
                  
                  v12' :: Vector3 GLfloat
v12' = case Vector3 GLfloat -> Vector3 GLfloat -> Maybe (Vector3 GLfloat)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
cross Vector3 GLfloat
v2 Vector3 GLfloat
v3 of
                                  Maybe (Vector3 GLfloat)
Nothing -> [Char] -> Vector3 GLfloat
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: three pts p1 q0 q1, it might be colinear"
                                  Just Vector3 GLfloat
v -> Vector3 GLfloat
v

                  norm :: Vector3 a -> a
norm Vector3 a
v = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Vector3 a -> Vector3 a -> a
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve Vector3 a
v Vector3 a
v
                  vn :: Vector3 GLfloat
vn = case Vector3 GLfloat -> Vector3 GLfloat -> Maybe (Vector3 GLfloat)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
cross Vector3 GLfloat
v01' Vector3 GLfloat
v12' of
                             Maybe (Vector3 GLfloat)
Nothing -> [Char] -> Vector3 GLfloat
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: three pts, it might be colinear"
                             Just Vector3 GLfloat
v -> Vector3 GLfloat
v

{-|
    === KEY: compute the normal of three points
-}            
normal3:: (Num a, Eq a) => Vertex3 a ->Vertex3 a ->Vertex3 a ->Maybe (Vector3 a)
normal3 :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Maybe (Vector3 a)
normal3 Vertex3 a
p0 Vertex3 a
q0 Vertex3 a
q1 = if Bool
isc then Maybe (Vector3 a)
forall a. Maybe a
Nothing else Vector3 a
v0 Vector3 a -> Vector3 a -> Maybe (Vector3 a)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
⊗ Vector3 a
v1
                where
                    isc :: Bool
isc = Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 a
p0 Vertex3 a
q0 Vertex3 a
q1
                    v0 :: Vector3 a
v0  = Vertex3 a
q0 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p0
                    v1 :: Vector3 a
v1  = Vertex3 a
q1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p0
{--
  Saturday, 10 February 2024 12:12 PST
  DELETE IT
{-|
    === KEY: compute the normal of plane with two given vectors
-}
normal3'::Vector3 GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
normal3' v0 v1 = v0 ⊗ v1
--}
  
{-|
  === num instance for Vertex3
-}
instance (Num a)=> Num(Vertex3 a) where
    (-) (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
- a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
- a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
- a
z1)
    + :: Vertex3 a -> Vertex3 a -> Vertex3 a
(+) (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
z1)
    negate :: Vertex3 a -> Vertex3 a
negate (Vertex3 a
x0 a
y0 a
z0)                 = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (-a
x0) (-a
y0) (-a
z0)
    abs :: Vertex3 a -> Vertex3 a
abs (Vertex3 a
x0 a
y0 a
z0)                    = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a -> a
forall a. Num a => a -> a
abs a
x0) (a -> a
forall a. Num a => a -> a
abs a
y0) (a -> a
forall a. Num a => a -> a
abs a
z0)
    * :: Vertex3 a -> Vertex3 a -> Vertex3 a
(*) (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
* a
z1)
    signum :: Vertex3 a -> Vertex3 a
signum (Vertex3 a
x a
y a
z)                   = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a -> a
forall a. Num a => a -> a
signum a
x) (a -> a
forall a. Num a => a -> a
signum a
y) (a -> a
forall a. Num a => a -> a
signum a
z)
    fromInteger :: Integer -> Vertex3 a
fromInteger Integer
x                            = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x) (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)

{-|
  === num instance for Vector3
-}
instance (Num a)=> Num(Vector3 a) where
    (-) (Vector3 a
x0 a
y0 a
z0) (Vector3 a
x1 a
y1 a
z1) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
- a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
- a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
- a
z1)
    + :: Vector3 a -> Vector3 a -> Vector3 a
(+) (Vector3 a
x0 a
y0 a
z0) (Vector3 a
x1 a
y1 a
z1) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
z1)
    negate :: Vector3 a -> Vector3 a
negate (Vector3 a
x0 a
y0 a
z0)                 = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (-a
x0) (-a
y0) (-a
z0)
    abs :: Vector3 a -> Vector3 a
abs    (Vector3 a
x0 a
y0 a
z0)                 = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a -> a
forall a. Num a => a -> a
abs a
x0) (a -> a
forall a. Num a => a -> a
abs a
y0) (a -> a
forall a. Num a => a -> a
abs a
z0)
    * :: Vector3 a -> Vector3 a -> Vector3 a
(*) (Vector3 a
x0 a
y0 a
z0) (Vector3 a
x1 a
y1 a
z1) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 (a
x0 a -> a -> a
forall a. Num a => a -> a -> a
* a
x1) (a
y0 a -> a -> a
forall a. Num a => a -> a -> a
* a
y1) (a
z0 a -> a -> a
forall a. Num a => a -> a -> a
* a
z1)
    signum :: Vector3 a -> Vector3 a
signum Vector3 a
_                                  = Vector3 a
forall a. HasCallStack => a
undefined
    fromInteger :: Integer -> Vector3 a
fromInteger Integer
_                             = Vector3 a
forall a. HasCallStack => a
undefined

-- | Vector: p0 -> p1 = p1 - p0
vec::(Num a) => Vertex3 a -> Vertex3 a -> Vector3 a
vec :: Vertex3 a -> Vertex3 a -> Vector3 a
vec Vertex3 a
p0 Vertex3 a
p1 = Vertex3 a
p1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p0


{-|
    KEY: Given a point and vector

    * Draw a line passes a point p₀ alone the vector v₀

    r(t) = p₀ + t(p₁ - p₀)

    @
    let p0 = Vertex3 0.0 0.0 0.0
    let v0 = Vector3 0.4 0.5 0.0
    let p1 = ray p0 1.0 v0
    drawSegmentls green [p0, p1]
    @
-}
ray::Vertex3 GLfloat -> GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
ray :: Vertex3 GLfloat -> GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
ray Vertex3 GLfloat
p0 GLfloat
t Vector3 GLfloat
v = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
t GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v)
  
{-|
    KEY: Given a point and vector

    * Draw a line passes a point p₀ alone the vector v₀

    r(t) = p₀ + t(p₁ - p₀)

    @
    let p0 = Vertex3 0.0 0.0 0.0
    let v0 = Vector3 0.4 0.5 0.0
    let p1 = ray2 1.0 p0 v0
    drawSegmentls green [p0, p1]
    @
-}  
ray2::GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
ray2 :: GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
ray2 GLfloat
t Vertex3 GLfloat
p0 Vector3 GLfloat
v = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
t GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v)



{-|
    === KEY: perpendicular line to c₀ center of p₀ p₁

    Given s, t, p₀ and p₁
    1. c₀ = center p₀ p₁
    2. p₁' = p₀ + s(⊥ p0 p1), p₂' = p₀ + t(⊥ p₀ p₁)
    3. Draw line from p₁' to p₂'

    @
    let vv0 = Vertex3 1   (negate 1  ) 0.0
    let vv1 = Vertex3 1.8 (negate 1.5) 0.0
    let v = [vv0, vv1]
    drawSegmentWithEndPt red v
    let vls = perpenLine 0.9 (-0.2) vv0 vv1

    drawSegmentWithEndPt green vls
    @

-}
perpenLine::GLfloat -> GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat]
perpenLine :: GLfloat
-> GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
perpenLine GLfloat
s GLfloat
t Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 = [Vertex3 GLfloat
c0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
s GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v), Vertex3 GLfloat
c0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
t GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v)]
           where
             v :: Vector3 GLfloat
v = Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw (Vector3 GLfloat -> Vector3 GLfloat)
-> Vector3 GLfloat -> Vector3 GLfloat
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
vec Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 -- p₀ → p₁
             c0 :: Vertex3 GLfloat
c0= Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
cen Vertex3 GLfloat
p0 Vertex3 GLfloat
p1

{-|
    === KEY: draw curve from given function
-}
curvePt::(GLfloat -> GLfloat)->(GLfloat, GLfloat)->[Vertex3 GLfloat]
curvePt :: (GLfloat -> GLfloat) -> (GLfloat, GLfloat) -> [Vertex3 GLfloat]
curvePt GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) = [GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x (GLfloat -> GLfloat
f GLfloat
x) GLfloat
0 | GLfloat
x <- let n :: GLfloat
n = GLfloat
100; d :: GLfloat
d = (GLfloat
b GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
n; in (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
a GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
xGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
d) [GLfloat
0..GLfloat
n]]
                   
curvePtD::(GLdouble -> GLdouble)->(GLdouble, GLdouble)->[Vertex3 GLdouble]
curvePtD :: (GLdouble -> GLdouble)
-> (GLdouble, GLdouble) -> [Vertex3 GLdouble]
curvePtD GLdouble -> GLdouble
f (GLdouble
a, GLdouble
b) = [GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x (GLdouble -> GLdouble
f GLdouble
x) GLdouble
0 | GLdouble
x <- let n :: GLdouble
n = GLdouble
100; d :: GLdouble
d = (GLdouble
b GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- GLdouble
a)GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
n; in (GLdouble -> GLdouble) -> [GLdouble] -> [GLdouble]
forall a b. (a -> b) -> [a] -> [b]
map(\GLdouble
x -> GLdouble
a GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
xGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
d) [GLdouble
0..GLdouble
n]]
                   
curvePtV::(GLfloat -> GLfloat)->(GLfloat, GLfloat)-> VU.Vector (Vertex3 GLfloat)
-- curvePtV f (a, b) = VU.fromList [Vertex3 0.1 10.1 10.0]
curvePtV :: (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> Vector (Vertex3 GLfloat)
curvePtV GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) = (GLfloat -> Vertex3 GLfloat)
-> Vector GLfloat -> Vector (Vertex3 GLfloat)
forall a b. (a -> b) -> Vector a -> Vector b
VU.map(\GLfloat
x -> GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x (GLfloat -> GLfloat
f GLfloat
x) GLfloat
0 ) (Vector GLfloat -> Vector (Vertex3 GLfloat))
-> Vector GLfloat -> Vector (Vertex3 GLfloat)
forall a b. (a -> b) -> a -> b
$ let n :: Int
n = Int
100; d :: GLfloat
d = (GLfloat
b GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
n) in (GLfloat -> GLfloat) -> Vector GLfloat -> Vector GLfloat
forall a b. (a -> b) -> Vector a -> Vector b
VU.map(\GLfloat
x -> GLfloat
a GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
xGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
d) (Vector GLfloat -> Vector GLfloat)
-> Vector GLfloat -> Vector GLfloat
forall a b. (a -> b) -> a -> b
$ GLfloat -> Int -> Vector GLfloat
forall a. Num a => a -> Int -> Vector a
VU.enumFromN GLfloat
0 Int
n


{-| 
    === Given a function \(f\), interval \( (a, b) \)

    Draw the curve on xy-plane from \(a\) to \(b\)

    >mapM_ (\n -> drawCurve (\x -> x^n) (-1.0, 1.0) green) [1..20]

    @
    let f = \x -> negate (x - 0.5)*(x + 0.5)
    drawCurve f (negate 1.0, 1.0) green
    @

    <http://localhost/image/opengl_drawcurve.png drawcurve>

   
-} 
drawCurve::(GLfloat -> GLfloat) -> (GLfloat, GLfloat) ->Color3 GLdouble  -> IO()
drawCurve :: (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> Color3 GLdouble -> IO ()
drawCurve GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat) -> (GLfloat, GLfloat) -> [Vertex3 GLfloat]
curvePt GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b)
  
drawCurveList::[Vertex3 GLfloat] ->Color3 GLdouble  -> IO()
drawCurveList :: [Vertex3 GLfloat] -> Color3 GLdouble -> IO ()
drawCurveList [Vertex3 GLfloat]
cx Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) [Vertex3 GLfloat]
cx
  
drawCurveListWithEndPt::[Vertex3 GLfloat] ->Color3 GLdouble  -> IO()
drawCurveListWithEndPt :: [Vertex3 GLfloat] -> Color3 GLdouble -> IO ()
drawCurveListWithEndPt [Vertex3 GLfloat]
cx Color3 GLdouble
c = do
                              PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
                                                          Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                                          Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) [Vertex3 GLfloat]
cx
                              Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red   GLdouble
0.01 (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head [Vertex3 GLfloat]
cx
                              Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
last [Vertex3 GLfloat]
cx        
  
drawCurveD::(GLdouble -> GLdouble) -> (GLdouble, GLdouble) ->Color3 GLdouble  -> IO()
drawCurveD :: (GLdouble -> GLdouble)
-> (GLdouble, GLdouble) -> Color3 GLdouble -> IO ()
drawCurveD GLdouble -> GLdouble
f (GLdouble
a, GLdouble
b) Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLdouble -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLdouble
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLdouble -> IO ()) -> Vertex3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLdouble
vx) ([Vertex3 GLdouble] -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble)
-> (GLdouble, GLdouble) -> [Vertex3 GLdouble]
curvePtD GLdouble -> GLdouble
f (GLdouble
a, GLdouble
b)                       

drawCurveV::(GLfloat -> GLfloat) -> (GLfloat, GLfloat) ->Color3 GLdouble  -> IO()
drawCurveV :: (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> Color3 GLdouble -> IO ()
drawCurveV GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> Vector (Vertex3 GLfloat) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
VU.mapM_(\Vertex3 GLfloat
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) (Vector (Vertex3 GLfloat) -> IO ())
-> Vector (Vertex3 GLfloat) -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> Vector (Vertex3 GLfloat)
curvePtV GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b)
  

{-| 
    === draw Surface for equation \( f(x, y) = x^2 + y^2 \) form

    Draw \( f (x, y) = x^2 + y^2 \)

    > drawSurface (\x y -> x^2 + y^2)
-} 
drawSurface::(GLfloat -> GLfloat -> GLfloat) -> IO()
drawSurface :: (GLfloat -> GLfloat -> GLfloat) -> IO ()
drawSurface GLfloat -> GLfloat -> GLfloat
f = do
    ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat -> GLfloat) -> [[Vertex3 GLfloat]]
grid2 GLfloat -> GLfloat -> GLfloat
f 
    ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
blue) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat -> GLfloat) -> [[Vertex3 GLfloat]]
grid2 GLfloat -> GLfloat -> GLfloat
f 

{-| 
    === draw Surface for equation \( f(x, y) = x^2 + y^2 \) form

    Draw \( f (x, y) = x^2 + y^2 \)

    > r = 2 => 1/(r*n) 
    > drawSurfaceR (\x y -> x^2 + y^2) r 
-} 
drawSurfaceR::(GLfloat -> GLfloat -> GLfloat) -> GLfloat -> IO()
drawSurfaceR :: (GLfloat -> GLfloat -> GLfloat) -> GLfloat -> IO ()
drawSurfaceR GLfloat -> GLfloat -> GLfloat
f GLfloat
r = do
    ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
row -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red [Vertex3 GLfloat]
row ) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat -> GLfloat) -> GLfloat -> [[Vertex3 GLfloat]]
grid2Ratio GLfloat -> GLfloat -> GLfloat
f GLfloat
r
    ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
row -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red [Vertex3 GLfloat]
row ) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat -> GLfloat) -> GLfloat -> [[Vertex3 GLfloat]]
grid2Ratio GLfloat -> GLfloat -> GLfloat
f GLfloat
r


    

--drawParamSurf::(GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> IO() 
--drawParamSurf fx fy fz = do 
--    mapM_ (\row -> drawSegmentFromTo red row ) $ pts 
--    mapM_ (\row -> drawSegmentFromTo red row ) $ tran pts 
--        where 
--            n  = 10 
--            fa = 1/(1.5*n)
--            t = map(\x -> rf $ fa * x) [-n..n]
--            pts = [[ Vertex3 (fx t) (fy t) (fz t)]]


{-| 
    === Plot all pts

    <http://localhost/image/opengl_plot_pt.png Plot_Points>

    @
    plot 2d graphic

    Divide each pair of point as  (x, y, 0)

    interval from [-len/2.. len/2]
    let pts = [0.3, 0.4, 0.1, 0.2] 
    plotPts red pts 
    plotPts green $ quickSort1 pts
    @
-} 
plotPts::Color3 GLdouble -> [GLfloat] ->IO()
plotPts :: Color3 GLdouble -> [GLfloat] -> IO ()
plotPts Color3 GLdouble
co [GLfloat]
cx = do
                let n :: Int
n = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div ([GLfloat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GLfloat]
cx) Int
2
                let xx :: [GLdouble]
xx = let del :: GLdouble
del = GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
n) in (Int -> GLdouble) -> [Int] -> [GLdouble]
forall a b. (a -> b) -> [a] -> [b]
map(\Int
x -> GLdouble
delGLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*(Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
x)) [-Int
n..Int
n]
                let xx' :: [GLfloat]
xx' = (GLdouble -> GLfloat) -> [GLdouble] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLdouble
x -> GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
x) [GLdouble]
xx
                let vl :: [Vertex3 GLfloat]
vl = (GLfloat -> GLfloat -> Vertex3 GLfloat)
-> [GLfloat] -> [GLfloat] -> [Vertex3 GLfloat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\GLfloat
x GLfloat
y -> GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y GLfloat
0) [GLfloat]
xx' [GLfloat]
cx 
                let pair :: [Vertex3 GLfloat]
pair = [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Vertex3 GLfloat]] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Vertex3 GLfloat
x Vertex3 GLfloat
y -> [Vertex3 GLfloat
x, Vertex3 GLfloat
y]) ([Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
init [Vertex3 GLfloat]
vl) ([Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
tail [Vertex3 GLfloat]
vl)
                (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vertex3 GLfloat
x -> Vertex3 GLfloat -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor Vertex3 GLfloat
x Color3 GLdouble
red GLdouble
0.01) [Vertex3 GLfloat]
vl 
                PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
Lines Color3 GLdouble
co [Vertex3 GLfloat]
pair 

{-|
  Draw a line that is tangent at pt (c, f(c)) where x in [x0, x1]

  <http://localhost/image/tangleline.png tangentLine>

  1. Given a function f, and x0 on x-Axis

  2. Derive a tangent line at (c, f(c)) with slop = f'(c)

  3. Interpolate (x0, f(x0)) and (x1, f(x1))

-}
tangentLine::(Fractional a)=>(a->a)->(a, a)->a->[Vertex3 a]
tangentLine :: (a -> a) -> (a, a) -> a -> [Vertex3 a]
tangentLine a -> a
f (a
x0, a
x1) a
c = Integer -> Vertex3 a -> Vertex3 a -> [Vertex3 a]
forall a.
Fractional a =>
Integer -> Vertex3 a -> Vertex3 a -> [Vertex3 a]
interpolate' Integer
1 Vertex3 a
p0 Vertex3 a
p1
        where
            y0 :: a
y0 = (a -> a) -> a -> a -> a
forall a. Fractional a => (a -> a) -> a -> a -> a
tangent a -> a
f a
x0 a
c  -- y = slop(x - c) + (f x0)
            y1 :: a
y1 = (a -> a) -> a -> a -> a
forall a. Fractional a => (a -> a) -> a -> a -> a
tangent a -> a
f a
x1 a
c  -- y = slop(x - c) + (f x1)
            p0 :: Vertex3 a
p0 = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x0 a
y0 a
0
            p1 :: Vertex3 a
p1 = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x1 a
y1 a
0

interpolate'::(Fractional a)=>Integer -> Vertex3 a->Vertex3 a->[Vertex3 a]
interpolate' :: Integer -> Vertex3 a -> Vertex3 a -> [Vertex3 a]
interpolate' Integer
n p0 :: Vertex3 a
p0@(Vertex3 a
x0 a
y0 a
z0) p1 :: Vertex3 a
p1@(Vertex3 a
x1 a
y1 a
z1) = (Integer -> Vertex3 a) -> [Integer] -> [Vertex3 a]
forall a b. (a -> b) -> [a] -> [b]
map(\Integer
k -> let t :: a
t = a
da -> a -> a
forall a. Num a => a -> a -> a
*(Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
k) in Vertex3 a
p0 Vertex3 a -> Vector3 a -> Vertex3 a
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (a
t a -> Vector3 a -> Vector3 a
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 a
ve)) [Integer
0..Integer
n]
                    where
                        ve :: Vector3 a
ve = Vertex3 a
p1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p0 -- vector: p0 -> p1
                        d :: a
d = a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/(Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
n)

{-|
    === Given a function f, interval (a, b),
        draw a tangent line at (x0, f(x0)) from a to b
    >f::x -> y

    (a, b) is interval

    differentiate at (x0, f x0)
-}
drawTangentLine::(GLfloat->GLfloat)->(GLfloat, GLfloat) -> GLfloat -> Color3 GLdouble -> IO()
drawTangentLine :: (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> GLfloat -> Color3 GLdouble -> IO ()
drawTangentLine GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) GLfloat
x0 Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
pts
                    where
                        pts :: [Vertex3 GLfloat]
pts = (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> GLfloat -> [Vertex3 GLfloat]
forall a. Fractional a => (a -> a) -> (a, a) -> a -> [Vertex3 a]
tangentLine GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) GLfloat
x0

{-|
 === NormalDir is either counter clockwise or clockwise for normal

 (x0, x1) is interval for the normal
 f is  any function
 x=c is the tangent point at (c, f c)

 >data NormalDir = NCCW | NCW deriving (Eq)
-}
normalLine::NormalDir -> (GLfloat->GLfloat)->(GLfloat, GLfloat)->GLfloat->[Vertex3 GLfloat]
normalLine :: NormalDir
-> (GLfloat -> GLfloat)
-> (GLfloat, GLfloat)
-> GLfloat
-> [Vertex3 GLfloat]
normalLine NormalDir
n GLfloat -> GLfloat
f (GLfloat
x0, GLfloat
x1) GLfloat
c = Integer -> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat]
forall a.
Fractional a =>
Integer -> Vertex3 a -> Vertex3 a -> [Vertex3 a]
interpolate' Integer
1 Vertex3 GLfloat
p0 Vertex3 GLfloat
p1'
        where
            y0 :: GLfloat
y0 = (GLfloat -> GLfloat) -> GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => (a -> a) -> a -> a -> a
tangent GLfloat -> GLfloat
f GLfloat
x0 GLfloat
c
            y1 :: GLfloat
y1 = (GLfloat -> GLfloat) -> GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => (a -> a) -> a -> a -> a
tangent GLfloat -> GLfloat
f GLfloat
x1 GLfloat
c
            p0 :: Vertex3 GLfloat
p0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
0
            p1 :: Vertex3 GLfloat
p1 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
0
            ve :: Vector3 GLfloat
ve = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0  -- p0 -> p1
            nr :: Vector3 GLfloat
nr = if NormalDir
n NormalDir -> NormalDir -> Bool
forall a. Eq a => a -> a -> Bool
== NormalDir
NCW then Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpccw Vector3 GLfloat
ve else Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw Vector3 GLfloat
ve
            p1' :: Vertex3 GLfloat
p1'= Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: Vector3 GLfloat
nr

normalLineNew::NormalDir -> (GLfloat->GLfloat)->GLfloat->GLfloat->[Vertex3 GLfloat]
normalLineNew :: NormalDir
-> (GLfloat -> GLfloat) -> GLfloat -> GLfloat -> [Vertex3 GLfloat]
normalLineNew NormalDir
n GLfloat -> GLfloat
f GLfloat
x0 GLfloat
c = Integer -> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat]
forall a.
Fractional a =>
Integer -> Vertex3 a -> Vertex3 a -> [Vertex3 a]
interpolate' Integer
1 Vertex3 GLfloat
p0 Vertex3 GLfloat
p1'
        where
            y0 :: GLfloat
y0 = (GLfloat -> GLfloat) -> GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => (a -> a) -> a -> a -> a
tangent GLfloat -> GLfloat
f GLfloat
x0 GLfloat
c
            y1 :: GLfloat
y1 = (GLfloat -> GLfloat) -> GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => (a -> a) -> a -> a -> a
tangent GLfloat -> GLfloat
f (GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
len) GLfloat
c
            p0 :: Vertex3 GLfloat
p0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
0
            p1 :: Vertex3 GLfloat
p1 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
len) GLfloat
y1 GLfloat
0
            ve :: Vector3 GLfloat
ve = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0  -- p0 -> p1
            nr :: Vector3 GLfloat
nr = if NormalDir
n NormalDir -> NormalDir -> Bool
forall a. Eq a => a -> a -> Bool
== NormalDir
NCW then Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpccw Vector3 GLfloat
ve else Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw Vector3 GLfloat
ve
            p1' :: Vertex3 GLfloat
p1'= Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: Vector3 GLfloat
nr
            len :: GLfloat
len = GLfloat
0.1

drawNormalLine::(GLfloat->GLfloat)->(GLfloat, GLfloat) -> GLfloat -> Color3 GLdouble -> IO()
drawNormalLine :: (GLfloat -> GLfloat)
-> (GLfloat, GLfloat) -> GLfloat -> Color3 GLdouble -> IO ()
drawNormalLine GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) GLfloat
x0 Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
pts
                    where
                        pts :: [Vertex3 GLfloat]
pts = NormalDir
-> (GLfloat -> GLfloat)
-> (GLfloat, GLfloat)
-> GLfloat
-> [Vertex3 GLfloat]
normalLine NormalDir
NCCW GLfloat -> GLfloat
f (GLfloat
a, GLfloat
b) GLfloat
x0

drawNormalLineNew::(GLfloat->GLfloat)->GLfloat -> GLfloat -> Color3 GLdouble -> IO()
drawNormalLineNew :: (GLfloat -> GLfloat)
-> GLfloat -> GLfloat -> Color3 GLdouble -> IO ()
drawNormalLineNew GLfloat -> GLfloat
f GLfloat
a GLfloat
x0 Color3 GLdouble
c = PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
LineStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
vx) ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
pts
                    where
                        pts :: [Vertex3 GLfloat]
pts = NormalDir
-> (GLfloat -> GLfloat) -> GLfloat -> GLfloat -> [Vertex3 GLfloat]
normalLineNew NormalDir
NCCW GLfloat -> GLfloat
f GLfloat
a GLfloat
x0
                        b :: GLdouble
b = GLdouble
0.1

-- | compute the center of two vertices/vertex
cen::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
cen :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
cen (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) (Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1) = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x1)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2) ((GLfloat
y0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y1)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2) ((GLfloat
z0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z1)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2)

middle::(Floating a) => Vertex3 a -> Vertex3 a -> Vertex3 a
middle :: Vertex3 a -> Vertex3 a -> Vertex3 a
middle (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((a
x0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
x1)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
2) ((a
y0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
y1)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
2) ((a
z0 a -> a -> a
forall a. Num a => a -> a -> a
+ a
z1)a -> a -> a
forall a. Fractional a => a -> a -> a
/a
2)
  

-- | check two vectors whether they are perpendicular
isPerpen::Vector3 GLfloat -> Vector3 GLfloat -> Bool
isPerpen :: Vector3 GLfloat -> Vector3 GLfloat -> Bool
isPerpen (Vector3 GLfloat
x GLfloat
y GLfloat
z) (Vector3 GLfloat
x' GLfloat
y' GLfloat
z') = GLfloat
xGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
x' GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
yGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
y' GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
zGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
z' GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== GLfloat
0

{-|
    === KEY: Check whether three pts are colinear in 2D plan.
    __NOTE__

    * If two points or three points are overlapped, then they are still colinear
    * It's only for 2D plan, Vertex3 x y z ⇒ Vertex3 x y 0

    NOTE: deprecated, bad name
    USE: 'isColinear2d'

    @
    f(t) = p0 + t(p1 - p0)
    f(s) = p0 + s(p2 - p0)
    f(t) = f(s) =>
    t(p1 - p0) = s(p2 - p0)
    t v1 = s v2, let A = [v1 v2]
    det A =? 0
    det A = 0 => p0 p1 p2 are colinear
    @
-}
isColinear::(Num a, Eq a) => Vertex3 a ->Vertex3 a ->Vertex3 a -> Bool
isColinear :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) (Vertex3 a
x2 a
y2 a
z2) = a
det a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                where
                    -- v01 = Vertex3 (x1 - x0) (y1 - y0) (z1 - z0)
                    -- v02 = Vertex3 (x2 - x0) (y2 - y0) (z2 - z0)
                    det :: a
det = (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x0)a -> a -> a
forall a. Num a => a -> a -> a
*(a
y2 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0) a -> a -> a
forall a. Num a => a -> a -> a
- (a
x2 a -> a -> a
forall a. Num a => a -> a -> a
- a
x0)a -> a -> a
forall a. Num a => a -> a -> a
*(a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0)
{-|
  === KEY: same as isColinear

  NOTE: use 'isColinear2d',  ∵ better name
-}
isColinear2d::(Num a, Eq a) => Vertex3 a ->Vertex3 a ->Vertex3 a -> Bool
isColinear2d :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear2d (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) (Vertex3 a
x2 a
y2 a
z2) = a
det a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
                where
                    det :: a
det = (a
x1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x0)a -> a -> a
forall a. Num a => a -> a -> a
*(a
y2 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0) a -> a -> a
forall a. Num a => a -> a -> a
- (a
x2 a -> a -> a
forall a. Num a => a -> a -> a
- a
x0)a -> a -> a
forall a. Num a => a -> a -> a
*(a
y1 a -> a -> a
forall a. Num a => a -> a -> a
- a
y0)
  
{-|

  === KEY: check if three points is colinear in 3d

  NOTE: use 'crossF' product only
-}
isColinear3d::Vertex3 GLdouble -> Vertex3 GLdouble -> Vertex3 GLdouble -> Bool
-- isColinear3d::(Floating a, Eq a, Ord a) => Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear3d :: Vertex3 GLdouble -> Vertex3 GLdouble -> Vertex3 GLdouble -> Bool
isColinear3d Vertex3 GLdouble
p0 Vertex3 GLdouble
p1 Vertex3 GLdouble
p2 = Bool
b
  where
    v10 :: Vector3 GLdouble
v10 = Vertex3 GLdouble
p1 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
p0
    v12 :: Vector3 GLdouble
v12 = Vertex3 GLdouble
p1 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
p2
    c :: Maybe (Vector3 GLdouble)
c = Vector3 GLdouble -> Vector3 GLdouble -> Maybe (Vector3 GLdouble)
crossF Vector3 GLdouble
v10 Vector3 GLdouble
v12
    b :: Bool
b = case Maybe (Vector3 GLdouble)
c of
         Maybe (Vector3 GLdouble)
Nothing -> Bool
True
         Just Vector3 GLdouble
_ -> Bool
False
  
{-|
    === Check whether a given point is inside the segment

    __NOTE__ use 'ptOnSegment' instead

    * Assume three pts are different pts

    * Given p0, q0 q1, check whether p0 is inside the segment of q0 q1

    * __If__ they are colinear
    * __then__ check the distance \( \overline{p_0 q_0} \)  \( \overline{p_0 q_1} \) and \( \overline{q_0 q_1} \)

    Using following __Affine combination on points__ formula

    === Linear combination on vector \( \{ x_1, x_2, \dots \} \)
    \[
        \begin{aligned}
            \sum_{i=1}^{n} \alpha_{i} x_i
        \end{aligned}
    \]

    If the sum of all the coefficients is 1
    \[
        \begin{aligned}
            \sum_{i=1}^{n} \alpha_{i} &= 1
        \end{aligned}
    \]
    is called __Affine Combination__ of \( \{x_1, x_2, \dots \} \)

    __NOTE__
    If we extend above definition to highter power on \(t\),
    \(t\) can have any power \( n > 0 \) or \( t^{n} \)

    \( [(1 - t) + t]^{n} \) is just Binomial Expansion

    <http://localhost/html/indexBezierCurve.html Bezier_Curve>

    \[
        \begin{aligned}
            1 &= [(1 - t) + t]^{1} \\
            Q &= (1 - t)p_0 + t p_1 \\ \\
            1 &= [(1 - t) + t]^{2} = (1 - t)^{2} + 2t(1-t) + t^2 \\
            Q &= (1-t)^{2} p_0 + 2t(1-t) p_1 + t^2 p_2  \\
        \end{aligned}
    \]



    In out case, there are only two points \( p_0, p_1 \)
    so \( p \) is the __Affine Combination__ of \( p_0, p_1 \)
    \[
        \begin{aligned}
            p &= (1 - t) p_0 + t p_1 \\
        \end{aligned}
    \]
    If \( 0 < t < 1 \) then the point on the segment \( \overline{p_0 p_1} \) but not overlapping on \( p_0, p_1 \)

    If \( t = 0 \) or \( t = 1 \) then the point \(p\) is overlapping \( p_0 \) or \( p_1 \)

    If \( t < 0 \) or \( t > 1 \) then the point \(p\) is NOT on the segment \( \overline{p_0 p_1} \)

    >p0 = Vertex3 0.5 0.5 0
    >q0 = Vertex3 1 1 0
    >q1 = Vertex3 0 0 0
    >isInSegment p0 q0 q1
    >Just True
-}
isInSegment::Vertex3 GLfloat ->Vertex3 GLfloat ->Vertex3 GLfloat -> Maybe Bool
isInSegment :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe Bool
isInSegment Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 = if Bool
is then (if GLfloat
d1 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> GLfloat
ds Bool -> Bool -> Bool
|| GLfloat
d2 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> GLfloat
ds then Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False else Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) else Maybe Bool
forall a. Maybe a
Nothing
                where
                    is :: Bool
is = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 -- has to be colinear
                    ds :: GLfloat
ds = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                    d1 :: GLfloat
d1 = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
p0 Vertex3 GLfloat
q0
                    d2 :: GLfloat
d2 = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
p0 Vertex3 GLfloat
q1

data PtSeg = OnEndPt
             | InSeg
             | OutSeg  deriving (PtSeg -> PtSeg -> Bool
(PtSeg -> PtSeg -> Bool) -> (PtSeg -> PtSeg -> Bool) -> Eq PtSeg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PtSeg -> PtSeg -> Bool
$c/= :: PtSeg -> PtSeg -> Bool
== :: PtSeg -> PtSeg -> Bool
$c== :: PtSeg -> PtSeg -> Bool
Eq, Int -> PtSeg -> ShowS
[PtSeg] -> ShowS
PtSeg -> [Char]
(Int -> PtSeg -> ShowS)
-> (PtSeg -> [Char]) -> ([PtSeg] -> ShowS) -> Show PtSeg
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PtSeg] -> ShowS
$cshowList :: [PtSeg] -> ShowS
show :: PtSeg -> [Char]
$cshow :: PtSeg -> [Char]
showsPrec :: Int -> PtSeg -> ShowS
$cshowsPrec :: Int -> PtSeg -> ShowS
Show)

{-|
    === Better version of 'isInSegment'

    (1) If \(p_0\) is overlapped with \(q_0, q_1\) then OnPt
    (2) If \(\overline{p_0 q_0} + \overline{p_0 q_1} > 0\) then OutSeg
    (3) Else InSeg

    @
    data PtSeg = OnEndPt -- ^ Overlapped pt
                 | InSeg   -- ^ Inside the segment
                 | OutSeg  -- ^ Out the segment
    @

    Maybe use better name:
    crossSegments - No endpt is overlapped

   >1. Three pts are colinear
   >    1. one endpts is overlapped
   >    2. No endpt is overlapped, one endpt is "inside" the segment
   >    3. Not intersected
   >2. Four pts are colinear
   >     1. No endpts is overlapped
   >         1. one segment "inside" the other segment
   >         2. one segment "outside" the other segment
   >     2. One endpts is overlapped
   >         1. one endpt is "outside" a segment
   >         2. one endpt is "inside" a segment
   >     3. two endpts are overlapped => same segment
   >3. No three pts are colinear
   >    1. If two segment is intersected, one must cross other segment
   >    2. Two segments DO NOT intersect

-}
ptOnSegment::Vertex3 GLfloat ->Vertex3 GLfloat ->Vertex3 GLfloat -> PtSeg
ptOnSegment :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> PtSeg
ptOnSegment Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 = if Bool
is then PtSeg
OnEndPt else (if GLfloat
d1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
d2 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> GLfloat
ds then PtSeg
OutSeg else PtSeg
InSeg)
    where
        is :: Bool
is = Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
containPt Vertex3 GLfloat
p0 [Vertex3 GLfloat
q0, Vertex3 GLfloat
q1]
        ds :: GLfloat
ds = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
        d1 :: GLfloat
d1 = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
p0 Vertex3 GLfloat
q0
        d2 :: GLfloat
d2 = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
p0 Vertex3 GLfloat
q1

{-|
    === Draw primitives with a list of triple '(GLfloat, GLfloat, GLfloat)' such lines, points, lineloop etc

    <http://localhost/html/indexHaskellOpenGLPrimitiveMode.html PrimitiveMode>

    @
    PrimitiveMode
    Lines
    LineStrip
    LineLoop
    TriangleStrip
    TriangleFan
    Quad
    QuadStrip
    Polygon
    Patches
    @

    drawPrimitive Lines green [(0.1, 0.2, 0.0), (0.2, 0.4, 0.0)]
-}
drawPrimitive::PrimitiveMode -> Color3 GLdouble -> [(GLfloat, GLfloat, GLfloat)]->IO()
drawPrimitive :: PrimitiveMode
-> Color3 GLdouble -> [(GLfloat, GLfloat, GLfloat)] -> IO ()
drawPrimitive PrimitiveMode
m Color3 GLdouble
c [(GLfloat, GLfloat, GLfloat)]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
m (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((GLfloat, GLfloat, GLfloat) -> IO ())
-> [(GLfloat, GLfloat, GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\(GLfloat
x, GLfloat
y, GLfloat
z) -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (Vertex3 GLfloat -> IO ()) -> Vertex3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y GLfloat
z) [(GLfloat, GLfloat, GLfloat)]
list

{-|
    === KEY: Draw primitives with a list of 'Vertex3 GLfloat' 

    <http://localhost/html/indexHaskellOpenGLPrimitiveMode.html PrimitiveMode>
    <<http://localhost/image/4Tile.svg 4Title>>

    @
    PrimitiveMode
    Lines
    LineStrip
    LineLoop
    TriangleStrip
    TriangleFan
    Quad
    QuadStrip
    Polygon
    Patches


    let p0 = Vertex3 0.2 0.3 0
    let v0 = Vertex3 0   (-0.6) 0
    let v1 = Vertex3 (-0.6) (-0.6) 0
    let v2 = Vertex3 (-0.5) (-0.1) 0
    let v3 = Vertex3 0.0 0.0 0
    drawPrimitiveVex Polygon green [v0, v1, v2, v3] 

    @

    drawPrimitiveVex Lines green [Vertex3 0.1, 0.2, 0.0, Vertex3 0.2, 0.4, 0.0]
-}    
drawPrimitiveVex::PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat]->IO()
drawPrimitiveVex :: PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitiveVex PrimitiveMode
m Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
m (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
vx -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
vx) [Vertex3 GLfloat]
list

{-|
   KEY: draw triangle from three vertex

   @
   drawTriangleList red [Vertex3 0 0 0, Vertex3 1 0 0, Vertex3 0 1 0]
   @
-}
drawTriangleList :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawTriangleList :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawTriangleList Color3 GLdouble
c [Vertex3 GLfloat]
cx = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitiveVex PrimitiveMode
LineLoop Color3 GLdouble
c [Vertex3 GLfloat]
cx
    
drawTriangleStrip:: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawTriangleStrip :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawTriangleStrip Color3 GLdouble
c [Vertex3 GLfloat]
cx = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitiveVex PrimitiveMode
TriangleStrip Color3 GLdouble
c [Vertex3 GLfloat]
cx

{-|
    KEY: Draw ONE triangle ONLY from '(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)'

    @
    PrimitiveMode
    Lines
    LineStrip
    LineLoop
    TriangleStrip
    TriangleFan
    Quad
    QuadStrip
    Polygon
    Patches

    let vv0 = Vertex3 0   0.6 0
    let vv1 = Vertex3 0.6 0.6 0
    let vv2 = Vertex3 0.5 0.1 0
    drawTriangleVex blue (vv0, vv1, vv2) 

    @
-}
drawTriangleVex:: Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawTriangleVex :: Color3 GLdouble
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawTriangleVex Color3 GLdouble
co (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitiveVex PrimitiveMode
TriangleStrip Color3 GLdouble
co [Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c]

{-|
    KEY: Draw ONE triangle ONLY, same as 'drawTriangleVex' 

    * Shorter name, 'drawTriangleVex'

    @
    PrimitiveMode
    Lines
    LineStrip
    LineLoop
    TriangleStrip
    TriangleFan
    Quad
    QuadStrip
    Polygon
    Patches
    @
-}
triangle:: Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
triangle :: Color3 GLdouble
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
triangle Color3 GLdouble
co (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) = Color3 GLdouble
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawTriangleVex Color3 GLdouble
co (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) 
{-| 
    === draw primitive such lines, points, lineloop etc

    <http://localhost/html/indexHaskellOpenGLPrimitiveMode.html PrimitiveMode>

    @
    Lines
    LineStrip
    LineLoop
    TriangleStrip
    TriangleFan
    Quad
    QuadStrip
    Polygon
    Patches
    @

    'AronOpenGL.randomVertex'

    >list <- randomVertex 60
    >drawPrimitive' Lines red list
-} 
drawPrimitive'::PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat]->IO()
drawPrimitive' :: PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
m Color3 GLdouble
c [Vertex3 GLfloat]
ls = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
m (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v) [Vertex3 GLfloat]
ls
    
drawPrimitive2::PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLdouble]->IO()
drawPrimitive2 :: PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawPrimitive2 PrimitiveMode
m Color3 GLdouble
c [Vertex3 GLdouble]
ls = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
m (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLdouble -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLdouble
v -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v) [Vertex3 GLdouble]
ls

drawPrimitiveX::PrimitiveMode -> [Vertex3 GLdouble] -> [Color3 GLdouble] ->IO()
drawPrimitiveX :: PrimitiveMode -> [Vertex3 GLdouble] -> [Color3 GLdouble] -> IO ()
drawPrimitiveX PrimitiveMode
m [Vertex3 GLdouble]
ls [Color3 GLdouble]
lc = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
m (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLdouble, Color3 GLdouble) -> IO ())
-> [(Vertex3 GLdouble, Color3 GLdouble)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\(Vertex3 GLdouble
v, Color3 GLdouble
c) -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v) ([(Vertex3 GLdouble, Color3 GLdouble)] -> IO ())
-> [(Vertex3 GLdouble, Color3 GLdouble)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLdouble]
-> [Color3 GLdouble] -> [(Vertex3 GLdouble, Color3 GLdouble)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex3 GLdouble]
ls ([[Color3 GLdouble]] -> [Color3 GLdouble]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Color3 GLdouble]] -> [Color3 GLdouble])
-> [[Color3 GLdouble]] -> [Color3 GLdouble]
forall a b. (a -> b) -> a -> b
$ [Color3 GLdouble] -> [[Color3 GLdouble]]
forall a. a -> [a]
repeat [Color3 GLdouble]
lc)
  
drawLines::Color3 GLdouble -> [Vertex3 GLfloat]->IO()
drawLines :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list


{-|
    === Draw Segment with Two End Pts

    @
    v = [Vertex3 0.1 0.1 0.2, Vertex3 0.4 0.2 0.7]
    drawSegmentWithEndPt red v
    
    v = [[Vertex3 0.1 0.1 0.2, Vertex3 0.4 0.2 0.7]]
    mapM_(\x -> drawSegmentWithEndPt red x) vv
    @
-}
drawSegmentWithEndPt::Color3 GLdouble -> [Vertex3 GLfloat]->IO()
drawSegmentWithEndPt :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentWithEndPt Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list

drawSegmentNoEndPt::Color3 GLdouble -> [Vertex3 GLfloat]->IO()
drawSegmentNoEndPt :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentNoEndPt Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    
drawSegmentNoEndPt2::Color3 GLdouble -> [Vertex3 GLdouble]->IO()
drawSegmentNoEndPt2 :: Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawSegmentNoEndPt2 Color3 GLdouble
c [Vertex3 GLdouble]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLdouble -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLdouble
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v3) [Vertex3 GLdouble]
list
    
{-|
   === draw fat segment

   @
    when True $ do
     let p₀ = Vertex3 0.0 0.0 0.0 :: Vertex3 GLfloat
     let p₁ = Vertex3 0.5 0.5 0.0 :: Vertex3 GLfloat
     let α = 0.005
     drawFatSegment α [p₀, p₁]
   @
-}
drawFatSegmentEndPt::GLfloat -> [Vertex3 GLfloat] -> IO()
drawFatSegmentEndPt :: GLfloat -> [Vertex3 GLfloat] -> IO ()
drawFatSegmentEndPt GLfloat
c [Vertex3 GLfloat]
cx = do 
  -- let a0 = Vertex3 0.0 0.0 0.0
  -- let b0 = Vertex3 0.5 0.5 0.0
  let p₀ :: Vertex3 GLfloat
p₀ = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head [Vertex3 GLfloat]
cx
  let p₁ :: Vertex3 GLfloat
p₁ = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
last [Vertex3 GLfloat]
cx
  -- drawSegmentls green [p0, p1]
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
red [Vertex3 GLfloat
p₀, Vertex3 GLfloat
p₁]
  let vab :: Vector3 GLfloat
vab = Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
(-:) Vertex3 GLfloat
p₁ Vertex3 GLfloat
p₀  -- vector a0 -> b0
  let vab' :: Vector3 GLfloat
vab' = GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
(*:) GLfloat
c (Vector3 GLfloat -> Vector3 GLfloat
forall a. Floating a => Vector3 a -> Vector3 a
uv Vector3 GLfloat
vab)  -- normalize a vector
  let perpccwV :: Vector3 GLfloat
perpccwV = Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpccw Vector3 GLfloat
vab'
  let perpcwV :: Vector3 GLfloat
perpcwV  = Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw  Vector3 GLfloat
vab'

  let ppccwPt_b0 :: Vertex3 GLfloat
ppccwPt_b0 = Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
(+:) Vertex3 GLfloat
p₁ Vector3 GLfloat
perpccwV
  let ppcwPt_b0 :: Vertex3 GLfloat
ppcwPt_b0  = Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
(+:) Vertex3 GLfloat
p₁ Vector3 GLfloat
perpcwV

  let ppccwPt_a0 :: Vertex3 GLfloat
ppccwPt_a0 = Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
(+:) Vertex3 GLfloat
p₀ Vector3 GLfloat
perpccwV
  let ppcwPt_a0 :: Vertex3 GLfloat
ppcwPt_a0  = Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
(+:) Vertex3 GLfloat
p₀ Vector3 GLfloat
perpcwV
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
blue  [Vertex3 GLfloat
p₁, Vertex3 GLfloat
ppccwPt_b0]
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
green [Vertex3 GLfloat
p₁, Vertex3 GLfloat
ppcwPt_b0]

  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
blue  [Vertex3 GLfloat
p₀, Vertex3 GLfloat
ppccwPt_a0]
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
green [Vertex3 GLfloat
p₀, Vertex3 GLfloat
ppcwPt_a0]

  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
blue  [Vertex3 GLfloat
ppccwPt_a0, Vertex3 GLfloat
ppccwPt_b0]
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
green [Vertex3 GLfloat
ppcwPt_a0,  Vertex3 GLfloat
ppcwPt_b0]

{-|
    === Draw a set segment from each pair of points(segment)

    Segment contains two end points, one is begin point, other is end point

    @
    [p0, p1, p2] = p0 -> p1    (p2 is ignored)
    [p0, p1, p2, p3]
    p0 -> p1
    p2 -> p3

    --NO loop
    drawSegments red  let v0 = Vertex3 0.1 (-0.1) 0
                          v1 = Vertex3 0.2 0.1    0
                          v2 = Vertex3 0.3 0.4    0
                          v3 = Vertex3 0.6 0.2    0
                          ls = [v0, v1, v2, v3]
                      in join $ zipWith (\x y -> [x, y]) (init ls) (tail ls)

    -- Loop
    drawSegments red  let v0 = Vertex3 0.1 (-0.1) 0
                          v1 = Vertex3 0.2 0.1    0
                          v2 = Vertex3 0.3 0.4    0
                          v3 = Vertex3 0.6 0.2    0
                          ls = [v0, v1, v2, v3, v0]
                      in join $ zipWith (\x y -> [x, y]) (init ls) (tail ls)
    @
-}
drawSegments::Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawSegments :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegments Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list

  
{-|
    === Draw one segment from p0 to p1

    NOTE: deprecated
    * Bad name

    @
    let p0 = Vertex3 0.1 0.1 0
    let p1 = Vertex3 0.4 0.4 0
    drawSegmentls red [p0, p1]
    @

    SAME: 'drawSegmentList' 
-}   
drawSegmentls::Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawSegmentls :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentls Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list

{-|
    === Draw one segment from p0 to p1

    @
    let p0 = Vertex3 0.1 0.1 0
    let p1 = Vertex3 0.4 0.4 0
    drawSegmentList red [p0, p1]
    @

    SAME: 'drawSegment' 
-}   
drawSegmentList::Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawSegmentList :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentList Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
  
{-|
    === Draw one segment from p0 to p1

    @
    let p0 = (Vertex3 0.1 0.1 0, Vertex3 0.4 0.4 0)
    let p1 = (Vertex3 0.4 0.4 0, Vertex3 0.4 0.6 0)
    drawSegment red (p0, p1)
    @
-}    
drawSegment::Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat)->IO()
drawSegment :: Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegment Color3 GLdouble
c (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
    ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
        where
            list :: [Vertex3 GLfloat]
list = [Vertex3 GLfloat
p0, Vertex3 GLfloat
p1]

{-|
    === Draw one segment from p0 to p1

    @
    let p0 = (Vertex3 0.1 0.1 0, Vertex3 0.4 0.4 0)
    let p1 = (Vertex3 0.4 0.4 0, Vertex3 0.4 0.6 0)
    drawSegment red (p0, p1)
    @
-}    
drawSegmentD::Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble)->IO()
drawSegmentD :: Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentD Color3 GLdouble
c (Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0, Vertex3 GLdouble
x1 GLdouble
y1 GLdouble
z1) = do
  Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegment Color3 GLdouble
c (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
x0) (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
y0) (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
z0), GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
x1) (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
y1) (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
z1))
    
{-|
    === Draw one segment from p0 to p1, simple version of 'drawSegmentD' and 'drawSegment'
 
    @
    let p0 = (0,   0, 0)
    let p1 = (0.2, 0, 0)
    drawSeg red (p0, p1)
    @
-} 
drawSeg::Color3 GLdouble -> (GLdouble, GLdouble, GLdouble) -> (GLdouble, GLdouble, GLdouble) -> IO()
drawSeg :: Color3 GLdouble
-> (GLdouble, GLdouble, GLdouble)
-> (GLdouble, GLdouble, GLdouble)
-> IO ()
drawSeg Color3 GLdouble
c (GLdouble
x0, GLdouble
y0, GLdouble
z0) (GLdouble
x1, GLdouble
y1, GLdouble
z1) = Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentD Color3 GLdouble
c (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0, GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x1 GLdouble
y1 GLdouble
z1)
                                      
drawSegNoEnd::Color3 GLdouble -> (GLdouble, GLdouble, GLdouble) -> (GLdouble, GLdouble, GLdouble) -> IO()
drawSegNoEnd :: Color3 GLdouble
-> (GLdouble, GLdouble, GLdouble)
-> (GLdouble, GLdouble, GLdouble)
-> IO ()
drawSegNoEnd Color3 GLdouble
c (GLdouble
x0, GLdouble
y0, GLdouble
z0) (GLdouble
x1, GLdouble
y1, GLdouble
z1) = Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentNoEnd2 Color3 GLdouble
c (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0, GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x1 GLdouble
y1 GLdouble
z1)
                                      
{-| 
    === Draw one segment with no endpt
-} 
drawSegmentNoEnd::Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat)->IO()
drawSegmentNoEnd :: Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
c (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
        where
            list :: [Vertex3 GLfloat]
list = [Vertex3 GLfloat
p0, Vertex3 GLfloat
p1]
    
{-| 
    === Draw one segment with no endpt
-} 
drawSegmentNoEnd2::Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble)->IO()
drawSegmentNoEnd2 :: Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentNoEnd2 Color3 GLdouble
c (Vertex3 GLdouble
p0, Vertex3 GLdouble
p1) = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLdouble -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLdouble
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v3) [Vertex3 GLdouble]
list
        where
            list :: [Vertex3 GLdouble]
list = [Vertex3 GLdouble
p0, Vertex3 GLdouble
p1]

    
-- | definition:
--   Segment contains two end points, one is begin point, other is end point
--   [p0, p1] = p0 -> p1
--
--data SegEndPt = No      -- no pt, just a segment
--                | End   -- end pt
--                | Beg   -- begin pt
--                | Both  -- begin and end pts
--                | Cen   -- center pt
--                | All   -- all pts: begin, end and ceneter
drawSegment'::SegEndPt -> Color3 GLdouble -> [Vertex3 GLfloat]->IO()
drawSegment' :: SegEndPt -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegment' SegEndPt
endpt Color3 GLdouble
c [Vertex3 GLfloat]
list = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\Vertex3 GLfloat
v3 -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3) [Vertex3 GLfloat]
list
    let bList :: IO ()
bList = ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
red GLdouble
0.01 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
        eList :: IO ()
eList = ((Integer, Vertex3 GLfloat) -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
x, Vertex3 GLfloat
y) -> if (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
x Integer
2) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
green GLdouble
0.015 Vertex3 GLfloat
y else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ) ([(Integer, Vertex3 GLfloat)] -> IO ())
-> [(Integer, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [Vertex3 GLfloat] -> [(Integer, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [Vertex3 GLfloat]
list
        ols :: [Vertex3 GLfloat]
ols = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
odds  [Vertex3 GLfloat]
list
        els :: [Vertex3 GLfloat]
els = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
evens [Vertex3 GLfloat]
list
        cls :: [Vertex3 GLfloat]
cls = (Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Vertex3 GLfloat
x Vertex3 GLfloat
y -> (GLfloat -> GLfloat) -> Vertex3 (GLfloat -> GLfloat)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2) Vertex3 (GLfloat -> GLfloat) -> Vertex3 GLfloat -> Vertex3 GLfloat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((GLfloat -> GLfloat -> GLfloat)
-> Vertex3 (GLfloat -> GLfloat -> GLfloat)
forall (f :: * -> *) a. Applicative f => a -> f a
pureGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
(+) Vertex3 (GLfloat -> GLfloat -> GLfloat)
-> Vertex3 GLfloat -> Vertex3 (GLfloat -> GLfloat)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertex3 GLfloat
x Vertex3 (GLfloat -> GLfloat) -> Vertex3 GLfloat -> Vertex3 GLfloat
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Vertex3 GLfloat
y)) [Vertex3 GLfloat]
ols [Vertex3 GLfloat]
els
        cList :: IO ()
cList = (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
blue GLdouble
0.012) [Vertex3 GLfloat]
cls
        in case SegEndPt
endpt of
            SegEndPt
Beg -> IO ()
bList -- begin pt
            SegEndPt
End -> IO ()
eList -- end pt
            SegEndPt
Cen -> IO ()
cList -- center pt
            SegEndPt
Both -> do
                IO ()
bList
                IO ()
eList
            SegEndPt
All -> do
                IO ()
bList
                IO ()
eList
                IO ()
cList
            SegEndPt
_   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Draw intersection pt from two segments
-- | Two segments need not have an intersection.
--
drawSegmentArg::Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Vertex3 GLfloat -> IO()
drawSegmentArg :: Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> IO ()
drawSegmentArg Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 = do
            Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
green [Vertex3 GLfloat
p0, Vertex3 GLfloat
ps]
            if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ GLfloat
s GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0, GLfloat
1]
            then if GLfloat
s GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> GLfloat
1
                then Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
blue  [Vertex3 GLfloat
p1, Vertex3 GLfloat
ps] -- (p0 --> p1) --> ps
                else Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
green [Vertex3 GLfloat
p0, Vertex3 GLfloat
ps] -- ps <-- (p0 --> p1
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            if GLfloat
t GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> GLfloat
1 Bool -> Bool -> Bool
|| GLfloat
t GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
0
            then if GLfloat
t GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> GLfloat
1
                then Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
green [Vertex3 GLfloat
q1, Vertex3 GLfloat
qt] -- (q0 --> q1) --> qt
                else Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
blue  [Vertex3 GLfloat
q0, Vertex3 GLfloat
qt] -- qt <-- (q0 --> q1)
            else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            where
                tup :: (Vertex3 GLfloat, [[GLfloat]])
tup = Maybe (Vertex3 GLfloat, [[GLfloat]])
-> (Vertex3 GLfloat, [[GLfloat]])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Vertex3 GLfloat, [[GLfloat]])
 -> (Vertex3 GLfloat, [[GLfloat]]))
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
-> (Vertex3 GLfloat, [[GLfloat]])
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine  Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                vx :: Vertex3 GLfloat
vx  = (Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst (Vertex3 GLfloat, [[GLfloat]])
tup
                s :: GLfloat
s   = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
tup
                t :: GLfloat
t   = ([GLfloat] -> GLfloat
forall a. [a] -> a
last ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
last) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
tup
                ps :: Vertex3 GLfloat
ps  = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
s GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: (Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0))
                qt :: Vertex3 GLfloat
qt  = Vertex3 GLfloat
q0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
t GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: (Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0))

{-|
  === draw sphere center at c with radius r
  * β is in x-y plane, it rotates around z-Axis. ϕ is in x-z plane, it rotates around y-Axis
  * \( r*\cos(ϕ) \) is the radius of circle cut through x-y plane


  <http://localhost/image/sphere_coordinate.svg sphere_equation>

  \[
        \begin{equation}
        \begin{aligned}
            f( ϕ, β ) &= r \times \cos(ϕ) * \cos(β) + x₀ \\
            f( ϕ, β ) &= r \times \cos(ϕ) * \sin(β) + y₀ \\
            f( ϕ, β ) &= r \times \sin(ϕ) + z₀
        \end{aligned}
        \end{equation}
  \]

-}
drawSpherePt::Vertex3 GLfloat -> GLfloat -> [Vertex3 GLfloat]
drawSpherePt :: Vertex3 GLfloat -> GLfloat -> [Vertex3 GLfloat]
drawSpherePt c :: Vertex3 GLfloat
c@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLfloat
r = [Vertex3 GLfloat]
pp
        where
            fx :: GLfloat -> GLfloat -> GLfloat
fx GLfloat
ϕ GLfloat
β = GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
ϕ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
β GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0 -- (x,_,_)
            fy :: GLfloat -> GLfloat -> GLfloat
fy GLfloat
ϕ GLfloat
β = GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
ϕ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
sin GLfloat
β GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0 -- (_,y,_)
            fz :: GLfloat -> p -> GLfloat
fz GLfloat
ϕ p
β = GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
sin GLfloat
ϕ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0         -- (_,_,z)
            n :: GLfloat
n = GLfloat
50
            π :: GLfloat
π = GLfloat
forall a. Floating a => a
pi
            δ :: GLfloat
δ = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
πGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
n
            ll :: [GLfloat]
ll= (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
xGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
δ) [GLfloat
1..GLfloat
n]
            ls :: [GLfloat]
ls= (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
xGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
δ) [GLfloat
1..GLfloat
n]
            pp :: [Vertex3 GLfloat]
pp=[ GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLfloat -> GLfloat -> GLfloat
fx GLfloat
ϕ GLfloat
β) (GLfloat -> GLfloat -> GLfloat
fy GLfloat
ϕ GLfloat
β) (GLfloat -> GLfloat -> GLfloat
forall p. GLfloat -> p -> GLfloat
fz GLfloat
ϕ GLfloat
β) | GLfloat
ϕ <- let d :: GLfloat
d = GLfloat
πGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
10 in (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
d) [GLfloat
0..GLfloat
10], GLfloat
β <- [GLfloat]
ls]


{-|
   === KEY: points set for sphere
-}
spherePts::[[Vertex3 GLfloat]]
spherePts :: [[Vertex3 GLfloat]]
spherePts = Fx -> Fx -> Fx -> Int -> [[Vertex3 GLfloat]]
geneParamSurface Fx
fx Fx
fy Fx
fz Int
10
    where
        n :: Int
n = Int
40::Int
        δ :: GLfloat
δ = (GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) :: Float
        r :: GLfloat
r = GLfloat
0.4
        br :: GLdouble
br = GLdouble
0.2
        σ :: GLdouble
σ = GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

        fx::Int -> Int -> GLfloat
        fx :: Fx
fx Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
α)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
β)
        fy::Int -> Int -> GLfloat
        fy :: Fx
fy Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                     n :: Integer
n = Integer
3
                 in GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
α)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
β)
        
        fz::Int -> Int -> GLfloat
        fz :: Fx
fz Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
α)

{-|
   === KEY: draw sphere at center

   * draw sphere at (0, 0, 0)

   @
   @
-}
drawSphere::IO()
drawSphere :: IO ()
drawSphere = Int -> GLfloat -> [Color3 GLdouble] -> IO ()
drawSphereN Int
40 GLfloat
0.4 [Color3 GLdouble
yellow, Color3 GLdouble
magenta]

{-|
   === KEY: draw sphere in n step with radius

   @
    drawSphereN 10 0.4
   @
-}
drawSphereN::Int -> GLfloat -> [Color3 GLdouble] -> IO()
drawSphereN :: Int -> GLfloat -> [Color3 GLdouble] -> IO ()
drawSphereN Int
n GLfloat
radius [Color3 GLdouble]
cc = do
    let δ :: GLfloat
δ = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
n :: GLfloat
        ϵ :: GLfloat
ϵ = GLfloat
forall a. Floating a => a
pi GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
n :: GLfloat
        r :: GLfloat
r = GLfloat
radius
        fx::Int -> Int -> GLfloat
        fx :: Fx
fx Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
i'
                     β :: GLfloat
β  = GLfloat
ϵ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
j'
                 in GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
β GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
α
        fy::Int -> Int -> GLfloat
        fy :: Fx
fy Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
i'
                     β :: GLfloat
β  = GLfloat
ϵ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
j'
                 in GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
β GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
sin GLfloat
α
        fz::Int -> Int -> GLfloat
        fz :: Fx
fz Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
i'
                     β :: GLfloat
β  = GLfloat
ϵ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
j'
                 in GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
sin GLfloat
α 
        in Fx -> Fx -> Fx -> Int -> [Color3 GLdouble] -> IO ()
drawParamSphere Fx
fx Fx
fy Fx
fz Int
n [Color3 GLdouble]
cc
{--
drawSphereNX::Int -> Int -> GLdouble -> Bool -> [Color3 GLdouble] -> IO()
drawSphereNX n k radius isFilled cc = do
    let δ = 2*pi / rf n :: GLdouble
        ϵ = pi / rf n :: GLdouble
        r = radius
        fx::Int -> Int -> GLdouble
        fx i j = let i' = rf i
                     j' = rf j
                     α  = δ * i'
                     β  = ϵ * j'
                 in r * cos β * cos α
        fy::Int -> Int -> GLdouble
        fy i j = let i' = rf i
                     j' = rf j
                     α  = δ * i'
                     β  = ϵ * j'
                 in r * cos β * sin α
        fz::Int -> Int -> GLdouble
        fz i j = let i' = rf i
                     j' = rf j
                     α  = δ * i'
                     β  = ϵ * j'
                 in r * sin β 

        ss = [[Vertex3 (fx i j)
                       (fy i j)
                       (fz i j) | i <- take (n+1) [0..n]] | j <- let m = div n 2 in take (k+1) [m, m - 1 .. -m]] :: [[Vertex3 GLdouble]]
        in drawParamSphereX isFilled ss cc
--}

drawParaboloid::IO()
drawParaboloid :: IO ()
drawParaboloid = do
    let n :: Int
n = Int
40::Int
        δ :: GLfloat
δ = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: Float
        r :: GLdouble
r = GLdouble
0.4
        br :: GLdouble
br = GLdouble
0.2
        σ :: GLdouble
σ = GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

        fx::Int -> Int -> GLfloat
        fx :: Fx
fx Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in  GLfloat
β GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
α
        fy::Int -> Int -> GLfloat
        fy :: Fx
fy Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                     n :: Integer
n = Integer
3
                 in GLfloat
β GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat -> GLfloat
forall a. Floating a => a -> a
sin GLfloat
α
        
        fz::Int -> Int -> GLfloat
        fz :: Fx
fz Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
βGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
β
        -- in drawParamSurfaceN fx fy fz n
        in Fx -> Fx -> Fx -> IO ()
drawParamSurface Fx
fx Fx
fy Fx
fz    

{-|
    === KEY: draw conic

     -http://localhost/image/opengl_coinc.png
-}
drawConic::IO()
drawConic :: IO ()
drawConic = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let u :: GLdouble
u = GLdouble
0.2
    -- rotate (90)$ (Vector3 0 0 1 :: Vector3 GLdouble)
    -- translate (Vector3 u u 0 :: Vector3 GLdouble)
    let n :: Int
n = Int
40::Int
        δ :: GLfloat
δ = (GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) :: Float
        r :: GLdouble
r = GLdouble
0.04
        br :: GLdouble
br = GLdouble
0.02
        σ :: GLdouble
σ = GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
        s :: GLfloat
s = GLfloat
0.05 -- scale the radius

        fx::Int -> Int -> GLfloat
        fx :: Fx
fx Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
sGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
βGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
α)
        fz::Int -> Int -> GLfloat
        fz :: Fx
fz Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
sGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
βGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
α)
        
        fy::Int -> Int -> GLfloat
        fy :: Fx
fy Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
sGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
β
        ss :: [[Vertex3 GLfloat]]
ss = [[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j)
                       (Fx
fy Int
i Int
j)
                       (Fx
fz Int
i Int
j) | Int
i <- [Int
1..Int
n]] | Int
j <- [Int
1..Int
n]]    
        in do
            ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red) [[Vertex3 GLfloat]]
ss
            ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
blue) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
ss
    
        -- in drawParamSurface fx fy fz

{-|
   IMAGE: http://xfido.com/image/opengl_grid.png
-}
drawGrid::IO()
drawGrid :: IO ()
drawGrid = do
    let n :: Int
n = Int
20::Int
        δ :: GLfloat
δ = (GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: Float
        r :: GLdouble
r = GLdouble
0.4
        br :: GLdouble
br = GLdouble
0.2
        -- σ = 1/rf(n-1)

        fx::Int -> Int -> GLfloat
        fx :: Fx
fx Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLdouble
j' = Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     -- β  = δ*j'
                 in GLfloat
αGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
0.1
        fy::Int -> Int -> GLfloat
        fy :: Fx
fy Int
i Int
j = let i' :: GLdouble
i' = Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     -- α  = δ*i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
βGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
0.1
        
        fz::Int -> Int -> GLfloat
        fz :: Fx
fz Int
i Int
j = let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i
                     j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j
                     α :: GLfloat
α  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'
                     β :: GLfloat
β  = GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j'
                 in GLfloat
0.2
        -- in drawParamSurfaceN fx fy fz n
        in Fx -> Fx -> Fx -> Int -> IO ()
drawParamSurfaceN_new Fx
fx Fx
fy Fx
fz Int
n

-- | draw plane with three points
-- | no check whether they are co-linear
--
drawPlane::Color3 GLdouble ->
           Vertex3 GLfloat ->
           Vertex3 GLfloat ->
           Vertex3 GLfloat -> IO()
drawPlane :: Color3 GLdouble
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> IO ()
drawPlane Color3 GLdouble
c Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 Vertex3 GLfloat
q2 = do
  PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vertex3 GLfloat
x -> do
                                    Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                    Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
x) [Vertex3 GLfloat
q0, Vertex3 GLfloat
q1, Vertex3 GLfloat
q0, Vertex3 GLfloat
q2, Vertex3 GLfloat
q1, Vertex3 GLfloat
q2]
{-|
    === Generate a circle 

    > let radius = 0.1
    > let pts = circlePt (Vertex3 0 0 0) radius

    See 'circleN' $n$ segments
-}
circlePt::Vertex3 GLfloat -> Double -> [Vertex3 GLfloat]
circlePt :: Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circlePt (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLdouble
r =[let alpha :: GLfloat
alpha = (GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | GLfloat
n <- [GLfloat
1..GLfloat
num]]
        where
            num :: GLfloat
num = GLfloat
4 
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float

circlePtD::Vertex3 GLdouble -> Double -> Int -> [Vertex3 GLdouble]
circlePtD :: Vertex3 GLdouble -> GLdouble -> Int -> [Vertex3 GLdouble]
circlePtD (Vertex3 GLdouble
x GLdouble
y GLdouble
z) GLdouble
r Int
n =[let alpha :: GLdouble
alpha = GLdouble
pi2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*(Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
k)GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
n' in GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLdouble
r'GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble -> GLdouble
forall a. Floating a => a -> a
sin(GLdouble
alpha) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
x) (GLdouble
r'GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble -> GLdouble
forall a. Floating a => a -> a
cos(GLdouble
alpha) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
y) GLdouble
z | Int
k <- [Int
0..Int
n]]
        where
            r' :: GLdouble
r' = GLdouble -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r
            n' :: GLdouble
n' = Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
n
            pi2 :: GLdouble
pi2 = GLdouble
2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
forall a. Floating a => a
pi::Double

{-|
    \(\color{red}{Deprecated} \) Use 'circlePt'

    === Fri Feb 15 11:13:17 2019 

    === Draw xy-plane circle

    NOTE: deprecated, Use circle'X
-}
circle'::Vertex3 GLfloat -> Double -> [Vertex3 GLfloat]
circle' :: Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLdouble
r =[let alpha :: GLfloat
alpha = (GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | GLfloat
n <- [GLfloat
1..GLfloat
num]]
        where
            num :: GLfloat
num = GLfloat
4
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float
  
{-|
    \(\color{red}{Deprecated} \) Use 'circlePt'

    === Draw xy-plane circle

    KEY: draw simple circle on xy-plane

    DATE: Sunday, 25 February 2024 23:09 PST
-}
circle'X :: Vertex3 GLfloat -> GLfloat -> [Vertex3 GLfloat]
circle'X :: Vertex3 GLfloat -> GLfloat -> [Vertex3 GLfloat]
circle'X (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLfloat
r =[let alpha :: GLfloat
alpha = (GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLfloat
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) ((GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLfloat
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | GLfloat
n <- [GLfloat
1..GLfloat
num]]
   where
       num :: GLfloat
num = GLfloat
4
       pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float
            
circle2::Vertex3 GLdouble -> Double -> [Vertex3 GLdouble]
circle2 :: Vertex3 GLdouble -> GLdouble -> [Vertex3 GLdouble]
circle2 (Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0) GLdouble
r =[let alpha :: GLdouble
alpha = (GLdouble
pi2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
n)GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
num in GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLdouble -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble -> GLdouble
forall a. Floating a => a -> a
sin(GLdouble
alpha) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
x0) ((GLdouble -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble -> GLdouble
forall a. Floating a => a -> a
cos(GLdouble
alpha) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
y0) (GLdouble
0 GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
z0) | GLdouble
n <- [GLdouble
1..GLdouble
num]]
        where
            num :: GLdouble
num = GLdouble
4
            pi2 :: GLdouble
pi2 = GLdouble
2GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
forall a. Floating a => a
pi::Double
            
            
{-|
    === Draw xy-plane circle with $n$ segment

    See 'circlePt' at xy-plane
-}
circleN::Vertex3 GLfloat -> Double -> Integer -> [Vertex3 GLfloat]
circleN :: Vertex3 GLfloat -> GLdouble -> Integer -> [Vertex3 GLfloat]
circleN (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLdouble
r Integer
num =[let alpha :: GLfloat
alpha = GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*(Integer -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Integer
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/Integer -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Integer
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | Integer
n <- [Integer
1..Integer
num]]
        where
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float

{-|
    === Draw xy-plane circle with $n$ segment

    See 'circleNX' at xy-plane
-}
circleNX::Vertex3 GLfloat -> GLfloat -> Int -> [Vertex3 GLfloat]
circleNX :: Vertex3 GLfloat -> GLfloat -> Int -> [Vertex3 GLfloat]
circleNX (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLfloat
r Int
num =[let alpha :: GLfloat
alpha = GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*(Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) (GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | Int
n <- [Int
0..Int
num]]
        where
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float

{-|
    === KEY: Vector3 to Vertex3 
-}
vec_ :: (Fractional a, Eq a) => (Vertex3 a) -> Vector3 a
-- vec_ :: (Floating a) => (Vertex3 a) -> Vector3 a
vec_ :: Vertex3 a -> Vector3 a
vec_ (Vertex3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
x a
y a
z 

{-|
    === KEY: Vertex3 to Vector3
-}
ver_ :: (Fractional a, Eq a) => (Vector3 a) -> Vertex3 a
ver_ :: Vector3 a -> Vertex3 a
ver_ (Vector3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z 


{-|
    === Draw xy-plane circle with 10 segments
-}
drawCircleFilled :: (Color3 GLdouble) -> (Vertex3 GLfloat) -> GLfloat -> IO()
drawCircleFilled :: Color3 GLdouble -> Vertex3 GLfloat -> GLfloat -> IO ()
drawCircleFilled Color3 GLdouble
cr Vertex3 GLfloat
p0 GLfloat
r = do 
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Vector3 GLfloat -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (Vector3 GLfloat -> IO ()) -> Vector3 GLfloat -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> Vector3 GLfloat
forall a. (Fractional a, Eq a) => Vertex3 a -> Vector3 a
vec_ Vertex3 GLfloat
p0 
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
TriangleFan (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vertex3 GLfloat
v -> do
                                           Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
cr 
                                           Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v
                                           ) [Vertex3 GLfloat]
ls
    where
      c0 :: Vertex3 GLfloat
c0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
0 GLfloat
0 GLfloat
0 :: (Vertex3 GLfloat)
      ls :: [Vertex3 GLfloat]
ls = Vertex3 GLfloat
c0 Vertex3 GLfloat -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. a -> [a] -> [a]
: Vertex3 GLfloat -> GLfloat -> Int -> [Vertex3 GLfloat]
circleNX Vertex3 GLfloat
c0 GLfloat
r Int
10

{-|
    === Draw xy-plane circle with $n$ segment, draw arc, circle arc

    See 'circlePt' at xy-plane

    @
    let cen = Vertex3 0.1 0.1 0
    let radius = 1.0
    let nStep = 10
                     + -> start interval
                     ↓
    let interval = (pi/4, pi/2)
                           ↑
                           + -> end interval

    circleNArc cen radius nStep interval
    @

    * circleNArc center radius n_step arc=(0, pi/2)
    * Arc rotates counter-clockwise if r₁ > r₀
    * Arc rotates clockwise         if r₁ <= r₀

    (x - x0)^2 + (y - y0)^2 = r^2

    x - x0 = r * cos α
    y - y0 = r * sin α

    x = r * cos α + x0
    y = r * sin α + y0
-}
circleNArc::Vertex3 GLdouble -> Double -> Integer -> (GLdouble, GLdouble) -> [Vertex3 GLdouble]
circleNArc :: Vertex3 GLdouble
-> GLdouble
-> Integer
-> (GLdouble, GLdouble)
-> [Vertex3 GLdouble]
circleNArc (Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0) GLdouble
r Integer
num (GLdouble
r0, GLdouble
r1) =[let delta :: GLdouble
delta = (GLdouble
r1 GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- GLdouble
r0)GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(Integer -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Integer
num)
                                                   r' :: GLdouble
r' = GLdouble -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r
                                               in GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLdouble
r' GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
* GLdouble -> GLdouble
forall a. Floating a => a -> a
cos (GLdouble
r0  GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ (Integer -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Integer
n)GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
delta) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
x0)  (GLdouble
r' GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
* GLdouble -> GLdouble
forall a. Floating a => a -> a
sin (GLdouble
r0 GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ (Integer -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Integer
n)GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
*GLdouble
delta) GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
+ GLdouble
y0)  GLdouble
z0 | Integer
n <- [Integer
0..Integer
num]]

{-|
    === Draw xz-plane circle
-}
circleXY::Vertex3 GLfloat -> Double -> [Vertex3 GLfloat]
circleXY :: Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleXY (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLdouble
r =[let alpha :: GLfloat
alpha = (GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | GLfloat
n <- [GLfloat
1..GLfloat
num]]
        where
            num :: GLfloat
num = GLfloat
4
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float

{-|
    === KEY: Draw xz-plane circle
-}
circleXZ::Vertex3 GLfloat -> Double -> [Vertex3 GLfloat]
circleXZ :: Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleXZ (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLdouble
r =[let alpha :: GLfloat
alpha = (GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | GLfloat
n <- [GLfloat
1..GLfloat
num]]
        where
            num :: GLfloat
num = GLfloat
4
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float

{-|
    === Draw yz-plane circle
-}
circleYZ::Vertex3 GLfloat -> Double -> [Vertex3 GLfloat]
circleYZ :: Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleYZ (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) GLdouble
r =[let alpha :: GLfloat
alpha = (GLfloat
pi2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
num in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3  (GLfloat
0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x0) ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y0) ((GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
r)GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
alpha) GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z0) | GLfloat
n <- [GLfloat
1..GLfloat
num]]
        where
            num :: GLfloat
num = GLfloat
4
            pi2 :: GLfloat
pi2 = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
pi::Float



{-|
    KEY: draw dot, small circle

    @
    echo dot is a circle
    r = 0.01
    c = red

    drawDot (Vertex3 0.0 0.0 0.0) -- p0
    drawDot (Vertex3 0.4 0.0 0.0) -- p1
    @
-}
drawDot::Vertex3 GLfloat -> IO()
drawDot :: Vertex3 GLfloat -> IO ()
drawDot Vertex3 GLfloat
ce = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLfloat -> [Vertex3 GLfloat]
circle'X Vertex3 GLfloat
ce GLfloat
r
        where
            r :: GLfloat
r = GLfloat
0.01 :: GLfloat
            c :: Color3 GLdouble
c = Color3 GLdouble
red

drawDotX::(Color3 GLdouble) -> Vertex3 GLfloat -> IO()
drawDotX :: Color3 GLdouble -> Vertex3 GLfloat -> IO ()
drawDotX Color3 GLdouble
cr Vertex3 GLfloat
p0 = Color3 GLdouble -> Vertex3 GLfloat -> GLfloat -> IO ()
drawDotXX Color3 GLdouble
cr Vertex3 GLfloat
p0 GLfloat
0.02 

drawDotXX::(Color3 GLdouble) -> Vertex3 GLfloat -> GLfloat -> IO()
drawDotXX :: Color3 GLdouble -> Vertex3 GLfloat -> GLfloat -> IO ()
drawDotXX Color3 GLdouble
cr Vertex3 GLfloat
p0 GLfloat
r = Color3 GLdouble -> Vertex3 GLfloat -> GLfloat -> IO ()
drawCircleFilled Color3 GLdouble
cr Vertex3 GLfloat
p0 GLfloat
r 

{-|
    KEY: draw dot, small circle with radius r = 0.1 

    @
    echo dot is a circle
    r = 0.01
    c = red

    drawDot (Vertex3 0.0 0.0 0.0) -- p0
    drawDot (Vertex3 0.4 0.0 0.0) -- p1
    @
-}
drawDotR::Vertex3 GLfloat -> Double -> IO()  -- drawDotR v r
drawDotR :: Vertex3 GLfloat -> GLdouble -> IO ()
drawDotR Vertex3 GLfloat
cen GLdouble
r = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' Vertex3 GLfloat
cen GLdouble
r
        where
            c :: Color3 GLdouble
c = Color3 GLdouble
red
  
drawDotColor::Vertex3 GLfloat -> Color3 GLdouble -> IO()  -- drawDotR v r
drawDotColor :: Vertex3 GLfloat -> Color3 GLdouble -> IO ()
drawDotColor Vertex3 GLfloat
cen Color3 GLdouble
c = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' Vertex3 GLfloat
cen GLdouble
r
        where
            r :: GLdouble
r = GLdouble
0.01
  
drawDotRColor::Vertex3 GLfloat -> GLdouble -> Color3 GLdouble -> IO()  -- drawDotRColor v r c
drawDotRColor :: Vertex3 GLfloat -> GLdouble -> Color3 GLdouble -> IO ()
drawDotRColor Vertex3 GLfloat
cen GLdouble
r Color3 GLdouble
c = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' Vertex3 GLfloat
cen GLdouble
r


-- | Given an Vector3 x y z or Vertex3 x y z
-- | Convert Cartesian Coordinates to Polar Coordinates
-- | beta  x-y plane,
-- | alpha x-z plane
-- |
-- |             y  z
-- |             | /
-- |          ---|/--- x
-- |             /
--
cartToPolar::(Vector3 GLfloat) -> (GLfloat, GLfloat)
cartToPolar :: Vector3 GLfloat -> (GLfloat, GLfloat)
cartToPolar (Vector3 GLfloat
x GLfloat
y GLfloat
z) = (GLfloat -> GLfloat
forall a. Floating a => a -> a
atan(GLfloat
yGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
x), GLfloat -> GLfloat
forall a. Floating a => a -> a
asin(GLfloat
zGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
rxz))
        where
            rxy :: GLfloat
rxy = GLfloat -> GLfloat
forall a. Floating a => a -> a
sqrt (GLfloat -> GLfloat) -> GLfloat -> GLfloat
forall a b. (a -> b) -> a -> b
$ Vector3 GLfloat -> Vector3 GLfloat -> GLfloat
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve (GLfloat -> GLfloat -> GLfloat -> Vector3 GLfloat
forall a. a -> a -> a -> Vector3 a
Vector3 GLfloat
x GLfloat
y GLfloat
0.0) (GLfloat -> GLfloat -> GLfloat -> Vector3 GLfloat
forall a. a -> a -> a -> Vector3 a
Vector3 GLfloat
x GLfloat
y GLfloat
0.0)
            rxz :: GLfloat
rxz = GLfloat -> GLfloat
forall a. Floating a => a -> a
sqrt (GLfloat -> GLfloat) -> GLfloat -> GLfloat
forall a b. (a -> b) -> a -> b
$ Vector3 GLfloat -> Vector3 GLfloat -> GLfloat
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve (GLfloat -> GLfloat -> GLfloat -> Vector3 GLfloat
forall a. a -> a -> a -> Vector3 a
Vector3 GLfloat
x GLfloat
0.0 GLfloat
z) (GLfloat -> GLfloat -> GLfloat -> Vector3 GLfloat
forall a. a -> a -> a -> Vector3 a
Vector3 GLfloat
x GLfloat
0.0 GLfloat
z)
            -- | at  = if y < 0 && x < 0 then pi + atan(y/x) else atan(y/x)


vecToM3x :: Vector3 GLdouble -> [[GLdouble]]
vecToM3x :: Vector3 GLdouble -> [[GLdouble]]
vecToM3x (Vector3 GLdouble
x GLdouble
y GLdouble
z) = [
                            [GLdouble
x, GLdouble
0, GLdouble
0],
                            [GLdouble
y, GLdouble
0, GLdouble
0],
                            [GLdouble
z, GLdouble
0, GLdouble
0]
                           ]

vecToM3y :: Vector3 GLdouble -> [[GLdouble]]
vecToM3y :: Vector3 GLdouble -> [[GLdouble]]
vecToM3y (Vector3 GLdouble
x GLdouble
y GLdouble
z) = [
                            [GLdouble
0, GLdouble
x, GLdouble
0],
                            [GLdouble
0, GLdouble
y, GLdouble
0],
                            [GLdouble
0, GLdouble
z, GLdouble
0]
                          ]
  
vecToM3z :: Vector3 GLdouble -> [[GLdouble]]
vecToM3z :: Vector3 GLdouble -> [[GLdouble]]
vecToM3z (Vector3 GLdouble
x GLdouble
y GLdouble
z) = [
                            [GLdouble
0, GLdouble
0, GLdouble
x],
                            [GLdouble
0, GLdouble
0, GLdouble
y],
                            [GLdouble
0, GLdouble
0, GLdouble
z]
                          ]
      

{-|
    === right hand coordinates system in OpenGL, y-z plan, rotation matrix

    * rotate matrix on x-z plane

    @ 
    rotx :: Floating a => a -> [[a]]
    rotx α =[[ 1.0,     0.0,     0.0]
            ,[ 0.0,     cos α ,  negate $ sin α]
            ,[ 0.0,     sin α,   cos α]
             ]
    @
-}
rotx :: Floating a => a -> [[a]]
rotx :: a -> [[a]]
rotx a
α =[[ a
1.0,     a
0.0,     a
0.0]
        ,[ a
0.0,     a -> a
forall a. Floating a => a -> a
cos a
α ,  a -> a
forall a. Num a => a -> a
negate (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
sin a
α]
        ,[ a
0.0,     a -> a
forall a. Floating a => a -> a
sin a
α,   a -> a
forall a. Floating a => a -> a
cos a
α]
         ]

{-|
    === right hand coordinates system in OpenGL, x-z plan, rotation matrix

    * rotate matrix on x-z plane

    @ 
     roty :: Floating a => a -> [[a]]
     roty α =[[cos α,          0.0,  sin α]
             ,[ 0.0 ,          1.0,  0.0  ]
             ,[negate $ sin α, 0.0,  cos α]
              ]
    @
-}
roty :: Floating a => a -> [[a]]
roty :: a -> [[a]]
roty a
α =[[a -> a
forall a. Floating a => a -> a
cos a
α,          a
0.0,  a -> a
forall a. Floating a => a -> a
sin a
α]
        ,[ a
0.0 ,          a
1.0,  a
0.0  ]
        ,[a -> a
forall a. Num a => a -> a
negate (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
sin a
α, a
0.0,  a -> a
forall a. Floating a => a -> a
cos a
α]
         ]

{-|
    === right hand coordinates system in OpenGL, x-y plane, rotation matrix

    * rotate matrix on x-y plane

    @
    rotz ϕ = [ [cos ϕ,   negate $ sin ϕ, 0.0]
              ,[sin ϕ,            cos ϕ, 0.0]
              ,[0.0  ,              0.0, 1.0]
              ]
    @

-}
rotz :: Floating a => a -> [[a]]
rotz :: a -> [[a]]
rotz a
ϕ = [[a -> a
forall a. Floating a => a -> a
cos a
ϕ,          a -> a
forall a. Num a => a -> a
negate (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Floating a => a -> a
sin a
ϕ, a
0.0]
         ,[a -> a
forall a. Floating a => a -> a
sin a
ϕ,          a -> a
forall a. Floating a => a -> a
cos a
ϕ,          a
0.0]
         ,[ a
0.0 ,            a
0.0,          a
1.0]
          ]

coordTip:: Color3 GLdouble -> IO()
coordTip :: Color3 GLdouble -> IO ()
coordTip Color3 GLdouble
c = do
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((GLfloat, GLfloat, GLfloat) -> IO ())
-> [(GLfloat, GLfloat, GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(\(GLfloat
x, GLfloat
y, GLfloat
z) -> do
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y GLfloat
z ::Vertex3 GLfloat)
        ) [(GLfloat, GLfloat, GLfloat)]
conic

coordTipX::Color3 GLdouble ->  GLdouble -> IO()
coordTipX :: Color3 GLdouble -> GLdouble -> IO ()
coordTipX Color3 GLdouble
c GLdouble
u = do
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
u GLdouble
0 GLdouble
0 :: Vector3 GLdouble)
        --rotate (90)$ (Vector3 0 0 1 :: Vector3 GLdouble)
        Color3 GLdouble -> IO ()
coordTip Color3 GLdouble
c
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 (GLdouble
uGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
2.0) GLdouble
0 GLdouble
0 :: Vector3 GLdouble)
        GLdouble -> GLdouble -> GLdouble -> IO ()
forall c. MatrixComponent c => c -> c -> c -> IO ()
GL.scale (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
scaleFont :: GL.GLdouble) (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
scaleFont) GLdouble
1

        -- Ref: https://hackage.haskell.org/package/gloss-rendering-1.13.1.1/docs/src/Graphics.Gloss.Internals.Rendering.Picture.html#renderPicture
        -- text looks weird when we have got blend on
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Disabled        
        IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StrokeFont -> [Char] -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> [Char] -> m ()
GLUT.renderString StrokeFont
GLUT.Roman [Char]
"Hello World"
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Enabled
    
coordTipY:: Color3 GLdouble ->  GLdouble -> IO()
coordTipY :: Color3 GLdouble -> GLdouble -> IO ()
coordTipY Color3 GLdouble
c GLdouble
u = do
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
u GLdouble
0 :: Vector3 GLdouble)
        GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
rotate (GLdouble
90)(Vector3 GLdouble -> IO ()) -> Vector3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
0 GLdouble
1 :: Vector3 GLdouble)
        Color3 GLdouble -> IO ()
coordTip Color3 GLdouble
c
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 (GLdouble
uGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
2.0) GLdouble
0 :: Vector3 GLdouble)
        GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
rotate (GLdouble
90)(Vector3 GLdouble -> IO ()) -> Vector3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
0 GLdouble
1 :: Vector3 GLdouble)
        GLdouble -> GLdouble -> GLdouble -> IO ()
forall c. MatrixComponent c => c -> c -> c -> IO ()
GL.scale (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
scaleFont :: GL.GLdouble) (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
scaleFont) GLdouble
1
    
        -- Ref: https://hackage.haskell.org/package/gloss-rendering-1.13.1.1/docs/src/Graphics.Gloss.Internals.Rendering.Picture.html#renderPicture
        -- text looks weird when we have got blend on
        -- GLUT.renderString GLUT.Roman "Y"
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Disabled        
        IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StrokeFont -> [Char] -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> [Char] -> m ()
GLUT.renderString StrokeFont
GLUT.Roman [Char]
"Y"
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Enabled

coordTipZ::Color3 GLdouble -> GLdouble -> IO()
coordTipZ :: Color3 GLdouble -> GLdouble -> IO ()
coordTipZ Color3 GLdouble
c GLdouble
u = do
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
0 GLdouble
u :: Vector3 GLdouble)
        GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
rotate (-GLdouble
90)(Vector3 GLdouble -> IO ()) -> Vector3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
1 GLdouble
0 :: Vector3 GLdouble)
        Color3 GLdouble -> IO ()
coordTip Color3 GLdouble
c
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
0 (GLdouble
uGLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
2.0) :: Vector3 GLdouble)
        GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
rotate (-GLdouble
90)(Vector3 GLdouble -> IO ()) -> Vector3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
1 GLdouble
0 :: Vector3 GLdouble)
        GLdouble -> GLdouble -> GLdouble -> IO ()
forall c. MatrixComponent c => c -> c -> c -> IO ()
GL.scale (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
scaleFont :: GL.GLdouble) (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
scaleFont) GLdouble
1

        -- Ref: https://hackage.haskell.org/package/gloss-rendering-1.13.1.1/docs/src/Graphics.Gloss.Internals.Rendering.Picture.html#renderPicture
        -- text looks weird when we have got blend on
        -- GLUT.renderString GLUT.Roman "Z"
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Disabled        
        IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StrokeFont -> [Char] -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> [Char] -> m ()
GLUT.renderString StrokeFont
GLUT.Roman [Char]
"Z"
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Enabled

show3dStr::String -> Color3 GLdouble ->  GLdouble -> IO()
show3dStr :: [Char] -> Color3 GLdouble -> GLdouble -> IO ()
show3dStr [Char]
str Color3 GLdouble
c GLdouble
u = do
    -- preservingMatrix $ do
        -- translate (Vector3 u 0 0 :: Vector3 GLdouble)
        -- rotate (90)$ (Vector3 0 0 1 :: Vector3 GLdouble)
         -- coordTip c
    IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 (-GLdouble
u) (-GLdouble
u) GLdouble
0 :: Vector3 GLdouble)
        -- SEE: Why we need to scale it before redering
        -- https://www.reddit.com/r/haskell/comments/o8qkbv/looking_for_minimum_example_to_render_string_or
        -- NOT Sure where the "4000" come from
        GLdouble -> GLdouble -> GLdouble -> IO ()
forall c. MatrixComponent c => c -> c -> c -> IO ()
GL.scale (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
4000 :: GL.GLdouble) (GLdouble
1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/GLdouble
4000::GL.GLdouble) GLdouble
1
        Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
        -- Ref: https://hackage.haskell.org/package/gloss-rendering-1.13.1.1/docs/src/Graphics.Gloss.Internals.Rendering.Picture.html#renderPicture
        -- text looks weird when we have got blend on
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Disabled        
        IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StrokeFont -> [Char] -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> [Char] -> m ()
GLUT.renderString StrokeFont
GLUT.Roman [Char]
str
        StateVar Capability
GL.blend StateVar Capability -> Capability -> IO ()
forall t a (m :: * -> *).
(HasSetter t a, MonadIO m) =>
t -> a -> m ()
$= Capability
GL.Enabled


{-|
    === Coordinate with tips

    positive dir is the tips dir
-}
renderCoordinates::IO ()
renderCoordinates :: IO ()
renderCoordinates = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let u :: GLdouble
u = GLdouble
1
    Color3 GLdouble -> GLdouble -> IO ()
coordTipX Color3 GLdouble
red   GLdouble
u
    Color3 GLdouble -> GLdouble -> IO ()
coordTipY Color3 GLdouble
green GLdouble
u
    Color3 GLdouble -> GLdouble -> IO ()
coordTipZ Color3 GLdouble
blue  GLdouble
u
    PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Lines (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
       -- x-Axis
       Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  (GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3  GLdouble
u    GLdouble
0    GLdouble
0    :: Color3  GLdouble)
       Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (-GLdouble
u) GLdouble
0    GLdouble
0    :: Vertex3 GLdouble)
       Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  (GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3  GLdouble
u    GLdouble
0    GLdouble
0    :: Color3  GLdouble)
       Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
u    GLdouble
0    GLdouble
0    :: Vertex3 GLdouble)
       -- y-Axis                                      
       Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  (GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3  GLdouble
0    GLdouble
u    GLdouble
0    :: Color3  GLdouble)
       Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0    (-GLdouble
u) GLdouble
0    :: Vertex3 GLdouble)
       Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  (GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3  GLdouble
0    GLdouble
u    GLdouble
0    :: Color3  GLdouble)
       Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0    GLdouble
u    GLdouble
0    :: Vertex3 GLdouble)
       -- z-Axis                                      
       Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  (GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3  GLdouble
0    GLdouble
0    GLdouble
u    :: Color3  GLdouble)
       Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0    GLdouble
0    (-GLdouble
u) :: Vertex3 GLdouble)
       Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  (GLdouble -> GLdouble -> GLdouble -> Color3 GLdouble
forall a. a -> a -> a -> Color3 a
Color3  GLdouble
0    GLdouble
0    GLdouble
u    :: Color3  GLdouble)
       Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
0    GLdouble
0    GLdouble
u    :: Vertex3 GLdouble)

{-|
    === KEY: Draw circle(r, c) which is ⊥ to ve
    === Given an radius r, center Vertex3 c, and Vector ve

    <http://localhost/image/img101.png Circle_perpendicular_a_Vector>

    @
      -- vector ve perpendicular to the circle(r, c)
      drawCircleVec 0.2 (Vertex3 0.0 0.0 0.0) (Vector3 0.2 0 0)
                     ↑           ↑                       ↑ 
                   radius r    center c             vector ve
      
    @
-}
drawCircleVec::GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat -> IO()
drawCircleVec :: GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat -> IO ()
drawCircleVec GLfloat
r Vertex3 GLfloat
c Vector3 GLfloat
v = do
  (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Vertex3 GLfloat -> IO ()
drawDot ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([[GLfloat]] -> Vertex3 GLfloat)
-> [[[GLfloat]]] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map ([[GLfloat]] -> Vertex3 GLfloat
forall a. [[a]] -> Vertex3 a
matVx) [[[GLfloat]]]
ls'
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawLines Color3 GLdouble
blue [Vertex3 GLfloat
c, Vertex3 GLfloat
c Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: Vector3 GLfloat
v]
  where
    (GLfloat
ϕ, GLfloat
α) = Vector3 GLfloat -> (GLfloat, GLfloat)
cartToPolar Vector3 GLfloat
v
    circ :: [[[GLfloat]]]
circ = [[[GLfloat
0.0], [GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*(GLfloat -> GLfloat
forall a. Floating a => a -> a
cos GLfloat
β)], [GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*(GLfloat -> GLfloat
forall a. Floating a => a -> a
sin GLfloat
β)]] | GLfloat
β <- let π :: GLfloat
π = GLfloat
3.1415; d :: GLfloat
d = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
πGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
100 in (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
d) [GLfloat
1..GLfloat
100]]
    -- | circ = [[[0.5], [0.5], [0.0]]]
    ls :: [[[GLfloat]]]
ls   = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
ϕ)) [[[GLfloat]]]
circ -- rotate x-y plane
    ls' :: [[[GLfloat]]]
ls'  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
roty (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
α)) [[[GLfloat]]]
ls   -- rotate x-z plane
    -- |  v'   = multiMat (rotz $ ϕ) (veMat v)
    -- |  v''  = multiMat (roty $ α) v'
    -- | matVx [[x], [y], [z]] = Vertex3 x y z
    -- | veMat (Vector3 x y z) = [[x], [y], [z]]
    -- | ls   = map(multiMat (rotz $ 0.0)) circ
    ls1 :: [[[GLfloat]]]
ls1  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls2 :: [[[GLfloat]]]
ls2  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls3 :: [[[GLfloat]]]
ls3  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
3GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls4 :: [[[GLfloat]]]
ls4  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
4GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls5 :: [[[GLfloat]]]
ls5  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
5GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls6 :: [[[GLfloat]]]
ls6  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
6GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls7 :: [[[GLfloat]]]
ls7  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
7GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ
    ls8 :: [[[GLfloat]]]
ls8  = ([[GLfloat]] -> [[GLfloat]]) -> [[[GLfloat]]] -> [[[GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map([[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat (GLfloat -> [[GLfloat]]
forall a. Floating a => a -> [[a]]
rotz (GLfloat -> [[GLfloat]]) -> GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ GLfloat
8GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
4)) [[[GLfloat]]]
circ

{-|
    === matrix to Vertex

    @
    matVx [[x], [y], [z]] = Vertex3 x y z
    @
-}
matVx :: [[a]] -> Vertex3 a
matVx [[a
x], [a
y], [a
z]] = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z


{-|
    === matrix to Vertex

    @
    matVe [[x], [y], [z]] = Vector3 x y z
    @
-}
matVe :: [[a]] -> Vector3 a
matVe [[a
x], [a
y], [a
z]] = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
x a
y a
z


{-|
    === Vector to matrix

    @
    veMat (Vector3 x y z) = [[x], [y], [z]]
    @
-}
veMat :: Vector3 a -> [[a]]
veMat (Vector3 a
x a
y a
z) = [[a
x], [a
y], [a
z]]

        

{-|
    === KEY: rectangle with leftTop and bottomRight
    @
    let     x0 = -0.5::GLfloat
            y0 = -0.5::GLfloat                                                     
            z0 = 0.0::GLfloat                                                      
            x1 = 0.5::GLfloat                                                      
            y1 = 0.5::GLfloat                                                      
            z1 = 0.0::GLfloat  in drawRect ((Vertex3 x0 y0 z0), (Vertex3 x1 y1 z1))

              Y
         p₀   ↑
         ↓    |    th
         +----|----+
         |    |    |  rv
         |    |    |
    lv   |    /----- → x
         |   /     |
         +--/------+ ← p₁  
           z        

             bh   
    @

    http://localhost/image/opengl_draw rect.png
-}                             
drawRect::(Vertex3 GLfloat, Vertex3 GLfloat) -> IO()
drawRect :: (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawRect (p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0), p1 :: Vertex3 GLfloat
p1@(Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)) = do
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
red (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y0 GLfloat
z0)  --  top horizontal 
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
red (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y1 GLfloat
z0)  --  left vertical  
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
red (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y0 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)  --  right vertical
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
red (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y1 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)  --  bottom horizontal
        
{-|
    === KEY: draw rectangle with color (Color3 GLdouble)
-}
drawRectColor::Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO()
drawRectColor :: Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawRectColor Color3 GLdouble
color (p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0), p1 :: Vertex3 GLfloat
p1@(Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)) = do
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
color (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y0 GLfloat
z0)  --  top horizontal 
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
color (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y1 GLfloat
z0)  --  left vertical  
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
color (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y0 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)  --  right vertical
        Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd Color3 GLdouble
color (GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y1 GLfloat
z0, GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)  --  bottom horizontal

{-|
    === KEY: draw rectangle with color (Color3 GLdouble)
-}
drawRectColor2::Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO()
drawRectColor2 :: Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawRectColor2 Color3 GLdouble
color (p0 :: Vertex3 GLdouble
p0@(Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0), p1 :: Vertex3 GLdouble
p1@(Vertex3 GLdouble
x1 GLdouble
y1 GLdouble
z1)) = do
        Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentNoEnd2 Color3 GLdouble
color (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0, GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x1 GLdouble
y0 GLdouble
z0)  --  top horizontal 
        Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentNoEnd2 Color3 GLdouble
color (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x0 GLdouble
y0 GLdouble
z0, GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x0 GLdouble
y1 GLdouble
z0)  --  left vertical  
        Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentNoEnd2 Color3 GLdouble
color (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x1 GLdouble
y0 GLdouble
z0, GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x1 GLdouble
y1 GLdouble
z1)  --  right vertical
        Color3 GLdouble -> (Vertex3 GLdouble, Vertex3 GLdouble) -> IO ()
drawSegmentNoEnd2 Color3 GLdouble
color (GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x0 GLdouble
y1 GLdouble
z0, GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
x1 GLdouble
y1 GLdouble
z1)  --  bottom horizontal
        
        
{-|
    === Draw Rectangle with Width and Height

    @
           w
       ⌜--------⌝
       |        |  
       |        | 
       |   +    | h
       |        |
       |        |
       ⌞--------⌟
    @
-}
drawRect2d::(GLfloat, GLfloat) -> IO()
drawRect2d :: (GLfloat, GLfloat) -> IO ()
drawRect2d (GLfloat
w, GLfloat
h) = do
  (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawRect (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1)
  where
    x0 :: GLfloat
x0 = GLfloat
wGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2
    y0 :: GLfloat
y0 = GLfloat
hGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2
    p0 :: Vertex3 GLfloat
p0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (-GLfloat
x0) GLfloat
y0    GLfloat
0
    p1 :: Vertex3 GLfloat
p1 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0    (-GLfloat
y0) GLfloat
0

{-|
    === Draw on xy-plane quads

    @
      drawQuads [Vertex3 0.1 0.1 0.0, Vertex3 0.2 0.1 0.0, Vertex3 0.2 0.2 0.0, Vertex3 0.1 0.2 0.0]    
    @
-}
drawQuads::[Vertex3 GLfloat] -> IO()
drawQuads :: [Vertex3 GLfloat] -> IO ()
drawQuads [Vertex3 GLfloat]
cx = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
Quads Color3 GLdouble
red ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
cx

{-|
    === KEY: draw quads

    @
    drawQuadsColor red [Vertex3 0.0 0.0 0.0, Vertex3 0.2 0.0 0.0, Vertex3 0.0 0.2 0.0, Vertex3 0.0 0.0 0.2]
    @

    http://localhost/image/opengl_drawquads.png
-}
drawQuadsColor:: Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawQuadsColor :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawQuadsColor Color3 GLdouble
c [Vertex3 GLfloat]
cx = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
Quads Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
cx 

{-|
    === KEY: xz-plane draw quads
-}
drawQuadsXZColor:: Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawQuadsXZColor :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawQuadsXZColor Color3 GLdouble
c [Vertex3 GLfloat]
cx = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
rotate (GLdouble
90)(Vector3 GLdouble -> IO ()) -> Vector3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
1 GLdouble
0 GLdouble
0 :: Vector3 GLdouble)
    PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
Quads Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
cx 

{-|
    === KEY: yz-plane draw quads
-}
drawQuadsYZColor:: Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawQuadsYZColor :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawQuadsYZColor Color3 GLdouble
c [Vertex3 GLfloat]
cx = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    GLdouble -> Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => c -> Vector3 c -> IO ()
rotate (GLdouble
90)(Vector3 GLdouble -> IO ()) -> Vector3 GLdouble -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
0 GLdouble
1 GLdouble
0 :: Vector3 GLdouble)
    PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
Quads Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
cx 



{-|
    === KEY: fill rectangle

    @
             ↑
             |
        v0   ⟶   v1
                   
        ↑           |
        |    +      ↓  -> y

       v3    <—-    v2
    @
-}
drawRectFill2d::Color3 GLdouble -> (GLfloat, GLfloat) -> IO()
drawRectFill2d :: Color3 GLdouble -> (GLfloat, GLfloat) -> IO ()
drawRectFill2d Color3 GLdouble
c (GLfloat
w, GLfloat
h) = do
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawQuadsColor Color3 GLdouble
c [Vertex3 GLfloat
vx0, Vertex3 GLfloat
vx1, Vertex3 GLfloat
vx2, Vertex3 GLfloat
vx3]
  where
    x0 :: GLfloat
x0 = GLfloat
wGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2
    y0 :: GLfloat
y0 = GLfloat
hGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
2
    vx0 :: Vertex3 GLfloat
vx0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (-GLfloat
x0) GLfloat
y0    GLfloat
0
    vx1 :: Vertex3 GLfloat
vx1 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0    GLfloat
y0    GLfloat
0
    vx2 :: Vertex3 GLfloat
vx2 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0    (-GLfloat
y0) GLfloat
0
    vx3 :: Vertex3 GLfloat
vx3 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (-GLfloat
x0) (-GLfloat
y0) GLfloat
0

{-|
    === KEY: fill rectangle

    @
             ↑
             |
        v0   ⟶   v1

        ↑           |
        |    +      ↓  -> y

       v3    <—-    v2
    @
-}
drawRectFill2dX :: Color3 GLdouble -> (GLfloat, GLfloat) -> IO ()
drawRectFill2dX :: Color3 GLdouble -> (GLfloat, GLfloat) -> IO ()
drawRectFill2dX Color3 GLdouble
c (GLfloat
w, GLfloat
h) = do
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawQuadsColor Color3 GLdouble
c [Vertex3 GLfloat
vx0, Vertex3 GLfloat
vx1, Vertex3 GLfloat
vx2, Vertex3 GLfloat
vx3]
  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawQuadsColor (Color3 GLdouble -> Color3 GLdouble
forall a. Fractional a => Color3 a -> Color3 a
f Color3 GLdouble
c) [Vertex3 GLfloat
vx0', Vertex3 GLfloat
vx1', Vertex3 GLfloat
vx2', Vertex3 GLfloat
vx3']
  Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd (Color3 GLdouble -> Color3 GLdouble
forall a. Fractional a => Color3 a -> Color3 a
f Color3 GLdouble
c) (Vertex3 GLfloat
vx0, Vertex3 GLfloat
vx0')
  Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd (Color3 GLdouble -> Color3 GLdouble
forall a. Fractional a => Color3 a -> Color3 a
f Color3 GLdouble
c) (Vertex3 GLfloat
vx1, Vertex3 GLfloat
vx1')
  Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd (Color3 GLdouble -> Color3 GLdouble
forall a. Fractional a => Color3 a -> Color3 a
f Color3 GLdouble
c) (Vertex3 GLfloat
vx2, Vertex3 GLfloat
vx2')
  Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegmentNoEnd (Color3 GLdouble -> Color3 GLdouble
forall a. Fractional a => Color3 a -> Color3 a
f Color3 GLdouble
c) (Vertex3 GLfloat
vx3, Vertex3 GLfloat
vx3')
  where
    x0 :: GLfloat
x0 = GLfloat
w GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ GLfloat
2
    y0 :: GLfloat
y0 = GLfloat
h GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ GLfloat
2
    vx0 :: Vertex3 GLfloat
vx0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
x0) GLfloat
y0 GLfloat
0
    vx1 :: Vertex3 GLfloat
vx1 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
0
    vx2 :: Vertex3 GLfloat
vx2 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 (- GLfloat
y0) GLfloat
0
    vx3 :: Vertex3 GLfloat
vx3 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
x0) (- GLfloat
y0) GLfloat
0
    dep :: GLfloat
dep = -GLfloat
0.02
    vx0' :: Vertex3 GLfloat
vx0' = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
x0) GLfloat
y0 GLfloat
dep
    vx1' :: Vertex3 GLfloat
vx1' = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
dep
    vx2' :: Vertex3 GLfloat
vx2' = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x0 (- GLfloat
y0) GLfloat
dep
    vx3' :: Vertex3 GLfloat
vx3' = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
x0) (- GLfloat
y0) GLfloat
dep
    f :: Color3 a -> Color3 a
f (Color3 a
a a
b a
c) = a -> a -> a -> Color3 a
forall a. a -> a -> a -> Color3 a
Color3 (a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5) (a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5) (a
c a -> a -> a
forall a. Num a => a -> a -> a
* a
0.5)

{-|
  === KEY: draw histgram in opengl 
 -}
drawHis :: [GLfloat] -> IO ()
drawHis :: [GLfloat] -> IO ()
drawHis [GLfloat]
cx = do
  let n :: Integer
n = [GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [GLfloat]
cx
  let δ :: GLfloat
δ = GLfloat
1 GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ Integer -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Integer
n
  let w :: GLfloat
w = GLfloat
δ GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
0.002
  let ls :: [(GLdouble, GLfloat)]
ls = ((GLfloat, GLfloat) -> (GLdouble, GLfloat))
-> [(GLfloat, GLfloat)] -> [(GLdouble, GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map (\(GLfloat
a, GLfloat
b) -> (GLfloat -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLfloat
a, GLfloat
b)) ([(GLfloat, GLfloat)] -> [(GLdouble, GLfloat)])
-> [(GLfloat, GLfloat)] -> [(GLdouble, GLfloat)]
forall a b. (a -> b) -> a -> b
$ [GLfloat] -> [GLfloat] -> [(GLfloat, GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GLfloat]
cx [GLfloat
0 ..]
  ((GLdouble, GLfloat) -> IO ()) -> [(GLdouble, GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ( \(GLdouble
h, GLfloat
c) -> do
        let off :: GLdouble
off = GLfloat -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf (GLfloat -> GLdouble) -> GLfloat -> GLdouble
forall a b. (a -> b) -> a -> b
$ GLfloat
c GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
δ
        IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
off (GLdouble
h GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLdouble
2) GLdouble
0 :: Vector3 GLdouble)
          Color3 GLdouble -> (GLfloat, GLfloat) -> IO ()
drawRectFill2dX Color3 GLdouble
white (GLfloat
w, (GLdouble -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf GLdouble
h))
        IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          let strNum :: [Char]
strNum = [Char] -> GLdouble -> [Char]
forall r. PrintfType r => [Char] -> r
PR.printf [Char]
"%.1f" GLdouble
h :: String
          GLint
strWidth <- StrokeFont -> [Char] -> IO GLint
forall a (m :: * -> *).
(Font a, MonadIO m) =>
a -> [Char] -> m GLint
GLUT.stringWidth StrokeFont
GLUT.Roman [Char]
strNum
          -- strHeight <- GLUT.stringHeight GLUT.Roman str
          -- 1000 => 1000 pixel
          [Char] -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"strWidth=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (GLdouble -> [Char]
forall a. Show a => a -> [Char]
show (GLdouble -> [Char]) -> GLdouble -> [Char]
forall a b. (a -> b) -> a -> b
$ GLint -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLint
strWidth GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLdouble
scaleFont)
          let cen :: GLdouble
cen = GLdouble
off GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- ((GLint -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf GLint
strWidth) GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ (GLdouble
scaleFont GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
* GLdouble
2.0))
          [Char] -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"cen=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (GLdouble -> [Char]
forall a. Show a => a -> [Char]
show GLdouble
cen)
          [Char] -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"off=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (GLdouble -> [Char]
forall a. Show a => a -> [Char]
show GLdouble
off)
          Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
cen (-GLdouble
0.1) GLdouble
0 :: Vector3 GLdouble)
          [Char] -> IO ()
renderText [Char]
strNum
    ) [(GLdouble, GLfloat)]
ls 

drawHisgram :: [GLfloat] -> IO ()
drawHisgram :: [GLfloat] -> IO ()
drawHisgram [GLfloat]
cx = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 (-GLdouble
0.5) GLdouble
0 GLdouble
0 :: Vector3 GLdouble)
    [GLfloat] -> IO ()
drawHis [GLfloat]
cx

renderText :: String -> IO ()
renderText :: [Char] -> IO ()
renderText [Char]
str = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    GLdouble -> GLdouble -> GLdouble -> IO ()
forall c. MatrixComponent c => c -> c -> c -> IO ()
GL.scale (GLdouble
1 GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLdouble
scaleFont :: GL.GLdouble) (GLdouble
1 GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/ GLdouble
scaleFont) GLdouble
1
    StrokeFont -> [Char] -> IO ()
forall a (m :: * -> *). (Font a, MonadIO m) => a -> [Char] -> m ()
GLUT.renderString StrokeFont
GLUT.Roman [Char]
str

{-|
    === draw circle with center and radius

    >drawCircle cen r = drawPrimitive LineLoop red $ circle cen r
-}
drawCircle'::Vertex3 GLfloat -> Double -> IO()
drawCircle' :: Vertex3 GLfloat -> GLdouble -> IO ()
drawCircle' Vertex3 GLfloat
cen GLdouble
r = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
red ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' Vertex3 GLfloat
cen GLdouble
r

                    
drawCircle2::Vertex3 GLfloat -> Double -> IO()
drawCircle2 :: Vertex3 GLfloat -> GLdouble -> IO ()
drawCircle2 Vertex3 GLfloat
cen GLdouble
r = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
red ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> Integer -> [Vertex3 GLfloat]
circleN Vertex3 GLfloat
cen GLdouble
r Integer
30

{-|
    KEY: draw circle with three points

    @
    let q0 = Vertex3 0 0 0
    let q1 = Vertex3 0.8 0.8 0
    let q2 = Vertex3 1.5 0.5 0
    let pt = threePtCircle q0 q1 q2
    print pt
    let c0 = case pt of
                  Just x  -> x
                  Nothing -> (Vertex3 0 0 0)
    
    -- drawCircle2 c0 $ rf $ distX c0 q1
  
    drawCircleThreePt q0 q1 q2 green

    drawSegmentWithEndPt green [q0, q1]
    drawSegmentWithEndPt blue  [q1, q2]
    @
-}
drawCircleThreePt::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Color3 GLdouble -> IO()
drawCircleThreePt :: Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Color3 GLdouble -> IO ()
drawCircleThreePt Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 Color3 GLdouble
co = case Maybe (Vertex3 GLfloat)
c0 of
                                 Just Vertex3 GLfloat
c  -> Vertex3 GLfloat -> GLdouble -> Color3 GLdouble -> Integer -> IO ()
drawCircleColorN Vertex3 GLfloat
c (GLfloat -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf (GLfloat -> GLdouble) -> GLfloat -> GLdouble
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
distX Vertex3 GLfloat
c Vertex3 GLfloat
p1) Color3 GLdouble
co Integer
30
                                 Maybe (Vertex3 GLfloat)
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    where
      c0 :: Maybe (Vertex3 GLfloat)
c0 = Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
threePtCircle Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2

{-|
  SEE: 'drawCircleThreePtListX'
-}
drawCircleThreePtList :: [Vertex3 GLfloat] -> Color3 GLdouble -> IO()
drawCircleThreePtList :: [Vertex3 GLfloat] -> Color3 GLdouble -> IO ()
drawCircleThreePtList [Vertex3 GLfloat]
cx Color3 GLdouble
c = if [Vertex3 GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
cx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3 then Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Color3 GLdouble -> IO ()
drawCircleThreePt Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 Color3 GLdouble
c else [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"List has to contain three Vertex3 GLfloat."
  where
    p0 :: Vertex3 GLfloat
p0 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
0
    p1 :: Vertex3 GLfloat
p1 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
1
    p2 :: Vertex3 GLfloat
p2 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
2
  
{-|
  SEE: 'drawCircleThreePtList'
-}
drawCircleThreePtListX :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawCircleThreePtListX :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawCircleThreePtListX Color3 GLdouble
c [Vertex3 GLfloat]
cx = if [Vertex3 GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
cx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3 then Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Color3 GLdouble -> IO ()
drawCircleThreePt Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 Color3 GLdouble
c else [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"List has to contain three Vertex3 GLfloat."
  where
    p0 :: Vertex3 GLfloat
p0 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
0
    p1 :: Vertex3 GLfloat
p1 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
1
    p2 :: Vertex3 GLfloat
p2 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
2
  
  
{-|
    KEY: three points fixes a circle

    return: center of a circle
-}
threePtCircle::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
threePtCircle :: Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
threePtCircle Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 = case Maybe (Vertex3 GLfloat, [[GLfloat]])
ret of
                              Just (Vertex3 GLfloat, [[GLfloat]])
x  -> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
forall a. a -> Maybe a
Just ((Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst (Vertex3 GLfloat, [[GLfloat]])
x)
                              Maybe (Vertex3 GLfloat, [[GLfloat]])
Nothing -> Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
    where
    c0 :: Vertex3 GLfloat
c0 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
center Vertex3 GLfloat
p0 Vertex3 GLfloat
p1
    pv :: Vector3 GLfloat
pv = Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw (Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0) -- perpendicular to p0 -> p1, counter-clockwise
    x0 :: Vertex3 GLfloat
x0 = Vertex3 GLfloat
c0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: Vector3 GLfloat
pv
    -- line c0 x0
    c1 :: Vertex3 GLfloat
c1 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
center Vertex3 GLfloat
p1 Vertex3 GLfloat
p2
    pu :: Vector3 GLfloat
pu = Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw (Vertex3 GLfloat
p2 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p1) -- perpendicular to p1 -> p2, counter-clockwise
    x1 :: Vertex3 GLfloat
x1 = Vertex3 GLfloat
c1 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: Vector3 GLfloat
pu
    -- line c1 x1
    ret :: Maybe (Vertex3 GLfloat, [[GLfloat]])
ret = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine Vertex3 GLfloat
c0 Vertex3 GLfloat
x0 Vertex3 GLfloat
c1 Vertex3 GLfloat
x1

threePtCircleList :: [Vertex3 GLfloat] -> Maybe (Vertex3 GLfloat)
threePtCircleList :: [Vertex3 GLfloat] -> Maybe (Vertex3 GLfloat)
threePtCircleList [Vertex3 GLfloat]
cx = if [Vertex3 GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
cx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3 then Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
threePtCircle Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 else [Char] -> Maybe (Vertex3 GLfloat)
forall a. HasCallStack => [Char] -> a
error [Char]
"Three pts only in the list"
  where
    p0 :: Vertex3 GLfloat
p0 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
0
    p1 :: Vertex3 GLfloat
p1 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
1
    p2 :: Vertex3 GLfloat
p2 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
2
  
{-|
    KEY: Center of two Vertex3 GLfloat
-}
center:: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
center :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
center (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) (Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1) = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 ((GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
x1) GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ GLfloat
2) ((GLfloat
y0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
y1) GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ GLfloat
2) ((GLfloat
z0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
z1) GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/ GLfloat
2)
  
{-|
    === draw circle with center and radius, n steps

    @
    let cen = Vertex3 0.1 0.0 0.0
    let r = 0.5
    let n = 10
    drawCircleColorN cen r n
    @
-}  
drawCircleColorN::Vertex3 GLfloat -> Double -> Color3 GLdouble -> Integer -> IO()
drawCircleColorN :: Vertex3 GLfloat -> GLdouble -> Color3 GLdouble -> Integer -> IO ()
drawCircleColorN Vertex3 GLfloat
cen GLdouble
r Color3 GLdouble
co Integer
n = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
co ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> Integer -> [Vertex3 GLfloat]
circleN Vertex3 GLfloat
cen GLdouble
r Integer
n
                    
  
drawCircleXYZ::Vertex3 GLfloat -> Double -> IO()
drawCircleXYZ :: Vertex3 GLfloat -> GLdouble -> IO ()
drawCircleXYZ Vertex3 GLfloat
cen GLdouble
r = do
                PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
red ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleXY Vertex3 GLfloat
cen GLdouble
r
                PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
red ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleXZ Vertex3 GLfloat
cen GLdouble
r
                PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
red ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleYZ Vertex3 GLfloat
cen GLdouble
r

drawCircleXYZColor::Vertex3 GLfloat -> Double -> Color3 GLdouble -> IO()
drawCircleXYZColor :: Vertex3 GLfloat -> GLdouble -> Color3 GLdouble -> IO ()
drawCircleXYZColor Vertex3 GLfloat
cen GLdouble
r Color3 GLdouble
c = do
                PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circleXY Vertex3 GLfloat
cen GLdouble
r
--                drawPrimitive' LineLoop c $ circleXZ cen r
--                drawPrimitive' LineLoop c $ circleYZ cen r


{-|
    === draw circle with center , Color3, radius

    >drawCircleColor (Vertex3 0.1 0.2 0.3) red 0.5
-}
drawCircleColor::Vertex3 GLfloat -> Color3 GLdouble -> Double -> IO()
drawCircleColor :: Vertex3 GLfloat -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor Vertex3 GLfloat
cen Color3 GLdouble
c GLdouble
r = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' Vertex3 GLfloat
cen GLdouble
r
                          
drawCircleColor2::Vertex3 GLdouble -> Color3 GLdouble -> Double -> IO()
drawCircleColor2 :: Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
cen Color3 GLdouble
c GLdouble
r = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawPrimitive2 PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLdouble] -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLdouble -> GLdouble -> [Vertex3 GLdouble]
circle2 Vertex3 GLdouble
cen GLdouble
r
                          
{-|
    === Similar to drawCircleColor, but it can do more

    * draw two circles with different centers

    >mapM_ (drawCircleColor' red 0.5) [Vertex3 0.1 0.2 0.3, Vertex3 0.2 0.3 04]
-}
drawCircleColor'::Color3 GLdouble ->Double -> Vertex3 GLfloat -> IO()
drawCircleColor' :: Color3 GLdouble -> GLdouble -> Vertex3 GLfloat -> IO ()
drawCircleColor' Color3 GLdouble
c GLdouble
r Vertex3 GLfloat
cen = PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
LineLoop Color3 GLdouble
c ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> GLdouble -> [Vertex3 GLfloat]
circle' Vertex3 GLfloat
cen GLdouble
r

{-|
    === Conic Parameter Equation
    gx <http://localhost/html/indexThebeautyofTorus.html Conic>
-}
conic::[(GLfloat, GLfloat, GLfloat)]
conic :: [(GLfloat, GLfloat, GLfloat)]
conic= [ let r' :: GLfloat
r' = GLfloat
r GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
rdGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i in (GLfloat
d'GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i, GLfloat
r'GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin(GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
k), GLfloat
r'GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos(GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
k)) | GLfloat
i <- [GLfloat
0..GLfloat
m], GLfloat
k <-[GLfloat
1..GLfloat
n]]
        where
            n :: GLfloat
n = GLfloat
40
            m :: GLfloat
m = GLfloat
10
            h :: GLfloat
h = GLfloat
0.1
            r :: GLfloat
r = GLfloat
0.05
            δ :: GLfloat
δ = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
n
            d' :: GLfloat
d' = GLfloat
hGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
m
            rd :: GLfloat
rd = GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
m


{-|
   KEY: determinant of two dimension matrix
   NOTE: row as column 
   @

   det2 [[a, b], [c, d]]
   =>

   m' =[ 
        [a  c]
        [b  d]
       ]

   det2(m) = a*d - c*b

   @
-}
det2::(Num a)=>[[a]] -> a
det2 :: [[a]] -> a
det2 [[a
a, a
b], [a
c, a
d]] = a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
d a -> a -> a
forall a. Num a => a -> a -> a
- a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
c


--- | Sat Dec 22 20:59:28 2018
--- |
--- | find the inverse of matrix in Rational number
--- | it is not much difference from the Integer code
--- | change division from (div n m) => (n / m)
--- |
inverseR::[[Rational]]->[[Rational]]
inverseR :: [[Rational]] -> [[Rational]]
inverseR [[Rational]]
m = if Rational
diag Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 then [[]] else [[Rational]]
mb'
        where
            id :: [[Rational]]
id = Int -> [[Rational]]
forall a. Num a => Int -> [[a]]
ident' (Int -> [[Rational]]) -> Int -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ [[Rational]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Rational]]
m
            -- argumented matrix [m] ++ [id]
            argm :: [[Rational]]
argm = ([Rational] -> [Rational] -> [Rational])
-> [[Rational]] -> [[Rational]] -> [[Rational]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\[Rational]
x [Rational]
y -> [Rational]
x [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ [Rational]
y) [[Rational]]
m [[Rational]]
id
            -- argm =
            -- [[1 2 3 1 0 0]]
            -- [[4 5 6 0 1 0]]
            -- [[7 8 9 0 0 1]]
            mt :: [[Rational]]
mt = [[Rational]] -> [[Rational]]
upperTri' [[Rational]]
argm
            -- mt =
            -- [[1, 2, 3 x x x]]
            -- [[   2, 2 x x x]]
            -- [[      1 x x x]]
            --
            -- If diag[onal] == 0 then it is single matrix
            diag :: Rational
diag = (Rational -> Rational -> Rational)
-> Rational -> [Rational] -> Rational
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldlRational -> Rational -> Rational
forall a. Num a => a -> a -> a
(*) Rational
1 [[Rational] -> Rational
forall a. [a] -> a
head [Rational]
x | [Rational]
x <- [[Rational]]
mt]
            ar :: [[Rational]]
ar = (Int -> [Rational] -> [Rational])
-> [Int] -> [[Rational]] -> [[Rational]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Int
x [Rational]
y -> (Int -> Rational -> [Rational]
forall a. Int -> a -> [a]
replicate Int
x Rational
0) [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ [Rational]
y) [Int
0..] [[Rational]]
mt
            -- ar =
            -- [[1 2 3 x x x]
            --  [0 2 2 x x x]
            --  [0 0 1 x x x]]
            pm :: [[[Rational]]]
pm = ([Rational] -> [[Rational]]) -> [[Rational]] -> [[[Rational]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
x -> Int -> [Rational] -> [[Rational]]
forall a. Int -> [a] -> [[a]]
partList ([[Rational]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Rational]]
ar) [Rational]
x ) [[Rational]]
ar
            -- pm =
            -- [[[1 2 3] [x x x]]
            --  [[0 1 2] [x x x]]
            --  [[0 0 1] [x x x]]]
            m1 :: [[Rational]]
m1 = ([[Rational]] -> [Rational]) -> [[[Rational]]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Rational]]
r -> [[Rational]] -> [Rational]
forall a. [a] -> a
head [[Rational]]
r) [[[Rational]]]
pm
            m2 :: [[Rational]]
m2 = ([[Rational]] -> [Rational]) -> [[[Rational]]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Rational]]
r -> [[Rational]] -> [Rational]
forall a. [a] -> a
last [[Rational]]
r) [[[Rational]]]
pm
            -- m1 =
            -- [[1 2 3]
            --  [0 1 2]
            --  [0 0 1]]
            -- m2 =
            -- [[x x x]
            --  [x x x]
            --  [x x x]]
            m11 :: [[Rational]]
m11= [[Rational]] -> [[Rational]]
forall a. [a] -> [a]
reverse ([[Rational]] -> [[Rational]]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ ([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
x -> [Rational] -> [Rational]
forall a. [a] -> [a]
reverse [Rational]
x) [[Rational]]
m1
            -- m11 =
            -- [[3 2 1]
            --  [2 1 0]
            --  [1 0 0]]
            -- [[1 0 0]
            --  [2 1 0]
            --  [3 2 1]]
            m22 :: [[Rational]]
m22= [[Rational]] -> [[Rational]]
forall a. [a] -> [a]
reverse ([[Rational]] -> [[Rational]]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ ([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
x -> [Rational] -> [Rational]
forall a. [a] -> [a]
reverse [Rational]
x) [[Rational]]
m2
            -- m22 =
            -- [[x x x]
            --  [x x x]
            --  [x x x]]

            m3 :: [[Rational]]
m3 = ([Rational] -> [Rational] -> [Rational])
-> [[Rational]] -> [[Rational]] -> [[Rational]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\[Rational]
x [Rational]
y -> [Rational]
x [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ [Rational]
y) [[Rational]]
m11 [[Rational]]
m22
            m4 :: [[Rational]]
m4 = [[Rational]] -> [[Rational]]
upperTri' [[Rational]]
m3
            --m4'= map(\r -> map(\x -> divI x   $ toInteger (head r))
            -- Fri Dec 14 16:04:32 2018
            -- remove the division here
            m4' :: [[Rational]]
m4'= ([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
r -> (Rational -> Rational) -> [Rational] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map(\Rational
x -> Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ ([Rational] -> Rational
forall a. [a] -> a
head [Rational]
r)) [Rational]
r) [[Rational]]
m4
            -- Not full inverse matrix here
            mm' :: [[Rational]]
mm'= (Int -> [Rational] -> [Rational])
-> [Int] -> [[Rational]] -> [[Rational]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Int
x [Rational]
y -> (Int -> Rational -> [Rational]
forall a. Int -> a -> [a]
replicate Int
x Rational
0) [Rational] -> [Rational] -> [Rational]
forall a. [a] -> [a] -> [a]
++ [Rational]
y) [Int
0..] [[Rational]]
m4'
            mm :: [[[Rational]]]
mm = ([Rational] -> [[Rational]]) -> [[Rational]] -> [[[Rational]]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
x -> Int -> [Rational] -> [[Rational]]
forall a. Int -> [a] -> [[a]]
partList ([[Rational]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Rational]]
mm') [Rational]
x) [[Rational]]
mm'
            m1' :: [[Rational]]
m1'= ([[Rational]] -> [Rational]) -> [[[Rational]]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Rational]]
x -> [[Rational]] -> [Rational]
forall a. [a] -> a
head [[Rational]]
x) [[[Rational]]]
mm
            m2' :: [[Rational]]
m2'= ([[Rational]] -> [Rational]) -> [[[Rational]]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[[Rational]]
x -> [[Rational]] -> [Rational]
forall a. [a] -> a
last [[Rational]]
x) [[[Rational]]]
mm
            ma' :: [[Rational]]
ma'= ([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
x -> [Rational] -> [Rational]
forall a. [a] -> [a]
reverse [Rational]
x) ([[Rational]] -> [[Rational]]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ [[Rational]] -> [[Rational]]
forall a. [a] -> [a]
reverse [[Rational]]
m1'
            mb' :: [[Rational]]
mb'= ([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Rational]
x -> [Rational] -> [Rational]
forall a. [a] -> [a]
reverse [Rational]
x) ([[Rational]] -> [[Rational]]) -> [[Rational]] -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ [[Rational]] -> [[Rational]]
forall a. [a] -> [a]
reverse [[Rational]]
m2'

{-|
  === Inverse of two dimension matrix
  <http://localhost/pdf/inverse_matrix2.pdf Inverse_matrix_determinant>

    \[
        \begin{equation}
        \begin{aligned}
        A &= \begin{bmatrix}
            a & b \\
            c & d \\
            \end{bmatrix} \\
        A^{ -1} &= \frac{1}{ \det A }
                \begin{bmatrix}
                 d & -b \\
                 -c & a \\
                 \end{bmatrix}
        \end{aligned}
        \end{equation}
    \]
    * inverse should be used in general.

    * Or 'isInver' should be used for large matrix because 'isInver' is implemented
      in <http://localhost/pdf/gram_schmidt.pdf QR_Decompoisition>

    @
    isInver::(Fractional a, Ord a)=> [[a]] -> Bool
    isInver m = if len (filter(< 0.0001) cx) > 0 then False else True
    @

    * Following function is implemented in Gaussian Elimination

    * There is some Integer overflow issue, it only works for small matrix, e.g. 10 by 10

    @
    isInvertible::[[Integer]]->Bool
    @
-}
inv2::(Fractional a)=>[[a]] -> [[a]]
inv2 :: [[a]] -> [[a]]
inv2 [[a
a, a
b], [a
c, a
d]] = (a
1a -> a -> a
forall a. Fractional a => a -> a -> a
/[[a]] -> a
forall a. Num a => [[a]] -> a
det2([[a
a, a
b], [a
c, a
d]])) a -> [[a]] -> [[a]]
forall a. Num a => a -> [[a]] -> [[a]]
*: [[a
d, (-a
b)], [(-a
c), a
a]]
    where
        -- scalar multiply 2x2 matrix
        (*:)::(Num a)=>a -> [[a]] -> [[a]]
        *: :: a -> [[a]] -> [[a]]
(*:) a
a [[a]]
cx = (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [a]) -> [[a]] -> [[a]])
-> ((a -> a) -> [a] -> [a]) -> (a -> a) -> [[a]] -> [[a]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map) (a -> a -> a
forall a. Num a => a -> a -> a
*a
a) [[a]]
cx
        dt :: a
dt = [[a]] -> a
forall a. Num a => [[a]] -> a
det2([[a
a, a
b], [a
c, a
d]])

data SegColinear = Colinear3 -- ^ If three pts are colinear => Colinear3
                   | Colinear4 -- ^ If four pts are colinear => Colinear4
                   | None deriving (SegColinear -> SegColinear -> Bool
(SegColinear -> SegColinear -> Bool)
-> (SegColinear -> SegColinear -> Bool) -> Eq SegColinear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegColinear -> SegColinear -> Bool
$c/= :: SegColinear -> SegColinear -> Bool
== :: SegColinear -> SegColinear -> Bool
$c== :: SegColinear -> SegColinear -> Bool
Eq, Int -> SegColinear -> ShowS
[SegColinear] -> ShowS
SegColinear -> [Char]
(Int -> SegColinear -> ShowS)
-> (SegColinear -> [Char])
-> ([SegColinear] -> ShowS)
-> Show SegColinear
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SegColinear] -> ShowS
$cshowList :: [SegColinear] -> ShowS
show :: SegColinear -> [Char]
$cshow :: SegColinear -> [Char]
showsPrec :: Int -> SegColinear -> ShowS
$cshowsPrec :: Int -> SegColinear -> ShowS
Show)
{-|
    === If four points are colinear then return 'Colinear4'
    === If only three points are colinear then return 'Colinear3'
    === Else return 'None'

    >data SegColinear = Colinear3 -- ^ If three pts are colinear => Colinear3
    >                   | Colinear4 -- ^ If four pts are colinear => Colinear4
    >                   | None deriving (Eq, Show) -- ^ else => None

    The function uses 'isColinear'
-}
fourPtColinear::(Vertex3 GLfloat, Vertex3 GLfloat) -> (Vertex3 GLfloat, Vertex3 GLfloat) -> SegColinear
fourPtColinear :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> SegColinear
fourPtColinear  (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) = if (Bool
is0 Bool -> Bool -> Bool
&& Bool
is1) then SegColinear
Colinear4 else
                                            if (Bool
is0 Bool -> Bool -> Bool
|| Bool
is1) Bool -> Bool -> Bool
|| (Bool
is0' Bool -> Bool -> Bool
|| Bool
is1') then SegColinear
Colinear3 else SegColinear
None
           where
                is0 :: Bool
is0 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                is1 :: Bool
is1 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                is0' :: Bool
is0'= Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
q0 Vertex3 GLfloat
p0 Vertex3 GLfloat
p1
                is1' :: Bool
is1'= Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
q1 Vertex3 GLfloat
p0 Vertex3 GLfloat
p1

-- intersectLineTri :: (Floating a, Ord a) => (Vertex3 a, Vertex3 a) -> (Vertex3 a, Vertex3 a, Vertex3 a) -> Maybe (Vertex3 a)
intersectLineTri :: (Vertex3 GLdouble, Vertex3 GLdouble) -> (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble) -> Maybe (Vertex3 GLdouble)  
intersectLineTri :: (Vertex3 GLdouble, Vertex3 GLdouble)
-> (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble)
-> Maybe (Vertex3 GLdouble)
intersectLineTri (Vertex3 GLdouble
p0, Vertex3 GLdouble
p1) q :: (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble)
q@(Vertex3 GLdouble
q0, Vertex3 GLdouble
q1, Vertex3 GLdouble
q2) = (Bool
isCol Bool -> Bool -> Bool
|| Bool
isPara) Bool
-> Maybe (Vertex3 GLdouble)
-> Maybe (Vertex3 GLdouble)
-> Maybe (Vertex3 GLdouble)
forall a. Bool -> a -> a -> a
? Maybe (Vertex3 GLdouble)
forall a. Maybe a
Nothing (Maybe (Vertex3 GLdouble) -> Maybe (Vertex3 GLdouble))
-> Maybe (Vertex3 GLdouble) -> Maybe (Vertex3 GLdouble)
forall a b. (a -> b) -> a -> b
$ Vertex3 GLdouble -> Maybe (Vertex3 GLdouble)
forall a. a -> Maybe a
Just Vertex3 GLdouble
vx 
  where
   eps :: GLdouble
eps = GLdouble
1e-12 
   vPerp :: Maybe (Vector3 GLdouble)
vPerp = Vector3 GLdouble -> Vector3 GLdouble -> Maybe (Vector3 GLdouble)
crossF (Vertex3 GLdouble
q1 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
q0) (Vertex3 GLdouble
q1 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
q2)
   isCol :: Bool
isCol = case Maybe (Vector3 GLdouble)
vPerp of 
              Just Vector3 GLdouble
v -> Bool
False 
              Maybe (Vector3 GLdouble)
Nothing -> Bool
True 
   -- is line parallel to the plane q
   p0' :: Vertex3 GLdouble
p0' = Vertex3 GLdouble
-> (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble)
-> Vertex3 GLdouble
forall a.
(Fractional a, Eq a) =>
Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> Vertex3 a
perpPlaneX Vertex3 GLdouble
p0 (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble)
q 
   p1' :: Vertex3 GLdouble
p1' = Vertex3 GLdouble
-> (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble)
-> Vertex3 GLdouble
forall a.
(Fractional a, Eq a) =>
Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> Vertex3 a
perpPlaneX Vertex3 GLdouble
p1 (Vertex3 GLdouble, Vertex3 GLdouble, Vertex3 GLdouble)
q
   v01 :: Vector3 GLdouble
v01  = Vertex3 GLdouble
p0 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
p1
   v01' :: Vector3 GLdouble
v01' = Vertex3 GLdouble
p0' Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
p1'  
   ang :: GLdouble
ang = Vector3 GLdouble -> Vector3 GLdouble -> GLdouble
forall a. Floating a => Vector3 a -> Vector3 a -> a
angle2Vector Vector3 GLdouble
v01 Vector3 GLdouble
v01'
   h0 :: GLdouble
h0 = Vector3 GLdouble -> GLdouble
forall a. Floating a => Vector3 a -> a
nr (Vector3 GLdouble -> GLdouble) -> Vector3 GLdouble -> GLdouble
forall a b. (a -> b) -> a -> b
$ Vertex3 GLdouble
p0 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
p0' 
   h1 :: GLdouble
h1 = Vector3 GLdouble -> GLdouble
forall a. Floating a => Vector3 a -> a
nr (Vector3 GLdouble -> GLdouble) -> Vector3 GLdouble -> GLdouble
forall a b. (a -> b) -> a -> b
$ Vertex3 GLdouble
p1 Vertex3 GLdouble -> Vertex3 GLdouble -> Vector3 GLdouble
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLdouble
p1' 
   isPara :: Bool
isPara = GLdouble -> GLdouble
forall a. Num a => a -> a
abs (GLdouble
h0 GLdouble -> GLdouble -> GLdouble
forall a. Num a => a -> a -> a
- GLdouble
h1) GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
< GLdouble
eps
   vx :: Vertex3 GLdouble
vx | GLdouble
h0 GLdouble -> GLdouble -> Bool
forall a. Ord a => a -> a -> Bool
> GLdouble
h1 = let u :: Vector3 GLdouble
u = Vector3 GLdouble -> Vector3 GLdouble
forall a. Floating a => Vector3 a -> Vector3 a
uv Vector3 GLdouble
v01' 
                      x :: GLdouble
x = GLdouble
h0GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(GLdouble -> GLdouble
forall a. Floating a => a -> a
tan GLdouble
ang)
                  in Vertex3 GLdouble
p0' Vertex3 GLdouble -> Vector3 GLdouble -> Vertex3 GLdouble
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLdouble
x GLdouble -> Vector3 GLdouble -> Vector3 GLdouble
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLdouble
u)
      | Bool
otherwise = let u :: Vector3 GLdouble
u = Vector3 GLdouble -> Vector3 GLdouble
forall a. Floating a => Vector3 a -> Vector3 a
uv (Vector3 GLdouble -> Vector3 GLdouble)
-> Vector3 GLdouble -> Vector3 GLdouble
forall a b. (a -> b) -> a -> b
$ (- Vector3 GLdouble
v01') 
                        x :: GLdouble
x = GLdouble
h1GLdouble -> GLdouble -> GLdouble
forall a. Fractional a => a -> a -> a
/(GLdouble -> GLdouble
forall a. Floating a => a -> a
tan GLdouble
ang)
                    in Vertex3 GLdouble
p1' Vertex3 GLdouble -> Vector3 GLdouble -> Vertex3 GLdouble
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLdouble
x GLdouble -> Vector3 GLdouble -> Vector3 GLdouble
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLdouble
u)


{-|
    === Find the intersection of two lines, also see 'intersectSeg'
    ==== Assume that two endpoints of each segment are not overlapped.(segment has non-zero length)

    __NOTE__ This function is ONLY for two dimensions

    __Line__ extends infinitly in both direction


    * If both line intersect at one pt => return the pt
        1. Intersection can be on a segments or NOT on a segment 
    * If four points are colinear: return Nothing, see 'fourPtColinear'

    @
    let p0 = Vertex3 0 0 0
    let p1 = Vertex3 1 0 0
    let q0 = Vertex3 1 0 0
    let q1 = Vertex3 2 0 0
    intersectLine p0 p1 q0 q1
    Nothing

    let xp0 = Vertex3 0 0    0
    let xp1 = Vertex3 1 1    0
    let xq0 = Vertex3 1 0    0
    let xq1 = Vertex3 2 (-1) 0
    let xret = intersectLine xp0 xp1 xq0 xq1
    Just (Vertex3 0.5 0.5 0) , [[0.5], [-0.5]]
    @

    * Two dimensions determinant is used here

    * The Intersection of two line is __NOT__ necessary in their segments
    * If two lines are __parallel__ or __overlapped__ then return Nothing
    * Else return the intersection and \( s, t \)

    \[
        \text{Given four pts: \(p_0, p_1\) and \(q_0, q_1\)} \\
        \begin{aligned}
        v_0 &= p_1 - p_0 \quad v_0 \text{ is a vector} \\
        v_1 &= q_1 - q_0 \quad v_1 \text{ is a vector} \\
        A &= \begin{bmatrix}
             v_0 & v_1
             \end{bmatrix} \\
        \det A &= 0  \quad \text{they are linearly dependent }
        \end{aligned}
    \]

    <http://localhost/pdf/check_line_intersection.pdf Check Line Intersection>
    TODO: Fix ERROR on PDF: <http://localhost/pdf/intersectionLine.pdf intersect_line_PDF>

    @
    data Seg a = Seg a a
    fun::Seg GLflat -> Seg GLfloat -> Maybe(Vertex3 GLfloat, [[GLfloat]])
    fun (Seg (Vertex3 x0 y0 z0) (Vertex3 x1 y1 z1)) = Nothing
    @
    @
    intersectLine p0 p1 q0 q1
    (Just ((Vertex3 2.0 2.0 0), [[2.0],[2.0]]))= intersectLine
                                                (Vertex3 0 0 0)
                                                (Vertex3 1 1 0)
                                                (Vertex3 2 0 0)
                                                (Vertex3 2 1 0)
    @
-}
intersectLine::Vertex3 GLfloat ->
               Vertex3 GLfloat ->
               Vertex3 GLfloat ->
               Vertex3 GLfloat ->
               Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine :: Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0)
              p1 :: Vertex3 GLfloat
p1@(Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)
              q0 :: Vertex3 GLfloat
q0@(Vertex3 GLfloat
a0 GLfloat
b0 GLfloat
c0)
              q1 :: Vertex3 GLfloat
q1@(Vertex3 GLfloat
a1 GLfloat
b1 GLfloat
c1)
              = if GLfloat
d GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== GLfloat
0 Bool -> Bool -> Bool
|| SegColinear
c4 SegColinear -> SegColinear -> Bool
forall a. Eq a => a -> a -> Bool
== SegColinear
Colinear4 then Maybe (Vertex3 GLfloat, [[GLfloat]])
forall a. Maybe a
Nothing else ((Vertex3 GLfloat, [[GLfloat]])
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
forall a. a -> Maybe a
Just (Vertex3 GLfloat
pt, [[GLfloat]]
st))
              where
--                is0 = isColinear p0 q0 q1
--                is1 = isColinear p1 q0 q1
--
                -- if c4 == Colinear4 then four pts are colinear
                c4 :: SegColinear
c4 = (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> SegColinear
fourPtColinear (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1)
                w1 :: [[GLfloat]]
w1   = Vertex3 GLfloat -> [[GLfloat]]
forall a. Vertex3 a -> [[a]]
v2a (Vertex3 GLfloat -> [[GLfloat]]) -> Vertex3 GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => a -> a -> a
- Vertex3 GLfloat
p0  -- [[1, 2]]
                w2 :: [[GLfloat]]
w2   = Vertex3 GLfloat -> [[GLfloat]]
forall a. Vertex3 a -> [[a]]
v2a (Vertex3 GLfloat -> [[GLfloat]]) -> Vertex3 GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => a -> a -> a
- Vertex3 GLfloat
q0  -- [[4, 5]]
                -- if d == 0 then two lines are parallel
                d :: GLfloat
d    = [[GLfloat]] -> GLfloat
forall a. Num a => [[a]] -> a
det2 ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ [[GLfloat]]
w1 [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. [a] -> [a] -> [a]
++ [[GLfloat]]
w2 -- det2 [[1, 2], [4, 5]]
                v01 :: Vector3 GLfloat
v01 = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0 -- p₁ - p₀  f(t) = p₀ + s(p₁ - p₀)
                u01 :: Vector3 GLfloat
u01 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0 -- q₁ - q₀  f(s) = q₀ + t(q₁ - q₀)
                ma :: [[GLfloat]]
ma = [[GLfloat -> GLfloat
ne (GLfloat
x1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
x0), (GLfloat
a1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0)],  -- [s]
                      [GLfloat -> GLfloat
ne (GLfloat
y1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
y0), (GLfloat
b1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0)]]  -- [t]
                ivm :: [[GLfloat]]
ivm= [[GLfloat]] -> [[GLfloat]]
forall a. Fractional a => [[a]] -> [[a]]
inv2 [[GLfloat]]
ma
                v :: [[GLfloat]]
v  = [[GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0],   -- p₀ - q₀
                      [GLfloat
y0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0]]
                -- solve s and t
                -- [s]
                -- [t]
                st :: [[GLfloat]]
st = [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat [[GLfloat]]
ivm [[GLfloat]]
v
                -- |  st = ivm *. v
                s :: GLfloat
s  = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) [[GLfloat]]
st -- st = [[s],[t]]
                -- t  = (last . last) st
                pt :: Vertex3 GLfloat
pt = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
s GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v01)
                ne :: GLfloat -> GLfloat
ne = GLfloat -> GLfloat
forall a. Num a => a -> a
negate
                *. :: [[a]] -> [[a]] -> [[a]]
(*.) [[a
a, a
b], [a
c, a
d]] [[a
x], [a
y]]  = [[a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
y], [a
ca -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
da -> a -> a
forall a. Num a => a -> a -> a
*a
y]]

                v2a :: Vertex3 a -> [[a]]
v2a (Vertex3 a
x a
y a
z) = [[a
x, a
y]]

{-| 
    === If two line parallel or four pts colinear => return Nothing
    === Else there is intersection pt, pt maybe on on segment or NOT on segment

    Sun Feb 17 15:32:59 2019 
    This function should replace 'intersectLine'
-} 
intersectLine2::Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
intersectLine2 :: Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
intersectLine2 p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0)
               p1 :: Vertex3 GLfloat
p1@(Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)
               q0 :: Vertex3 GLfloat
q0@(Vertex3 GLfloat
a0 GLfloat
b0 GLfloat
c0)
               q1 :: Vertex3 GLfloat
q1@(Vertex3 GLfloat
a1 GLfloat
b1 GLfloat
c1) 
                 | GLfloat
d GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== GLfloat
0 Bool -> Bool -> Bool
|| SegColinear
c4 SegColinear -> SegColinear -> Bool
forall a. Eq a => a -> a -> Bool
== SegColinear
Colinear4  = Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. Maybe a
Nothing 
                 | Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
overLappedMaybe Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat)) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. Maybe a
Nothing = Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
overLappedMaybe
                 | Bool
otherwise                  = (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. a -> Maybe a
Just (Vertex3 GLfloat
pt, (GLfloat
s, GLfloat
t)) 
--                 | otherwise                  = (Just (pt, st)) 
                    where
                        -- if c4 == Colinear4 then four pts are colinear
                        c4 :: SegColinear
c4 = (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> SegColinear
fourPtColinear (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1)
                        w1 :: [[GLfloat]]
w1   = Vertex3 GLfloat -> [[GLfloat]]
forall a. Vertex3 a -> [[a]]
v2a (Vertex3 GLfloat -> [[GLfloat]]) -> Vertex3 GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => a -> a -> a
- Vertex3 GLfloat
p0  -- [[1, 2]]
                        w2 :: [[GLfloat]]
w2   = Vertex3 GLfloat -> [[GLfloat]]
forall a. Vertex3 a -> [[a]]
v2a (Vertex3 GLfloat -> [[GLfloat]]) -> Vertex3 GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => a -> a -> a
- Vertex3 GLfloat
q0  -- [[4, 5]]
                        -- if d == 0 then two lines are parallel
                        d :: GLfloat
d    = [[GLfloat]] -> GLfloat
forall a. Num a => [[a]] -> a
det2 ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ [[GLfloat]]
w1 [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. [a] -> [a] -> [a]
++ [[GLfloat]]
w2 -- det2 [[1, 2], [4, 5]]
                        v01 :: Vector3 GLfloat
v01 = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0 -- p₁ - p₀  f(s) = p₀ + s(p₁ - p₀)
                        u01 :: Vector3 GLfloat
u01 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0 -- q₁ - q₀  f(t) = q₀ + t(q₁ - q₀)
                        ma :: [[GLfloat]]
ma = [[GLfloat -> GLfloat
ne (GLfloat
x1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
x0), (GLfloat
a1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0)],  -- [s]
                              [GLfloat -> GLfloat
ne (GLfloat
y1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
y0), (GLfloat
b1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0)]]  -- [t]
                        ivm :: [[GLfloat]]
ivm= [[GLfloat]] -> [[GLfloat]]
forall a. Fractional a => [[a]] -> [[a]]
inv2 [[GLfloat]]
ma
                        v :: [[GLfloat]]
v  = [[GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0],   -- p₀ - q₀
                              [GLfloat
y0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0]]

                        -- If two segments are overlapped ONE endPt
                        overLappedMaybe :: Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
overLappedMaybe = (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
onePtOverlappedSeg (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1)
                        -- solve s and t
                        -- [s]
                        -- [t]
                        st :: [[GLfloat]]
st = [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat [[GLfloat]]
ivm [[GLfloat]]
v
                        -- |  st = ivm *. v
                        s :: GLfloat
s  = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) [[GLfloat]]
st -- st = [[s],[t]]
                        t :: GLfloat
t  = ([GLfloat] -> GLfloat
forall a. [a] -> a
last ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
last) [[GLfloat]]
st -- st = [[s],[t]]
                        pt :: Vertex3 GLfloat
pt = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
s GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v01)
                        ne :: GLfloat -> GLfloat
ne = GLfloat -> GLfloat
forall a. Num a => a -> a
negate
                        *. :: [[a]] -> [[a]] -> [[a]]
(*.) [[a
a, a
b], [a
c, a
d]] [[a
x], [a
y]]  = [[a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
y], [a
ca -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
da -> a -> a
forall a. Num a => a -> a -> a
*a
y]]

                        v2a :: Vertex3 a -> [[a]]
v2a (Vertex3 a
x a
y a
z) = [[a
x, a
y]]


{-| 
    === Given two segments: \( (p_0, p_1), (q_0, q_1) \), find the overlapped endPt

    == Precondition: Four pts are NOT colinear \( \Rightarrow \) __any three pts__ are NOT colinear

    If two segments are overlapped at one endPt, return Maybe(Vertex3 GLfloat, GLfloat s, GLfloat t)
    else return Nothing

    == Four cases
    1. \( p_0 = q_0 \)
    2. \( p_0 = q_1 \)
    3. \( p_1 = q_0 \)
    4. \( p_1 = q_1 \)

    < https://xfido.com/image/onept_overlapped_segment.svg onept_overlapped_segment >

-} 
onePtOverlappedSeg::(Vertex3 GLfloat, Vertex3 GLfloat) -> 
                    (Vertex3 GLfloat, Vertex3 GLfloat) -> 
                    Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
onePtOverlappedSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
onePtOverlappedSeg (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) | Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
q0 = (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. a -> Maybe a
Just (Vertex3 GLfloat
p0, (GLfloat
0.0, GLfloat
0.0)) -- (Vertex3, s, t) 
                                     | Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
q1 = (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. a -> Maybe a
Just (Vertex3 GLfloat
p0, (GLfloat
0.0, GLfloat
1.0)) -- (Vertex3, s, t) 
                                     | Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
q0 = (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. a -> Maybe a
Just (Vertex3 GLfloat
p1, (GLfloat
1.0, GLfloat
0.0)) -- (Vertex3, s, t) 
                                     | Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
q1 = (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. a -> Maybe a
Just (Vertex3 GLfloat
p1, (GLfloat
1.0, GLfloat
1.0)) -- (Vertex3, s, t) 
                                     | Bool
otherwise = Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. Maybe a
Nothing

-- | Four Vertex3 in a list
--
intersectLine'::[Vertex3 GLfloat] ->
               Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine' :: [Vertex3 GLfloat] -> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine' [p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0)
               ,p1 :: Vertex3 GLfloat
p1@(Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)
               ,q0 :: Vertex3 GLfloat
q0@(Vertex3 GLfloat
a0 GLfloat
b0 GLfloat
c0)
               ,q1 :: Vertex3 GLfloat
q1@(Vertex3 GLfloat
a1 GLfloat
b1 GLfloat
c1)
               ]
              = if Bool
is0 Bool -> Bool -> Bool
&& Bool
is1 then Maybe (Vertex3 GLfloat, [[GLfloat]])
forall a. Maybe a
Nothing else ((Vertex3 GLfloat, [[GLfloat]])
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
forall a. a -> Maybe a
Just (Vertex3 GLfloat
pt, [[GLfloat]]
st))
              where
                is0 :: Bool
is0 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                is1 :: Bool
is1 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                v01 :: Vector3 GLfloat
v01 = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0 -- p₁ - p₀  f(t) = p₀ + s(p₁ - p₀)
                u01 :: Vector3 GLfloat
u01 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0 -- q₁ - q₀  f(s) = q₀ + t(q₁ - q₀)
                ma :: [[GLfloat]]
ma  = [[GLfloat -> GLfloat
ne (GLfloat
x1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
x0), (GLfloat
a1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0)],  -- [s]
                      [GLfloat -> GLfloat
ne (GLfloat
y1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
y0), (GLfloat
b1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0)]]  -- [t]
                ivm :: [[GLfloat]]
ivm = [[GLfloat]] -> [[GLfloat]]
forall a. Fractional a => [[a]] -> [[a]]
inv2 [[GLfloat]]
ma
                v :: [[GLfloat]]
v   = [[GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0],   -- p₀ - q₀
                      [GLfloat
y0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0]]
                -- solve s and t
                -- [s]
                -- [t]
                st :: [[GLfloat]]
st = [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a. Num a => [[a]] -> [[a]] -> [[a]]
multiMat [[GLfloat]]
ivm [[GLfloat]]
v
                -- |  st = ivm *. v
                s :: GLfloat
s  = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) [[GLfloat]]
st -- st = [[s],[t]]
                pt :: Vertex3 GLfloat
pt = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (GLfloat
s GLfloat -> Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 GLfloat
v01)
                ne :: GLfloat -> GLfloat
ne = GLfloat -> GLfloat
forall a. Num a => a -> a
negate
                *. :: [[a]] -> [[a]] -> [[a]]
(*.) [[a
a, a
b], [a
c, a
d]] [[a
x], [a
y]]  = [[a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
y], [a
ca -> a -> a
forall a. Num a => a -> a -> a
*a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
da -> a -> a
forall a. Num a => a -> a -> a
*a
y]]
{-|
   === KEY: point to line, pt to line, distance from point to line in 2d

   NOTE: Compute the distance from p0 to line: q0 q1

   TODO: fix, the code only handles two dimension.

   Given a point: p0, line: q0 q1

   Compute the distance from p0 to line: q0 q1

   NOTE: Use 'ptToLine', better function 
-}
pointToLine::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
pointToLine :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
pointToLine Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 = if Bool
is then GLfloat
0.0 else GLfloat
di
            where
                is :: Bool
is = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 -- if three pts are colinear, return zero
                nr :: Vector3 GLfloat
nr = Vector3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vector3 a -> Vector3 a
perpcw (Vector3 GLfloat -> Vector3 GLfloat)
-> Vector3 GLfloat -> Vector3 GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0) -- normal of q0 -> q1
                p1 :: Vertex3 GLfloat
p1 = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vector3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: Vector3 GLfloat
nr -- p0 +: t*normal where t = 1
                vx :: Vertex3 GLfloat
vx = (Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst ((Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat)
-> (Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ Maybe (Vertex3 GLfloat, [[GLfloat]])
-> (Vertex3 GLfloat, [[GLfloat]])
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Vertex3 GLfloat, [[GLfloat]])
 -> (Vertex3 GLfloat, [[GLfloat]]))
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
-> (Vertex3 GLfloat, [[GLfloat]])
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1  -- compute the insection of two lines
                -- square root can not be represented in Rational number in general,
                -- Convert: Vertex3 Rational => Vertex3 GLfloat
                vx' :: Vertex3 GLfloat
vx'= (GLfloat -> GLfloat) -> Vertex3 GLfloat -> Vertex3 GLfloat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GLfloat -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac) Vertex3 GLfloat
vx
                di :: GLfloat
di = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
dist Vertex3 GLfloat
p0 Vertex3 GLfloat
vx'
{-|

   KEY: vector to vertex

   'Vector3' to 'Vertex3'
-}
vecToVex :: Vector3 a -> Vertex3 a
vecToVex :: Vector3 a -> Vertex3 a
vecToVex (Vector3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z

vexToVec :: Vertex3 a -> Vector3 a
vexToVec :: Vertex3 a -> Vector3 a
vexToVec (Vertex3 a
x a
y a
z) = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 a
x a
y a
z


vecToList :: Vector3 a -> [a]
vecToList :: Vector3 a -> [a]
vecToList (Vector3 a
x a
y a
z) = [a
x, a
y, a
z]

vexToList :: Vertex3 a -> [a]
vexToList :: Vertex3 a -> [a]
vexToList (Vertex3 a
x a
y a
z) = [a
x, a
y, a
z]

listToVec :: [a] -> Vector3 a
listToVec :: [a] -> Vector3 a
listToVec [a]
ls = a -> a -> a -> Vector3 a
forall a. a -> a -> a -> Vector3 a
Vector3 ([a] -> a
forall a. [a] -> a
head [a]
lt) (([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail) [a]
lt) ([a] -> a
forall a. [a] -> a
last [a]
lt)
  where
    lt :: [a]
lt = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
3 [a]
ls

listToVex :: [a] -> Vertex3 a
listToVex :: [a] -> Vertex3 a
listToVex [a]
ls = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 ([a] -> a
forall a. [a] -> a
head [a]
lt) (([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail) [a]
lt) ([a] -> a
forall a. [a] -> a
last [a]
lt)
  where
    lt :: [a]
lt = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
3 [a]
ls
  
listToVer :: [a] -> Vertex3 a
listToVer :: [a] -> Vertex3 a
listToVer [a]
ls = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 ([a] -> a
forall a. [a] -> a
head [a]
lt) (([a] -> a
forall a. [a] -> a
head ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail) [a]
lt) ([a] -> a
forall a. [a] -> a
last [a]
lt)
  where
    lt :: [a]
lt = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
3 [a]
ls  

{-|
   === KEY: vector projects on plane
-}
projOnPlane :: (Num a, Eq a) => Vector3 a -> (Vector3 a, Vector3 a) -> Vector3 a
projOnPlane :: Vector3 a -> (Vector3 a, Vector3 a) -> Vector3 a
projOnPlane Vector3 a
v (Vector3 a
v0, Vector3 a
v1) = Vector3 a
v Vector3 a -> Vector3 a -> Vector3 a
forall a. Num a => a -> a -> a
- Vector3 a
vp
  where
    vc :: Vector3 a
vc = case Vector3 a
v0 Vector3 a -> Vector3 a -> Maybe (Vector3 a)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
⊗ Vector3 a
v1 of
              Maybe (Vector3 a)
Nothing -> [Char] -> Vector3 a
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: two vectors can not be parallel, ERROR124"
              Just Vector3 a
v -> Vector3 a
v
    vp :: Vector3 a
vp = (Vector3 a
v Vector3 a -> Vector3 a -> a
forall a. Num a => Vector3 a -> Vector3 a -> a
`dot3ve` Vector3 a
vc) a -> Vector3 a -> Vector3 a
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 a
vc

{-|

  === KEY: point to a line, pt to a line, distance from a pt to a line
  
  <<http://localhost:8080/pdf/project_matrix.pdf project_matrix>>
-}
ptToLine3d :: Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat) -> GLfloat
ptToLine3d :: Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat) -> GLfloat
ptToLine3d Vertex3 GLfloat
p0 (Vertex3 GLfloat
q1, Vertex3 GLfloat
q2) = Vector3 GLfloat -> GLfloat
forall a. Floating a => Vector3 a -> a
nr Vector3 GLfloat
vr
  where
    -- http://localhost:8080/pdf/project_matrix.pdf
    v0 :: [GLfloat]
v0 = Vertex3 GLfloat -> [GLfloat]
forall a. Vertex3 a -> [a]
vexToList Vertex3 GLfloat
p0
    v12 :: Vector3 GLfloat
v12 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q2
    u12 :: Vector3 GLfloat
u12 = Vector3 GLfloat -> Vector3 GLfloat
forall a. Floating a => Vector3 a -> Vector3 a
uv Vector3 GLfloat
v12
    ls :: [GLfloat]
ls = Vector3 GLfloat -> [GLfloat]
forall a. Vector3 a -> [a]
vecToList Vector3 GLfloat
u12
    mx :: [[GLfloat]]
mx = (GLfloat -> GLfloat -> GLfloat)
-> [GLfloat] -> [GLfloat] -> [[GLfloat]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [[c]]
out GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
(*) [GLfloat]
ls [GLfloat]
ls  -- outer product two vector
    vp :: [GLfloat]
vp = [[GLfloat]]
mx [[GLfloat]] -> [GLfloat] -> [GLfloat]
forall a. Num a => [[a]] -> [a] -> [a]
`multiVecL` [GLfloat]
v0  -- p0 project onto v12
    vr :: Vector3 GLfloat
vr = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: [GLfloat] -> Vertex3 GLfloat
forall a. [a] -> Vertex3 a
listToVex [GLfloat]
vp     -- p0 reject onto  v12
{-|

  KEY: angle between two `Vector3 a` `Vector3 a`
  RETURN: radian

  DATE: Fri  8 Mar 22:51:09 2024 
  FIX: There is bug in the old formula to compute the angle

  Change to the dot product formula
  ang = acos (v0 dot3ve v1) / |v0||v1|

  @
  vx = Vertex3
  p0 = vx 1 0 0
  p1 = vx 0 0 0
  p2 = vx 0 1 0

  v10 = p1 -: p0
  v12 = p1 -: p2
  ang = angle2Vector v10 v12

  ang
  1.5707963267948966

  180/pi * ang
  90.0
  @

  @
  > vx = Vertex3
  > p0 = vx 1 0 0
  > p1 = vx 0 0 0
  > p2 = vx 1 0 0

  > v01 = p0 -: p1
  > v12 = p1 -: p2
  > angle2Vector v01 (-v12)
  0.0

  > angle2Vector v01 v12
  3.141592653589793

  > angleThreePts p0 p1 p2
  0.0
  > angleThreePts p2 p1 p0
  0.0
  @

-}
angle2Vector :: (Floating a) => Vector3 a -> Vector3 a -> a
angle2Vector :: Vector3 a -> Vector3 a -> a
angle2Vector Vector3 a
v0 Vector3 a
v1 = a -> a
forall a. Floating a => a -> a
acos (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (Vector3 a
v0 Vector3 a -> Vector3 a -> a
forall a. Num a => Vector3 a -> Vector3 a -> a
`dot3ve` Vector3 a
v1) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v0 a -> a -> a
forall a. Num a => a -> a -> a
* Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v1) 
-- angle2Vector v0 v1 = acos $ (n0*n0 + n1*n1 - dx*dx) / (2 * n0 * n1)
  where 
    x0 :: Vertex3 a
x0 = Vector3 a -> Vertex3 a
forall a. Vector3 a -> Vertex3 a
vecToVex Vector3 a
v0
    x1 :: Vertex3 a
x1 = Vector3 a -> Vertex3 a
forall a. Vector3 a -> Vertex3 a
vecToVex Vector3 a
v1
    dx :: a
dx = Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
distX Vertex3 a
x0 Vertex3 a
x1
    xz :: Vertex3 a
xz = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
0 a
0 a
0
    n0 :: a
n0 = Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
distX Vertex3 a
xz Vertex3 a
x0
    n1 :: a
n1 = Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
distX Vertex3 a
xz Vertex3 a
x1

  
{-|
   === KEY: point to line, pt to line, distance from point to line in 2d

   NOTE: Compute the distance from p0 to line: q0 q1

   TODO: fix, the code only handles two dimension.

   Given a point: p0, line: q0 q1

   Compute the distance from p0 to line: q0 q1

   DATE: Wednesday, 28 February 2024 00:56 PST
   NOTE: Use this function
-}  
ptToLine::Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat) -> GLfloat
ptToLine :: Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat) -> GLfloat
ptToLine Vertex3 GLfloat
p0 (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
pointToLine Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1


{-|
    === Find the intersection of two segments, 'intersectLine' or 'intersectSegNoEndPt'
    ==== Assume that two endpoints of each segment are not overlapped.(segment has non-zero length)

    * (p0, p0) is NOT a segment
    * If two EndPts from different segments are over overlapped => then Maybe(Vertex3 endpt)

    __NOTE__ This function is ONLY for two dimensions

    __NOTE__ endpoins of different segments may be coincide

    @
    intersectSeg (p0, p1) (q0, q1)
    Nothing
    
    intersectSeg (p0, p1) (q0, q1)
    Vertex3 x y z

    v0 = Vertex3 0 0 0
    v1 = Vertex3 1 1 0
    u0 = Vertex3 1 1 0
    u1 = Vertex3 1 0 0
    intersectSeg (v0, v1) (v1, u1)
    Just (Vertex3 1.0 1.0 0.0)
    @

    The function is based on 'intersectLine'
    * If two segments are __parallel__ or __overlapped__ then return Nothing

    TODO: add test cases
-}
intersectSeg::(Vertex3 GLfloat, Vertex3 GLfloat)->(Vertex3 GLfloat, Vertex3 GLfloat)->Maybe (Vertex3 GLfloat)
intersectSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSeg (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) = case Maybe (Vertex3 GLfloat, [[GLfloat]])
is of
                                      Just (Vertex3 GLfloat, [[GLfloat]])
x -> if (GLfloat
s GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0]) Bool -> Bool -> Bool
&& (GLfloat
t GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0]) then (Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
forall a. a -> Maybe a
Just ((Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst (Vertex3 GLfloat, [[GLfloat]])
x)) else Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
                                        where s :: GLfloat
s = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
x
                                              t :: GLfloat
t = ([GLfloat] -> GLfloat
forall a. [a] -> a
last ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
last) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
x
                                      Maybe (Vertex3 GLfloat, [[GLfloat]])
_      -> Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
               where
                is :: Maybe (Vertex3 GLfloat, [[GLfloat]])
is = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1

{-|
    === intersection excluding two EndPts, 'intersectLine' or 'intersectSeg'

    Sun Feb 17 19:24:22 2019

    There are some issues in endpts overlapped

    Deprecated, Should use 'intersectSegNoEndPt2'

    If four pts are colinear \( \Rightarrow \) Nothing

-}
intersectSegNoEndPt::(Vertex3 GLfloat, Vertex3 GLfloat)->(Vertex3 GLfloat, Vertex3 GLfloat)->Maybe (Vertex3 GLfloat)
intersectSegNoEndPt :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) = case Maybe (Vertex3 GLfloat, [[GLfloat]])
is of
                                      Just (Vertex3 GLfloat, [[GLfloat]])
x -> if GLfloat
s GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= GLfloat
0.0 Bool -> Bool -> Bool
&& GLfloat
s GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= GLfloat
1.0 Bool -> Bool -> Bool
&& GLfloat
t GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= GLfloat
0.0 Bool -> Bool -> Bool
&& GLfloat
t GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= GLfloat
1.0 Bool -> Bool -> Bool
&& (GLfloat
s GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0]) Bool -> Bool -> Bool
&& (GLfloat
t GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0]) then (Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
forall a. a -> Maybe a
Just ((Vertex3 GLfloat, [[GLfloat]]) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst (Vertex3 GLfloat, [[GLfloat]])
x)) else Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
                                        where s :: GLfloat
s = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
x
                                              t :: GLfloat
t = ([GLfloat] -> GLfloat
forall a. [a] -> a
last ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
last) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
x
                                      Maybe (Vertex3 GLfloat, [[GLfloat]])
_      -> Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
               where
                is :: Maybe (Vertex3 GLfloat, [[GLfloat]])
is = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1

{-| 
    === intersection excluding two EndPts, 'intersectLine' or 'intersectSeg'
    Sun Feb 17 19:26:05 2019 

    Fixed some bugs in 'intersectSegNoEndPt'

    @
    v0 = Vertex3 0 0 0
    v1 = Vertex3 1 1 0
    u0 = Vertex3 1 1 0
    u1 = Vertex3 1 0 0
    intersectSegNoEndPt2 v0 v1 v1 u1
    Nothing
    @

    SEE picture
    < http://xfido.com/image/endpoint_intersection.svg  end_point_intersection >
-} 
intersectSegNoEndPt2::(Vertex3 GLfloat, Vertex3 GLfloat)->(Vertex3 GLfloat, Vertex3 GLfloat)->Maybe (Vertex3 GLfloat)
intersectSegNoEndPt2 :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt2 (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) | Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
overLapped Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat)) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. Maybe a
Nothing = Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
                                       | Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
is Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat)) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. Maybe a
Nothing = if GLfloat
s GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0] Bool -> Bool -> Bool
&& (GLfloat
t GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0]) then Maybe (Vertex3 GLfloat)
mj else Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
                                       | Bool
otherwise = Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing
                                          where 
                                                is :: Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
is = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
intersectLine2 Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                                                s :: GLfloat
s  = ((GLfloat, GLfloat) -> GLfloat
forall a b. (a, b) -> a
fst ((GLfloat, GLfloat) -> GLfloat)
-> ((Vertex3 GLfloat, (GLfloat, GLfloat)) -> (GLfloat, GLfloat))
-> (Vertex3 GLfloat, (GLfloat, GLfloat))
-> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex3 GLfloat, (GLfloat, GLfloat)) -> (GLfloat, GLfloat)
forall a b. (a, b) -> b
snd) ((Vertex3 GLfloat, (GLfloat, GLfloat)) -> GLfloat)
-> (Vertex3 GLfloat, (GLfloat, GLfloat)) -> GLfloat
forall a b. (a -> b) -> a -> b
$ Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
-> (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
is 
                                                t :: GLfloat
t  = ((GLfloat, GLfloat) -> GLfloat
forall a b. (a, b) -> b
snd ((GLfloat, GLfloat) -> GLfloat)
-> ((Vertex3 GLfloat, (GLfloat, GLfloat)) -> (GLfloat, GLfloat))
-> (Vertex3 GLfloat, (GLfloat, GLfloat))
-> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex3 GLfloat, (GLfloat, GLfloat)) -> (GLfloat, GLfloat)
forall a b. (a, b) -> b
snd) ((Vertex3 GLfloat, (GLfloat, GLfloat)) -> GLfloat)
-> (Vertex3 GLfloat, (GLfloat, GLfloat)) -> GLfloat
forall a b. (a -> b) -> a -> b
$ Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
-> (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
is  
                                                mj :: Maybe (Vertex3 GLfloat)
mj = Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
forall a. a -> Maybe a
Just (Vertex3 GLfloat -> Maybe (Vertex3 GLfloat))
-> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, (GLfloat, GLfloat)) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst ((Vertex3 GLfloat, (GLfloat, GLfloat)) -> Vertex3 GLfloat)
-> (Vertex3 GLfloat, (GLfloat, GLfloat)) -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
-> (Vertex3 GLfloat, (GLfloat, GLfloat))
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
is 
                                                overLapped :: Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
overLapped = (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, (GLfloat, GLfloat))
onePtOverlappedSeg (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1)

                                       
{-|
    === If four pts are colinear return False 
    === If the intersection is within \( s \in [0.0, 1.0], t \in [0.0, 1.0] \) return True
    === Else return False
-}
isIntersectedSeg::(Vertex3 GLfloat, Vertex3 GLfloat)->(Vertex3 GLfloat, Vertex3 GLfloat)->Bool
isIntersectedSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Bool
isIntersectedSeg (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1) = case Maybe (Vertex3 GLfloat, [[GLfloat]])
is of
                                      Just (Vertex3 GLfloat, [[GLfloat]])
x -> (GLfloat
s GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0]) Bool -> Bool -> Bool
&& (GLfloat
t GLfloat -> [GLfloat] -> Bool
forall a. (Num a, Ord a) => a -> [a] -> Bool
∈ [GLfloat
0.0, GLfloat
1.0])
                                        where s :: GLfloat
s = ([GLfloat] -> GLfloat
forall a. [a] -> a
head ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
head) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
x
                                              t :: GLfloat
t = ([GLfloat] -> GLfloat
forall a. [a] -> a
last ([GLfloat] -> GLfloat)
-> ([[GLfloat]] -> [GLfloat]) -> [[GLfloat]] -> GLfloat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[GLfloat]] -> [GLfloat]
forall a. [a] -> a
last) ([[GLfloat]] -> GLfloat) -> [[GLfloat]] -> GLfloat
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, [[GLfloat]]) -> [[GLfloat]]
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, [[GLfloat]])
x
                                      Maybe (Vertex3 GLfloat, [[GLfloat]])
_      -> Bool
False
               where
                is :: Maybe (Vertex3 GLfloat, [[GLfloat]])
is = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 GLfloat, [[GLfloat]])
intersectLine Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1

{-|
    === intersect line, return Rational
-}
intersectLineR::Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Vertex3 GLfloat ->
                Maybe (Vertex3 Rational, [[Rational]])
intersectLineR :: Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 Rational, [[Rational]])
intersectLineR p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0)
               p1 :: Vertex3 GLfloat
p1@(Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1)
               q0 :: Vertex3 GLfloat
q0@(Vertex3 GLfloat
a0 GLfloat
b0 GLfloat
c0)
               q1 :: Vertex3 GLfloat
q1@(Vertex3 GLfloat
a1 GLfloat
b1 GLfloat
c1)
               = if Bool
is0 Bool -> Bool -> Bool
&& Bool
is1 then Maybe (Vertex3 Rational, [[Rational]])
forall a. Maybe a
Nothing else ((Vertex3 Rational, [[Rational]])
-> Maybe (Vertex3 Rational, [[Rational]])
forall a. a -> Maybe a
Just (Vertex3 Rational
pt, [[Rational]]
st))
               where
                is0 :: Bool
is0 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p0 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                is1 :: Bool
is1 = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
p1 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1
                v01 :: Vector3 Rational
v01 = (GLfloat -> Rational) -> Vector3 GLfloat -> Vector3 Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GLfloat -> Rational
forall a. Real a => a -> Rational
toRational) (Vector3 GLfloat -> Vector3 Rational)
-> Vector3 GLfloat -> Vector3 Rational
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0 -- p₁ - p₀  f(t) = p₀ + s(p₁ - p₀)
                u01 :: Vector3 GLfloat
u01 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0 -- q₁ - q₀  f(s) = q₀ + t(q₁ - q₀)
                ma :: [[GLfloat]]
ma = [[GLfloat -> GLfloat
ne (GLfloat
x1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
x0), (GLfloat
a1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0)],  -- [s]
                      [GLfloat -> GLfloat
ne (GLfloat
y1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
y0), (GLfloat
b1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0)]]  -- [t]
                ma' :: [[Rational]]
ma'= [[GLfloat]] -> [[Rational]]
forall (f :: * -> *) (f :: * -> *) a.
(Functor f, Functor f, Real a) =>
f (f a) -> f (f Rational)
toR [[GLfloat]]
ma
                ivm :: [[Rational]]
ivm= [[Rational]] -> [[Rational]]
invR [[Rational]]
ma'
                v' :: [[GLfloat]]
v'  = [[GLfloat
x0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
a0],   -- p₀ - q₀
                      [GLfloat
y0 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
b0]]
                v :: [[Rational]]
v = [[GLfloat]] -> [[Rational]]
forall (f :: * -> *) (f :: * -> *) a.
(Functor f, Functor f, Real a) =>
f (f a) -> f (f Rational)
toR [[GLfloat]]
v'
                -- solve s and t
                -- [s]
                -- [t]
                st :: [[Rational]]
st = [[Rational]]
ivm [[Rational]] -> [[Rational]] -> [[Rational]]
*. [[Rational]]
v
                s :: Rational
s  = ([Rational] -> Rational
forall a. [a] -> a
head ([Rational] -> Rational)
-> ([[Rational]] -> [Rational]) -> [[Rational]] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Rational]] -> [Rational]
forall a. [a] -> a
head) [[Rational]]
st -- st = [[s],[t]]
                p0' :: Vertex3 Rational
p0' = (GLfloat -> Rational) -> Vertex3 GLfloat -> Vertex3 Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GLfloat -> Rational
forall a. Real a => a -> Rational
toRational) Vertex3 GLfloat
p0
                pt :: Vertex3 Rational
pt = Vertex3 Rational
p0' Vertex3 Rational -> Vector3 Rational -> Vertex3 Rational
+> (Rational
s Rational -> Vector3 Rational -> Vector3 Rational
**: Vector3 Rational
v01)
                ne :: GLfloat -> GLfloat
ne = GLfloat -> GLfloat
forall a. Num a => a -> a
negate
                invR::[[Rational]] -> [[Rational]]
                invR :: [[Rational]] -> [[Rational]]
invR [[Rational
a, Rational
b], [Rational
c, Rational
d]] = (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/[[Rational]] -> Rational
detR([[Rational
a, Rational
b], [Rational
c, Rational
d]])) Rational -> [[Rational]] -> [[Rational]]
#: [[Rational
d, (-Rational
b)], [(-Rational
c), Rational
a]]

                (*.)::[[Rational]]->[[Rational]] -> [[Rational]]
                *. :: [[Rational]] -> [[Rational]] -> [[Rational]]
(*.) [[Rational
a, Rational
b], [Rational
c, Rational
d]] [[Rational
x], [Rational
y]]  = [[Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
bRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
y], [Rational
cRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
dRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
y]]

                detR::[[Rational]] -> Rational
                detR :: [[Rational]] -> Rational
detR [[Rational
a, Rational
b], [Rational
c, Rational
d]] = Rational
aRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
d Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
bRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
c
                (#:)::Rational->[[Rational]] -> [[Rational]]
                #: :: Rational -> [[Rational]] -> [[Rational]]
(#:) Rational
r [[Rational]]
cx = (([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Rational] -> [Rational]) -> [[Rational]] -> [[Rational]])
-> ((Rational -> Rational) -> [Rational] -> [Rational])
-> (Rational -> Rational)
-> [[Rational]]
-> [[Rational]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational) -> [Rational] -> [Rational]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
r) [[Rational]]
cx

                (**:)::Rational -> Vector3 Rational -> Vector3 Rational
                **: :: Rational -> Vector3 Rational -> Vector3 Rational
(**:) Rational
r (Vector3 Rational
x Rational
y Rational
z) = Rational -> Rational -> Rational -> Vector3 Rational
forall a. a -> a -> a -> Vector3 a
Vector3 (Rational
rRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
x) (Rational
rRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
y) (Rational
rRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
z)

                toR :: f (f a) -> f (f Rational)
toR f (f a)
m = ((f a -> f Rational) -> f (f a) -> f (f Rational)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f a -> f Rational) -> f (f a) -> f (f Rational))
-> ((a -> Rational) -> f a -> f Rational)
-> (a -> Rational)
-> f (f a)
-> f (f Rational)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Rational) -> f a -> f Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (a -> Rational
forall a. Real a => a -> Rational
toRational) f (f a)
m

                (+>)::Vertex3 Rational -> Vector3 Rational -> Vertex3 Rational
                +> :: Vertex3 Rational -> Vector3 Rational -> Vertex3 Rational
(+>) (Vertex3 Rational
a Rational
b Rational
c) (Vector3 Rational
x Rational
y Rational
z) = Rational -> Rational -> Rational -> Vertex3 Rational
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Rational
a Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
x) (Rational
b Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
y) (Rational
c Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
z)

{-|
 === Three points rotation order can be determinated by the \( \color{red}{\text{Right Hand Rule}} \)
 <http://localhost/html/indexConvexHullAlgorithm.html#rotate_dir Three_Points_Direction>

  If given three points in following order:

  p₀ = (1, 0)

  p₁ = (0, 0)

  p₂ = (0, 1)

  then vectors are computed in following:

  v10 = p₀ - p₁

  v12 = p₂ - p₁

 matrix can be formed as following:

 m = [v10, v12]

 \( \vec{v_{01}} \times \vec{v_{02}} \) in Right Hand Rule

 \[
  m = \begin{bmatrix}
      1 & 0 \\
      0 & 1 \\
      \end{bmatrix} \\
  \det m = 1 > 0 \\
 \]

 If the three points are collinear:

 \( \det M = 0 \)

 If the order of three points in clockwise order:

 \( \det M > 0 \)

 If the order of three points in counter clockwise order:

 \( \det M < 0 \)

 @
 Sunday, 14 April 2024 14:50 PDT
 FIXME: there is bug in the cod
        v10 = v2m $ p0 -: p1
        v10 = v2m $ p1 -: p0 ?
 @

-}
threePtDeterminant::(Fractional a)=>(Vertex3 a) ->(Vertex3 a)->(Vertex3 a)->a
threePtDeterminant :: Vertex3 a -> Vertex3 a -> Vertex3 a -> a
threePtDeterminant Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 = [[a]] -> a
forall a. Num a => [[a]] -> a
det [[a]]
m
  where
    v10 :: [a]
v10 = Vector3 a -> [a]
forall a. Vector3 a -> [a]
v2m (Vector3 a -> [a]) -> Vector3 a -> [a]
forall a b. (a -> b) -> a -> b
$ Vertex3 a
p0 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p1
    v12 :: [a]
v12 = Vector3 a -> [a]
forall a. Vector3 a -> [a]
v2m (Vector3 a -> [a]) -> Vector3 a -> [a]
forall a b. (a -> b) -> a -> b
$ Vertex3 a
p2 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p1
    v2m :: Vector3 a -> [a]
v2m (Vector3 a
x a
y a
z) = [a
x, a
y]
    m :: [[a]]
m = [[a]
v10, [a]
v12]

{-|
 === Three points in Counter ClockWise order
 \(  \det M > 0 \)
-}
threePtCCW::(Fractional a, Ord a)=>(Vertex3 a)->(Vertex3 a)->(Vertex3 a)->Bool
threePtCCW :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
threePtCCW Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 = Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Fractional a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
threePtDeterminant Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0

{-|
 === Three points in ClockWise order
 \( \det M < 0 \)
-}
threePtCW::(Fractional a, Ord a)=>(Vertex3 a)->(Vertex3 a)->(Vertex3 a)->Bool
threePtCW :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
threePtCW Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 = Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Fractional a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
threePtDeterminant Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0

{-|
    === Three points are collinear

\[
    \begin{aligned}
    p_0 &= (x_0, y_0) \\
    p_1 &= (x_1, y_1) \\
    p_2 &= (x_2, y_2) \\
    u   &= p_0 - p_1 \\
    u   &= (x_0 - x_1, y_0 - y_1) \\
    v   &= p_2 - p_1 \\
    v   &= (x_2 - x_1, y_2 - y_1) \\
    M   &= \begin{bmatrix}
           u & v
           \end{bmatrix} \\
    &\mbox{If three pts are colinear, then } \\
    \det M &= 0 \\
    \end{aligned}
\]
-}
threePtCollinear::(Fractional a, Ord a)=>(Vertex3 a)->(Vertex3 a)->(Vertex3 a)->Bool
threePtCollinear :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
threePtCollinear Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 = Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Fractional a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
threePtDeterminant Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0.0

{-|
    Given a point \( p_0 \), a line \(q_0, q_2 \)
    === Check whether a point \(p_0\) is on the left size of a line \( q_0, q_2 \), it is based on 'threePtDeterminant' with additional condtion: \(y_2 > y_0 \) or \( y_2 < y_0 \) since

    __NOTE__ y2 \(\neq\) y0 where given (Vertex3 x0 y0 z0) and (Vertex3 x2 y2 z2)

    ==== Assume \( p_0, p_2 \) are not __coincide__

    * If pt on the line, return False
    * If pt on the right side of the line, return False
    * Else return True

    \[
        \begin{aligned}
        p_1 &= (x_1, y_1) \\
        p_0 &= (x_0, y_0) \\
        p_2 &= (x_2, y_2) \\
        u &= \overrightarrow{p1 p0}  \\
        v &= \overrightarrow{p1 p2}  \\
        \end{aligned}
    \]

    if \( y_2 > y_0 \)
    form a determinant
    \[
        \begin{aligned}
         \det \begin{vmatrix}
                u & v
                \end{vmatrix} > 0
        \end{aligned}
    \]
    if \( y_2 < y_0 \)
    form a determinant
    \[
        \begin{aligned}
         \det \begin{vmatrix}
                u & v
                \end{vmatrix} < 0
        \end{aligned}
    \]

    If \( y_2 = y_0 \), compare \( x_0, x_2 \)

    === Check whether a point is below a line \(p_0, p_2\)
    if \( x_2 < x_0 \)
    \[
        \begin{aligned}
         \det \begin{vmatrix}
                u & v
                \end{vmatrix} > 0
        \end{aligned}
    \]

    if \( x_2 > x_0 \)
    \[
        \begin{aligned}
         \det \begin{vmatrix}
                u & v
                \end{vmatrix} < 0
        \end{aligned}
    \]


-}
ptOnLeftLine::(Fractional a, Ord a)=>(Vertex3 a) ->(Vertex3 a)->(Vertex3 a) -> Bool
ptOnLeftLine :: Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
ptOnLeftLine p0 :: Vertex3 a
p0@(Vertex3 a
x0 a
y0 a
z0)
             p1 :: Vertex3 a
p1@(Vertex3 a
x1 a
y1 a
z1)
             p2 :: Vertex3 a
p2@(Vertex3 a
x2 a
y2 a
z2) = if a
y2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y0 then (a
de a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True
                                        else if a
y2 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
y0 then (a
de a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False else (a
de a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False
             where
                de :: a
de = Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Fractional a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
threePtDeterminant Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2

--ptOnUpLine::(Fractional a, Ord a)=>(Vertex3 a) ->(Vertex3 a)->(Vertex3 a) -> Bool
--

{-|
  === KEY: Check whether a point \(p_0\) is inside a triangle \( \triangle ABC \), point is inside triangle

  * is a point inside a triangle
  * __NOTE__ the order of three pts: \(A, B, C\) does't matter. e.g CCW or CW
  * \(p_0\) can NOT be the same point as \(A, B, C\), if \(p_0\) is overlapped pts \(A, B, C\), then return (False, 0.0)
  * If \(p_0\) is collinear with AB, BC, or AC, then \(p_0\) is considered inside the \( \triangle ABC \)

  \(p_0\) is the point that is tested
  three points \(A, B, C\) forms a triangle

  * if point p0 inside the triangle, return true

  * The sum of three angles are in degree.

  @
  let p0 = Vertex3 0.1 0.1 0
  let a  = Vertex3 1 0 0
  let b  = Vertex3 0 0 0
  let c  = Vertex3 0 1 0
  
  ptInsideTri p0 (a, b, c)
  (True, 360.0)
  @

  TODO: how to check whether a pt is inside a n-polygon 'ptInsidePolygon'
  <http://localhost/html/indexConvexHullAlgorithm.html#npolygon N-Polygon>

  DATE: Tue 12 Mar 01:01:02 2024 
  FIX: fixed a serious bug when two different types are mixed
  NOTE: Floating a => Vertex3 a and Vertex3 GLfloat 

  DATE: Mon 18 Mar 11:59:21 2024 
  UPDATE: if the vertex is same as one of triangle vertexes, then the vertex is INSIDE the triangle

-}
ptInsideTri::(Floating a, Ord a) => Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> (Bool, a)
-- ptInsideTri p0 (a, b, c) = (notSame && isOK, isOK ? rad $ -1)
ptInsideTri :: Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> (Bool, a)
ptInsideTri Vertex3 a
p0 (Vertex3 a
a, Vertex3 a
b, Vertex3 a
c) = (Bool
isSameVer Bool -> Bool -> Bool
|| Bool
isOK, Bool
isOK Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
? a
rad (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ -a
1)
           where
             eps :: a
eps = a
1e-12 
             allTrue :: t Bool -> Bool
allTrue t Bool
ls = (Bool -> Bool -> Bool) -> Bool -> t Bool -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Bool
a Bool
b -> Bool
a Bool -> Bool -> Bool
&& Bool
b) Bool
True t Bool
ls
             hasTrue :: t Bool -> Bool
hasTrue t Bool
ls = (Bool -> Bool -> Bool) -> Bool -> t Bool -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Bool
a Bool
b -> Bool
a Bool -> Bool -> Bool
|| Bool
b ) Bool
False t Bool
ls 
             verCheck :: t a -> t a -> Bool
verCheck t a
v0 t a
v1 = let s :: t Bool
s = (a -> Bool) -> t a -> t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> a -> a
forall a. Num a => a -> a
abs a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
eps) (t a -> t Bool) -> t a -> t Bool
forall a b. (a -> b) -> a -> b
$ t a
v0 t a -> t a -> t a
forall a. Num a => a -> a -> a
- t a
v1 in t Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
allTrue t Bool
s
             isSameVer :: Bool
isSameVer  = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
hasTrue ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Vertex3 a -> Bool) -> [Vertex3 a] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 a
x -> Vertex3 a -> Vertex3 a -> Bool
forall (t :: * -> *).
(Foldable t, Functor t, Num (t a)) =>
t a -> t a -> Bool
verCheck Vertex3 a
p0 Vertex3 a
x) [Vertex3 a
a, Vertex3 a
b, Vertex3 a
c]
             -- notSame = not $ p0 `elem` [a, b, c]
             v10 :: Vector3 a
v10 = Vertex3 a
p0 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
a 
             v12 :: Vector3 a
v12 = Vertex3 a
p0 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
b 
             d :: a
d = Vector3 a -> Vector3 a -> a
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve Vector3 a
v10 Vector3 a
v12
             n1 :: a
n1 = Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v10
             n2 :: a
n2 = Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v12
             rad :: a
rad= (Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 a
b Vertex3 a
p0 Vertex3 a
a) a -> a -> a
forall a. Num a => a -> a -> a
+ (Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 a
c Vertex3 a
p0 Vertex3 a
b) a -> a -> a
forall a. Num a => a -> a -> a
+ (Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 a
c Vertex3 a
p0 Vertex3 a
a)
             isOK :: Bool
isOK = a -> a
forall a. Num a => a -> a
abs(a
rad a -> a -> a
forall a. Num a => a -> a -> a
- a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
forall a. Floating a => a
pi) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
eps
{--
ptInsideTri::Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> (Bool, GLfloat)
ptInsideTri p0 (a, b, c) = (notSame && is, notSame ? rad $ 0.0)
                           where
                             notSame = not $ p0 `elem` [a, b, c]
                             rad= (cosVex3 b p0 a) + (cosVex3 c p0 b) + (cosVex3 c p0 a)
                             is = abs(rad - 2*pi) < 0.000001
  
--}



{-|
    === KEY: same as 'ptInsideTri' is a point inside a triangle

    * Better name

    DATE: Mon 18 Mar 14:56:10 2024 
    NOTE: deprecated
    NOTE: Does not support 'Float' and 'Double'
    NOTE: use 'ptInsideTri'
-}
isPtInsideTri::Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> (Bool, GLfloat)
isPtInsideTri :: Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
isPtInsideTri Vertex3 GLfloat
p0 (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) = Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
forall a.
(Floating a, Ord a) =>
Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> (Bool, a)
ptInsideTri Vertex3 GLfloat
p0 (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c)

{-|
    === KEY: almost same as 'ptInsideTri' is a point inside a triangle

    * Pass a list of vertex (three)
    * Better name
-}  
isPtInsideTriList::Vertex3 GLfloat -> [Vertex3 GLfloat] -> (Bool, GLfloat)
isPtInsideTriList :: Vertex3 GLfloat -> [Vertex3 GLfloat] -> (Bool, GLfloat)
isPtInsideTriList Vertex3 GLfloat
p0 [Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c] = Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
forall a.
(Floating a, Ord a) =>
Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> (Bool, a)
ptInsideTri Vertex3 GLfloat
p0 (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c)
  

{-|
 - KEY: distance to plane, pt to plane, point to three points
 -
  Given a point p0 and three pts: q0, q1, q2,

  Compute the intersection of line is perpendicular to the plane and passes point p0

  If three pts (q0, q1, q2) are colinear, return Nothing

  otherwise, return Just (Vertex3 GLfloat)

  NOTE: the function does not work in 3d
-}
perpPlane::(Vertex3 GLfloat) ->
           (Vertex3 GLfloat) ->
           (Vertex3 GLfloat) ->
           (Vertex3 GLfloat) ->
           Maybe (Vertex3 Rational)
perpPlane :: Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 Rational)
perpPlane p0 :: Vertex3 GLfloat
p0@(Vertex3 GLfloat
e0 GLfloat
e1 GLfloat
e2)
          q0 :: Vertex3 GLfloat
q0@(Vertex3 GLfloat
m0 GLfloat
m1 GLfloat
m2)
          q1 :: Vertex3 GLfloat
q1@(Vertex3 GLfloat
k0 GLfloat
k1 GLfloat
k2)
          q2 :: Vertex3 GLfloat
q2@(Vertex3 GLfloat
d0 GLfloat
d1 GLfloat
d2)
          = if Bool
is then Maybe (Vertex3 Rational)
forall a. Maybe a
Nothing else Vertex3 Rational -> Maybe (Vertex3 Rational)
forall a. a -> Maybe a
Just Vertex3 Rational
pt
        where
            is :: Bool
is = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 Vertex3 GLfloat
q2
            nr :: Vector3 GLfloat
nr = Maybe (Vector3 GLfloat) -> Vector3 GLfloat
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Vector3 GLfloat) -> Vector3 GLfloat)
-> Maybe (Vector3 GLfloat) -> Vector3 GLfloat
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe (Vector3 GLfloat)
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Maybe (Vector3 a)
normal3 Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 Vertex3 GLfloat
q2
            v1 :: Vector3 GLfloat
v1 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0
            v2 :: Vector3 GLfloat
v2 = Vertex3 GLfloat
q2 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0
            qp :: Vector3 GLfloat
qp = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0
            vqp :: [[Rational]]
vqp = (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]])
-> ((GLfloat -> Rational) -> [GLfloat] -> [Rational])
-> (GLfloat -> Rational)
-> [[GLfloat]]
-> [[Rational]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLfloat -> Rational) -> [GLfloat] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map) (GLfloat -> Rational
forall a. Real a => a -> Rational
toRational) ([[GLfloat]] -> [[Rational]]) -> [[GLfloat]] -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat Vector3 GLfloat
qp
            mat :: [[GLfloat]]
mat = ([GLfloat] -> [GLfloat] -> [GLfloat] -> [GLfloat])
-> [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3(\[GLfloat]
x [GLfloat]
y [GLfloat]
z -> [GLfloat]
x [GLfloat] -> [GLfloat] -> [GLfloat]
forall a. [a] -> [a] -> [a]
++ [GLfloat]
y [GLfloat] -> [GLfloat] -> [GLfloat]
forall a. [a] -> [a] -> [a]
++ [GLfloat]
z) (Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat Vector3 GLfloat
v1) (Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat Vector3 GLfloat
v2) (Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat (Vector3 GLfloat -> [[GLfloat]]) -> Vector3 GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ Vector3 GLfloat -> Vector3 GLfloat
forall (f :: * -> *) b. (Functor f, Num b) => f b -> f b
neg Vector3 GLfloat
nr)
            mat' :: [[Rational]]
mat' = (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]])
-> ((GLfloat -> Rational) -> [GLfloat] -> [Rational])
-> (GLfloat -> Rational)
-> [[GLfloat]]
-> [[Rational]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLfloat -> Rational) -> [GLfloat] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map) (GLfloat -> Rational
forall a. Real a => a -> Rational
toRational) [[GLfloat]]
mat
            ima :: [[Rational]]
ima = [[Rational]] -> [[Rational]]
inverseR [[Rational]]
mat'
            sth :: [[Rational]]
sth = [[Rational]] -> [[Rational]] -> [[Rational]]
multiMatR [[Rational]]
ima [[Rational]]
vqp -- sth =  [[s], [t], [h]]
            h :: Rational
h  = ([Rational] -> Rational
forall a. [a] -> a
last ([Rational] -> Rational)
-> ([[Rational]] -> [Rational]) -> [[Rational]] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Rational]] -> [Rational]
forall a. [a] -> a
last) [[Rational]]
sth
            pt :: Vertex3 Rational
pt  = Vertex3 Rational
p0' Vertex3 Rational -> Vector3 Rational -> Vertex3 Rational
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
`ad` (Rational
h Rational -> Vector3 Rational -> Vector3 Rational
forall (f :: * -> *) b. (Functor f, Num b) => b -> f b -> f b
`mu` Vector3 Rational
nr') where
                                        p0' :: Vertex3 Rational
p0' = Vertex3 GLfloat -> Vertex3 Rational
forall (f :: * -> *) a. (Functor f, Real a) => f a -> f Rational
toR Vertex3 GLfloat
p0 -- toRational
                                        mu :: b -> f b -> f b
mu b
x f b
y = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(b -> b -> b
forall a. Num a => a -> a -> a
*b
x) f b
y  -- t*v
                                        nr' :: Vector3 Rational
nr' = Vector3 GLfloat -> Vector3 Rational
forall (f :: * -> *) a. (Functor f, Real a) => f a -> f Rational
toR Vector3 GLfloat
nr  -- toRational
                                        -- pt = p0 + v in affine space:)
                                        ad :: Vertex3 a -> Vector3 a -> Vertex3 a
ad (Vertex3 a
x a
y a
z) (Vector3 a
a a
b a
c) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a) (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) (a
z a -> a -> a
forall a. Num a => a -> a -> a
+ a
c)

            -- | local functions
            veMat :: Vector3 a -> [[a]]
veMat (Vector3 a
x a
y a
z) = [[a
x], [a
y], [a
z]]
            matVx :: [[a]] -> Vertex3 a
matVx [[a
x], [a
y], [a
z]] = (a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z)
            neg :: f b -> f b
neg f b
x = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b
forall a. Num a => a -> a
negate) f b
x
            toR :: f a -> f Rational
toR f a
x = (a -> Rational) -> f a -> f Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Rational
forall a. Real a => a -> Rational
toRational) f a
x

-- | Line intersects Plane
-- | Given Line: p0 p1 and Plane: q0 q1 q2
-- | Compute the intersection of line and plane
-- |
--  p1 = p0 +: h(p1 -: p0)
lineIntersectPlane::Vertex3 GLfloat ->
                    Vector3 GLfloat ->
                    Vertex3 GLfloat ->
                    Vertex3 GLfloat ->
                    Vertex3 GLfloat ->
                    Maybe (Vertex3 Rational)
lineIntersectPlane :: Vertex3 GLfloat
-> Vector3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Maybe (Vertex3 Rational)
lineIntersectPlane Vertex3 GLfloat
p0 Vector3 GLfloat
ve Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 Vertex3 GLfloat
q2 = if Bool
is then Maybe (Vertex3 Rational)
forall a. Maybe a
Nothing else Vertex3 Rational -> Maybe (Vertex3 Rational)
forall a. a -> Maybe a
Just Vertex3 Rational
pt
                where
                    is :: Bool
is = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a.
(Num a, Eq a) =>
Vertex3 a -> Vertex3 a -> Vertex3 a -> Bool
isColinear Vertex3 GLfloat
q0 Vertex3 GLfloat
q1 Vertex3 GLfloat
q2
                    v1 :: Vector3 GLfloat
v1 = Vertex3 GLfloat
q1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0 -- q0 -> q1
                    v2 :: Vector3 GLfloat
v2 = Vertex3 GLfloat
q2 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0 -- q0 -> q2
                    nr :: Vector3 GLfloat
nr = Vector3 GLfloat
ve
                    qp :: Vector3 GLfloat
qp = Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
q0
                    vqp :: [[Rational]]
vqp = (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]])
-> ((GLfloat -> Rational) -> [GLfloat] -> [Rational])
-> (GLfloat -> Rational)
-> [[GLfloat]]
-> [[Rational]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLfloat -> Rational) -> [GLfloat] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map) (GLfloat -> Rational
forall a. Real a => a -> Rational
toRational) ([[GLfloat]] -> [[Rational]]) -> [[GLfloat]] -> [[Rational]]
forall a b. (a -> b) -> a -> b
$ Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat Vector3 GLfloat
qp
                    mat :: [[GLfloat]]
mat = ([GLfloat] -> [GLfloat] -> [GLfloat] -> [GLfloat])
-> [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]] -> [[GLfloat]]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3(\[GLfloat]
x [GLfloat]
y [GLfloat]
z -> [GLfloat]
x [GLfloat] -> [GLfloat] -> [GLfloat]
forall a. [a] -> [a] -> [a]
++ [GLfloat]
y [GLfloat] -> [GLfloat] -> [GLfloat]
forall a. [a] -> [a] -> [a]
++ [GLfloat]
z) (Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat Vector3 GLfloat
v1) (Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat Vector3 GLfloat
v2) (Vector3 GLfloat -> [[GLfloat]]
forall a. Vector3 a -> [[a]]
veMat (Vector3 GLfloat -> [[GLfloat]]) -> Vector3 GLfloat -> [[GLfloat]]
forall a b. (a -> b) -> a -> b
$ Vector3 GLfloat -> Vector3 GLfloat
forall (f :: * -> *) b. (Functor f, Num b) => f b -> f b
neg Vector3 GLfloat
nr)
                    mat' :: [[Rational]]
mat' = (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]]
forall a b. (a -> b) -> [a] -> [b]
map (([GLfloat] -> [Rational]) -> [[GLfloat]] -> [[Rational]])
-> ((GLfloat -> Rational) -> [GLfloat] -> [Rational])
-> (GLfloat -> Rational)
-> [[GLfloat]]
-> [[Rational]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GLfloat -> Rational) -> [GLfloat] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map) (GLfloat -> Rational
forall a. Real a => a -> Rational
toRational) [[GLfloat]]
mat
                    ima :: [[Rational]]
ima = [[Rational]] -> [[Rational]]
inverseR [[Rational]]
mat'
                    sth :: [[Rational]]
sth = [[Rational]] -> [[Rational]] -> [[Rational]]
multiMatR [[Rational]]
ima [[Rational]]
vqp -- sth =  [[s], [t], [h]]
                    h :: Rational
h  = ([Rational] -> Rational
forall a. [a] -> a
last ([Rational] -> Rational)
-> ([[Rational]] -> [Rational]) -> [[Rational]] -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Rational]] -> [Rational]
forall a. [a] -> a
last) [[Rational]]
sth
                    pt :: Vertex3 Rational
pt  = Vertex3 Rational
p0' Vertex3 Rational -> Vector3 Rational -> Vertex3 Rational
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
`ad` (Rational
h Rational -> Vector3 Rational -> Vector3 Rational
forall (f :: * -> *) b. (Functor f, Num b) => b -> f b -> f b
`mu` Vector3 Rational
nr') where
                                                p0' :: Vertex3 Rational
p0' = Vertex3 GLfloat -> Vertex3 Rational
forall (f :: * -> *) a. (Functor f, Real a) => f a -> f Rational
toR Vertex3 GLfloat
p0 -- toRational
                                                mu :: b -> f b -> f b
mu b
x f b
y = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap(b -> b -> b
forall a. Num a => a -> a -> a
*b
x) f b
y  -- t*v
                                                nr' :: Vector3 Rational
nr' = Vector3 GLfloat -> Vector3 Rational
forall (f :: * -> *) a. (Functor f, Real a) => f a -> f Rational
toR Vector3 GLfloat
nr  -- toRational
                                                -- pt = p0 + v in affine space:)
                                                ad :: Vertex3 a -> Vector3 a -> Vertex3 a
ad (Vertex3 a
x a
y a
z) (Vector3 a
a a
b a
c) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a) (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
b) (a
z a -> a -> a
forall a. Num a => a -> a -> a
+ a
c)

                    -- | local functions
                    veMat :: Vector3 a -> [[a]]
veMat (Vector3 a
x a
y a
z) = [[a
x], [a
y], [a
z]]
                    matVx :: [[a]] -> Vertex3 a
matVx [[a
x], [a
y], [a
z]] = (a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
z)
                    neg :: f b -> f b
neg f b
x = (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b
forall a. Num a => a -> a
negate) f b
x
                    toR :: f a -> f Rational
toR f a
x = (a -> Rational) -> f a -> f Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Rational
forall a. Real a => a -> Rational
toRational) f a
x


{-|
 === Slow Algorithm 1 \( \color{red}{ \mathcal{O}(n^2)} \)
 1. find the a point \( p_0 \) which has the maximum y-axis value
 2. find the a point \( p' \) from \( p_0 \) so that the rest of all the points on one side of the segment \( \overline{p_0 p'} \)
 3. continua with the rest of points

 <http://localhost/html/indexConvexHullAlgorithm.html Slow_Algorithm>

 >p0 p1 p2 p3
 >(p0, p1) (p0, p2) (p0, p3)
 >(p1, p2) (p1, p3)
 >(p2, p3)

 === Naive Algorithm to compute the convex hull in \( \color{red}{\mathcal{O}(nh)} \) where \( \color{red}{n} \) is the number of points on the plane, \( \color{red}{h} \) is the number of points on the convex hull

 If all the points are around the convex hull, then the runtime will be \( \color{red}{\mathcal{O}(n^2)} \)

 @
 convexHull n pts
 n is the total of vertices
 pts contains all the vertexes

 p0 = Vertex3 0 0 0
 p1 = Vertex3 1 0 0
 p2 = Vertex3 0 1 0
 p3 = Vertex3 0.1 0.1 0
 pts= [p0, p1, p2, p3]
 n  = 4 = len pts
 pts = [p0, p1, p2, p3]
 exp= [[p2, p1],
       [p1, p0],
       [p0, p2]]
 @

 * __Algorithm__
 <http://localhost/html/indexConvexHullAlgorithm.html#convexhull ConvexHull>
 * Find a __top__ vertex: B(Vertex3 x y z) with maximum y-Axis value (TODO: What if there are more than one pts on the top?)
 * Construct a new vertex: A(Vertex3 x+1 y z) from __top__(Vertex3 x y z)
 * Compute \( \cos ∠ABC \) from three points: \(A, B, C\)
 * If there are only two points in pts for the list of Vertex3 e.g. p0 p1
 * then segments: \(\overline{AB} \) and \(\overline{BC} \) are drawn
 <http://localhost/html/indexConvexHullAlgorithm.html#three_pts_angle Three_pts_angle>

 n = length pts \(\Rightarrow\) n vertices \(\Rightarrow\) n edges. if there is two vertices, then \((p_0, p_1)\) and \((p_1, p_0)\)

 vec(top x1) and vec(top x2)

 \(\vec{v_1}\) = top -> x1 = x1 -: top

 \(\vec{v_2}\) = top -> x2 = x2 -: top

 * TODO: Handle the case where the three points are colinear.

 * TODO: If there are more than one point that have maximum y-axis, then choose the left most point
 <http://localhost/html/indexConvexHullAlgorithm.html#top_point Top_Point>

 \( \color{red}{TODO} \): use eliminate points technic to improve the algorithm
 <http://localhost/html/indexConvexHullAlgorithm.html#eliminate_points Eliminate_Points>

 It seems that the algorithm is still \( \color{red}{ \mathcal{O}(nh)} \)
 Given n vertices on a plane. There are \(h\) points on the convex hull.
 Assume \( \frac{1}{h} n \) vertices may be eliminated when the next point is found on the convex hull.
 The total number of steps are:
 \[
 \begin{aligned}
    s &= n + \frac{h-1}{h} n + \frac{h-2}{h} n + \dots + \frac{1}{h} n \\
    s &= n h (1 + 2 + 3 + \dots + h) \\
    s &= n h \frac{(1 + h)h}{2} \\
    s &= n \frac{1+ h}{2} \\
      &= \mathcal{O}(nh) \\
 \end{aligned}
 \]



 When the algo walks around the convex hull in counter clokcwise order.

 segment can be drawn from top point to previous point

 All the points can be removed if they are on the left side of the segment

 \( \color{red}{TODO} \) use other algo: check whether a point is on the left or right side of a segment

 The algo can be check with the determinant of two vectors 'threePtDeterminant'
 <http://localhost/html/indexConvexHullAlgorithm.html#rotate_dir Three_Points_Direction>

  Monday, 26 February 2024 16:51 PST
  NOTE: DO NOT USE IT, deprecated
  NOTE: Delete it, there is bug
  USE: 'convexHull4X'
-}
convexHull::Int-> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
convexHull :: Int -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
convexHull Int
n [Vertex3 GLfloat]
pts = ((Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat])
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map(\(Vertex3 GLfloat
a, Vertex3 GLfloat
b) -> [Vertex3 GLfloat
a, Vertex3 GLfloat
b]) ([(Vertex3 GLfloat, Vertex3 GLfloat)] -> [[Vertex3 GLfloat]])
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ Int -> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull2 Int
n [Vertex3 GLfloat]
pts

{-| 
    === Same as 'convexHull', except that it return [(Vertex3 GLfloat, Vertex3 GLfloat)]

    Monday, 26 February 2024 16:51 PST
    NOTE: DO NOT USE, deprecated
    NOTE: There is bug on it, Delete it
    Use 'convexHull4X'
-} 
convexHull2::Int-> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull2 :: Int -> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull2 Int
n [Vertex3 GLfloat]
pts = Int
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall t a.
(Ord t, Num t, Ord a, Floating a) =>
t
-> Vertex3 a
-> Vertex3 a
-> [Vertex3 a]
-> [(Vertex3 a, Vertex3 a)]
convexHull' Int
n Vertex3 GLfloat
topx Vertex3 GLfloat
top [Vertex3 GLfloat]
pts
    where
        -- Find the vertex that has maximum y value.
        ptsSort :: [Vertex3 GLfloat]
ptsSort = (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Ord a => Vertex3 a -> Vertex3 a -> Bool
cmp [Vertex3 GLfloat]
pts where cmp :: Vertex3 a -> Vertex3 a -> Bool
cmp (Vertex3 a
x1 a
y1 a
z1) (Vertex3 a
x2 a
y2 a
z2) = a
y1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y2

        -- Find the largest angle
        -- Angle: p0_p1_p2, vec: (p1, p2) and vec: (p1, p0)
        vexSort :: [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
vexSort = ((GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
 -> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> Bool)
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. (a -> a -> Bool) -> [a] -> [a]
mergeSortC (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> Bool
forall a b c b c. Ord a => (a, b, c) -> (a, b, c) -> Bool
cmp ([(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
 -> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat))
-> [Vertex3 GLfloat]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map(\Vertex3 GLfloat
p2 -> (Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2, Vertex3 GLfloat
p1, Vertex3 GLfloat
p2)) [Vertex3 GLfloat]
cx  -- p1 to all the rest of pts
                        where
                            p1 :: Vertex3 GLfloat
p1 = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head [Vertex3 GLfloat]
ptsSort
                            p0 :: Vertex3 GLfloat
p0 = Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a
addx1 Vertex3 GLfloat
p1 where addx1 :: Vertex3 a -> Vertex3 a
addx1 (Vertex3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
1) a
y a
z
                            cx :: [Vertex3 GLfloat]
cx = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
tail [Vertex3 GLfloat]
ptsSort
                            cmp :: (a, b, c) -> (a, b, c) -> Bool
cmp (a, b, c)
c1 (a, b, c)
c2  = (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c2

        top :: Vertex3 GLfloat
top = (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b c. (a, b, c) -> b
t2 ((GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat)
-> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
forall a. [a] -> a
head' [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
vexSort
        topx :: Vertex3 GLfloat
topx = Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a
addx1 Vertex3 GLfloat
top where addx1 :: Vertex3 a -> Vertex3 a
addx1 (Vertex3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
y a
z
        {--
                      (x,y)    (x+1,y)
                       top - - topx
                      /
                     p0


                     topx
                     /
                    top
                     \
                      p1
        --}
        convexHull' :: t
-> Vertex3 a
-> Vertex3 a
-> [Vertex3 a]
-> [(Vertex3 a, Vertex3 a)]
convexHull' t
n Vertex3 a
topx Vertex3 a
top [Vertex3 a]
ls = if (t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0) Bool -> Bool -> Bool
&& Vertex3 a
top Vertex3 a -> Vertex3 a -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 a
p0 then (t
-> Vertex3 a
-> Vertex3 a
-> [Vertex3 a]
-> [(Vertex3 a, Vertex3 a)]
convexHull' (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Vertex3 a
top Vertex3 a
p0 [Vertex3 a]
cx) [(Vertex3 a, Vertex3 a)]
-> [(Vertex3 a, Vertex3 a)] -> [(Vertex3 a, Vertex3 a)]
forall a. [a] -> [a] -> [a]
++ [(Vertex3 a
p0, Vertex3 a
top)] else [(Vertex3 a
p0, Vertex3 a
top)]
                            where
                                -- Use merge sort here for y andthen x
                                -- Choose the left most vertex
                                -- Find the biggest dot product of vec(top p1) vec(top p2) => the smallest angle
                                cx :: [Vertex3 a]
cx = (Vertex3 a -> Bool) -> [Vertex3 a] -> [Vertex3 a]
forall a. (a -> Bool) -> [a] -> [a]
filter(\Vertex3 a
x -> Vertex3 a
x Vertex3 a -> Vertex3 a -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 a
top) [Vertex3 a]
ls -- remove top pt
                                cmp :: (a, b, c) -> (a, b, c) -> Bool
cmp (a, b, c)
c1 (a, b, c)
c2  = (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c2 -- the largest angle for the smallest cos(angle)
                                sortAngle :: [(a, Vertex3 a, Vertex3 a)]
sortAngle = ((a, Vertex3 a, Vertex3 a) -> (a, Vertex3 a, Vertex3 a) -> Bool)
-> [(a, Vertex3 a, Vertex3 a)] -> [(a, Vertex3 a, Vertex3 a)]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (a, Vertex3 a, Vertex3 a) -> (a, Vertex3 a, Vertex3 a) -> Bool
forall a b c b c. Ord a => (a, b, c) -> (a, b, c) -> Bool
cmp ([(a, Vertex3 a, Vertex3 a)] -> [(a, Vertex3 a, Vertex3 a)])
-> [(a, Vertex3 a, Vertex3 a)] -> [(a, Vertex3 a, Vertex3 a)]
forall a b. (a -> b) -> a -> b
$ (Vertex3 a -> (a, Vertex3 a, Vertex3 a))
-> [Vertex3 a] -> [(a, Vertex3 a, Vertex3 a)]
forall a b. (a -> b) -> [a] -> [b]
map(\Vertex3 a
p -> (Vertex3 a -> Vertex3 a -> Vertex3 a -> a
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 a
p Vertex3 a
top Vertex3 a
topx, Vertex3 a
top, Vertex3 a
p)) ([Vertex3 a] -> [(a, Vertex3 a, Vertex3 a)])
-> [Vertex3 a] -> [(a, Vertex3 a, Vertex3 a)]
forall a b. (a -> b) -> a -> b
$ [Vertex3 a]
cx
                                p0 :: Vertex3 a
p0 = (a, Vertex3 a, Vertex3 a) -> Vertex3 a
forall a b c. (a, b, c) -> c
t3 ((a, Vertex3 a, Vertex3 a) -> Vertex3 a)
-> (a, Vertex3 a, Vertex3 a) -> Vertex3 a
forall a b. (a -> b) -> a -> b
$ [(a, Vertex3 a, Vertex3 a)] -> (a, Vertex3 a, Vertex3 a)
forall a. [a] -> a
head [(a, Vertex3 a, Vertex3 a)]
sortAngle


{-| 
    === Connect all pts inside convex hull without crossing intersection

    <http://localhost/html/indexConvexHullAlgorithm.html#convexhull_all_segments All_Segments_ConvexHull>

    @
    let vexList = [Vertex3 0.1 0.1 0.1, Vertex3 0.4 0.3 0.6, Vertex3 0.6 0.8 0.2]
    mapM_(\vx -> do 
                drawSegment green vx 
                threadDelay 500
                ) $ convexHullAllSeg vexList



    Wednesday, 29 June 2022 02:22 PDT
    BUG:

        cx = [
                Vertex3 0.1   0.1  0
               ,Vertex3 0.2   0.6  0
               ,Vertex3 0.88  0.9  0
               ,Vertex3 0.25  0.34 0
               ,Vertex3 0.12  0.8  0
               ,Vertex3 1.3   0.12 0
              ]

        let lsx = convexHullAllSeg cx

        OUTPUT: lsx
       (Vertex3 0.1 0.1 0.0,Vertex3 0.2 0.6 0.0)
       (Vertex3 0.1 0.1 0.0,Vertex3 0.25 0.34 0.0)
       (Vertex3 0.12 0.8 0.0,Vertex3 0.1 0.1 0.0)
       (Vertex3 0.12 0.8 0.0,Vertex3 0.2 0.6 0.0)
       (Vertex3 0.12 0.8 0.0,Vertex3 0.88 0.9 0.0)
       (Vertex3 0.12 0.8 0.0,Vertex3 1.3 0.12 0.0)

       (Vertex3 0.12 0.8 0.0,Vertex3 1.3 0.12 0.0)
       (Vertex3 0.12 0.8 0.0,Vertex3 1.3 0.12 0.0)

       (Vertex3 0.2 0.6 0.0,Vertex3 0.25 0.34 0.0)

       (Vertex3 0.88 0.9 0.0,Vertex3 0.88 0.9 0.0)  <- Same Vertex

       (Vertex3 1.3 0.12 0.0,Vertex3 0.1 0.1 0.0)
       (Vertex3 1.3 0.12 0.0,Vertex3 0.12 0.8 0.0)
       (Vertex3 1.3 0.12 0.0,Vertex3 0.12 0.8 0.0)
       (Vertex3 1.3 0.12 0.0,Vertex3 0.12 0.8 0.0)
       (Vertex3 1.3 0.12 0.0,Vertex3 0.2 0.6 0.0)
       (Vertex3 1.3 0.12 0.0,Vertex3 0.25 0.34 0.0)

       (Vertex3 1.3 0.12 0.0,Vertex3 0.88 0.9 0.0)  <- Duplicated segments
       (Vertex3 1.3 0.12 0.0,Vertex3 0.88 0.9 0.0)  <- 
    @

    'convexHull3'
-} 
convexHullAllSeg::[Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullAllSeg :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullAllSeg [Vertex3 GLfloat]
cx = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
segList [(Vertex3 GLfloat, Vertex3 GLfloat)]
hullList [Vertex3 GLfloat]
diffList
    where
        -- Generate a list of vertexes defining a convex hull from a given set of vertexes
        -- hullList = convexHull2 le cx where le = len cx 
        hullList :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
hullList = [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull3 [Vertex3 GLfloat]
cx
        -- All the pts are NOT on the convex hull
        -- (Data.List.\\) [1,2,3] [1,2] => [3]
        diffList :: [Vertex3 GLfloat]
diffList = [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. Eq a => [a] -> [a] -> [a]
(L.\\) [Vertex3 GLfloat]
cx ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst [(Vertex3 GLfloat, Vertex3 GLfloat)]
hullList 

        -- Connect all pts inside convexhull to all the pts on the boundary of convexhull, no intersection
        -- URL: http://localhost/image/allsegment.svg
        segList::[(Vertex3 GLfloat, Vertex3 GLfloat)] -> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
        segList :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
segList [(Vertex3 GLfloat, Vertex3 GLfloat)]
sl []     = [(Vertex3 GLfloat, Vertex3 GLfloat)]
sl
        segList [(Vertex3 GLfloat, Vertex3 GLfloat)]
sl (Vertex3 GLfloat
p:[Vertex3 GLfloat]
cx) = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
segList (([(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Vertex3 GLfloat -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
nonCrossSegmentNoEndPt [(Vertex3 GLfloat, Vertex3 GLfloat)]
sl Vertex3 GLfloat
p) [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. [a] -> [a] -> [a]
++ [(Vertex3 GLfloat, Vertex3 GLfloat)]
sl) [Vertex3 GLfloat]
cx

{-|
   Given a Triangle mesh with all segments and a vertex, return a list of triangles
-}
vertexWithAllTri :: [(Vertex3 GLfloat, Vertex3 GLfloat)] -> Vertex3 GLfloat -> [[Vertex3 GLfloat]]
vertexWithAllTri :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Vertex3 GLfloat -> [[Vertex3 GLfloat]]
vertexWithAllTri [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx Vertex3 GLfloat
vx = ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Vertex3 GLfloat]
seg -> Vertex3 GLfloat
vxVertex3 GLfloat -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. a -> [a] -> [a]
:[Vertex3 GLfloat]
seg) [[Vertex3 GLfloat]]
segInTriangle
  where
    allChildren :: [Vertex3 GLfloat]
allChildren = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. Ord a => [a] -> [a]
unique ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
cmpVex ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (Maybe (Vertex3 GLfloat) -> Vertex3 GLfloat)
-> [Maybe (Vertex3 GLfloat)] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Vertex3 GLfloat) -> Vertex3 GLfloat
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe (Vertex3 GLfloat)] -> [Vertex3 GLfloat])
-> [Maybe (Vertex3 GLfloat)] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (Maybe (Vertex3 GLfloat) -> Bool)
-> [Maybe (Vertex3 GLfloat)] -> [Maybe (Vertex3 GLfloat)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat) -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([Maybe (Vertex3 GLfloat)] -> [Maybe (Vertex3 GLfloat)])
-> [Maybe (Vertex3 GLfloat)] -> [Maybe (Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ ([Vertex3 GLfloat] -> Maybe (Vertex3 GLfloat))
-> [[Vertex3 GLfloat]] -> [Maybe (Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map(\[Vertex3 GLfloat]
seg -> Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
forall a. Eq a => a -> [a] -> Bool
vexOnSeg Vertex3 GLfloat
vx [Vertex3 GLfloat]
seg Bool
-> Maybe (Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat)
forall a. Bool -> a -> a -> a
? Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
forall a. a -> Maybe a
Just (Vertex3 GLfloat -> [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. Eq a => a -> [a] -> a
otherEnd Vertex3 GLfloat
vx [Vertex3 GLfloat]
seg) (Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat))
-> Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
forall a b. (a -> b) -> a -> b
$ Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing ) [[Vertex3 GLfloat]]
sortSeg
    vexOnSeg :: a -> [a] -> Bool
vexOnSeg a
v [a
x, a
y] = a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x Bool -> Bool -> Bool
|| a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
    otherEnd :: a -> [a] -> a
otherEnd a
v [a
x, a
y] = a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
? a
y (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
x
  
    cartesianPair :: [[Vertex3 GLfloat]]
cartesianPair = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
sortVex ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ Int -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
forall a. Int -> [a] -> [[a]]
combin Int
2 [Vertex3 GLfloat]
allChildren
  
    sortSeg :: [[Vertex3 GLfloat]]
sortSeg = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
sortVex ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat])
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vertex3 GLfloat
v1, Vertex3 GLfloat
v2) -> [Vertex3 GLfloat
v1, Vertex3 GLfloat
v2]) [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx
    originSeg :: Set [Vertex3 GLfloat]
originSeg = [[Vertex3 GLfloat]] -> Set [Vertex3 GLfloat]
forall a. Ord a => [a] -> Set a
S.fromList [[Vertex3 GLfloat]]
sortSeg
    validSeg :: [[Vertex3 GLfloat]]
validSeg = ([Vertex3 GLfloat] -> Bool)
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat]
x [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] ) ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat] -> Set [Vertex3 GLfloat] -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member [Vertex3 GLfloat]
x Set [Vertex3 GLfloat]
originSeg Bool -> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. Bool -> a -> a -> a
? [Vertex3 GLfloat]
x ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ []) [[Vertex3 GLfloat]]
cartesianPair
    
    segInTriangle :: [[Vertex3 GLfloat]]
segInTriangle = ([Vertex3 GLfloat] -> Bool)
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Vertex3 GLfloat]
seg -> let or :: t Bool -> Bool
or t Bool
ls = (Bool -> Bool -> Bool) -> Bool -> t Bool -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Bool
a Bool
b -> Bool
a Bool -> Bool -> Bool
|| Bool
b) Bool
False t Bool
ls
                                    in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> Bool) -> [Vertex3 GLfloat] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
pt -> (Bool, GLfloat) -> Bool
forall a b. (a, b) -> a
fst ((Bool, GLfloat) -> Bool) -> (Bool, GLfloat) -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> [Vertex3 GLfloat] -> (Bool, GLfloat)
isPtInsideTriList Vertex3 GLfloat
pt (Vertex3 GLfloat
vxVertex3 GLfloat -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. a -> [a] -> [a]
:[Vertex3 GLfloat]
seg) ) [Vertex3 GLfloat]
allChildren) [[Vertex3 GLfloat]]
validSeg

{-|
   === KEY: find all triangles from a set of vertexes and segments

   Assume any three pts forms a triangle without intersection.
-}
meshAllTriangle :: [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
meshAllTriangle :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
meshAllTriangle [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx [Vertex3 GLfloat]
cv = ([[Vertex3 GLfloat]] -> [Vertex3 GLfloat])
-> [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a. [a] -> a
head ([[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]])
-> [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ ([Vertex3 GLfloat] -> [Vertex3 GLfloat] -> Bool)
-> [[Vertex3 GLfloat]] -> [[[Vertex3 GLfloat]]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> Bool
forall a. Eq a => [Vertex3 a] -> [Vertex3 a] -> Bool
cmpL ([[Vertex3 GLfloat]] -> [[[Vertex3 GLfloat]]])
-> [[Vertex3 GLfloat]] -> [[[Vertex3 GLfloat]]]
forall a b. (a -> b) -> a -> b
$ ([Vertex3 GLfloat] -> [Vertex3 GLfloat] -> Bool)
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> Bool
forall a. Eq a => [Vertex3 a] -> [Vertex3 a] -> Bool
cmpL ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
sortVex ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]])
-> [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> [[Vertex3 GLfloat]])
-> [Vertex3 GLfloat] -> [[[Vertex3 GLfloat]]]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
v -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Vertex3 GLfloat -> [[Vertex3 GLfloat]]
vertexWithAllTri [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx Vertex3 GLfloat
v) [Vertex3 GLfloat]
cv
  where
    cmpL :: [Vertex3 a] -> [Vertex3 a] -> Bool
cmpL [Vertex3 a
a0, Vertex3 a
b0, Vertex3 a
c0] [Vertex3 a
a1, Vertex3 a
b1, Vertex3 a
c1] = Vertex3 a -> Vertex3 a -> Bool
forall a. Eq a => Vertex3 a -> Vertex3 a -> Bool
cmpV Vertex3 a
a0 Vertex3 a
a1 Bool -> Bool -> Bool
&& Vertex3 a -> Vertex3 a -> Bool
forall a. Eq a => Vertex3 a -> Vertex3 a -> Bool
cmpV Vertex3 a
b0 Vertex3 a
b1 Bool -> Bool -> Bool
&& Vertex3 a -> Vertex3 a -> Bool
forall a. Eq a => Vertex3 a -> Vertex3 a -> Bool
cmpV Vertex3 a
c0 Vertex3 a
c1
    cmpV :: Vertex3 a -> Vertex3 a -> Bool
cmpV (Vertex3 a
x0 a
y0 a
z0) (Vertex3 a
x1 a
y1 a
z1) = a
x0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x1 Bool -> Bool -> Bool
&& a
y0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y1 Bool -> Bool -> Bool
&& a
z0 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
z1

{-|
   === KEY: triangulation, triangulate

   * Given a set of vertexes and a list of segments
   * Triangulate the mesh and generate a set of segments.

   * Very slow version, 100 vertexes, it takes __12.647__ seconds to triangulate the mesh.

  <http://localhost/image/triangulationxx.png Triangulation>
-}
drawTriangulation :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> (GLfloat, GLfloat)-> IO()
drawTriangulation :: [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> (GLfloat, GLfloat)
-> IO ()
drawTriangulation [Vertex3 GLfloat]
vex [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg (GLfloat
sx, GLfloat
sy) = do
      let segM :: [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM = ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat)))
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vertex3 GLfloat, Vertex3 GLfloat)
s -> (Bool
True, (Vertex3 GLfloat, Vertex3 GLfloat)
s)) [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg
      let goodSeg :: [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
goodSeg = [Vertex3 GLfloat]
-> [Vertex3 GLfloat]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
triangulateSimple [Vertex3 GLfloat]
vex [Vertex3 GLfloat]
vex [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM
      
      let collectionSeg :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectionSeg = [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectSegment [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
goodSeg
      
      let validTri :: [[Vertex3 GLfloat]]
validTri = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
meshAllTriangle [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectionSeg [Vertex3 GLfloat]
vex
      ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
se -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentList        Color3 GLdouble
yellow ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
v -> (GLfloat, GLfloat) -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => (a, a) -> Vertex3 a -> Vertex3 a
shiftXY (GLfloat
sx, GLfloat
sy) Vertex3 GLfloat
v) [Vertex3 GLfloat]
se) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat])
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat]
tupTols2 [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectionSeg
      -- mapM_ (\vx -> drawCircleThreePtListX blue vx) $ map (\seg -> map (\v -> shiftXY (sx, sy) v) seg) validTri
  
{-|
   === KEY: triangulation, triangulate

   * Given a set of vertexes and a list of segments
   * Triangulate the mesh and generate a set of segments.

   * Very slow version, 100 vertexes, it takes __12.647__ seconds to triangulate the mesh.

  <http://localhost/image/triangulationxx.png Triangulation>
-}
drawTriangulationWithCircle :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> (GLfloat, GLfloat)-> IO()
drawTriangulationWithCircle :: [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> (GLfloat, GLfloat)
-> IO ()
drawTriangulationWithCircle [Vertex3 GLfloat]
vex [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg (GLfloat
sx, GLfloat
sy) = do
      let segM :: [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM = ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat)))
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vertex3 GLfloat, Vertex3 GLfloat)
s -> (Bool
True, (Vertex3 GLfloat, Vertex3 GLfloat)
s)) [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg
      let goodSeg :: [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
goodSeg = [Vertex3 GLfloat]
-> [Vertex3 GLfloat]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
triangulateSimple [Vertex3 GLfloat]
vex [Vertex3 GLfloat]
vex [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM
      
      let collectionSeg :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectionSeg = [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectSegment [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
goodSeg
      
      let validTri :: [[Vertex3 GLfloat]]
validTri = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
meshAllTriangle [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectionSeg [Vertex3 GLfloat]
vex
      ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
se -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentList        Color3 GLdouble
yellow ([Vertex3 GLfloat] -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
v -> (GLfloat, GLfloat) -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => (a, a) -> Vertex3 a -> Vertex3 a
shiftXY (GLfloat
sx, GLfloat
sy) Vertex3 GLfloat
v) [Vertex3 GLfloat]
se) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat])
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat]
tupTols2 [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectionSeg
      ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
vx -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawCircleThreePtListX Color3 GLdouble
blue [Vertex3 GLfloat]
vx) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Vertex3 GLfloat]
seg -> (Vertex3 GLfloat -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
v -> (GLfloat, GLfloat) -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => (a, a) -> Vertex3 a -> Vertex3 a
shiftXY (GLfloat
sx, GLfloat
sy) Vertex3 GLfloat
v) [Vertex3 GLfloat]
seg) [[Vertex3 GLfloat]]
validTri
    

collectSegment :: [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectSegment :: [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectSegment [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM = if [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
group Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 then (Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
 -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
 -> [(Vertex3 GLfloat, Vertex3 GLfloat)])
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ (Maybe (Vertex3 GLfloat, Vertex3 GLfloat) -> Bool)
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. Maybe a
Nothing) ([Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
 -> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)])
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> Maybe (Vertex3 GLfloat, Vertex3 GLfloat))
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vertex3 GLfloat, Vertex3 GLfloat)
v -> (Vertex3 GLfloat, Vertex3 GLfloat)
-> Set (Vertex3 GLfloat, Vertex3 GLfloat) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (Vertex3 GLfloat, Vertex3 GLfloat)
v Set (Vertex3 GLfloat, Vertex3 GLfloat)
set Bool
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. Bool -> a -> a -> a
? Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. Maybe a
Nothing (Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
 -> Maybe (Vertex3 GLfloat, Vertex3 GLfloat))
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, Vertex3 GLfloat)
-> Maybe (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. a -> Maybe a
Just (Vertex3 GLfloat, Vertex3 GLfloat)
v) [(Vertex3 GLfloat, Vertex3 GLfloat)]
good
                                        else [(Vertex3 GLfloat, Vertex3 GLfloat)]
good
  where
    group :: [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
group = ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat)) -> Bool)
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\(Bool
a, (Vertex3 GLfloat, Vertex3 GLfloat)
b) (Bool
a', (Vertex3 GLfloat, Vertex3 GLfloat)
b') -> Bool
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
a') ([(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]])
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
forall a b. (a -> b) -> a -> b
$ ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat)) -> Bool)
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (\(Bool
a, (Vertex3 GLfloat, Vertex3 GLfloat)
b) (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
_ -> Bool
a) [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM
    
    bad :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
bad   = ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map ((Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
sortSeg ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
    -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b. (a, b) -> b
snd) ([(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [(Vertex3 GLfloat, Vertex3 GLfloat)])
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. [a] -> a
last [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
group
    good :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
good  = ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map ((Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
sortSeg ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
    -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b. (a, b) -> b
snd) ([(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [(Vertex3 GLfloat, Vertex3 GLfloat)])
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. [a] -> a
head [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
group
    set :: Set (Vertex3 GLfloat, Vertex3 GLfloat)
set = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. Ord a => [a] -> Set a
S.fromList [(Vertex3 GLfloat, Vertex3 GLfloat)]
bad
  
    sortSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
sortSeg (Vertex3 GLfloat, Vertex3 GLfloat)
s = [Vertex3 GLfloat] -> (Vertex3 GLfloat, Vertex3 GLfloat)
lsToTup2 ([Vertex3 GLfloat] -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> [Vertex3 GLfloat] -> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortVexL ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat]
tupTols2 (Vertex3 GLfloat, Vertex3 GLfloat)
s


triangulateSimple :: [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))] -> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
triangulateSimple :: [Vertex3 GLfloat]
-> [Vertex3 GLfloat]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
triangulateSimple [Vertex3 GLfloat]
vex [] [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM = [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM
triangulateSimple [Vertex3 GLfloat]
vex (Vertex3 GLfloat
v:[Vertex3 GLfloat]
vx) [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM = case Maybe
  ((Vertex3 GLfloat, Vertex3 GLfloat),
   (Vertex3 GLfloat, Vertex3 GLfloat),
   [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
mayTup of
                                         Just ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
tup -> let rmSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
rmSeg = ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b c. (a, b, c) -> a
t1 ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
tup
                                                         addSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
addSeg = ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b c. (a, b, c) -> b
t2 ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
tup
                                                     in [(Bool
False, (Vertex3 GLfloat, Vertex3 GLfloat)
rmSeg),(Bool
True, (Vertex3 GLfloat, Vertex3 GLfloat)
addSeg)] [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. [a] -> [a] -> [a]
++ [Vertex3 GLfloat]
-> [Vertex3 GLfloat]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
triangulateSimple [Vertex3 GLfloat]
vex [Vertex3 GLfloat]
vex ( [(Bool
False, (Vertex3 GLfloat, Vertex3 GLfloat)
rmSeg),(Bool
True, (Vertex3 GLfloat, Vertex3 GLfloat)
addSeg)] [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. [a] -> [a] -> [a]
++ [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM)
                                         Maybe
  ((Vertex3 GLfloat, Vertex3 GLfloat),
   (Vertex3 GLfloat, Vertex3 GLfloat),
   [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
Nothing -> [Vertex3 GLfloat]
-> [Vertex3 GLfloat]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
triangulateSimple [Vertex3 GLfloat]
vex [Vertex3 GLfloat]
vx [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM
  where
    seg :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg = [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
collectSegment [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
segM
    trix :: [[Vertex3 GLfloat]]
trix = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
meshAllTriangle [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg [Vertex3 GLfloat]
vex
      -- let tup = flipEdge c (map lsToTup3 trix) seg
    mayTup :: Maybe
  ((Vertex3 GLfloat, Vertex3 GLfloat),
   (Vertex3 GLfloat, Vertex3 GLfloat),
   [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
mayTup = Vertex3 GLfloat
-> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
flipEdge Vertex3 GLfloat
v (([Vertex3 GLfloat]
 -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat))
-> [[Vertex3 GLfloat]]
-> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map [Vertex3 GLfloat]
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
lsToTup3 [[Vertex3 GLfloat]]
trix) [(Vertex3 GLfloat, Vertex3 GLfloat)]
seg
  
  
lsToTup2 :: [Vertex3 GLfloat] -> (Vertex3 GLfloat, Vertex3 GLfloat)
lsToTup2 :: [Vertex3 GLfloat] -> (Vertex3 GLfloat, Vertex3 GLfloat)
lsToTup2 [Vertex3 GLfloat]
cx = if [Vertex3 GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
cx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
2 then let v1 :: Vertex3 GLfloat
v1 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
0
                                      v2 :: Vertex3 GLfloat
v2 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
1
                             in (Vertex3 GLfloat
v1, Vertex3 GLfloat
v2)
                             else [Char] -> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: List of two only"

lsToTup3 :: [Vertex3 GLfloat] -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
lsToTup3 :: [Vertex3 GLfloat]
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
lsToTup3 [Vertex3 GLfloat]
cx = if [Vertex3 GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
cx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
3 then let v1 :: Vertex3 GLfloat
v1 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
0
                                      v2 :: Vertex3 GLfloat
v2 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
1
                                      v3 :: Vertex3 GLfloat
v3 = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> Int -> Vertex3 GLfloat
forall a. [a] -> Int -> a
!! Int
2
                             in (Vertex3 GLfloat
v1, Vertex3 GLfloat
v2, Vertex3 GLfloat
v3)
                             else [Char] -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: List of three only"
tupTols3 :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat]
tupTols3 :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> [Vertex3 GLfloat]
tupTols3 (Vertex3 GLfloat
x, Vertex3 GLfloat
y, Vertex3 GLfloat
z) = [Vertex3 GLfloat
x, Vertex3 GLfloat
y, Vertex3 GLfloat
z]
  
tupTols2 :: (Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat]
tupTols2 :: (Vertex3 GLfloat, Vertex3 GLfloat) -> [Vertex3 GLfloat]
tupTols2 (Vertex3 GLfloat
a, Vertex3 GLfloat
b) = [Vertex3 GLfloat
a, Vertex3 GLfloat
b]

{-|
   === KEY:

   1. Given a vertex and a list of triangles.
   2. If the vertex is inside the inscribe circle in the triangle.
   3. Remove a segment and add a segment, add two triangles
-}
flipEdge :: Vertex3 GLfloat -> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)] -> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> Maybe ((Vertex3 GLfloat, Vertex3 GLfloat), (Vertex3 GLfloat, Vertex3 GLfloat), [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
flipEdge :: Vertex3 GLfloat
-> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
flipEdge Vertex3 GLfloat
v [] [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx = Maybe
  ((Vertex3 GLfloat, Vertex3 GLfloat),
   (Vertex3 GLfloat, Vertex3 GLfloat),
   [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
forall a. Maybe a
Nothing
flipEdge Vertex3 GLfloat
v (triangle :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
triangle@(Vertex3 GLfloat
x, Vertex3 GLfloat
y, Vertex3 GLfloat
z):[(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
tri) [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx = if
                                          | Vertex3 GLfloat
x Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
v Bool -> Bool -> Bool
|| Vertex3 GLfloat
y Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
v Bool -> Bool -> Bool
|| Vertex3 GLfloat
z Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
v -> Vertex3 GLfloat
-> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
flipEdge Vertex3 GLfloat
v [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
tri [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx
                                          | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
isInside -> Vertex3 GLfloat
-> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
flipEdge Vertex3 GLfloat
v [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
tri [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx
                                          | (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
interSeg (Vertex3 GLfloat
x, Vertex3 GLfloat
v) (Vertex3 GLfloat
y, Vertex3 GLfloat
z) Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Integer
lnx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 -> ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
forall a. a -> Maybe a
Just ((Vertex3 GLfloat
y, Vertex3 GLfloat
z), (Vertex3 GLfloat
x, Vertex3 GLfloat
v), [(Vertex3 GLfloat
v, Vertex3 GLfloat
x, Vertex3 GLfloat
z),(Vertex3 GLfloat
v, Vertex3 GLfloat
x, Vertex3 GLfloat
y)])
                                          | (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
interSeg (Vertex3 GLfloat
y, Vertex3 GLfloat
v) (Vertex3 GLfloat
x, Vertex3 GLfloat
z) Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Integer
lny Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 -> ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
forall a. a -> Maybe a
Just ((Vertex3 GLfloat
x, Vertex3 GLfloat
z), (Vertex3 GLfloat
y, Vertex3 GLfloat
v), [(Vertex3 GLfloat
v, Vertex3 GLfloat
y, Vertex3 GLfloat
z),(Vertex3 GLfloat
v, Vertex3 GLfloat
x, Vertex3 GLfloat
y)])
                                          | (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
interSeg (Vertex3 GLfloat
z, Vertex3 GLfloat
v) (Vertex3 GLfloat
x, Vertex3 GLfloat
y) Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& Integer
lnz Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1 -> ((Vertex3 GLfloat, Vertex3 GLfloat),
 (Vertex3 GLfloat, Vertex3 GLfloat),
 [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
forall a. a -> Maybe a
Just ((Vertex3 GLfloat
x, Vertex3 GLfloat
y), (Vertex3 GLfloat
z, Vertex3 GLfloat
v), [(Vertex3 GLfloat
v, Vertex3 GLfloat
y, Vertex3 GLfloat
z),(Vertex3 GLfloat
v, Vertex3 GLfloat
x, Vertex3 GLfloat
z)])
                                          | Bool
otherwise   -> Vertex3 GLfloat
-> [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Maybe
     ((Vertex3 GLfloat, Vertex3 GLfloat),
      (Vertex3 GLfloat, Vertex3 GLfloat),
      [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
flipEdge Vertex3 GLfloat
v [(Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
tri [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx
          where
            lnx :: Integer
lnx = [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> Integer)
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> Integer
forall a b. (a -> b) -> a -> b
$ (Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> Bool)
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
forall a. Maybe a
Nothing) ([Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))])
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
intersectSegNoEndPtList (Vertex3 GLfloat
x, Vertex3 GLfloat
v) [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx
            lny :: Integer
lny = [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> Integer)
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> Integer
forall a b. (a -> b) -> a -> b
$ (Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> Bool)
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
forall a. Maybe a
Nothing) ([Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))])
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
intersectSegNoEndPtList (Vertex3 GLfloat
y, Vertex3 GLfloat
v) [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx
            lnz :: Integer
lnz = [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> Integer)
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> Integer
forall a b. (a -> b) -> a -> b
$ (Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> Bool)
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
forall a. Maybe a
Nothing) ([Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))])
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
intersectSegNoEndPtList (Vertex3 GLfloat
z, Vertex3 GLfloat
v) [(Vertex3 GLfloat, Vertex3 GLfloat)]
ccx
            interSeg :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
interSeg = (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt2
            isInside :: Bool
isInside = (Bool, GLfloat) -> Bool
forall a b. (a, b) -> a
fst ((Bool, GLfloat) -> Bool) -> (Bool, GLfloat) -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
isPtInsideInscribeCircle Vertex3 GLfloat
v (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
triangle
  
isPtOnInscribeCircle :: Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> (Bool, GLfloat)
isPtOnInscribeCircle :: Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
isPtOnInscribeCircle Vertex3 GLfloat
v (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) = case Maybe (Vertex3 GLfloat)
mcen of
                                       Just Vertex3 GLfloat
cen -> let k :: GLfloat
k = Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
distX Vertex3 GLfloat
cen Vertex3 GLfloat
v GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> a
distX Vertex3 GLfloat
cen Vertex3 GLfloat
a in (GLfloat -> GLfloat
forall a. Num a => a -> a
abs(GLfloat
k) GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
1e-5, GLfloat
k)
                                       Maybe (Vertex3 GLfloat)
Nothing -> [Char] -> (Bool, GLfloat)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (Bool, GLfloat)) -> [Char] -> (Bool, GLfloat)
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: Can not form a cirlce with three pts=>" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> [Char]
forall a. Show a => a -> [Char]
show (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c)
  where
   mcen :: Maybe (Vertex3 GLfloat)
mcen = Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> Maybe (Vertex3 GLfloat)
threePtCircle Vertex3 GLfloat
a Vertex3 GLfloat
b Vertex3 GLfloat
c
  
isPtInsideInscribeCircle :: Vertex3 GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> (Bool, GLfloat)
isPtInsideInscribeCircle :: Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
isPtInsideInscribeCircle Vertex3 GLfloat
v (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) = if Bool -> Bool
not Bool
bo Bool -> Bool -> Bool
&& GLfloat
k GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
0 then (Bool
True, GLfloat
k) else (Bool
False, GLfloat
k)
  where
   tup :: (Bool, GLfloat)
tup = Vertex3 GLfloat
-> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> (Bool, GLfloat)
isPtOnInscribeCircle Vertex3 GLfloat
v (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c)
   bo :: Bool
bo = (Bool, GLfloat) -> Bool
forall a b. (a, b) -> a
fst (Bool, GLfloat)
tup
   k :: GLfloat
k  = (Bool, GLfloat) -> GLfloat
forall a b. (a, b) -> b
snd (Bool, GLfloat)
tup
  
intersectSegNoEndPt3::[Vertex3 GLfloat] ->[Vertex3 GLfloat] ->Maybe (Vertex3 GLfloat)
intersectSegNoEndPt3 :: [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt3 [Vertex3 GLfloat
p0, Vertex3 GLfloat
p1] [Vertex3 GLfloat
q0, Vertex3 GLfloat
q1] = (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt2 (Vertex3 GLfloat
p0, Vertex3 GLfloat
p1) (Vertex3 GLfloat
q0, Vertex3 GLfloat
q1)

cmpVex::Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
cmpVex :: Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
cmpVex (Vertex3 GLfloat
x0 GLfloat
y0 GLfloat
z0) (Vertex3 GLfloat
x1 GLfloat
y1 GLfloat
z1) = GLfloat
x0 GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= GLfloat
x1 Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? GLfloat
x0 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
x1 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (GLfloat
y0 GLfloat -> GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= GLfloat
y1 Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? GLfloat
y0 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
y1 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (GLfloat
z0 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
< GLfloat
z1))


sortVex::[[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
sortVex :: [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
sortVex [[Vertex3 GLfloat]]
cx = ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (\[Vertex3 GLfloat]
lv -> (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (\Vertex3 GLfloat
a Vertex3 GLfloat
b -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
cmpVex Vertex3 GLfloat
a Vertex3 GLfloat
b) [Vertex3 GLfloat]
lv) [[Vertex3 GLfloat]]
cx

sortVexL :: [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortVexL :: [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortVexL [Vertex3 GLfloat]
cx = (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (\Vertex3 GLfloat
a Vertex3 GLfloat
b -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
cmpVex Vertex3 GLfloat
a Vertex3 GLfloat
b) [Vertex3 GLfloat]
cx  
  
{-|
  Given a segment, a list of segments
  if a intersection is found, then return the vertex of intersection and the segment
-}
intersectSegNoEndPtList ::(Vertex3 GLfloat, Vertex3 GLfloat) -> [(Vertex3 GLfloat, Vertex3 GLfloat)]-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
intersectSegNoEndPtList :: (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
intersectSegNoEndPtList (Vertex3 GLfloat
v1, Vertex3 GLfloat
v2) [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx = ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat)))
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Vertex3 GLfloat, Vertex3 GLfloat)
seg -> case (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt2 (Vertex3 GLfloat
v1, Vertex3 GLfloat
v2) (Vertex3 GLfloat, Vertex3 GLfloat)
seg of
                                                        Just Vertex3 GLfloat
v -> (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
-> Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
forall a. a -> Maybe a
Just (Vertex3 GLfloat
v, (Vertex3 GLfloat, Vertex3 GLfloat)
seg)
                                                        Maybe (Vertex3 GLfloat)
Nothing -> Maybe (Vertex3 GLfloat, (Vertex3 GLfloat, Vertex3 GLfloat))
forall a. Maybe a
Nothing
                                          ) [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx

  

{-|
  === KEY: convexhull, convex hull

  * Monday, 26 February 2024 16:55 PST

  * TODO: How to handle the boundary pts are colinear, DONE
  
  <http://localhost/image/convexhullgood.png covexhull_best>

  * NOTE: Does not allow duplicated vertex, vertices, vertexes

  * NOTE: Use 'convexHull4X'
-}
convexHull3 :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull3 :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull3 [Vertex3 GLfloat]
cx = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullX Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' [Vertex3 GLfloat]
rest
  where
    -- TODO: Why x < x' does not work
    -- cmpPt v@(Vertex3 x y z) v'@(Vertex3 x' y' z') = y /= y' ? y > y' $ (x /= x' ? x < x' $ (error $ "ERROR: cmpPt, same pts = " ++ show v ++ " " ++ show v'))
    cmpPt :: Vertex3 a -> Vertex3 a -> Bool
cmpPt v :: Vertex3 a
v@(Vertex3 a
x a
y a
z) v' :: Vertex3 a
v'@(Vertex3 a
x' a
y' a
z') = a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y' Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y' (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x' Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x' (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: cmpPt, same pts = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex3 a -> [Char]
forall a. Show a => a -> [Char]
show Vertex3 a
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex3 a -> [Char]
forall a. Show a => a -> [Char]
show Vertex3 a
v'))
    sortY :: [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortY = (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. (Ord a, Show a) => Vertex3 a -> Vertex3 a -> Bool
cmpPt
  
    top :: Vertex3 GLfloat
top = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head ([Vertex3 GLfloat] -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortY [Vertex3 GLfloat]
cx
    topx :: Vertex3 GLfloat
topx = Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Floating a => Vertex3 a -> a -> Vertex3 a
shiftX Vertex3 GLfloat
top GLfloat
10.0
  
    rest :: [Vertex3 GLfloat]
rest = (Vertex3 GLfloat -> Bool) -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
top) [Vertex3 GLfloat]
cx
    top' :: Vertex3 GLfloat
top' = Vertex3 GLfloat
top
    convexHullX :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
    convexHullX :: Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullX Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' [] =  [(Vertex3 GLfloat
top, Vertex3 GLfloat
top')]
    convexHullX Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' [Vertex3 GLfloat]
rest =  if Vertex3 GLfloat
pi Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
top' then [(Vertex3 GLfloat
pi, Vertex3 GLfloat
top)] else (Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullX Vertex3 GLfloat
pi Vertex3 GLfloat
top Vertex3 GLfloat
top' [Vertex3 GLfloat]
rest') [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. [a] -> [a] -> [a]
++ [(Vertex3 GLfloat
pi, Vertex3 GLfloat
top)]
            where
              --                                largest angle                    smallest dist
              cmp :: (a, b, c) -> (a, b, c) -> Bool
cmp (a, b, c)
c1 (a, b, c)
c2 = ((a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c2) Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? ((a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c2) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= (a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c2 Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? (a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c1 b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< (a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c2 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: cmp, same pts = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (a, b, c) -> [Char]
forall a. Show a => a -> [Char]
show (a, b, c)
c1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (a, b, c) -> [Char]
forall a. Show a => a -> [Char]
show (a, b, c)
c2))
              -- cmp c1 c2 = (t1 c1 > t1 c2)
              sortAngle :: [(GLfloat, GLfloat, Vertex3 GLfloat)]
sortAngle = ((GLfloat, GLfloat, Vertex3 GLfloat)
 -> (GLfloat, GLfloat, Vertex3 GLfloat) -> Bool)
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (GLfloat, GLfloat, Vertex3 GLfloat)
-> (GLfloat, GLfloat, Vertex3 GLfloat) -> Bool
forall a b c c.
(Ord a, Ord b, Show a, Show b, Show c, Show c) =>
(a, b, c) -> (a, b, c) -> Bool
cmp ([(GLfloat, GLfloat, Vertex3 GLfloat)]
 -> [(GLfloat, GLfloat, Vertex3 GLfloat)])
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> (GLfloat, GLfloat, Vertex3 GLfloat))
-> [Vertex3 GLfloat] -> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
p -> (Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 GLfloat
p Vertex3 GLfloat
top Vertex3 GLfloat
topx, Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
sqdist Vertex3 GLfloat
p Vertex3 GLfloat
top, Vertex3 GLfloat
p)) ([Vertex3 GLfloat] -> [(GLfloat, GLfloat, Vertex3 GLfloat)])
-> [Vertex3 GLfloat] -> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat
top Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
top' Bool -> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. Bool -> a -> a -> a
? ([Vertex3 GLfloat]
rest [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a] -> [a]
++ [Vertex3 GLfloat
top']) ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat]
rest)
              -- sortAngle = qqsort cmp $ map (\p -> (cosVex3 p top topx, sqdist p top, p)) rest
              pi :: Vertex3 GLfloat
pi = (GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b c. (a, b, c) -> c
t3 ((GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat)
-> (GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> (GLfloat, GLfloat, Vertex3 GLfloat)
forall a. [a] -> a
head [(GLfloat, GLfloat, Vertex3 GLfloat)]
sortAngle
              rest' :: [Vertex3 GLfloat]
rest' = (Vertex3 GLfloat -> Bool) -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
pi) [Vertex3 GLfloat]
rest

{-|
  === KEY: draw convexhull or draw spiral

  DATE: Monday, 26 February 2024 16:33 PST
  
  NOTE: At least two vertex vertices vertexes

  @
  -- Draw convexHull
  let ls = [Vertex3 0 0 0, Vertex3 0.5 0 0, Vertex3 0 0.5 0, Vertex3 0.2 0.2]
  let isConvexHull = True
  let lt = convexHull4X ls isConvexHull
  mapM_ (drawSegment red) lt
  mapM_ (drawDot green) ls

  -- Draw spiral
  let isConvexHull = False
  let lt = convexHull4X ls isConvexHull
  @

 -}
convexHull4X :: [Vertex3 GLfloat] -> Bool -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull4X :: [Vertex3 GLfloat] -> Bool -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull4X [Vertex3 GLfloat]
lt Bool
isConvexHull = [Vertex3 GLfloat]
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Bool
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull4 [Vertex3 GLfloat]
lt Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' Bool
isConvexHull
  where
    cmp :: Vertex3 a -> Vertex3 a -> Bool
cmp (Vertex3 a
x a
y a
z) (Vertex3 a
x' a
y' a
z') = a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y'
    lt' :: [Vertex3 GLfloat]
lt' = (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Ord a => Vertex3 a -> Vertex3 a -> Bool
cmp [Vertex3 GLfloat]
lt
    top :: Vertex3 GLfloat
top = if [Vertex3 GLfloat] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
lt' Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 then [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head [Vertex3 GLfloat]
lt' else [Char] -> Vertex3 GLfloat
forall a. HasCallStack => [Char] -> a
error [Char]
"len lt' can not be zero"
    topx :: Vertex3 GLfloat
topx = Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a
addx Vertex3 GLfloat
top
    top' :: Vertex3 GLfloat
top' = Vertex3 GLfloat
top
    addx :: Vertex3 a -> Vertex3 a
addx (Vertex3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a
y a
z
  
    convexHull4 :: [Vertex3 GLfloat] -> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> Bool -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
    convexHull4 :: [Vertex3 GLfloat]
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Bool
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull4 [Vertex3 GLfloat]
lt Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' Bool
isConvexHull = if Vertex3 GLfloat
top' Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
pt0 then [Vertex3 GLfloat]
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> Bool
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHull4 [Vertex3 GLfloat]
lx' Vertex3 GLfloat
pt0 Vertex3 GLfloat
top Vertex3 GLfloat
top' Bool
isConvexHull [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. [a] -> [a] -> [a]
++ [(Vertex3 GLfloat
top, Vertex3 GLfloat
pt0)] else [(Vertex3 GLfloat
top, Vertex3 GLfloat
top')]
      where
        lx :: [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
lx = ((GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
 -> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
 -> Bool)
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (\(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
a (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
b -> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
a (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> Getting
     GLfloat
     (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
     GLfloat
-> GLfloat
forall s a. s -> Getting a s a -> a
^.Getting
  GLfloat
  (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
  GLfloat
forall s t a b. Field1 s t a b => Lens s t a b
_1 GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
b (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> Getting
     GLfloat
     (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
     GLfloat
-> GLfloat
forall s a. s -> Getting a s a -> a
^.Getting
  GLfloat
  (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
  GLfloat
forall s t a b. Field1 s t a b => Lens s t a b
_1) ([(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
 -> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)])
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat
 -> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat))
-> [Vertex3 GLfloat]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
x -> (Vertex3 GLfloat
x Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= (Bool
isConvexHull Bool -> Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Bool -> a -> a -> a
? Vertex3 GLfloat
top (Vertex3 GLfloat -> Vertex3 GLfloat)
-> Vertex3 GLfloat -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat
top') Bool -> GLfloat -> GLfloat -> GLfloat
forall a. Bool -> a -> a -> a
? Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 GLfloat
x Vertex3 GLfloat
top Vertex3 GLfloat
topx (GLfloat -> GLfloat) -> GLfloat -> GLfloat
forall a b. (a -> b) -> a -> b
$ -GLfloat
1, Vertex3 GLfloat
x, Vertex3 GLfloat
top, Vertex3 GLfloat
topx)) [Vertex3 GLfloat]
lt 
        hpt :: (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
hpt = if [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
lx Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 then [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
forall a. [a] -> a
head [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
lx else [Char]
-> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
forall a. HasCallStack => [Char] -> a
error [Char]
"convexHull4 len lx == 0"
        pt0 :: Vertex3 GLfloat
pt0 = (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
hpt (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> Getting
     (Vertex3 GLfloat)
     (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
     (Vertex3 GLfloat)
-> Vertex3 GLfloat
forall s a. s -> Getting a s a -> a
^.Getting
  (Vertex3 GLfloat)
  (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
  (Vertex3 GLfloat)
forall s t a b. Field2 s t a b => Lens s t a b
_2 
        lx' :: [Vertex3 GLfloat]
lx' = ((GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
 -> Vertex3 GLfloat)
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map ((GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> Getting
     (Vertex3 GLfloat)
     (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
     (Vertex3 GLfloat)
-> Vertex3 GLfloat
forall s a. s -> Getting a s a -> a
^.Getting
  (Vertex3 GLfloat)
  (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
  (Vertex3 GLfloat)
forall s t a b. Field2 s t a b => Lens s t a b
_2) ([(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
 -> [Vertex3 GLfloat])
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ ((GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
 -> Bool)
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
x -> (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
x (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> Getting
     (Vertex3 GLfloat)
     (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
     (Vertex3 GLfloat)
-> Vertex3 GLfloat
forall s a. s -> Getting a s a -> a
^.Getting
  (Vertex3 GLfloat)
  (GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
  (Vertex3 GLfloat)
forall s t a b. Field2 s t a b => Lens s t a b
_2 Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
pt0) [(GLfloat, Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)]
lx
  
  
{-|
   === KEY: convexhull, loop all the outer boundary to inner boundary

   NOTE: See 'convexHull4' spiral

   <http://localhost/image/convexhullloop.png convexhullloop>
-}
convexHullLoop :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullLoop :: [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullLoop [Vertex3 GLfloat]
cx = Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullX Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' [Vertex3 GLfloat]
rest
  where
    -- TODO: Why x < x' does not work
    -- cmpPt v@(Vertex3 x y z) v'@(Vertex3 x' y' z') = y /= y' ? y > y' $ (x /= x' ? x < x' $ (error $ "ERROR: cmpPt, same pts = " ++ show v ++ " " ++ show v'))
    cmpPt :: Vertex3 a -> Vertex3 a -> Bool
cmpPt v :: Vertex3 a
v@(Vertex3 a
x a
y a
z) v' :: Vertex3 a
v'@(Vertex3 a
x' a
y' a
z') = a
y a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y' Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
y' (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x' Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x' (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: cmpPt, same pts = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex3 a -> [Char]
forall a. Show a => a -> [Char]
show Vertex3 a
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Vertex3 a -> [Char]
forall a. Show a => a -> [Char]
show Vertex3 a
v'))
    sortY :: [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortY = (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. (Ord a, Show a) => Vertex3 a -> Vertex3 a -> Bool
cmpPt
  
    top :: Vertex3 GLfloat
top = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head ([Vertex3 GLfloat] -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ [Vertex3 GLfloat] -> [Vertex3 GLfloat]
sortY [Vertex3 GLfloat]
cx
    topx :: Vertex3 GLfloat
topx = Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Floating a => Vertex3 a -> a -> Vertex3 a
shiftX Vertex3 GLfloat
top GLfloat
10.0
  
    rest :: [Vertex3 GLfloat]
rest = (Vertex3 GLfloat -> Bool) -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
top) [Vertex3 GLfloat]
cx
    top' :: Vertex3 GLfloat
top' = Vertex3 GLfloat
top
    convexHullX :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
    convexHullX :: Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullX Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' [] =  [] -- [(top, top')] -- include the last segment for a loop
    convexHullX Vertex3 GLfloat
top Vertex3 GLfloat
topx Vertex3 GLfloat
top' [Vertex3 GLfloat]
rest =  if Vertex3 GLfloat
pi Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex3 GLfloat
top' then [(Vertex3 GLfloat
pi, Vertex3 GLfloat
top)] else (Vertex3 GLfloat
-> Vertex3 GLfloat
-> Vertex3 GLfloat
-> [Vertex3 GLfloat]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
convexHullX Vertex3 GLfloat
pi Vertex3 GLfloat
top Vertex3 GLfloat
top' [Vertex3 GLfloat]
rest') [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. [a] -> [a] -> [a]
++ [(Vertex3 GLfloat
pi, Vertex3 GLfloat
top)]
            where
              --                                largest angle                    smallest dist
              cmp :: (a, b, c) -> (a, b, c) -> Bool
cmp (a, b, c)
c1 (a, b, c)
c2 = ((a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c2) Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? ((a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> (a, b, c) -> a
forall a b c. (a, b, c) -> a
t1 (a, b, c)
c2) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c1 b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= (a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c2 Bool -> Bool -> Bool -> Bool
forall a. Bool -> a -> a -> a
? (a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c1 b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< (a, b, c) -> b
forall a b c. (a, b, c) -> b
t2 (a, b, c)
c2 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"ERROR: cmp, same pts = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (a, b, c) -> [Char]
forall a. Show a => a -> [Char]
show (a, b, c)
c1 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (a, b, c) -> [Char]
forall a. Show a => a -> [Char]
show (a, b, c)
c2))
              -- cmp c1 c2 = (t1 c1 > t1 c2)
              sortAngle :: [(GLfloat, GLfloat, Vertex3 GLfloat)]
sortAngle = ((GLfloat, GLfloat, Vertex3 GLfloat)
 -> (GLfloat, GLfloat, Vertex3 GLfloat) -> Bool)
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a. (a -> a -> Bool) -> [a] -> [a]
qqsort (GLfloat, GLfloat, Vertex3 GLfloat)
-> (GLfloat, GLfloat, Vertex3 GLfloat) -> Bool
forall a b c c.
(Ord a, Ord b, Show a, Show b, Show c, Show c) =>
(a, b, c) -> (a, b, c) -> Bool
cmp ([(GLfloat, GLfloat, Vertex3 GLfloat)]
 -> [(GLfloat, GLfloat, Vertex3 GLfloat)])
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> (GLfloat, GLfloat, Vertex3 GLfloat))
-> [Vertex3 GLfloat] -> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 GLfloat
p -> (Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
forall a. Floating a => Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 GLfloat
p Vertex3 GLfloat
top Vertex3 GLfloat
topx, Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
sqdist Vertex3 GLfloat
p Vertex3 GLfloat
top, Vertex3 GLfloat
p)) [Vertex3 GLfloat]
rest
              -- sortAngle = qqsort cmp $ map (\p -> (cosVex3 p top topx, sqdist p top, p)) rest
              pi :: Vertex3 GLfloat
pi = (GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b c. (a, b, c) -> c
t3 ((GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat)
-> (GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> (GLfloat, GLfloat, Vertex3 GLfloat)
forall a. [a] -> a
head [(GLfloat, GLfloat, Vertex3 GLfloat)]
sortAngle
              rest' :: [Vertex3 GLfloat]
rest' = ((GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat)
-> [(GLfloat, GLfloat, Vertex3 GLfloat)] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (GLfloat, GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b c. (a, b, c) -> c
t3 ([(GLfloat, GLfloat, Vertex3 GLfloat)] -> [Vertex3 GLfloat])
-> [(GLfloat, GLfloat, Vertex3 GLfloat)] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ [(GLfloat, GLfloat, Vertex3 GLfloat)]
-> [(GLfloat, GLfloat, Vertex3 GLfloat)]
forall a. [a] -> [a]
tail [(GLfloat, GLfloat, Vertex3 GLfloat)]
sortAngle
  

-- shift alone on X-axis
shiftX ::(Floating a)=> Vertex3 a -> a -> Vertex3 a 
shiftX :: Vertex3 a -> a -> Vertex3 a
shiftX (Vertex3 a
x a
y a
z) a
a = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a) a
y a
z
  
shiftXList :: [Vertex3 a] -> a -> [Vertex3 a]
shiftXList [Vertex3 a]
ls a
a = (Vertex3 a -> Vertex3 a) -> [Vertex3 a] -> [Vertex3 a]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 a
v -> Vertex3 a -> a -> Vertex3 a
forall a. Floating a => Vertex3 a -> a -> Vertex3 a
shiftX Vertex3 a
v a
a) [Vertex3 a]
ls
  
-- shift alone on Y-axis
shiftY :: Vertex3 a -> a -> Vertex3 a
shiftY (Vertex3 a
x a
y a
z) a
a = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
a) a
z
shiftYList :: [Vertex3 a] -> a -> [Vertex3 a]
shiftYList [Vertex3 a]
ls a
a = (Vertex3 a -> Vertex3 a) -> [Vertex3 a] -> [Vertex3 a]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 a
v -> Vertex3 a -> a -> Vertex3 a
forall a. Num a => Vertex3 a -> a -> Vertex3 a
shiftY Vertex3 a
v a
a) [Vertex3 a]
ls

shiftXY :: (a, a) -> Vertex3 a -> Vertex3 a
shiftXY (a
x', a
y') (Vertex3 a
x a
y a
z) = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
x') (a
y a -> a -> a
forall a. Num a => a -> a -> a
+ a
y') a
z
  
shiftXYList :: (a, a) -> [Vertex3 a] -> [Vertex3 a]
shiftXYList (a, a)
t [Vertex3 a]
ls = (Vertex3 a -> Vertex3 a) -> [Vertex3 a] -> [Vertex3 a]
forall a b. (a -> b) -> [a] -> [b]
map (\Vertex3 a
v -> (a, a) -> Vertex3 a -> Vertex3 a
forall a. Num a => (a, a) -> Vertex3 a -> Vertex3 a
shiftXY (a, a)
t Vertex3 a
v) [Vertex3 a]
ls
  
shiftTriX :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
shiftTriX :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
shiftTriX (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) GLfloat
k = (Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Floating a => Vertex3 a -> a -> Vertex3 a
shiftX Vertex3 GLfloat
a GLfloat
k, Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Floating a => Vertex3 a -> a -> Vertex3 a
shiftX Vertex3 GLfloat
b GLfloat
k, Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Floating a => Vertex3 a -> a -> Vertex3 a
shiftX Vertex3 GLfloat
c GLfloat
k)

shiftTriY :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat) -> GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
shiftTriY :: (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
-> GLfloat -> (Vertex3 GLfloat, Vertex3 GLfloat, Vertex3 GLfloat)
shiftTriY (Vertex3 GLfloat
a, Vertex3 GLfloat
b, Vertex3 GLfloat
c) GLfloat
k = (Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> a -> Vertex3 a
shiftY Vertex3 GLfloat
a GLfloat
k, Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> a -> Vertex3 a
shiftY Vertex3 GLfloat
b GLfloat
k, Vertex3 GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. Num a => Vertex3 a -> a -> Vertex3 a
shiftY Vertex3 GLfloat
c GLfloat
k) 


{-|
    === Check whether a pt is inside a polygon (assume the polygon is convex)
    === This is essentially a Covex Hull problem => use Convex Hull Algorithm

    TODO: Add test cases, never test it yet

    @
    let p  = Vertex3 0.2 0.3 0
    let v0 = Vertex3 0   0.6 0
    let v1 = Vertex3 0.6 0.6 0
    let v2 = Vertex3 0.0 0.0 0
    ptInsidePolygon p [v0, v1, v2]  -- return True 
    @
-}
ptInsidePolygon::Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
ptInsidePolygon :: Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
ptInsidePolygon Vertex3 GLfloat
p0 [Vertex3 GLfloat]
cx = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
containPt Vertex3 GLfloat
p0 [Vertex3 GLfloat]
cxx
    where
        cx' :: [Vertex3 GLfloat]
cx' = [Vertex3 GLfloat]
cx [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a] -> [a]
++ [Vertex3 GLfloat
p0]
        sz :: Int
sz = [Vertex3 GLfloat] -> Int
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len [Vertex3 GLfloat]
cx'
        cxx :: [Vertex3 GLfloat]
cxx = ([Vertex3 GLfloat] -> Vertex3 GLfloat)
-> [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head [Vertex3 GLfloat]
x) ([[Vertex3 GLfloat]] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ Int -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
convexHull Int
sz [Vertex3 GLfloat]
cx'

{-|
    === Given a \(p_0\): Vertex3 and [Vertex3], check whether the list contain p0
-}
containPt::Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
containPt :: Vertex3 GLfloat -> [Vertex3 GLfloat] -> Bool
containPt Vertex3 GLfloat
p0 [Vertex3 GLfloat]
cx = Vertex3 GLfloat -> Set (Vertex3 GLfloat) -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member Vertex3 GLfloat
p0 Set (Vertex3 GLfloat)
s
    where
        s :: Set (Vertex3 GLfloat)
s = [Vertex3 GLfloat] -> Set (Vertex3 GLfloat)
forall a. Ord a => [a] -> Set a
S.fromList [Vertex3 GLfloat]
cx
{-|
    === Projection from \(u\) onto \(v\) in Vector3
    <http://localhost/pdf/projectionlatex.pdf projection>
-}
projv :: (Fractional a) => Vector3 a -> Vector3 a -> Vector3 a
projv :: Vector3 a -> Vector3 a -> Vector3 a
projv Vector3 a
u Vector3 a
v = Vector3 a
w'
  where
    u' :: [[a]]
u' = Vector3 a -> [[a]]
forall a. Vector3 a -> [[a]]
veMat Vector3 a
u
    v' :: [[a]]
v' = Vector3 a -> [[a]]
forall a. Vector3 a -> [[a]]
veMat Vector3 a
v
    w :: [[a]]
w  = [[a]] -> [[a]] -> [[a]]
forall a. Fractional a => [[a]] -> [[a]] -> [[a]]
projn [[a]]
u' [[a]]
v'
    w' :: Vector3 a
w' = [[a]] -> Vector3 a
forall a. [[a]] -> Vector3 a
matVe [[a]]
w

{-|
 
    NOTE: q0 q1 q3 should be in CW

                                 
                                 q0
                                /  \ 
                           |   /    \
                           |  /      \
                           | /        \
                          q2 ---------- q1

                              v10 x v12


 -}
perpPlaneX::(Fractional a, Eq a)=> Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> Vertex3 a
perpPlaneX :: Vertex3 a -> (Vertex3 a, Vertex3 a, Vertex3 a) -> Vertex3 a
perpPlaneX p0 :: Vertex3 a
p0@(Vertex3 a
e0 a
e1 a
e2) (q0 :: Vertex3 a
q0@(Vertex3 a
m0 a
m1 a
m2), q1 :: Vertex3 a
q1@(Vertex3 a
k0 a
k1 a
k2), q2 :: Vertex3 a
q2@(Vertex3 a
d0 a
d1 a
d2)) = Vertex3 a
vx 
  where       
    v10 :: Vector3 a
v10 = Vertex3 a
q1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
q0
    v12 :: Vector3 a
v12 = Vertex3 a
q1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
q2
    vp :: Maybe (Vector3 a)
vp = Vector3 a
v10 Vector3 a -> Vector3 a -> Maybe (Vector3 a)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
`cross` Vector3 a
v12
    v00 :: Vector3 a
v00 = Vertex3 a
q0 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p0
    v_vp :: Vector3 a
v_vp = case Maybe (Vector3 a)
vp of
              Just Vector3 a
v -> Vector3 a -> Vector3 a -> Vector3 a
forall a. Fractional a => Vector3 a -> Vector3 a -> Vector3 a
projv Vector3 a
v00 Vector3 a
v 
              Maybe (Vector3 a)
Nothing -> [Char] -> Vector3 a
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: cross product"
    vx :: Vertex3 a
vx = Vertex3 a
q0 Vertex3 a -> Vector3 a -> Vertex3 a
forall a. Num a => Vertex3 a -> Vector3 a -> Vertex3 a
+: (Vector3 a
v00 Vector3 a -> Vector3 a -> Vector3 a
forall a. Num a => a -> a -> a
+ (-Vector3 a
v_vp))

{-|
   === Compute the norm of a vector, length of a vector

   \(v = (x, y, z)\)

   \(|v| = \sqrt{ x^2 + y^2 + z^2} \)
-}
nr::(Floating a) => Vector3 a -> a
nr :: Vector3 a -> a
nr Vector3 a
v = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ Vector3 a -> Vector3 a -> a
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve Vector3 a
v Vector3 a
v

{--
nr2::(Floating a) => Vector3 a -> a
nr2 v = sqrt $ dot3ve v v
--}
       
{-|
  === KEY: Normalize a vector, norm of a vector
  
  e.g \( \|\vec{v}\| = 1 \)
-}
uv::(Floating a) => Vector3 a-> Vector3 a
uv :: Vector3 a -> Vector3 a
uv Vector3 a
v = (a -> a) -> Vector3 a -> Vector3 a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> a -> a
forall a. Fractional a => a -> a -> a
/a
n) Vector3 a
v
    where
        n :: a
n = Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v
  
normalizeV3 :: (Floating a) => Vector3 a -> Vector3 a
normalizeV3 :: Vector3 a -> Vector3 a
normalizeV3 = Vector3 a -> Vector3 a
forall a. Floating a => Vector3 a -> Vector3 a
uv
  
{-|
    === Rodrigue formula

    \(u\) rotates around \(v\) in angle \(\phi\) in right hand rule

    rejection = \(u - p\)

    gx <http://localhost/pdf/rotate_arbitrary_axis.pdf Rotation>
-}
rod :: Vector3 a -> Vector3 a -> a -> Vector3 a
rod Vector3 a
u Vector3 a
v a
θ = Vector3 a
tv
  where
    p :: Vector3 a
p = Vector3 a -> Vector3 a -> Vector3 a
forall a. Fractional a => Vector3 a -> Vector3 a -> Vector3 a
projv Vector3 a
u Vector3 a
v
    -- right hand rule
    w :: Vector3 a
w = case Vector3 a
u Vector3 a -> Vector3 a -> Maybe (Vector3 a)
forall a.
(Num a, Eq a) =>
Vector3 a -> Vector3 a -> Maybe (Vector3 a)
⊗ Vector3 a
v of
      Maybe (Vector3 a)
Nothing -> [Char] -> Vector3 a
forall a. HasCallStack => [Char] -> a
error [Char]
"ERROR: u v can not be parallel"
      Just Vector3 a
v -> Vector3 a
v
    re :: Vector3 a
re= Vector3 a
u Vector3 a -> Vector3 a -> Vector3 a
forall a. Num a => a -> a -> a
- Vector3 a
p
    u' :: Vector3 a
u'= (a -> a
forall a. Floating a => a -> a
cos a
θ a -> Vector3 a -> Vector3 a
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 a
re) Vector3 a -> Vector3 a -> Vector3 a
forall a. Num a => a -> a -> a
+ ((a -> a
forall a. Floating a => a -> a
sin a
θ a -> a -> a
forall a. Num a => a -> a -> a
* Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
re) a -> Vector3 a -> Vector3 a
forall a. Num a => a -> Vector3 a -> Vector3 a
*: Vector3 a -> Vector3 a
forall a. Floating a => Vector3 a -> Vector3 a
uv Vector3 a
w)
    tv :: Vector3 a
tv= Vector3 a
p Vector3 a -> Vector3 a -> Vector3 a
forall a. Num a => a -> a -> a
+ Vector3 a
u'

{-|
    === KEY: Compute an angle from three points

    * Three points: \(a, b, c \) in angle \(\angle ABC \) with dot product
    
    >let a = Vertex3 1 0 0
    >let b = Vertex3 0 0 0
    >let c = Vertex3 0 1 0
    >cosVex3 a b c
    >0.0

    @
           ∠ ABC
           B --------A
           |
           |
           |
           C
    @

    \[
        \begin{equation}
        \begin{aligned}
            \vec{ba} &= a - b \\
            \vec{bc} &= c - b \\
            \vec{ba} \circ \vec{bc} &= | \vec{ba} | | \vec{bc} | \cos{\angle ABC}  \\
            \cos{\angle ABC} &= \frac{ \vec{bc} \circ \vec{bc} }{| \vec{ba} | | \vec{bc}|} \\
        \end{aligned}
        \end{equation}
    \]

-}
-- cosVex3::(Fractional a) => Vertex3 a -> Vertex3 a -> Vertex3 a -> a 
cosVex3::(Floating a) => Vertex3 a -> Vertex3 a -> Vertex3 a -> a 
cosVex3 :: Vertex3 a -> Vertex3 a -> Vertex3 a -> a
cosVex3 Vertex3 a
p0 Vertex3 a
p1 Vertex3 a
p2 = a -> a
forall a. Floating a => a -> a
acos (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
da -> a -> a
forall a. Fractional a => a -> a -> a
/(a
n1a -> a -> a
forall a. Num a => a -> a -> a
*a
n2)
                where
                    v10 :: Vector3 a
v10 = Vertex3 a
p1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p0
                    v12 :: Vector3 a
v12 = Vertex3 a
p1 Vertex3 a -> Vertex3 a -> Vector3 a
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 a
p2
                    d :: a
d = Vector3 a -> Vector3 a -> a
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve Vector3 a
v10 Vector3 a
v12
                    n1 :: a
n1 = Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v10
                    n2 :: a
n2 = Vector3 a -> a
forall a. Floating a => Vector3 a -> a
nr Vector3 a
v12

{-|
    === Compute an angle from three points: \(a, b, c \) with dot product

    * The angle is defined by angle $\angle ABC$ in $\bigtriangleup ABC$ from point $a$ to $c$ in counter-clockwise

    >let a = Vertex3 1 0 0
    >let b = Vertex3 0 0 0
    >let c = Vertex3 1 0 0
    >angleThreePts a b c
    >0.0

    @
    vx = Vertex3
    p0 = vx 1 0 0
    p1 = vx 0 0 0
    p2 = vx 0 1 0

    v10 = p1 -: p0
    v12 = p1 -: p2

    a = angle3Pts p0 p1 p2
    180/pi * a
    @

    @
      interval of angle is [0, π]
    @
-}
angleThreePts::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
angleThreePts :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
angleThreePts Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 = GLfloat -> GLfloat
forall a. Floating a => a -> a
acos (GLfloat -> GLfloat) -> GLfloat -> GLfloat
forall a b. (a -> b) -> a -> b
$ GLfloat
dGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(GLfloat
n1GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n2)
                    where
                      -- ERROR ? Saturday, 06 April 2024 10:49 PDT
                      -- v10 = p0 -: p1  -- vector p1 -> p0
                      -- v12 = p2 -: p1  -- vector p1 -> p2
                      v10 :: Vector3 GLfloat
v10 = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p0  -- vector p1 -> p0
                      v12 :: Vector3 GLfloat
v12 = Vertex3 GLfloat
p1 Vertex3 GLfloat -> Vertex3 GLfloat -> Vector3 GLfloat
forall a. Num a => Vertex3 a -> Vertex3 a -> Vector3 a
-: Vertex3 GLfloat
p2  -- vector p1 -> p2
                      d :: GLfloat
d = Vector3 GLfloat -> Vector3 GLfloat -> GLfloat
forall a. Num a => Vector3 a -> Vector3 a -> a
dot3ve Vector3 GLfloat
v10 Vector3 GLfloat
v12
                      n1 :: GLfloat
n1 = Vector3 GLfloat -> GLfloat
forall a. Floating a => Vector3 a -> a
nr Vector3 GLfloat
v10
                      n2 :: GLfloat
n2 = Vector3 GLfloat -> GLfloat
forall a. Floating a => Vector3 a -> a
nr Vector3 GLfloat
v12

{-|
    === Compute an angle from three points: \(a, b, c \) with dot product

    * The angle is defined by angle $\angle ABC$ in $\bigtriangleup ABC$ from point $a$ to $c$ in counter-clockwise

    >let a = Vertex3 1 0 0
    >let b = Vertex3 0 0 0
    >let c = Vertex3 1 0 0
    >angleThreePts a b c
    >0.0

    @
    vx = Vertex3
    p0 = vx 1 0 0
    p1 = vx 0 0 0
    p2 = vx 0 1 0

    v10 = p1 -: p0
    v12 = p1 -: p2

    a = angle3Pts p0 p1 p2
    180/pi * a
    @

    @
      interval of angle is [0, π]
    @
-}  
angle3Pts::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
angle3Pts :: Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
angle3Pts = Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> GLfloat
angleThreePts
  

{-|
    === Find all the segments DO NOT Cross some new segments
    Current algorithm is brute force

    __NOTE__ use __Convex Hull algo__ might be faster

    __NOTE__ EndPts are excluded, please see 'intersectSegNoEndPt'

    * Given a list of segments and a point

    * _SEE_ pictures to better understand it
    <http://localhost/html/indexConvexHullAlgorithm.html#non_cross_segment non_cross_segment>

    <http://localhost/html/indexConvexHullAlgorithm.html#non_cross_segment_2 non_cross_segment_2>

    Given Segments \( [(B, E), (E, A), (A, D), (D, C)] \) pt: \(F\)

    return => \( [(A, F), (F, D), (F, C)] \)

    @
    let p0 = Vertex3 0 0 0
        p1 = Vertex3 0.5 0 0
        p2 = Vertex3 0 0.5 0
        q0 = Vertex3 1 1 0
        ls = [(p0, p1), (p0, p2)]
        exp= sort [(p0, q0), (p1, q0), (p2, q0)]
        in exp == (sort $ nonCrossSegmentNoEndPt ls q0)

    let p0 = Vertex3 0 0 0
        p1 = Vertex3 0.5 0 0
        p2 = Vertex3 0 0.5 0
        q0 = Vertex3 1 1 0
        ls = [(p0, p1), (p1, p2)]
        exp= sort [(p1, q0), (p2, q0)]
        in exp == (sort $ nonCrossSegmentNoEndPt ls q0)
    @

    remove all the segments with same vertex from old segments list
    then check all the new segments with the rest of old segments list

-}
nonCrossSegmentNoEndPt::[(Vertex3 GLfloat, Vertex3 GLfloat)] ->
                        Vertex3 GLfloat ->
                        [(Vertex3 GLfloat, Vertex3 GLfloat)]
nonCrossSegmentNoEndPt :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Vertex3 GLfloat -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
nonCrossSegmentNoEndPt [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx Vertex3 GLfloat
p = Set (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. Set a -> [a]
S.toList (Set (Vertex3 GLfloat, Vertex3 GLfloat)
 -> [(Vertex3 GLfloat, Vertex3 GLfloat)])
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ Set (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
delSeg ([(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. Ord a => [a] -> Set a
S.fromList [(Vertex3 GLfloat, Vertex3 GLfloat)]
newSeg) [(Vertex3 GLfloat, Vertex3 GLfloat)]
badSeg
        where
            -- Cartesian product
            -- checkInter oldSeg newSeg = join $ map(\x -> map(\y -> (intersectSegNoEndPt x y) /= Nothing) oldSeg) newSeg
            badSeg :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
badSeg = ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
 -> (Vertex3 GLfloat, Vertex3 GLfloat))
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> [a] -> [b]
map(\(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
x -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
-> (Vertex3 GLfloat, Vertex3 GLfloat)
forall a b. (a, b) -> b
snd (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
x) ([(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [(Vertex3 GLfloat, Vertex3 GLfloat)])
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. (a -> b) -> a -> b
$ ((Bool, (Vertex3 GLfloat, Vertex3 GLfloat)) -> Bool)
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a. (a -> Bool) -> [a] -> [a]
filter(\(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
x -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat)) -> Bool
forall a b. (a, b) -> a
fst (Bool, (Vertex3 GLfloat, Vertex3 GLfloat))
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True) ([(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
 -> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))])
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> a -> b
$ [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
checkInter [(Vertex3 GLfloat, Vertex3 GLfloat)]
oldSeg [(Vertex3 GLfloat, Vertex3 GLfloat)]
newSeg

            delSeg::Set (Vertex3 GLfloat, Vertex3 GLfloat) ->
                    [(Vertex3 GLfloat, Vertex3 GLfloat)] ->
                    Set (Vertex3 GLfloat, Vertex3 GLfloat)
            delSeg :: Set (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
delSeg Set (Vertex3 GLfloat, Vertex3 GLfloat)
s []     = Set (Vertex3 GLfloat, Vertex3 GLfloat)
s
            delSeg Set (Vertex3 GLfloat, Vertex3 GLfloat)
s ((Vertex3 GLfloat, Vertex3 GLfloat)
b:[(Vertex3 GLfloat, Vertex3 GLfloat)]
bx) = Set (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
delSeg (Set (Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat)
-> Set (Vertex3 GLfloat, Vertex3 GLfloat)
forall a. Ord a => Set a -> a -> Set a
g Set (Vertex3 GLfloat, Vertex3 GLfloat)
s (Vertex3 GLfloat, Vertex3 GLfloat)
b) [(Vertex3 GLfloat, Vertex3 GLfloat)]
bx
                where
                    g :: Set a -> a -> Set a
g Set a
s a
b = a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
delete a
b Set a
s


            frm::[(Vertex3 GLfloat, Vertex3 GLfloat)] ->
                 [(Vertex3 GLfloat, Vertex3 GLfloat)] ->
                 [(Vertex3 GLfloat, Vertex3 GLfloat)]
            frm :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
frm [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx [] = [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx
            frm [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx ((Vertex3 GLfloat, Vertex3 GLfloat)
b:[(Vertex3 GLfloat, Vertex3 GLfloat)]
bx) = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
frm ([(Vertex3 GLfloat, Vertex3 GLfloat)]
-> (Vertex3 GLfloat, Vertex3 GLfloat)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. Eq a => [a] -> a -> [a]
g [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx (Vertex3 GLfloat, Vertex3 GLfloat)
b) [(Vertex3 GLfloat, Vertex3 GLfloat)]
bx
                where
                    g :: [a] -> a -> [a]
g [a]
cx a
b = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter(\a
x -> a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b) [a]
cx

            checkInter :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
checkInter [(Vertex3 GLfloat, Vertex3 GLfloat)]
oldSeg [(Vertex3 GLfloat, Vertex3 GLfloat)]
newSeg = [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
 -> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))])
-> [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> a -> b
$ ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))])
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [[(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]]
forall a b. (a -> b) -> [a] -> [b]
map(\(Vertex3 GLfloat, Vertex3 GLfloat)
nx -> ((Vertex3 GLfloat, Vertex3 GLfloat)
 -> (Bool, (Vertex3 GLfloat, Vertex3 GLfloat)))
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Bool, (Vertex3 GLfloat, Vertex3 GLfloat))]
forall a b. (a -> b) -> [a] -> [b]
map(\(Vertex3 GLfloat, Vertex3 GLfloat)
y -> (((Vertex3 GLfloat, Vertex3 GLfloat)
-> (Vertex3 GLfloat, Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat)
intersectSegNoEndPt2 (Vertex3 GLfloat, Vertex3 GLfloat)
nx (Vertex3 GLfloat, Vertex3 GLfloat)
y) Maybe (Vertex3 GLfloat) -> Maybe (Vertex3 GLfloat) -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe (Vertex3 GLfloat)
forall a. Maybe a
Nothing, (Vertex3 GLfloat, Vertex3 GLfloat)
nx)) [(Vertex3 GLfloat, Vertex3 GLfloat)]
oldSeg) [(Vertex3 GLfloat, Vertex3 GLfloat)]
newSeg
            -- Did not improve performance 
--            checkInter oldSeg newSeg = join $ map(\nx -> 
--                                map(\y -> ((intersectSegNoEndPt2 nx y) /= Nothing, nx)) (rmAdjacentSeg (fst nx) oldSeg)) newSeg
            oldSeg :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
oldSeg = [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx         -- [(p0, p1)]
            newSeg :: [(Vertex3 GLfloat, Vertex3 GLfloat)]
newSeg = [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> Vertex3 GLfloat -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. Ord a => [(a, a)] -> b -> [(a, b)]
mkSeg [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx Vertex3 GLfloat
p -- [(p0, p), (p1, p)]
            mkSeg :: [(a, a)] -> b -> [(a, b)]
mkSeg [(a, a)]
cx b
p = (a -> (a, b)) -> [a] -> [(a, b)]
forall a b. (a -> b) -> [a] -> [b]
map(\a
x -> (a
x, b
p)) ([a] -> [(a, b)]) -> [a] -> [(a, b)]
forall a b. (a -> b) -> a -> b
$ [(a, a)] -> [a]
forall a. Ord a => [(a, a)] -> [a]
fv [(a, a)]
cx -- [(p0, p1)], p => [(p0, p), (p1, p)]
            fv :: [(a, a)] -> [a]
fv [(a, a)]
cx = [a] -> [a]
forall a. Ord a => [a] -> [a]
unique ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ ((a, a) -> [a]) -> [(a, a)] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map(\(a, a)
x -> [(a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
x, (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
x]) [(a, a)]
cx -- [(p0, p1), (p0, p2), (p1, p2)] => [p0, p1, p2]

{-| 
    === Remove all adjacent edges or adjacent segments from a list of segments/edges
-} 
rmAdjacentSeg::Vertex3 GLfloat -> 
               [(Vertex3 GLfloat, Vertex3 GLfloat)] -> 
               [(Vertex3 GLfloat, Vertex3 GLfloat)]
rmAdjacentSeg :: Vertex3 GLfloat
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
rmAdjacentSeg Vertex3 GLfloat
p0 [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx = ((Vertex3 GLfloat, Vertex3 GLfloat) -> Bool)
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
-> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a. (a -> Bool) -> [a] -> [a]
filter(\(Vertex3 GLfloat, Vertex3 GLfloat)
s -> (Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b. (a, b) -> a
fst (Vertex3 GLfloat, Vertex3 GLfloat)
s Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
p0 Bool -> Bool -> Bool
&& (Vertex3 GLfloat, Vertex3 GLfloat) -> Vertex3 GLfloat
forall a b. (a, b) -> b
snd (Vertex3 GLfloat, Vertex3 GLfloat)
s Vertex3 GLfloat -> Vertex3 GLfloat -> Bool
forall a. Eq a => a -> a -> Bool
/= Vertex3 GLfloat
p0) [(Vertex3 GLfloat, Vertex3 GLfloat)]
cx


{-| 
    === Affine Combination on three points
    == Draw all the points inside a triangle p0 p1 p2

    The number of steps is \( n = 10 \)

    Extend it to polygon

    <http://localhost/image/affine_triangle.png Affine_Triangle>
-} 
affineTri::Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat]
affineTri :: Vertex3 GLfloat
-> Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat]
affineTri Vertex3 GLfloat
p0 Vertex3 GLfloat
p1 Vertex3 GLfloat
p2 = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. Ord a => [a] -> [a]
unique ([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Vertex3 GLfloat]] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (GLfloat -> [Vertex3 GLfloat]) -> [GLfloat] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
h -> (GLfloat -> Vertex3 GLfloat) -> [GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
t -> if GLfloat
t GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
h GLfloat -> GLfloat -> Bool
forall a. Ord a => a -> a -> Bool
<= GLfloat
1 then GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall (f :: * -> *) b. (Functor f, Num b) => b -> f b -> f b
mu (GLfloat
1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
h GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
- GLfloat
t) Vertex3 GLfloat
p0 Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => a -> a -> a
+ (GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall (f :: * -> *) b. (Functor f, Num b) => b -> f b -> f b
mu GLfloat
h Vertex3 GLfloat
p1) Vertex3 GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall a. Num a => a -> a -> a
+ (GLfloat -> Vertex3 GLfloat -> Vertex3 GLfloat
forall (f :: * -> *) b. (Functor f, Num b) => b -> f b -> f b
mu GLfloat
t Vertex3 GLfloat
p2) else Vertex3 GLfloat
p0 ) [GLfloat]
tt ) [GLfloat]
hh 
    where
        mu :: b -> f b -> f b
mu b
x f b
v = (b -> b -> b
forall a. Num a => a -> a -> a
*b
x) (b -> b) -> f b -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
v

        hh::[Float]
        hh :: [GLfloat]
hh = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x ->GLfloat
xGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
del) [GLfloat
0..GLfloat
n]
            where
                del :: GLfloat
del = GLfloat
1GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
n;
                n :: GLfloat
n = GLfloat
10;
        tt :: [GLfloat]
tt = [GLfloat]
hh



{-| 
    === Draw all segments from Vertex3 a To Vertex3 b
-} 
drawSegmentFromTo::Color3 GLdouble -> [Vertex3 GLfloat] -> IO()
drawSegmentFromTo :: Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
c [Vertex3 GLfloat]
cx = do
                            let n :: Int
n = [Vertex3 GLfloat] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertex3 GLfloat]
cx
                            let pair :: [Vertex3 GLfloat]
pair = [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Vertex3 GLfloat]] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Vertex3 GLfloat
x Vertex3 GLfloat
y -> [Vertex3 GLfloat
x, Vertex3 GLfloat
y]) ([Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
init [Vertex3 GLfloat]
cx) ([Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
tail [Vertex3 GLfloat]
cx)
                            (Vertex3 GLfloat -> IO ()) -> [Vertex3 GLfloat] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vertex3 GLfloat
x -> Vertex3 GLfloat -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor Vertex3 GLfloat
x Color3 GLdouble
red GLdouble
0.002) [Vertex3 GLfloat]
pair 
                            PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawPrimitive' PrimitiveMode
Lines Color3 GLdouble
c [Vertex3 GLfloat]
pair 
                            let one :: Vertex3 GLfloat
one = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
head [Vertex3 GLfloat]
pair
                            let las :: Vertex3 GLfloat
las = [Vertex3 GLfloat] -> Vertex3 GLfloat
forall a. [a] -> a
last [Vertex3 GLfloat]
pair
                            Vertex3 GLfloat -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor Vertex3 GLfloat
one Color3 GLdouble
green GLdouble
0.005 
                            Vertex3 GLfloat -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor Vertex3 GLfloat
las Color3 GLdouble
blue GLdouble
0.014
                            
{-| 
    === Draw all segments from Vertex3 a To Vertex3 b

    Deprecated
    Use 'drawSegmentFromToD'
-} 
drawSegmentFromTo2::Color3 GLdouble -> [Vertex3 GLdouble] -> IO()
drawSegmentFromTo2 :: Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawSegmentFromTo2 Color3 GLdouble
c [Vertex3 GLdouble]
cx = do
                            let n :: Int
n = [Vertex3 GLdouble] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertex3 GLdouble]
cx
                            let pair :: [Vertex3 GLdouble]
pair = [[Vertex3 GLdouble]] -> [Vertex3 GLdouble]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Vertex3 GLdouble]] -> [Vertex3 GLdouble])
-> [[Vertex3 GLdouble]] -> [Vertex3 GLdouble]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLdouble -> Vertex3 GLdouble -> [Vertex3 GLdouble])
-> [Vertex3 GLdouble] -> [Vertex3 GLdouble] -> [[Vertex3 GLdouble]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Vertex3 GLdouble
x Vertex3 GLdouble
y -> [Vertex3 GLdouble
x, Vertex3 GLdouble
y]) ([Vertex3 GLdouble] -> [Vertex3 GLdouble]
forall a. [a] -> [a]
init [Vertex3 GLdouble]
cx) ([Vertex3 GLdouble] -> [Vertex3 GLdouble]
forall a. [a] -> [a]
tail [Vertex3 GLdouble]
cx)
                            (Vertex3 GLdouble -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vertex3 GLdouble
x -> Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
x Color3 GLdouble
red GLdouble
0.002) [Vertex3 GLdouble]
pair 
                            PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawPrimitive2 PrimitiveMode
Lines Color3 GLdouble
c [Vertex3 GLdouble]
pair 
                            let one :: Vertex3 GLdouble
one = [Vertex3 GLdouble] -> Vertex3 GLdouble
forall a. [a] -> a
head [Vertex3 GLdouble]
pair
                            let las :: Vertex3 GLdouble
las = [Vertex3 GLdouble] -> Vertex3 GLdouble
forall a. [a] -> a
last [Vertex3 GLdouble]
pair
                            Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
one Color3 GLdouble
green GLdouble
0.005 
                            Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
las Color3 GLdouble
blue GLdouble
0.014 
{-| 
    === Draw all segments from Vertex3 GLdouble To Vertex3 GLdouble
-} 
drawSegmentFromToD::Color3 GLdouble -> [Vertex3 GLdouble] -> IO()
drawSegmentFromToD :: Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawSegmentFromToD Color3 GLdouble
c [Vertex3 GLdouble]
cx = do
                            let n :: Int
n = [Vertex3 GLdouble] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Vertex3 GLdouble]
cx
                            let pair :: [Vertex3 GLdouble]
pair = [[Vertex3 GLdouble]] -> [Vertex3 GLdouble]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Vertex3 GLdouble]] -> [Vertex3 GLdouble])
-> [[Vertex3 GLdouble]] -> [Vertex3 GLdouble]
forall a b. (a -> b) -> a -> b
$ (Vertex3 GLdouble -> Vertex3 GLdouble -> [Vertex3 GLdouble])
-> [Vertex3 GLdouble] -> [Vertex3 GLdouble] -> [[Vertex3 GLdouble]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith(\Vertex3 GLdouble
x Vertex3 GLdouble
y -> [Vertex3 GLdouble
x, Vertex3 GLdouble
y]) ([Vertex3 GLdouble] -> [Vertex3 GLdouble]
forall a. [a] -> [a]
init [Vertex3 GLdouble]
cx) ([Vertex3 GLdouble] -> [Vertex3 GLdouble]
forall a. [a] -> [a]
tail [Vertex3 GLdouble]
cx)
                            (Vertex3 GLdouble -> IO ()) -> [Vertex3 GLdouble] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Vertex3 GLdouble
x -> Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
x Color3 GLdouble
red GLdouble
0.002) [Vertex3 GLdouble]
pair 
                            PrimitiveMode -> Color3 GLdouble -> [Vertex3 GLdouble] -> IO ()
drawPrimitive2 PrimitiveMode
Lines Color3 GLdouble
c [Vertex3 GLdouble]
pair 
                            let one :: Vertex3 GLdouble
one = [Vertex3 GLdouble] -> Vertex3 GLdouble
forall a. [a] -> a
head [Vertex3 GLdouble]
pair
                            let las :: Vertex3 GLdouble
las = [Vertex3 GLdouble] -> Vertex3 GLdouble
forall a. [a] -> a
last [Vertex3 GLdouble]
pair
                            Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
one Color3 GLdouble
green GLdouble
0.005 
                            Vertex3 GLdouble -> Color3 GLdouble -> GLdouble -> IO ()
drawCircleColor2 Vertex3 GLdouble
las Color3 GLdouble
blue GLdouble
0.014 
  
                            
{-| 
    === 2d grid on x-y-plane, z=0
    == draw grid

    >mapM_ (\row -> drawSegmentFromTo red row ) grid 
    >mapM_ (\row -> drawSegmentFromTo red row ) $ tran grid 
-} 
grid::[[Vertex3 GLfloat]]
grid :: [[Vertex3 GLfloat]]
grid =[[ let c :: C
c = (GLfloat -> GLfloat -> C
C GLfloat
a GLfloat
b) in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (C -> GLfloat
re C
c) (C -> GLfloat
im C
c) GLfloat
0 | GLfloat
a <- [GLfloat]
aa] | GLfloat
b <- [GLfloat]
bb]
        where 
            n :: GLfloat
n  = GLfloat
10 
            fa :: GLfloat
fa = GLfloat
1GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(GLfloat
1.5GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)
            aa :: [GLfloat]
aa = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
fa GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
x) [-GLfloat
n..GLfloat
n]
            bb :: [GLfloat]
bb = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
fa GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
x) [-GLfloat
n..GLfloat
n]

grid2::(GLfloat -> GLfloat -> GLfloat) -> [[Vertex3 GLfloat]]
grid2 :: (GLfloat -> GLfloat -> GLfloat) -> [[Vertex3 GLfloat]]
grid2 GLfloat -> GLfloat -> GLfloat
f =[[ GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y (GLfloat -> GLfloat -> GLfloat
f GLfloat
x GLfloat
y) | GLfloat
x <- [GLfloat]
aa] | GLfloat
y <- [GLfloat]
bb]
        where 
            n :: GLfloat
n  = GLfloat
10 
            fa :: GLfloat
fa = GLfloat
1GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(GLfloat
1.5GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)
            aa :: [GLfloat]
aa = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
fa GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
x) [-GLfloat
n..GLfloat
n]
            bb :: [GLfloat]
bb = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
fa GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
x) [-GLfloat
n..GLfloat
n]

{-| 
    === Draw parameter equation.
    x = 2*u    \u -> 2*u        u [1..10]
    y = 3*v    \v -> 3*v        v [3..20]
    z = u + v  \(u, v) -> u + v
-} 
grid3::(GLfloat -> GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> [[Vertex3 GLfloat]]
grid3 :: (GLfloat -> GLfloat -> GLfloat)
-> (GLfloat -> GLfloat)
-> (GLfloat -> GLfloat)
-> [[Vertex3 GLfloat]]
grid3 GLfloat -> GLfloat -> GLfloat
f GLfloat -> GLfloat
u GLfloat -> GLfloat
v =[[ GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y (GLfloat -> GLfloat -> GLfloat
f GLfloat
x GLfloat
y) | GLfloat
x <- [GLfloat]
aa] | GLfloat
y <- [GLfloat]
bb]
        where 
            n :: GLfloat
n  = GLfloat
20 
            fa :: GLfloat
fa = GLfloat
1GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
n
            aa :: [GLfloat]
aa = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat -> GLfloat
u GLfloat
x) ([GLfloat] -> [GLfloat]) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
fa) [-GLfloat
n..GLfloat
n]
            bb :: [GLfloat]
bb = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat -> GLfloat
v GLfloat
x) ([GLfloat] -> [GLfloat]) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
fa) [-GLfloat
n..GLfloat
n]

drawParamSurf::(GLfloat -> GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> IO()
drawParamSurf :: (GLfloat -> GLfloat -> GLfloat)
-> (GLfloat -> GLfloat) -> (GLfloat -> GLfloat) -> IO ()
drawParamSurf GLfloat -> GLfloat -> GLfloat
f GLfloat -> GLfloat
u GLfloat -> GLfloat
v = do
                ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
row -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red [Vertex3 GLfloat]
row ) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat -> GLfloat)
-> (GLfloat -> GLfloat)
-> (GLfloat -> GLfloat)
-> [[Vertex3 GLfloat]]
grid3 GLfloat -> GLfloat -> GLfloat
f GLfloat -> GLfloat
u GLfloat -> GLfloat
v
                ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
row -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
blue [Vertex3 GLfloat]
row ) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran ([[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ (GLfloat -> GLfloat -> GLfloat)
-> (GLfloat -> GLfloat)
-> (GLfloat -> GLfloat)
-> [[Vertex3 GLfloat]]
grid3 GLfloat -> GLfloat -> GLfloat
f GLfloat -> GLfloat
u GLfloat -> GLfloat
v


{-|

  @
  torus2::[(GLfloat, GLfloat, GLfloat)]
  torus2= [ ( fx i k, 
             fy i k, 
             fz i k ) | i <- [1..n], k <-[1..n]]
          where 
              del = rf(2*pi/(n-1))
              n = 100 
              r = 0.2
              br = 0.3

              fx = \i k -> (br + r**cos(del*i))*cos(del*j)
              fy = \i k -> sin(rf del*i)
              fz = \i k -> (br + r*cos(rf del*i))*sin(rf del*j)

    i = [1..n], j = [1..n]
    x = outer + inner × cos(δ × i) × cos(δ × j)
    y = sin(δ × i)
    z = outer + inner × cos(δ × i) × sin(δ × j)
  @

  Torus equation
  http://localhost/html/indexThebeautyofTorus.html
-}
torus2::[[Vertex3 GLfloat]]
torus2 :: [[Vertex3 GLfloat]]
torus2 =[[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (GLfloat -> GLfloat -> GLfloat
fx GLfloat
i GLfloat
j) 
                  (GLfloat -> GLfloat -> GLfloat
forall p. p -> GLfloat -> GLfloat
fy GLfloat
i GLfloat
j) 
                  (GLfloat -> GLfloat -> GLfloat
fz GLfloat
i GLfloat
j) | GLfloat
i <- [GLfloat
0..GLfloat
n]] | GLfloat
j <-[GLfloat
0..GLfloat
n]]
        where
            n :: GLfloat
n = GLfloat
10          
            δ :: GLfloat
δ = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/GLfloat
n
            r :: GLfloat
r = GLfloat
0.1
            br :: GLfloat
br = GLfloat
0.2

            fx :: GLfloat -> GLfloat -> GLfloat
fx = \GLfloat
i GLfloat
j -> (GLfloat
br GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i))GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j)
            fy :: p -> GLfloat -> GLfloat
fy = \p
i GLfloat
j -> GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j)
            fz :: GLfloat -> GLfloat -> GLfloat
fz = \GLfloat
i GLfloat
j -> (GLfloat
br GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i))GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j)

drawTorus2::IO()
drawTorus2 :: IO ()
drawTorus2 = do
  ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red) [[Vertex3 GLfloat]]
torus2
  -- mapM_ (drawSegmentFromTo blue) $ tran torus2

drawTorus::GLfloat -> GLfloat -> Int -> [Color3 GLdouble]-> IO()
drawTorus :: GLfloat -> GLfloat -> Int -> [Color3 GLdouble] -> IO ()
drawTorus GLfloat
r GLfloat
br Int
n [Color3 GLdouble]
cx = do
  ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red) [[Vertex3 GLfloat]]
torus3
  -- mapM_ (drawSegmentFromTo yellow) $ tran torus3
  ([(Color3 GLdouble, Vertex3 GLfloat)] -> IO ())
-> [[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[(Color3 GLdouble, Vertex3 GLfloat)]
row -> do
            PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
TriangleStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Color3 GLdouble, Vertex3 GLfloat) -> IO ())
-> [(Color3 GLdouble, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Color3 GLdouble
c, Vertex3 GLfloat
v) -> do
                                                      Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                                      Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v
                                                      ) [(Color3 GLdouble, Vertex3 GLfloat)]
row
        ) [[(Color3 GLdouble, Vertex3 GLfloat)]]
cm
  where
    cm :: [[(Color3 GLdouble, Vertex3 GLfloat)]]
cm = [[Vertex3 GLfloat]]
-> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a.
Num a =>
[[Vertex3 a]]
-> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 a)]]
combinePt [[Vertex3 GLfloat]]
torus3 [Color3 GLdouble]
cx
    torus3::[[Vertex3 GLfloat]]
    torus3 :: [[Vertex3 GLfloat]]
torus3 =[[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j) 
                (Fx
fy Int
i Int
j) 
                (Fx
fz Int
i Int
j) | Int
i <- [Int
0..Int
n]] | Int
j <-[Int
0..Int
n]]
            where
                δ :: GLfloat
δ = GLfloat
2GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
forall a. Floating a => a
piGLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
n
                fx :: Fx
fx = \Int
i Int
j -> let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i; j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j in (GLfloat
br GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'))GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j')
                fy :: Fx
fy = \Int
i Int
j -> let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i; j' :: GLdouble
j' = Int -> GLdouble
forall a b. (Real a, Fractional b) => a -> b
rf Int
j in GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i')
                fz :: Fx
fz = \Int
i Int
j -> let i' :: GLfloat
i' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
i; j' :: GLfloat
j' = Int -> GLfloat
forall a b. (Real a, Fractional b) => a -> b
rf Int
j in (GLfloat
br GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
cos (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
i'))GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat -> GLfloat
forall a. Floating a => a -> a
sin (GLfloat
δGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
j')    




type Fx = Int -> Int -> GLfloat
type Fy = Int -> Int -> GLfloat
type Fz = Int -> Int -> GLfloat

type Fx' = Int -> Int -> GLdouble
type Fy' = Int -> Int -> GLdouble
type Fz' = Int -> Int -> GLdouble

drawParamSurface::Fx -> Fy -> Fz -> IO ()
drawParamSurface :: Fx -> Fx -> Fx -> IO ()
drawParamSurface Fx
fx Fx
fy Fx
fz = do
  ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red) [[Vertex3 GLfloat]]
ss
  ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
blue) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
ss
  where
    n :: Int
n = Int
40
    ss :: [[Vertex3 GLfloat]]
ss = [[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j)
                   (Fx
fy Int
i Int
j)
                   (Fx
fz Int
i Int
j) | Int
i <- [(-Int
n)..Int
n]] | Int
j <- [(-Int
n)..Int
n]]

{-|
    === draw parametric surface

    @
    See $sp/PlotGeometry

    -- draw s sphere
    let n = 40::Int
        δ = 2*pi/ rf(n-1) :: GLfloat
        r = 0.4
        br = 0.2
        σ = 1/ rf(n-1)

        fx::Int -> Int -> GLfloat
        fx i j = let i' = rf i
                     j' = rf j
                     α  = δ*i'
                     β  = δ*j'
                 in r * cos β * cos α
        fy::Int -> Int -> GLfloat
        fy i j = let i' = rf i
                     j' = rf j
                     α  = δ*i'
                     β  = δ*j'
                 in r * cos β * sin α

        fz::Int -> Int -> GLfloat
        fz i j = let i' = rf i
                     j' = rf j
                     α  = δ*i'
                     β  = δ*j'
                 in r * sin β
        in drawParamSurfaceN fx fy fz n
    @
-}
drawParamSurfaceN::Fx -> Fy -> Fz -> Int -> IO ()
drawParamSurfaceN :: Fx -> Fx -> Fx -> Int -> IO ()
drawParamSurfaceN Fx
fx Fx
fy Fx
fz Int
n = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let u :: GLdouble
u = GLdouble
0.2
        -- translate (Vector3 u u 0 :: Vector3 GLdouble)
        -- mapM_ (drawSegmentFromTo red) ss
        let cl :: [Color3 GLdouble]
cl = [[Color3 GLdouble]] -> [Color3 GLdouble]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Color3 GLdouble]] -> [Color3 GLdouble])
-> [[Color3 GLdouble]] -> [Color3 GLdouble]
forall a b. (a -> b) -> a -> b
$ [Color3 GLdouble] -> [[Color3 GLdouble]]
forall a. a -> [a]
repeat [Color3 GLdouble
red, Color3 GLdouble
blue, Color3 GLdouble
cyan, Color3 GLdouble
yellow, Color3 GLdouble
gray, Color3 GLdouble
green]
        let ss' :: [[Vertex3 GLfloat]]
ss' = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
ss
        let ax :: [[Vertex3 GLfloat]]
ax = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [a] -> [a]
init [[Vertex3 GLfloat]]
ss'
        let bx :: [[Vertex3 GLfloat]]
bx = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [a] -> [a]
tail [[Vertex3 GLfloat]]
ss'
        let cx :: [[Vertex3 GLfloat]]
cx = [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]])
-> [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ (([Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]]
-> [[Vertex3 GLfloat]]
-> [[[Vertex3 GLfloat]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (([Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]])
 -> [[Vertex3 GLfloat]]
 -> [[Vertex3 GLfloat]]
 -> [[[Vertex3 GLfloat]]])
-> ((Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
    -> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]])
-> (Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]]
-> [[Vertex3 GLfloat]]
-> [[[Vertex3 GLfloat]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith) (\Vertex3 GLfloat
a Vertex3 GLfloat
b -> [Vertex3 GLfloat
a, Vertex3 GLfloat
b]) [[Vertex3 GLfloat]]
ax [[Vertex3 GLfloat]]
bx
        let cx' :: [[(Color3 GLdouble, Vertex3 GLfloat)]]
cx' = let c :: [[Color3 GLdouble]]
c = [Color3 GLdouble] -> [[Color3 GLdouble]]
forall a. a -> [a]
repeat [Color3 GLdouble
red, Color3 GLdouble
blue, Color3 GLdouble
cyan, Color3 GLdouble
yellow, Color3 GLdouble
gray, Color3 GLdouble
green] in (([Color3 GLdouble]
 -> [Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)])
-> [[Color3 GLdouble]]
-> [[Vertex3 GLfloat]]
-> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (([Color3 GLdouble]
  -> [Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)])
 -> [[Color3 GLdouble]]
 -> [[Vertex3 GLfloat]]
 -> [[(Color3 GLdouble, Vertex3 GLfloat)]])
-> ((Color3 GLdouble
     -> Vertex3 GLfloat -> (Color3 GLdouble, Vertex3 GLfloat))
    -> [Color3 GLdouble]
    -> [Vertex3 GLfloat]
    -> [(Color3 GLdouble, Vertex3 GLfloat)])
-> (Color3 GLdouble
    -> Vertex3 GLfloat -> (Color3 GLdouble, Vertex3 GLfloat))
-> [[Color3 GLdouble]]
-> [[Vertex3 GLfloat]]
-> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color3 GLdouble
 -> Vertex3 GLfloat -> (Color3 GLdouble, Vertex3 GLfloat))
-> [Color3 GLdouble]
-> [Vertex3 GLfloat]
-> [(Color3 GLdouble, Vertex3 GLfloat)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith) (,) [[Color3 GLdouble]]
c [[Vertex3 GLfloat]]
cx
        let m :: [[(Color3 GLdouble, Vertex3 GLfloat)]]
m = ([Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)])
-> [[Vertex3 GLfloat]] -> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Vertex3 GLfloat]
cx -> [Color3 GLdouble]
-> [Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Color3 GLdouble]
cl [Vertex3 GLfloat]
cx) ([[Vertex3 GLfloat]] -> [[(Color3 GLdouble, Vertex3 GLfloat)]])
-> [[Vertex3 GLfloat]] -> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
hg [[Vertex3 GLfloat]]
ss
        let mx :: [[(Color3 GLdouble, Vertex3 GLfloat)]]
mx = ([Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)])
-> [[Vertex3 GLfloat]] -> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a b. (a -> b) -> [a] -> [b]
map(\[Vertex3 GLfloat]
cx -> [Color3 GLdouble]
-> [Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Color3 GLdouble]
cl [Vertex3 GLfloat]
cx) ([[Vertex3 GLfloat]] -> [[(Color3 GLdouble, Vertex3 GLfloat)]])
-> [[Vertex3 GLfloat]] -> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
hg [[Vertex3 GLfloat]]
ss
        
        [Char]
mxx <- (IO () -> IO [Char]
forall a. IO a -> IO [Char]
cap (IO () -> IO [Char])
-> ([[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ())
-> [[(Color3 GLdouble, Vertex3 GLfloat)]]
-> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ()
forall a. Show a => [[a]] -> IO ()
printMat) [[(Color3 GLdouble, Vertex3 GLfloat)]]
m
        [[Char]] -> IO ()
logFileG [[Char]
"mxx11"]
        [[Char]] -> IO ()
logFileG [[Char]
mxx]
        
        ((Integer, [Vertex3 GLfloat]) -> IO ())
-> [(Integer, [Vertex3 GLfloat])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
n, [Vertex3 GLfloat]
v) -> do
                  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo (Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
n Bool -> Color3 GLdouble -> Color3 GLdouble -> Color3 GLdouble
forall a. Bool -> a -> a -> a
? Color3 GLdouble
red (Color3 GLdouble -> Color3 GLdouble)
-> Color3 GLdouble -> Color3 GLdouble
forall a b. (a -> b) -> a -> b
$ Color3 GLdouble
white) [Vertex3 GLfloat]
v
              ) ([(Integer, [Vertex3 GLfloat])] -> IO ())
-> [(Integer, [Vertex3 GLfloat])] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [[Vertex3 GLfloat]] -> [(Integer, [Vertex3 GLfloat])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [[Vertex3 GLfloat]]
ss
        {--
         -- BUG
        renderPrimitive TriangleStrip $ (mapM_ . mapM_) (\(c, v) -> do
                                                            color c
                                                            vertex v
                                                            ) m
        --}
        {--
         -- BUG
        renderPrimitive TriangleStrip $ (mapM_ . mapM_) (\(c, v) -> do
                                                            color c
                                                            vertex v
                                                         ) mx
        --}
        ([(Color3 GLdouble, Vertex3 GLfloat)] -> IO ())
-> [[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[(Color3 GLdouble, Vertex3 GLfloat)]
row -> do
                  PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
TriangleStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Color3 GLdouble, Vertex3 GLfloat) -> IO ())
-> [(Color3 GLdouble, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Color3 GLdouble
c, Vertex3 GLfloat
v) -> do
                                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v
                                                            ) [(Color3 GLdouble, Vertex3 GLfloat)]
row
                  ) [[(Color3 GLdouble, Vertex3 GLfloat)]]
mx
      where
        ss :: [[Vertex3 GLfloat]]
ss = [[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j)
                       (Fx
fy Int
i Int
j)
                       (Fx
fz Int
i Int
j) | Int
i <- [Int
0..Int
n]] | Int
j <- let m :: Int
m = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
n Int
2 in [-Int
m, -Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
m]]
        gg :: [([a], [a])] -> [[[a]]]
gg [([a], [a])]
cx = (([a], [a]) -> [[a]]) -> [([a], [a])] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
a, [a]
b) -> (a -> a -> [a]) -> [a] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> [a
x, a
y]) [a]
a [a]
b) [([a], [a])]
cx
        fg :: [a] -> [b] -> [(a, b)]
fg [a]
x [b]
y = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [a]
forall a. [a] -> [a]
init [a]
x) ([b] -> [b]
forall a. [a] -> [a]
tail [b]
y)
        hg :: [[a]] -> [[a]]
hg [[a]]
m = ([[a]] -> [a]) -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [[a]] -> [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[[a]]] -> [[a]]) -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [([a], [a])] -> [[[a]]]
forall a. [([a], [a])] -> [[[a]]]
gg ([([a], [a])] -> [[[a]]]) -> [([a], [a])] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
fg [[a]]
m [[a]]
m


combinePt :: (Num a) => [[Vertex3 a]] -> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 a)]]
combinePt :: [[Vertex3 a]]
-> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 a)]]
combinePt [[Vertex3 a]]
m [Color3 GLdouble]
cx = ([Vertex3 a] -> [(Color3 GLdouble, Vertex3 a)])
-> [[Vertex3 a]] -> [[(Color3 GLdouble, Vertex3 a)]]
forall a b. (a -> b) -> [a] -> [b]
map ([Color3 GLdouble] -> [Vertex3 a] -> [(Color3 GLdouble, Vertex3 a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([[Color3 GLdouble]] -> [Color3 GLdouble]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Color3 GLdouble]] -> [Color3 GLdouble])
-> [[Color3 GLdouble]] -> [Color3 GLdouble]
forall a b. (a -> b) -> a -> b
$ [Color3 GLdouble] -> [[Color3 GLdouble]]
forall a. a -> [a]
repeat [Color3 GLdouble]
cx)) ([[Vertex3 a]] -> [[(Color3 GLdouble, Vertex3 a)]])
-> [[Vertex3 a]] -> [[(Color3 GLdouble, Vertex3 a)]]
forall a b. (a -> b) -> a -> b
$ [[Vertex3 a]] -> [[Vertex3 a]]
forall a. [[a]] -> [[a]]
hg [[Vertex3 a]]
m
  where
    gg :: [([a], [a])] -> [[[a]]]
gg [([a], [a])]
xs = (([a], [a]) -> [[a]]) -> [([a], [a])] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
map (\([a]
a, [a]
b) -> (a -> a -> [a]) -> [a] -> [a] -> [[a]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\a
x a
y -> [a
x, a
y]) [a]
a [a]
b) [([a], [a])]
xs 
    fg :: [a] -> [b] -> [(a, b)]
fg [a]
x [b]
y = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [a]
forall a. [a] -> [a]
init [a]
x) ([b] -> [b]
forall a. [a] -> [a]
tail [b]
y)
    hg :: [[a]] -> [[a]]
hg [[a]]
m2 = ([[a]] -> [a]) -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [[a]] -> [a]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[[a]]] -> [[a]]) -> [[[a]]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [([a], [a])] -> [[[a]]]
forall a. [([a], [a])] -> [[[a]]]
gg ([([a], [a])] -> [[[a]]]) -> [([a], [a])] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
fg [[a]]
m2 [[a]]
m2

{--
{-|
 - KEY: combine points
 -
 - DATE: Sat 16 Mar 13:09:32 2024 
 - NOTE: if it does not work, use the old code above
 -}
combinePt :: (Num a) => [[Vertex3 a]] -> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 a)]]
combinePt m cx = map (zip (join $ repeat cx)) $ la m 
  where
    la lv = map (\(a:b:_) -> join $ zipWith (\a b -> [a, b]) a b) $ listSlide lv 2 
--}    

drawParamSphere::Fx -> Fy -> Fz -> Int -> [Color3 GLdouble]-> IO ()
drawParamSphere :: Fx -> Fx -> Fx -> Int -> [Color3 GLdouble] -> IO ()
drawParamSphere Fx
fx Fx
fy Fx
fz Int
n [Color3 GLdouble]
cc = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let cl :: [Color3 GLdouble]
cl = [Color3 GLdouble]
cc
        let ss' :: [[Vertex3 GLfloat]]
ss' = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
ss
        let ax :: [[Vertex3 GLfloat]]
ax = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [a] -> [a]
init [[Vertex3 GLfloat]]
ss'
        let bx :: [[Vertex3 GLfloat]]
bx = [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [a] -> [a]
tail [[Vertex3 GLfloat]]
ss'
        let cx :: [[Vertex3 GLfloat]]
cx = [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]])
-> [[[Vertex3 GLfloat]]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> a -> b
$ (([Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]])
-> [[Vertex3 GLfloat]]
-> [[Vertex3 GLfloat]]
-> [[[Vertex3 GLfloat]]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (([Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]])
 -> [[Vertex3 GLfloat]]
 -> [[Vertex3 GLfloat]]
 -> [[[Vertex3 GLfloat]]])
-> ((Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
    -> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]])
-> (Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]]
-> [[Vertex3 GLfloat]]
-> [[[Vertex3 GLfloat]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex3 GLfloat -> Vertex3 GLfloat -> [Vertex3 GLfloat])
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat] -> [[Vertex3 GLfloat]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith) (\Vertex3 GLfloat
a Vertex3 GLfloat
b -> [Vertex3 GLfloat
a, Vertex3 GLfloat
b]) [[Vertex3 GLfloat]]
ax [[Vertex3 GLfloat]]
bx
        let cx' :: [[(Color3 GLdouble, Vertex3 GLfloat)]]
cx' = let c :: [[Color3 GLdouble]]
c = [Color3 GLdouble] -> [[Color3 GLdouble]]
forall a. a -> [a]
repeat [Color3 GLdouble
red, Color3 GLdouble
blue, Color3 GLdouble
cyan, Color3 GLdouble
yellow, Color3 GLdouble
gray, Color3 GLdouble
green] in (([Color3 GLdouble]
 -> [Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)])
-> [[Color3 GLdouble]]
-> [[Vertex3 GLfloat]]
-> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (([Color3 GLdouble]
  -> [Vertex3 GLfloat] -> [(Color3 GLdouble, Vertex3 GLfloat)])
 -> [[Color3 GLdouble]]
 -> [[Vertex3 GLfloat]]
 -> [[(Color3 GLdouble, Vertex3 GLfloat)]])
-> ((Color3 GLdouble
     -> Vertex3 GLfloat -> (Color3 GLdouble, Vertex3 GLfloat))
    -> [Color3 GLdouble]
    -> [Vertex3 GLfloat]
    -> [(Color3 GLdouble, Vertex3 GLfloat)])
-> (Color3 GLdouble
    -> Vertex3 GLfloat -> (Color3 GLdouble, Vertex3 GLfloat))
-> [[Color3 GLdouble]]
-> [[Vertex3 GLfloat]]
-> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Color3 GLdouble
 -> Vertex3 GLfloat -> (Color3 GLdouble, Vertex3 GLfloat))
-> [Color3 GLdouble]
-> [Vertex3 GLfloat]
-> [(Color3 GLdouble, Vertex3 GLfloat)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith) (,) [[Color3 GLdouble]]
c [[Vertex3 GLfloat]]
cx
        -- let mx = map (zip cl) $ hg ss
        let mx :: [[(Color3 GLdouble, Vertex3 GLfloat)]]
mx = [[Vertex3 GLfloat]]
-> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 GLfloat)]]
forall a.
Num a =>
[[Vertex3 a]]
-> [Color3 GLdouble] -> [[(Color3 GLdouble, Vertex3 a)]]
combinePt [[Vertex3 GLfloat]]
ss [Color3 GLdouble]
cl
        
        [Char]
mxx <- (IO () -> IO [Char]
forall a. IO a -> IO [Char]
cap (IO () -> IO [Char])
-> ([[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ())
-> [[(Color3 GLdouble, Vertex3 GLfloat)]]
-> IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ()
forall a. Show a => [[a]] -> IO ()
printMat) [[(Color3 GLdouble, Vertex3 GLfloat)]]
mx
        [[Char]] -> IO ()
logFileG [[Char]
"mxx22"]
        [[Char]] -> IO ()
logFileG [[Char]
mxx]
        
        ((Integer, [Vertex3 GLfloat]) -> IO ())
-> [(Integer, [Vertex3 GLfloat])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Integer
n, [Vertex3 GLfloat]
v) -> do
                  Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo (Integer -> Bool
forall a. Integral a => a -> Bool
odd Integer
n Bool -> Color3 GLdouble -> Color3 GLdouble -> Color3 GLdouble
forall a. Bool -> a -> a -> a
? Color3 GLdouble
red (Color3 GLdouble -> Color3 GLdouble)
-> Color3 GLdouble -> Color3 GLdouble
forall a b. (a -> b) -> a -> b
$ Color3 GLdouble
white) [Vertex3 GLfloat]
v
              ) ([(Integer, [Vertex3 GLfloat])] -> IO ())
-> [(Integer, [Vertex3 GLfloat])] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Integer] -> [[Vertex3 GLfloat]] -> [(Integer, [Vertex3 GLfloat])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [[Vertex3 GLfloat]]
ss
        ([(Color3 GLdouble, Vertex3 GLfloat)] -> IO ())
-> [[(Color3 GLdouble, Vertex3 GLfloat)]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[(Color3 GLdouble, Vertex3 GLfloat)]
row -> do
                  PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
TriangleStrip (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ((Color3 GLdouble, Vertex3 GLfloat) -> IO ())
-> [(Color3 GLdouble, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Color3 GLdouble
c, Vertex3 GLfloat
v) -> do
                                                            Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color Color3 GLdouble
c
                                                            Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v
                                                            ) [(Color3 GLdouble, Vertex3 GLfloat)]
row
                  ) [[(Color3 GLdouble, Vertex3 GLfloat)]]
mx
      where
        ss :: [[Vertex3 GLfloat]]
ss = [[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j)
                       (Fx
fy Int
i Int
j)
                       (Fx
fz Int
i Int
j) | Int
i <- [Int
0..Int
n]] | Int
j <- let m :: Int
m = Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
n Int
2 in [-Int
m, -Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
m]]

{--
{-|
 
  === KEY: draw partial sphere 

  DATE: Sun 17 Mar 01:23:49 2024 
  latitude
  longitude

  NOTE: take k latitude from the North

    @
    [
    [

      -- Singular pts
      Vertex3 (-1.7484556e-8) (-0.0) 0.4)
      Vertex3 (-1.4145303e-8) (-1.0277164e-8) 0.4),

      (Color3 0.0 1.0 0.0,Vertex3 (-1.7484556e-8) (-0.0) 0.4),       <----
      (Color3 0.0 0.0 1.0,Vertex3 0.12360679 0.0 0.38042262),
      (Color3 0.0 1.0 1.0,Vertex3 (-1.4145303e-8) (-1.0277164e-8) 0.4), <----
      (Color3 1.0 0.0 1.0,Vertex3 9.9999994e-2 7.265425e-2 0.38042262)
    ]
    ]

    -- NOTE: North pole is singular pt
    let lxx = [[
                {--
                [
                  (Color3 0.0 1.0 0.0,Vertex3 (-1.7484556e-8) (-0.0) 0.4),
                  (Color3 0.0 0.0 1.0,Vertex3 0.12360679 0.0 0.38042262),
                  (Color3 0.0 1.0 1.0,Vertex3 (-1.4145303e-8) (-1.0277164e-8) 0.4)
                ]
                --}
                [
                  (Color3 0.0 0.0 1.0,Vertex3 0.12360679 0.0 0.38042262),
                  (Color3 0.0 1.0 1.0,Vertex3 (-1.4145303e-8) (-1.0277164e-8) 0.4),
                  (Color3 1.0 0.0 1.0,Vertex3 9.9999994e-2 7.265425e-2 0.38042262)
                ]
              ]] :: [[[(Color3 GLdouble, Vertex3 GLdouble)]]]



                                               k latitude
                                                |
    drawParamSphereX::Fx -> Fy -> Fz -> Int -> Int -> [Color3 GLdouble]-> IO ()
    drawParamSphereX fx fy fz n k cc = do


    [[v 0, v 1], [v2, v3]]
      v 2, v 3
    @
 -}
drawParamSphereX::Bool -> [[Vertex3 GLdouble]] -> [Color3 GLdouble]-> IO ()
drawParamSphereX isFilled ss cc = do
  preservingMatrix $ do
        let mx = combinePt ss cc 
        when False $ do
          mapM_ (\(k, v) -> drawSegmentFromToD (odd k ? red $ white) v
                ) $ zip [1..] ss
        when isFilled $ do       
          mapM_ (\row -> renderPrimitive TriangleStrip $ mapM_ (\(c, v) -> do
                                                              color c
                                                              vertex v
                                                              ) row
                    ) mx
        when True $ do       
          preservingMatrix $ do
            {--
            s <- (cap . print) mx
            writeFileList "/tmp/ee.hs" [s]
            --}
            -- translate (Vector3 0.0 0 0 :: Vector3 GLdouble)
            
            (mapM_ . mapM_) (\tr -> do 
                                    renderPrimitive TriangleStrip $ mapM_ (\(c, v) -> do
                                                                          color c 
                                                                          vertex v
                                                                        ) tr
                             )  $ map (\x -> listSlide x 3) mx 
            
            -- xxx
            let p0 = Vertex3 0 0 0.4
            let p1 = Vertex3 0.1 0.1 0.319
            let xs = (map . map) (\((_, a):(_, b):(_,c):_) -> 
                                    case intersectLineTri (p0, p1) (a, b, c) of
                                          Just t -> ptInsideTri t (a, b, c)
                                          Nothing -> (False, -1) 
                                 ) $ map (\x -> listSlide x 3) mx 

            let lc = circlePtD (Vertex3 0.7 0.7 0) 0.2 10
            renderPrimitive LineLoop $ mapM_(\v -> do
                      color red 
                      vertex v
                  ) lc

            (mapM_ . mapM_) (\((_, a):(_, b):(_,c):_) -> do 
                          mapM_(\px -> do
                            case intersectLineTri (p0, px) (a, b, c) of
                                  Just t -> do 
                                    let (isIn, _) = ptInsideTri t (a, b, c)
                                    if isIn then do
                                      logFileGT "xx_yes" [show t]
                                      drawCubeQuadX t 0.002
                                      {--
                                      renderPrimitive Points $ mapM_(\v ->do 
                                            color yellow 
                                            vertex v
                                        ) [t]
                                      --}
                                    else return ()

                                  Nothing -> return () 
                                ) lc
                       ) $ map (\x -> listSlide x 3) mx 
--}

drawCubeQuadX :: Vertex3 GLdouble-> GLdouble -> IO ()
drawCubeQuadX :: Vertex3 GLdouble -> GLdouble -> IO ()
drawCubeQuadX Vertex3 GLdouble
px GLdouble
r = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (Vertex3 GLdouble -> Vector3 GLdouble
forall a. (Fractional a, Eq a) => Vertex3 a -> Vector3 a
vec_ Vertex3 GLdouble
px) 
    GLdouble -> IO ()
drawCubeQuadD GLdouble
r

drawCubeQuadT :: (GLdouble, Vertex3 GLdouble) -> IO ()
drawCubeQuadT :: (GLdouble, Vertex3 GLdouble) -> IO ()
drawCubeQuadT (GLdouble
r, Vertex3 GLdouble
p0) = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Vector3 GLdouble -> IO ()
forall c. MatrixComponent c => Vector3 c -> IO ()
translate (Vertex3 GLdouble -> Vector3 GLdouble
forall a. (Fractional a, Eq a) => Vertex3 a -> Vector3 a
vec_ Vertex3 GLdouble
p0) 
    GLdouble -> IO ()
drawCubeQuadD GLdouble
r

{-|
-- |
-- -
--  KEY: draw cube with quad
--  @
--  @
-}
drawCubeQuad :: GLfloat -> IO ()
drawCubeQuad :: GLfloat -> IO ()
drawCubeQuad GLfloat
r =
  let nfaces :: [(Normal3 GLfloat, (Color3 GLdouble, Color3 GLdouble),
  [Vertex3 GLfloat])]
nfaces = [Normal3 GLfloat]
-> [(Color3 GLdouble, Color3 GLdouble)]
-> [[Vertex3 GLfloat]]
-> [(Normal3 GLfloat, (Color3 GLdouble, Color3 GLdouble),
     [Vertex3 GLfloat])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Normal3 GLfloat]
n [(Color3 GLdouble
green, Color3 GLdouble
gray), (Color3 GLdouble
cyan, Color3 GLdouble
blue), (Color3 GLdouble
yellow, Color3 GLdouble
green), (Color3 GLdouble
gray, Color3 GLdouble
blue), (Color3 GLdouble
white, Color3 GLdouble
yellow), (Color3 GLdouble
blue, Color3 GLdouble
cyan)] [[Vertex3 GLfloat]]
facesx
   in do
        ((Normal3 GLfloat, (Color3 GLdouble, Color3 GLdouble),
  [Vertex3 GLfloat])
 -> IO ())
-> [(Normal3 GLfloat, (Color3 GLdouble, Color3 GLdouble),
     [Vertex3 GLfloat])]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
          ( \(Normal3 GLfloat
n, (Color3 GLdouble
c1, Color3 GLdouble
c2), [Vertex3 GLfloat
v0, Vertex3 GLfloat
v1, Vertex3 GLfloat
v2, Vertex3 GLfloat
v3]) -> do
              PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Quads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Normal3 GLfloat -> IO ()
forall a. Normal a => a -> IO ()
normal Normal3 GLfloat
n
                Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  Color3 GLdouble
c1 
                Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v0
                Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  Color3 GLdouble
c2 
                Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v1
                Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v2
                Vertex3 GLfloat -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLfloat
v3
          )
          [(Normal3 GLfloat, (Color3 GLdouble, Color3 GLdouble),
  [Vertex3 GLfloat])]
nfaces
  where
    n :: [Normal3 GLfloat]
    n :: [Normal3 GLfloat]
n =
      [ GLfloat -> GLfloat -> GLfloat -> Normal3 GLfloat
forall a. a -> a -> a -> Normal3 a
Normal3 (-GLfloat
1.0) GLfloat
0.0 GLfloat
0.0,
        GLfloat -> GLfloat -> GLfloat -> Normal3 GLfloat
forall a. a -> a -> a -> Normal3 a
Normal3 GLfloat
0.0 GLfloat
1.0 GLfloat
0.0,
        GLfloat -> GLfloat -> GLfloat -> Normal3 GLfloat
forall a. a -> a -> a -> Normal3 a
Normal3 GLfloat
1.0 GLfloat
0.0 GLfloat
0.0,
        GLfloat -> GLfloat -> GLfloat -> Normal3 GLfloat
forall a. a -> a -> a -> Normal3 a
Normal3 GLfloat
0.0 (-GLfloat
1.0) GLfloat
0.0,
        GLfloat -> GLfloat -> GLfloat -> Normal3 GLfloat
forall a. a -> a -> a -> Normal3 a
Normal3 GLfloat
0.0 GLfloat
0.0 GLfloat
1.0,
        GLfloat -> GLfloat -> GLfloat -> Normal3 GLfloat
forall a. a -> a -> a -> Normal3 a
Normal3 GLfloat
0.0 GLfloat
0.0 (-GLfloat
1.0)
      ]
    faces :: [[Vertex3 GLfloat]]
    faces :: [[Vertex3 GLfloat]]
faces =
      [ [ Int -> Vertex3 GLfloat
v Int
0, Int -> Vertex3 GLfloat
v Int
1, Int -> Vertex3 GLfloat
v Int
2, Int -> Vertex3 GLfloat
v Int
3],
        [ Int -> Vertex3 GLfloat
v Int
3, Int -> Vertex3 GLfloat
v Int
2, Int -> Vertex3 GLfloat
v Int
6, Int -> Vertex3 GLfloat
v Int
7],
        [ Int -> Vertex3 GLfloat
v Int
7, Int -> Vertex3 GLfloat
v Int
6, Int -> Vertex3 GLfloat
v Int
5, Int -> Vertex3 GLfloat
v Int
4],
        [ Int -> Vertex3 GLfloat
v Int
4, Int -> Vertex3 GLfloat
v Int
5, Int -> Vertex3 GLfloat
v Int
1, Int -> Vertex3 GLfloat
v Int
0],
        [ Int -> Vertex3 GLfloat
v Int
5, Int -> Vertex3 GLfloat
v Int
6, Int -> Vertex3 GLfloat
v Int
2, Int -> Vertex3 GLfloat
v Int
1],
        [ Int -> Vertex3 GLfloat
v Int
7, Int -> Vertex3 GLfloat
v Int
4, Int -> Vertex3 GLfloat
v Int
0, Int -> Vertex3 GLfloat
v Int
3]
      ]
    v :: Int -> Vertex3 GLfloat
    v :: Int -> Vertex3 GLfloat
v Int
x = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
v0 GLfloat
v1 GLfloat
v2
      where
        v0 :: GLfloat
v0
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = - GLfloat
r
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = GLfloat
r
        v1 :: GLfloat
v1
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = - GLfloat
r
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = GLfloat
r
        v2 :: GLfloat
v2
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = GLfloat
r
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = - GLfloat
r
    facesx :: [[Vertex3 GLfloat]]
    facesx :: [[Vertex3 GLfloat]]
facesx =
      [ [Vertex3 GLfloat
v0, Vertex3 GLfloat
v1, Vertex3 GLfloat
v2, Vertex3 GLfloat
v3],
        [Vertex3 GLfloat
v3, Vertex3 GLfloat
v2, Vertex3 GLfloat
v6, Vertex3 GLfloat
v7],
        [Vertex3 GLfloat
v7, Vertex3 GLfloat
v6, Vertex3 GLfloat
v5, Vertex3 GLfloat
v4],
        [Vertex3 GLfloat
v4, Vertex3 GLfloat
v5, Vertex3 GLfloat
v1, Vertex3 GLfloat
v0],
        [Vertex3 GLfloat
v5, Vertex3 GLfloat
v6, Vertex3 GLfloat
v2, Vertex3 GLfloat
v1],
        [Vertex3 GLfloat
v7, Vertex3 GLfloat
v4, Vertex3 GLfloat
v0, Vertex3 GLfloat
v3]
      ]
    v0 :: Vertex3 GLfloat
v0 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
r) (- GLfloat
r) GLfloat
r
    v1 :: Vertex3 GLfloat
v1 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
r) (- GLfloat
r) (- GLfloat
r)
    v2 :: Vertex3 GLfloat
v2 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
r) GLfloat
r (- GLfloat
r)
    v3 :: Vertex3 GLfloat
v3 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLfloat
r) GLfloat
r GLfloat
r
    v4 :: Vertex3 GLfloat
v4 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
r (- GLfloat
r) GLfloat
r
    v5 :: Vertex3 GLfloat
v5 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
r (- GLfloat
r) (- GLfloat
r)
    v6 :: Vertex3 GLfloat
v6 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
r GLfloat
r (- GLfloat
r)
    v7 :: Vertex3 GLfloat
v7 = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
r GLfloat
r GLfloat
r

drawCubeQuadD :: GLdouble -> IO ()
drawCubeQuadD :: GLdouble -> IO ()
drawCubeQuadD GLdouble
r =
  let nfaces :: [(Normal3 GLdouble, (Color3 GLdouble, Color3 GLdouble),
  [Vertex3 GLdouble])]
nfaces = [Normal3 GLdouble]
-> [(Color3 GLdouble, Color3 GLdouble)]
-> [[Vertex3 GLdouble]]
-> [(Normal3 GLdouble, (Color3 GLdouble, Color3 GLdouble),
     [Vertex3 GLdouble])]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Normal3 GLdouble]
n [(Color3 GLdouble
green, Color3 GLdouble
gray), (Color3 GLdouble
cyan, Color3 GLdouble
blue), (Color3 GLdouble
yellow, Color3 GLdouble
green), (Color3 GLdouble
gray, Color3 GLdouble
blue), (Color3 GLdouble
white, Color3 GLdouble
yellow), (Color3 GLdouble
blue, Color3 GLdouble
cyan)] [[Vertex3 GLdouble]]
facesx
   in do
        ((Normal3 GLdouble, (Color3 GLdouble, Color3 GLdouble),
  [Vertex3 GLdouble])
 -> IO ())
-> [(Normal3 GLdouble, (Color3 GLdouble, Color3 GLdouble),
     [Vertex3 GLdouble])]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
          ( \(Normal3 GLdouble
n, (Color3 GLdouble
c1, Color3 GLdouble
c2), [Vertex3 GLdouble
v0, Vertex3 GLdouble
v1, Vertex3 GLdouble
v2, Vertex3 GLdouble
v3]) -> do
              PrimitiveMode -> IO () -> IO ()
forall a. PrimitiveMode -> IO a -> IO a
renderPrimitive PrimitiveMode
Quads (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Normal3 GLdouble -> IO ()
forall a. Normal a => a -> IO ()
normal Normal3 GLdouble
n
                Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  Color3 GLdouble
c1 
                Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v0
                Color3 GLdouble -> IO ()
forall a. Color a => a -> IO ()
color  Color3 GLdouble
c2 
                Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v1
                Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v2
                Vertex3 GLdouble -> IO ()
forall a. Vertex a => a -> IO ()
vertex Vertex3 GLdouble
v3
          )
          [(Normal3 GLdouble, (Color3 GLdouble, Color3 GLdouble),
  [Vertex3 GLdouble])]
nfaces
  where
    n :: [Normal3 GLdouble]
    n :: [Normal3 GLdouble]
n =
      [ GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
forall a. a -> a -> a -> Normal3 a
Normal3 (-GLdouble
1.0) GLdouble
0.0 GLdouble
0.0,
        GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
forall a. a -> a -> a -> Normal3 a
Normal3 GLdouble
0.0 GLdouble
1.0 GLdouble
0.0,
        GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
forall a. a -> a -> a -> Normal3 a
Normal3 GLdouble
1.0 GLdouble
0.0 GLdouble
0.0,
        GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
forall a. a -> a -> a -> Normal3 a
Normal3 GLdouble
0.0 (-GLdouble
1.0) GLdouble
0.0,
        GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
forall a. a -> a -> a -> Normal3 a
Normal3 GLdouble
0.0 GLdouble
0.0 GLdouble
1.0,
        GLdouble -> GLdouble -> GLdouble -> Normal3 GLdouble
forall a. a -> a -> a -> Normal3 a
Normal3 GLdouble
0.0 GLdouble
0.0 (-GLdouble
1.0)
      ]
    faces :: [[Vertex3 GLdouble]]
    faces :: [[Vertex3 GLdouble]]
faces =
      [ [ Int -> Vertex3 GLdouble
v Int
0, Int -> Vertex3 GLdouble
v Int
1, Int -> Vertex3 GLdouble
v Int
2, Int -> Vertex3 GLdouble
v Int
3],
        [ Int -> Vertex3 GLdouble
v Int
3, Int -> Vertex3 GLdouble
v Int
2, Int -> Vertex3 GLdouble
v Int
6, Int -> Vertex3 GLdouble
v Int
7],
        [ Int -> Vertex3 GLdouble
v Int
7, Int -> Vertex3 GLdouble
v Int
6, Int -> Vertex3 GLdouble
v Int
5, Int -> Vertex3 GLdouble
v Int
4],
        [ Int -> Vertex3 GLdouble
v Int
4, Int -> Vertex3 GLdouble
v Int
5, Int -> Vertex3 GLdouble
v Int
1, Int -> Vertex3 GLdouble
v Int
0],
        [ Int -> Vertex3 GLdouble
v Int
5, Int -> Vertex3 GLdouble
v Int
6, Int -> Vertex3 GLdouble
v Int
2, Int -> Vertex3 GLdouble
v Int
1],
        [ Int -> Vertex3 GLdouble
v Int
7, Int -> Vertex3 GLdouble
v Int
4, Int -> Vertex3 GLdouble
v Int
0, Int -> Vertex3 GLdouble
v Int
3]
      ]
    v :: Int -> Vertex3 GLdouble
    v :: Int -> Vertex3 GLdouble
v Int
x = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
v0 GLdouble
v1 GLdouble
v2
      where
        v0 :: GLdouble
v0
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 = - GLdouble
r
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = GLdouble
r
        v1 :: GLdouble
v1
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = - GLdouble
r
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = GLdouble
r
        v2 :: GLdouble
v2
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = GLdouble
r
          | Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = - GLdouble
r
    facesx :: [[Vertex3 GLdouble]]
    facesx :: [[Vertex3 GLdouble]]
facesx =
      [ [Vertex3 GLdouble
v0, Vertex3 GLdouble
v1, Vertex3 GLdouble
v2, Vertex3 GLdouble
v3],
        [Vertex3 GLdouble
v3, Vertex3 GLdouble
v2, Vertex3 GLdouble
v6, Vertex3 GLdouble
v7],
        [Vertex3 GLdouble
v7, Vertex3 GLdouble
v6, Vertex3 GLdouble
v5, Vertex3 GLdouble
v4],
        [Vertex3 GLdouble
v4, Vertex3 GLdouble
v5, Vertex3 GLdouble
v1, Vertex3 GLdouble
v0],
        [Vertex3 GLdouble
v5, Vertex3 GLdouble
v6, Vertex3 GLdouble
v2, Vertex3 GLdouble
v1],
        [Vertex3 GLdouble
v7, Vertex3 GLdouble
v4, Vertex3 GLdouble
v0, Vertex3 GLdouble
v3]
      ]
    v0 :: Vertex3 GLdouble
v0 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLdouble
r) (- GLdouble
r) GLdouble
r
    v1 :: Vertex3 GLdouble
v1 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLdouble
r) (- GLdouble
r) (- GLdouble
r)
    v2 :: Vertex3 GLdouble
v2 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLdouble
r) GLdouble
r (- GLdouble
r)
    v3 :: Vertex3 GLdouble
v3 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 (- GLdouble
r) GLdouble
r GLdouble
r
    v4 :: Vertex3 GLdouble
v4 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
r (- GLdouble
r) GLdouble
r
    v5 :: Vertex3 GLdouble
v5 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
r (- GLdouble
r) (- GLdouble
r)
    v6 :: Vertex3 GLdouble
v6 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
r GLdouble
r (- GLdouble
r)
    v7 :: Vertex3 GLdouble
v7 = GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
r GLdouble
r GLdouble
r

{-|

   'drawParamSurfaceN'
   [1..n]

   'drawParamSurfaceN_new'
   [(-n)..n]
-}
drawParamSurfaceN_new::Fx -> Fy -> Fz -> Int -> IO ()
drawParamSurfaceN_new :: Fx -> Fx -> Fx -> Int -> IO ()
drawParamSurfaceN_new Fx
fx Fx
fy Fx
fz Int
n = do
  IO () -> IO ()
forall a. IO a -> IO a
preservingMatrix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let u :: GLdouble
u = GLdouble
0.0
        -- translate (Vector3 u u 0 :: Vector3 GLdouble)
        ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red) [[Vertex3 GLfloat]]
ss
        ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
blue) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
ss
      where
        ss :: [[Vertex3 GLfloat]]
ss = [[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j)
                       (Fx
fy Int
i Int
j)
                       (Fx
fz Int
i Int
j) | Int
i <- [(-Int
n)..Int
n]] | Int
j <- [(-Int
n)..Int
n]]    

{-|
    === KEY: generate parametric surface points
    @
    type Fx = Int -> Int -> GLfloat
    type Fy = Int -> Int -> GLfloat
    type Fz = Int -> Int -> GLfloat
    @
-}
geneParamSurface::Fx -> Fy -> Fz -> Int -> [[Vertex3 GLfloat]]
geneParamSurface :: Fx -> Fx -> Fx -> Int -> [[Vertex3 GLfloat]]
geneParamSurface Fx
fx Fx
fy Fx
fz Int
n = [[GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 (Fx
fx Int
i Int
j)
                                        (Fx
fy Int
i Int
j)
                                        (Fx
fz Int
i Int
j) | Int
i <- [Int
1..Int
n]] | Int
j <- [Int
1..Int
n]]

{-|
    === KEY: draw surface from list of [Vertex3 GLfloat]
-}
drawSurfaceFromList::[[Vertex3 GLfloat]] -> IO()
drawSurfaceFromList :: [[Vertex3 GLfloat]] -> IO ()
drawSurfaceFromList [[Vertex3 GLfloat]]
cx = do
  ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
row -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
red [Vertex3 GLfloat]
row) [[Vertex3 GLfloat]]
cx
  ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
row -> Color3 GLdouble -> [Vertex3 GLfloat] -> IO ()
drawSegmentFromTo Color3 GLdouble
blue [Vertex3 GLfloat]
row) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
cx

{-| 
    === grid 2d with ratio: 

    >r = 1  => 1/(r*n) => 1/n
    >r = 2  => 1/(2*n) 
-} 
grid2Ratio::(GLfloat -> GLfloat -> GLfloat) -> GLfloat -> [[Vertex3 GLfloat]]
grid2Ratio :: (GLfloat -> GLfloat -> GLfloat) -> GLfloat -> [[Vertex3 GLfloat]]
grid2Ratio GLfloat -> GLfloat -> GLfloat
f GLfloat
r =[[ GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y (GLfloat -> GLfloat -> GLfloat
f GLfloat
x GLfloat
y) | GLfloat
x <- [GLfloat]
aa] | GLfloat
y <- [GLfloat]
bb]
        where 
            n :: GLfloat
n  = GLfloat
10 
            fa :: GLfloat
fa = GLfloat
1GLfloat -> GLfloat -> GLfloat
forall a. Fractional a => a -> a -> a
/(GLfloat
rGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
n)
            aa :: [GLfloat]
aa = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
fa GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
x) [-GLfloat
n..GLfloat
n]
            bb :: [GLfloat]
bb = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map(\GLfloat
x -> GLfloat
fa GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
* GLfloat
x) [-GLfloat
n..GLfloat
n]

{-| 
    === KEY: list to 'Vertex3', list to Vertex3

    >[1, 2, 3] => (1, 2, 3)
-} 
list3ToVertex3::(Show a)=>[a] -> Vertex3 a  -- [1, 2, 3] => (1, 2, 3)
list3ToVertex3 :: [a] -> Vertex3 a
list3ToVertex3 [a
a, a
b, a
c] = a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
a a
b a
c
list3ToVertex3 [a]
cx         = [Char] -> Vertex3 a
forall a. HasCallStack => [Char] -> a
error ([Char] -> Vertex3 a) -> [Char] -> Vertex3 a
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid List" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([a] -> [Char]
forall a. Show a => a -> [Char]
show [a]
cx)
                           
{-| 
    === 'Vertex3' to list

    >(1, 2, 3) => [1, 2, 3]
-} 
vertex3ToList::Vertex3 a -> [a]  -- (1, 2, 3) => [1, 2, 3]
vertex3ToList :: Vertex3 a -> [a]
vertex3ToList (Vertex3 a
a a
b a
c) = [a
a, a
b, a
c]

{-|
    === KEY: read file to load geometry(ies), read script

    1. "--" will be ignored
    2. Emtpy line will be ignored

    Support following geometries so far

    @
      point
      0.1 0.1 0
      0.2 0.2 0
      0.3 0.3 0
      endpoint

      segment
      0.1 0.1 0.1
      0.2 0.2 0.2
      0.3 0.3 0.3
      0.4 0.4 0.4
      endsegment

      triangle
      0.1 0.1 0.1
      0.2 0.2 0.2
      0.3 0.3 0.3
      0.4 0.4 0.4
      0.5 5.5 0.5
      0.6 0.6 0.6
      endtriangle
    @
-}
readGLScript::FilePath -> IO [String]
readGLScript :: [Char] -> IO [[Char]]
readGLScript [Char]
fp = [Char] -> IO Bool
fExist [Char]
fp IO Bool -> (Bool -> IO [[Char]]) -> IO [[Char]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> if Bool
x then [Char] -> IO [[Char]]
readFileList [Char]
fp IO [[Char]] -> ([[Char]] -> IO [[Char]]) -> IO [[Char]]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[[Char]]
ls -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter(\[Char]
x -> let f :: Bool
f = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Bool
hasPrefix [Char]
"--" [Char]
x
                                                                                                     g :: Bool
g = ([Char] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([Char] -> Integer) -> ShowS -> [Char] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) [Char]
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
                                                                                                 in  Bool
f Bool -> Bool -> Bool
&& Bool
g) [[Char]]
ls
                                      else [[Char]] -> IO [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
{-|
    === string to vector3
-}
strToVector3::String -> Vector3 GLdouble
strToVector3 :: [Char] -> Vector3 GLdouble
strToVector3 [Char]
str = Vector3 GLdouble
vec
  where
    s :: [[Char]]
s = [Char] -> [[Char]]
splitSPC [Char]
str
    vec :: Vector3 GLdouble
vec = if [[Char]] -> Int
forall a. [a] -> Int
ρ [[Char]]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then let a :: GLdouble
a = [Char] -> GLdouble
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
0)::GLdouble
                               b :: GLdouble
b = [Char] -> GLdouble
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
1)::GLdouble
                               c :: GLdouble
c = [Char] -> GLdouble
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
2)::GLdouble
                               (!) = [a] -> Int -> a
forall a. [a] -> Int -> a
(!!)
                           in GLdouble -> GLdouble -> GLdouble -> Vector3 GLdouble
forall a. a -> a -> a -> Vector3 a
Vector3 GLdouble
a GLdouble
b GLdouble
c
          else [Char] -> Vector3 GLdouble
forall a. HasCallStack => [Char] -> a
error ([Char] -> Vector3 GLdouble) -> [Char] -> Vector3 GLdouble
forall a b. (a -> b) -> a -> b
$ [Char]
"Error2: String should contain three GLfloat. str=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
" s=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
s)
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)                         

{-|
    === KEY: str to triple, string to triple

    @
    String to ('GLfloat', 'GLfloat', 'GLfloat')
    @
-}
strToTriple::String -> (GLfloat, GLfloat, GLfloat)
strToTriple :: [Char] -> (GLfloat, GLfloat, GLfloat)
strToTriple [Char]
str = (GLfloat, GLfloat, GLfloat)
tri
  where
    s :: [[Char]]
s = [Char] -> [[Char]]
splitSPC [Char]
str
    tri :: (GLfloat, GLfloat, GLfloat)
tri = if ([[Char]] -> Int
forall a. [a] -> Int
ρ [[Char]]
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then let a :: GLfloat
a = [Char] -> GLfloat
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
0)::GLfloat
                                 b :: GLfloat
b = [Char] -> GLfloat
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
1)::GLfloat
                                 c :: GLfloat
c = [Char] -> GLfloat
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
2)::GLfloat
                                 (!) = [a] -> Int -> a
forall a. [a] -> Int -> a
(!!)
                             in (GLfloat
a, GLfloat
b, GLfloat
c)
          else [Char] -> (GLfloat, GLfloat, GLfloat)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (GLfloat, GLfloat, GLfloat))
-> [Char] -> (GLfloat, GLfloat, GLfloat)
forall a b. (a -> b) -> a -> b
$ [Char]
"Error1: String should contain three GLfloat. str=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
" s=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
s)
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
    
{-|
    === KEY: 
-}
vertex3ToTriple::Vertex3 GLfloat -> (GLfloat, GLfloat, GLfloat)
vertex3ToTriple :: Vertex3 GLfloat -> (GLfloat, GLfloat, GLfloat)
vertex3ToTriple (Vertex3 GLfloat
a GLfloat
b GLfloat
c) = (GLfloat
a, GLfloat
b, GLfloat
c)
                                  
{-|
    === KEY: 
-}
tripleToVertex3::(GLfloat, GLfloat, GLfloat) -> Vertex3 GLfloat
tripleToVertex3 :: (GLfloat, GLfloat, GLfloat) -> Vertex3 GLfloat
tripleToVertex3 (GLfloat
a, GLfloat
b, GLfloat
c) = GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
a GLfloat
b GLfloat
c
                            
{-|
    === KEY: 
-}    
strToVertex3::String -> Vertex3 GLfloat
strToVertex3 :: [Char] -> Vertex3 GLfloat
strToVertex3 [Char]
str = Vertex3 GLfloat
vex
  where
    s :: [[Char]]
s = [Char] -> [[Char]]
splitSPC [Char]
str
    vex :: Vertex3 GLfloat
vex = if [[Char]] -> Int
forall a. [a] -> Int
ρ [[Char]]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then let a :: GLfloat
a = [Char] -> GLfloat
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
0)::GLfloat
                               b :: GLfloat
b = [Char] -> GLfloat
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
1)::GLfloat
                               c :: GLfloat
c = [Char] -> GLfloat
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
2)::GLfloat
                               (!) = [a] -> Int -> a
forall a. [a] -> Int -> a
(!!)
                           in GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
a GLfloat
b GLfloat
c
          else [Char] -> Vertex3 GLfloat
forall a. HasCallStack => [Char] -> a
error ([Char] -> Vertex3 GLfloat) -> [Char] -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ [Char]
"Error2: String should contain three GLfloat. str=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
" s=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
s)
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
    
{-|
    === KEY: 
-}    
strToVertex3'::String -> Vertex3 GLdouble
strToVertex3' :: [Char] -> Vertex3 GLdouble
strToVertex3' [Char]
str = Vertex3 GLdouble
vex
  where
    s :: [[Char]]
s = [Char] -> [[Char]]
splitSPC [Char]
str
    vex :: Vertex3 GLdouble
vex = if [[Char]] -> Int
forall a. [a] -> Int
ρ [[Char]]
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3 then let a :: GLdouble
a = [Char] -> GLdouble
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
0)::GLdouble
                               b :: GLdouble
b = [Char] -> GLdouble
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
1)::GLdouble
                               c :: GLdouble
c = [Char] -> GLdouble
forall a. Read a => [Char] -> a
read ([[Char]]
s [[Char]] -> Int -> [Char]
forall a. [a] -> Int -> a
! Int
2)::GLdouble
                               (!) = [a] -> Int -> a
forall a. [a] -> Int -> a
(!!)
                           in GLdouble -> GLdouble -> GLdouble -> Vertex3 GLdouble
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLdouble
a GLdouble
b GLdouble
c
          else [Char] -> Vertex3 GLdouble
forall a. HasCallStack => [Char] -> a
error ([Char] -> Vertex3 GLdouble) -> [Char] -> Vertex3 GLdouble
forall a b. (a -> b) -> a -> b
$ [Char]
"Error2: String should contain three GLfloat. str=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
str [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ [Char]
" s=" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
+ ([[Char]] -> [Char]
forall a. Show a => a -> [Char]
show [[Char]]
s)
    + :: [a] -> [a] -> [a]
(+) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
    
{-|
-}
takeVertex3::[String] -> [Vertex3 GLdouble]
takeVertex3 :: [[Char]] -> [Vertex3 GLdouble]
takeVertex3 [] = []
takeVertex3 [[Char]]
cx = [Vertex3 GLdouble]
xs
  where
    beg :: [Char]
beg = [Char]
"vertex3"
    end :: [Char]
end = [Char]
"endvertex3"
    ss :: [[Char]]
ss = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter(\[Char]
x -> ([Char] -> Integer
forall (t :: * -> *) b a. (Foldable t, Num b) => t a -> b
len ([Char] -> Integer) -> ShowS -> [Char] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
trim) [Char]
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [[Char]] -> [[Char]]
takeBetweenExc [Char]
beg [Char]
end [[Char]]
cx
    xs :: [Vertex3 GLdouble]
xs = ([Char] -> Vertex3 GLdouble) -> [[Char]] -> [Vertex3 GLdouble]
forall a b. (a -> b) -> [a] -> [b]
map(\[Char]
x -> [Char] -> Vertex3 GLdouble
strToVertex3' [Char]
x ) ([[Char]] -> [Vertex3 GLdouble]) -> [[Char]] -> [Vertex3 GLdouble]
forall a b. (a -> b) -> a -> b
$ ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
trim [[Char]]
ss

  
{-|
   === KEY: Draw complex function
   @
                    + Complex function, id => ([-1, 1], [-1, 1]) Grid
                    |
    drawComplex (\c -> c * c) 0.8
                               |
                               + -> Scale image, 1.0 => x = [-1, -1 + 0.1 .. 1]
                                                        y = [-1, -1 + 0.1 .. 1]
    
   @
-}
drawComplex :: (Complex GLfloat -> Complex GLfloat) -> GLfloat -> IO()
drawComplex :: (Complex GLfloat -> Complex GLfloat) -> GLfloat -> IO ()
drawComplex Complex GLfloat -> Complex GLfloat
f GLfloat
sc = do
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
False (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat] -> IO ()
drawConnect [Vertex3 GLfloat]
x) [[Vertex3 GLfloat]]
lx
        ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat] -> IO ()
drawConnect [Vertex3 GLfloat]
x) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
lx

      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
True (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat] -> IO ()
drawConnect [Vertex3 GLfloat]
x) [[Vertex3 GLfloat]]
lxc
        ([Vertex3 GLfloat] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Vertex3 GLfloat]
x -> [Vertex3 GLfloat] -> IO ()
drawConnect [Vertex3 GLfloat]
x) ([[Vertex3 GLfloat]] -> IO ()) -> [[Vertex3 GLfloat]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a. [[a]] -> [[a]]
tran [[Vertex3 GLfloat]]
lxc
  where
      cTov :: Complex a -> Vertex3 a
cTov Complex a
c = let x :: a
x = Complex a -> a
forall a. Complex a -> a
realPart Complex a
c; y :: a
y = Complex a -> a
forall a. Complex a -> a
imagPart Complex a
c in a -> a -> a -> Vertex3 a
forall a. a -> a -> a -> Vertex3 a
Vertex3 a
x a
y a
0
      vToc :: Vertex3 a -> Complex a
vToc (Vertex3 a
x a
y a
z) = a
x a -> a -> Complex a
forall a. a -> a -> Complex a
:+ a
y
      vs :: [GLfloat]
vs = (GLfloat -> GLfloat) -> [GLfloat] -> [GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map (\GLfloat
x -> GLfloat
scGLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
*GLfloat
x) [-GLfloat
1, -GLfloat
1 GLfloat -> GLfloat -> GLfloat
forall a. Num a => a -> a -> a
+ GLfloat
0.1 .. GLfloat
1]
      lx :: [[Vertex3 GLfloat]]
lx = (GLfloat -> GLfloat -> Vertex3 GLfloat)
-> [GLfloat] -> [GLfloat] -> [[Vertex3 GLfloat]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [[c]]
out(\GLfloat
x GLfloat
y -> GLfloat -> GLfloat -> GLfloat -> Vertex3 GLfloat
forall a. a -> a -> a -> Vertex3 a
Vertex3 GLfloat
x GLfloat
y GLfloat
0) [GLfloat]
vs [GLfloat]
vs
      lxc :: [[Vertex3 GLfloat]]
lxc = (([Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]]
forall a b. (a -> b) -> [a] -> [b]
map (([Vertex3 GLfloat] -> [Vertex3 GLfloat])
 -> [[Vertex3 GLfloat]] -> [[Vertex3 GLfloat]])
-> ((Vertex3 GLfloat -> Vertex3 GLfloat)
    -> [Vertex3 GLfloat] -> [Vertex3 GLfloat])
-> (Vertex3 GLfloat -> Vertex3 GLfloat)
-> [[Vertex3 GLfloat]]
-> [[Vertex3 GLfloat]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vertex3 GLfloat -> Vertex3 GLfloat)
-> [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a b. (a -> b) -> [a] -> [b]
map) (\Vertex3 GLfloat
x -> let c :: Complex GLfloat
c = Vertex3 GLfloat -> Complex GLfloat
forall a. Vertex3 a -> Complex a
vToc Vertex3 GLfloat
x in Complex GLfloat -> Vertex3 GLfloat
forall a. Num a => Complex a -> Vertex3 a
cTov (Complex GLfloat -> Vertex3 GLfloat)
-> Complex GLfloat -> Vertex3 GLfloat
forall a b. (a -> b) -> a -> b
$ Complex GLfloat -> Complex GLfloat
f Complex GLfloat
c) [[Vertex3 GLfloat]]
lx
      vv :: [Vertex3 GLfloat]
vv = [[Vertex3 GLfloat]] -> [Vertex3 GLfloat]
forall a. [a] -> a
head [[Vertex3 GLfloat]]
lx

      drawConnect :: [Vertex3 GLfloat] -> IO ()
drawConnect [Vertex3 GLfloat]
vv = ((Vertex3 GLfloat, Vertex3 GLfloat) -> IO ())
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Vertex3 GLfloat, Vertex3 GLfloat)
x -> Color3 GLdouble -> (Vertex3 GLfloat, Vertex3 GLfloat) -> IO ()
drawSegment Color3 GLdouble
green (Vertex3 GLfloat, Vertex3 GLfloat)
x) ([(Vertex3 GLfloat, Vertex3 GLfloat)] -> IO ())
-> [(Vertex3 GLfloat, Vertex3 GLfloat)] -> IO ()
forall a b. (a -> b) -> a -> b
$ let lt :: [Vertex3 GLfloat]
lt = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
init [Vertex3 GLfloat]
vv; lv :: [Vertex3 GLfloat]
lv = [Vertex3 GLfloat] -> [Vertex3 GLfloat]
forall a. [a] -> [a]
tail [Vertex3 GLfloat]
vv in [Vertex3 GLfloat]
-> [Vertex3 GLfloat] -> [(Vertex3 GLfloat, Vertex3 GLfloat)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vertex3 GLfloat]
lt [Vertex3 GLfloat]
lv