hOff-display-0.1.0.0: src-app/display.hs

{-
    This file is part of hOff-display.

    hOff-display is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    hOff-display is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Foobar.  If not, see <http://www.gnu.org/licenses/>.
-}

{-|
Module:       Main
Description:  Main file
Copyright:    (C) Johann Lee <me@qinka.pro>, 2017
License:      GPL-3
Maintainer:   me@qinka.pro
Stability:    experimental
Portability:  unknown

-}

module Main where

import HOff.Parser
import HOff.Display
import Control.Monad
import System.Environment
import Text.Parsec
import Graphics.Rendering.OpenGL as GL
import Graphics.UI.GLFW as GLFW
import Graphics.Rendering.OpenGL (($=))


main :: IO ()
main = do
  files <- getArgs
  mapM_ step files
  where step fp' = do
          let fpO = fp ++ ".off"
              fpP = fp ++ ".png"
              fp = real fp'
          str <- readFile fpO
          case runParser offP defParStat fpO str of
            Left  e -> print e
            Right o -> display $ normOFF o
        real str =
          let ext = takeWhile (/='.') $ reverse str
          in if ext == "ffo"
             then reverse $ dropWhile (=='.') $ dropWhile (/='.') $ reverse str
             else str



color3 :: GLfloat -> GLfloat -> GLfloat -> GL.Color3 GLfloat
color3 = GL.Color3

display :: OFF Float Int -> IO ()
display o@(OFF ps fs) = do
  GLFW.initialize
  -- open window
  GLFW.openWindow (GL.Size 400 400) [GLFW.DisplayAlphaBits 8] GLFW.Window
  GLFW.windowTitle $= "hOff Display"

  GL.shadeModel    $= GL.Smooth
  -- enable antialiasing
  GL.lineSmooth $= GL.Enabled
  GL.blend      $= GL.Enabled
  GL.blendFunc  $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
  GL.lineWidth  $= 1.5
  
  -- set the color to clear background
  GL.clearColor $= Color4 1 1 1 0
 
  -- OpenGL Viewport.
  GLFW.windowSizeCallback $= \ size@(GL.Size w h) -> 
    GL.viewport   $= (GL.Position 0 0, size)
  -- Draw loop
  drawLoop o

  -- finish up
  GLFW.closeWindow
  GLFW.terminate


drawLoop o = do
  wO <- getParam Opened
  esc <- GLFW.getKey GLFW.ESC
  when ( esc /= GLFW.Press && wO) $ do
    GLFW.pollEvents


    GL.clear [GL.ColorBuffer]
    drawOFF o

    up    <- GLFW.getKey 'W'
    down  <- GLFW.getKey 'S'
    left  <- GLFW.getKey 'A'
    right <- GLFW.getKey 'D'
    zL    <- GLFW.getKey 'Q'
    zR    <- GLFW.getKey 'E'

    when (up    == GLFW.Press) $ GL.rotate ( 10 :: Double) (Vector3 1 0 0)
    when (down  == GLFW.Press) $ GL.rotate (-10 :: Double) (Vector3 1 0 0)
    when (left  == GLFW.Press) $ GL.rotate ( 10 :: Double) (Vector3 0 1 0)
    when (right == GLFW.Press) $ GL.rotate (-10 :: Double) (Vector3 0 1 0)
    when (zL    == GLFW.Press) $ GL.rotate ( 10 :: Double) (Vector3 0 0 1)
    when (zR    == GLFW.Press) $ GL.rotate (-10 :: Double) (Vector3 0 0 1)
  
    GLFW.swapBuffers
    GLFW.sleep 0.1
  
    drawLoop o

v3 a b c = Vertex3 a b c :: Vertex3 Float

normOFF :: (Ord a, Floating a)
        => OFF a b
        -> OFF a b
normOFF (OFF ps fs) =
  let Vertice (a,b,c) = maximum ps
      m = maximum [a,b,c] * 2
      ps' = map (\(Vertice (x,y,z)) -> (Vertice (x/m,y/m,z/m))) ps
  in OFF ps' fs