diff --git a/HGamer3D.cabal b/HGamer3D.cabal --- a/HGamer3D.cabal +++ b/HGamer3D.cabal @@ -1,12 +1,14 @@ Name: HGamer3D -Version: 0.2.1 -Synopsis: Windows Game Engine for the Haskell Programmer +Version: 0.3.0 +Synopsis: A Game Engine for the Haskell Programmer Description: 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. + a Haskell API on top of that. HGamer3D is available on Windows and Linux. + This package is a wrapper for the main modules and does not contain additional + functionality. License: OtherLicense License-file: LICENSE @@ -19,9 +21,9 @@ Extra-source-files: Setup.hs Library - Build-Depends: base >= 3 && < 5, containers, text, directory == 1.1.0.2, Win32, mtl, FindBin, monad-loops, split, netwire == 4.0.7, HGamer3D-Data >= 0.2.0, HGamer3D-Ogre-Binding == 0.2.1, HGamer3D-SFML-Binding == 0.2.0, HGamer3D-CEGUI-Binding == 0.2.1, HGamer3D-Bullet-Binding == 0.2.1, HGamer3D-Enet-Binding == 0.2.0 + Build-Depends: base >= 3 && < 5, HGamer3D-Data >= 0.3.0 && < 0.4.0, HGamer3D-Audio >= 0.3.0 && < 0.4.0, HGamer3D-Network >= 0.3.0 && < 0.4.0, HGamer3D-InputSystem >= 0.3.0 && < 0.4.0, HGamer3D-Graphics3D >= 0.3.0 && < 0.4.0, HGamer3D-WinEvent >= 0.3.0 && < 0.4.0, HGamer3D-GUI >= 0.3.0 && < 0.4.0 - 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.APIs.Base,HGamer3D.APIs.Base.Network.EngineHelper,HGamer3D.APIs.Base.Network.Network,HGamer3D.APIs.Base.Physics.EngineHelper,HGamer3D.APIs.Base.Physics.Physics, HGamer3D.APIs.FRP.GUI, HGamer3D.APIs.FRP.Graphics3D,HGamer3D.APIs.FRP.InputSystem,HGamer3D.APIs.FRP.Network,HGamer3D.APIs.FRP.Types,HGamer3D.APIs.FRP + Exposed-modules: HGamer3D Other-modules: c-sources: diff --git a/HGamer3D.hs b/HGamer3D.hs new file mode 100644 --- /dev/null +++ b/HGamer3D.hs @@ -0,0 +1,81 @@ +-- 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) 2014 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. + +-- HGamer3D Main Module +-- + +-- | HGamer3D - A game engine for the Haskell Programmer +module HGamer3D + +( + Event (..), + + module HGamer3D.Graphics3D, + module HGamer3D.WinEvent, + module HGamer3D.GUI, + + loopHGamer3D, + initHGamer3D, + exitHGamer3D + + ) where + + import HGamer3D.Graphics3D hiding (initHGamer3D, loopHGamer3D, exitHGamer3D) + import HGamer3D.WinEvent hiding (initHGamer3D, loopHGamer3D, exitHGamer3D) + import HGamer3D.GUI + import qualified System.Info as SI + + data Event = EventWindow SDLEvent | EventGUI [GUIEvent] + + exitHGamer3D :: Graphics3DSystem -> GUISystem -> IO () + exitHGamer3D g3ds guis = do + exitGraphics3D g3ds + + loopHGamer3D :: Graphics3DSystem -> GUISystem -> IO (Maybe Event, Bool) + loopHGamer3D g3ds guis = do + + renderOneFrame g3ds + + -- this one is quite tricky, on Linux we need to call the message loop in addition to WinEvent! + if SI.os /= "mingw32" then graphics3DPumpWindowMessages else return () + i <- checkQuitReceived + evt <- pollWinEvent + + case evt of + Just sdlEvt -> do + injectWinEventToGUI guis sdlEvt -- inject event into gui + return (Just (EventWindow sdlEvt), (i == 1) ) + _ -> do + gevts <- pollGUIEvents guis + if length gevts > 0 then + return (Just (EventGUI gevts), (i == 1) ) + else + return (Nothing, (i == 1) ) + + + initHGamer3D :: String -- ^ Window Title + -> Bool -- ^ Flag show config dialogue + -> Bool -- ^ Flag logging enabled + -> Bool -- ^ show Graphics Cursor + -> IO (Graphics3DSystem, GUISystem, Camera, Viewport) + initHGamer3D windowTitle fConfigDialogue fLog fGraphicsCursor = do + success <- initWinEvent [WEV_INIT_EVENTS, WEV_INIT_TIMER, WEV_INIT_VIDEO] + (g3ds, camera, viewport, window) <- initGraphics3D windowTitle "DefaultSceneManager" fConfigDialogue fLog + win <- attachToWindow window + guis <- initGUI fLog fGraphicsCursor + return (g3ds, guis, camera, viewport) diff --git a/HGamer3D/APIs/Base.hs b/HGamer3D/APIs/Base.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base.hs +++ /dev/null @@ -1,70 +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. - --- BaseAPI.hs - --- |HGamer3D Base API: basic Haskell API for HGamer3D, based on the low-level bindings, with moderate abstraction on top of it. - -module HGamer3D.APIs.Base - -( - -- * Data definitions, re-exported - module HGamer3D.Data.Colour, - module HGamer3D.Data.Vector, - module HGamer3D.Data.Angle, - - -- * Main API functionality, split into sub modules - module HGamer3D.APIs.Base.Audio.Audio, - module HGamer3D.APIs.Base.InputSystem.InputSystem, - module HGamer3D.APIs.Base.Graphics3D.Basic3D, - module HGamer3D.APIs.Base.Graphics3D.Light, - module HGamer3D.APIs.Base.Graphics3D.Object3D, - module HGamer3D.APIs.Base.Graphics3D.PlatonObjects, - module HGamer3D.APIs.Base.GUI.BasicGUI, - module HGamer3D.APIs.Base.Physics.Physics, - module HGamer3D.APIs.Base.Network.Network, - - -- * Game-Loop and internal functionality - module HGamer3D.APIs.Base.Engine.Types, - module HGamer3D.APIs.Base.Engine.Engine -) - -where - -import HGamer3D.Data.Colour -import HGamer3D.Data.Vector -import HGamer3D.Data.Angle - -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 HGamer3D.APIs.Base.Physics.Physics -import HGamer3D.APIs.Base.Network.Network - -import Control.Monad.Trans (liftIO) - diff --git a/HGamer3D/APIs/Base/Audio/Audio.hs b/HGamer3D/APIs/Base/Audio/Audio.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Audio/Audio.hs +++ /dev/null @@ -1,298 +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 - --- |The Audio functionality of the Base API. - - -module HGamer3D.APIs.Base.Audio.Audio - -( - -- * Types - module HGamer3D.Bindings.SFML.EnumSoundSourceStatus, - AudioSource (..), - - -- * Listener Functions - setAudioMainVolume, - getAudioMainVolume, - setAudioListenerPosition, - setAudioListenerDirection, - - -- * Source creation and delete Functions - createMusic, - createSound, - deleteAudioSource, - - -- * Source play function - playAudioSource, - pauseAudioSource, - stopAudioSource, - - -- * Source property functions - setAudioSourceLoop, - getAudioSourceLoop, - - getAudioSourceVolume, - setAudioSourceVolume, - - getAudioSourcePitch, - setAudioSourcePitch, - - getAudioSourcePosition, - setAudioSourcePosition, - - getAudioSourceAttenuation, - setAudioSourceAttenuation, - - getAudioSourceMinDistance, - setAudioSourceMinDistance, - - setAudioSourcePositionDependent, - isAudioSourcePositionDependent, - -) - -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 - --- | set overall main audio volume -setAudioMainVolume :: Float -- ^ volume in a scale between 0 and 100.0 - -> MHGamer3D () -setAudioMainVolume vol = liftIO $ Listener.setGlobalVolume vol - --- | get overall main audio volume -getAudioMainVolume :: MHGamer3D Float -- ^ volume in a scale between 0 and 100.0 -getAudioMainVolume = liftIO $ Listener.getGlobalVolume - --- | set position of the listener, this is where the \"micro\" is located -setAudioListenerPosition :: Vec3 -- ^ position of listener - -> MHGamer3D () -setAudioListenerPosition (Vec3 x y z) = liftIO $ Listener.setPosition x y z - --- | set direction of the listener -setAudioListenerDirection :: Vec3 -- ^ direction, in which listener hears - -> MHGamer3D () -setAudioListenerDirection (Vec3 x y z) = liftIO $ Listener.setDirection x y z - - --- Music Functions, deletion and cretion of Audio types --- - --- | create music (stream source, reading from file) -createMusic :: String -- ^ filename of music without path - -> MHGamer3D (Maybe AudioSource) -- ^ audio source, which can be played -createMusic filename = do - music <- liftIO $ Music.new - rs <- ask - let cs = commonSystem rs - 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 - --- | create sound (stream source, loaded into memory) -createSound :: String -- ^ filename of sound without path - -> MHGamer3D (Maybe AudioSource) -- ^ audio source, which can be played -createSound filename = do - sound <- liftIO $ Sound.new - buffer <- liftIO $ SoundBuffer.new - rs <- ask - let cs = commonSystem rs - 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 - --- | delete audio source -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 --- - --- | starts playing audio source -playAudioSource :: AudioSource -- ^the audio source - -> MHGamer3D () -playAudioSource (Music music) = do - liftIO $ SoundStream.play music -playAudioSource (Sound sound buffer) = do - liftIO $ Sound.play sound - --- | pause playing audio source, remembers location -pauseAudioSource :: AudioSource -> MHGamer3D () -pauseAudioSource (Music music) = do - liftIO $ SoundStream.pause music -pauseAudioSource (Sound sound buffer) = do - liftIO $ Sound.pause sound - --- | completely stops audio playing -stopAudioSource :: AudioSource -> MHGamer3D () -stopAudioSource (Music music) = do - liftIO $ SoundStream.stop music -stopAudioSource (Sound sound buffer) = do - liftIO $ Sound.stop sound - --- | is audio play looping -getAudioSourceLoop :: AudioSource -- ^audio source - -> MHGamer3D Bool -- ^true, loop is enabled, false loop is disabled -getAudioSourceLoop (Music music) = do - fLoop <- liftIO $ SoundStream.getLoop music - return fLoop -getAudioSourceLoop (Sound sound buffer) = do - fLoop <- liftIO $ Sound.getLoop sound - return fLoop - --- | set audio play is looping -setAudioSourceLoop :: AudioSource -- ^audio source - -> Bool -- ^loop enabled - -> 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 --- - --- | get volume of a single audio source -getAudioSourceVolume :: AudioSource -- ^audio source - -> MHGamer3D Float -- ^volume of audio source in scale of 0 to 100.0 - -getAudioSourceVolume (Music s) = liftIO $ SoundSource.getVolume s -getAudioSourceVolume (Sound s b) = liftIO $ SoundSource.getVolume s - --- | set volume of a single audio source -setAudioSourceVolume :: AudioSource -- ^audio source - -> Float -> MHGamer3D () -- ^volume of this audio source in scale of 0 to 100.0 - -setAudioSourceVolume (Music s) v = liftIO $ SoundSource.setVolume s v -setAudioSourceVolume (Sound s b) v = liftIO $ SoundSource.setVolume s v - --- | get audio source pitch --- the pitch is the frequency of the sound which also influences playing speed. The default value is 1.0. -getAudioSourcePitch :: AudioSource -- ^audio source - -> MHGamer3D Float -- ^pitch, a 1.0 is no change to original sound - -getAudioSourcePitch (Music s) = liftIO $ SoundSource.getPitch s -getAudioSourcePitch (Sound s b) = liftIO $ SoundSource.getPitch s - --- | sets the pitch of an audio source -setAudioSourcePitch :: AudioSource -> Float -> MHGamer3D () -setAudioSourcePitch (Music s) p = liftIO $ SoundSource.setPitch s p -setAudioSourcePitch (Sound s b) p = liftIO $ SoundSource.setPitch s p - --- | sets the position of an audio source -setAudioSourcePosition :: AudioSource -- ^audio source - -> Vec3 -> MHGamer3D () -- ^new position of this source - -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 - --- | gets the position of an audio source -getAudioSourcePosition :: AudioSource -- ^audio source - -> MHGamer3D Vec3 -- ^position of the audio source - -getAudioSourcePosition (Music s) = liftIO $ SoundSource.getPosition s -getAudioSourcePosition (Sound s b) = liftIO $ SoundSource.getPosition s - --- | gets the attenuation factor of an audio source -getAudioSourceAttenuation :: AudioSource -- ^audio source - -> MHGamer3D Float -- ^attenuation is the damping factor by distance, default value is 1.0, 0.0 means no damping -getAudioSourceAttenuation (Music s) = liftIO $ SoundSource.getAttenuation s -getAudioSourceAttenuation (Sound s b) = liftIO $ SoundSource.getAttenuation s - --- | sets the attenuation factor of an audio source -setAudioSourceAttenuation :: AudioSource -- ^audio source - -> Float -> MHGamer3D () -- ^attenuation factor -setAudioSourceAttenuation (Music s) a = liftIO $ SoundSource.setAttenuation s a -setAudioSourceAttenuation (Sound s b) a = liftIO $ SoundSource.setAttenuation s a - --- | gets audio source min distance, distance at which sound is played a volume 100.0 -getAudioSourceMinDistance :: AudioSource -> MHGamer3D Float -getAudioSourceMinDistance (Music s) = liftIO $ SoundSource.getMinDistance s -getAudioSourceMinDistance (Sound s b) = liftIO $ SoundSource.getMinDistance s - --- | sets audio source min distance, distance at which sound is played a volume 100.0 -setAudioSourceMinDistance :: AudioSource -> Float -> MHGamer3D () -setAudioSourceMinDistance (Music s) d = liftIO $ SoundSource.setMinDistance s d -setAudioSourceMinDistance (Sound s b) d = liftIO $ SoundSource.setMinDistance s d - --- | set flag if audio source depends on position, default is FALSE (not dependent on position) -setAudioSourcePositionDependent :: AudioSource -> Bool -> MHGamer3D () -setAudioSourcePositionDependent (Music s) isR = liftIO $ SoundSource.setRelativeToListener s isR -setAudioSourcePositionDependent (Sound s b) isR = liftIO $ SoundSource.setRelativeToListener s isR - --- | get flag if audio source depends on position, default is FALSE (not dependent on position) -isAudioSourcePositionDependent :: AudioSource -> MHGamer3D Bool -isAudioSourcePositionDependent (Music s) = liftIO $ SoundSource.isRelativeToListener s -isAudioSourcePositionDependent (Sound s b) = liftIO $ SoundSource.isRelativeToListener s - - diff --git a/HGamer3D/APIs/Base/Engine/Engine.hs b/HGamer3D/APIs/Base/Engine/Engine.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Engine/Engine.hs +++ /dev/null @@ -1,354 +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. - --- Engine.hs - --- | Game-Loop and internals of Base API implementation - -module HGamer3D.APIs.Base.Engine.Engine ( - - -- * utility functions - getUniqueName, - mapFunctionToTag, - getFunctionFromTag, - getTimeMS, - - -- * basic functions, to constitute running system --- initCommonSystem, - runMHGamer3D, - initHGamer3D, - renderLoop - - -- * usage of game loop - -- $intro - -) - -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 HGamer3D.APIs.Base.Network.EngineHelper -import HGamer3D.APIs.Base.Physics.EngineHelper - -import Control.Monad -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.State -import Control.Concurrent -import Data.List - -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 -import System.Win32.Registry - -import Data.List.Split - - --- | get unique identifiers, by appending a unique integer to a prefix -getUniqueName :: String -> MHGamer3D String -getUniqueName prefix = do - enstate <- lift get - let HG3DEngineState (x:xs) evtmap = enstate - lift $ put (HG3DEngineState xs evtmap) - return (prefix ++ (show x)) - --- |event function mapping, map a function to a tag (a string identifier) -mapFunctionToTag :: String -> EventFunction -> MHGamer3D () -mapFunctionToTag tag function = do - enstate <- lift get - let HG3DEngineState un evtmap = enstate - let evtmap2 = Map.insert tag function evtmap - lift $ put (HG3DEngineState un evtmap2) - return () - --- |event function mapping, return the function of the tag (string identifier) -getFunctionFromTag :: String -> MHGamer3D (Maybe EventFunction) -getFunctionFromTag tag = do - enstate <- lift get - let eventMap = esEventMap enstate - let fr = Map.lookup tag eventMap - return fr - --- function, which finds installation path of HG3D --- - --- assumes very strict versioning info in version.cfg, 3rd line will have version without dots! --- version.cfg will be located in "media/engine" - -readVersion path = do - text <- readFile (path ++ "/media/engine/version.cfg") - let ver = (splitOn "=" ((splitOn "\n" text)!!2))!!1 - return ver - - --- function, which ignores all behind a specific string -ignoreTextAfterIndicator :: String -> String -> String -ignoreTextAfterIndicator text indicator = case text of - [] -> [] - (x:xs) -> if (indicator `Data.List.isPrefixOf` text) then [] else (x : (ignoreTextAfterIndicator xs indicator)) - -getHG3DPath :: IO (String, String) -getHG3DPath = do - progpath2 <- getProgPath - -- fix error of getProgPath in ghci, cut of line at "\-l..." - let progpath = ignoreTextAfterIndicator progpath2 "\\-l" - -- read version file - v <- readVersion progpath - key <- regCreateKey hKEY_LOCAL_MACHINE ("SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\hg3dpath" ++ v ++ ".exe") - binpath <- regQueryValue key (Just "Path") - -- remove "/bin" from path - let path = take (length binpath - 4) binpath - return (path, progpath) - --- | internal function, to initialize common system record, not used by end-users -initCommonSystem :: IO CommonSystem -initCommonSystem = do - (csHG3DPath, csProgPath) <- getHG3DPath - return (CommonSystem csHG3DPath csProgPath) - --- Milliseconds Timescale - --- | get current game time in milliseconds -getTimeMS :: MHGamer3D (TimeMS) -getTimeMS = do - fr <- liftIO $ queryPerformanceFrequency - wt <- liftIO $ queryPerformanceCounter - return (TimeMS $ fromIntegral (wt * 1000 `div` fr)) - --- | run a HGamer3D monad function within the states of the game -runMHGamer3D :: (HG3DReaderState, HG3DEngineState) -- ^ initial state, taken from initMHGamer3D - -> MHGamer3D a -- ^ the action, which should be run in the monad - -> IO (a, (HG3DReaderState, HG3DEngineState)) -- ^ the output value and updated state of the monad -runMHGamer3D (readerstate, enginestate) action = do - (actionResult, newEnginestate) <- runStateT (runReaderT action readerstate ) enginestate - return (actionResult, (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) - --- | initialize the HGamer3D system -initHGamer3D :: String -- ^ name of the window (shown in main title bar) - -> IO (HG3DReaderState, HG3DEngineState) -- ^ the state value needed for further invocation of HGamer3D code through the monad. -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 - - -- init Network engine - network <- initNetworkEngine - - -- init Phyiscs engine - physics <- initPhysicsEngine - - let eventmap = Map.fromList ([]::[(String, EventFunction)]) - let enginestate = HG3DEngineState [1..] eventmap - let readerstate = HG3DReaderState cs g3s gui network physics - - return (readerstate, enginestate) - --- 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 - rs <- ask - let cs = commonSystem rs - let g3s = graphics3DSystem rs - let gui = guiSystem rs - -- 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 (guiGUI gui) CEGUIButton.MouseLeftButton - return () - else do - return () - if lastMouseState == MouseDown && ms == MouseUp then do - liftIO $ CEGUISystem.injectMouseButtonUp (guiGUI 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 (guiGUI gui) (fromIntegral mouseX) (fromIntegral mouseY) - -- time pulse injection - liftIO $ CEGUISystem.injectTimePulse (guiGUI gui) delta2 - -- display 3D and GUI - liftIO $ Root.renderOneFrame (g3sRoot g3s) - liftIO $ CEGUISystem.renderGUI (guiGUI gui) - - return (True, (TimeMouseState ms (TimeMS time)) ) - - -renderInternalLoop :: Int -> TimeMouseState -> gamestateType -> (TimeMS -> gamestateType -> MHGamer3D (Bool, gamestateType)) -> MHGamer3D () -renderInternalLoop frameRate rsold gamestate renderStep = do - let (TimeMouseState ms (TimeMS timeold)) = rsold - getEventsFromGui - (flagStep, rs) <- renderInternalStep frameRate rsold - let (TimeMouseState ms (TimeMS time)) = rs - let delta = (TimeMS (time - timeold)) - (flagLoop, gsnew) <- renderStep delta gamestate - if (flagStep && flagLoop) then do - renderInternalLoop frameRate rs gsnew renderStep - else return () - --- | the main loop, call this at end of your world preparation, to start game loop -renderLoop :: Int -- ^ the frame rate, you want to achieve, frames per second - -> worldState -- ^ a type of your choice for the world state - -> (TimeMS -> worldState -> MHGamer3D (Bool, worldState)) -- ^ the renderStep function, a function which gets called each step, the bool value indicates if world should run further (True) or if world should stop (False). - -> MHGamer3D () -renderLoop frameRate gamestate renderStep = do - rs <- initTimeMouseState - renderInternalLoop frameRate rs gamestate renderStep - --- event loop - -getEventsFromGui :: MHGamer3D () -getEventsFromGui = do - rs <- ask - let cs = commonSystem rs - let g3s = graphics3DSystem rs - let gui = guiSystem rs - let eventController = guiEventController gui - processEvents <- liftIO $ HG3DEventController.eventsAvailable eventController - if processEvents then do - (name, sender, window) <- liftIO $ HG3DEventController.popEvent eventController - let evt = GUIEvent name sender window - evtfunc <- getFunctionFromTag name - case evtfunc of - Just func -> do - func evt - return () - Nothing -> return () - getEventsFromGui - return () - else do - return () - return () - -{-$intro -use as in the following code example: -first define a renderStep function - -@ - renderStep :: TimeMS -> Gameworld -> MHGamer3D (Bool, Gameworld) - renderStep (TimeMS time) cube = do - yaw3D cube (Rad 0.005) - roll3D cube (Rad 0.002) - return (True, cube) -@ - -in the main program, initialize your objects, and at the end call the game loop - -@ - main3DProgram = do - \-- do some more init here: lights, objects, ... - renderLoop 40 cubeBlue renderStep - return () -@ - -in the main program, just run the main init routine and the main program in the HGamer3D monad - -@ - main = do - hg <- initHGamer3D \"HGamer3D - Getting Started Example\" - (l, hg) <- runMHGamer3D hg main3DProgram - return () -@ - --} - diff --git a/HGamer3D/APIs/Base/Engine/Types.hs b/HGamer3D/APIs/Base/Engine/Types.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Engine/Types.hs +++ /dev/null @@ -1,128 +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. - --- Types.hs - --- |Types of the Base API. - -module HGamer3D.APIs.Base.Engine.Types ( - - -- * records for sub system objects from low-level API - CommonSystem (..), - Graphics3DSystem (..), - GUISystem (..), - NetworkSystem (..), - PhysicsSystem (..), - - -- * the main HGamer3D monad - HG3DReaderState (..), - HG3DEngineState (..), - MHGamer3D, - - -- * Events - Event (..), - EventFunction, - EventMap, - - -- * Time - TimeMS (..), -) - -where - -import HGamer3D.Data.HG3DClass -import Control.Monad.Reader -import Control.Monad.State -import qualified Data.Map as Map - --- | General information, needed in all sub-systems -data CommonSystem = CommonSystem { - csHG3DPath::String, -- ^ the path, where the binaries of HGamer3D are installed (install directory, without bin) - csProgPath::String -- ^ the path, from which the final linked executable has been started -} - --- | 3D Graphics objects (Ogre specific) -data Graphics3DSystem = Graphics3DSystem { - g3sRoot::HG3DClass, - g3sSceneManager::HG3DClass, - g3sResourceGroupManager::HG3DClass, - g3sTextureManager::HG3DClass, - g3sControllerManager::HG3DClass, - g3sLogManager::HG3DClass, - g3sCamera::HG3DClass, - g3sRenderWindow::HG3DClass, - g3sViewport::HG3DClass, - g3sMessagePump::HG3DClass -} - --- | GUI System objects (CEGUI specific) -data GUISystem = GUISystem { - guiRenderer::HG3DClass, - guiGUI::HG3DClass, - guiWindowManager::HG3DClass, - guiWindowManagerHG3D::HG3DClass, - guiFontManager::HG3DClass, - guiSchemeManager::HG3DClass, - guiEventController::HG3DClass -} - --- | Network System objects -data NetworkSystem = NetworkSystem { - nsNetwork::HG3DClass -} - --- | Physics System objects -data PhysicsSystem = PhysicsSystem { - psPhysics::HG3DClass, - psWorld::HG3DClass -} - --- | Data, which can be read by all sub-system implementations, but not modified -data HG3DReaderState = HG3DReaderState { - commonSystem::CommonSystem, - graphics3DSystem::Graphics3DSystem, - guiSystem::GUISystem, - networkSystem::NetworkSystem, - physicsSystem::PhysicsSystem -} - --- | Data, which can be read and modified (for State monad) -data HG3DEngineState = HG3DEngineState { - esUniqueNumbers::[Integer], - esEventMap::EventMap -} - --- | the HGamer3D monad, a monad stack of reader and state monad -type MHGamer3D a = (ReaderT HG3DReaderState) (StateT HG3DEngineState IO) a - --- | summary data type for all types of Events -data Event = - GUIEvent String String HG3DClass -- ^ GUI Event: name sender window - --- | an event function is reacting on an event with a side effect only -type EventFunction = Event -> MHGamer3D () - --- | map of all events -type EventMap = Map.Map String EventFunction - --- | the time type of HGamer3D (in milliseconds) -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 deleted file mode 100644 --- a/HGamer3D/APIs/Base/GUI/BasicGUI.hs +++ /dev/null @@ -1,303 +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. - --- BasicGUI.hs - --- |GUI functionality of the Base API. - -module HGamer3D.APIs.Base.GUI.BasicGUI - -( - -- * Types - GUIElement (..), - - -- * Initialization and configuration functions - loadGuiLayoutFromFile, - loadGuiScheme, - loadGuiFont, - setGuiDefaultFont, - setGuiDefaultMouseCursor, - setGuiDefaultTooltip, - - -- * Find and display GUI Elements - getChildGuiEl, - findChildGuiElRecursive, - addGuiElToDisplay, - removeGuiElFromDisplay, - - -- * Set specific GUI Element properties - getGuiElProperty, - setGuiElProperty, - enableGuiEl, - disableGuiEl, - activateGuiEl, - deactivateGuiEl, - showGuiEl, - hideGuiEl, - - -- * Listbox, Compobox specific functions - listboxAddText, - listboxGetSelectedText, - listboxRemoveAllText, - comboboxAddText, - comboboxRemoveAllText, - - -- * GUI Event handling - mapGuiElEventToFunction, -) - -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.Bindings.CEGUI.ClassHG3DListboxStaticFunctions as ListboxSF -import HGamer3D.Bindings.CEGUI.ClassHG3DWindowStaticFunctions as WindowSF -import HGamer3D.Bindings.CEGUI.ClassListbox as Listbox -import HGamer3D.Bindings.CEGUI.ClassListboxItem as ListboxItem -import HGamer3D.Bindings.CEGUI.ClassCombobox as Combobox - -import HGamer3D.Data.HG3DClass -import Control.Monad.Trans -import Control.Monad.Reader -import Control.Monad.Loops -import HGamer3D.Data.Vector - --- | The GUI Element, a window, a button, any widget or widget element, organized in a hierarchy -data GUIElement = GUIElement HG3DClass -- ^ only one constructor, currently GUI elements are not specified in more detail - --- | load a complete layout file into the application -loadGuiLayoutFromFile :: String -- ^ filename, without the path (this is defined by resource locations) - -> String -- ^ prefix to append to the identifiers in the layout, this allows, to load the same dailog/gui element multiple times with different names, if needed - -> MHGamer3D GUIElement -- ^ the resulting tree of GUI elements as top GUI element -loadGuiLayoutFromFile layoutFile prefix = do - rs <- ask - let gui = guiSystem rs - let hg3dWinMgr = guiWindowManagerHG3D gui - window <- liftIO $ WindowManagerHG3D.loadWindowLayoutHG3D hg3dWinMgr layoutFile prefix - return (GUIElement window) - --- | add a GUI element to the display -addGuiElToDisplay :: GUIElement -- ^ GUI element - -> MHGamer3D () -addGuiElToDisplay (GUIElement window) = do - rs <- ask - let gui = guiSystem rs - let guiS = guiGUI gui - guiSheet <- liftIO $ System.getGUISheet guiS - liftIO $ Window.addChildWindow2 guiSheet window - --- | remove a GUI element from the display -removeGuiElFromDisplay :: GUIElement -- ^ GUI element - -> MHGamer3D () -removeGuiElFromDisplay (GUIElement window) = do - rs <- ask - let gui = guiSystem rs - let guiS = guiGUI gui - guiSheet <- liftIO $ System.getGUISheet guiS - liftIO $ Window.removeChildWindow2 guiSheet window - --- | enable GUI element, allow interaction with it and render it accordingly -enableGuiEl :: GUIElement -- ^ GUI element to enable - -> MHGamer3D () -enableGuiEl (GUIElement window) = do - liftIO $ Window.enable window - --- | disable GUI element, disallow interaction with it and render it accordingly -disableGuiEl :: GUIElement -- ^ GUI element to disable - -> MHGamer3D () -disableGuiEl (GUIElement window) = do - liftIO $ Window.disable window - --- | activate GUI element, process events send to it -activateGuiEl :: GUIElement -- ^ GUI element to activate - -> MHGamer3D () -activateGuiEl (GUIElement window) = do - liftIO $ Window.activate window - --- | deactivate GUI element, do not process events send to it -deactivateGuiEl :: GUIElement -- ^ GUI element to deactivate - -> MHGamer3D () -deactivateGuiEl (GUIElement window) = do - liftIO $ Window.deactivate window - --- | show GUI element -showGuiEl :: GUIElement -- ^ GUI element to show - -> MHGamer3D () -showGuiEl (GUIElement window) = do - liftIO $ Window.show window - --- | hide GUI element -hideGuiEl :: GUIElement -- ^ GUI element to hide - -> MHGamer3D () -hideGuiEl (GUIElement window) = do - liftIO $ Window.hide window - --- | get child gui element, throws an exception, if element not found in children, only searches the direct children of element. -getChildGuiEl :: GUIElement -- ^ GUI element, which childrens are searched for child element - -> String -- ^ name of searched child element - -> MHGamer3D GUIElement -- ^ found element (throws exception, in case no child found) -getChildGuiEl (GUIElement window) name = do - window <- liftIO $ Window.getChild window name - return (GUIElement window) - --- | find child element recursively, searches all sub-trees -findChildGuiElRecursive :: GUIElement -- ^ GUI element, which childrens are searched, including children of children and so on. - -> String -- ^ name of child element to be found - -> MHGamer3D (Maybe GUIElement) -- ^ in case of found element: Just el, Nothing otherwhise -findChildGuiElRecursive (GUIElement window) name = do - window <- liftIO $ Window.getChildRecursive window name - if (ocPtr window) == nullPtr then do - return Nothing - else do - return (Just (GUIElement window)) - --- | get a named property as string from element -getGuiElProperty :: GUIElement -- ^ GUI element - -> String -- ^ property name to get - -> MHGamer3D String -- ^ property value -getGuiElProperty (GUIElement window) name = do - prop <- liftIO $ PropertySet.getProperty window name - return prop - --- | set a named property -setGuiElProperty :: GUIElement -- ^ GUI element - -> String -- ^ property name to set - -> String -- ^ property value as string - -> MHGamer3D () -setGuiElProperty (GUIElement window) name value = do - liftIO $ PropertySet.setProperty window name value - --- | load a complete GUI scheme, see CEGUI manual for details -loadGuiScheme :: String -- ^ scheme name - -> MHGamer3D () -loadGuiScheme schemeName = do - rs <- ask - let gui = guiSystem rs - liftIO $ SystemHG3D.schemeManagerCreate (guiSchemeManager gui) schemeName - --- | load a GUI font -loadGuiFont :: String -- ^ font name - -> MHGamer3D () -loadGuiFont fontName = do - rs <- ask - let gui = guiSystem rs - liftIO $ SystemHG3D.fontManagerCreate (guiFontManager gui) fontName - --- | set default GUI font -setGuiDefaultFont :: String -- ^ font name - -> MHGamer3D () -setGuiDefaultFont fontName = do - rs <- ask - let gui = guiSystem rs - let guiS = guiGUI gui - liftIO $ System.setDefaultFont guiS fontName - --- | set default mouse cursor -setGuiDefaultMouseCursor :: String -- ^ scheme name, where cursor is contained in - -> String -- ^ cursor name - -> MHGamer3D () -setGuiDefaultMouseCursor schemeName cursorName = do - rs <- ask - let gui = guiSystem rs - let guiS = guiGUI gui - liftIO $ System.setDefaultMouseCursor3 guiS schemeName cursorName - --- | set default tool tip -setGuiDefaultTooltip :: String -- ^ default tool tip name - -> MHGamer3D () -setGuiDefaultTooltip ttName = do - rs <- ask - let gui = guiSystem rs - let guiS = guiGUI gui - liftIO $ System.setDefaultTooltip2 guiS ttName - --- | directly maps one specific event of one specific GUI element to a callback function -mapGuiElEventToFunction :: GUIElement -- ^ the GUI element from which the event is mapped - -> String -- ^ the event name, see the CEGUI documentation for details - -> EventFunction -- ^ an event function, the impact needs to be on a side effect - -> MHGamer3D () -mapGuiElEventToFunction (GUIElement window) eventName function = do - functionTag <- getUniqueName "Event" - mapFunctionToTag functionTag function - liftIO $ EvtSF.subscribeScriptedEvent window eventName functionTag - return () - --- | add one line of text as a selectable entry to a combobox -comboboxAddText :: GUIElement -- ^ GUI element, needs to be a combobox - -> String -- ^ the entry string to add - -> MHGamer3D () -comboboxAddText (GUIElement window) itemname = do - realcombo <- liftIO $ WindowSF.castWindowToCombobox window - liftIO $ ListboxSF.comboboxAddItem realcombo itemname - --- | removes all lines of entries from a combobox -comboboxRemoveAllText :: GUIElement -- ^ the GUI elements, needs to be a combobox - -> MHGamer3D () -comboboxRemoveAllText (GUIElement window) = do - realcombo <- liftIO $ WindowSF.castWindowToCombobox window - liftIO $ Combobox.resetList realcombo - --- | add one line of text as a selectable entry to a listbox -listboxAddText :: GUIElement -- ^ GUI element, needs to be a listbox - -> String -- ^ the entry string to add - -> MHGamer3D () -listboxAddText (GUIElement window) itemname = do - reallistbox <- liftIO $ WindowSF.castWindowToListbox window - liftIO $ ListboxSF.listboxAddItem reallistbox itemname - -_getTextListOfItem reallistbox item list = do - let (HG3DClass ptra ptrb) = item - if ptra /= nullPtr then do - txt <- liftIO $ ListboxItem.getText item - let list' = list ++ [txt] - item' <- liftIO $ Listbox.getNextSelected reallistbox item - list'' <- _getTextListOfItem reallistbox item' list' - return list'' - else do - return list - --- | return the selected items as an array of strings -listboxGetSelectedText :: GUIElement -- ^ the GUI element, needs to be a listbox - -> MHGamer3D [String] -- ^ the selected items as an array of strings -listboxGetSelectedText (GUIElement window) = do - reallistbox <- liftIO $ WindowSF.castWindowToListbox window - item <- liftIO $ Listbox.getFirstSelectedItem reallistbox - list <- _getTextListOfItem reallistbox item ([]::[String]) - return list - --- | removes all lines of entries from a listbox -listboxRemoveAllText :: GUIElement -- ^ the GUI element, needs to be a listbox - -> MHGamer3D () -listboxRemoveAllText (GUIElement window) = do - reallistbox <- liftIO $ WindowSF.castWindowToListbox window - liftIO $ Listbox.resetList reallistbox - - diff --git a/HGamer3D/APIs/Base/GUI/EngineHelper.hs b/HGamer3D/APIs/Base/GUI/EngineHelper.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/GUI/EngineHelper.hs +++ /dev/null @@ -1,163 +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. - --- EngineHelper.hs - --- |Supporting GUI functionality for the Base API, used internally for the game loop. -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.CEGUI.ClassWindowManagerHG3D as HG3DWindowManager -import HGamer3D.Bindings.Ogre.ClassHG3DMessagePump as MessagePump - - -import HGamer3D.APIs.Base.Engine.Types - -import Control.Monad.Trans -import Control.Monad.Reader - - --- | initialize the GUI system, used internally -initGUIEngine :: Bool -- ^ logging flag - -> IO (GUISystem) -- ^ GUI system object -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 "VanillaSkin.scheme" - CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLook.scheme" - CEGUISystemHG3D.schemeManagerCreate guischememgr "WindowsLookWidgets.scheme" - CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLook.scheme" - CEGUISystemHG3D.schemeManagerCreate guischememgr "TaharezLookWidgets.scheme" - - CEGUISystemHG3D.fontManagerCreate guifontmgr "DejaVuSans-10.font" - - CEGUISystem.setDefaultFont guisystem "DejaVuSans-10" - CEGUISystem.setDefaultMouseCursor3 guisystem "Vanilla-Images" "MouseArrow" - CEGUISystem.setDefaultTooltip2 guisystem "WindowsLook/Tooltip" - - -- set standard empty gui sheet - myRoot <- CEGUIWindowManager.createWindow guiwindowmgr "DefaultWindow" "root" - CEGUISystem.setGUISheet guisystem myRoot - - eventController <- HG3DEventController.new - - guiwmgrhg3d <- HG3DWindowManager.new - - return (GUISystem guirenderer guisystem guiwindowmgr guiwmgrhg3d guifontmgr guischememgr eventController) - - --- keypressInject - --- | injects key presses into the CEGUI engine, used internally -keypressInject :: MHGamer3D () -keypressInject = do - rs <- ask - let g3s = graphics3DSystem rs - let gui = guiSystem rs - let gSystem = guiGUI gui - let messagePump = g3sMessagePump g3s - - 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 deleted file mode 100644 --- a/HGamer3D/APIs/Base/Graphics3D/Basic3D.hs +++ /dev/null @@ -1,217 +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. - --- Basic3D.hs - --- |Types and basic objects for 3D module of Base API. - -module HGamer3D.APIs.Base.Graphics3D.Basic3D ( - - -- * Types - Position3D (..), - Scale3D (..), - translate3D, - Direction3D (..), - Orientation3D (..), - - -- * Camera - Camera (..), - HGamer3D.APIs.Base.Graphics3D.Basic3D.getCamera, - cameraLookAt, - - -- * Background Colour - HGamer3D.APIs.Base.Graphics3D.Basic3D.setBackgroundColour, - - -- * Resource locations - -- $audioresource - - 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 - --- | a type with a Position3D instance can be positioned -class Position3D t where - - -- | get position function - position3D :: t -> MHGamer3D Vec3 - -- | set position function - positionTo3D :: t -> Vec3 -> MHGamer3D () - --- | move position function -translate3D :: Position3D t => t -> Vec3 -> MHGamer3D () -translate3D t v = do - p <- position3D t - positionTo3D t ( v &+ p ) - return () - --- | a type with a Scale3D instance can be scaled -class Scale3D t where - - -- | get scale function - scale3D :: t -> MHGamer3D Vec3 - -- | set scale function - scaleTo3D :: t -> Vec3 -> MHGamer3D () - --- | a type with a Direction3D instance can be oriented towards a point (Camera for example) -class Direction3D t where - -- | get direction function - direction3D :: t -> MHGamer3D Vec3 - -- | set direction function - directionTo3D :: t -> Vec3 -> MHGamer3D () - --- | a type with an Orientation3D instance can be oriented in space -class Orientation3D t where - -- | get orientation function - orientation3D :: t -> MHGamer3D UnitQuaternion - -- | set orientation function - orientationTo3D :: t -> UnitQuaternion -> MHGamer3D () - --- Camera functions --- - --- | The Camera -data Camera = Camera HG3DClass - --- | get the camera object -getCamera :: MHGamer3D Camera -getCamera = do - rs <- ask - let g3s = graphics3DSystem rs - 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 () - --- | set the direction in a way, that the camera looks toward a specified point -cameraLookAt :: Camera -> Vec3 -> MHGamer3D () -cameraLookAt (Camera c) v = do - liftIO $ Camera.lookAt c v - return () - - --- specific single function --- - --- | sets the background colour of the 3d drawing window -setBackgroundColour :: Colour -> MHGamer3D () -setBackgroundColour bgColour = do - rs <- ask - let g3s = graphics3DSystem rs - liftIO $ Viewport.setBackgroundColour (g3sViewport g3s) bgColour - --- locations of media in same folder as program resides --- - --- | adds a resource location for 3D media (Ogre) -addResourceLocationMedia :: String -- ^ path to new resource location, the path should identify a directory - -> MHGamer3D () -addResourceLocationMedia path = do - rs <- ask - let g3s = graphics3DSystem rs - let cs = commonSystem rs - let progPath = csProgPath cs - let rgm = g3sResourceGroupManager g3s - liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" "General" False - --- | adds a resource location for 3D media (Ogre) which is a zip file -addResourceZipfileMedia :: String -- ^ path to new resource location, the path should identify a zip file - -> MHGamer3D () -addResourceZipfileMedia path = do - rs <- ask - let g3s = graphics3DSystem rs - let cs = commonSystem rs - let progPath = csProgPath cs - let rgm = g3sResourceGroupManager g3s - liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "Zip" "General" False - --- | adds a resource location for GUI media (CEGUI) which is a directory -addResourceLocationGUI :: String -- ^ path to the directory with the GUI media in it - -> String -- ^ category of GUI media, for example: Layout, Images, ... - -> MHGamer3D () -addResourceLocationGUI path category = do - rs <- ask - let g3s = graphics3DSystem rs - let cs = commonSystem rs - let progPath = csProgPath cs - let rgm = g3sResourceGroupManager g3s - liftIO $ ResourceGroupManager.addResourceLocation rgm (progPath ++ "\\" ++ path) "FileSystem" category False - --- | finalize adding resource locations. This function needs to be called at the end of all addResourceLocation... functions. -finalizeResourceLocations :: MHGamer3D () -finalizeResourceLocations = do - rs <- ask - let g3s = graphics3DSystem rs - let cs = commonSystem rs - let rgm = g3sResourceGroupManager g3s - liftIO $ ResourceGroupManager.initialiseAllResourceGroups rgm - - - -{-$audioresource -The resource location for audio files is currently fixed and it is not needed, to set it. The path -for audio files is \"..\/media\/audio\". --} diff --git a/HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs b/HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Graphics3D/EngineHelper.hs +++ /dev/null @@ -1,171 +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. - --- EngineHelper.hs - --- | Initialization function for 3d graphics in Base API. - -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) - --- | initializes the 3d graphics module, used internally by the Base API engine module -initGraphics3D :: String -- ^ Name of the window, displayed - -> String -- ^ SceneManager type used - -> String -- ^ path to hgamer3d installation directory - -> Bool -- ^ flag, show configuration dialogue - -> Bool -- ^ flag, use directx - -> Bool -- ^ flag, is logging enabled - -> 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 deleted file mode 100644 --- a/HGamer3D/APIs/Base/Graphics3D/Light.hs +++ /dev/null @@ -1,191 +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. - --- Light.hs - --- | Creating and managing Light in Base API. - - -module HGamer3D.APIs.Base.Graphics3D.Light ( - - -- * Types - Light (..), - - -- * Create and modify light sources - HGamer3D.APIs.Base.Graphics3D.Light.setAmbientLight, - createPointlight, - createSpotlight, - setSpotlightAngle, - createDirectionalLight -) - -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 - --- | The light. -data Light = Light HG3DClass deriving (Show) - -instance Position3D Light where - - position3D (Light l) = do - pos <- liftIO $ Light.getPosition l - return (pos) - - positionTo3D (Light l) pos = do - let (Vec3 x y z) = pos - liftIO $ Light.setPosition l x y z - return () - -instance Direction3D Light where - - direction3D (Light l) = do - d <- liftIO $ Light.getDirection l - return d - - directionTo3D (Light l) v = do - liftIO $ Light.setDirection2 l v - return () - - --- | Ambient light is present everywhere, this function creates it and sets the colour of it. --- There is no light object, since movement, rotation, scaling would make no sense anyhow. -setAmbientLight :: Colour -> MHGamer3D () -setAmbientLight colour = do - rs <- ask - let g3s = graphics3DSystem rs - liftIO $ SceneManager.setAmbientLight (g3sSceneManager g3s) colour - return () - - --- | creates a point light at a specific location -createPointlight :: Colour -- ^ Color of the light - -> Vec3 -- ^ Position, where light is created - -> MHGamer3D (Light) -- ^ The light object - -createPointlight (Colour t r g b) (Vec3 x y z) = do - rs <- ask - let g3s = graphics3DSystem rs - lightName <- getUniqueName "LO" - light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName - liftIO $ Light.setType light LT_POINT - liftIO $ Light.setPosition light x y z - liftIO $ Light.setDiffuseColour light r g b - liftIO $ Light.setSpecularColour light r g b - let eo = Light light - return eo - --- | creates a spot light at a specific location -createSpotlight :: Colour -- ^ Color of the light - -> Vec3 -- ^ Position, where light is created - -> MHGamer3D (Light) -- ^ The light object - -createSpotlight (Colour t r g b) (Vec3 x y z) = do - rs <- ask - let g3s = graphics3DSystem rs - lightName <- getUniqueName "LO" - light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName - liftIO $ Light.setType light LT_SPOTLIGHT - liftIO $ Light.setPosition light x y z - liftIO $ Light.setDiffuseColour light r g b - liftIO $ Light.setSpecularColour light r g b - let eo = Light light - return eo - --- | set the angle of a spotlight -setSpotlightAngle :: Light -- ^ spotlight - -> Angle -- ^ angle of the light cone, should be between 5 and 355 degree - -> MHGamer3D () -setSpotlightAngle (Light light) a = do - if (a >= (Deg 5)) && (a <= (Deg 355)) - then do - let innerAngle = fromAngle $ a `subA` (Deg 4.5) - let outerAngle = fromAngle $ a `addA` (Deg 4.5) - liftIO $ Light.setSpotlightInnerAngle light innerAngle - liftIO $ Light.setSpotlightOuterAngle light outerAngle - return () - else do - return () - - --- | creates a directional light at a specific location -createDirectionalLight :: Colour -- ^ Color of the light - -> Vec3 -- ^ Position, where light is created - -> MHGamer3D (Light) -- ^ The light object - -createDirectionalLight (Colour t r g b) (Vec3 x y z) = do - rs <- ask - let g3s = graphics3DSystem rs - lightName <- getUniqueName "LO" - light <- liftIO $ SceneManager.createLight (g3sSceneManager g3s) lightName - liftIO $ Light.setType light LT_DIRECTIONAL - liftIO $ Light.setPosition light x y z - liftIO $ Light.setDiffuseColour light r g b - liftIO $ Light.setSpecularColour light r g b - let eo = Light light - return eo - diff --git a/HGamer3D/APIs/Base/Graphics3D/Object3D.hs b/HGamer3D/APIs/Base/Graphics3D/Object3D.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Graphics3D/Object3D.hs +++ /dev/null @@ -1,441 +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. - --- Object3D.hs - --- | Creating and managing 3D objects functionality for Base API - -module HGamer3D.APIs.Base.Graphics3D.Object3D ( - - -- * Type Definitions - Object3D (..), - Material (..), - Mesh (..), - - -- * Mesh creation functions - createColouredLineMesh, - createColouredCubeMesh, - createRainbowCubeMesh, - createNamedMesh, - - -- * Object creation functions - createObject3DFromMesh, - createSphere, - createCube, - createPlane, - createLine, - createColouredLine, - createColouredCube, - createRainbowCube, - loadMesh, - - -- * Modify objects - setObjectMaterial, - combineObjects, - - -- * special movements - yaw3D, - roll3D, - pitch3D -) - -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 - --- | The basic 3D object. Each object is a single instance, which can be displayed, moved, scaled, rotated, ... --- Objects are created from meshes (templates for ojbects) or manually, by manual object creation methods. -data Object3D = SingleObject3D HG3DClass HG3DClass | -- ^ a single object, consisting of: node (Ogre) and entity (Ogre) - CombinedObject3D HG3DClass [Object3D] -- ^ a combined object,consisting of : node (Ogre) and array of sub-objects - -getNode :: Object3D -> HG3DClass -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) - --- | The material. Define how an object is looking. -data Material = NamedMaterial String -- ^ a named material, already installed - --- | The mesh. A template for creating Objects. Defines the vertices, including colour and material of an object. -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 - --- | Creates a mesh (object template) from resource -createNamedMesh :: String -- ^ mesh resource name - -> MHGamer3D Mesh -- ^ mesh -createNamedMesh meshName = do - return (NamedMesh meshName) - --- | Creates a line with a colour from start and end point (mesh as object template) -createColouredLineMesh :: Vec3 -- ^ start point - -> Vec3 -- ^ end point - -> Material -- ^ material - -> Colour -- ^ colour - -> MHGamer3D Mesh -- ^ line mesh -createColouredLineMesh vStart vEnd (NamedMaterial materialName) colour = do - rs <- ask - let g3s = graphics3DSystem rs - 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 coloured cube mesh -createColouredCubeMesh :: Material -> Colour -- ^ colour - -> MHGamer3D Mesh -- ^ cube mesh -createColouredCubeMesh (NamedMaterial materialName) colour = do - - - rs <- ask - let g3s = graphics3DSystem rs - 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) - - --- | Creates a rainbow coloured cube mesh -createRainbowCubeMesh :: MHGamer3D Mesh -createRainbowCubeMesh = do - - rs <- ask - let g3s = graphics3DSystem rs - 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) - --- | creates a 3D object, by using a mesh template -createObject3DFromMesh :: Mesh -- ^ mesh used for creation - -> MHGamer3D Object3D -- ^ created 3d object -createObject3DFromMesh mesh = do - rs <- ask - let g3s = graphics3DSystem rs - -- 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 <- liftIO $ SceneNode.createChildSceneNode rootNode vzero qident - liftIO $ SceneNode.attachObject node entity - -- return object - return (SingleObject3D node entity) - --- | directly creates a sphere object -createSphere :: MHGamer3D Object3D -createSphere = do - ob <- createObject3DFromMesh SphereMesh - return (ob) - --- | directly creates a cube object -createCube :: MHGamer3D Object3D -createCube = do - ob <- createObject3DFromMesh CubeMesh - return (ob) - --- | directly creates a plane object -createPlane :: MHGamer3D Object3D -createPlane = do - ob <- createObject3DFromMesh PlaneMesh - return (ob) - --- | directly creates a mesh object -loadMesh :: String -- ^ name of resource of mesh - -> MHGamer3D Object3D -- ^ mesh object (not template!) -loadMesh name = do - ob <- createObject3DFromMesh (NamedMesh name) - return (ob) - --- | directly creates a line from start and end point with colour -createLine :: Vec3 -- ^ start point - -> Vec3 -- ^ end point - -> Colour -- ^ colour - -> MHGamer3D Object3D -- ^ created line object -createLine vStart vEnd colour = do - mesh <- createColouredLineMesh vStart vEnd (NamedMaterial "BaseWhiteNoLighting") colour - ob <- createObject3DFromMesh mesh - return ob - --- | directly creates a line from start and end point with colour and material -createColouredLine :: Vec3 -- ^ start point - -> Vec3 -- ^ end point - -> Material -- ^ material - -> Colour -- ^ colour - -> MHGamer3D Object3D -- ^ created line object -createColouredLine vStart vEnd material colour = do - mesh <- createColouredLineMesh vStart vEnd material colour - ob <- createObject3DFromMesh mesh - return ob - --- | directly creates coloured cube object -createColouredCube :: Material -- ^ material - -> Colour -- ^ colour - -> MHGamer3D Object3D -- ^ created cube -createColouredCube material colour = do - mesh <- createColouredCubeMesh material colour - ob <- createObject3DFromMesh mesh - return ob - --- | directly creates a cube with rainbow colours -createRainbowCube :: MHGamer3D Object3D -createRainbowCube = do - mesh <- createRainbowCubeMesh - ob <- createObject3DFromMesh mesh - return ob - -instance Position3D Object3D where - - position3D obj = do - pos <- liftIO $ Node.getPosition (getNode obj) - return (pos) - - positionTo3D obj pos = do - liftIO $ Node.setPosition (getNode obj) pos - return () - -instance Scale3D Object3D where - - scale3D obj = do - pos <- liftIO $ Node.getScale (getNode obj) - return (pos) - - scaleTo3D obj pos = do - liftIO $ Node.setScale (getNode obj) pos - return () - -instance Orientation3D Object3D where - - orientation3D obj = do - q <- liftIO $ Node.getOrientation (getNode obj) - let uq = mkNormal q - return uq - - orientationTo3D obj uq = do - liftIO $ Node.setOrientation (getNode obj) (fromNormal uq) - return () - --- | set the material of an object -setObjectMaterial :: Object3D -- ^ 3d object - -> Material -- ^ material - -> MHGamer3D () -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 create a group and move, rotate and scale it as one entity. - -combineObjects :: [Object3D] -- ^ A list of objects, to be grouped - -> MHGamer3D (Object3D) -- ^ The return value is a new 3d object. - -combineObjects listObjects = do - rs <- ask - let g3s = graphics3DSystem rs - 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 ( \object -> do - let objectnode = getNode object - parent <- liftIO $ Node.getParent objectnode - liftIO $ Node.removeChild2 parent objectnode - liftIO $ Node.addChild node objectnode - return () - ) - listObjects) - return ( CombinedObject3D node listObjects) - --- yaw, roll, pitch functions --- functions, to rotate on axis, relative to object -rotRelativeToObjectAxis :: Object3D -> Vec3 -> Float -> MHGamer3D () -rotRelativeToObjectAxis object axis val = do - qob <- orientation3D object - let odir = actU qob axis - let qrot = rotU odir val - let nrot = qrot .*. qob - orientationTo3D object nrot - return () - --- | rotate object on own axis (yaw) by angle -yaw3D :: Object3D -> Angle -> MHGamer3D () -yaw3D object val = rotRelativeToObjectAxis object (Vec3 0.0 1.0 0.0) (fromAngle val) - --- | rotate object on own axis (roll) by angle -roll3D :: Object3D -> Angle -> MHGamer3D () -roll3D object val = rotRelativeToObjectAxis object (Vec3 0.0 0.0 1.0) (fromAngle val) - --- | rotate object on own axis (pitch) by angle -pitch3D :: Object3D -> Angle -> MHGamer3D () -pitch3D object val = rotRelativeToObjectAxis object (Vec3 1.0 0.0 0.0) (fromAngle val) - diff --git a/HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs b/HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Graphics3D/PlatonObjects.hs +++ /dev/null @@ -1,256 +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. - --- PlatonObjects.hs - --- | Create platonic objects, ikosaeder and dodekaeder -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 - - --- | create an ikoaeder mesh - from the mesh more objects can be created -createIkosaederMesh :: String -- ^ material name of the ikosaeder - -> Colour -- ^ colour of the ikosaeder - -> MHGamer3D Mesh -- ^ created mesh object -createIkosaederMesh material colour = do - - rs <- ask - let g3s = graphics3DSystem rs - 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) - - --- | create a dodekaeder mesh -createDodekaederMesh :: String -- ^ material of the dodekaeder - -> Colour -- ^ colour of the dodekaeder - -> MHGamer3D Mesh -- ^ created dodekaeder mesh -createDodekaederMesh material colour = do - - rs <- ask - let g3s = graphics3DSystem rs - 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) - - --- | convenience function to directly create an ikosaeder, creates a mesh and from that directly a 3d object -createIkosaeder :: String -- ^ material - -> Colour -- ^ colour - -> MHGamer3D Object3D -- ^ ikosaeder 3d object -createIkosaeder material colour = do - mesh <- createIkosaederMesh material colour - ob <- createObject3DFromMesh mesh - return ob - - --- | convenience function to directly create an dodekaeder, creates a mesh and from that directly a 3d object -createDodekaeder :: String -- ^ material - -> Colour -- ^ colour - -> MHGamer3D Object3D -- ^ dodekaeder 3d object -createDodekaeder material colour = do - mesh <- createDodekaederMesh material colour - ob <- createObject3DFromMesh mesh - return ob - diff --git a/HGamer3D/APIs/Base/InputSystem/InputSystem.hs b/HGamer3D/APIs/Base/InputSystem/InputSystem.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/InputSystem/InputSystem.hs +++ /dev/null @@ -1,179 +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 - - --- | Mouse, Keyboard and Joystick functionality of the Base API. -module HGamer3D.APIs.Base.InputSystem.InputSystem - -( - -- * Types - module HGamer3D.Bindings.SFML.EnumJoystickAxis, - module HGamer3D.Bindings.SFML.EnumKey, - module HGamer3D.Bindings.SFML.EnumMouseButton, - - 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 - - --- | The Joystick -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 --- - --- | This functions gathers the Joystick inputs. It should called frequently, for example during the gameloop, to get new values and new Joystick availability. At least it should be called before querying the Joystick values. -updateJoystickStatus :: MHGamer3D () -updateJoystickStatus = liftIO Joystick.update - --- | Get a list of connected Joysticks. -getConnectedJoysticks :: MHGamer3D [Joystick] -- ^ returns list of connected Joysticks -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 - --- | Queries, if a specific Joystick is connected. -isJoystickConnected :: Joystick -- ^ the Joystick to be queried - -> MHGamer3D Bool -- ^ True: Joystick is connected -isJoystickConnected (Joystick jn) = do - rv <- liftIO $ Joystick.isConnected jn - return rv - --- | Queries the available axes of one specific Joystick -getJoystickAxes:: Joystick -- ^ the Joystick to be queried - -> MHGamer3D [EnumJoystickAxis] -- ^ returns a list of available axes -getJoystickAxes (Joystick j) = do - axes <- filterM ( \a -> do - liftIO $ Joystick.hasAxis j a) [ JoystickAxisX, JoystickAxisY, JoystickAxisZ, - JoystickAxisR, JoystickAxisU, JoystickAxisV, - JoystickAxisPovX, JoystickAxisPovY ] - return axes - --- | Queries the available buttons of one specific Joystick -getJoystickButtons :: Joystick -- ^ the Joystick to be queried - -> MHGamer3D [JoystickButton] -- ^ returns a list of available buttons -getJoystickButtons (Joystick j) = do - jn <- liftIO $ Joystick.getButtonCount j - let btns = map JoystickButton [0..(jn-1)] - return btns - --- | Check if a specific Joystick Button is currently pressed -isJoystickButtonPressed :: Joystick -- ^ the Joystick - -> JoystickButton -- ^ the Button - -> MHGamer3D Bool -- ^ returns True if pressed -isJoystickButtonPressed (Joystick j) (JoystickButton b) = liftIO $ Joystick.isButtonPressed j b - --- | Queries the current position of a Joystick Axis -getJoystickAxisPosition :: Joystick -- ^ the Joystick - -> EnumJoystickAxis -- ^ the Axis - -> MHGamer3D Float -- ^ returns the postion, ranging from -x.0 to x.0, x depending on Joystick -getJoystickAxisPosition (Joystick j) ax = liftIO $ Joystick.getAxisPosition j ax - - --- Keyboard functions --- - --- | Check if a specific keyboard key is currently pressed -isKeyPressed :: EnumKey -- ^ the key - -> MHGamer3D Bool -- ^ True, if pressed -isKeyPressed key = liftIO $ Keyboard.isKeyPressed key - --- Mouse functions --- - --- | Check if a specific mouse button is pressed -isMouseButtonPressed :: EnumMouseButton -- ^ mouse button - -> MHGamer3D Bool -- ^ True, if pressed -isMouseButtonPressed mb = liftIO $ Mouse.isButtonPressed mb - --- | Queries current mouse position -getMousePosition :: MHGamer3D (Int, Int) -- ^ absolute mouse position on screen in pixel -getMousePosition = liftIO Mouse2.getPosition - - diff --git a/HGamer3D/APIs/Base/Network/EngineHelper.hs b/HGamer3D/APIs/Base/Network/EngineHelper.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Network/EngineHelper.hs +++ /dev/null @@ -1,51 +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. - --- EngineHelper.hs - --- | Internal functions of the network functionality, used by the Base API. -module HGamer3D.APIs.Base.Network.EngineHelper - -( - initNetworkEngine -) - -where - -import GHC.Ptr - -import HGamer3D.Data.HG3DClass -import HGamer3D.Data.Vector - -import HGamer3D.Bindings.Enet.ClassPtr -import HGamer3D.Bindings.Enet.Utils - -import HGamer3D.Bindings.Enet.ClassEnet as Enet - -import HGamer3D.APIs.Base.Engine.Types - -import Control.Monad.Trans -import Control.Monad.Reader - - --- | intializes the network engine, used internally in the Base API. -initNetworkEngine :: IO (NetworkSystem) -initNetworkEngine = do - enet <- Enet.new - let ns = (NetworkSystem enet) - return ns diff --git a/HGamer3D/APIs/Base/Network/Network.hs b/HGamer3D/APIs/Base/Network/Network.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Network/Network.hs +++ /dev/null @@ -1,183 +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. - --- Network.hs - --- | Network functionality of Base API -module HGamer3D.APIs.Base.Network.Network - -( - - -- * Overview - -- $Overview - - -- * Types - NetworkClient (..), - NetworkServer (..), - NetworkPacket (..), - NetworkNode (..), - - -- * Connection Handling - createNetworkClient, - createNetworkServer, - connectClientToServer, - disconnectClient -) - -where - -import GHC.Ptr - -import HGamer3D.Data.HG3DClass -import HGamer3D.Data.Vector - -import Foreign.Ptr -import HGamer3D.Bindings.Enet.ClassEnet as Enet -import HGamer3D.Bindings.Enet.ClassEnetServer as EnetServer -import HGamer3D.Bindings.Enet.ClassEnetClient as EnetClient -import HGamer3D.Bindings.Enet.ClassEnetPacket as EnetPacket -import HGamer3D.Data.HG3DClass - -import HGamer3D.APIs.Base.Engine.Types - -import Control.Monad.Trans -import Control.Monad.Reader - --- | The network client -data NetworkClient = NetworkClient HG3DClass - --- | The network server -data NetworkServer = NetworkServer HG3DClass - --- | A network packet -data NetworkPacket = NetworkPacket { - clientname :: String, -- ^ the name of the client, sending the message, can be used, to reply - channel :: Int, -- ^ the channel on which the message has been sent - message :: String -- ^ the actual message itself - } - --- | creates a network client, a client can connect to servers, but not vice versa -createNetworkClient :: MHGamer3D NetworkClient -createNetworkClient = do - client <- liftIO $ Enet.createClient - return (NetworkClient client) - --- | creates a network server, a server can accept connections from clients -createNetworkServer :: Int -- ^ the port on which the server listen for connections - -> MHGamer3D NetworkServer -createNetworkServer port = do - server <- liftIO $ Enet.createServer port - return (NetworkServer server) - --- | create a connection from a client to a server -connectClientToServer :: NetworkClient -- ^ the client, created by createNetworkClient - -> String -- ^ the server address (regular IP addresses or NS names) - -> Int -- ^ the port of the server to connect to - -> MHGamer3D Bool -connectClientToServer (NetworkClient client) serveraddress port = do - ok <- liftIO $ EnetClient.connect client serveraddress port - return ok - --- | disconnect a client from a server -disconnectClient :: NetworkClient -- ^ the client - -> MHGamer3D Bool -disconnectClient (NetworkClient client) = do - ok <- liftIO $ EnetClient.disconnect client - return ok - --- | The network node. This TypeClass contain the methods for sending and receiving data. -class NetworkNode a where - -- | the method to send a message - sendNetworkMessage :: a -- ^ the node itself - -> String -- ^ the clientname (only used, when a server send to one of his clients). Can be obtained from the first message send by the client, see above in the 'NetworkPacket' type. - -> Int -- ^ the channel on which to send the message - -> String -- ^ the message - -> MHGamer3D () - - -- | receive pending messages - receiveNetworkMessages :: a -- ^ the node itself - -> TimeMS -- ^ the time in ms, which the node waits for incoming messages. If zero only delivers pending messages. - -> MHGamer3D [NetworkPacket] -- ^ array of received network packages - - -_transformPackage :: HG3DClass -> MHGamer3D NetworkPacket -_transformPackage p = do - message <- liftIO $ EnetPacket.getData p - channel <- liftIO $ EnetPacket.getChannel p - clientname <- liftIO $ EnetPacket.getPeer p - liftIO $ EnetPacket.delete p - return $ NetworkPacket clientname channel message - -_receiveClient client ms pkg = do - liftIO $ EnetClient.serve client ms - p <- liftIO $ EnetClient.getPacket client - let (HG3DClass aptr bptr) = p - if aptr /= nullPtr - then do - p' <- _transformPackage p - pkg' <- _receiveClient client ms (pkg ++ [p']) - return pkg' - else do - return pkg - -_receiveServer server ms pkg = do - liftIO $ EnetServer.serve server ms - p <- liftIO $ EnetServer.getPacket server - let (HG3DClass aptr bptr) = p - if aptr /= nullPtr - then do - p' <- _transformPackage p - pkg' <- _receiveServer server ms (pkg ++ [p']) - return pkg' - else do - return pkg - -instance NetworkNode NetworkClient where - - sendNetworkMessage (NetworkClient client) clientname channel message = do - liftIO $ EnetClient.send client message channel - return () - - receiveNetworkMessages (NetworkClient client) (TimeMS ms) = do - allPs <- _receiveClient client ms [] - return allPs - -instance NetworkNode NetworkServer where - - sendNetworkMessage (NetworkServer server) clientname channel message = do - liftIO $ EnetServer.send server clientname message channel - return () - - receiveNetworkMessages (NetworkServer server) (TimeMS ms) = do - allPs <- _receiveServer server ms [] - return allPs - - - - -{-$Overview - -The commuication model of this library is easy. There are clients and servers. Clients can connect to servers but not whise versa. So each server can have multiple clients. Both are nodes. Nodes can send and receive messages. - -Upon connection the port is defined on which servers and clients communicate with each other. - -In addition to the port, channels exists, to enable parallel streams of messages on different channels. - -A client has a name, to identify him. This name is communicated in the first packet from the client to the server. The server needs the client name, to send a package to the specific client. The client does not need a name for the server, since there exists only one connection from the client to one server. - --} diff --git a/HGamer3D/APIs/Base/Physics/EngineHelper.hs b/HGamer3D/APIs/Base/Physics/EngineHelper.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Physics/EngineHelper.hs +++ /dev/null @@ -1,59 +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. - --- EngineHelper.hs - --- | Internal functionality of pyhsics functionality for Base API. - - -module HGamer3D.APIs.Base.Physics.EngineHelper - -( - initPhysicsEngine -) - -where - -import GHC.Ptr - -import HGamer3D.Data.HG3DClass -import HGamer3D.Data.Vector - -import HGamer3D.Bindings.Bullet.ClassHG3DBulletMotionStateHandler as Motion -import HGamer3D.Bindings.Bullet.ClassHG3DBulletDefaultCreator as Bullet -import HGamer3D.Bindings.Bullet.ClassConeShapeX as Cone -import HGamer3D.Bindings.Bullet.ClassDynamicsWorld as World -import HGamer3D.Bindings.Bullet.ClassHG3DRigidBodyCreator as Rigids - -import HGamer3D.Bindings.Bullet.ClassPtr -import HGamer3D.Bindings.Bullet.Utils - -import HGamer3D.APIs.Base.Engine.Types - -import Control.Monad.Trans -import Control.Monad.Reader - - --- | initialize the physics system, only used internally in Base API. -initPhysicsEngine :: IO PhysicsSystem -initPhysicsEngine = do - - bullet <- Bullet.new - world <- Bullet.getDynamicsWorld bullet - let ps = (PhysicsSystem bullet world) - return ps diff --git a/HGamer3D/APIs/Base/Physics/Physics.hs b/HGamer3D/APIs/Base/Physics/Physics.hs deleted file mode 100644 --- a/HGamer3D/APIs/Base/Physics/Physics.hs +++ /dev/null @@ -1,181 +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. - --- Physics.hs - --- | Physics functionality of Base API. This module is likely to change in the near future and not well documented. - - -module HGamer3D.APIs.Base.Physics.Physics - -( - Body (..), - createSphereBody, - createBoxBody, - createCylinderBody, - createCapsuleBody, - createConeBody, - createStaticPlaneBody, - - physicsSimulationStep, - setBodyGravity, - getBodyGravity, - applyBodyImpulse, - getBodyLinearVelocity, - setBodyLinearVelocity -) - -where - -import GHC.Ptr - -import HGamer3D.Data.HG3DClass -import HGamer3D.Data.Vector -import HGamer3D.APIs.Base.Graphics3D.Basic3D - -import HGamer3D.Bindings.Bullet.ClassHG3DBulletMotionStateHandler as Motion -import HGamer3D.Bindings.Bullet.ClassHG3DBulletDefaultCreator as Bullet -import HGamer3D.Bindings.Bullet.ClassConeShapeX as Cone -import HGamer3D.Bindings.Bullet.ClassDynamicsWorld as World -import HGamer3D.Bindings.Bullet.ClassHG3DRigidBodyCreator as Rigids -import HGamer3D.Bindings.Bullet.ClassRigidBody as RBody - -import HGamer3D.Bindings.Bullet.ClassPtr -import HGamer3D.Bindings.Bullet.Utils - --- here the physics includes - - -import HGamer3D.APIs.Base.Engine.Types - -import Control.Monad.Trans -import Control.Monad.Reader - -data Body = Body HG3DClass - - -createSphereBody :: Float -> Vec3 -> Quaternion -> Float -> MHGamer3D Body -createSphereBody mass position quat radius = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - sphere <- liftIO $ Rigids.createSphere mass position quat radius - liftIO $ World.addRigidBody world sphere - return (Body sphere) - -createBoxBody :: Float -> Vec3 -> Quaternion -> Vec3 -> MHGamer3D Body -createBoxBody mass position quat halfExtends = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - box <- liftIO $ Rigids.createBox mass position quat halfExtends - liftIO $ World.addRigidBody world box - return (Body box) - -createCylinderBody :: Float -> Vec3 -> Quaternion -> Vec3 -> MHGamer3D Body -createCylinderBody mass position quat halfExtends = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - cylinder <- liftIO $ Rigids.createCylinder mass position quat halfExtends - liftIO $ World.addRigidBody world cylinder - return (Body cylinder) - -createCapsuleBody :: Float -> Vec3 -> Quaternion -> Float -> Float -> MHGamer3D Body -createCapsuleBody mass position quat radius height = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - capsule <- liftIO $ Rigids.createCapsule mass position quat radius height - liftIO $ World.addRigidBody world capsule - return (Body capsule) - -createConeBody :: Float -> Vec3 -> Quaternion -> Float -> Float -> MHGamer3D Body -createConeBody mass position quat radius height = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - cone <- liftIO $ Rigids.createCone mass position quat radius height - liftIO $ World.addRigidBody world cone - return (Body cone) - -createStaticPlaneBody :: Float -> Vec3 -> Quaternion -> Vec3 -> MHGamer3D Body -createStaticPlaneBody mass position quat origin = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - plane <- liftIO $ Rigids.createStaticPlane mass position quat origin - liftIO $ World.addRigidBody world plane - return (Body plane) - -physicsSimulationStep :: Float -> Int -> Float -> MHGamer3D Int -physicsSimulationStep timeStep maxSubSteps fixedTimeStep = do - rs <- ask - let ps = physicsSystem rs - let phys = psPhysics ps - let world = psWorld ps - val <- liftIO $ World.stepSimulation world timeStep maxSubSteps fixedTimeStep - return val - -instance Position3D Body where - - position3D (Body body) = do - pos <- liftIO $ Motion.getPosition body - return pos - positionTo3D (Body body) pos = do - liftIO $ Motion.setPosition body pos - -instance Orientation3D Body where - - orientation3D (Body body) = do - dir <- liftIO $ Motion.getQuaternion body - return $ (mkU . fromQ) dir - orientationTo3D (Body body) dir = do - liftIO $ Motion.setQuaternion body ((toQ . fromU) dir) - -setBodyGravity :: Body -> Vec3 -> MHGamer3D () -setBodyGravity (Body body) grav = do - liftIO $ RBody.setGravity body grav - return () - -getBodyGravity :: Body -> MHGamer3D Vec3 -getBodyGravity (Body body) = do - grav <- liftIO $ RBody.getGravity body - return grav - -applyBodyImpulse :: Body -> Vec3 -> Vec3 -> MHGamer3D () -applyBodyImpulse (Body body) imp relpos = do - liftIO $ RBody.applyImpulse body imp relpos - -getBodyLinearVelocity :: Body -> MHGamer3D Vec3 -getBodyLinearVelocity (Body body) = do - vel <- liftIO $ RBody.getLinearVelocity body - return vel - -setBodyLinearVelocity :: Body -> Vec3 -> MHGamer3D () -setBodyLinearVelocity (Body body) vel = do - liftIO $ RBody.setLinearVelocity body vel - return () - - diff --git a/HGamer3D/APIs/FRP.hs b/HGamer3D/APIs/FRP.hs deleted file mode 100644 --- a/HGamer3D/APIs/FRP.hs +++ /dev/null @@ -1,46 +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. - --- WireAPI.hs - --- |HGamer3D FRP API: an arrowized functional reactive programming API, based on the netwire library (). - -module HGamer3D.APIs.FRP - -( - -- * Types - module HGamer3D.APIs.FRP.Types, - - -- * Main FRP API functionality - module HGamer3D.APIs.FRP.GUI, - module HGamer3D.APIs.FRP.Graphics3D, - module HGamer3D.APIs.FRP.InputSystem, - module HGamer3D.APIs.FRP.Network, - - -- * re-exported Base API - module HGamer3D.APIs.Base -) - -where - -import HGamer3D.APIs.Base -import HGamer3D.APIs.FRP.GUI -import HGamer3D.APIs.FRP.Graphics3D -import HGamer3D.APIs.FRP.InputSystem -import HGamer3D.APIs.FRP.Network -import HGamer3D.APIs.FRP.Types diff --git a/HGamer3D/APIs/FRP/GUI.hs b/HGamer3D/APIs/FRP/GUI.hs deleted file mode 100644 --- a/HGamer3D/APIs/FRP/GUI.hs +++ /dev/null @@ -1,283 +0,0 @@ -{-# LANGUAGE Arrows #-} - --- | The GUI functionality of the FRP API -module HGamer3D.APIs.FRP.GUI -( - -- * basic Wires - guiEventW, - guiSetPropW, - guiGetPropW, - buttonW, - staticTextW, - - -- * editable GUI element wires - -- $EditGUIWire - editBoxW, - floatEditBoxW, - checkBoxW, - radioButtonW, - sliderW, - spinnerW, - listBoxW, - comboBoxW, - - -- * Wires which do not fire on setting values by program - -- $FireOnlyOnGUI - editBoxW', - floatEditBoxW', - checkBoxW', - radioButtonW', - sliderW', - spinnerW' -) - -where - -import HGamer3D.APIs.Base as Base -import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController - -import Control.Monad.Trans - -import Control.Monad.Identity (Identity) -import Control.Wire -import Prelude hiding ((.), id) - -import Control.Monad.Reader -import Control.Monad.State - -import Data.IORef -import HGamer3D.APIs.FRP.Types - - --- functions to put gui events into a list and pop them out again, as well as fire, when there is an event in it --- - -_gatherGUIEvents :: IORef [Base.Event] -> EventFunction -_gatherGUIEvents ref event = do - list <- liftIO $ readIORef ref - liftIO $ writeIORef ref (list ++ [event]) - return () - -_popGUIEvent :: IORef [Base.Event] -> MHGamer3D (Maybe Base.Event) -_popGUIEvent ref = do - list <- liftIO $ readIORef ref - case list of - [] -> return Nothing - (x : xs) -> do - liftIO $ writeIORef ref xs - return $ Just x - -_eventFunctionFired :: IORef [Base.Event] -> Time -> a -> MHGamer3D (Either () a) -_eventFunctionFired ref t a = do - evt <- _popGUIEvent ref - case evt of - Just (GUIEvent name sender window) -> do - return (Right a) - Nothing -> do - return (Left ()) - - --- new approach, more elemental wires, with better granularity --- - --- first create an event receiving wire for a GUIElement and a specific event - --- | Constructor for a wire, which delivers events from a GUI element -guiEventW :: GUIElement -- ^ GUI element - -> String -- ^ name of event - -> GameWire a a -- ^ event wire, which fires in case of event occurrence -guiEventW widget eventname = switch (mkStateM True (\t (a,s) -> do - if s then do - -- create the event IORef - ref <- liftIO $ newIORef [] - -- then map the events to a function, which gather events into this ref - mapGuiElEventToFunction widget eventname (_gatherGUIEvents ref) - -- finally create the wire - return $ (Right (mkFixM (_eventFunctionFired ref)), False) - else do - return (Left (), False))) id - - - --- then create a wire which gets and sets a property of the underlying GUI element - - --- | Constructor for a wire, which sets a specific property on occurrence -guiSetPropW :: GUIElement -- ^ GUI element - -> String -- ^ property name - -> GameWire String String -- ^ wire, which sets the property and returns the value -guiSetPropW widget propname = mkFixM (\t s -> do - setGuiElProperty widget propname s - return $ Right s) - --- | Constructor for a wire, which gets a specific property from a GUI element -guiGetPropW :: GUIElement -- ^ GUI element - -> String -- ^ property name - -> GameWire a String -- ^ wire, which returns property value as string, input is ignored -guiGetPropW widget propname = mkFixM (\t s -> do - s' <-getGuiElProperty widget propname - return $ Right s') - -_createGUIValueW :: GUIElement -> String -> String -> (GameWire a String, GameWire String String) -_createGUIValueW widget propname changename = (valueW . changeW, setValueW) where - changeW = guiEventW widget changename - valueW = guiGetPropW widget propname - setValueW = guiSetPropW widget propname - --- | Constructor for two wires, which in combination provide the functionality of an editable box GUI element. -editBoxW :: GUIElement -- ^ GUI element (should be an editbox) - -> (GameWire a String, GameWire String String) -- ^ Two wires as return value, a wire, which fires when the value changed and a setter wire, which sets the text of the editbox. -editBoxW widget =_createGUIValueW widget "Text" "TextChanged" - --- | Constructor for two wires, which provide the functionality of an editable box for float values as a GUI element. -floatEditBoxW :: GUIElement -- ^ GUI element (should be an editbox) - -> (GameWire a Float, GameWire Float Float) -- ^ Two wires as return value, a value changed wire and a setter wire. -floatEditBoxW widget = (fchanged, fsetter) where - sToF str = if length arr > 0 then fst $ arr !! 0 else 0.0 where - arr = (reads str) :: [(Float, String)] - toFW = mkFix (\t s -> Right $ sToF s) - showF = mkFix (\t f -> Right $ show f) - (changed, setter) = editBoxW widget - fchanged = toFW . changed - fsetter = toFW . setter . showF - --- | Constructur for a wire, which can change a static text GUI element (a setter). -staticTextW :: GUIElement -- ^ GUI element (should be a static text, or any widget with a "Text" property. - -> (GameWire String String) -- ^ the returned wire -staticTextW widget = guiSetPropW widget "Text" - -_bst = mkFix (\time b -> if b then Right "True" else Right "False") -_stb = mkFix (\time st -> if st == "True" then Right True else Right False) - --- | Consructor for two wires, which deliver the checkbox GUI element functionality. -checkBoxW :: GUIElement -- ^ GUI element (should be a checkbox) - -> (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire -checkBoxW widget = (changed, setter) where - (changed', setter') = _createGUIValueW widget "Selected" "CheckStateChanged" - changed = _stb . changed' - setter = _stb . setter' . _bst - --- | Constructor for two wires, which deliver the radiobuttion GUI element functionality. -radioButtonW :: GUIElement -- ^ GUI element (should be a checkbox) - -> (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire -radioButtonW widget = (changed, setter) where - (changed', setter') = _createGUIValueW widget "Selected" "SelectStateChanged" - changed = _stb . changed' - setter = _stb . setter' . _bst - -_fst = mkFix (\time f -> Right $ show f) -_stf = mkFix (\time st -> Right $ read st) - --- | Constructor for two wires, which deliver the slider GUI element functionality. -sliderW :: GUIElement -- ^ GUI element (should be a slider) - -> (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire -sliderW widget = (changed, setter) where - (changed', setter') = _createGUIValueW widget "CurrentValue" "ValueChanged" - changed = _stf . changed' - setter = _stf . setter' . _fst - --- | Constructur for two wires, which deliver the spinner GUI element functionality. -spinnerW :: GUIElement -- ^ GUI element (which should be a spinner) - -> (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire -spinnerW = sliderW - --- | Constructure for an event wire, which deliver the button functionality. It simply fires the event on button press. -buttonW :: GUIElement -- ^ GUI element (which should be a button) - -> GameWire a a -- ^ event wire -buttonW widget = guiEventW widget "Clicked" - -_listboxGetSelectedTextW :: GUIElement -> GameWire a [String] -_listboxGetSelectedTextW widget = mkFixM (\t s -> do - t <- listboxGetSelectedText widget - return $ Right t) - -_listboxSetTextW :: GUIElement -> GameWire [String] [String] -_listboxSetTextW widget = mkFixM (\t ls -> do - listboxRemoveAllText widget - mapM (listboxAddText widget) ls - return (Right ls)) - --- | Constructur for two wires, which deliver the listbox functionality. -listBoxW :: GUIElement -- ^ GUI element, which should be a list box - -> (GameWire a [String], GameWire [String] [String]) -- ^ Two wires as return value, a value changed wire and a wire - -- which sets the listbox. Those wires are slightly differently since the setter sets the list of choices, not the - -- actual selection on them. The changed value wire delivers an array of selections on each change. -listBoxW widget = (changed, setter) where - changeW = guiEventW widget "ItemSelectionChanged" - valueW = _listboxGetSelectedTextW widget - changed = valueW . changeW - setter = _listboxSetTextW widget - -_comboboxSetTextW :: GUIElement -> GameWire [String] [String] -_comboboxSetTextW widget = mkFixM (\t ls -> do - comboboxRemoveAllText widget - mapM (comboboxAddText widget) ls - return (Right ls)) - --- | Constructor for two wires, which deliver the combobox functionality. -comboBoxW :: GUIElement -- ^ GUI element, which should be a combobox - -> (GameWire a String, GameWire [String] [String]) -- ^ Two wires, one value changed wire, which delivers just one selection and a setter wire, with which the selectable elements can be set. The possibility, to edit the selected element is not included in the functionality. -comboBoxW widget = (changed, setter) where - changeW = guiEventW widget "ListSelectionAccepted" - valueW = guiGetPropW widget "Text" - changed = valueW . changeW - setter = _comboboxSetTextW widget - - -_changeOnlyOnInputWire (cw, sw) = do - rb <- liftIO $ newIORef False - let sw' = mkFixM (\t a -> do - liftIO $ writeIORef rb True - return (Right a)) . sw - let cw' = mkFixM (\t a -> do - b <- liftIO $ readIORef rb - liftIO $ writeIORef rb False - if b then return (Left ()) else return (Right a)) . cw - return (cw', sw') - - --- | Constructor for two wires, which in combination provide the functionality of an editable box GUI element. Version, which does not deliver a change event, if value set by program. -editBoxW' :: GUIElement -- ^ GUI element (should be an editbox) - -> MHGamer3D (GameWire a String, GameWire String String) -- ^ Two wires as return value, a wire, which fires when the value changed and a setter wire, which sets the text of the editbox. -editBoxW' el = _changeOnlyOnInputWire (editBoxW el) - --- | Constructor for two wires, which provide the functionality of an editable box for float values as a GUI element. Version, which does not deliver a change event, if value set by program. -floatEditBoxW' :: GUIElement -- ^ GUI element (should be an editbox) - -> MHGamer3D (GameWire a Float, GameWire Float Float) -- ^ Two wires as return value, a value changed wire and a setter wire. -floatEditBoxW' el = _changeOnlyOnInputWire (floatEditBoxW el) - --- | Consructor for two wires, which deliver the checkbox GUI element functionality. Version, which does not deliver a change event, if value set by program. -checkBoxW' :: GUIElement -- ^ GUI element (should be a checkbox) - -> MHGamer3D (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire -checkBoxW' el = _changeOnlyOnInputWire (checkBoxW el) - --- | Constructor for two wires, which deliver the radiobuttion GUI element functionality. Version, which does not deliver a change event, if value set by program. -radioButtonW' :: GUIElement -- ^ GUI element (should be a checkbox) - -> MHGamer3D (GameWire a Bool, GameWire Bool Bool) -- ^ the returned wires, a value changed wire and a setter wire -radioButtonW' el = _changeOnlyOnInputWire (radioButtonW el) - --- | Constructor for two wires, which deliver the slider GUI element functionality. Version, which does not deliver a change event, if value set by program. -sliderW' :: GUIElement -- ^ GUI element (should be a slider) - -> MHGamer3D (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire -sliderW' el = _changeOnlyOnInputWire (sliderW el) - --- | Constructur for two wires, which deliver the spinner GUI element functionality. Version, which does not deliver a change event, if value set by program. -spinnerW' :: GUIElement -- ^ GUI element (which should be a spinner) - -> MHGamer3D (GameWire a Float, GameWire Float Float) -- ^ the returned wires, a value changed wire and a setter wire -spinnerW' el = _changeOnlyOnInputWire (spinnerW el) - - -{-$EditGUIWire - The standard GUI wire creation functions are not in the MHGamer3D monad. This enables their usage in an easy way in GHCI. - The editable elements are composed of two different types of functions, which might occurr at different times and therefore - the corresponding wires are two, in each case. One type of functions sets the content of the editable element. For example - the setter functions set the text of an editbox or the position of a slider. The other type of functions deliver an event - in the case the value has been changed from the GUI user. The simple wires below also deliver a change event in case - the value has been set by the programmer with the setter. Below are more complex wires (still with the same API) which do - not deliver a change event, in case the programmer sets the value of a GUI element. --} - -{-$FireOnlyOnGUI - Below functions do not deliver a change event in case the programmer sets the value by the setter wire. This enables much more - easy usage in case of circular dependencies between GUI elements. The creation functions are in the MHGamer3D monad. --} diff --git a/HGamer3D/APIs/FRP/Graphics3D.hs b/HGamer3D/APIs/FRP/Graphics3D.hs deleted file mode 100644 --- a/HGamer3D/APIs/FRP/Graphics3D.hs +++ /dev/null @@ -1,97 +0,0 @@ -{-# LANGUAGE Arrows #-} - --- | 3D graphics functionality of the FRP API -module HGamer3D.APIs.FRP.Graphics3D - -( - scaleW, - translateW, - scaleToW, - directionW, - directionToW, - positionW, - positionToW, - orientationW, - orientationToW -) - -where - -import HGamer3D.APIs.Base as Base -import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController - -import Control.Monad.Trans - -import Control.Monad.Identity (Identity) -import Control.Wire -import Prelude hiding ((.), id) - -import Control.Monad.Reader -import Control.Monad.State - -import HGamer3D.APIs.FRP.Types -import Data.IORef - --- | A wire, which delivers each cycle the position, input is ignored -positionW :: Position3D ob => ob -- ^ positionable object - -> GameWire a Vec3 -- ^ wire which delivers the position -positionW ob = mkFixM (\t x -> do - vec <- position3D ob - return (Right vec)) - --- | A wire, which sets and returns the position -positionToW :: Position3D ob => ob -- ^ positionable object - -> GameWire Vec3 Vec3 -- ^ wire which sets and returns the position -positionToW ob = mkFixM (\t vec -> do - positionTo3D ob vec - return (Right vec)) - --- | A wire, which translates each cycle the position -translateW :: Position3D ob => ob -- ^ positionable object - -> GameWire Vec3 Vec3 -- ^ wire, which translates the object -translateW ob = mkFixM (\t v -> do - translate3D ob v - return (Right v)) - --- | A wire, which delivers each cycle the direction, input is ignored -directionW :: Direction3D ob => ob -- ^ object with direction - -> GameWire a Vec3 -- ^ wire, which delivers the direction -directionW ob = mkFixM (\t x -> do - vec <- direction3D ob - return (Right vec)) - --- | A wire, which sets the direction -directionToW :: Direction3D ob => ob -- ^ directionable object - -> GameWire Vec3 Vec3 -- ^ wire, which sets direction -directionToW ob = mkFixM (\t v -> do - directionTo3D ob v - return (Right v)) - --- | A wire, which delivers each cycle the scale, input is ignored -scaleW :: Scale3D ob => ob -- ^ scalable object - -> GameWire a Vec3 -- ^ wire, which delivers the scale -scaleW ob = mkFixM (\t x -> do - vec <- scale3D ob - return (Right vec)) - --- | A wire, which sets the scale -scaleToW :: Scale3D ob => ob -- ^ scalable object - -> GameWire Vec3 Vec3 -- ^ a wire, which sets and returns the scale -scaleToW ob = mkFixM (\t v -> do - scaleTo3D ob v - return (Right v)) - --- | A wire, which delivers each cycle the orientation, input is ignored -orientationW :: Orientation3D ob => ob -- ^ object with orientation - -> GameWire a UnitQuaternion -- ^ wire, which delivers the orientation, as a unit quaternion -orientationW ob = mkFixM (\t x -> do - ori <- orientation3D ob - return (Right ori)) - --- | A wire, which sets the orientation -orientationToW :: Orientation3D ob => ob -- ^ object with orientation - -> GameWire UnitQuaternion UnitQuaternion -- ^ a wire which sets and returns the orientation -orientationToW ob = mkFixM (\t ori -> do - orientationTo3D ob ori - return (Right ori)) - diff --git a/HGamer3D/APIs/FRP/InputSystem.hs b/HGamer3D/APIs/FRP/InputSystem.hs deleted file mode 100644 --- a/HGamer3D/APIs/FRP/InputSystem.hs +++ /dev/null @@ -1,123 +0,0 @@ -{-# LANGUAGE Arrows #-} - --- | Input device functionality of FRP API. Mouse, Joystick, Keyboard input is handled. -module HGamer3D.APIs.FRP.InputSystem - -( - -- * Joystick functionality - connectedJoysticksW, - joystickButtonW, - joystickButtonPressedW, - joystickAxisPositionW, - - -- * Mouse functionality - mouseButtonW, - mouseButtonPressedW, - mousePositionW, - - -- * Keyboard functionality - keyW, - keyPressedW -) - -where - -import HGamer3D.APIs.Base as Base -import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController - -import Control.Monad.Trans - -import Control.Monad.Identity (Identity) -import Control.Wire -import Prelude hiding ((.), id) - -import Control.Monad.Reader -import Control.Monad.State - -import Data.IORef -import HGamer3D.APIs.FRP.Types - --- Joystick ------------ - --- | Wire, which delivers the connected joysticks -connectedJoysticksW :: GameWire a [Joystick] -connectedJoysticksW = mkFixM (\t a -> do - updateJoystickStatus - js <- getConnectedJoysticks - return (Right js)) - -_joystickButtonStatus :: Joystick -> JoystickButton -> GameWire a Bool -_joystickButtonStatus joystick button = mkFixM (\t a -> do - updateJoystickStatus - pressed <- isJoystickButtonPressed joystick button - return (Right pressed)) - --- | Wire, which fires, when joystick button is pressed -joystickButtonW :: Joystick -- ^ joystick - -> JoystickButton -- ^ joystick button, to be checked - -> GameWire a a -- ^ event, which fires, when button pressed -joystickButtonW joystick button = ifW (_joystickButtonStatus joystick button) id (inhibit ()) - --- | Wire, which fires after a button down, button up sequence of a joystick button -joystickButtonPressedW :: Joystick -- ^ joystick - -> JoystickButton -- ^ joystick button, to be checked - -> GameWire a a -- ^ event, which fires, after button has been pressed once -joystickButtonPressedW joystick button = ifW ((edge (\a -> not a)) . (_joystickButtonStatus joystick button)) id (inhibit ()) - --- | Wire, which delivers the value of a joystick axis -joystickAxisPositionW :: Joystick -- ^ joystick - -> EnumJoystickAxis -- ^ joystick axis, to be checked - -> GameWire a Float -- ^ delivers position of joystick axis, input value ignored -joystickAxisPositionW joystick axis = mkFixM (\t a -> do - updateJoystickStatus - rval <- getJoystickAxisPosition joystick axis - return (Right rval)) - - --- Mouse --------- - -_mouseButtonStatus :: EnumMouseButton -> GameWire a Bool -_mouseButtonStatus button = mkFixM (\t a -> do - pressed <- isMouseButtonPressed button - return (Right pressed)) - --- | Wire, which fires, when mouse button is pressed -mouseButtonW :: EnumMouseButton -- ^ mouse button, to be checked - -> GameWire a a -- ^ event, which fires, when button pressed -mouseButtonW button = ifW (_mouseButtonStatus button) id (inhibit ()) - --- | Wire, which fires after a button down, button up sequence of a mouse button -mouseButtonPressedW :: EnumMouseButton -- ^ mouse button, to be checked - -> GameWire a a -- ^ event, which fires, after button has been pressed once -mouseButtonPressedW button = ifW ((edge (\a -> not a)) . (_mouseButtonStatus button)) id (inhibit ()) - --- | Wire, which delivers the value of the mouse position -mousePositionW :: GameWire a (Int, Int) -- ^ delivers position of mouse, x, y in absolute screen pixels, input value ignored -mousePositionW = mkFixM (\t a -> do - rval <- getMousePosition - return (Right rval)) - - - --- Keyboard ------------ - -_keyStatus :: EnumKey -> GameWire a Bool -_keyStatus key = mkFixM (\t a -> do - val <- isKeyPressed key - return (Right val)) - --- | Wire, which delivers an event, if key is pressed -keyW :: EnumKey -- ^ the key, to be checked - -> GameWire a a -- ^ the event wire -keyW key = ifW (_keyStatus key) id (inhibit ()) - --- | Wire, which delivers an event after a key down, key up sequence -keyPressedW :: EnumKey -- ^ the key, to be checked - -> GameWire a a -- ^ the event wire -keyPressedW key = ifW ((edge (\a -> not a)) . (_keyStatus key)) id (inhibit ()) - - - diff --git a/HGamer3D/APIs/FRP/Network.hs b/HGamer3D/APIs/FRP/Network.hs deleted file mode 100644 --- a/HGamer3D/APIs/FRP/Network.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE Arrows #-} - -module HGamer3D.APIs.FRP.Network - -( -) - -where - -import HGamer3D.APIs.Base as Base -import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController - -import Control.Monad.Trans - -import Control.Monad.Identity (Identity) -import Control.Wire -import Prelude hiding ((.), id) - -import Control.Monad.Reader -import Control.Monad.State - -import Data.IORef -import HGamer3D.APIs.FRP.Types - - diff --git a/HGamer3D/APIs/FRP/Types.hs b/HGamer3D/APIs/FRP/Types.hs deleted file mode 100644 --- a/HGamer3D/APIs/FRP/Types.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE Arrows #-} - -module HGamer3D.APIs.FRP.Types - -( - mkRefWire, - swapRefWire, - MHGamer3D2, - GameWire -) - -where - -import HGamer3D.APIs.Base as Base -import HGamer3D.Bindings.CEGUI.ClassHG3DEventController as HG3DEventController - -import Control.Monad.Trans - -import Control.Monad.Identity (Identity) -import Control.Wire -import Prelude hiding ((.), id) - -import Control.Monad.Reader -import Control.Monad.State - -import Control.Concurrent.MVar -import Data.IORef - -type MHGamer3D2 = (ReaderT HG3DReaderState) (StateT HG3DEngineState IO) -type GameWire a b = Wire () MHGamer3D2 a b - --- function to keep a reference to a wire - -mrefWireFunction :: Time -> (a, MVar (Wire e MHGamer3D2 a b)) -> MHGamer3D (Either e b, (MVar (Wire e MHGamer3D2 a b))) -mrefWireFunction dt (a, s) = do - wire <- liftIO $ takeMVar s - (r, wire') <- stepWire wire dt a - liftIO $ putMVar s wire' - return (r, s) - -mkRefWire :: Wire e MHGamer3D2 a b -> IO (MVar (Wire e MHGamer3D2 a b), (Wire e MHGamer3D2 a b)) -mkRefWire wire = do - ref <- newMVar wire - let wire' = mkStateM ref mrefWireFunction - return (ref, wire') - -swapRefWire :: MVar (Wire e MHGamer3D2 a b) -> Wire e MHGamer3D2 a b -> IO (Wire e MHGamer3D2 a b) -swapRefWire ref wire = swapMVar ref wire diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,15 +1,42 @@ -(c) 2011-2013 Peter Althainz +LICENSE +------- -The files are part of HGamer3D (www.hgamer3d.org) +(c) 2011-2014 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 +HGamer3D (http://www.hgamer3d.org) +---------------------------------- -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. +HGamer3D is licensed under the Apache License, Version 2.0 (the "License"); you may not use this software 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. + + +Source Code +----------- +You can obtain the latest version of the source code under http://www.bitbucket.org/althainz/HGamer3D + + +Open Source Software Used - Module HGamer3D +------------------------------------------- + +HGamer3D uses a number of open source software libraries. You are responsible to comply to the licenses of those packages and the licenses of software used by those packages if you use HGamer3D. + +The HGamer3D module uses the following Haskell libraries from Hackage: + +base, license: BSD3 +containers, license: BSD3 +text, license: BSD3 +directory, license: BSD3 +mtl, license: BSD3 +FindBin, license: BSD3 +monad-loops, license: PublicDomain, BSD3 similar +split, license: BSD3 +netwire, license: BSD3 +HGamer3D-Data, license: Apache 2.0 +HGamer3D-Ogre-Binding, license: Apache 2.0 and dependencies see in that module +HGamer3D-SFML-Binding, license: Apache 2.0 and dependencies see in that module +HGamer3D-CEGUI-Binding, license: Apache 2.0 and dependencies see in that module +HGamer3D-Enet-Binding, license: Apache 2.0 and dependencies see in that module diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,8 +1,8 @@ -- 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 +-- For the latest info, see http://www.hgamer3d.org -- --- (c) 2011 Peter Althainz +-- (c) 2011-2013 Peter Althainz -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License.