import Graphics.Rendering.OpenGL as OpenGL
import Graphics.UI.GLUT  as GLUT

import OrbitPointOfView 
import StateUtil

main = do
  (progName,_) <-  getArgsAndInitialize
  initialDisplayMode $= [WithDepthBuffer,DoubleBuffered]
  pPos <- new (90::Int,270::Int,1.0)	
  depthFunc $= Just Less
  createWindow progName

  lighting  $= Enabled
  normalize $= Enabled
  depthFunc $= Just Less

  position (Light 0) $= Vertex4 0 0 (10) 0
  ambient (Light 0) $= Color4 1 1 1 1
  diffuse (Light 0) $= Color4 1 1 1 1
  specular (Light 0) $= Color4 1 1 1 1
  light (Light 0) $= Enabled

  displayCallback $= display pPos
  keyboardMouseCallback $= Just (keyboard pPos)
  reshapeCallback $= Just reshape 
  mainLoop

keyboard pPos c _  _ _ = keyForPos pPos c
display pPos = do
  loadIdentity
  clearColor $= Color4 1 0 0 1
  setPointOfView pPos
  clear [ColorBuffer,DepthBuffer]
  tux
  swapBuffers
sphere r xs ys zs = do
  scal xs ys zs
  createSphere r

createSphere r = renderObject Solid $Sphere' r 50 50

scal:: GLfloat -> GLfloat -> GLfloat -> IO ()
scal x y z = scale x y z
transl:: GLfloat -> GLfloat -> GLfloat -> IO ()
transl x y z= translate$Vector3 x y z

rota:: GLfloat -> GLfloat -> GLfloat -> GLfloat -> IO ()
rota a x y z  = rotate a $ Vector3 x y z 

rotateZ a = rota a 0 0 1
rotateY a = rota a 0 1 0
rotateX a = rota a 1 0 0
crMat (rd,gd,bd) (rs,gs,bs) exp = do
  materialDiffuse   Front $= Color4 rd gd bd  1.0
  materialAmbient   Front $= Color4 rd gd bd  1.0
  materialSpecular  Front $= Color4 rs gs bs  1.0
  materialShininess Front $= exp

  materialDiffuse   Back $= Color4 rd gd bd  1.0
  materialSpecular  Back $= Color4 rs gs bs  1.0
  materialShininess Back $= exp

whitePenguin = crMat (0.58, 0.58, 0.58)(0.2, 0.2, 0.2) 50.0
blackPenguin = crMat (0.1, 0.1, 0.1)   (0.5, 0.5, 0.5) 20.0
beakColour   = crMat (0.64, 0.54, 0.06)(0.4, 0.4, 0.4) 5
nostrilColour= crMat (0.48039, 0.318627, 0.033725)(0.0,0.0,0.0) 1
irisColour   = crMat (0.01, 0.01, 0.01)(0.4, 0.4, 0.4) 90.0
makeBody = do
  preservingMatrix$do
    blackPenguin
    sphere 1 0.95 1.0 0.8
  preservingMatrix$do
    whitePenguin
    transl 0 0 0.17
    sphere 1 0.8 0.9 0.7
createTorso = preservingMatrix$do
  scal 0.9 0.9 0.9
  makeBody

createShoulders = preservingMatrix$do
  transl 0 0.4 0.05
  leftArm
  rightArm
  scal 0.72 0.72 0.72
  makeBody
createNeck = preservingMatrix$do
 transl 0 0.9 0.07
 createHead
 rotateY 90
 blackPenguin
 sphere 0.8 0.45 0.5 0.45
 transl 0 (-0.08) 0.35
 whitePenguin
 sphere 0.66 0.8 0.9 0.7

createHead = preservingMatrix$do
 transl 0 0.3 0.07
 createBeak
 createEyes
 rotateY 90
 blackPenguin
 sphere 1 0.42 0.5 0.42

createBeak = do
  preservingMatrix$do
    transl 0 (-0.205) 0.3
    rotateX 10
    beakColour
    sphere 0.8 0.23 0.12 0.4
  preservingMatrix$do
    beakColour
    transl 0 (-0.23) 0.3
    rotateX 10
    sphere 0.66 0.21 0.17 0.38
createEyes = preservingMatrix$do
  leftEye
  leftIris
  rightEye
  rightIris

leftEye = preservingMatrix$do
  transl 0.13 (-0.03) 0.38
  rotateY 18
  rotateZ 5
  rotateX 5
  whitePenguin
  sphere 0.66 0.1 0.13 0.03

rightEye = preservingMatrix$do
  transl (-0.13) (-0.03) 0.38
  rotateY (-18)
  rotateZ (-5)
  rotateX 5
  whitePenguin
  sphere 0.66 0.1 0.13 0.03

leftIris = preservingMatrix$do
  transl 0.12 (-0.045) 0.4
  rotateY 18
  rotateZ 5
  rotateX 5
  irisColour
  sphere 0.66 0.055 0.07 0.03

rightIris = preservingMatrix$do
  transl (-0.12) (-0.045) 0.4
  rotateY (-18)
  rotateZ (-5)
  rotateX 5
  irisColour
  sphere 0.66 0.055 0.07 0.03
leftArm = preservingMatrix$do
  rotateY 180
  transl (-0.56) 0.3 0
  rotateZ 45
  rotateX 90
  leftForeArm
  blackPenguin
  sphere 0.66 0.34 0.1 0.2

rightArm = preservingMatrix$do
  transl (-0.56) 0.3 0
  rotateZ 45
  rotateX(-90)
  rightForeArm
  blackPenguin
  sphere 0.66 0.34 0.1 0.2

leftForeArm = preservingMatrix$do
  transl (-0.23) 0 0
  rotateZ 20
  rotateX 90
  leftHand
  blackPenguin
  sphere 0.66 0.3 0.07 0.15

rightForeArm = leftForeArm

leftHand = preservingMatrix$do
  transl (-0.24) 0 0
  rotateZ 20
  rotateX 90
  blackPenguin
  sphere 0.5 0.12 0.05 0.12

leftTigh = preservingMatrix$do
  rotateY 180
  transl (-0.28) (-0.8) 0
  rotateY 110
  leftHipBall
  leftCalf

  rotateY (-110)
  transl 0 (-0.1) 0
  beakColour
  sphere 0.5 0.07 0.3 0.07

leftHipBall = preservingMatrix$do 
  blackPenguin
  sphere 0.5 0.09 0.18 0.09

rightTigh = preservingMatrix$do
  transl (-0.28) (-0.8) 0
  rotateY (-110)
  rightHipBall
  rightCalf

  transl 0 (-0.1) 0
  beakColour
  sphere 0.5 0.07 0.3 0.07

rightHipBall = preservingMatrix$do 
  blackPenguin
  sphere 0.5 0.09 0.18 0.09

leftCalf = preservingMatrix$do
 transl 0 (-0.21) 0
 rotateY 90
 leftFoot
 beakColour
 sphere 0.5 0.06 0.18 0.06

rightCalf = preservingMatrix$do
 transl 0 (-0.21) 0
 rightFoot
 beakColour
 sphere 0.5 0.06 0.18 0.06
foot = preservingMatrix$do
  scal  1.1 1.0 1.3 
  beakColour
  footBase
  toe1
  toe2
  toe3

footBase = preservingMatrix$do
  sphere 0.66 0.25 0.08 0.18

toe1 = preservingMatrix$do
  transl (-0.07) 0 0.1
  rotateY 30
  scal 0.27 0.07 0.11
  createSphere 0.66

toe2 = preservingMatrix$do
 transl (-0.07) 0 (-0.1)
 rotateY (-30)
 sphere 0.66  0.27 0.07 0.11

toe3 = preservingMatrix$do
  transl (-0.08) 0 0
  sphere 0.66  0.27 0.07 0.10

leftFoot = preservingMatrix$do
  transl 0 (-0.09) 0
  rotateY (100) 
  foot

rightFoot = preservingMatrix$do
  transl 0 (-0.09) 0
  rotateY 180
  foot
createTail = preservingMatrix$ do
  transl 0 (-0.4) (-0.5)
  rotateX (-60)
  transl 0 0.15 0
  blackPenguin
  sphere 0.5 0.2 0.3 0.1
tux = preservingMatrix$do
  scale 0.35 0.35 (0.35::GLfloat)
  rotateY (-180)
  rotateZ (-180)
  createTorso
  createShoulders
  createNeck
  leftTigh
  rightTigh
  createTail