diff --git a/HGamer3D.cabal b/HGamer3D.cabal --- a/HGamer3D.cabal +++ b/HGamer3D.cabal @@ -1,32 +1,27 @@ Name: HGamer3D -Version: 0.1.8 -Synopsis: Library to enable 3D game development for Haskell +Version: 0.1.9 +Synopsis: Windows Game Engine for the Haskell Programmer Description: - Library, to enable 3D game development for Haskell, - based on bindings to 3D Graphics, Audio and GUI libraries. - - This is the module, which includes all other needed modules and provides - an higher level API for primary - use. - - Platform: Windows only - License: Apache License, Version 2.0 - Install: see http://www.althainz.de/HGamer3D/Download-and-Installation.html + HGamer3D is a game engine for developing 3D games in the programming + language Haskell. The game engine uses available libraries for 3D graphics, + sound, input device handling, gui programming and other areas and make + those functions available for the Haskell programmer by providing + a Haskell API on top of that. HGamer3D is available on Windows only. License: OtherLicense License-file: LICENSE Author: Peter Althainz -Maintainer: althainz@googlemail.com +Maintainer: althainz@gmail.com Build-Type: Simple Cabal-Version: >=1.2 -Homepage: http://www.althainz.de/HGamer3D.html +Homepage: http://www.hgamer3d.org Category: Game Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, text, directory, Win32, mtl, HGamer3D-Data == 0.1.8, HGamer3D-Ogre-Binding == 0.1.8, HGamer3D-SFML-Binding == 0.1.8 + Build-Depends: base >= 3 && < 5, containers, text, directory, Win32, mtl, FindBin, HGamer3D-Data >= 0.1.9, HGamer3D-Ogre-Binding == 0.1.9, HGamer3D-SFML-Binding == 0.1.9, HGamer3D-CEGUI-Binding == 0.1.9 - Exposed-modules: HGamer3D.APIs.Base.Common,HGamer3D.APIs.Base.Audio,HGamer3D.APIs.Base.InputSystem,HGamer3D.APIs.Base.Graphics3D.Engine3D,HGamer3D.APIs.Base.Graphics3D.Light,HGamer3D.APIs.Base.Graphics3D.Object3D,HGamer3D.BaseAPI + Exposed-modules: HGamer3D.APIs.Base.Engine.Types,HGamer3D.APIs.Base.Graphics3D.Basic3D,HGamer3D.APIs.Base.Graphics3D.EngineHelper,HGamer3D.APIs.Base.Graphics3D.Light,HGamer3D.APIs.Base.Graphics3D.Object3D,HGamer3D.APIs.Base.Graphics3D.PlatonObjects,HGamer3D.APIs.Base.GUI.BasicGUI,HGamer3D.APIs.Base.GUI.EngineHelper,HGamer3D.APIs.Base.Engine.Engine,HGamer3D.APIs.Base.Audio.Audio,HGamer3D.APIs.Base.InputSystem.InputSystem,HGamer3D.BaseAPI Other-modules: c-sources: diff --git a/HGamer3D/APIs/Base/Audio.hs b/HGamer3D/APIs/Base/Audio.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Audio.hs +++ /dev/null @@ -1,233 +0,0 @@ --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.althainz.de/HGamer3D.html --- --- (c) 2011 Peter Althainz --- --- Licensed under the Apache License, Version 2.0 (the "License"); --- you may not use this file except in compliance with the License. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. - --- Audio.hs - --- |This module is one sub module of the second attempt, to provide an --- abstracted interface to the HGamer3D API Bindings. It is named 'Two', --- submodule Audio and handles Music and Sound. - -module HGamer3D.APIs.Base.Audio - -( - -- Enums - -- - module HGamer3D.Bindings.SFML.EnumSoundSourceStatus, - - - -- Data - -- - AudioSource (..), - - -- Listener Functions - setAudioListenerVolume, - getAudioListenerVolume, - setAudioListenerPosition, - setAudioListenerDirection, - - - -- Source creation and delete Functions - createMusic, - createSound, - deleteAudioSource, - - -- Source play function - playAudioSource, - pauseAudioSource, - stopAudioSource, - setAudioSourceLoop, - getAudioSourceLoop, - - -- Source Functions - setAudioSourcePitch, - setAudioSourceVolume, - setAudioSourcePosition, - setAudioSourceAttenuation, - - getAudioSourcePitch, - getAudioSourceVolume, - getAudioSourceMinDistance, - getAudioSourceAttenuation, - - attachAudioSourceToListener, - isAudioSourceAttachedToListener, - -) - -where - -import GHC.Ptr - -import HGamer3D.APIs.Base.Common -import HGamer3D.Bindings.SFML.ClassPtr -import HGamer3D.Bindings.SFML.Utils - -import qualified HGamer3D.Bindings.SFML.ClassListener as Listener -import qualified HGamer3D.Bindings.SFML.ClassMusic as Music -import qualified HGamer3D.Bindings.SFML.ClassSound as Sound -import qualified HGamer3D.Bindings.SFML.ClassSoundBuffer as SoundBuffer -import qualified HGamer3D.Bindings.SFML.ClassSoundSource as SoundSource -import qualified HGamer3D.Bindings.SFML.ClassSoundStream as SoundStream -import HGamer3D.Bindings.SFML.EnumSoundSourceStatus - -import HGamer3D.Data.HG3DClass -import Control.Monad.Trans -import Control.Monad.Reader -import HGamer3D.Data.Vector - --- Source types - -data AudioSource = Music HG3DClass | Sound HG3DClass HG3DClass - - --- Listener Functions - -setAudioListenerVolume :: Float -> MHGamer3D () -setAudioListenerVolume vol = liftIO $ Listener.setGlobalVolume vol - -getAudioListenerVolume :: MHGamer3D Float -getAudioListenerVolume = liftIO $ Listener.getGlobalVolume - -setAudioListenerPosition :: Vec3 -> MHGamer3D () -setAudioListenerPosition (Vec3 x y z) = liftIO $ Listener.setPosition x y z - -setAudioListenerDirection :: Vec3 -> MHGamer3D () -setAudioListenerDirection (Vec3 x y z) = liftIO $ Listener.setDirection x y z - - --- Music Functions, deletion and cretion of Audio types --- - --- | Creates music with name -createMusic :: String -> MHGamer3D (Maybe AudioSource) -createMusic filename = do - music <- liftIO $ Music.new - (cs, es) <- ask - let dir = (csHG3DPath cs) - fOk <- liftIO $ Music.openFromFile music (dir ++ "\\media\\sound\\" ++ filename) - if fOk then - return (Just (Music music)) - else do - liftIO $ Music.delete music - return Nothing - - -createSound :: String -> MHGamer3D (Maybe AudioSource) -createSound filename = do - sound <- liftIO $ Sound.new - buffer <- liftIO $ SoundBuffer.new - (cs, es) <- ask - let dir = (csHG3DPath cs) - fOk <- liftIO $ SoundBuffer.loadFromFile buffer (dir ++ "\\media\\sound\\" ++ filename) - if fOk then do - liftIO $ Sound.setBuffer sound buffer - return (Just (Sound sound buffer)) - else do - liftIO $ Sound.delete sound - liftIO $ SoundBuffer.delete buffer - return Nothing - -deleteAudioSource :: AudioSource -> MHGamer3D () -deleteAudioSource (Music music) = do - liftIO $ Music.delete music -deleteSource (Sound sound buffer) = do - liftIO $ Sound.delete sound - liftIO $ SoundBuffer.delete buffer - - --- Source play, pause, stop --- - -playAudioSource :: AudioSource -> MHGamer3D () -playAudioSource (Music music) = do - liftIO $ SoundStream.play music -playAudioSource (Sound sound buffer) = do - liftIO $ Sound.play sound - -pauseAudioSource :: AudioSource -> MHGamer3D () -pauseAudioSource (Music music) = do - liftIO $ SoundStream.pause music -pauseAudioSource (Sound sound buffer) = do - liftIO $ Sound.pause sound - -stopAudioSource :: AudioSource -> MHGamer3D () -stopAudioSource (Music music) = do - liftIO $ SoundStream.stop music -stopAudioSource (Sound sound buffer) = do - liftIO $ Sound.stop sound - -getAudioSourceLoop :: AudioSource -> MHGamer3D Bool -getAudioSourceLoop (Music music) = do - fLoop <- liftIO $ SoundStream.getLoop music - return fLoop -getAudioSourceLoop (Sound sound buffer) = do - fLoop <- liftIO $ Sound.getLoop sound - return fLoop - -setAudioSourceLoop :: AudioSource -> Bool -> MHGamer3D () -setAudioSourceLoop (Music music) fLoop = do - liftIO $ SoundStream.setLoop music fLoop -setAudioSourceLoop (Sound sound buffer) fLoop = do - liftIO $ Sound.setLoop sound fLoop - - --- Sound Source Functions --- - -setAudioSourcePitch :: AudioSource -> Float -> MHGamer3D () -setAudioSourcePitch (Music s) p = liftIO $ SoundSource.setPitch s p -setAudioSourcePitch (Sound s b) p = liftIO $ SoundSource.setPitch s p - -setAudioSourceVolume :: AudioSource -> Float -> MHGamer3D () -setAudioSourceVolume (Music s) v = liftIO $ SoundSource.setVolume s v -setAudioSourceVolume (Sound s b) v = liftIO $ SoundSource.setVolume s v - -setAudioSourcePosition :: AudioSource -> Vec3 -> MHGamer3D () -setAudioSourcePosition (Music s) (Vec3 x y z) = liftIO $ SoundSource.setPosition s x y z -setAudioSourcePosition (Sound s b) (Vec3 x y z) = liftIO $ SoundSource.setPosition s x y z - -setAudioSourceAttenuation :: AudioSource -> Float -> MHGamer3D () -setAudioSourceAttenuation (Music s) a = liftIO $ SoundSource.setAttenuation s a -setAudioSourceAttenuation (Sound s b) a = liftIO $ SoundSource.setAttenuation s a - -getAudioSourcePitch :: AudioSource -> MHGamer3D Float -getAudioSourcePitch (Music s) = liftIO $ SoundSource.getPitch s -getAudioSourcePitch (Sound s b) = liftIO $ SoundSource.getPitch s - - -getAudioSourceVolume :: AudioSource -> MHGamer3D Float -getAudioSourceVolume (Music s) = liftIO $ SoundSource.getVolume s -getAudioSourceVolume (Sound s b) = liftIO $ SoundSource.getVolume s - -getAudioSourceMinDistance :: AudioSource -> MHGamer3D Float -getAudioSourceMinDistance (Music s) = liftIO $ SoundSource.getMinDistance s -getAudioSourceMinDistance (Sound s b) = liftIO $ SoundSource.getMinDistance s - -getAudioSourceAttenuation :: AudioSource -> MHGamer3D Float -getAudioSourceAttenuation (Music s) = liftIO $ SoundSource.getAttenuation s -getAudioSourceAttenuation (Sound s b) = liftIO $ SoundSource.getAttenuation s - -attachAudioSourceToListener :: AudioSource -> Bool -> MHGamer3D () -attachAudioSourceToListener (Music s) isR = liftIO $ SoundSource.setRelativeToListener s isR -attachAudioSourceToListener (Sound s b) isR = liftIO $ SoundSource.setRelativeToListener s isR - -isAudioSourceAttachedToListener :: AudioSource -> MHGamer3D Bool -isAudioSourceAttachedToListener (Music s) = liftIO $ SoundSource.isRelativeToListener s -isAudioSourceAttachedToListener (Sound s b) = liftIO $ SoundSource.isRelativeToListener s - - diff --git a/HGamer3D/APIs/Base/Audio/Audio.hs b/HGamer3D/APIs/Base/Audio/Audio.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/Audio/Audio.hs @@ -0,0 +1,246 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Audio.hs + +-- |Base API, Audio Module, Audio Sub-Module. +-- Basic Audio functionality of the HGamer3D engine. + + +module HGamer3D.APIs.Base.Audio.Audio + +( + -- Enums + -- + module HGamer3D.Bindings.SFML.EnumSoundSourceStatus, + + + -- Data + -- + AudioSource (..), + + -- Listener Functions + setAudioListenerVolume, + getAudioListenerVolume, + setAudioListenerPosition, + setAudioListenerDirection, + + + -- Source creation and delete Functions + createMusic, + createSound, + deleteAudioSource, + + -- Source play function + playAudioSource, + pauseAudioSource, + stopAudioSource, + setAudioSourceLoop, + getAudioSourceLoop, + + -- Source Functions + setAudioSourcePitch, + setAudioSourceVolume, + setAudioSourcePosition, + setAudioSourceAttenuation, + + getAudioSourcePitch, + getAudioSourceVolume, + getAudioSourceMinDistance, + getAudioSourceAttenuation, + + attachAudioSourceToListener, + isAudioSourceAttachedToListener, + +) + +where + +import GHC.Ptr + +import HGamer3D.APIs.Base.Engine.Types + +import HGamer3D.Bindings.SFML.ClassPtr +import HGamer3D.Bindings.SFML.Utils + +import qualified HGamer3D.Bindings.SFML.ClassListener as Listener +import qualified HGamer3D.Bindings.SFML.ClassMusic as Music +import qualified HGamer3D.Bindings.SFML.ClassSound as Sound +import qualified HGamer3D.Bindings.SFML.ClassSoundBuffer as SoundBuffer +import qualified HGamer3D.Bindings.SFML.ClassSoundSource as SoundSource +import qualified HGamer3D.Bindings.SFML.ClassSoundStream as SoundStream +import HGamer3D.Bindings.SFML.EnumSoundSourceStatus + +import HGamer3D.Data.HG3DClass +import Control.Monad.Trans +import Control.Monad.Reader +import HGamer3D.Data.Vector + +-- Source types + +data AudioSource = Music HG3DClass | Sound HG3DClass HG3DClass + + +-- Listener Functions + +setAudioListenerVolume :: Float -> MHGamer3D () +setAudioListenerVolume vol = liftIO $ Listener.setGlobalVolume vol + +getAudioListenerVolume :: MHGamer3D Float +getAudioListenerVolume = liftIO $ Listener.getGlobalVolume + +setAudioListenerPosition :: Vec3 -> MHGamer3D () +setAudioListenerPosition (Vec3 x y z) = liftIO $ Listener.setPosition x y z + +setAudioListenerDirection :: Vec3 -> MHGamer3D () +setAudioListenerDirection (Vec3 x y z) = liftIO $ Listener.setDirection x y z + + +-- Music Functions, deletion and cretion of Audio types +-- + +-- | Creates music with name +createMusic :: String -> MHGamer3D (Maybe AudioSource) +createMusic filename = do + music <- liftIO $ Music.new + (cs, es, gs) <- ask + let dir = (csHG3DPath cs) + let progdir = (csProgPath cs) + -- first try in runtime folder + fOk <- liftIO $ Music.openFromFile music (dir ++ "\\media\\sound\\" ++ filename) + if fOk then + return (Just (Music music)) + else do + fOk <- liftIO $ Music.openFromFile music (progdir ++ "\\media\\sound\\" ++ filename) + if fOk then + return (Just (Music music)) + else do + liftIO $ Music.delete music + return Nothing + + +createSound :: String -> MHGamer3D (Maybe AudioSource) +createSound filename = do + sound <- liftIO $ Sound.new + buffer <- liftIO $ SoundBuffer.new + (cs, es, gs) <- ask + let dir = (csHG3DPath cs) + let progdir = (csProgPath cs) + fOk <- liftIO $ SoundBuffer.loadFromFile buffer (dir ++ "\\media\\sound\\" ++ filename) + if fOk then do + liftIO $ Sound.setBuffer sound buffer + return (Just (Sound sound buffer)) + else do + fOk <- liftIO $ SoundBuffer.loadFromFile buffer (progdir ++ "\\media\\sound\\" ++ filename) + if fOk then do + liftIO $ Sound.setBuffer sound buffer + return (Just (Sound sound buffer)) + else do + liftIO $ Sound.delete sound + liftIO $ SoundBuffer.delete buffer + return Nothing + +deleteAudioSource :: AudioSource -> MHGamer3D () +deleteAudioSource (Music music) = do + liftIO $ Music.delete music +deleteAudioSource (Sound sound buffer) = do + liftIO $ Sound.delete sound + liftIO $ SoundBuffer.delete buffer + + +-- Source play, pause, stop +-- + +playAudioSource :: AudioSource -> MHGamer3D () +playAudioSource (Music music) = do + liftIO $ SoundStream.play music +playAudioSource (Sound sound buffer) = do + liftIO $ Sound.play sound + +pauseAudioSource :: AudioSource -> MHGamer3D () +pauseAudioSource (Music music) = do + liftIO $ SoundStream.pause music +pauseAudioSource (Sound sound buffer) = do + liftIO $ Sound.pause sound + +stopAudioSource :: AudioSource -> MHGamer3D () +stopAudioSource (Music music) = do + liftIO $ SoundStream.stop music +stopAudioSource (Sound sound buffer) = do + liftIO $ Sound.stop sound + +getAudioSourceLoop :: AudioSource -> MHGamer3D Bool +getAudioSourceLoop (Music music) = do + fLoop <- liftIO $ SoundStream.getLoop music + return fLoop +getAudioSourceLoop (Sound sound buffer) = do + fLoop <- liftIO $ Sound.getLoop sound + return fLoop + +setAudioSourceLoop :: AudioSource -> Bool -> MHGamer3D () +setAudioSourceLoop (Music music) fLoop = do + liftIO $ SoundStream.setLoop music fLoop +setAudioSourceLoop (Sound sound buffer) fLoop = do + liftIO $ Sound.setLoop sound fLoop + + +-- Sound Source Functions +-- + +setAudioSourcePitch :: AudioSource -> Float -> MHGamer3D () +setAudioSourcePitch (Music s) p = liftIO $ SoundSource.setPitch s p +setAudioSourcePitch (Sound s b) p = liftIO $ SoundSource.setPitch s p + +setAudioSourceVolume :: AudioSource -> Float -> MHGamer3D () +setAudioSourceVolume (Music s) v = liftIO $ SoundSource.setVolume s v +setAudioSourceVolume (Sound s b) v = liftIO $ SoundSource.setVolume s v + +setAudioSourcePosition :: AudioSource -> Vec3 -> MHGamer3D () +setAudioSourcePosition (Music s) (Vec3 x y z) = liftIO $ SoundSource.setPosition s x y z +setAudioSourcePosition (Sound s b) (Vec3 x y z) = liftIO $ SoundSource.setPosition s x y z + +setAudioSourceAttenuation :: AudioSource -> Float -> MHGamer3D () +setAudioSourceAttenuation (Music s) a = liftIO $ SoundSource.setAttenuation s a +setAudioSourceAttenuation (Sound s b) a = liftIO $ SoundSource.setAttenuation s a + +getAudioSourcePitch :: AudioSource -> MHGamer3D Float +getAudioSourcePitch (Music s) = liftIO $ SoundSource.getPitch s +getAudioSourcePitch (Sound s b) = liftIO $ SoundSource.getPitch s + + +getAudioSourceVolume :: AudioSource -> MHGamer3D Float +getAudioSourceVolume (Music s) = liftIO $ SoundSource.getVolume s +getAudioSourceVolume (Sound s b) = liftIO $ SoundSource.getVolume s + +getAudioSourceMinDistance :: AudioSource -> MHGamer3D Float +getAudioSourceMinDistance (Music s) = liftIO $ SoundSource.getMinDistance s +getAudioSourceMinDistance (Sound s b) = liftIO $ SoundSource.getMinDistance s + +getAudioSourceAttenuation :: AudioSource -> MHGamer3D Float +getAudioSourceAttenuation (Music s) = liftIO $ SoundSource.getAttenuation s +getAudioSourceAttenuation (Sound s b) = liftIO $ SoundSource.getAttenuation s + +attachAudioSourceToListener :: AudioSource -> Bool -> MHGamer3D () +attachAudioSourceToListener (Music s) isR = liftIO $ SoundSource.setRelativeToListener s isR +attachAudioSourceToListener (Sound s b) isR = liftIO $ SoundSource.setRelativeToListener s isR + +isAudioSourceAttachedToListener :: AudioSource -> MHGamer3D Bool +isAudioSourceAttachedToListener (Music s) = liftIO $ SoundSource.isRelativeToListener s +isAudioSourceAttachedToListener (Sound s b) = liftIO $ SoundSource.isRelativeToListener s + + diff --git a/HGamer3D/APIs/Base/Common.hs b/HGamer3D/APIs/Base/Common.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Common.hs +++ /dev/null @@ -1,153 +0,0 @@ --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.althainz.de/HGamer3D.html --- --- (c) 2011 Peter Althainz --- --- Licensed under the Apache License, Version 2.0 (the "License"); --- you may not use this file except in compliance with the License. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. - --- Engine3D.hs --- - --- Basic functionality of HGamer3D, Base API - -module HGamer3D.APIs.Base.Common ( - - MHGamer3D, - Position3D (..), - Scale3D (..), - translate3D, - Direction3D (..), - Orientation3D (..), - - CommonSystem (..), - EngineSystem (..), - - getUniqueName, - initCommon, - - TimeMS (..), - getTimeMS, - - runMHGamer3D -) - -where - -import HGamer3D.Data.Colour -import HGamer3D.Data.Vector -import HGamer3D.Data.Angle -import HGamer3D.Data.HG3DClass - -import qualified Data.Text as T -import System.Directory - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.State -import Control.Concurrent - -import System.Win32.Time - --- identification dll --- -hg3ddllname :: String -hg3ddllname = "HGamer3D-Version-0.1.8-DontDelete.txt" - -data CommonSystem = CommonSystem { - csHG3DPath::String -} - -data EngineSystem = EngineSystem { - esRoot::HG3DClass, - esSceneManager::HG3DClass, - esResourceGroupManager::HG3DClass, - esTextureManager::HG3DClass, - esControllerManager::HG3DClass, - esLogManager::HG3DClass, - esCamera::HG3DClass, - esRenderWindow::HG3DClass, - esViewport::HG3DClass -} - -type MHGamer3D a = (ReaderT (CommonSystem, EngineSystem)) (StateT [Integer] IO) a - -class Position3D t where - - position3D :: t -> MHGamer3D Vec3 - positionTo3D :: t -> Vec3 -> MHGamer3D () - -translate3D :: Position3D t => t -> Vec3 -> MHGamer3D () -translate3D t v = do - p <- position3D t - positionTo3D t ( v &+ p ) - return () - -class Scale3D t where - - scale3D :: t -> MHGamer3D Vec3 - scaleTo3D :: t -> Vec3 -> MHGamer3D () - -class Direction3D t where - direction3D :: t -> MHGamer3D Vec3 - directionTo3D :: t -> Vec3 -> MHGamer3D () - -class Orientation3D t where - orientation3D :: t -> MHGamer3D UnitQuaternion - orientationTo3D :: t -> UnitQuaternion -> MHGamer3D () - --- unique identifiers, by appending a unique integer to a prefix --- - -getUniqueName :: String -> StateT [Integer] IO String -getUniqueName prefix = do - (x:xs) <- get - put xs - return (prefix ++ (show x)) - - --- function, which finds installation path of HG3D --- - -getHG3DPath :: IO String -getHG3DPath = do - env <- findExecutable hg3ddllname - let path = case env of - Just path -> fst (T.breakOn (T.pack $ "\\bin\\" ++ hg3ddllname) (T.pack path)) - Nothing -> T.pack "" - return (T.unpack path) - -initCommon :: IO CommonSystem -initCommon = do - csHG3DPath <- getHG3DPath - return (CommonSystem csHG3DPath) - --- Milliseconds Timescale - -data TimeMS = TimeMS Int -- time in milliseconds - -instance Show TimeMS where - show (TimeMS s) = (show s) ++ " Milliseconds" - -getTimeMS :: MHGamer3D (TimeMS) -getTimeMS = do - fr <- liftIO $ queryPerformanceFrequency - wt <- liftIO $ queryPerformanceCounter - return (TimeMS $ fromIntegral (wt * 1000 `div` fr)) - -runMHGamer3D :: (CommonSystem, EngineSystem) -> [Integer] -> MHGamer3D a -> IO (a, [Integer]) -runMHGamer3D (cs, es) s action = do - (actionResult, newState) <- runStateT (runReaderT action (cs, es) ) s - return (actionResult, newState) - diff --git a/HGamer3D/APIs/Base/Engine/Engine.hs b/HGamer3D/APIs/Base/Engine/Engine.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/Engine/Engine.hs @@ -0,0 +1,270 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Engine.hs + +-- |Base API, Engine Module, Engine Sub-Module. +-- Basic functionality of the HGamer3D engine. + + +module HGamer3D.APIs.Base.Engine.Engine ( + + getUniqueName, + mapFunctionToFunctionTag, + getFunctionFromFunctionTag, + initCommonSystem, + + getTimeMS, + runMHGamer3D, + initHGamer3D, + + renderLoop +) + +where + + +import GHC.Ptr + +import HGamer3D.Data.Colour +import HGamer3D.Data.Vector +import HGamer3D.Data.Angle +import HGamer3D.Data.HG3DClass + +import HGamer3D.Bindings.Ogre.ClassRoot as Root +import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump +import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow +import HGamer3D.Bindings.Ogre.ClassWindowUtilsHG3D as WindowUtils +import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem +import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController + +import HGamer3D.APIs.Base.Engine.Types +import qualified HGamer3D.APIs.Base.InputSystem.InputSystem as IS + +import HGamer3D.APIs.Base.Graphics3D.EngineHelper +import HGamer3D.APIs.Base.GUI.EngineHelper + +import Control.Monad +import Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State +import Control.Concurrent + +import System.Win32.Process +import qualified Data.Text as T +import System.Directory +import System.Environment (getArgs) +import qualified Data.Map as Map +import System.Win32.Time +import System.Environment.FindBin + + +-- identification dll +-- +hg3ddllname :: String +hg3ddllname = "HGamer3D-Version-0.1.9-DontDelete.txt" + +-- unique identifiers, by appending a unique integer to a prefix + +getUniqueName :: String -> MHGamer3D String +getUniqueName prefix = do + + HG3DEngineState (x:xs) <- lift get + lift $ put (HG3DEngineState xs) + return (prefix ++ (show x)) + +-- event function mapping + +mapFunctionToFunctionTag :: EventFunction a -> String -> EventMap a -> EventMap a +mapFunctionToFunctionTag function tag efmap = Map.insert tag function efmap + +getFunctionFromFunctionTag :: String -> EventMap a -> Maybe (EventFunction a) +getFunctionFromFunctionTag tag efmap = Map.lookup tag efmap + + +-- function, which finds installation path of HG3D +-- + +getHG3DPath :: IO (String, String) +getHG3DPath = do + env <- findExecutable hg3ddllname + let path = case env of + Just path -> fst (T.breakOn (T.pack $ "\\bin\\" ++ hg3ddllname) (T.pack path)) + Nothing -> T.pack "" + progpath <- getProgPath + return (T.unpack path, progpath) + +initCommonSystem :: IO CommonSystem +initCommonSystem = do + (csHG3DPath, csProgPath) <- getHG3DPath + return (CommonSystem csHG3DPath csProgPath) + +-- Milliseconds Timescale + + +getTimeMS :: MHGamer3D (TimeMS) +getTimeMS = do + fr <- liftIO $ queryPerformanceFrequency + wt <- liftIO $ queryPerformanceCounter + return (TimeMS $ fromIntegral (wt * 1000 `div` fr)) + + +runMHGamer3D :: MHGamer3DState -> MHGamer3D a -> IO (a, MHGamer3DState) +runMHGamer3D (MHGamer3DState readerstate enginestate) action = do + (actionResult, newEnginestate) <- runStateT (runReaderT action readerstate ) enginestate + return (actionResult, MHGamer3DState readerstate newEnginestate) + +data MouseState = MouseUp | MouseDown deriving (Eq) + +data TimeMouseState = TimeMouseState { + tmsMouse::MouseState, + tmsTimeMS::TimeMS + } + +initTimeMouseState :: MHGamer3D (TimeMouseState) +initTimeMouseState = do + tms <- getTimeMS + leftButton <- IS.isMouseButtonPressed IS.MouseButtonLeft + let ms = if leftButton then MouseUp else MouseDown + return (TimeMouseState ms tms) + + +initHGamer3D :: String -> IO MHGamer3DState +initHGamer3D windowName = do + + -- init Commons configs + cs <- initCommonSystem + + -- get flags from program arguments + let hg3dpath = (csHG3DPath cs) + args <- getArgs + let fConfig = foldl (||) False $ map (\arg -> if arg == "--config" then True else False) args + let fDX = foldl (||) False $ map (\arg -> if arg == "--directx" then True else False) args + let fLog = foldl (||) False $ map (\arg -> if arg == "--logging" then True else False) args + + -- init Graphics3D configs and engine + g3s <- initGraphics3D windowName "OctreeSceneManager" hg3dpath fConfig fDX fLog + + -- init GUI configs and engine + gui <- initGUIEngine fLog + + let state = HG3DEngineState [1..] + return (MHGamer3DState (cs, g3s, gui) state) + +-- renderStep a :: TimeMS -> a -> MHGamer3D (Bool, a) +-- this function needs to be defined in + +renderInternalStep :: Int -> TimeMouseState -> MHGamer3D (Bool, TimeMouseState) +renderInternalStep frameRate (TimeMouseState lastMouseState (TimeMS lastTime)) = do + (cs, g3s, gui) <- ask + -- adapt to framerate, while still doing messagePump + (TimeMS time) <- getTimeMS + let delta = time - lastTime + let waitTimeMS = (1000.0 / (fromIntegral frameRate) ) - (fromIntegral delta) + time <- if waitTimeMS > 0.0 then do + liftIO $ sleep (round waitTimeMS) + (TimeMS time) <- getTimeMS + return (time) + else + return (time) + -- adapt + let messagePump = g3sMessagePump g3s + liftIO $ MessagePump.messagePump messagePump + closed <- liftIO $ RenderWindow.isClosed (g3sRenderWindow g3s) + if (closed) then + return (False, (TimeMouseState lastMouseState (TimeMS time)) ) + else do + -- here comes the things, we need to do each time + -- + let delta2 = (fromIntegral (time - lastTime)) * 1000.0 + -- mouse state injection + leftButton <- IS.isMouseButtonPressed IS.MouseButtonLeft + let ms = if leftButton then MouseDown else MouseUp + if lastMouseState == MouseUp && ms == MouseDown then do + liftIO $ CEGUISystem.injectMouseButtonDown (guiSystem gui) CEGUIButton.MouseLeftButton + return () + else do + return () + if lastMouseState == MouseDown && ms == MouseUp then do + liftIO $ CEGUISystem.injectMouseButtonUp (guiSystem gui) CEGUIButton.MouseLeftButton + return () + else do + return () + -- mouse position injection + (xm, ym) <- IS.getMousePosition + leftButton <- IS.isMouseButtonPressed IS.MouseButtonLeft + (width, height, colorDepth, left, top) <- liftIO $ RenderWindow.getMetrics (g3sRenderWindow g3s) + (topT, bottomT, leftT, rightT) <- liftIO $ WindowUtils.getWindowTopLeft (g3sRenderWindow g3s) + let offLeft = (rightT - leftT - width) `div` 2 + let offRight = bottomT - topT - height - offLeft + -- key press injection + keypressInject + + let mouseX = xm - left - offLeft + let mouseY = ym - top - offRight + liftIO $ CEGUISystem.injectMousePosition (guiSystem gui) (fromIntegral mouseX) (fromIntegral mouseY) + -- time pulse injection + liftIO $ CEGUISystem.injectTimePulse (guiSystem gui) delta2 + -- display 3D and GUI + liftIO $ Root.renderOneFrame (g3sRoot g3s) + liftIO $ CEGUISystem.renderGUI (guiSystem gui) + + return (True, (TimeMouseState ms (TimeMS time)) ) + + +renderInternalLoop :: Int -> TimeMouseState -> gamestateType -> EventMap gamestateType -> (TimeMS -> gamestateType -> MHGamer3D (Bool, gamestateType)) -> MHGamer3D () +renderInternalLoop frameRate rsold gamestate eventMap renderStep = do + let (TimeMouseState ms (TimeMS timeold)) = rsold + gsnew <- getEventsFromGui gamestate eventMap + (flagStep, rs) <- renderInternalStep frameRate rsold + let (TimeMouseState ms (TimeMS time)) = rs + let delta = (TimeMS (time - timeold)) + (flagLoop, gsnew2) <- renderStep delta gsnew + if (flagStep && flagLoop) then do + renderInternalLoop frameRate rs gsnew2 eventMap renderStep + else return () + +renderLoop :: Int -> gamestateType -> EventMap gamestateType -> (TimeMS -> gamestateType -> MHGamer3D (Bool, gamestateType)) -> MHGamer3D () +renderLoop frameRate gamestate eventMap renderStep = do + rs <- initTimeMouseState + renderInternalLoop frameRate rs gamestate eventMap renderStep + +-- event loop + +getEventsFromGui :: a -> EventMap a -> MHGamer3D a +getEventsFromGui a eventMap = do + (cs, es, gs) <- ask + let eventController = guiEventController gs + processEvents <- liftIO $ HG3DEventController.eventsAvailable eventController + + outera <- if processEvents then do + (name, sender, window) <- liftIO $ HG3DEventController.popEvent eventController + let evt = GUIEvent name sender window + let evtfunc = getFunctionFromFunctionTag name eventMap + innera <- case evtfunc of + Just func -> do + fa <- func evt a + return fa + Nothing -> return a + loopa <- getEventsFromGui innera eventMap + return loopa + else do + return a + return outera + diff --git a/HGamer3D/APIs/Base/Engine/Types.hs b/HGamer3D/APIs/Base/Engine/Types.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/Engine/Types.hs @@ -0,0 +1,98 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Types.hs + +-- |Base API, Engine Module, Types Sub-Module. +-- Basic types of the HGamer3D engine. + + +module HGamer3D.APIs.Base.Engine.Types ( + + MHGamer3D, + Event (..), + EventFunction, + EventMap, + + CommonSystem (..), + Graphics3DSystem (..), + GUISystem (..), + + HG3DReaderState (..), + HG3DEngineState (..), + + MHGamer3DState (..), + TimeMS (..), +) + +where + +import HGamer3D.Data.HG3DClass +import Control.Monad.Reader +import Control.Monad.State +import qualified Data.Map as Map + + +data CommonSystem = CommonSystem { + csHG3DPath::String, + csProgPath::String +} + +data Graphics3DSystem = Graphics3DSystem { + g3sRoot::HG3DClass, + g3sSceneManager::HG3DClass, + g3sResourceGroupManager::HG3DClass, + g3sTextureManager::HG3DClass, + g3sControllerManager::HG3DClass, + g3sLogManager::HG3DClass, + g3sCamera::HG3DClass, + g3sRenderWindow::HG3DClass, + g3sViewport::HG3DClass, + g3sMessagePump::HG3DClass +} + +data GUISystem = GUISystem { + guiRenderer::HG3DClass, + guiSystem::HG3DClass, + guiWindowManager::HG3DClass, + guiFontManager::HG3DClass, + guiSchemeManager::HG3DClass, + guiEventController::HG3DClass +} + +data Event = GUIEvent String String HG3DClass -- name sender window + +type EventFunction a = Event -> a -> MHGamer3D a +type EventMap a = Map.Map String (EventFunction a) + +type HG3DReaderState = (CommonSystem, Graphics3DSystem, GUISystem) + +data HG3DEngineState = HG3DEngineState { + esUniqueNumbers::[Integer] +} + +data MHGamer3DState = MHGamer3DState HG3DReaderState HG3DEngineState + +type MHGamer3D a = (ReaderT HG3DReaderState) (StateT HG3DEngineState IO) a + + +data TimeMS = TimeMS Int -- time in milliseconds + +instance Show TimeMS where + show (TimeMS s) = (show s) ++ " Milliseconds" + diff --git a/HGamer3D/APIs/Base/GUI/BasicGUI.hs b/HGamer3D/APIs/Base/GUI/BasicGUI.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/GUI/BasicGUI.hs @@ -0,0 +1,187 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- BasicGUI.hs + +-- |Base API, GUI Module, BasicGUI Sub-Module. +-- Basic GUI functionality. + + +module HGamer3D.APIs.Base.GUI.BasicGUI + +( + loadWindowFromFile, + addWindowToDisplay, + removeWindowFromDisplay, + + enableWindow, + disableWindow, + activateWindow, + deactivateWindow, + showWindow, + hideWindow, + + getChildWindow, + findChildWindowRecursive, + getWindowProperty, + setWindowProperty, + + loadScheme, + loadFont, + HGamer3D.APIs.Base.GUI.BasicGUI.setDefaultFont, + setDefaultMouseCursor, + HGamer3D.APIs.Base.GUI.BasicGUI.setDefaultTooltip, + + mapGUIEventToFunctionTag, + mapGUIEventToFunction +) + +where + +import GHC.Ptr + +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine +import HGamer3D.Bindings.CEGUI.ClassPtr +import HGamer3D.Bindings.CEGUI.Utils + +import HGamer3D.Bindings.CEGUI.ClassWindow as Window +import HGamer3D.Bindings.CEGUI.ClassWindowManager as WindowManager +import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as WindowManagerHG3D +import HGamer3D.Bindings.CEGUI.ClassWindow as Window +import HGamer3D.Bindings.CEGUI.ClassSystem as System +import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as SystemHG3D +import HGamer3D.Bindings.CEGUI.ClassPropertySet as PropertySet +import HGamer3D.Bindings.CEGUI.ClassHG3DEventStaticFunctions as EvtSF + +import HGamer3D.Data.HG3DClass +import Control.Monad.Trans +import Control.Monad.Reader +import HGamer3D.Data.Vector + + +loadWindowFromFile :: String -> String -> MHGamer3D (HG3DClass) +loadWindowFromFile layoutFile prefix = do + (cs, g3s, gui) <- ask + hg3dWinMgr <- liftIO $ WindowManagerHG3D.new + window <- liftIO $ WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix + liftIO $ WindowManagerHG3D.delete hg3dWinMgr + return (window) + +addWindowToDisplay :: HG3DClass -> MHGamer3D () +addWindowToDisplay window = do + (cs, g3s, gui) <- ask + guiSheet <- liftIO $ System.getGUISheet (guiSystem gui) + liftIO $ Window.addChildWindow2 guiSheet window + +removeWindowFromDisplay :: HG3DClass -> MHGamer3D () +removeWindowFromDisplay window = do + (cs, g3s, gui) <- ask + guiSheet <- liftIO $ System.getGUISheet (guiSystem gui) + liftIO $ Window.removeChildWindow2 guiSheet window + +enableWindow :: HG3DClass -> MHGamer3D () +enableWindow window = do + (cs, g3s, gui) <- ask + liftIO $ Window.enable window + +disableWindow :: HG3DClass -> MHGamer3D () +disableWindow window = do + (cs, g3s, gui) <- ask + liftIO $ Window.disable window + +activateWindow :: HG3DClass -> MHGamer3D () +activateWindow window = do + (cs, g3s, gui) <- ask + liftIO $ Window.activate window + +deactivateWindow :: HG3DClass -> MHGamer3D () +deactivateWindow window = do + (cs, g3s, gui) <- ask + liftIO $ Window.deactivate window + +showWindow :: HG3DClass -> MHGamer3D () +showWindow window = do + (cs, g3s, gui) <- ask + liftIO $ Window.show window + +hideWindow :: HG3DClass -> MHGamer3D () +hideWindow window = do + (cs, g3s, gui) <- ask + liftIO $ Window.hide window + +getChildWindow :: HG3DClass -> String -> MHGamer3D HG3DClass +getChildWindow window name = do + window <- liftIO $ Window.getChild window name + return window + +findChildWindowRecursive :: HG3DClass -> String -> MHGamer3D (Maybe HG3DClass) +findChildWindowRecursive window name = do + window <- liftIO $ Window.getChildRecursive window name + if (ocPtr window) == nullPtr then do + return Nothing + else do + return (Just window) + +getWindowProperty :: HG3DClass -> String -> MHGamer3D String +getWindowProperty window name = do + prop <- liftIO $ PropertySet.getProperty window name + return prop + +setWindowProperty :: HG3DClass -> String -> String -> MHGamer3D () +setWindowProperty window name value = do + liftIO $ PropertySet.setProperty window name value + +loadScheme :: String -> MHGamer3D () +loadScheme schemeName = do + (cs, g3s, gui) <- ask + liftIO $ SystemHG3D.schemeManagerCreate (guiSchemeManager gui) schemeName + +loadFont :: String -> MHGamer3D () +loadFont fontName = do + (cs, g3s, gui) <- ask + liftIO $ SystemHG3D.fontManagerCreate (guiFontManager gui) fontName + +setDefaultFont :: String -> MHGamer3D () +setDefaultFont fontName = do + (cs, g3s, gui) <- ask + liftIO $ System.setDefaultFont (guiSystem gui) fontName + +setDefaultMouseCursor :: String -> String -> MHGamer3D () +setDefaultMouseCursor schemeName cursorName = do + (cs, g3s, gui) <- ask + liftIO $ System.setDefaultMouseCursor3 (guiSystem gui) schemeName cursorName + +setDefaultTooltip :: String -> MHGamer3D () +setDefaultTooltip ttName = do + (cs, g3s, gui) <- ask + liftIO $ System.setDefaultTooltip2 (guiSystem gui) ttName + +mapGUIEventToFunctionTag :: Event -> String -> MHGamer3D () +mapGUIEventToFunctionTag event functionTag = do + case event of + GUIEvent name sender window -> do + liftIO $ EvtSF.subscribeScriptedEvent window name functionTag + return () + +mapGUIEventToFunction :: HG3DClass -> String -> EventFunction a -> EventMap a -> MHGamer3D (EventMap a) +mapGUIEventToFunction window eventName function eventMap = do + functionTag <- getUniqueName "Event" + let newmap = mapFunctionToFunctionTag function functionTag eventMap + liftIO $ EvtSF.subscribeScriptedEvent window eventName functionTag + return newmap diff --git a/HGamer3D/APIs/Base/GUI/EngineHelper.hs b/HGamer3D/APIs/Base/GUI/EngineHelper.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/GUI/EngineHelper.hs @@ -0,0 +1,156 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- EngineHelper.hs + +-- |Base API, GUI Module, EngineHelper Sub-Module. +-- Functionality of the GUI module, which is needed for the game engine. + + +module HGamer3D.APIs.Base.GUI.EngineHelper + +( + initGUIEngine, + keypressInject +) + +where + +import GHC.Ptr + +import HGamer3D.Data.HG3DClass +import HGamer3D.Data.Vector + +import HGamer3D.Bindings.CEGUI.ClassPtr +import HGamer3D.Bindings.CEGUI.Utils + +import HGamer3D.Bindings.CEGUI.ClassOgreRenderer as CEGUIOgreRenderer +import HGamer3D.Bindings.CEGUI.ClassSystem as CEGUISystem +import HGamer3D.Bindings.CEGUI.ClassSystemHG3D as CEGUISystemHG3D +import HGamer3D.Bindings.CEGUI.ClassWindowManagerHG3D as CEGUIWindowManagerHG3D +import HGamer3D.Bindings.CEGUI.ClassWindowManager as CEGUIWindowManager +import HGamer3D.Bindings.CEGUI.ClassResourceProvider as CEGUIResourceProvider +import HGamer3D.Bindings.CEGUI.ClassDefaultResourceProvider as CEGUIDefaultResourceProvider +import HGamer3D.Bindings.CEGUI.ClassImageset as CEGUIImageset +import HGamer3D.Bindings.CEGUI.ClassFont as CEGUIFont +import HGamer3D.Bindings.CEGUI.ClassScheme as CEGUIScheme +import HGamer3D.Bindings.CEGUI.ClassWidgetLookManager as CEGUIWidgetLookManager +import HGamer3D.Bindings.CEGUI.ClassScriptModule as CEGUIScriptModule +import HGamer3D.Bindings.CEGUI.ClassLogger as CEGUILogger +import HGamer3D.Bindings.CEGUI.EnumLoggingLevel +import HGamer3D.Bindings.CEGUI.EnumMouseButton as CEGUIButton +import HGamer3D.Bindings.CEGUI.ClassFontManager as CEGUIFontManager +import HGamer3D.Bindings.CEGUI.ClassSchemeManager as CEGUISchemeManager +import HGamer3D.Bindings.CEGUI.ClassDefaultLogger as CEGUIDefaultLogger +import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController +import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump + + +import HGamer3D.APIs.Base.Engine.Types + +import Control.Monad.Trans +import Control.Monad.Reader + + + +initGUIEngine :: Bool -- ^fLog, log yes or no + -> IO (GUISystem) + +initGUIEngine fLog = do + + + -- CEGUI system + --------------- + + -- first logger, loglevel + + if not fLog then do + ceguilog <- CEGUISystemHG3D.createNoLogger + return () + else do + ceguilog <- CEGUIDefaultLogger.new + CEGUILogger.setLogFilename ceguilog "hgamer3d-gui.log" False + CEGUILogger.setLoggingLevel ceguilog LoggingLevelInformative + return () + + -- bootstrap complete cegui system + + guirenderer <- CEGUIOgreRenderer.bootstrapSystem + + guisystem <- CEGUISystem.getSingletonPtr + guiwindowmgr <- CEGUIWindowManagerHG3D.getSingleton + guifontmgr <- CEGUISystemHG3D.getFontManagerSingleton + guischememgr <- CEGUISystemHG3D.getSchemeManagerSingleton + + CEGUIScheme.setDefaultResourceGroup "Schemes" + CEGUIImageset.setDefaultResourceGroup "Imagesets" + CEGUIFont.setDefaultResourceGroup "Fonts" + CEGUIWidgetLookManager.setDefaultResourceGroup "LookNFeel" + CEGUIWindowManager.setDefaultResourceGroup "Layouts" +-- CEGUIScriptModule.setDefaultResourceGroup "lua_scripts" + + CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLook.scheme" + CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLookWidgets.scheme" + CEGUISystemHG3D.fontManagerCreate guifontmgr "DejaVuSans-10.font" + + CEGUISystem.setDefaultFont guisystem "DejaVuSans-10" + CEGUISystem.setDefaultMouseCursor3 guisystem "WindowsLook" "MouseArrow" + CEGUISystem.setDefaultTooltip2 guisystem "WindowsLook/Tooltip" + + -- set standard empty gui sheet + myRoot <- CEGUIWindowManager.createWindow guiwindowmgr "DefaultWindow" "root" + CEGUISystem.setGUISheet guisystem myRoot + + eventController <- HG3DEventController.new + + return (GUISystem guirenderer guisystem guiwindowmgr guifontmgr guischememgr eventController) + + +-- keypressInject + +keypressInject :: MHGamer3D () +keypressInject = do + (cs, g3s, gui) <- ask + let messagePump = g3sMessagePump g3s + let gSystem = guiSystem gui + + processEvents <- liftIO $ MessagePump.eventsPending messagePump + if processEvents then do + key <- liftIO $ MessagePump.getKeyDownEvent messagePump + if key /= 0 then do + liftIO $ CEGUISystem.injectKeyDown gSystem key + return () + else do + return () + key <- liftIO $ MessagePump.getKeyUpEvent messagePump + if key /= 0 then do + liftIO $ CEGUISystem.injectKeyUp gSystem key + return () + else do + return () + char <- liftIO $ MessagePump.getCharEvent messagePump + if char /= 0 then do + liftIO $ CEGUISystem.injectChar gSystem char + return () + else do + return () + keypressInject + return () + else do + return () + diff --git a/HGamer3D/APIs/Base/Graphics3D/Basic3D.hs b/HGamer3D/APIs/Base/Graphics3D/Basic3D.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/Graphics3D/Basic3D.hs @@ -0,0 +1,170 @@ + -- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- Basic3D.hs + +-- |Base API, Graphics3D Module, Basic3D Sub-Module. +-- Basic functionality of the HGamer3D engine. + + +module HGamer3D.APIs.Base.Graphics3D.Basic3D ( + + Position3D (..), + Scale3D (..), + translate3D, + Direction3D (..), + Orientation3D (..), + + Camera (..), + HGamer3D.APIs.Base.Graphics3D.Basic3D.getCamera, + cameraLookAt, + HGamer3D.APIs.Base.Graphics3D.Basic3D.setBackgroundColour, + + addResourceLocationMedia, + addResourceZipfileMedia, + addResourceLocationGUI, + finalizeResourceLocations +) + +where + +import HGamer3D.Data.Colour +import HGamer3D.Data.Vector +import HGamer3D.Data.Angle +import HGamer3D.Data.HG3DClass + +import HGamer3D.Bindings.Ogre.ClassCamera as Camera +import HGamer3D.Bindings.Ogre.ClassViewport as Viewport +import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager + +import HGamer3D.APIs.Base.Engine.Types + +import Control.Monad +import Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State +import Control.Concurrent + + +class Position3D t where + + position3D :: t -> MHGamer3D Vec3 + positionTo3D :: t -> Vec3 -> MHGamer3D () + +translate3D :: Position3D t => t -> Vec3 -> MHGamer3D () +translate3D t v = do + p <- position3D t + positionTo3D t ( v &+ p ) + return () + +class Scale3D t where + + scale3D :: t -> MHGamer3D Vec3 + scaleTo3D :: t -> Vec3 -> MHGamer3D () + +class Direction3D t where + direction3D :: t -> MHGamer3D Vec3 + directionTo3D :: t -> Vec3 -> MHGamer3D () + +class Orientation3D t where + orientation3D :: t -> MHGamer3D UnitQuaternion + orientationTo3D :: t -> UnitQuaternion -> MHGamer3D () + +-- Camera functions +-- + +data Camera = Camera HG3DClass + +getCamera :: MHGamer3D Camera +getCamera = do + (cs, g3s, gui) <- ask + let cam = Camera (g3sCamera g3s) + return cam + +instance Position3D Camera where + + position3D (Camera c) = do + pos <- liftIO $ Camera.getPosition c + return (pos) + + positionTo3D (Camera c) pos = do + liftIO $ Camera.setPosition2 c pos + return () + +instance Direction3D Camera where + + direction3D (Camera c) = do + d <- liftIO $ Camera.getDirection c + return d + + directionTo3D (Camera c) v = do + liftIO $ Camera.setDirection2 c v + +instance Orientation3D Camera where + + orientation3D (Camera c) = do + q <- liftIO $ Camera.getOrientation c + let uq = mkNormal q + return uq + + orientationTo3D (Camera c) uq = do + liftIO $ Camera.setOrientation c (fromNormal uq) + return () + +cameraLookAt (Camera c) v = do + liftIO $ Camera.lookAt c v + return () + +-- specific single function +-- + +setBackgroundColour :: Colour -> MHGamer3D () +setBackgroundColour bgColour = do + (cs, g3s, gui) <- ask + liftIO $ Viewport.setBackgroundColour (g3sViewport g3s) bgColour + +-- locations of media in same folder as program resides +-- + +addResourceLocationMedia :: String -> MHGamer3D () +addResourceLocationMedia path = do + (cs, g3s, gui) <- ask + let progPath = csProgPath cs + let rgm = g3sResourceGroupManager g3s + liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" "General" False + +addResourceZipfileMedia :: String -> MHGamer3D () +addResourceZipfileMedia path = do + (cs, g3s, gui) <- ask + let progPath = csProgPath cs + let rgm = g3sResourceGroupManager g3s + liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "Zip" "General" False + +addResourceLocationGUI :: String -> String -> MHGamer3D () +addResourceLocationGUI path category = do + (cs, g3s, gui) <- ask + let progPath = csProgPath cs + let rgm = g3sResourceGroupManager g3s + liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" category False + +finalizeResourceLocations :: MHGamer3D () +finalizeResourceLocations = do + (cs, g3s, gui) <- ask + let rgm = g3sResourceGroupManager g3s + liftIO $ ResourceGroupManager.initialiseAllResourceGroups rgm + diff --git a/HGamer3D/APIs/Base/Graphics3D/Engine3D.hs b/HGamer3D/APIs/Base/Graphics3D/Engine3D.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Graphics3D/Engine3D.hs +++ /dev/null @@ -1,260 +0,0 @@ --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.althainz.de/HGamer3D.html --- --- (c) 2011 Peter Althainz --- --- Licensed under the Apache License, Version 2.0 (the "License"); --- you may not use this file except in compliance with the License. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. - --- Engine3D.hs --- - --- Basic functionality of the 3D engine - -module HGamer3D.APIs.Base.Graphics3D.Engine3D ( - - Camera (..), - HGamer3D.APIs.Base.Graphics3D.Engine3D.getCamera, - cameraLookAt, - HGamer3D.APIs.Base.Graphics3D.Engine3D.setBackgroundColour, - - initEngine3D, - renderLoop -) - -where - - -import GHC.Ptr - -import HGamer3D.Bindings.Ogre.ClassPtr -import HGamer3D.Bindings.Ogre.Utils - -import HGamer3D.Data.Colour -import HGamer3D.Data.Vector -import HGamer3D.Data.Angle - -import HGamer3D.Bindings.Ogre.StructColour -import HGamer3D.Bindings.Ogre.StructSharedPtr - -import HGamer3D.Bindings.Ogre.EnumSceneType -import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace - -import HGamer3D.Bindings.Ogre.ClassCamera as Camera -import HGamer3D.Bindings.Ogre.ClassRoot as Root -import HGamer3D.Bindings.Ogre.ClassLight as Light -import HGamer3D.Bindings.Ogre.ClassNode as Node -import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager -import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode -import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget -import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow -import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager -import HGamer3D.Bindings.Ogre.ClassTextureManager as TextureManager -import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager -import HGamer3D.Bindings.Ogre.ClassViewport as Viewport -import HGamer3D.Bindings.Ogre.ClassFrustum as Frustum -import HGamer3D.Bindings.Ogre.ClassAnimationState as AnimationState -import HGamer3D.Bindings.Ogre.ClassEntity as Entity -import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager -import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities -import HGamer3D.Bindings.Ogre.ClassLogManager as LogManager -import HGamer3D.Bindings.Ogre.ClassLog as Log - -import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject -import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType -import HGamer3D.Bindings.Ogre.StructHG3DClass -import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType - -import HGamer3D.Data.HG3DClass -import HGamer3D.APIs.Base.Common - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.State -import Control.Concurrent - -import System.Win32.Process -import System.Environment (getArgs) - - --- Camera functions --- - -data Camera = Camera HG3DClass - -getCamera :: MHGamer3D Camera -getCamera = do - (cs, es) <- ask - let cam = Camera (esCamera es) - return cam - -instance Position3D Camera where - - position3D (Camera c) = do - pos <- liftIO $ Camera.getPosition c - return (pos) - - positionTo3D (Camera c) pos = do - liftIO $ Camera.setPosition2 c pos - return () - -instance Direction3D Camera where - - direction3D (Camera c) = do - d <- liftIO $ Camera.getDirection c - return d - - directionTo3D (Camera c) v = do - liftIO $ Camera.setDirection2 c v - -instance Orientation3D Camera where - - orientation3D (Camera c) = do - q <- liftIO $ Camera.getOrientation c - let uq = mkNormal q - return uq - - orientationTo3D (Camera c) uq = do - liftIO $ Camera.setOrientation c (fromNormal uq) - return () - -cameraLookAt (Camera c) v = do - liftIO $ Camera.lookAt c v - return () - --- specific single function --- - -setBackgroundColour :: Colour -> MHGamer3D () -setBackgroundColour bgColour = do - (cs, es) <- ask - liftIO $ Viewport.setBackgroundColour (esViewport es) bgColour - - - -initEngine3D :: CommonSystem - -> String -- ^Name of the window, displayed - -> String -- ^SceneManager type used - -> IO (EngineSystem) - -initEngine3D cs windowName sceneManagerType = do - - let hg3dpath = (csHG3DPath cs) - - -- create a good experience for the user, starting the - -- engine, and also, make sure, we can modify options - - args <- getArgs - let fConfig = foldl (||) False $ map (\arg -> if arg == "--config" then True else False) args - let fDX = foldl (||) False $ map (\arg -> if arg == "--directx" then True else False) args - let fLog = foldl (||) False $ map (\arg -> if arg == "--logging" then True else False) args - let plugins = if fDX then hg3dpath ++ "\\config\\pluginsDX.cfg" else hg3dpath ++ "\\config\\plugins.cfg" - let config = if fDX then hg3dpath ++ "\\config\\engineDX.cfg" else hg3dpath ++ "\\config\\engine.cfg" - print "Here comes the path info" - print plugins - print config - - root <- Root.new plugins config "" - lmgr <- LogManager.getSingletonPtr - if not fLog then do - newlog <- LogManager.createLog lmgr "SilentLog" True False True - return () - else do - newlog <- LogManager.createLog lmgr "hgamer3d-engine.log" True False False - return () - - fOk <- if fConfig then - Root.showConfigDialog root - else do - fLoaded <- Root.restoreConfig root - if not fLoaded then - Root.showConfigDialog root - else - return True - - --- fUAddResourceLocations "resources.cfg" - renderWindow <-Root.initialise root True windowName "" - - -- Suppress logging unless, fLog - - sceneManager <- Root.createSceneManager root sceneManagerType "SceneManager" - - camera <- SceneManager.createCamera sceneManager "SimpleCamera" - Frustum.setNearClipDistance camera 5.0 - Frustum.setFarClipDistance camera 5000.0 - - - viewport <- RenderTarget.addViewport renderWindow camera 0 0.0 0.0 1.0 1.0 - let bgColor = Colour 0.0 0.0 0.0 1.0 - Viewport.setBackgroundColour viewport bgColor - - height <- Viewport.getActualHeight viewport - width <- Viewport.getActualWidth viewport - - Frustum.setAspectRatio camera ((fromIntegral width) / (fromIntegral height)) - - tm <- TextureManager.getSingletonPtr - TextureManager.setDefaultNumMipmaps tm 20 - - rgm <- ResourceGroupManager.getSingletonPtr - ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\materials") "FileSystem" "General" False - ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\Sinbad.zip") "Zip" "General" False - ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\ywing.zip") "Zip" "General" False - ResourceGroupManager.initialiseAllResourceGroups rgm - - - cm <- ControllerManager.new - - return (EngineSystem root sceneManager rgm tm cm lmgr camera renderWindow viewport ) - - - --- renderStep a :: TimeMS -> a -> MHGamer3D (Bool, a) --- this function needs to be defined in - -renderInternalStep :: Int -> TimeMS -> MHGamer3D (Bool, TimeMS) -renderInternalStep frameRate (TimeMS lastTime) = do - (cs, es) <- ask - -- adapt to framerate, while still doing messagePump - (TimeMS time) <- getTimeMS - let delta = time - lastTime - let waitTimeMS = (1000.0 / (fromIntegral frameRate) ) - (fromIntegral delta) - time <- if waitTimeMS > 0.0 then do - liftIO $ sleep (round waitTimeMS) - (TimeMS time) <- getTimeMS - return (time) - else - return (time) - -- adapt - liftIO $ WindowEventUtilities.messagePump - closed <- liftIO $ RenderWindow.isClosed (esRenderWindow es) - if (closed) then - return (False, (TimeMS time)) - else do - liftIO $ Root.renderOneFrame (esRoot es) - return (True, (TimeMS time)) - -renderLoop :: Int -> TimeMS -> a -> (TimeMS -> a -> MHGamer3D (Bool, a)) -> MHGamer3D () -renderLoop frameRate t a renderStep = do - (cs, es) <- ask - (flagStep, time) <- renderInternalStep frameRate t - let delta = TimeMS (time' - t') where - TimeMS time' = time - TimeMS t' = t - (flagLoop, a) <- renderStep delta a - if (flagStep && flagLoop) then do - renderLoop frameRate time a renderStep - else return () - diff --git a/HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs b/HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs @@ -0,0 +1,172 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- EngineHelper.hs + +-- |Base API, Graphics3D Module, EngineHelper Sub-Module. +-- Functionality of the 3D module, which is needed for the game engine. + + +module HGamer3D.APIs.Base.Graphics3D.EngineHelper ( + + initGraphics3D +) + +where + + +import GHC.Ptr + + +import HGamer3D.Data.Colour +import HGamer3D.Data.Vector +import HGamer3D.Data.Angle +import HGamer3D.Data.HG3DClass + +import HGamer3D.Bindings.Ogre.ClassPtr +import HGamer3D.Bindings.Ogre.Utils +import HGamer3D.Bindings.Ogre.StructColour +import HGamer3D.Bindings.Ogre.StructSharedPtr +import HGamer3D.Bindings.Ogre.EnumSceneType +import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace +import HGamer3D.Bindings.Ogre.ClassCamera as Camera +import HGamer3D.Bindings.Ogre.ClassRoot as Root +import HGamer3D.Bindings.Ogre.ClassLight as Light +import HGamer3D.Bindings.Ogre.ClassNode as Node +import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager +import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode +import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget +import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow +import HGamer3D.Bindings.Ogre.ClassRenderSystem as RenderSystem +import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager +import HGamer3D.Bindings.Ogre.ClassTextureManager as TextureManager +import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager +import HGamer3D.Bindings.Ogre.ClassViewport as Viewport +import HGamer3D.Bindings.Ogre.ClassFrustum as Frustum +import HGamer3D.Bindings.Ogre.ClassAnimationState as AnimationState +import HGamer3D.Bindings.Ogre.ClassEntity as Entity +import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager +-- import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities +import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump +import HGamer3D.Bindings.Ogre.ClassLogManager as LogManager +import HGamer3D.Bindings.Ogre.ClassLog as Log + +import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject +import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType +import HGamer3D.Bindings.Ogre.StructHG3DClass +import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType +import HGamer3D.Bindings.Ogre.ClassWindowUtilsHG3D as WindowUtils + +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Graphics3D.Basic3D +import qualified HGamer3D.APIs.Base.InputSystem.InputSystem as IS + +import Control.Monad +import Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State +import Control.Concurrent + +import System.Win32.Process +import System.Environment (getArgs) + +initGraphics3D :: String -- ^Name of the window, displayed + -> String -- ^SceneManager type used + -> String -- path + -> Bool -- fConfig + -> Bool -- fDX + -> Bool -- fLog + -> IO (Graphics3DSystem) + +initGraphics3D windowName sceneManagerType hg3dpath fConfig fDX fLog = do + + let plugins = if fDX then hg3dpath ++ "\\config\\pluginsDX.cfg" else hg3dpath ++ "\\config\\plugins.cfg" + let config = if fDX then hg3dpath ++ "\\config\\engineDX.cfg" else hg3dpath ++ "\\config\\engine.cfg" + + root <- Root.new plugins config "" + lmgr <- LogManager.getSingletonPtr + if not fLog then do + newlog <- LogManager.createLog lmgr "SilentLog" True False True + return () + else do + newlog <- LogManager.createLog lmgr "hgamer3d-engine.log" True False False + return () + + fOk <- if fConfig then + Root.showConfigDialog root + else do + fLoaded <- Root.restoreConfig root + if not fLoaded then + Root.showConfigDialog root + else + return True + + +-- fUAddResourceLocations "resources.cfg" + renderWindow <-Root.initialise root True windowName "" + + -- Suppress logging unless, fLog + + sceneManager <- Root.createSceneManager root sceneManagerType "SceneManager" + + camera <- SceneManager.createCamera sceneManager "SimpleCamera" + Frustum.setNearClipDistance camera 5.0 + Frustum.setFarClipDistance camera 5000.0 + + + viewport <- RenderTarget.addViewport renderWindow camera 0 0.0 0.0 1.0 1.0 + let bgColor = Colour 0.0 0.0 0.0 1.0 + Viewport.setBackgroundColour viewport bgColor + + height <- Viewport.getActualHeight viewport + width <- Viewport.getActualWidth viewport + + Frustum.setAspectRatio camera ((fromIntegral width) / (fromIntegral height)) + + tm <- TextureManager.getSingletonPtr + TextureManager.setDefaultNumMipmaps tm 20 + + rgm <- ResourceGroupManager.getSingletonPtr + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\materials") "FileSystem" "General" False +-- ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\Sinbad.zip") "Zip" "General" False +-- ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\ywing.zip") "Zip" "General" False + + ResourceGroupManager.createResourceGroup rgm "Schemes" False + ResourceGroupManager.createResourceGroup rgm "Imagesets" False + ResourceGroupManager.createResourceGroup rgm "Fonts" False + ResourceGroupManager.createResourceGroup rgm "Layouts" False + ResourceGroupManager.createResourceGroup rgm "LookNFeel" False + ResourceGroupManager.createResourceGroup rgm "LuaScripts" False + ResourceGroupManager.createResourceGroup rgm "XMLSchemas" False + + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\schemes") "FileSystem" "Schemes" False + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\imagesets") "FileSystem" "Imagesets" False + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\fonts") "FileSystem" "Fonts" False + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\layouts") "FileSystem" "Layouts" False + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\looknfeel") "FileSystem" "LookNFeel" False + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\lua_scripts") "FileSystem" "LuaScripts" False + ResourceGroupManager.addResourceLocation rgm (hg3dpath ++ "\\media\\gui\\xml_schemas") "FileSystem" "XMLSchemas" False + + + cm <- ControllerManager.new + WindowUtils.showCursor False + messagePump <- MessagePump.new + + return (Graphics3DSystem root sceneManager rgm tm cm lmgr camera renderWindow viewport messagePump ) + + diff --git a/HGamer3D/APIs/Base/Graphics3D/Light.hs b/HGamer3D/APIs/Base/Graphics3D/Light.hs --- a/HGamer3D/APIs/Base/Graphics3D/Light.hs +++ b/HGamer3D/APIs/Base/Graphics3D/Light.hs @@ -17,10 +17,11 @@ -- limitations under the License. -- Light.hs --- --- Light functionality +-- |Base API, Graphics3D Module, Light Sub-Module. +-- Creating and managing Light. + module HGamer3D.APIs.Base.Graphics3D.Light ( Light (..), @@ -79,8 +80,10 @@ import Control.Monad.Reader import Control.Monad.State -import HGamer3D.APIs.Base.Common -import HGamer3D.APIs.Base.Graphics3D.Engine3D +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine +import HGamer3D.APIs.Base.Graphics3D.EngineHelper +import HGamer3D.APIs.Base.Graphics3D.Basic3D data Light = Light HG3DClass deriving (Show) @@ -109,8 +112,8 @@ -- | creates a light, which fills all the room with similar strength setAmbientLight :: Colour -> MHGamer3D () setAmbientLight colour = do - (cs, es) <- ask - liftIO $ SceneManager.setAmbientLight (esSceneManager es) colour + (cs, g3s, gui) <- ask + liftIO $ SceneManager.setAmbientLight (g3sSceneManager g3s) colour return () @@ -120,9 +123,9 @@ -> MHGamer3D (Light) -- ^Return value is a graphics object createPointLight colour (Vec3 x y z) = do - (cs, es) <- ask - lightName <- lift $ getUniqueName "LO" - light <- liftIO $ SceneManager.createLight (esSceneManager es) lightName + (cs, g3s, gui) <- ask + lightName <- getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_DIRECTIONAL liftIO $ Light.setPosition light x y z let eo = Light light @@ -134,9 +137,9 @@ -> MHGamer3D (Light) -- ^Return value is a graphics object createSpotLight colour (Vec3 x y z) = do - (cs, es) <- ask - lightName <- lift $ getUniqueName "LO" - light <- liftIO $ SceneManager.createLight (esSceneManager es) lightName + (cs, g3s, gui) <- ask + lightName <- getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_SPOTLIGHT liftIO $ Light.setPosition light x y z let eo = Light light @@ -149,9 +152,9 @@ -> MHGamer3D (Light) -- ^Return value is a graphics object createDirectionalLight colour (Vec3 x y z) = do - (cs, es) <- ask - lightName <- lift $ getUniqueName "LO" - light <- liftIO $ SceneManager.createLight (esSceneManager es) lightName + (cs, g3s, gui) <- ask + lightName <- getUniqueName "LO" + light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName liftIO $ Light.setType light LT_DIRECTIONAL liftIO $ Light.setPosition light x y z let eo = Light light diff --git a/HGamer3D/APIs/Base/Graphics3D/Object3D.hs b/HGamer3D/APIs/Base/Graphics3D/Object3D.hs --- a/HGamer3D/APIs/Base/Graphics3D/Object3D.hs +++ b/HGamer3D/APIs/Base/Graphics3D/Object3D.hs @@ -17,20 +17,34 @@ -- limitations under the License. -- Object3D.hs --- --- Graphics Objects 3D functionality +-- |Base API, Graphics3D Module, Object3D Sub-Module. +-- Creating and managing 3D objects. + module HGamer3D.APIs.Base.Graphics3D.Object3D ( Object3D (..), Material (..), + + Mesh (..), + + createColouredLineMesh, + createColouredCubeMesh, + createRainbowCubeMesh, + + createObject3D, + createSphere, createCube, createPlane, - createMesh, createLine, - setObjectMaterial, + createNamedMeshObject, + createColouredLine, + createColouredCube, + createRainbowCube, + + setObjectMaterial, combineObjects ) @@ -82,74 +96,217 @@ import Control.Monad.Reader import Control.Monad.State -import HGamer3D.APIs.Base.Common -import HGamer3D.APIs.Base.Graphics3D.Engine3D +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine +import HGamer3D.APIs.Base.Graphics3D.EngineHelper +import HGamer3D.APIs.Base.Graphics3D.Basic3D -data Object3D = Object3D HG3DClass HG3DClass | -- node entity - Object3DCombined HG3DClass -- node only +data Object3D = SingleObject3D HG3DClass HG3DClass | -- node entity + CombinedObject3D HG3DClass [Object3D] -- node, subnodes getNode :: Object3D -> HG3DClass -getNode (Object3D node entity) = node -getNode (Object3DCombined node) = node +getNode (SingleObject3D node entity) = node +getNode (CombinedObject3D node objects) = node +getEntities :: Object3D -> [HG3DClass] +getEntities (SingleObject3D node entity) = [entity] +getEntities (CombinedObject3D node objects) = foldl (++) [] (map getEntities objects) + data Material = NamedMaterial String -createObjectFromEntity :: HG3DClass -> EngineSystem -> IO Object3D -createObjectFromEntity entity es = do - rootNode <- SceneManager.getRootSceneNode (esSceneManager es) +data Mesh = CubeMesh | -- Cube Mesh-Type + PlaneMesh | -- Plane Mesh-Type + SphereMesh | -- Sphere Mesh-Type + NamedMesh String | -- Mesh resource loaded from file + ManualMesh String -- Manual Mesh-Type, identified by name + +createColouredLineMesh :: Vec3 -> Vec3 -> Material -> Colour -> MHGamer3D Mesh +createColouredLineMesh vStart vEnd (NamedMaterial materialName) colour = do + (cs, g3s, gui) <- ask + lineName <- getUniqueName "Line" + meshName <- getUniqueName "Mesh" + mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) lineName + liftIO $ ManualObject.begin mo materialName OT_LINE_LIST "General" + liftIO $ ManualObject.position mo vStart + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position mo vEnd + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.end mo + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + +-- |Creates a cube by using the ManualObject functionality of Ogre +createColouredCubeMesh :: Material -> Colour -- ^The color of the line + -> MHGamer3D Mesh -- ^Return value is a mesh +createColouredCubeMesh (NamedMaterial materialName) colour = do + + + (cs, g3s, gui) <- ask + cubeName <- getUniqueName "Cube" + meshName <- getUniqueName "Mesh" + + mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) cubeName + + -- basic parameters + let lsize = 1.0 + let cp = 1.0 * lsize + let cm = -1.0 * lsize + + liftIO $ ManualObject.begin mo materialName OT_TRIANGLE_LIST "General" + + liftIO $ ManualObject.position2 mo cm cp cm -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cp cm -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cm cm -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cm cm cm -- a vertex + liftIO $ ManualObject.colour mo colour + + liftIO $ ManualObject.position2 mo cm cp cp -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cp cp -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cp cm cp -- a vertex + liftIO $ ManualObject.colour mo colour + liftIO $ ManualObject.position2 mo cm cm cp -- a vertex + liftIO $ ManualObject.colour mo colour + + liftIO $ ManualObject.triangle mo 0 1 2 + liftIO $ ManualObject.triangle mo 2 3 0 + liftIO $ ManualObject.triangle mo 4 6 5 + liftIO $ ManualObject.triangle mo 6 4 7 + + liftIO $ ManualObject.triangle mo 0 4 5 + liftIO $ ManualObject.triangle mo 5 1 0 + liftIO $ ManualObject.triangle mo 2 6 7 + liftIO $ ManualObject.triangle mo 7 3 2 + + liftIO $ ManualObject.triangle mo 0 7 4 + liftIO $ ManualObject.triangle mo 7 0 3 + liftIO $ ManualObject.triangle mo 1 5 6 + liftIO $ ManualObject.triangle mo 6 2 1 + + liftIO $ ManualObject.end mo + + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + + +-- create a rainbow coloured cube with manual ojbect lib +-- +createRainbowCubeMesh :: MHGamer3D Mesh +createRainbowCubeMesh = do + + (cs, g3s, gui) <- ask + cubeName <- getUniqueName "Cube" + meshName <- getUniqueName "Mesh" + + let materialName = "BaseWhiteNoLighting" + + mo <- liftIO $ SceneManager.createManualObject (g3sSceneManager g3s) cubeName + + -- basic parameters + let lsize = 1.0 + let cp = 1.0 * lsize + let cm = -1.0 * lsize + + liftIO $ ManualObject.begin mo "BaseWhiteNoLighting" OT_TRIANGLE_LIST "General" + + sequence $ map (\(x, y, z, c) -> liftIO $ ManualObject.position2 mo x y z >> ManualObject.colour mo c) [ + (cm, cp, cm, (Colour 0.0 1.0 0.0 1.0) ), + (cp, cp, cm, (Colour 1.0 1.0 0.0 1.0) ), + (cp, cm, cm, (Colour 1.0 0.0 0.0 1.0) ), + (cm, cm, cm, (Colour 0.0 0.0 0.0 1.0) ), + + (cm, cp, cp, (Colour 0.0 1.0 1.0 1.0) ), + (cp, cp, cp, (Colour 1.0 1.0 1.0 1.0) ), + (cp, cm, cp, (Colour 1.0 0.0 1.0 1.0) ), + (cm, cm, cp, (Colour 0.0 0.0 1.0 1.0) ) ] + + sequence $ map (\(x,y,z) -> liftIO $ ManualObject.triangle mo x y z) [ + (0, 1, 2), + (2, 3, 0), + (4, 6, 5), + (6, 4, 7), + + (0, 4, 5), + (5, 1, 0), + (2, 6, 7), + (7, 3, 2), + + (0, 7, 4), + (7, 0, 3), + (1, 5, 6), + (6, 2, 1) ] + + liftIO $ ManualObject.end mo + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + + + +createObject3D :: Mesh -> MHGamer3D Object3D +createObject3D mesh = do + (cs, g3s, gui) <- ask + -- first create entity from the mesh + entity <- case mesh of + CubeMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_CUBE + SphereMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_SPHERE + PlaneMesh -> liftIO $ SceneManager.createEntity6 (g3sSceneManager g3s) PT_PLANE + (NamedMesh name) -> liftIO $ SceneManager.createEntity3 (g3sSceneManager g3s) name + (ManualMesh name) -> liftIO $ SceneManager.createEntity3 (g3sSceneManager g3s) name + -- now create node and attach entity to it + rootNode <- liftIO $ SceneManager.getRootSceneNode (g3sSceneManager g3s) let vzero = Vec3 0.0 0.0 0.0 let qident = Q (Vec4 1.0 0.0 0.0 0.0) - node <- SceneNode.createChildSceneNode rootNode vzero qident - SceneNode.attachObject node entity - return (Object3D node entity) - + node <- liftIO $ SceneNode.createChildSceneNode rootNode vzero qident + liftIO $ SceneNode.attachObject node entity + -- return object + return (SingleObject3D node entity) + createSphere :: MHGamer3D Object3D createSphere = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_SPHERE - ob <- liftIO $ createObjectFromEntity entity es + ob <- createObject3D SphereMesh return (ob) createCube :: MHGamer3D Object3D createCube = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_CUBE - ob <- liftIO $ createObjectFromEntity entity es + ob <- createObject3D CubeMesh return (ob) createPlane :: MHGamer3D Object3D createPlane = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity4 (esSceneManager es) PT_PLANE - ob <- liftIO $ createObjectFromEntity entity es + ob <- createObject3D PlaneMesh return (ob) -createMesh :: String -> MHGamer3D Object3D -createMesh name = do - (cs, es) <- ask - entity <- liftIO $ SceneManager.createEntity2 (esSceneManager es) name - ob <- liftIO $ createObjectFromEntity entity es +createNamedMeshObject :: String -> MHGamer3D Object3D +createNamedMeshObject name = do + ob <- createObject3D (NamedMesh name) return (ob) -createLine :: Vec3 -> Vec3 -> MHGamer3D Object3D -createLine vStart vEnd = do - (cs, es) <- ask - lineName <- lift $ getUniqueName "GO" - name <- lift $ getUniqueName "GO" - let materialName = "BaseWhiteNoLighting" - let colour = Colour 1.0 1.0 1.0 1.0 - mo <- liftIO $ SceneManager.createManualObject (esSceneManager es) lineName - liftIO $ ManualObject.begin mo materialName OT_LINE_LIST "General" - liftIO $ ManualObject.position mo vStart - liftIO $ ManualObject.colour mo colour - liftIO $ ManualObject.position mo vEnd - liftIO $ ManualObject.colour mo colour - liftIO $ ManualObject.end mo - mesh <- liftIO $ ManualObject.convertToMesh mo name "General" - obj <- createMesh name - return (obj) +createLine :: Vec3 -> Vec3 -> Colour -> MHGamer3D Object3D +createLine vStart vEnd colour = do + mesh <- createColouredLineMesh vStart vEnd (NamedMaterial "BaseWhiteNoLighting") colour + ob <- createObject3D mesh + return ob +createColouredLine vStart vEnd material colour = do + mesh <- createColouredLineMesh vStart vEnd material colour + ob <- createObject3D mesh + return ob + +createColouredCube material colour = do + mesh <- createColouredCubeMesh material colour + ob <- createObject3D mesh + return ob + +createRainbowCube = do + mesh <- createRainbowCubeMesh + ob <- createObject3D mesh + return ob + instance Position3D Object3D where position3D obj = do @@ -182,33 +339,32 @@ return () setObjectMaterial :: Object3D -> Material -> MHGamer3D () -setObjectMaterial (Object3D node entity) (NamedMaterial name) = do - liftIO $ Entity.setMaterialName entity name "General" -setObjectMaterial (Object3DCombined node) (NamedMaterial name) = do - liftIO $ print "try to set material of combined object, not possible" +setObjectMaterial object (NamedMaterial name) = do + let entities = getEntities object + sequence $ map (\entity -> liftIO $ Entity.setMaterialName entity name "General") entities + return () -- |This function groups objects into a new object -- it is not perfoming any geometric operations, it just groups the -- input objects. Can be used, to move and rotate a group. + combineObjects :: [Object3D] -- ^A list of objects, to be grouped -> MHGamer3D (Object3D) -- ^The return value is a new GraphicsObject + combineObjects listObjects = do - (cs, es) <- ask - rootNode <- liftIO $ SceneManager.getRootSceneNode (esSceneManager es) + (cs, g3s, gui) <- ask + rootNode <- liftIO $ SceneManager.getRootSceneNode (g3sSceneManager g3s) let vzero = Vec3 0.0 0.0 0.0 let qident = Q (Vec4 1.0 0.0 0.0 0.0) node <- liftIO $ SceneNode.createChildSceneNode rootNode vzero qident - sequence_ (map ( \(Object3D objectnode object) -> do + sequence_ (map ( \object -> do + let objectnode = getNode object parent <- liftIO $ Node.getParent objectnode - -- currently no check here, if parent exists! - -- no parent is only valid for root node and this is not accessible to the - -- user of this api (should not be used, at least) liftIO $ Node.removeChild2 parent objectnode liftIO $ Node.addChild node objectnode return () ) listObjects) - return ( Object3DCombined node ) - + return ( CombinedObject3D node listObjects) diff --git a/HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs b/HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs @@ -0,0 +1,245 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- PlatonObjects.hs + +-- |Base API, Graphics3D Module, PlatonObjects Sub-Module. +-- Creating platonic bodies 3D objects. + + +module HGamer3D.APIs.Base.Graphics3D.PlatonObjects ( + + createIkosaederMesh, + createDodekaederMesh, + createIkosaeder, + createDodekaeder + +) + +where + + +import GHC.Ptr + +import HGamer3D.Bindings.Ogre.ClassPtr +import HGamer3D.Bindings.Ogre.Utils + +import HGamer3D.Data.Colour +import HGamer3D.Data.Vector +import HGamer3D.Data.Angle + +import HGamer3D.Bindings.Ogre.StructColour +import HGamer3D.Bindings.Ogre.StructSharedPtr + +import HGamer3D.Bindings.Ogre.EnumSceneType +import HGamer3D.Bindings.Ogre.EnumNodeTransformSpace +import HGamer3D.Bindings.Ogre.EnumLightType + +import HGamer3D.Bindings.Ogre.ClassCamera as Camera +import HGamer3D.Bindings.Ogre.ClassRoot as Root +import HGamer3D.Bindings.Ogre.ClassLight as Light +import HGamer3D.Bindings.Ogre.ClassNode as Node +import HGamer3D.Bindings.Ogre.ClassSceneManager as SceneManager +import HGamer3D.Bindings.Ogre.ClassSceneNode as SceneNode +import HGamer3D.Bindings.Ogre.ClassRenderTarget as RenderTarget +import HGamer3D.Bindings.Ogre.ClassRenderWindow as RenderWindow +import HGamer3D.Bindings.Ogre.ClassResourceGroupManager as ResourceGroupManager +import HGamer3D.Bindings.Ogre.ClassTextureManager as TextureManager +import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager +import HGamer3D.Bindings.Ogre.ClassViewport as Viewport +import HGamer3D.Bindings.Ogre.ClassFrustum as Frustum +import HGamer3D.Bindings.Ogre.ClassAnimationState as AnimationState +import HGamer3D.Bindings.Ogre.ClassEntity as Entity +import HGamer3D.Bindings.Ogre.ClassControllerManager as ControllerManager +import HGamer3D.Bindings.Ogre.ClassWindowEventUtilities as WindowEventUtilities + +import HGamer3D.Bindings.Ogre.ClassManualObject as ManualObject +import HGamer3D.Bindings.Ogre.EnumRenderOperationOperationType +import HGamer3D.Bindings.Ogre.StructHG3DClass +import HGamer3D.Bindings.Ogre.EnumSceneManagerPrefabType + +import HGamer3D.Data.HG3DClass + +import Control.Monad.Trans +import Control.Monad.Reader +import Control.Monad.State + +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine +import HGamer3D.APIs.Base.Graphics3D.EngineHelper +import HGamer3D.APIs.Base.Graphics3D.Basic3D +import HGamer3D.APIs.Base.Graphics3D.Object3D + + +vminus = Vec3 (-1.0) (-1.0) (-1.0) + +getNormOfFace vertices (a, b, c) = normalize cross + where + v1 = vertices !! a + v2 = vertices !! b + v3 = vertices !! c + cross = (v2 &- v1) `crossprod` (v3 &- v1) + + +isIn (a, b, c) n = if n == a then True else + if n == b then True else + if n == c then True else + False + + +_createPlatonObject :: Graphics3DSystem -> String -> String -> Colour -> [Vec3] -> [(Int, Int, Int)] -> Int -> IO HG3DClass +_createPlatonObject g3s name material colour vertices faces iColor = do + + mo <- SceneManager.createManualObject (g3sSceneManager g3s) name + -- set Dynamic to false + ManualObject.setDynamic mo False + + let normsOfFaces = map (getNormOfFace vertices) faces + + let vzero = Vec3 0.0 0.0 0.0 + + let normsOfVertices = map vnorm allVerticesIndexes + where + allVerticesIndexes = [ i | i <- [0..(length vertices)]] + vnorm = (\i -> normalize $ foldr (&+) vzero (map (\face -> if isIn face i then normsOfFaces !! i else vzero) faces)) + + sequence $ map (\((x,y,z), norm) -> do + ManualObject.begin mo material OT_TRIANGLE_LIST "General" + ManualObject.position mo (vertices !! x) + ManualObject.normal mo norm + ManualObject.position mo (vertices !! y) + ManualObject.position mo (vertices !! z) + ManualObject.triangle mo 0 1 2 + ManualObject.end mo) (zip faces normsOfFaces) + + return mo + + + +createIkosaederMesh :: String -> Colour -> MHGamer3D Mesh +createIkosaederMesh material colour = do + + (cs, g3s, gui) <- ask + bodyName <- getUniqueName "Platon" + meshName <- getUniqueName "Mesh" + + let x = 0.525731112119133606 + let z = 0.850650808352039932 + + let vertices = [ + ( Vec3 (-x) 0.0 z), + ( Vec3 x 0.0 z), + ( Vec3 (-x) 0.0 (-z)), + ( Vec3 x 0.0 (-z)), + ( Vec3 0.0 z x), + ( Vec3 0.0 z (-x)), + ( Vec3 0.0 (-z) x), + ( Vec3 0.0 (-z) (-x)), + ( Vec3 z x 0.0), + ( Vec3 (-z) x 0.0), + ( Vec3 z (-x) 0.0), + ( Vec3 (-z) (-x) 0.0) + ] + + let faces = [ + + (0,4,1), (0,9,4), (9,5,4), (4,5,8), (4,8,1), + (8,10,1), (8,3,10), (5,3,8), (5,2,3), (2,7,3), + (7,10,3), (7,6,10), (7,11,6), (11,0,6), (0,1,6), + (6,1,10), (9,0,11), (9,11,2), (9,2,5), (7,2,11) + + ] + + mo <- liftIO $ _createPlatonObject g3s bodyName material colour vertices faces 0 + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + + + +createDodekaederMesh :: String -> Colour -> MHGamer3D Mesh +createDodekaederMesh material colour = do + + (cs, g3s, gui) <- ask + bodyName <- getUniqueName "Platon" + meshName <- getUniqueName "Mesh" + + let s = 0.618034 + let t = 1.618034 + + + let vertices = [ + + (Vec3 1.0 1.0 1.0), + (Vec3 1.0 1.0 (-1.0)), + (Vec3 1.0 (-1.0) 1.0), + (Vec3 1.0 (-1.0) (-1.0)), + (Vec3 (-1.0) 1.0 1.0), + (Vec3 (-1.0) 1.0 (-1.0)), + (Vec3 (-1.0) (-1.0) 1.0), + (Vec3 (-1.0) (-1.0) (-1.0)), + (Vec3 s t 0.0), + (Vec3 (-s) t 0.0), + (Vec3 s (-t) 0.0), + (Vec3 (-s) (-t) 0.0), + (Vec3 t 0.0 s), + (Vec3 t 0.0 (-s)), + (Vec3 (-t) 0.0 s), + (Vec3 (-t) 0.0 (-s)), + (Vec3 0.0 s t), + (Vec3 0.0 (-s) t), + (Vec3 0.0 s (-t)), + (Vec3 0.0 (-s) (-t)) + + ] + + let faces = [ + +-- (1,8,0,12,13), (4, 9, 5, 15, 14), +-- (2, 10, 3, 13, 12), (7, 11, 6, 14, 15), +-- (2, 12, 0, 16, 17), (1, 13, 3, 19, 18), +-- (4, 14, 6, 17, 16), (7, 15, 5, 18, 19), +-- (4, 16, 0, 8, 9), (2, 17, 6, 11, 10), +-- (1, 18, 5, 9, 8), (7, 19, 3, 10, 11) + + (1,8,0,12,13), (4, 9, 5, 15, 14), + (2, 10, 3, 13, 12), (7, 11, 6, 14, 15), + (2, 12, 0, 16, 17), (1, 13, 3, 19, 18), + (4, 14, 6, 17, 16), (7, 15, 5, 18, 19), + (4, 16, 0, 8, 9), (2, 17, 6, 11, 10), + (1, 18, 5, 9, 8), (7, 19, 3, 10, 11) + + ] + + let faces2 = foldl (++) [] $ map ( \(a, b, c, d, e) -> [ (a, b, e), (b, d, e), (c, d, b) ] ) faces + + mo <- liftIO $ _createPlatonObject g3s bodyName material colour vertices faces2 0 + liftIO $ ManualObject.convertToMesh mo meshName "General" + return (ManualMesh meshName) + + +createIkosaeder material colour = do + mesh <- createIkosaederMesh material colour + ob <- createObject3D mesh + return ob + + +createDodekaeder material colour = do + mesh <- createDodekaederMesh material colour + ob <- createObject3D mesh + return ob + diff --git a/HGamer3D/APIs/Base/InputSystem.hs b/HGamer3D/APIs/Base/InputSystem.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/InputSystem.hs +++ /dev/null @@ -1,154 +0,0 @@ --- This source file is part of HGamer3D --- (A project to enable 3D game development in Haskell) --- For the latest info, see http://www.althainz.de/HGamer3D.html --- --- (c) 2011 Peter Althainz --- --- Licensed under the Apache License, Version 2.0 (the "License"); --- you may not use this file except in compliance with the License. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. - --- InputSystem.hs - --- |This module is the Input System and handles Mouse, Keyboard and Joystick Input. - -module HGamer3D.APIs.Base.InputSystem - -( - -- Enums - -- - module HGamer3D.Bindings.SFML.EnumJoystickAxis, - module HGamer3D.Bindings.SFML.EnumKey, - module HGamer3D.Bindings.SFML.EnumMouseButton, - - -- Joystick Data - Joystick (..), - JoystickButton (..), - - -- Joystick Functions - updateJoystickStatus, - - getConnectedJoysticks, - getJoystickAxes, - getJoystickButtons, - - isJoystickButtonPressed, - getJoystickAxisPosition, - - -- Keyboard Functions - isKeyPressed, - - -- Mouse Functions - isMouseButtonPressed, - getMousePosition, - - - -) - -where - -import GHC.Ptr - -import HGamer3D.Bindings.SFML.ClassPtr -import HGamer3D.Bindings.SFML.Utils - -import qualified HGamer3D.Bindings.SFML.ClassJoystick as Joystick -import qualified HGamer3D.Bindings.SFML.ClassKeyboard as Keyboard -import qualified HGamer3D.Bindings.SFML.ClassMouse as Mouse -import qualified HGamer3D.Bindings.SFML.ClassMouseHG3D as Mouse2 -import HGamer3D.Bindings.SFML.EnumJoystickAxis -import HGamer3D.Bindings.SFML.EnumKey -import HGamer3D.Bindings.SFML.EnumMouseButton - -import HGamer3D.APIs.Base.Common -import HGamer3D.Data.HG3DClass -import Control.Monad.Trans -import Control.Monad.Reader -import HGamer3D.Data.Vector - - --- Joystick Data -data Joystick = Joystick Int deriving (Eq) -data JoystickButton = JoystickButton Int deriving (Eq) - -instance Show Joystick where - show (Joystick j) = show $ "Joystick-" ++ (show j) - -instance Show JoystickButton where - show (JoystickButton jb) = show $ "JoystickButton-" ++ (show jb) - -instance Show EnumJoystickAxis where - show axis = "JoystickAxis-" ++ (case axis of - JoystickAxisX -> "X" - JoystickAxisY -> "Y" - JoystickAxisZ -> "Z" - JoystickAxisR -> "R" - JoystickAxisU -> "U" - JoystickAxisV -> "V" - JoystickAxisPovX -> "PovX" - JoystickAxisPovY -> "PoxY" - ) - - --- Joystick funtions --- - -updateJoystickStatus :: MHGamer3D () -updateJoystickStatus = liftIO Joystick.update - -getConnectedJoysticks :: MHGamer3D [Joystick] -getConnectedJoysticks = do - let ns = [ x | x <- [0..20]] - jns <- filterM (\jn -> do - c <- liftIO $ Joystick.isConnected jn - return (c) ) ns - let js = map Joystick jns - return js - -getJoystickAxes:: Joystick -> MHGamer3D [EnumJoystickAxis] -getJoystickAxes (Joystick j) = do - axes <- filterM ( \a -> do - liftIO $ Joystick.hasAxis j a) [ JoystickAxisX, JoystickAxisY, JoystickAxisZ, - JoystickAxisR, JoystickAxisU, JoystickAxisV, - JoystickAxisPovX, JoystickAxisPovY ] - return axes - - -getJoystickButtons :: Joystick -> MHGamer3D [JoystickButton] -getJoystickButtons (Joystick j) = do - jn <- liftIO $ Joystick.getButtonCount j - let btns = map JoystickButton [0..(jn-1)] - return btns - -isJoystickButtonPressed :: Joystick -> JoystickButton -> MHGamer3D Bool -isJoystickButtonPressed (Joystick j) (JoystickButton b) = liftIO $ Joystick.isButtonPressed j b - -getJoystickAxisPosition :: Joystick -> EnumJoystickAxis -> MHGamer3D Float -getJoystickAxisPosition (Joystick j) ax = liftIO $ Joystick.getAxisPosition j ax - - --- Keyboard functions --- - -isKeyPressed :: EnumKey -> MHGamer3D Bool -isKeyPressed key = liftIO $ Keyboard.isKeyPressed key - --- Mouse functions --- - -isMouseButtonPressed :: EnumMouseButton -> MHGamer3D Bool -isMouseButtonPressed mb = liftIO $ Mouse.isButtonPressed mb - -getMousePosition :: MHGamer3D (Int, Int) -getMousePosition = liftIO Mouse2.getPosition - - diff --git a/HGamer3D/APIs/Base/InputSystem/InputSystem.hs b/HGamer3D/APIs/Base/InputSystem/InputSystem.hs new file mode 100644 --- /dev/null +++ b/HGamer3D/APIs/Base/InputSystem/InputSystem.hs @@ -0,0 +1,165 @@ +-- This source file is part of HGamer3D +-- (A project to enable 3D game development in Haskell) +-- For the latest info, see http://www.althainz.de/HGamer3D.html +-- +-- (c) 2011 Peter Althainz +-- +-- Licensed under the Apache License, Version 2.0 (the "License"); +-- you may not use this file except in compliance with the License. +-- You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, software +-- distributed under the License is distributed on an "AS IS" BASIS, +-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +-- See the License for the specific language governing permissions and +-- limitations under the License. + +-- InputSystem.hs + +-- |Base API, InputSystem Module, InputSystem Sub-Module. +-- The input system handles Mouse, Keyboard and Joystick Input. + + +module HGamer3D.APIs.Base.InputSystem.InputSystem + +( + -- Enums + -- + module HGamer3D.Bindings.SFML.EnumJoystickAxis, + module HGamer3D.Bindings.SFML.EnumKey, + module HGamer3D.Bindings.SFML.EnumMouseButton, + + -- Joystick Data + Joystick (..), + JoystickButton (..), + + -- Joystick Functions + updateJoystickStatus, + + getConnectedJoysticks, + isJoystickConnected, + + getJoystickAxes, + getJoystickButtons, + + isJoystickButtonPressed, + getJoystickAxisPosition, + + -- Keyboard Functions + isKeyPressed, + + -- Mouse Functions + isMouseButtonPressed, + getMousePosition, + + + +) + +where + +import GHC.Ptr + +import HGamer3D.Data.HG3DClass +import HGamer3D.Data.Vector + +import HGamer3D.Bindings.SFML.ClassPtr +import HGamer3D.Bindings.SFML.Utils + +import qualified HGamer3D.Bindings.SFML.ClassJoystick as Joystick +import qualified HGamer3D.Bindings.SFML.ClassKeyboard as Keyboard +import qualified HGamer3D.Bindings.SFML.ClassMouse as Mouse +import qualified HGamer3D.Bindings.SFML.ClassMouseHG3D as Mouse2 +import HGamer3D.Bindings.SFML.EnumJoystickAxis +import HGamer3D.Bindings.SFML.EnumKey +import HGamer3D.Bindings.SFML.EnumMouseButton + +import HGamer3D.APIs.Base.Engine.Types + +import Control.Monad.Trans +import Control.Monad.Reader + + +-- Joystick Data +data Joystick = Joystick Int deriving (Eq) +data JoystickButton = JoystickButton Int deriving (Eq) + +instance Show Joystick where + show (Joystick j) = show $ "Joystick-" ++ (show j) + +instance Show JoystickButton where + show (JoystickButton jb) = show $ "JoystickButton-" ++ (show jb) + +instance Show EnumJoystickAxis where + show axis = "JoystickAxis-" ++ (case axis of + JoystickAxisX -> "X" + JoystickAxisY -> "Y" + JoystickAxisZ -> "Z" + JoystickAxisR -> "R" + JoystickAxisU -> "U" + JoystickAxisV -> "V" + JoystickAxisPovX -> "PovX" + JoystickAxisPovY -> "PoxY" + ) + + +-- Joystick funtions +-- + +updateJoystickStatus :: MHGamer3D () +updateJoystickStatus = liftIO Joystick.update + +getConnectedJoysticks :: MHGamer3D [Joystick] +getConnectedJoysticks = do + let ns = [ x | x <- [0..15]] + jns <- filterM (\jn -> do + c <- liftIO $ Joystick.isConnected jn + return (c) ) ns + let js = map Joystick jns + return js + +isJoystickConnected :: Joystick -> MHGamer3D Bool +isJoystickConnected (Joystick jn) = do + rv <- liftIO $ Joystick.isConnected jn + return rv + +getJoystickAxes:: Joystick -> MHGamer3D [EnumJoystickAxis] +getJoystickAxes (Joystick j) = do + axes <- filterM ( \a -> do + liftIO $ Joystick.hasAxis j a) [ JoystickAxisX, JoystickAxisY, JoystickAxisZ, + JoystickAxisR, JoystickAxisU, JoystickAxisV, + JoystickAxisPovX, JoystickAxisPovY ] + return axes + + +getJoystickButtons :: Joystick -> MHGamer3D [JoystickButton] +getJoystickButtons (Joystick j) = do + jn <- liftIO $ Joystick.getButtonCount j + let btns = map JoystickButton [0..(jn-1)] + return btns + +isJoystickButtonPressed :: Joystick -> JoystickButton -> MHGamer3D Bool +isJoystickButtonPressed (Joystick j) (JoystickButton b) = liftIO $ Joystick.isButtonPressed j b + +getJoystickAxisPosition :: Joystick -> EnumJoystickAxis -> MHGamer3D Float +getJoystickAxisPosition (Joystick j) ax = liftIO $ Joystick.getAxisPosition j ax + + +-- Keyboard functions +-- + +isKeyPressed :: EnumKey -> MHGamer3D Bool +isKeyPressed key = liftIO $ Keyboard.isKeyPressed key + +-- Mouse functions +-- + +isMouseButtonPressed :: EnumMouseButton -> MHGamer3D Bool +isMouseButtonPressed mb = liftIO $ Mouse.isButtonPressed mb + +getMousePosition :: MHGamer3D (Int, Int) +getMousePosition = liftIO Mouse2.getPosition + + diff --git a/HGamer3D/BaseAPI.hs b/HGamer3D/BaseAPI.hs --- a/HGamer3D/BaseAPI.hs +++ b/HGamer3D/BaseAPI.hs @@ -27,15 +27,16 @@ module HGamer3D.Data.Vector, module HGamer3D.Data.Angle, - module HGamer3D.APIs.Base.Audio, - module HGamer3D.APIs.Base.InputSystem, - module HGamer3D.APIs.Base.Common, - module HGamer3D.APIs.Base.Graphics3D.Engine3D, + module HGamer3D.APIs.Base.Audio.Audio, + module HGamer3D.APIs.Base.InputSystem.InputSystem, + module HGamer3D.APIs.Base.Engine.Types, + module HGamer3D.APIs.Base.Engine.Engine, + module HGamer3D.APIs.Base.Graphics3D.Basic3D, module HGamer3D.APIs.Base.Graphics3D.Light, module HGamer3D.APIs.Base.Graphics3D.Object3D, + module HGamer3D.APIs.Base.Graphics3D.PlatonObjects, - initHGamer3D - + module HGamer3D.APIs.Base.GUI.BasicGUI ) where @@ -44,17 +45,19 @@ import HGamer3D.Data.Vector import HGamer3D.Data.Angle -import HGamer3D.APIs.Base.Audio -import HGamer3D.APIs.Base.InputSystem -import HGamer3D.APIs.Base.Common -import HGamer3D.APIs.Base.Graphics3D.Engine3D +import HGamer3D.APIs.Base.Audio.Audio +import HGamer3D.APIs.Base.InputSystem.InputSystem +import HGamer3D.APIs.Base.Engine.Types +import HGamer3D.APIs.Base.Engine.Engine + +import HGamer3D.APIs.Base.Graphics3D.Basic3D import HGamer3D.APIs.Base.Graphics3D.Light import HGamer3D.APIs.Base.Graphics3D.Object3D +import HGamer3D.APIs.Base.Graphics3D.PlatonObjects +import qualified Data.Map as Map + +import HGamer3D.APIs.Base.GUI.BasicGUI + import Control.Monad.Trans (liftIO) -initHGamer3D windowName = do - cs <- initCommon - es <- initEngine3D cs windowName "OctreeSceneManager" - let s = [1..] - return ((cs, es), s)