packages feed

topkata-0.2: Topkata/Topka/Base.hs

module Topkata.Topka.Base where

import Graphics.UI.GLUT

data Textures = Textures {
      texTopkata, texGhost :: Maybe TextureObject
}

data Direction =
      North | East| South | West
    deriving (Enum, Eq, Show, Bounded)

epsilon = 0.1

drawSegment pm seg = do
    renderPrimitive pm $ do
      color (Color4 1 1 (1 :: GLdouble) 1)
      mapM_ nvertex seg


nvertex (t,v) = do
  --putStrLn $ show t
  texCoord t
  normal $ v2n  v
  vertex v

v2n (Vertex3 x y z) = Normal3 x y z

segment b1 b2 =
     merge (v b1) (v b2)
  where z1, z2 :: GLdouble
        z1 = cos b1
        z2 = cos b2
        v b  = [sphereVertex a b | a <-  [0.0, epsilon .. pi+epsilon]]

merge [] [] = []
merge (h1:t1) (h2:t2) = h1:h2:merge t1 t2


sphereVertex a b =
    (TexCoord2 (a/pi) (2*b/pi), Vertex3 (cos b * sin a) (sin a * sin b) (cos a))


ringSegment y1 y2 phase =
    concat $ [  [v a y1 (r1 a), v a y2 (r2 a)] |
              a <-  [0.0, 0.05 .. 2*pi+epsilon] ]
 where v a y r = (TexCoord2 0 (0 :: GLfloat), Vertex3 (r * sin a) y (r * cos a))
       p        = phase / 4.0
       pscale1    = - y1 / pi
       poffset1   = pscale1 * 0.2 
       pscale2    = - y2 / pi
       poffset2   = pscale2 * 0.2 
       r1 a       =  poffset1 + 1 + pscale1 * 0.2 * sin ((a+p)*6)
       r2 a       =  poffset2 + 1 + pscale2 * 0.2 * sin ((a+p)*6)


angleOfDirection dir =
   case dir of
     North -> 0
     East -> pi * 1.5
     South -> pi
     West -> pi / 2.0

rotCW :: Direction -> Direction
rotCCW :: Direction -> Direction
rotCW d | d == maxBound   =  minBound
rotCW d | otherwise      =  succ d
rotCCW d | d == minBound =  maxBound
rotCCW d | otherwise     = pred d

flipOrientation d =
    case d of
      North -> South
      South -> North
      East -> West
      West -> East