summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjunjihashimoto <>2020-02-13 07:45:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-02-13 07:45:00 (GMT)
commit072047b6cbe69d5c0c09331aba44cfaad43bed7d (patch)
treeece302b015a5062786213982f16115a993de0128
version 0.1.0.00.1.0.0
-rw-r--r--ChangeLog.md3
-rw-r--r--HsWebots.cabal126
-rw-r--r--LICENSE7
-rw-r--r--README.md3
-rw-r--r--Setup.hs2
-rw-r--r--app/Main.hs164
-rw-r--r--src/Webots/Accelerometer.hs52
-rw-r--r--src/Webots/Brake.hs52
-rw-r--r--src/Webots/Camera.hs174
-rw-r--r--src/Webots/Compass.hs52
-rw-r--r--src/Webots/Connector.hs60
-rw-r--r--src/Webots/Console.hs40
-rw-r--r--src/Webots/Device.hs40
-rw-r--r--src/Webots/DifferentialWheels.hs80
-rw-r--r--src/Webots/Display.hs128
-rw-r--r--src/Webots/DistanceSensor.hs68
-rw-r--r--src/Webots/Driver.hs136
-rw-r--r--src/Webots/Emitter.hs60
-rw-r--r--src/Webots/Gps.hs64
-rw-r--r--src/Webots/Gyro.hs52
-rw-r--r--src/Webots/InertialUnit.hs52
-rw-r--r--src/Webots/Joystick.hs96
-rw-r--r--src/Webots/Keyboard.hs52
-rw-r--r--src/Webots/Led.hs44
-rw-r--r--src/Webots/Lidar.hs60
-rw-r--r--src/Webots/LightSensor.hs52
-rw-r--r--src/Webots/Microphone.hs48
-rw-r--r--src/Webots/Motor.hs152
-rw-r--r--src/Webots/Mouse.hs72
-rw-r--r--src/Webots/Nodes.hs40
-rw-r--r--src/Webots/Pen.hs44
-rw-r--r--src/Webots/PositionSensor.hs64
-rw-r--r--src/Webots/Radar.hs52
-rw-r--r--src/Webots/Radio.hs141
-rw-r--r--src/Webots/RangeFinder.hs48
-rw-r--r--src/Webots/Receiver.hs68
-rw-r--r--src/Webots/RemoteControl.hs124
-rw-r--r--src/Webots/Robot.hs176
-rw-r--r--src/Webots/Skin.hs60
-rw-r--r--src/Webots/Speaker.hs72
-rw-r--r--src/Webots/Supervisor.hs548
-rw-r--r--src/Webots/TouchSensor.hs60
-rw-r--r--src/Webots/Types.hs99
-rw-r--r--test/Spec.hs2
44 files changed, 3589 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..3eb5481
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for HsWebots
+
+## Unreleased changes
diff --git a/HsWebots.cabal b/HsWebots.cabal
new file mode 100644
index 0000000..4bc333c
--- /dev/null
+++ b/HsWebots.cabal
@@ -0,0 +1,126 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.32.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: e6548a8c426c4713ccc1f02cf5d47595be365cd0d81e184ad1c647ca0df5e040
+
+name: HsWebots
+version: 0.1.0.0
+synopsis: Webots bindings for Haskell
+description: Please see the README on GitHub at <https://github.com/githubuser/HsWebots#readme>
+category: Robotics
+homepage: https://github.com/junjihashimoto/HsWebots#readme
+bug-reports: https://github.com/junjihashimoto/HsWebots/issues
+author: Junji Hashimoto
+maintainer: junji.hashimoto@gmail.com
+copyright: 2020 Junji Hashimoto
+license: MIT
+license-file: LICENSE
+build-type: Simple
+extra-source-files:
+ README.md
+ ChangeLog.md
+
+source-repository head
+ type: git
+ location: https://github.com/junjihashimoto/HsWebots
+
+library
+ exposed-modules:
+ Webots.Accelerometer
+ Webots.Brake
+ Webots.Camera
+ Webots.Compass
+ Webots.Connector
+ Webots.Console
+ Webots.Device
+ Webots.DifferentialWheels
+ Webots.Display
+ Webots.DistanceSensor
+ Webots.Driver
+ Webots.Emitter
+ Webots.Gps
+ Webots.Gyro
+ Webots.InertialUnit
+ Webots.Joystick
+ Webots.Keyboard
+ Webots.Led
+ Webots.Lidar
+ Webots.LightSensor
+ Webots.Microphone
+ Webots.Motor
+ Webots.Mouse
+ Webots.Nodes
+ Webots.Pen
+ Webots.PositionSensor
+ Webots.Radar
+ Webots.Radio
+ Webots.RangeFinder
+ Webots.Receiver
+ Webots.RemoteControl
+ Webots.Robot
+ Webots.Skin
+ Webots.Speaker
+ Webots.Supervisor
+ Webots.TouchSensor
+ Webots.Types
+ other-modules:
+ Paths_HsWebots
+ hs-source-dirs:
+ src
+ build-depends:
+ JuicyPixels
+ , base >=4.7 && <5
+ , bytestring
+ , inline-c >=0.9.0.0
+ , inline-c-cpp >=0.4.0.0
+ , safe-exceptions
+ , template-haskell
+ , vector
+ default-language: Haskell2010
+
+executable HsWebots-exe
+ main-is: Main.hs
+ other-modules:
+ Paths_HsWebots
+ hs-source-dirs:
+ app
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ HsWebots
+ , JuicyPixels
+ , base >=4.7 && <5
+ , bytestring
+ , inline-c >=0.9.0.0
+ , inline-c-cpp >=0.4.0.0
+ , language-c
+ , pretty
+ , safe-exceptions
+ , shakespeare
+ , syb
+ , template-haskell
+ , text
+ , vector
+ default-language: Haskell2010
+
+test-suite HsWebots-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ other-modules:
+ Paths_HsWebots
+ hs-source-dirs:
+ test
+ ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ HsWebots
+ , JuicyPixels
+ , base >=4.7 && <5
+ , bytestring
+ , inline-c >=0.9.0.0
+ , inline-c-cpp >=0.4.0.0
+ , safe-exceptions
+ , template-haskell
+ , vector
+ default-language: Haskell2010
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..1dc7028
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,7 @@
+Copyright 2020 Junji Hashimoto
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..c38f426
--- /dev/null
+++ b/README.md
@@ -0,0 +1,3 @@
+# HsWebots
+
+Webots bindings for Haskell
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..c2fa655
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+module Main where
+
+import System.IO
+import System.Environment
+import Data.Generics
+import Data.List
+import Language.C
+import Language.C.System.GCC
+import Language.C.Data
+import Language.C.Data.Ident
+import Text.PrettyPrint
+import Control.Monad
+import Text.Shakespeare.Text
+import qualified Data.Text.IO as T
+
+whenM cond exp = if cond then exp else pure ()
+
+main = do
+ (filename:[]) <- getArgs
+ parseMyFile filename >>= \i -> do
+ case i of
+ CTranslUnit v a -> do
+ forM_ v $ \i -> do
+ printFunc filename i
+
+parseMyFile :: FilePath -> IO CTranslUnit
+parseMyFile input_file =
+ do parse_result <- parseCFile (newGCC "gcc") Nothing ["-Ideps/webots/include"] input_file
+ case parse_result of
+ Left parse_err -> error (show parse_err)
+ Right ast -> return ast
+
+class CIdent a where
+ toIdent :: a -> String
+
+instance CIdent Ident where
+ toIdent a = identToString a
+
+instance CIdent (CStorageSpecifier NodeInfo) where
+ toIdent a = render $ pretty a
+
+instance CIdent (CTypeSpecifier NodeInfo) where
+ toIdent a = render $ pretty a
+
+instance CIdent (CTypeQualifier NodeInfo) where
+ toIdent a = render $ pretty a
+
+instance CIdent (CFunctionSpecifier NodeInfo) where
+ toIdent a = render $ pretty a
+
+instance CIdent (CAlignmentSpecifier NodeInfo) where
+ toIdent a = render $ pretty a
+
+instance CIdent (CDeclarationSpecifier NodeInfo) where
+ toIdent a = render $ pretty a
+
+instance CIdent (CDeclaration NodeInfo) where
+ toIdent (CDecl [CStorageSpec a] _ _) = toIdent a
+ toIdent (CDecl [CTypeSpec a] _ _) = toIdent a
+ toIdent (CDecl [CTypeQual a] _ _) = toIdent a
+ toIdent (CDecl [CFunSpec a] _ _) = toIdent a
+ toIdent (CDecl [CAlignSpec a] _ _) = toIdent a
+ toIdent (CDecl a _ _) = intercalate "," $ map toIdent a
+ toIdent a = "not-parsed"
+
+
+csnd (CDecl [CStorageSpec a] b _) = b
+csnd (CDecl [CTypeSpec a] b _) = b
+csnd (CDecl [CTypeQual a] b _) = b
+csnd (CDecl [CFunSpec a] b _) = b
+csnd (CDecl [CAlignSpec a] b _) = b
+csnd (CDecl a b _) = b
+csnd a = undefined
+
+getArgIds [] = []
+getArgIds ((Just (CDeclr
+ (Just arg)
+ _
+ _
+ _
+ _
+ )):xs) = toIdent arg : getArgIds xs
+getArgIds (_:xs) = "xxx" : getArgIds xs
+
+printFunc :: FilePath -> CExternalDeclaration NodeInfo -> IO ()
+printFunc path (CDeclExt (CDecl
+ rets
+ [(Just (CDeclr
+ (Just func_name)
+ (CFunDeclr (Right (args,_)) _ _:_)
+ _
+ _
+ _
+ )
+ ,_
+ ,_)]
+ (NodeInfo pos _ _)
+ )
+ ) = whenM (path == posFile pos) $ do
+ T.putStr [st|
+#{toIdent func_name} :: #{argsH}IO #{retH}
+#{toIdent func_name} #{argIds} =
+ #{bra} #{retC} { #{toIdent func_name}(#{argsC}) } #{ket}
+|]
+ where
+ bra = "[C.exp|"
+ ket = "|]"
+ retH = case map toIdent rets of
+ ["void"] -> "()"
+ ["char"] -> "CBool"
+ ["int"] -> "CInt"
+ ["double"] -> "CDouble"
+ ["const","char"] -> "String"
+ ["const","double"] -> "Ptr CDouble"
+ [a] -> a
+ _ -> "UnKnown"
+ retC = case map toIdent rets of
+ ["void"] -> "void"
+ ["char"] -> "bool"
+ ["int"] -> "int"
+ ["double"] -> "double"
+ ["const","char"] -> "const char*"
+ ["const","double"] -> "const double*"
+ [a] -> a
+ argH arg = case arg of
+ "void" -> "()"
+ "char" -> "CBool"
+ "int" -> "CInt"
+ "double" -> "CDouble"
+ "const,char" -> "String"
+ "const,double" -> "Ptr CDouble"
+ a -> a
+ _ -> "UnKnown"
+ argsH =
+ case map (\(i :: CDeclaration NodeInfo) -> argH (toIdent i)) args of
+ [] -> ""
+ a -> (intercalate " -> " a) ++ " -> "
+ argC arg = case arg of
+ "void" -> "void"
+ "char" -> "bool"
+ "int" -> "int"
+ "double" -> "double"
+ "const,char" -> "const char*"
+ "const,double" -> "const double*"
+ a -> a
+ args' = getArgIds (map (\(a,b,c) -> a) $ concat $ map (\a -> csnd a) args)
+ argsC =
+ case (map (\(i :: CDeclaration NodeInfo) -> argC (toIdent i)) args,args') of
+ ([],_) -> ""
+ (_,[]) -> ""
+ (a,b) -> intercalate ", " $ map (\(aa,bb) -> "$("++ aa ++ " " ++ bb ++")" ) $ zip a b
+ argIds = intercalate " " args'
+printFunc path (CDeclExt a@(CDecl ret body (NodeInfo pos _ _))) = return ()
+-- whenM (path == posFile pos) $ print a
+printFunc path (CDeclExt a@(CStaticAssert exp lit _)) = return ()
+printFunc path (CFDefExt a) = return ()
+printFunc path (CAsmExt a _) = return ()
+
diff --git a/src/Webots/Accelerometer.hs b/src/Webots/Accelerometer.hs
new file mode 100644
index 0000000..377f262
--- /dev/null
+++ b/src/Webots/Accelerometer.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Accelerometer where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/accelerometer.h>"
+
+wb_accelerometer_enable :: WbDeviceTag -> CInt -> IO ()
+wb_accelerometer_enable tag sampling_period =
+ [C.exp| void { wb_accelerometer_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_accelerometer_disable :: WbDeviceTag -> IO ()
+wb_accelerometer_disable tag =
+ [C.exp| void { wb_accelerometer_disable($(WbDeviceTag tag)) } |]
+
+wb_accelerometer_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_accelerometer_get_sampling_period tag =
+ [C.exp| int { wb_accelerometer_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_accelerometer_get_values :: WbDeviceTag -> IO (Ptr CDouble)
+wb_accelerometer_get_values tag =
+ [C.exp| const double* { wb_accelerometer_get_values($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Brake.hs b/src/Webots/Brake.hs
new file mode 100644
index 0000000..72166b7
--- /dev/null
+++ b/src/Webots/Brake.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Brake where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/brake.h>"
+
+wb_brake_set_damping_constant :: WbDeviceTag -> CDouble -> IO ()
+wb_brake_set_damping_constant tag damping_constant =
+ [C.exp| void { wb_brake_set_damping_constant($(WbDeviceTag tag), $(double damping_constant)) } |]
+
+wb_brake_get_type :: WbDeviceTag -> IO WbJointType
+wb_brake_get_type tag =
+ [C.exp| WbJointType { wb_brake_get_type($(WbDeviceTag tag)) } |]
+
+wb_brake_get_motor :: WbDeviceTag -> IO WbDeviceTag
+wb_brake_get_motor tag =
+ [C.exp| WbDeviceTag { wb_brake_get_motor($(WbDeviceTag tag)) } |]
+
+wb_brake_get_position_sensor :: WbDeviceTag -> IO WbDeviceTag
+wb_brake_get_position_sensor tag =
+ [C.exp| WbDeviceTag { wb_brake_get_position_sensor($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Camera.hs b/src/Webots/Camera.hs
new file mode 100644
index 0000000..3b95146
--- /dev/null
+++ b/src/Webots/Camera.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Camera where
+
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/camera.h>"
+
+wb_camera_enable :: WbDeviceTag -> CInt -> IO ()
+wb_camera_enable tag sampling_period =
+ [C.exp| void { wb_camera_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_camera_disable :: WbDeviceTag -> IO ()
+wb_camera_disable tag =
+ [C.exp| void { wb_camera_disable($(WbDeviceTag tag)) } |]
+
+wb_camera_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_camera_get_sampling_period tag =
+ [C.exp| int { wb_camera_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_camera_get_image :: WbDeviceTag -> IO (I.Image I.PixelRGBA8)
+wb_camera_get_image tag = do
+ let channel = 4
+ zero = I.PixelRGBA8 0 0 0 0
+ width <- fromIntegral <$> wb_camera_get_width tag
+ height <- fromIntegral <$> wb_camera_get_height tag
+ ptr1 <- [C.exp| const char* { wb_camera_get_image($(WbDeviceTag tag)) } |]
+ let img@(I.Image w h vec) = I.generateImage (\_ _ -> zero) width height
+ let (fptr,len) = V.unsafeToForeignPtr0 vec
+ whc = width * height * channel
+ if (len /= whc) then
+ throwIO $ userError $ "vector's length(" ++ show len ++ ") is not the same as image' one."
+ else do
+ F.withForeignPtr fptr $ \ptr2 -> do
+ BSI.memcpy (F.castPtr ptr2) (F.castPtr ptr1) len
+-- return $ I.pixelMap bgr2rgb img
+ return $ img
+ where
+ bgr2rgb (I.PixelRGBA8 b g r a) = I.PixelRGBA8 r g b a
+
+wb_camera_get_width :: WbDeviceTag -> IO CInt
+wb_camera_get_width tag =
+ [C.exp| int { wb_camera_get_width($(WbDeviceTag tag)) } |]
+
+wb_camera_get_height :: WbDeviceTag -> IO CInt
+wb_camera_get_height tag =
+ [C.exp| int { wb_camera_get_height($(WbDeviceTag tag)) } |]
+
+wb_camera_get_fov :: WbDeviceTag -> IO CDouble
+wb_camera_get_fov tag =
+ [C.exp| double { wb_camera_get_fov($(WbDeviceTag tag)) } |]
+
+wb_camera_get_max_fov :: WbDeviceTag -> IO CDouble
+wb_camera_get_max_fov tag =
+ [C.exp| double { wb_camera_get_max_fov($(WbDeviceTag tag)) } |]
+
+wb_camera_get_min_fov :: WbDeviceTag -> IO CDouble
+wb_camera_get_min_fov tag =
+ [C.exp| double { wb_camera_get_min_fov($(WbDeviceTag tag)) } |]
+
+wb_camera_set_fov :: WbDeviceTag -> CDouble -> IO ()
+wb_camera_set_fov tag fov =
+ [C.exp| void { wb_camera_set_fov($(WbDeviceTag tag), $(double fov)) } |]
+
+wb_camera_get_focal_length :: WbDeviceTag -> IO CDouble
+wb_camera_get_focal_length tag =
+ [C.exp| double { wb_camera_get_focal_length($(WbDeviceTag tag)) } |]
+
+wb_camera_get_focal_distance :: WbDeviceTag -> IO CDouble
+wb_camera_get_focal_distance tag =
+ [C.exp| double { wb_camera_get_focal_distance($(WbDeviceTag tag)) } |]
+
+wb_camera_get_max_focal_distance :: WbDeviceTag -> IO CDouble
+wb_camera_get_max_focal_distance tag =
+ [C.exp| double { wb_camera_get_max_focal_distance($(WbDeviceTag tag)) } |]
+
+wb_camera_get_min_focal_distance :: WbDeviceTag -> IO CDouble
+wb_camera_get_min_focal_distance tag =
+ [C.exp| double { wb_camera_get_min_focal_distance($(WbDeviceTag tag)) } |]
+
+wb_camera_set_focal_distance :: WbDeviceTag -> CDouble -> IO ()
+wb_camera_set_focal_distance tag focal_distance =
+ [C.exp| void { wb_camera_set_focal_distance($(WbDeviceTag tag), $(double focal_distance)) } |]
+
+wb_camera_get_near :: WbDeviceTag -> IO CDouble
+wb_camera_get_near tag =
+ [C.exp| double { wb_camera_get_near($(WbDeviceTag tag)) } |]
+
+wb_camera_save_image :: WbDeviceTag -> String -> CInt -> IO CInt
+wb_camera_save_image tag filename quality =
+ withCString filename $ \filename' ->
+ [C.exp| int { wb_camera_save_image($(WbDeviceTag tag), $(const char* filename'), $(int quality)) } |]
+
+wb_camera_has_recognition :: WbDeviceTag -> IO CBool
+wb_camera_has_recognition tag =
+ [C.exp| bool { wb_camera_has_recognition($(WbDeviceTag tag)) } |]
+
+wb_camera_recognition_enable :: WbDeviceTag -> CInt -> IO ()
+wb_camera_recognition_enable tag sampling_period =
+ [C.exp| void { wb_camera_recognition_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_camera_recognition_disable :: WbDeviceTag -> IO ()
+wb_camera_recognition_disable tag =
+ [C.exp| void { wb_camera_recognition_disable($(WbDeviceTag tag)) } |]
+
+wb_camera_recognition_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_camera_recognition_get_sampling_period tag =
+ [C.exp| int { wb_camera_recognition_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_camera_recognition_get_number_of_objects :: WbDeviceTag -> IO CInt
+wb_camera_recognition_get_number_of_objects tag =
+ [C.exp| int { wb_camera_recognition_get_number_of_objects($(WbDeviceTag tag)) } |]
+
+wb_camera_recognition_get_objects :: WbDeviceTag -> IO [WbCameraRecognitionObject]
+wb_camera_recognition_get_objects tag = do
+ num <- wb_camera_recognition_get_number_of_objects tag
+ ptr <- [C.exp| const WbCameraRecognitionObject* { wb_camera_recognition_get_objects($(WbDeviceTag tag)) } |]
+ forM [0..(num-1)] $ \i -> do
+ obj_id <- [C.exp| int { $(WbCameraRecognitionObject* ptr)[$(int i)].id } |]
+ obj_position <- (,,)
+ <$> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].position[0] } |]
+ <*> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].position[1] } |]
+ <*> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].position[2] } |]
+ obj_orientation <- (,,,)
+ <$> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].orientation[0] } |]
+ <*> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].orientation[1] } |]
+ <*> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].orientation[2] } |]
+ <*> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].orientation[3] } |]
+ obj_size <- (,)
+ <$> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].size[0] } |]
+ <*> [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].size[1] } |]
+ obj_position_on_image <- (,)
+ <$> [C.exp| int { $(WbCameraRecognitionObject* ptr)[$(int i)].position_on_image[0] } |]
+ <*> [C.exp| int { $(WbCameraRecognitionObject* ptr)[$(int i)].position_on_image[1] } |]
+ obj_size_on_image <- (,)
+ <$> [C.exp| int { $(WbCameraRecognitionObject* ptr)[$(int i)].size_on_image[0] } |]
+ <*> [C.exp| int { $(WbCameraRecognitionObject* ptr)[$(int i)].size_on_image[1] } |]
+ obj_number_of_colors <- [C.exp| int { $(WbCameraRecognitionObject* ptr)[$(int i)].number_of_colors } |]
+ obj_colors <- forM [0..(obj_number_of_colors-1)] $ \j ->
+ [C.exp| double { $(WbCameraRecognitionObject* ptr)[$(int i)].colors[$(int j)] } |]
+ obj_model <- peekCString =<< [C.exp| const char* { $(WbCameraRecognitionObject* ptr)[$(int i)].model } |]
+ return $ WbCameraRecognitionObject{..}
+
+
diff --git a/src/Webots/Compass.hs b/src/Webots/Compass.hs
new file mode 100644
index 0000000..ad11d7e
--- /dev/null
+++ b/src/Webots/Compass.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Compass where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/compass.h>"
+
+wb_compass_enable :: WbDeviceTag -> CInt -> IO ()
+wb_compass_enable tag sampling_period =
+ [C.exp| void { wb_compass_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_compass_disable :: WbDeviceTag -> IO ()
+wb_compass_disable tag =
+ [C.exp| void { wb_compass_disable($(WbDeviceTag tag)) } |]
+
+wb_compass_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_compass_get_sampling_period tag =
+ [C.exp| int { wb_compass_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_compass_get_values :: WbDeviceTag -> IO (Ptr CDouble)
+wb_compass_get_values tag =
+ [C.exp| const double* { wb_compass_get_values($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Connector.hs b/src/Webots/Connector.hs
new file mode 100644
index 0000000..27e0fcf
--- /dev/null
+++ b/src/Webots/Connector.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Connector where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/connector.h>"
+
+wb_connector_enable_presence :: WbDeviceTag -> CInt -> IO ()
+wb_connector_enable_presence tag sampling_period =
+ [C.exp| void { wb_connector_enable_presence($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_connector_disable_presence :: WbDeviceTag -> IO ()
+wb_connector_disable_presence tag =
+ [C.exp| void { wb_connector_disable_presence($(WbDeviceTag tag)) } |]
+
+wb_connector_get_presence_sampling_period :: WbDeviceTag -> IO CInt
+wb_connector_get_presence_sampling_period tag =
+ [C.exp| int { wb_connector_get_presence_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_connector_get_presence :: WbDeviceTag -> IO CInt
+wb_connector_get_presence tag =
+ [C.exp| int { wb_connector_get_presence($(WbDeviceTag tag)) } |]
+
+wb_connector_lock :: WbDeviceTag -> IO ()
+wb_connector_lock tag =
+ [C.exp| void { wb_connector_lock($(WbDeviceTag tag)) } |]
+
+wb_connector_unlock :: WbDeviceTag -> IO ()
+wb_connector_unlock tag =
+ [C.exp| void { wb_connector_unlock($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Console.hs b/src/Webots/Console.hs
new file mode 100644
index 0000000..e6521b6
--- /dev/null
+++ b/src/Webots/Console.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Console where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/console.h>"
+
+wb_console_print :: String -> CInt -> IO ()
+wb_console_print text stream =
+ withCString text $ \text' -> [C.exp| void { wb_console_print($(const char* text'), $(int stream)) } |]
diff --git a/src/Webots/Device.hs b/src/Webots/Device.hs
new file mode 100644
index 0000000..18c1c50
--- /dev/null
+++ b/src/Webots/Device.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Device where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/device.h>"
+
+wb_device_get_name :: WbDeviceTag -> IO String
+wb_device_get_name dt =
+ peekCString =<< [C.exp| const char* { wb_device_get_name($(WbDeviceTag dt)) } |]
+
+wb_device_get_model :: WbDeviceTag -> IO String
+wb_device_get_model dt =
+ peekCString =<< [C.exp| const char* { wb_device_get_model($(WbDeviceTag dt)) } |]
+
+wb_device_get_node_type :: WbDeviceTag -> IO WbNodeType
+wb_device_get_node_type dt =
+ [C.exp| WbNodeType { wb_device_get_node_type($(WbDeviceTag dt)) } |]
+
diff --git a/src/Webots/DifferentialWheels.hs b/src/Webots/DifferentialWheels.hs
new file mode 100644
index 0000000..a4628ca
--- /dev/null
+++ b/src/Webots/DifferentialWheels.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.DifferentialWheels where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/differential_wheels.h>"
+
+wb_differential_wheels_set_speed :: CDouble -> CDouble -> IO ()
+wb_differential_wheels_set_speed left right =
+ [C.exp| void { wb_differential_wheels_set_speed($(double left), $(double right)) } |]
+
+wb_differential_wheels_get_left_speed :: IO CDouble
+wb_differential_wheels_get_left_speed =
+ [C.exp| double { wb_differential_wheels_get_left_speed() } |]
+
+wb_differential_wheels_get_right_speed :: IO CDouble
+wb_differential_wheels_get_right_speed =
+ [C.exp| double { wb_differential_wheels_get_right_speed() } |]
+
+wb_differential_wheels_get_max_speed :: IO CDouble
+wb_differential_wheels_get_max_speed =
+ [C.exp| double { wb_differential_wheels_get_max_speed() } |]
+
+wb_differential_wheels_get_speed_unit :: IO CDouble
+wb_differential_wheels_get_speed_unit =
+ [C.exp| double { wb_differential_wheels_get_speed_unit() } |]
+
+wb_differential_wheels_enable_encoders :: CInt -> IO ()
+wb_differential_wheels_enable_encoders sampling_period =
+ [C.exp| void { wb_differential_wheels_enable_encoders($(int sampling_period)) } |]
+
+wb_differential_wheels_disable_encoders :: IO ()
+wb_differential_wheels_disable_encoders =
+ [C.exp| void { wb_differential_wheels_disable_encoders() } |]
+
+wb_differential_wheels_get_encoders_sampling_period :: IO CInt
+wb_differential_wheels_get_encoders_sampling_period =
+ [C.exp| int { wb_differential_wheels_get_encoders_sampling_period() } |]
+
+wb_differential_wheels_get_left_encoder :: IO CDouble
+wb_differential_wheels_get_left_encoder =
+ [C.exp| double { wb_differential_wheels_get_left_encoder() } |]
+
+wb_differential_wheels_get_right_encoder :: IO CDouble
+wb_differential_wheels_get_right_encoder =
+ [C.exp| double { wb_differential_wheels_get_right_encoder() } |]
+
+wb_differential_wheels_set_encoders :: CDouble -> CDouble -> IO ()
+wb_differential_wheels_set_encoders left right =
+ [C.exp| void { wb_differential_wheels_set_encoders($(double left), $(double right)) } |]
diff --git a/src/Webots/Display.hs b/src/Webots/Display.hs
new file mode 100644
index 0000000..12ea020
--- /dev/null
+++ b/src/Webots/Display.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Display where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/display.h>"
+
+wb_display_get_width :: WbDeviceTag -> IO CInt
+wb_display_get_width tag =
+ [C.exp| int { wb_display_get_width($(WbDeviceTag tag)) } |]
+
+wb_display_get_height :: WbDeviceTag -> IO CInt
+wb_display_get_height tag =
+ [C.exp| int { wb_display_get_height($(WbDeviceTag tag)) } |]
+
+wb_display_set_color :: WbDeviceTag -> CInt -> IO ()
+wb_display_set_color tag color =
+ [C.exp| void { wb_display_set_color($(WbDeviceTag tag), $(int color)) } |]
+
+wb_display_set_alpha :: WbDeviceTag -> CDouble -> IO ()
+wb_display_set_alpha tag alpha =
+ [C.exp| void { wb_display_set_alpha($(WbDeviceTag tag), $(double alpha)) } |]
+
+wb_display_set_opacity :: WbDeviceTag -> CDouble -> IO ()
+wb_display_set_opacity tag opacity =
+ [C.exp| void { wb_display_set_opacity($(WbDeviceTag tag), $(double opacity)) } |]
+
+wb_display_set_font :: WbDeviceTag -> String -> CInt -> CBool -> IO ()
+wb_display_set_font tag font size anti_aliasing =
+ withCString font $ \font' -> [C.exp| void { wb_display_set_font($(WbDeviceTag tag), $(const char* font'), $(int size), $(bool anti_aliasing)) } |]
+
+wb_display_attach_camera :: WbDeviceTag -> WbDeviceTag -> IO ()
+wb_display_attach_camera tag camera_tag =
+ [C.exp| void { wb_display_attach_camera($(WbDeviceTag tag), $(WbDeviceTag camera_tag)) } |]
+
+wb_display_detach_camera :: WbDeviceTag -> IO ()
+wb_display_detach_camera tag =
+ [C.exp| void { wb_display_detach_camera($(WbDeviceTag tag)) } |]
+
+wb_display_draw_pixel :: WbDeviceTag -> CInt -> CInt -> IO ()
+wb_display_draw_pixel tag x y =
+ [C.exp| void { wb_display_draw_pixel($(WbDeviceTag tag), $(int x), $(int y)) } |]
+
+wb_display_draw_line :: WbDeviceTag -> CInt -> CInt -> CInt -> CInt -> IO ()
+wb_display_draw_line tag x1 y1 x2 y2 =
+ [C.exp| void { wb_display_draw_line($(WbDeviceTag tag), $(int x1), $(int y1), $(int x2), $(int y2)) } |]
+
+wb_display_draw_rectangle :: WbDeviceTag -> CInt -> CInt -> CInt -> CInt -> IO ()
+wb_display_draw_rectangle tag x y width height =
+ [C.exp| void { wb_display_draw_rectangle($(WbDeviceTag tag), $(int x), $(int y), $(int width), $(int height)) } |]
+
+wb_display_draw_oval :: WbDeviceTag -> CInt -> CInt -> CInt -> CInt -> IO ()
+wb_display_draw_oval tag cx cy a b =
+ [C.exp| void { wb_display_draw_oval($(WbDeviceTag tag), $(int cx), $(int cy), $(int a), $(int b)) } |]
+
+wb_display_draw_polygon :: WbDeviceTag -> Ptr CInt -> Ptr CInt -> CInt -> IO ()
+wb_display_draw_polygon tag x y size =
+ [C.exp| void { wb_display_draw_polygon($(WbDeviceTag tag), $(int* x), $(int* y), $(int size)) } |]
+
+wb_display_draw_text :: WbDeviceTag -> String -> CInt -> CInt -> IO ()
+wb_display_draw_text tag text x y =
+ withCString text $ \text' -> [C.exp| void { wb_display_draw_text($(WbDeviceTag tag), $(const char* text'), $(int x), $(int y)) } |]
+
+wb_display_fill_rectangle :: WbDeviceTag -> CInt -> CInt -> CInt -> CInt -> IO ()
+wb_display_fill_rectangle tag x y width height =
+ [C.exp| void { wb_display_fill_rectangle($(WbDeviceTag tag), $(int x), $(int y), $(int width), $(int height)) } |]
+
+wb_display_fill_oval :: WbDeviceTag -> CInt -> CInt -> CInt -> CInt -> IO ()
+wb_display_fill_oval tag cx cy a b =
+ [C.exp| void { wb_display_fill_oval($(WbDeviceTag tag), $(int cx), $(int cy), $(int a), $(int b)) } |]
+
+wb_display_fill_polygon :: WbDeviceTag -> Ptr CInt -> Ptr CInt -> CInt -> IO ()
+wb_display_fill_polygon tag x y size =
+ [C.exp| void { wb_display_fill_polygon($(WbDeviceTag tag), $(int* x), $(int* y), $(int size)) } |]
+
+wb_display_image_new :: WbDeviceTag -> CInt -> CInt -> Ptr () -> CInt -> IO WbImageRef
+wb_display_image_new tag width height dat format =
+ [C.exp| WbImageRef { wb_display_image_new($(WbDeviceTag tag), $(int width), $(int height), $(void* dat), $(int format)) } |]
+
+wb_display_image_copy :: WbDeviceTag -> CInt -> CInt -> CInt -> CInt -> IO WbImageRef
+wb_display_image_copy tag x y width height =
+ [C.exp| WbImageRef { wb_display_image_copy($(WbDeviceTag tag), $(int x), $(int y), $(int width), $(int height)) } |]
+
+wb_display_image_load :: WbDeviceTag -> String -> IO WbImageRef
+wb_display_image_load tag filename =
+ withCString filename $ \filename' -> [C.exp| WbImageRef { wb_display_image_load($(WbDeviceTag tag), $(const char* filename')) } |]
+
+wb_display_image_delete :: WbDeviceTag -> WbImageRef -> IO ()
+wb_display_image_delete tag ir =
+ [C.exp| void { wb_display_image_delete($(WbDeviceTag tag), $(WbImageRef ir)) } |]
+
+wb_display_image_paste :: WbDeviceTag -> WbImageRef -> CInt -> CInt -> CBool -> IO ()
+wb_display_image_paste tag ir x y blend =
+ [C.exp| void { wb_display_image_paste($(WbDeviceTag tag), $(WbImageRef ir), $(int x), $(int y), $(bool blend)) } |]
+
+wb_display_image_save :: WbDeviceTag -> WbImageRef -> String -> IO ()
+wb_display_image_save tag ir filename =
+ withCString filename $ \filename' -> [C.exp| void { wb_display_image_save($(WbDeviceTag tag), $(WbImageRef ir), $(const char* filename')) } |]
diff --git a/src/Webots/DistanceSensor.hs b/src/Webots/DistanceSensor.hs
new file mode 100644
index 0000000..fa1874f
--- /dev/null
+++ b/src/Webots/DistanceSensor.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.DistanceSensor where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/distance_sensor.h>"
+
+wb_distance_sensor_enable :: WbDeviceTag -> CInt -> IO ()
+wb_distance_sensor_enable tag sampling_period =
+ [C.exp| void { wb_distance_sensor_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_distance_sensor_disable :: WbDeviceTag -> IO ()
+wb_distance_sensor_disable tag =
+ [C.exp| void { wb_distance_sensor_disable($(WbDeviceTag tag)) } |]
+
+wb_distance_sensor_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_distance_sensor_get_sampling_period tag =
+ [C.exp| int { wb_distance_sensor_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_distance_sensor_get_value :: WbDeviceTag -> IO CDouble
+wb_distance_sensor_get_value tag =
+ [C.exp| double { wb_distance_sensor_get_value($(WbDeviceTag tag)) } |]
+
+wb_distance_sensor_get_max_value :: WbDeviceTag -> IO CDouble
+wb_distance_sensor_get_max_value tag =
+ [C.exp| double { wb_distance_sensor_get_max_value($(WbDeviceTag tag)) } |]
+
+wb_distance_sensor_get_min_value :: WbDeviceTag -> IO CDouble
+wb_distance_sensor_get_min_value tag =
+ [C.exp| double { wb_distance_sensor_get_min_value($(WbDeviceTag tag)) } |]
+
+wb_distance_sensor_get_aperture :: WbDeviceTag -> IO CDouble
+wb_distance_sensor_get_aperture tag =
+ [C.exp| double { wb_distance_sensor_get_aperture($(WbDeviceTag tag)) } |]
+
+wb_distance_sensor_get_type :: WbDeviceTag -> IO WbDistanceSensorType
+wb_distance_sensor_get_type tag =
+ [C.exp| WbDistanceSensorType { wb_distance_sensor_get_type($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Driver.hs b/src/Webots/Driver.hs
new file mode 100644
index 0000000..d018383
--- /dev/null
+++ b/src/Webots/Driver.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Driver where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/vehicle/driver.h>"
+
+wbu_driver_init :: IO ()
+wbu_driver_init =
+ [C.exp| void { wbu_driver_init() } |]
+
+wbu_driver_cleanup :: IO ()
+wbu_driver_cleanup =
+ [C.exp| void { wbu_driver_cleanup() } |]
+
+wbu_driver_step :: IO CInt
+wbu_driver_step =
+ [C.exp| int { wbu_driver_step() } |]
+
+wbu_driver_set_steering_angle :: CDouble -> IO ()
+wbu_driver_set_steering_angle steering_angle =
+ [C.exp| void { wbu_driver_set_steering_angle($(double steering_angle)) } |]
+
+wbu_driver_get_steering_angle :: IO CDouble
+wbu_driver_get_steering_angle =
+ [C.exp| double { wbu_driver_get_steering_angle() } |]
+
+wbu_driver_set_cruising_speed :: CDouble -> IO ()
+wbu_driver_set_cruising_speed speed =
+ [C.exp| void { wbu_driver_set_cruising_speed($(double speed)) } |]
+
+wbu_driver_get_target_cruising_speed :: IO CDouble
+wbu_driver_get_target_cruising_speed =
+ [C.exp| double { wbu_driver_get_target_cruising_speed() } |]
+
+wbu_driver_get_current_speed :: IO CDouble
+wbu_driver_get_current_speed =
+ [C.exp| double { wbu_driver_get_current_speed() } |]
+
+wbu_driver_set_throttle :: CDouble -> IO ()
+wbu_driver_set_throttle throttle =
+ [C.exp| void { wbu_driver_set_throttle($(double throttle)) } |]
+
+wbu_driver_get_throttle :: IO CDouble
+wbu_driver_get_throttle =
+ [C.exp| double { wbu_driver_get_throttle() } |]
+
+wbu_driver_set_brake_intensity :: CDouble -> IO ()
+wbu_driver_set_brake_intensity intensity =
+ [C.exp| void { wbu_driver_set_brake_intensity($(double intensity)) } |]
+
+wbu_driver_get_brake_intensity :: IO CDouble
+wbu_driver_get_brake_intensity =
+ [C.exp| double { wbu_driver_get_brake_intensity() } |]
+
+wbu_driver_set_indicator :: WbuDriverIndicatorState -> IO ()
+wbu_driver_set_indicator state =
+ [C.exp| void { wbu_driver_set_indicator($(WbuDriverIndicatorState state)) } |]
+
+wbu_driver_set_hazard_flashers :: CBool -> IO ()
+wbu_driver_set_hazard_flashers state =
+ [C.exp| void { wbu_driver_set_hazard_flashers($(bool state)) } |]
+
+wbu_driver_get_indicator :: IO WbuDriverIndicatorState
+wbu_driver_get_indicator =
+ [C.exp| WbuDriverIndicatorState { wbu_driver_get_indicator() } |]
+
+wbu_driver_get_hazard_flashers :: IO CBool
+wbu_driver_get_hazard_flashers =
+ [C.exp| bool { wbu_driver_get_hazard_flashers() } |]
+
+wbu_driver_set_dipped_beams :: CBool -> IO ()
+wbu_driver_set_dipped_beams state =
+ [C.exp| void { wbu_driver_set_dipped_beams($(bool state)) } |]
+
+wbu_driver_set_antifog_lights :: CBool -> IO ()
+wbu_driver_set_antifog_lights state =
+ [C.exp| void { wbu_driver_set_antifog_lights($(bool state)) } |]
+
+wbu_driver_get_dipped_beams :: IO CBool
+wbu_driver_get_dipped_beams =
+ [C.exp| bool { wbu_driver_get_dipped_beams() } |]
+
+wbu_driver_get_antifog_lights :: IO CBool
+wbu_driver_get_antifog_lights =
+ [C.exp| bool { wbu_driver_get_antifog_lights() } |]
+
+wbu_driver_get_rpm :: IO CDouble
+wbu_driver_get_rpm =
+ [C.exp| double { wbu_driver_get_rpm() } |]
+
+wbu_driver_get_gear :: IO CInt
+wbu_driver_get_gear =
+ [C.exp| int { wbu_driver_get_gear() } |]
+
+wbu_driver_set_gear :: CInt -> IO ()
+wbu_driver_set_gear gear =
+ [C.exp| void { wbu_driver_set_gear($(int gear)) } |]
+
+wbu_driver_get_gear_number :: IO CInt
+wbu_driver_get_gear_number =
+ [C.exp| int { wbu_driver_get_gear_number() } |]
+
+wbu_driver_get_control_mode :: IO WbuDriverControlMode
+wbu_driver_get_control_mode =
+ [C.exp| WbuDriverControlMode { wbu_driver_get_control_mode() } |]
+
+wbu_driver_set_wiper_mode :: WbuDriverWiperMode -> IO ()
+wbu_driver_set_wiper_mode mode =
+ [C.exp| void { wbu_driver_set_wiper_mode($(WbuDriverWiperMode mode)) } |]
+
+wbu_driver_get_wiper_mode :: IO WbuDriverWiperMode
+wbu_driver_get_wiper_mode =
+ [C.exp| WbuDriverWiperMode { wbu_driver_get_wiper_mode() } |]
+
diff --git a/src/Webots/Emitter.hs b/src/Webots/Emitter.hs
new file mode 100644
index 0000000..b8aadbc
--- /dev/null
+++ b/src/Webots/Emitter.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Emitter where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/emitter.h>"
+
+wb_emitter_send :: WbDeviceTag -> Ptr () -> CInt -> IO CInt
+wb_emitter_send tag dat size =
+ [C.exp| int { wb_emitter_send($(WbDeviceTag tag), $(void* dat), $(int size)) } |]
+
+wb_emitter_get_buffer_size :: WbDeviceTag -> IO CInt
+wb_emitter_get_buffer_size tag =
+ [C.exp| int { wb_emitter_get_buffer_size($(WbDeviceTag tag)) } |]
+
+wb_emitter_set_channel :: WbDeviceTag -> CInt -> IO ()
+wb_emitter_set_channel tag channel =
+ [C.exp| void { wb_emitter_set_channel($(WbDeviceTag tag), $(int channel)) } |]
+
+wb_emitter_get_channel :: WbDeviceTag -> IO CInt
+wb_emitter_get_channel tag =
+ [C.exp| int { wb_emitter_get_channel($(WbDeviceTag tag)) } |]
+
+wb_emitter_get_range :: WbDeviceTag -> IO CDouble
+wb_emitter_get_range tag =
+ [C.exp| double { wb_emitter_get_range($(WbDeviceTag tag)) } |]
+
+wb_emitter_set_range :: WbDeviceTag -> CDouble -> IO ()
+wb_emitter_set_range tag range =
+ [C.exp| void { wb_emitter_set_range($(WbDeviceTag tag), $(double range)) } |]
diff --git a/src/Webots/Gps.hs b/src/Webots/Gps.hs
new file mode 100644
index 0000000..5f65327
--- /dev/null
+++ b/src/Webots/Gps.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Gps where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/gps.h>"
+
+wb_gps_enable :: WbDeviceTag -> CInt -> IO ()
+wb_gps_enable tag sampling_period =
+ [C.exp| void { wb_gps_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_gps_disable :: WbDeviceTag -> IO ()
+wb_gps_disable tag =
+ [C.exp| void { wb_gps_disable($(WbDeviceTag tag)) } |]
+
+wb_gps_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_gps_get_sampling_period tag =
+ [C.exp| int { wb_gps_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_gps_get_speed :: WbDeviceTag -> IO CDouble
+wb_gps_get_speed tag =
+ [C.exp| double { wb_gps_get_speed($(WbDeviceTag tag)) } |]
+
+wb_gps_get_values :: WbDeviceTag -> IO (Ptr CDouble)
+wb_gps_get_values tag =
+ [C.exp| const double* { wb_gps_get_values($(WbDeviceTag tag)) } |]
+
+wb_gps_convert_to_degrees_minutes_seconds :: CDouble -> IO String
+wb_gps_convert_to_degrees_minutes_seconds decimal_degrees =
+ peekCString =<< [C.exp| const char* { wb_gps_convert_to_degrees_minutes_seconds($(double decimal_degrees)) } |]
+
+wb_gps_get_coordinate_system :: WbDeviceTag -> IO WbGpsCoordinateSystem
+wb_gps_get_coordinate_system tag =
+ [C.exp| WbGpsCoordinateSystem { wb_gps_get_coordinate_system($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Gyro.hs b/src/Webots/Gyro.hs
new file mode 100644
index 0000000..0f25476
--- /dev/null
+++ b/src/Webots/Gyro.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Gyro where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/gyro.h>"
+
+wb_gyro_enable :: WbDeviceTag -> CInt -> IO ()
+wb_gyro_enable tag sampling_period =
+ [C.exp| void { wb_gyro_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_gyro_disable :: WbDeviceTag -> IO ()
+wb_gyro_disable tag =
+ [C.exp| void { wb_gyro_disable($(WbDeviceTag tag)) } |]
+
+wb_gyro_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_gyro_get_sampling_period tag =
+ [C.exp| int { wb_gyro_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_gyro_get_values :: WbDeviceTag -> IO (Ptr CDouble)
+wb_gyro_get_values tag =
+ [C.exp| const double* { wb_gyro_get_values($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/InertialUnit.hs b/src/Webots/InertialUnit.hs
new file mode 100644
index 0000000..4b97b63
--- /dev/null
+++ b/src/Webots/InertialUnit.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.InertialUnit where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/inertial_unit.h>"
+
+wb_inertial_unit_enable :: WbDeviceTag -> CInt -> IO ()
+wb_inertial_unit_enable tag sampling_period =
+ [C.exp| void { wb_inertial_unit_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_inertial_unit_disable :: WbDeviceTag -> IO ()
+wb_inertial_unit_disable tag =
+ [C.exp| void { wb_inertial_unit_disable($(WbDeviceTag tag)) } |]
+
+wb_inertial_unit_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_inertial_unit_get_sampling_period tag =
+ [C.exp| int { wb_inertial_unit_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_inertial_unit_get_roll_pitch_yaw :: WbDeviceTag -> IO (Ptr CDouble)
+wb_inertial_unit_get_roll_pitch_yaw tag =
+ [C.exp| const double* { wb_inertial_unit_get_roll_pitch_yaw($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Joystick.hs b/src/Webots/Joystick.hs
new file mode 100644
index 0000000..3dc97aa
--- /dev/null
+++ b/src/Webots/Joystick.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Joystick where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/joystick.h>"
+
+wb_joystick_enable :: CInt -> IO ()
+wb_joystick_enable sampling_period =
+ [C.exp| void { wb_joystick_enable($(int sampling_period)) } |]
+
+wb_joystick_disable :: IO ()
+wb_joystick_disable =
+ [C.exp| void { wb_joystick_disable() } |]
+
+wb_joystick_get_sampling_period :: IO CInt
+wb_joystick_get_sampling_period =
+ [C.exp| int { wb_joystick_get_sampling_period() } |]
+
+wb_joystick_is_connected :: IO CBool
+wb_joystick_is_connected =
+ [C.exp| bool { wb_joystick_is_connected() } |]
+
+wb_joystick_get_model :: IO String
+wb_joystick_get_model =
+ peekCString =<< [C.exp| const char* { wb_joystick_get_model() } |]
+
+wb_joystick_get_number_of_axes :: IO CInt
+wb_joystick_get_number_of_axes =
+ [C.exp| int { wb_joystick_get_number_of_axes() } |]
+
+wb_joystick_get_axis_value :: CInt -> IO CInt
+wb_joystick_get_axis_value axis =
+ [C.exp| int { wb_joystick_get_axis_value($(int axis)) } |]
+
+wb_joystick_get_number_of_povs :: IO CInt
+wb_joystick_get_number_of_povs =
+ [C.exp| int { wb_joystick_get_number_of_povs() } |]
+
+wb_joystick_get_pov_value :: CInt -> IO CInt
+wb_joystick_get_pov_value pov =
+ [C.exp| int { wb_joystick_get_pov_value($(int pov)) } |]
+
+wb_joystick_get_pressed_button :: IO CInt
+wb_joystick_get_pressed_button =
+ [C.exp| int { wb_joystick_get_pressed_button() } |]
+
+wb_joystick_set_constant_force :: CInt -> IO ()
+wb_joystick_set_constant_force level =
+ [C.exp| void { wb_joystick_set_constant_force($(int level)) } |]
+
+wb_joystick_set_constant_force_duration :: CDouble -> IO ()
+wb_joystick_set_constant_force_duration duration =
+ [C.exp| void { wb_joystick_set_constant_force_duration($(double duration)) } |]
+
+wb_joystick_set_auto_centering_gain :: CDouble -> IO ()
+wb_joystick_set_auto_centering_gain gain =
+ [C.exp| void { wb_joystick_set_auto_centering_gain($(double gain)) } |]
+
+wb_joystick_set_resistance_gain :: CDouble -> IO ()
+wb_joystick_set_resistance_gain gain =
+ [C.exp| void { wb_joystick_set_resistance_gain($(double gain)) } |]
+
+wb_joystick_set_force_axis :: CInt -> IO ()
+wb_joystick_set_force_axis axis =
+ [C.exp| void { wb_joystick_set_force_axis($(int axis)) } |]
diff --git a/src/Webots/Keyboard.hs b/src/Webots/Keyboard.hs
new file mode 100644
index 0000000..e53857d
--- /dev/null
+++ b/src/Webots/Keyboard.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Keyboard where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/keyboard.h>"
+
+wb_keyboard_enable :: CInt -> IO ()
+wb_keyboard_enable sampling_period =
+ [C.exp| void { wb_keyboard_enable($(int sampling_period)) } |]
+
+wb_keyboard_disable :: IO ()
+wb_keyboard_disable =
+ [C.exp| void { wb_keyboard_disable() } |]
+
+wb_keyboard_get_sampling_period :: IO CInt
+wb_keyboard_get_sampling_period =
+ [C.exp| int { wb_keyboard_get_sampling_period() } |]
+
+wb_keyboard_get_key :: IO CInt
+wb_keyboard_get_key =
+ [C.exp| int { wb_keyboard_get_key() } |]
diff --git a/src/Webots/Led.hs b/src/Webots/Led.hs
new file mode 100644
index 0000000..d166193
--- /dev/null
+++ b/src/Webots/Led.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Led where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/led.h>"
+
+wb_led_set :: WbDeviceTag -> CInt -> IO ()
+wb_led_set tag value =
+ [C.exp| void { wb_led_set($(WbDeviceTag tag), $(int value)) } |]
+
+wb_led_get :: WbDeviceTag -> IO CInt
+wb_led_get tag =
+ [C.exp| int { wb_led_get($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Lidar.hs b/src/Webots/Lidar.hs
new file mode 100644
index 0000000..5884429
--- /dev/null
+++ b/src/Webots/Lidar.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Lidar where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/lidar.h>"
+
+wb_lidar_enable :: WbDeviceTag -> CInt -> IO ()
+wb_lidar_enable tag sampling_period =
+ [C.exp| void { wb_lidar_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_lidar_enable_point_cloud :: WbDeviceTag -> IO ()
+wb_lidar_enable_point_cloud tag =
+ [C.exp| void { wb_lidar_enable_point_cloud($(WbDeviceTag tag)) } |]
+
+wb_lidar_disable :: WbDeviceTag -> IO ()
+wb_lidar_disable tag =
+ [C.exp| void { wb_lidar_disable($(WbDeviceTag tag)) } |]
+
+wb_lidar_disable_point_cloud :: WbDeviceTag -> IO ()
+wb_lidar_disable_point_cloud tag =
+ [C.exp| void { wb_lidar_disable_point_cloud($(WbDeviceTag tag)) } |]
+
+wb_lidar_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_lidar_get_sampling_period tag =
+ [C.exp| int { wb_lidar_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_lidar_is_point_cloud_enabled :: WbDeviceTag -> IO CBool
+wb_lidar_is_point_cloud_enabled tag =
+ [C.exp| bool { wb_lidar_is_point_cloud_enabled($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/LightSensor.hs b/src/Webots/LightSensor.hs
new file mode 100644
index 0000000..669509a
--- /dev/null
+++ b/src/Webots/LightSensor.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.LightSensor where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/light_sensor.h>"
+
+wb_light_sensor_enable :: WbDeviceTag -> CInt -> IO ()
+wb_light_sensor_enable tag sampling_period =
+ [C.exp| void { wb_light_sensor_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_light_sensor_disable :: WbDeviceTag -> IO ()
+wb_light_sensor_disable tag =
+ [C.exp| void { wb_light_sensor_disable($(WbDeviceTag tag)) } |]
+
+wb_light_sensor_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_light_sensor_get_sampling_period tag =
+ [C.exp| int { wb_light_sensor_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_light_sensor_get_value :: WbDeviceTag -> IO CDouble
+wb_light_sensor_get_value tag =
+ [C.exp| double { wb_light_sensor_get_value($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Microphone.hs b/src/Webots/Microphone.hs
new file mode 100644
index 0000000..0408e52
--- /dev/null
+++ b/src/Webots/Microphone.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Microphone where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/microphone.h>"
+
+wb_microphone_enable :: WbDeviceTag -> CInt -> IO ()
+wb_microphone_enable tag sampling_period =
+ [C.exp| void { wb_microphone_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_microphone_disable :: WbDeviceTag -> IO ()
+wb_microphone_disable tag =
+ [C.exp| void { wb_microphone_disable($(WbDeviceTag tag)) } |]
+
+wb_microphone_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_microphone_get_sampling_period tag =
+ [C.exp| int { wb_microphone_get_sampling_period($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Motor.hs b/src/Webots/Motor.hs
new file mode 100644
index 0000000..865ebb2
--- /dev/null
+++ b/src/Webots/Motor.hs
@@ -0,0 +1,152 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Motor where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/motor.h>"
+
+wb_motor_set_position :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_position tag position =
+ [C.exp| void { wb_motor_set_position($(WbDeviceTag tag), $(double position)) } |]
+
+wb_motor_set_acceleration :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_acceleration tag acceleration =
+ [C.exp| void { wb_motor_set_acceleration($(WbDeviceTag tag), $(double acceleration)) } |]
+
+wb_motor_set_velocity :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_velocity tag velocity =
+ [C.exp| void { wb_motor_set_velocity($(WbDeviceTag tag), $(double velocity)) } |]
+
+wb_motor_set_force :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_force tag force =
+ [C.exp| void { wb_motor_set_force($(WbDeviceTag tag), $(double force)) } |]
+
+wb_motor_set_torque :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_torque tag torque =
+ [C.exp| void { wb_motor_set_torque($(WbDeviceTag tag), $(double torque)) } |]
+
+wb_motor_set_available_force :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_available_force tag force =
+ [C.exp| void { wb_motor_set_available_force($(WbDeviceTag tag), $(double force)) } |]
+
+wb_motor_set_available_torque :: WbDeviceTag -> CDouble -> IO ()
+wb_motor_set_available_torque tag torque =
+ [C.exp| void { wb_motor_set_available_torque($(WbDeviceTag tag), $(double torque)) } |]
+
+wb_motor_set_control_pid :: WbDeviceTag -> CDouble -> CDouble -> CDouble -> IO ()
+wb_motor_set_control_pid tag p i d =
+ [C.exp| void { wb_motor_set_control_pid($(WbDeviceTag tag), $(double p), $(double i), $(double d)) } |]
+
+wb_motor_enable_force_feedback :: WbDeviceTag -> CInt -> IO ()
+wb_motor_enable_force_feedback tag sampling_period =
+ [C.exp| void { wb_motor_enable_force_feedback($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_motor_disable_force_feedback :: WbDeviceTag -> IO ()
+wb_motor_disable_force_feedback tag =
+ [C.exp| void { wb_motor_disable_force_feedback($(WbDeviceTag tag)) } |]
+
+wb_motor_get_force_feedback_sampling_period :: WbDeviceTag -> IO CInt
+wb_motor_get_force_feedback_sampling_period tag =
+ [C.exp| int { wb_motor_get_force_feedback_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_motor_get_force_feedback :: WbDeviceTag -> IO CDouble
+wb_motor_get_force_feedback tag =
+ [C.exp| double { wb_motor_get_force_feedback($(WbDeviceTag tag)) } |]
+
+wb_motor_enable_torque_feedback :: WbDeviceTag -> CInt -> IO ()
+wb_motor_enable_torque_feedback tag sampling_period =
+ [C.exp| void { wb_motor_enable_torque_feedback($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_motor_disable_torque_feedback :: WbDeviceTag -> IO ()
+wb_motor_disable_torque_feedback tag =
+ [C.exp| void { wb_motor_disable_torque_feedback($(WbDeviceTag tag)) } |]
+
+wb_motor_get_torque_feedback_sampling_period :: WbDeviceTag -> IO CInt
+wb_motor_get_torque_feedback_sampling_period tag =
+ [C.exp| int { wb_motor_get_torque_feedback_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_motor_get_torque_feedback :: WbDeviceTag -> IO CDouble
+wb_motor_get_torque_feedback tag =
+ [C.exp| double { wb_motor_get_torque_feedback($(WbDeviceTag tag)) } |]
+
+wb_motor_get_type :: WbDeviceTag -> IO WbJointType
+wb_motor_get_type tag =
+ [C.exp| WbJointType { wb_motor_get_type($(WbDeviceTag tag)) } |]
+
+wb_motor_get_target_position :: WbDeviceTag -> IO CDouble
+wb_motor_get_target_position tag =
+ [C.exp| double { wb_motor_get_target_position($(WbDeviceTag tag)) } |]
+
+wb_motor_get_min_position :: WbDeviceTag -> IO CDouble
+wb_motor_get_min_position tag =
+ [C.exp| double { wb_motor_get_min_position($(WbDeviceTag tag)) } |]
+
+wb_motor_get_max_position :: WbDeviceTag -> IO CDouble
+wb_motor_get_max_position tag =
+ [C.exp| double { wb_motor_get_max_position($(WbDeviceTag tag)) } |]
+
+wb_motor_get_velocity :: WbDeviceTag -> IO CDouble
+wb_motor_get_velocity tag =
+ [C.exp| double { wb_motor_get_velocity($(WbDeviceTag tag)) } |]
+
+wb_motor_get_max_velocity :: WbDeviceTag -> IO CDouble
+wb_motor_get_max_velocity tag =
+ [C.exp| double { wb_motor_get_max_velocity($(WbDeviceTag tag)) } |]
+
+wb_motor_get_acceleration :: WbDeviceTag -> IO CDouble
+wb_motor_get_acceleration tag =
+ [C.exp| double { wb_motor_get_acceleration($(WbDeviceTag tag)) } |]
+
+wb_motor_get_available_force :: WbDeviceTag -> IO CDouble
+wb_motor_get_available_force tag =
+ [C.exp| double { wb_motor_get_available_force($(WbDeviceTag tag)) } |]
+
+wb_motor_get_max_force :: WbDeviceTag -> IO CDouble
+wb_motor_get_max_force tag =
+ [C.exp| double { wb_motor_get_max_force($(WbDeviceTag tag)) } |]
+
+wb_motor_get_available_torque :: WbDeviceTag -> IO CDouble
+wb_motor_get_available_torque tag =
+ [C.exp| double { wb_motor_get_available_torque($(WbDeviceTag tag)) } |]
+
+wb_motor_get_max_torque :: WbDeviceTag -> IO CDouble
+wb_motor_get_max_torque tag =
+ [C.exp| double { wb_motor_get_max_torque($(WbDeviceTag tag)) } |]
+
+wb_motor_get_brake :: WbDeviceTag -> IO WbDeviceTag
+wb_motor_get_brake tag =
+ [C.exp| WbDeviceTag { wb_motor_get_brake($(WbDeviceTag tag)) } |]
+
+wb_motor_get_position_sensor :: WbDeviceTag -> IO WbDeviceTag
+wb_motor_get_position_sensor tag =
+ [C.exp| WbDeviceTag { wb_motor_get_position_sensor($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Mouse.hs b/src/Webots/Mouse.hs
new file mode 100644
index 0000000..280f177
--- /dev/null
+++ b/src/Webots/Mouse.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Mouse where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/mouse.h>"
+
+wb_mouse_enable :: CInt -> IO ()
+wb_mouse_enable sampling_period =
+ [C.exp| void { wb_mouse_enable($(int sampling_period)) } |]
+
+wb_mouse_disable :: IO ()
+wb_mouse_disable =
+ [C.exp| void { wb_mouse_disable() } |]
+
+wb_mouse_get_sampling_period :: IO CInt
+wb_mouse_get_sampling_period =
+ [C.exp| int { wb_mouse_get_sampling_period() } |]
+
+wb_mouse_enable_3d_position :: IO ()
+wb_mouse_enable_3d_position =
+ [C.exp| void { wb_mouse_enable_3d_position() } |]
+
+wb_mouse_disable_3d_position :: IO ()
+wb_mouse_disable_3d_position =
+ [C.exp| void { wb_mouse_disable_3d_position() } |]
+
+wb_mouse_is_3d_position_enabled :: IO CBool
+wb_mouse_is_3d_position_enabled =
+ [C.exp| bool { wb_mouse_is_3d_position_enabled() } |]
+
+wb_mouse_get_state :: IO WbMouseState
+wb_mouse_get_state = do
+ mouse_left <- [C.exp| bool { wb_mouse_get_state().left } |]
+ mouse_middle <- [C.exp| bool { wb_mouse_get_state().middle } |]
+ mouse_right <- [C.exp| bool { wb_mouse_get_state().right } |]
+ mouse_u <- [C.exp| double { wb_mouse_get_state().u } |]
+ mouse_v <- [C.exp| double { wb_mouse_get_state().v } |]
+ mouse_x <- [C.exp| double { wb_mouse_get_state().x } |]
+ mouse_y <- [C.exp| double { wb_mouse_get_state().y } |]
+ mouse_z <- [C.exp| double { wb_mouse_get_state().z } |]
+ return $ WbMouseState {..}
diff --git a/src/Webots/Nodes.hs b/src/Webots/Nodes.hs
new file mode 100644
index 0000000..92d0276
--- /dev/null
+++ b/src/Webots/Nodes.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Nodes where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/nodes.h>"
+
+wb_node_get_name :: WbNodeType -> IO String
+wb_node_get_name t =
+ peekCString =<< [C.exp| const char* { wb_node_get_name($(WbNodeType t)) } |]
diff --git a/src/Webots/Pen.hs b/src/Webots/Pen.hs
new file mode 100644
index 0000000..ab3a6a0
--- /dev/null
+++ b/src/Webots/Pen.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Pen where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/pen.h>"
+
+wb_pen_write :: WbDeviceTag -> CBool -> IO ()
+wb_pen_write tag write =
+ [C.exp| void { wb_pen_write($(WbDeviceTag tag), $(bool write)) } |]
+
+wb_pen_set_ink_color :: WbDeviceTag -> CInt -> CDouble -> IO ()
+wb_pen_set_ink_color tag color density =
+ [C.exp| void { wb_pen_set_ink_color($(WbDeviceTag tag), $(int color), $(double density)) } |]
diff --git a/src/Webots/PositionSensor.hs b/src/Webots/PositionSensor.hs
new file mode 100644
index 0000000..c08cf30
--- /dev/null
+++ b/src/Webots/PositionSensor.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.PositionSensor where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/position_sensor.h>"
+
+wb_position_sensor_enable :: WbDeviceTag -> CInt -> IO ()
+wb_position_sensor_enable tag sampling_period =
+ [C.exp| void { wb_position_sensor_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_position_sensor_disable :: WbDeviceTag -> IO ()
+wb_position_sensor_disable tag =
+ [C.exp| void { wb_position_sensor_disable($(WbDeviceTag tag)) } |]
+
+wb_position_sensor_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_position_sensor_get_sampling_period tag =
+ [C.exp| int { wb_position_sensor_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_position_sensor_get_value :: WbDeviceTag -> IO CDouble
+wb_position_sensor_get_value tag =
+ [C.exp| double { wb_position_sensor_get_value($(WbDeviceTag tag)) } |]
+
+wb_position_sensor_get_type :: WbDeviceTag -> IO WbJointType
+wb_position_sensor_get_type tag =
+ [C.exp| WbJointType { wb_position_sensor_get_type($(WbDeviceTag tag)) } |]
+
+wb_position_sensor_get_motor :: WbDeviceTag -> IO WbDeviceTag
+wb_position_sensor_get_motor tag =
+ [C.exp| WbDeviceTag { wb_position_sensor_get_motor($(WbDeviceTag tag)) } |]
+
+wb_position_sensor_get_brake :: WbDeviceTag -> IO WbDeviceTag
+wb_position_sensor_get_brake tag =
+ [C.exp| WbDeviceTag { wb_position_sensor_get_brake($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Radar.hs b/src/Webots/Radar.hs
new file mode 100644
index 0000000..aac20b8
--- /dev/null
+++ b/src/Webots/Radar.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Radar where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/radar.h>"
+
+wb_radar_enable :: WbDeviceTag -> CInt -> IO ()
+wb_radar_enable tag sampling_period =
+ [C.exp| void { wb_radar_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_radar_disable :: WbDeviceTag -> IO ()
+wb_radar_disable tag =
+ [C.exp| void { wb_radar_disable($(WbDeviceTag tag)) } |]
+
+wb_radar_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_radar_get_sampling_period tag =
+ [C.exp| int { wb_radar_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_radar_get_number_of_targets :: WbDeviceTag -> IO CInt
+wb_radar_get_number_of_targets tag =
+ [C.exp| int { wb_radar_get_number_of_targets($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Radio.hs b/src/Webots/Radio.hs
new file mode 100644
index 0000000..585f082
--- /dev/null
+++ b/src/Webots/Radio.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Radio where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/radio.h>"
+
+wb_radio_message_new :: CInt -> String -> String -> IO WbRadioMessage
+wb_radio_message_new length body destination =
+ withCString body $ \body' -> withCString destination $ \destination' -> [C.exp| WbRadioMessage { wb_radio_message_new($(int length), $(const char* body'), $(const char* destination')) } |]
+
+wb_radio_message_delete :: WbRadioMessage -> IO ()
+wb_radio_message_delete msg =
+ [C.exp| void { wb_radio_message_delete($(WbRadioMessage msg)) } |]
+
+wb_radio_message_get_destination :: WbRadioMessage -> IO String
+wb_radio_message_get_destination msg =
+ peekCString =<< [C.exp| const char* { wb_radio_message_get_destination($(WbRadioMessage msg)) } |]
+
+wb_radio_message_get_length :: WbRadioMessage -> IO CInt
+wb_radio_message_get_length msg =
+ [C.exp| int { wb_radio_message_get_length($(WbRadioMessage msg)) } |]
+
+wb_radio_message_get_body :: WbRadioMessage -> IO String
+wb_radio_message_get_body msg =
+ peekCString =<< [C.exp| const char* { wb_radio_message_get_body($(WbRadioMessage msg)) } |]
+
+wb_radio_enable :: WbDeviceTag -> CInt -> IO ()
+wb_radio_enable tag sampling_period =
+ [C.exp| void { wb_radio_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_radio_disable :: WbDeviceTag -> IO ()
+wb_radio_disable tag =
+ [C.exp| void { wb_radio_disable($(WbDeviceTag tag)) } |]
+
+wb_radio_set_address :: WbDeviceTag -> String -> IO ()
+wb_radio_set_address tag address =
+ withCString address $ \address' -> [C.exp| void { wb_radio_set_address($(WbDeviceTag tag), $(const char* address')) } |]
+
+wb_radio_get_address :: WbDeviceTag -> IO String
+wb_radio_get_address tag =
+ peekCString =<< [C.exp| const char* { wb_radio_get_address($(WbDeviceTag tag)) } |]
+
+wb_radio_set_frequency :: WbDeviceTag -> CDouble -> IO ()
+wb_radio_set_frequency tag hz =
+ [C.exp| void { wb_radio_set_frequency($(WbDeviceTag tag), $(double hz)) } |]
+
+wb_radio_get_frequency :: WbDeviceTag -> IO CDouble
+wb_radio_get_frequency tag =
+ [C.exp| double { wb_radio_get_frequency($(WbDeviceTag tag)) } |]
+
+wb_radio_set_channel :: WbDeviceTag -> CInt -> IO ()
+wb_radio_set_channel tag channel =
+ [C.exp| void { wb_radio_set_channel($(WbDeviceTag tag), $(int channel)) } |]
+
+wb_radio_get_channel :: WbDeviceTag -> IO CInt
+wb_radio_get_channel tag =
+ [C.exp| int { wb_radio_get_channel($(WbDeviceTag tag)) } |]
+
+wb_radio_set_bitrate :: WbDeviceTag -> CInt -> IO ()
+wb_radio_set_bitrate tag bits_per_second =
+ [C.exp| void { wb_radio_set_bitrate($(WbDeviceTag tag), $(int bits_per_second)) } |]
+
+wb_radio_get_bitrate :: WbDeviceTag -> IO CInt
+wb_radio_get_bitrate tag =
+ [C.exp| int { wb_radio_get_bitrate($(WbDeviceTag tag)) } |]
+
+wb_radio_set_rx_sensitivity :: WbDeviceTag -> CDouble -> IO ()
+wb_radio_set_rx_sensitivity tag dBm =
+ [C.exp| void { wb_radio_set_rx_sensitivity($(WbDeviceTag tag), $(double dBm)) } |]
+
+wb_radio_get_rx_sensitivity :: WbDeviceTag -> IO CDouble
+wb_radio_get_rx_sensitivity tag =
+ [C.exp| double { wb_radio_get_rx_sensitivity($(WbDeviceTag tag)) } |]
+
+wb_radio_set_tx_power :: WbDeviceTag -> CDouble -> IO ()
+wb_radio_set_tx_power tag dBm =
+ [C.exp| void { wb_radio_set_tx_power($(WbDeviceTag tag), $(double dBm)) } |]
+
+wb_radio_get_tx_power :: WbDeviceTag -> IO CDouble
+wb_radio_get_tx_power tag =
+ [C.exp| double { wb_radio_get_tx_power($(WbDeviceTag tag)) } |]
+
+wb_radio_set_callback :: WbDeviceTag -> (WbRadioEvent -> IO ()) -> IO ()
+wb_radio_set_callback tag callback = do
+ callback' <- $(C.mkFunPtr [t| WbRadioEvent -> IO () |]) callback
+ [C.exp| void { wb_radio_set_callback($(WbDeviceTag tag), $(void (*callback')(WbRadioEvent))) } |]
+
+wb_radio_event_get_radio :: WbRadioEvent -> IO WbDeviceTag
+wb_radio_event_get_radio ev =
+ [C.exp| WbDeviceTag { wb_radio_event_get_radio($(WbRadioEvent ev)) } |]
+
+wb_radio_event_get_data :: WbRadioEvent -> IO String
+wb_radio_event_get_data ev =
+ peekCString =<< [C.exp| char* { wb_radio_event_get_data($(WbRadioEvent ev)) } |]
+
+wb_radio_event_get_data_size :: WbRadioEvent -> IO CInt
+wb_radio_event_get_data_size ev =
+ [C.exp| int { wb_radio_event_get_data_size($(WbRadioEvent ev)) } |]
+
+wb_radio_event_get_emitter :: WbRadioEvent -> IO String
+wb_radio_event_get_emitter ev =
+ peekCString =<< [C.exp| char* { wb_radio_event_get_emitter($(WbRadioEvent ev)) } |]
+
+wb_radio_event_get_rssi :: WbRadioEvent -> IO CDouble
+wb_radio_event_get_rssi ev =
+ [C.exp| double { wb_radio_event_get_rssi($(WbRadioEvent ev)) } |]
+
+wb_radio_send :: WbDeviceTag -> WbRadioMessage -> CDouble -> IO ()
+wb_radio_send tag msg delay =
+ [C.exp| void { wb_radio_send($(WbDeviceTag tag), $(WbRadioMessage msg), $(double delay)) } |]
diff --git a/src/Webots/RangeFinder.hs b/src/Webots/RangeFinder.hs
new file mode 100644
index 0000000..c1cf2de
--- /dev/null
+++ b/src/Webots/RangeFinder.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.RangeFinder where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/range_finder.h>"
+
+wb_range_finder_enable :: WbDeviceTag -> CInt -> IO ()
+wb_range_finder_enable tag sampling_period =
+ [C.exp| void { wb_range_finder_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_range_finder_disable :: WbDeviceTag -> IO ()
+wb_range_finder_disable tag =
+ [C.exp| void { wb_range_finder_disable($(WbDeviceTag tag)) } |]
+
+wb_range_finder_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_range_finder_get_sampling_period tag =
+ [C.exp| int { wb_range_finder_get_sampling_period($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Receiver.hs b/src/Webots/Receiver.hs
new file mode 100644
index 0000000..2c13c78
--- /dev/null
+++ b/src/Webots/Receiver.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Receiver where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/receiver.h>"
+
+wb_receiver_enable :: WbDeviceTag -> CInt -> IO ()
+wb_receiver_enable tag sampling_period =
+ [C.exp| void { wb_receiver_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_receiver_disable :: WbDeviceTag -> IO ()
+wb_receiver_disable tag =
+ [C.exp| void { wb_receiver_disable($(WbDeviceTag tag)) } |]
+
+wb_receiver_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_receiver_get_sampling_period tag =
+ [C.exp| int { wb_receiver_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_receiver_set_channel :: WbDeviceTag -> CInt -> IO ()
+wb_receiver_set_channel tag channel =
+ [C.exp| void { wb_receiver_set_channel($(WbDeviceTag tag), $(int channel)) } |]
+
+wb_receiver_get_channel :: WbDeviceTag -> IO CInt
+wb_receiver_get_channel tag =
+ [C.exp| int { wb_receiver_get_channel($(WbDeviceTag tag)) } |]
+
+wb_receiver_get_queue_length :: WbDeviceTag -> IO CInt
+wb_receiver_get_queue_length tag =
+ [C.exp| int { wb_receiver_get_queue_length($(WbDeviceTag tag)) } |]
+
+wb_receiver_next_packet :: WbDeviceTag -> IO ()
+wb_receiver_next_packet tag =
+ [C.exp| void { wb_receiver_next_packet($(WbDeviceTag tag)) } |]
+
+wb_receiver_get_data_size :: WbDeviceTag -> IO CInt
+wb_receiver_get_data_size tag =
+ [C.exp| int { wb_receiver_get_data_size($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/RemoteControl.hs b/src/Webots/RemoteControl.hs
new file mode 100644
index 0000000..d96128a
--- /dev/null
+++ b/src/Webots/RemoteControl.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.RemoteControl where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/remote_control.h>"
+
+wb_remote_control_custom_function :: Ptr CChar -> IO ()
+wb_remote_control_custom_function xxx =
+ [C.exp| void { wb_remote_control_custom_function($(char* xxx)) } |]
+
+wbr_robot_battery_sensor_set_value :: CDouble -> IO ()
+wbr_robot_battery_sensor_set_value value =
+ [C.exp| void { wbr_robot_battery_sensor_set_value($(double value)) } |]
+
+wbr_differential_wheels_set_encoders :: CDouble -> CDouble -> IO ()
+wbr_differential_wheels_set_encoders left right =
+ [C.exp| void { wbr_differential_wheels_set_encoders($(double left), $(double right)) } |]
+
+wbr_accelerometer_set_values :: WbDeviceTag -> Ptr CDouble -> IO ()
+wbr_accelerometer_set_values tag values =
+ [C.exp| void { wbr_accelerometer_set_values($(WbDeviceTag tag), $(const double* values)) } |]
+
+wbr_camera_recognition_set_object :: WbDeviceTag -> Ptr WbCameraRecognitionObject -> CInt -> IO ()
+wbr_camera_recognition_set_object tag objects object_number =
+ [C.exp| void { wbr_camera_recognition_set_object($(WbDeviceTag tag), $(const WbCameraRecognitionObject* objects), $(int object_number)) } |]
+
+wbr_compass_set_values :: WbDeviceTag -> Ptr CDouble -> IO ()
+wbr_compass_set_values tag values =
+ [C.exp| void { wbr_compass_set_values($(WbDeviceTag tag), $(const double* values)) } |]
+
+wbr_distance_sensor_set_value :: WbDeviceTag -> CDouble -> IO ()
+wbr_distance_sensor_set_value tag value =
+ [C.exp| void { wbr_distance_sensor_set_value($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_gps_set_values :: WbDeviceTag -> Ptr CDouble -> IO ()
+wbr_gps_set_values tag values =
+ [C.exp| void { wbr_gps_set_values($(WbDeviceTag tag), $(const double* values)) } |]
+
+wbr_gps_set_speed :: WbDeviceTag -> CDouble -> IO ()
+wbr_gps_set_speed tag speed =
+ [C.exp| void { wbr_gps_set_speed($(WbDeviceTag tag), $(double speed)) } |]
+
+wbr_gyro_set_values :: WbDeviceTag -> Ptr CDouble -> IO ()
+wbr_gyro_set_values tag values =
+ [C.exp| void { wbr_gyro_set_values($(WbDeviceTag tag), $(const double* values)) } |]
+
+wbr_inertial_unit_set_value :: WbDeviceTag -> CDouble -> IO ()
+wbr_inertial_unit_set_value tag value =
+ [C.exp| void { wbr_inertial_unit_set_value($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_light_sensor_set_value :: WbDeviceTag -> CDouble -> IO ()
+wbr_light_sensor_set_value tag value =
+ [C.exp| void { wbr_light_sensor_set_value($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_microphone_set_buffer :: WbDeviceTag -> Ptr CChar -> CInt -> IO ()
+wbr_microphone_set_buffer tag buffer size =
+ [C.exp| void { wbr_microphone_set_buffer($(WbDeviceTag tag), $(const char* buffer), $(int size)) } |]
+
+wbr_motor_set_position_feedback :: WbDeviceTag -> CDouble -> IO ()
+wbr_motor_set_position_feedback tag value =
+ [C.exp| void { wbr_motor_set_position_feedback($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_motor_set_force_feedback :: WbDeviceTag -> CDouble -> IO ()
+wbr_motor_set_force_feedback tag value =
+ [C.exp| void { wbr_motor_set_force_feedback($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_motor_set_torque_feedback :: WbDeviceTag -> CDouble -> IO ()
+wbr_motor_set_torque_feedback tag value =
+ [C.exp| void { wbr_motor_set_torque_feedback($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_position_sensor_set_value :: WbDeviceTag -> CDouble -> IO ()
+wbr_position_sensor_set_value tag value =
+ [C.exp| void { wbr_position_sensor_set_value($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_radar_set_targets :: WbDeviceTag -> Ptr WbRadarTarget -> CInt -> IO ()
+wbr_radar_set_targets tag targets target_number =
+ [C.exp| void { wbr_radar_set_targets($(WbDeviceTag tag), $(const WbRadarTarget* targets), $(int target_number)) } |]
+
+wbr_touch_sensor_set_value :: WbDeviceTag -> CDouble -> IO ()
+wbr_touch_sensor_set_value tag value =
+ [C.exp| void { wbr_touch_sensor_set_value($(WbDeviceTag tag), $(double value)) } |]
+
+wbr_touch_sensor_set_values :: WbDeviceTag -> Ptr CDouble -> IO ()
+wbr_touch_sensor_set_values tag values =
+ [C.exp| void { wbr_touch_sensor_set_values($(WbDeviceTag tag), $(const double* values)) } |]
+
+wbr_display_save_image :: WbDeviceTag -> CInt -> CInt -> CInt -> Ptr CChar -> IO ()
+wbr_display_save_image tag id width height image =
+ [C.exp| void { wbr_display_save_image($(WbDeviceTag tag), $(int id), $(int width), $(int height), $(char* image)) } |]
+
+wbr_camera_set_image :: WbDeviceTag -> Ptr CChar -> IO ()
+wbr_camera_set_image tag image =
+ [C.exp| void { wbr_camera_set_image($(WbDeviceTag tag), $(char* image)) } |]
diff --git a/src/Webots/Robot.hs b/src/Webots/Robot.hs
new file mode 100644
index 0000000..4104347
--- /dev/null
+++ b/src/Webots/Robot.hs
@@ -0,0 +1,176 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Robot where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/robot.h>"
+C.include "<webots/robot_window.h>"
+C.include "<webots/robot_wwi.h>"
+C.include "<webots/supervisor.h>"
+
+wb_robot_init :: IO CInt
+wb_robot_init =
+ [C.exp| int { wb_robot_init() } |]
+
+wb_robot_step :: CInt -> IO CInt
+wb_robot_step duration =
+ [C.exp| int { wb_robot_step($(int duration)) } |]
+
+wb_robot_wait_for_user_input_event :: WbUserInputEvent -> CInt -> IO WbUserInputEvent
+wb_robot_wait_for_user_input_event event_type timeout =
+ [C.exp| WbUserInputEvent { wb_robot_wait_for_user_input_event($(WbUserInputEvent event_type), $(int timeout)) } |]
+
+wb_robot_cleanup :: IO ()
+wb_robot_cleanup =
+ [C.exp| void { wb_robot_cleanup() } |]
+
+wb_robot_get_time :: IO CDouble
+wb_robot_get_time =
+ [C.exp| double { wb_robot_get_time() } |]
+
+wb_robot_get_name :: IO String
+wb_robot_get_name =
+ peekCString =<< [C.exp| const char* { wb_robot_get_name() } |]
+
+wb_robot_get_model :: IO String
+wb_robot_get_model =
+ peekCString =<< [C.exp| const char* { wb_robot_get_model() } |]
+
+wb_robot_get_custom_data :: IO String
+wb_robot_get_custom_data =
+ peekCString =<< [C.exp| const char* { wb_robot_get_custom_data() } |]
+
+wb_robot_set_custom_data :: String -> IO ()
+wb_robot_set_custom_data dat =
+ withCString dat $ \dat' ->
+ [C.exp| void { wb_robot_set_custom_data($(const char* dat')) } |]
+
+wb_robot_get_mode :: IO WbRobotMode
+wb_robot_get_mode =
+ [C.exp| WbRobotMode { wb_robot_get_mode() } |]
+
+wb_robot_set_mode :: WbRobotMode -> Ptr CChar -> IO ()
+wb_robot_set_mode mode args =
+ [C.exp| void { wb_robot_set_mode($(WbRobotMode mode), $(char* args)) } |]
+
+wb_robot_get_synchronization :: IO CBool
+wb_robot_get_synchronization =
+ [C.exp| bool { wb_robot_get_synchronization() } |]
+
+wb_robot_get_supervisor :: IO CBool
+wb_robot_get_supervisor =
+ [C.exp| bool { wb_robot_get_supervisor() } |]
+
+wb_robot_get_project_path :: IO String
+wb_robot_get_project_path =
+ peekCString =<< [C.exp| const char* { wb_robot_get_project_path() } |]
+
+wb_robot_get_world_path :: IO String
+wb_robot_get_world_path =
+ peekCString =<< [C.exp| const char* { wb_robot_get_world_path() } |]
+
+wb_robot_get_basic_time_step :: IO CDouble
+wb_robot_get_basic_time_step =
+ [C.exp| double { wb_robot_get_basic_time_step() } |]
+
+wb_robot_get_device :: String -> IO WbDeviceTag
+wb_robot_get_device name =
+ withCString name $ \name' ->
+ [C.exp| WbDeviceTag { wb_robot_get_device($(const char* name')) } |]
+
+wb_robot_get_controller_name :: IO String
+wb_robot_get_controller_name =
+ peekCString =<< [C.exp| const char* { wb_robot_get_controller_name() } |]
+
+wb_robot_get_controller_arguments :: IO String
+wb_robot_get_controller_arguments =
+ peekCString =<< [C.exp| const char* { wb_robot_get_controller_arguments() } |]
+
+wb_robot_get_number_of_devices :: IO CInt
+wb_robot_get_number_of_devices =
+ [C.exp| int { wb_robot_get_number_of_devices() } |]
+
+wb_robot_get_device_by_index :: CInt -> IO WbDeviceTag
+wb_robot_get_device_by_index index =
+ [C.exp| WbDeviceTag { wb_robot_get_device_by_index($(int index)) } |]
+
+wb_robot_get_type :: IO WbNodeType
+wb_robot_get_type =
+ [C.exp| WbNodeType { wb_robot_get_type() } |]
+
+wb_robot_battery_sensor_enable :: CInt -> IO ()
+wb_robot_battery_sensor_enable sampling_period =
+ [C.exp| void { wb_robot_battery_sensor_enable($(int sampling_period)) } |]
+
+wb_robot_battery_sensor_disable :: IO ()
+wb_robot_battery_sensor_disable =
+ [C.exp| void { wb_robot_battery_sensor_disable() } |]
+
+wb_robot_battery_sensor_get_sampling_period :: IO CInt
+wb_robot_battery_sensor_get_sampling_period =
+ [C.exp| int { wb_robot_battery_sensor_get_sampling_period() } |]
+
+wb_robot_battery_sensor_get_value :: IO CDouble
+wb_robot_battery_sensor_get_value =
+ [C.exp| double { wb_robot_battery_sensor_get_value() } |]
+
+--wb_robot_task_new :: () -> () -> IO ()
+--wb_robot_task_new task param =
+-- [C.exp| void { wb_robot_task_new($(void task), $(void param)) } |]
+
+wb_robot_mutex_new :: IO WbMutexRef
+wb_robot_mutex_new =
+ [C.exp| WbMutexRef { wb_robot_mutex_new() } |]
+
+wb_robot_mutex_lock :: WbMutexRef -> IO ()
+wb_robot_mutex_lock mutex =
+ [C.exp| void { wb_robot_mutex_lock($(WbMutexRef mutex)) } |]
+
+wb_robot_mutex_unlock :: WbMutexRef -> IO ()
+wb_robot_mutex_unlock mutex =
+ [C.exp| void { wb_robot_mutex_unlock($(WbMutexRef mutex)) } |]
+
+wb_robot_mutex_delete :: WbMutexRef -> IO ()
+wb_robot_mutex_delete mutex =
+ [C.exp| void { wb_robot_mutex_delete($(WbMutexRef mutex)) } |]
+
+wb_robot_pin_to_static_environment :: CBool -> IO ()
+wb_robot_pin_to_static_environment pin =
+ [C.exp| void { wb_robot_pin_to_static_environment($(bool pin)) } |]
+
+{-
+wb_robot_window_custom_function :: String -> IO String
+wb_robot_window_custom_function xxx =
+ withCString xxx $ \xxx' ->
+ peekCString =<< [C.exp| const char* { wb_robot_window_custom_function($(const char* xxx')) } |]
+
+wb_robot_wwi_send :: String -> CInt -> IO ()
+wb_robot_wwi_send dat size =
+ withCString dat $ \dat' ->
+ [C.exp| void { wb_robot_wwi_send($(const char* dat'), $(int size)) } |]
+
+wb_robot_wwi_receive :: CInt -> IO String
+wb_robot_wwi_receive size =
+ peekCString =<< [C.exp| const char* { wb_robot_wwi_receive($(int size)) } |]
+-}
diff --git a/src/Webots/Skin.hs b/src/Webots/Skin.hs
new file mode 100644
index 0000000..f39a981
--- /dev/null
+++ b/src/Webots/Skin.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Skin where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/skin.h>"
+
+wb_skin_set_bone_orientation :: WbDeviceTag -> CInt -> Ptr CDouble -> CBool -> IO ()
+wb_skin_set_bone_orientation tag index orientation absolute =
+ [C.exp| void { wb_skin_set_bone_orientation($(WbDeviceTag tag), $(int index), $(const double* orientation), $(bool absolute)) } |]
+
+wb_skin_set_bone_position :: WbDeviceTag -> CInt -> Ptr CDouble -> CBool -> IO ()
+wb_skin_set_bone_position tag index position absolute =
+ [C.exp| void { wb_skin_set_bone_position($(WbDeviceTag tag), $(int index), $(const double* position), $(bool absolute)) } |]
+
+wb_skin_get_bone_count :: WbDeviceTag -> IO CInt
+wb_skin_get_bone_count tag =
+ [C.exp| int { wb_skin_get_bone_count($(WbDeviceTag tag)) } |]
+
+wb_skin_get_bone_name :: WbDeviceTag -> CInt -> IO String
+wb_skin_get_bone_name tag index =
+ peekCString =<< [C.exp| const char* { wb_skin_get_bone_name($(WbDeviceTag tag), $(int index)) } |]
+
+wb_skin_get_bone_orientation :: WbDeviceTag -> CInt -> CBool -> IO (Ptr CDouble)
+wb_skin_get_bone_orientation tag index absolute =
+ [C.exp| const double* { wb_skin_get_bone_orientation($(WbDeviceTag tag), $(int index), $(bool absolute)) } |]
+
+wb_skin_get_bone_position :: WbDeviceTag -> CInt -> CBool -> IO (Ptr CDouble)
+wb_skin_get_bone_position tag index absolute =
+ [C.exp| const double* { wb_skin_get_bone_position($(WbDeviceTag tag), $(int index), $(bool absolute)) } |]
diff --git a/src/Webots/Speaker.hs b/src/Webots/Speaker.hs
new file mode 100644
index 0000000..36130bb
--- /dev/null
+++ b/src/Webots/Speaker.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Speaker where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/speaker.h>"
+
+wb_speaker_play_sound :: WbDeviceTag -> WbDeviceTag -> String -> CDouble -> CDouble -> CDouble -> CBool -> IO ()
+wb_speaker_play_sound left right sound volume pitch balance loop =
+ withCString sound $ \sound' -> [C.exp| void { wb_speaker_play_sound($(WbDeviceTag left), $(WbDeviceTag right), $(const char* sound'), $(double volume), $(double pitch), $(double balance), $(bool loop)) } |]
+
+wb_speaker_stop :: WbDeviceTag -> String -> IO ()
+wb_speaker_stop tag sound =
+ withCString sound $ \sound' -> [C.exp| void { wb_speaker_stop($(WbDeviceTag tag), $(const char* sound')) } |]
+
+wb_speaker_is_sound_playing :: WbDeviceTag -> String -> IO CBool
+wb_speaker_is_sound_playing tag sound =
+ withCString sound $ \sound' -> [C.exp| bool { wb_speaker_is_sound_playing($(WbDeviceTag tag), $(const char* sound')) } |]
+
+wb_speaker_set_engine :: WbDeviceTag -> String -> IO CBool
+wb_speaker_set_engine tag engine =
+ withCString engine $ \engine' -> [C.exp| bool { wb_speaker_set_engine($(WbDeviceTag tag), $(const char* engine')) } |]
+
+wb_speaker_set_language :: WbDeviceTag -> String -> IO CBool
+wb_speaker_set_language tag language =
+ withCString language $ \language' -> [C.exp| bool { wb_speaker_set_language($(WbDeviceTag tag), $(const char* language')) } |]
+
+wb_speaker_get_engine :: WbDeviceTag -> IO String
+wb_speaker_get_engine tag =
+ peekCString =<< [C.exp| const char* { wb_speaker_get_engine($(WbDeviceTag tag)) } |]
+
+wb_speaker_get_language :: WbDeviceTag -> IO String
+wb_speaker_get_language tag =
+ peekCString =<< [C.exp| const char* { wb_speaker_get_language($(WbDeviceTag tag)) } |]
+
+wb_speaker_speak :: WbDeviceTag -> String -> CDouble -> IO ()
+wb_speaker_speak tag text volume =
+ withCString text $ \text' -> [C.exp| void { wb_speaker_speak($(WbDeviceTag tag), $(const char* text'), $(double volume)) } |]
+
+wb_speaker_is_speaking :: WbDeviceTag -> IO CBool
+wb_speaker_is_speaking tag =
+ [C.exp| bool { wb_speaker_is_speaking($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Supervisor.hs b/src/Webots/Supervisor.hs
new file mode 100644
index 0000000..3b88c7b
--- /dev/null
+++ b/src/Webots/Supervisor.hs
@@ -0,0 +1,548 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.Supervisor where
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/robot.h>"
+C.include "<webots/supervisor.h>"
+
+wb_supervisor_world_load :: String -> IO ()
+wb_supervisor_world_load filename =
+ withCString filename $ \filename' ->
+ [C.exp| void { wb_supervisor_world_load($(const char* filename')) } |]
+
+wb_supervisor_world_save :: String -> IO CBool
+wb_supervisor_world_save filename =
+ withCString filename $ \filename' ->
+ [C.exp| bool { wb_supervisor_world_save($(const char* filename')) } |]
+
+wb_supervisor_world_reload :: IO ()
+wb_supervisor_world_reload =
+ [C.exp| void { wb_supervisor_world_reload() } |]
+
+wb_supervisor_simulation_quit :: CInt -> IO ()
+wb_supervisor_simulation_quit status =
+ [C.exp| void { wb_supervisor_simulation_quit($(int status)) } |]
+
+wb_supervisor_simulation_reset :: IO ()
+wb_supervisor_simulation_reset =
+ [C.exp| void { wb_supervisor_simulation_reset() } |]
+
+wb_supervisor_simulation_reset_physics :: IO ()
+wb_supervisor_simulation_reset_physics =
+ [C.exp| void { wb_supervisor_simulation_reset_physics() } |]
+
+wb_supervisor_simulation_get_mode :: IO WbSimulationMode'
+wb_supervisor_simulation_get_mode = do
+ v <- [C.exp| WbSimulationMode { wb_supervisor_simulation_get_mode() } |]
+ case v of
+ 0 -> return WB_SUPERVISOR_SIMULATION_MODE_PAUSE
+ 1 -> return WB_SUPERVISOR_SIMULATION_MODE_REAL_TIME
+ 2 -> return WB_SUPERVISOR_SIMULATION_MODE_RUN
+ _ -> return WB_SUPERVISOR_SIMULATION_MODE_FAST
+
+wb_supervisor_simulation_set_mode :: WbSimulationMode' -> IO ()
+wb_supervisor_simulation_set_mode mode = do
+ let mode' = case mode of
+ WB_SUPERVISOR_SIMULATION_MODE_PAUSE -> 0
+ WB_SUPERVISOR_SIMULATION_MODE_REAL_TIME -> 1
+ WB_SUPERVISOR_SIMULATION_MODE_RUN -> 2
+ WB_SUPERVISOR_SIMULATION_MODE_FAST -> 3
+ [C.exp| void { wb_supervisor_simulation_set_mode($(WbSimulationMode mode')) } |]
+
+wb_supervisor_set_label :: CInt -> String -> CDouble -> CDouble -> CDouble -> CInt -> CDouble -> String -> IO ()
+wb_supervisor_set_label id text x y size color transparency font =
+ withCString text $ \text' ->
+ withCString font $ \font' ->
+ [C.exp| void { wb_supervisor_set_label($(int id), $(const char* text'), $(double x), $(double y), $(double size), $(int color), $(double transparency), $(const char* font')) } |]
+
+wb_supervisor_export_image :: String -> CInt -> IO ()
+wb_supervisor_export_image filename quality =
+ withCString filename $ \filename' ->
+ [C.exp| void { wb_supervisor_export_image($(const char* filename'), $(int quality)) } |]
+
+wb_supervisor_movie_start_recording :: String -> CInt -> CInt -> CInt -> CInt -> CInt -> CBool -> IO ()
+wb_supervisor_movie_start_recording filename width height codec quality acceleration caption =
+ withCString filename $ \filename' ->
+ [C.exp| void { wb_supervisor_movie_start_recording($(const char* filename'), $(int width), $(int height), $(int codec), $(int quality), $(int acceleration), $(bool caption)) } |]
+
+wb_supervisor_movie_stop_recording :: IO ()
+wb_supervisor_movie_stop_recording =
+ [C.exp| void { wb_supervisor_movie_stop_recording() } |]
+
+wb_supervisor_movie_is_ready :: IO CBool
+wb_supervisor_movie_is_ready =
+ [C.exp| bool { wb_supervisor_movie_is_ready() } |]
+
+wb_supervisor_movie_failed :: IO CBool
+wb_supervisor_movie_failed =
+ [C.exp| bool { wb_supervisor_movie_failed() } |]
+
+wb_supervisor_animation_start_recording :: String -> IO CBool
+wb_supervisor_animation_start_recording filename =
+ withCString filename $ \filename' ->
+ [C.exp| bool { wb_supervisor_animation_start_recording($(const char* filename')) } |]
+
+wb_supervisor_animation_stop_recording :: IO CBool
+wb_supervisor_animation_stop_recording =
+ [C.exp| bool { wb_supervisor_animation_stop_recording() } |]
+
+wb_supervisor_node_get_root :: IO WbNodeRef
+wb_supervisor_node_get_root =
+ [C.exp| WbNodeRef { wb_supervisor_node_get_root() } |]
+
+wb_supervisor_node_get_self :: IO WbNodeRef
+wb_supervisor_node_get_self =
+ [C.exp| WbNodeRef { wb_supervisor_node_get_self() } |]
+
+wb_supervisor_node_get_id :: WbNodeRef -> IO CInt
+wb_supervisor_node_get_id node =
+ [C.exp| int { wb_supervisor_node_get_id($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_from_id :: CInt -> IO WbNodeRef
+wb_supervisor_node_get_from_id id =
+ [C.exp| WbNodeRef { wb_supervisor_node_get_from_id($(int id)) } |]
+
+wb_supervisor_node_get_from_def :: String -> IO WbNodeRef
+wb_supervisor_node_get_from_def def =
+ withCString def $ \def' ->
+ [C.exp| WbNodeRef { wb_supervisor_node_get_from_def($(const char* def')) } |]
+
+wb_supervisor_node_get_parent_node :: WbNodeRef -> IO WbNodeRef
+wb_supervisor_node_get_parent_node node =
+ [C.exp| WbNodeRef { wb_supervisor_node_get_parent_node($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_selected :: IO WbNodeRef
+wb_supervisor_node_get_selected =
+ [C.exp| WbNodeRef { wb_supervisor_node_get_selected() } |]
+
+wb_supervisor_node_get_type :: WbNodeRef -> IO WbNodeType
+wb_supervisor_node_get_type node =
+ [C.exp| WbNodeType { wb_supervisor_node_get_type($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_field :: WbNodeRef -> String -> IO WbFieldRef
+wb_supervisor_node_get_field node field_name =
+ withCString field_name $ \field_name' ->
+ [C.exp| WbFieldRef { wb_supervisor_node_get_field($(WbNodeRef node), $(const char* field_name')) } |]
+
+wb_supervisor_node_remove :: WbNodeRef -> IO ()
+wb_supervisor_node_remove node =
+ [C.exp| void { wb_supervisor_node_remove($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_def :: WbNodeRef -> IO String
+wb_supervisor_node_get_def node =
+ peekCString =<< [C.exp| const char* { wb_supervisor_node_get_def($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_type_name :: WbNodeRef -> IO String
+wb_supervisor_node_get_type_name node =
+ peekCString =<< [C.exp| const char* { wb_supervisor_node_get_type_name($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_base_type_name :: WbNodeRef -> IO String
+wb_supervisor_node_get_base_type_name node =
+ peekCString =<< [C.exp| const char* { wb_supervisor_node_get_base_type_name($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_center_of_mass :: WbNodeRef -> IO (Ptr CDouble)
+wb_supervisor_node_get_center_of_mass node =
+ [C.exp| const double* { wb_supervisor_node_get_center_of_mass($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_contact_point :: WbNodeRef -> CInt -> IO (Ptr CDouble)
+wb_supervisor_node_get_contact_point node index =
+ [C.exp| const double* { wb_supervisor_node_get_contact_point($(WbNodeRef node), $(int index)) } |]
+
+wb_supervisor_node_get_number_of_contact_points :: WbNodeRef -> IO CInt
+wb_supervisor_node_get_number_of_contact_points node =
+ [C.exp| int { wb_supervisor_node_get_number_of_contact_points($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_orientation :: WbNodeRef -> IO (CDouble,CDouble,CDouble,CDouble)
+wb_supervisor_node_get_orientation node =
+ (,,,) <$>
+ [C.exp| double { wb_supervisor_node_get_orientation($(WbNodeRef node))[0] } |] <*>
+ [C.exp| double { wb_supervisor_node_get_orientation($(WbNodeRef node))[1] } |] <*>
+ [C.exp| double { wb_supervisor_node_get_orientation($(WbNodeRef node))[2] } |] <*>
+ [C.exp| double { wb_supervisor_node_get_orientation($(WbNodeRef node))[2] } |]
+
+wb_supervisor_node_get_position :: WbNodeRef -> IO (CDouble,CDouble,CDouble)
+wb_supervisor_node_get_position node =
+ (,,) <$>
+ [C.exp| double { wb_supervisor_node_get_position($(WbNodeRef node))[0] } |] <*>
+ [C.exp| double { wb_supervisor_node_get_position($(WbNodeRef node))[1] } |] <*>
+ [C.exp| double { wb_supervisor_node_get_position($(WbNodeRef node))[2] } |]
+
+wb_supervisor_node_get_static_balance :: WbNodeRef -> IO CBool
+wb_supervisor_node_get_static_balance node =
+ [C.exp| bool { wb_supervisor_node_get_static_balance($(WbNodeRef node)) } |]
+
+wb_supervisor_node_get_velocity :: WbNodeRef -> IO (Ptr CDouble)
+wb_supervisor_node_get_velocity node =
+ [C.exp| const double* { wb_supervisor_node_get_velocity($(WbNodeRef node)) } |]
+
+wb_supervisor_node_set_velocity :: WbNodeRef -> Ptr CDouble -> IO ()
+wb_supervisor_node_set_velocity node velocity =
+ [C.exp| void { wb_supervisor_node_set_velocity($(WbNodeRef node), $(const double* velocity)) } |]
+
+wb_supervisor_node_reset_physics :: WbNodeRef -> IO ()
+wb_supervisor_node_reset_physics node =
+ [C.exp| void { wb_supervisor_node_reset_physics($(WbNodeRef node)) } |]
+
+wb_supervisor_node_restart_controller :: WbNodeRef -> IO ()
+wb_supervisor_node_restart_controller node =
+ [C.exp| void { wb_supervisor_node_restart_controller($(WbNodeRef node)) } |]
+
+wb_supervisor_node_move_viewpoint :: WbNodeRef -> IO ()
+wb_supervisor_node_move_viewpoint node =
+ [C.exp| void { wb_supervisor_node_move_viewpoint($(WbNodeRef node)) } |]
+
+wb_supervisor_node_set_visibility :: WbNodeRef -> WbNodeRef -> CBool -> IO ()
+wb_supervisor_node_set_visibility node from visible =
+ [C.exp| void { wb_supervisor_node_set_visibility($(WbNodeRef node), $(WbNodeRef from), $(bool visible)) } |]
+
+wb_supervisor_field_get_type :: WbFieldRef -> IO WbFieldType
+wb_supervisor_field_get_type field =
+ [C.exp| WbFieldType { wb_supervisor_field_get_type($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_type_name :: WbFieldRef -> IO String
+wb_supervisor_field_get_type_name field =
+ peekCString =<< [C.exp| const char* { wb_supervisor_field_get_type_name($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_count :: WbFieldRef -> IO CInt
+wb_supervisor_field_get_count field =
+ [C.exp| int { wb_supervisor_field_get_count($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_bool :: WbFieldRef -> IO CBool
+wb_supervisor_field_get_sf_bool field =
+ [C.exp| bool { wb_supervisor_field_get_sf_bool($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_int32 :: WbFieldRef -> IO CInt
+wb_supervisor_field_get_sf_int32 field =
+ [C.exp| int { wb_supervisor_field_get_sf_int32($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_float :: WbFieldRef -> IO CDouble
+wb_supervisor_field_get_sf_float field =
+ [C.exp| double { wb_supervisor_field_get_sf_float($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_vec2f :: WbFieldRef -> IO (Ptr CDouble)
+wb_supervisor_field_get_sf_vec2f field =
+ [C.exp| const double* { wb_supervisor_field_get_sf_vec2f($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_vec3f :: WbFieldRef -> IO (Ptr CDouble)
+wb_supervisor_field_get_sf_vec3f field =
+ [C.exp| const double* { wb_supervisor_field_get_sf_vec3f($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_rotation :: WbFieldRef -> IO (Ptr CDouble)
+wb_supervisor_field_get_sf_rotation field =
+ [C.exp| const double* { wb_supervisor_field_get_sf_rotation($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_color :: WbFieldRef -> IO (Ptr CDouble)
+wb_supervisor_field_get_sf_color field =
+ [C.exp| const double* { wb_supervisor_field_get_sf_color($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_string :: WbFieldRef -> IO String
+wb_supervisor_field_get_sf_string field =
+ peekCString =<< [C.exp| const char* { wb_supervisor_field_get_sf_string($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_sf_node :: WbFieldRef -> IO WbNodeRef
+wb_supervisor_field_get_sf_node field =
+ [C.exp| WbNodeRef { wb_supervisor_field_get_sf_node($(WbFieldRef field)) } |]
+
+wb_supervisor_field_get_mf_bool :: WbFieldRef -> CInt -> IO CBool
+wb_supervisor_field_get_mf_bool field index =
+ [C.exp| bool { wb_supervisor_field_get_mf_bool($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_int32 :: WbFieldRef -> CInt -> IO CInt
+wb_supervisor_field_get_mf_int32 field index =
+ [C.exp| int { wb_supervisor_field_get_mf_int32($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_float :: WbFieldRef -> CInt -> IO CDouble
+wb_supervisor_field_get_mf_float field index =
+ [C.exp| double { wb_supervisor_field_get_mf_float($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_vec2f :: WbFieldRef -> CInt -> IO (Ptr CDouble)
+wb_supervisor_field_get_mf_vec2f field index =
+ [C.exp| const double* { wb_supervisor_field_get_mf_vec2f($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_vec3f :: WbFieldRef -> CInt -> IO (Ptr CDouble)
+wb_supervisor_field_get_mf_vec3f field index =
+ [C.exp| const double* { wb_supervisor_field_get_mf_vec3f($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_color :: WbFieldRef -> CInt -> IO (Ptr CDouble)
+wb_supervisor_field_get_mf_color field index =
+ [C.exp| const double* { wb_supervisor_field_get_mf_color($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_rotation :: WbFieldRef -> CInt -> IO (Ptr CDouble)
+wb_supervisor_field_get_mf_rotation field index =
+ [C.exp| const double* { wb_supervisor_field_get_mf_rotation($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_string :: WbFieldRef -> CInt -> IO String
+wb_supervisor_field_get_mf_string field index =
+ peekCString =<< [C.exp| const char* { wb_supervisor_field_get_mf_string($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_get_mf_node :: WbFieldRef -> CInt -> IO WbNodeRef
+wb_supervisor_field_get_mf_node field index =
+ [C.exp| WbNodeRef { wb_supervisor_field_get_mf_node($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_set_sf_bool :: WbFieldRef -> CBool -> IO ()
+wb_supervisor_field_set_sf_bool field value =
+ [C.exp| void { wb_supervisor_field_set_sf_bool($(WbFieldRef field), $(bool value)) } |]
+
+wb_supervisor_field_set_sf_int32 :: WbFieldRef -> CInt -> IO ()
+wb_supervisor_field_set_sf_int32 field value =
+ [C.exp| void { wb_supervisor_field_set_sf_int32($(WbFieldRef field), $(int value)) } |]
+
+wb_supervisor_field_set_sf_float :: WbFieldRef -> CDouble -> IO ()
+wb_supervisor_field_set_sf_float field value =
+ [C.exp| void { wb_supervisor_field_set_sf_float($(WbFieldRef field), $(double value)) } |]
+
+wb_supervisor_field_set_sf_vec2f :: WbFieldRef -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_sf_vec2f field values =
+ [C.exp| void { wb_supervisor_field_set_sf_vec2f($(WbFieldRef field), $(const double* values)) } |]
+
+wb_supervisor_field_set_sf_vec3f :: WbFieldRef -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_sf_vec3f field values =
+ [C.exp| void { wb_supervisor_field_set_sf_vec3f($(WbFieldRef field), $(const double* values)) } |]
+
+wb_supervisor_field_set_sf_rotation :: WbFieldRef -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_sf_rotation field values =
+ [C.exp| void { wb_supervisor_field_set_sf_rotation($(WbFieldRef field), $(const double* values)) } |]
+
+wb_supervisor_field_set_sf_color :: WbFieldRef -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_sf_color field values =
+ [C.exp| void { wb_supervisor_field_set_sf_color($(WbFieldRef field), $(const double* values)) } |]
+
+wb_supervisor_field_set_sf_string :: WbFieldRef -> String -> IO ()
+wb_supervisor_field_set_sf_string field value =
+ withCString value $ \value' ->
+ [C.exp| void { wb_supervisor_field_set_sf_string($(WbFieldRef field), $(const char* value')) } |]
+
+wb_supervisor_field_set_mf_bool :: WbFieldRef -> CInt -> CBool -> IO ()
+wb_supervisor_field_set_mf_bool field index value =
+ [C.exp| void { wb_supervisor_field_set_mf_bool($(WbFieldRef field), $(int index), $(bool value)) } |]
+
+wb_supervisor_field_set_mf_int32 :: WbFieldRef -> CInt -> CInt -> IO ()
+wb_supervisor_field_set_mf_int32 field index value =
+ [C.exp| void { wb_supervisor_field_set_mf_int32($(WbFieldRef field), $(int index), $(int value)) } |]
+
+wb_supervisor_field_set_mf_float :: WbFieldRef -> CInt -> CDouble -> IO ()
+wb_supervisor_field_set_mf_float field index value =
+ [C.exp| void { wb_supervisor_field_set_mf_float($(WbFieldRef field), $(int index), $(double value)) } |]
+
+wb_supervisor_field_set_mf_vec2f :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_mf_vec2f field index values =
+ [C.exp| void { wb_supervisor_field_set_mf_vec2f($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_set_mf_vec3f :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_mf_vec3f field index values =
+ [C.exp| void { wb_supervisor_field_set_mf_vec3f($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_set_mf_rotation :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_mf_rotation field index values =
+ [C.exp| void { wb_supervisor_field_set_mf_rotation($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_set_mf_color :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_set_mf_color field index values =
+ [C.exp| void { wb_supervisor_field_set_mf_color($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_set_mf_string :: WbFieldRef -> CInt -> String -> IO ()
+wb_supervisor_field_set_mf_string field index value =
+ withCString value $ \value' ->
+ [C.exp| void { wb_supervisor_field_set_mf_string($(WbFieldRef field), $(int index), $(const char* value')) } |]
+
+wb_supervisor_field_insert_mf_bool :: WbFieldRef -> CInt -> CBool -> IO ()
+wb_supervisor_field_insert_mf_bool field index value =
+ [C.exp| void { wb_supervisor_field_insert_mf_bool($(WbFieldRef field), $(int index), $(bool value)) } |]
+
+wb_supervisor_field_insert_mf_int32 :: WbFieldRef -> CInt -> CInt -> IO ()
+wb_supervisor_field_insert_mf_int32 field index value =
+ [C.exp| void { wb_supervisor_field_insert_mf_int32($(WbFieldRef field), $(int index), $(int value)) } |]
+
+wb_supervisor_field_insert_mf_float :: WbFieldRef -> CInt -> CDouble -> IO ()
+wb_supervisor_field_insert_mf_float field index value =
+ [C.exp| void { wb_supervisor_field_insert_mf_float($(WbFieldRef field), $(int index), $(double value)) } |]
+
+wb_supervisor_field_insert_mf_vec2f :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_insert_mf_vec2f field index values =
+ [C.exp| void { wb_supervisor_field_insert_mf_vec2f($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_insert_mf_vec3f :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_insert_mf_vec3f field index values =
+ [C.exp| void { wb_supervisor_field_insert_mf_vec3f($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_insert_mf_rotation :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_insert_mf_rotation field index values =
+ [C.exp| void { wb_supervisor_field_insert_mf_rotation($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_insert_mf_color :: WbFieldRef -> CInt -> Ptr CDouble -> IO ()
+wb_supervisor_field_insert_mf_color field index values =
+ [C.exp| void { wb_supervisor_field_insert_mf_color($(WbFieldRef field), $(int index), $(const double* values)) } |]
+
+wb_supervisor_field_insert_mf_string :: WbFieldRef -> CInt -> String -> IO ()
+wb_supervisor_field_insert_mf_string field index value =
+ withCString value $ \value' ->
+ [C.exp| void { wb_supervisor_field_insert_mf_string($(WbFieldRef field), $(int index), $(const char* value')) } |]
+
+wb_supervisor_field_remove_mf :: WbFieldRef -> CInt -> IO ()
+wb_supervisor_field_remove_mf field index =
+ [C.exp| void { wb_supervisor_field_remove_mf($(WbFieldRef field), $(int index)) } |]
+
+wb_supervisor_field_import_mf_node :: WbFieldRef -> CInt -> String -> IO ()
+wb_supervisor_field_import_mf_node field position filename =
+ withCString filename $ \filename' ->
+ [C.exp| void { wb_supervisor_field_import_mf_node($(WbFieldRef field), $(int position), $(const char* filename')) } |]
+
+wb_supervisor_field_import_mf_node_from_string :: WbFieldRef -> CInt -> String -> IO ()
+wb_supervisor_field_import_mf_node_from_string field position node_string =
+ withCString node_string $ \node_string' ->
+ [C.exp| void { wb_supervisor_field_import_mf_node_from_string($(WbFieldRef field), $(int position), $(const char* node_string')) } |]
+
+wb_supervisor_virtual_reality_headset_is_used :: IO CBool
+wb_supervisor_virtual_reality_headset_is_used =
+ [C.exp| bool { wb_supervisor_virtual_reality_headset_is_used() } |]
+
+wb_supervisor_virtual_reality_headset_get_position :: IO (Ptr CDouble)
+wb_supervisor_virtual_reality_headset_get_position =
+ [C.exp| const double* { wb_supervisor_virtual_reality_headset_get_position() } |]
+
+wb_supervisor_virtual_reality_headset_get_orientation :: IO (Ptr CDouble)
+wb_supervisor_virtual_reality_headset_get_orientation =
+ [C.exp| const double* { wb_supervisor_virtual_reality_headset_get_orientation() } |]
+
+wb_supervisor_movie_get_status :: IO CInt
+wb_supervisor_movie_get_status =
+ [C.exp| int { wb_supervisor_movie_get_status() } |]
+
+
+loop :: CInt -> (Int -> IO ()) -> IO ()
+loop time_step func = loop' 0
+ where
+ loop' cnt = do
+ i <- [C.exp| int { wb_robot_step($(int time_step)) }|]
+ whenM (i /= -1) $ do
+ func cnt
+ loop' (cnt+1)
+
+withWbRobot func = do
+ time <- [C.block| int {
+ wb_robot_init();
+ return wb_robot_get_basic_time_step();
+ }|]
+ func time
+ [C.exp| void { wb_robot_cleanup() }|]
+
+fieldGetCount :: WbFieldRef -> IO CInt
+fieldGetCount ptr = [C.exp| int { wb_supervisor_field_get_count($(WbFieldRef ptr)) } |]
+
+
+fieldGetSfBool :: WbFieldRef -> IO CBool
+fieldGetSfBool ptr = [C.exp|bool {wb_supervisor_field_get_sf_bool($(WbFieldRef ptr))}|]
+
+fieldGetSfInt32 :: WbFieldRef -> IO CInt
+fieldGetSfInt32 ptr = [C.exp|int {wb_supervisor_field_get_sf_int32($(WbFieldRef ptr))}|]
+
+fieldGetSfFloat :: WbFieldRef -> IO CDouble
+fieldGetSfFloat ptr = [C.exp|double {wb_supervisor_field_get_sf_float($(WbFieldRef ptr))}|]
+
+fieldGetSfVec2f :: WbFieldRef -> IO (CDouble,CDouble)
+fieldGetSfVec2f ptr = do
+ ptr <- [C.exp|const double * {wb_supervisor_field_get_sf_vec2f($(WbFieldRef ptr))}|]
+ x <- peek ptr
+ y <- peekByteOff ptr (sizeOf x)
+ return (x,y)
+
+fieldGetSfVec3f :: WbFieldRef -> IO (CDouble,CDouble,CDouble)
+fieldGetSfVec3f ptr = do
+ ptr <- [C.exp|const double * {wb_supervisor_field_get_sf_vec3f($(WbFieldRef ptr))}|]
+ x <- peek ptr
+ y <- peekByteOff ptr (sizeOf x)
+ z <- peekByteOff ptr ((sizeOf x)*2)
+ return (x,y,z)
+
+fieldGetSfRotation :: WbFieldRef -> IO (CDouble,CDouble,CDouble,CDouble)
+fieldGetSfRotation ptr = do
+ ptr <- [C.exp|const double *{wb_supervisor_field_get_sf_rotation($(WbFieldRef ptr))}|]
+ a <- peek ptr
+ b <- peekByteOff ptr (sizeOf a)
+ c <- peekByteOff ptr ((sizeOf a)*2)
+ d <- peekByteOff ptr ((sizeOf a)*3)
+ return (a,b,c,d)
+
+fieldGetSfColor :: WbFieldRef -> IO (CDouble,CDouble,CDouble)
+fieldGetSfColor ptr = do
+ ptr <- [C.exp|const double *{wb_supervisor_field_get_sf_color($(WbFieldRef ptr))}|]
+ x <- peek ptr
+ y <- peekByteOff ptr (sizeOf x)
+ z <- peekByteOff ptr ((sizeOf x)*2)
+ return (x,y,z)
+
+fieldGetSfString :: WbFieldRef -> IO String
+fieldGetSfString ptr =
+ peekCString =<< [C.exp|const char *{wb_supervisor_field_get_sf_string($(WbFieldRef ptr))}|]
+
+fieldGetMfNode :: WbFieldRef -> CInt -> IO WbNodeRef
+fieldGetMfNode ptr i = [C.exp| WbNodeRef { wb_supervisor_field_get_mf_node($(WbFieldRef ptr), $(int i)) } |]
+
+getField :: WbNodeRef -> String -> IO WbFieldRef
+getField ptr str =
+ withCString str $ \cstr ->
+ [C.exp| WbFieldRef { wb_supervisor_node_get_field($(WbNodeRef ptr), $(char* cstr)) } |]
+
+getId :: WbNodeRef -> IO CInt
+getId ptr =
+ [C.exp| int { wb_supervisor_node_get_id($(WbNodeRef ptr)) } |]
+
+getTypeName :: WbNodeRef -> IO String
+getTypeName ptr =
+ [C.exp| const char* { wb_supervisor_node_get_type_name($(WbNodeRef ptr)) } |] >>= peekCString
+
+getRootNode :: IO WbNodeRef
+getRootNode = [C.exp| WbNodeRef { wb_supervisor_node_get_root()} |]
+
+setVelocity :: WbNodeRef -> (CDouble,CDouble,CDouble) -> (CDouble,CDouble,CDouble) -> IO ()
+setVelocity node (x,y,z) (x1,y1,z1) =
+ [C.block| void {
+ const double velocity[6] =
+ { $(double x)
+ , $(double y)
+ , $(double z)
+ , $(double x1)
+ , $(double y1)
+ , $(double z1)
+ };
+ wb_supervisor_node_set_velocity($(WbNodeRef node), velocity);
+ } |]
+
+whenM cond block = if cond then block else return ()
+
+getRootNodes :: IO [(WbNodeRef,CInt,String)]
+getRootNodes = do
+ root <- getRootNode
+ children <- getField root "children"
+ cnt <- fieldGetCount children
+ forM [0..(cnt-1)] $ \i -> do
+ node <- fieldGetMfNode children i
+ nodeId <- getId node
+ typeName <- getTypeName node
+ return (node,nodeId,typeName)
+
+getNodeFieldByString :: WbNodeRef -> String -> IO String
+getNodeFieldByString node label = getField node label >>= fieldGetSfString
+
diff --git a/src/Webots/TouchSensor.hs b/src/Webots/TouchSensor.hs
new file mode 100644
index 0000000..8a44c53
--- /dev/null
+++ b/src/Webots/TouchSensor.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Webots.TouchSensor where
+import Control.Exception.Safe ( try
+ , SomeException(..)
+ , throwIO
+ )
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+
+import qualified Language.C.Inline as C
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.C.Inline.Cpp (cppTypePairs)
+import Foreign.C.Types
+import Control.Monad (forM_,forM)
+import qualified Codec.Picture as I
+
+import qualified Data.Vector.Storable as V
+import qualified Foreign.ForeignPtr as F
+import qualified Foreign.Ptr as F
+import qualified Data.ByteString.Internal as BSI
+
+import Webots.Types
+
+C.context $ C.baseCtx `mappend` cppTypePairs typeMaps
+
+C.include "<math.h>"
+C.include "<stdio.h>"
+C.include "<stdlib.h>"
+C.include "<webots/touch_sensor.h>"
+
+wb_touch_sensor_enable :: WbDeviceTag -> CInt -> IO ()
+wb_touch_sensor_enable tag sampling_period =
+ [C.exp| void { wb_touch_sensor_enable($(WbDeviceTag tag), $(int sampling_period)) } |]
+
+wb_touch_sensor_disable :: WbDeviceTag -> IO ()
+wb_touch_sensor_disable tag =
+ [C.exp| void { wb_touch_sensor_disable($(WbDeviceTag tag)) } |]
+
+wb_touch_sensor_get_sampling_period :: WbDeviceTag -> IO CInt
+wb_touch_sensor_get_sampling_period tag =
+ [C.exp| int { wb_touch_sensor_get_sampling_period($(WbDeviceTag tag)) } |]
+
+wb_touch_sensor_get_value :: WbDeviceTag -> IO CDouble
+wb_touch_sensor_get_value tag =
+ [C.exp| double { wb_touch_sensor_get_value($(WbDeviceTag tag)) } |]
+
+wb_touch_sensor_get_values :: WbDeviceTag -> IO (Ptr CDouble)
+wb_touch_sensor_get_values tag =
+ [C.exp| const double* { wb_touch_sensor_get_values($(WbDeviceTag tag)) } |]
+
+wb_touch_sensor_get_type :: WbDeviceTag -> IO WbTouchSensorType
+wb_touch_sensor_get_type tag =
+ [C.exp| WbTouchSensorType { wb_touch_sensor_get_type($(WbDeviceTag tag)) } |]
diff --git a/src/Webots/Types.hs b/src/Webots/Types.hs
new file mode 100644
index 0000000..a557a3b
--- /dev/null
+++ b/src/Webots/Types.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Webots.Types where
+
+import Foreign.Ptr
+import Data.Word
+import Foreign.C.Types
+--import qualified Language.C.Inline as C
+--import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+import Language.Haskell.TH
+
+data WbField
+data WbNode
+data WbMutex
+data WbImage
+data WbRadarTarget
+type WbRadioEvent = Ptr ()
+type WbRadioMessage = Ptr ()
+
+data WbSimulationMode'
+ = WB_SUPERVISOR_SIMULATION_MODE_PAUSE
+ | WB_SUPERVISOR_SIMULATION_MODE_REAL_TIME
+ | WB_SUPERVISOR_SIMULATION_MODE_RUN
+ | WB_SUPERVISOR_SIMULATION_MODE_FAST
+ deriving (Show,Eq)
+
+
+data WbCameraRecognitionObject = WbCameraRecognitionObject
+ { obj_id :: CInt
+ , obj_position :: (CDouble,CDouble,CDouble)
+ , obj_orientation :: (CDouble,CDouble,CDouble,CDouble)
+ , obj_size :: (CDouble,CDouble)
+ , obj_position_on_image :: (CInt,CInt)
+ , obj_size_on_image :: (CInt,CInt)
+ , obj_number_of_colors :: CInt
+ , obj_colors :: [CDouble]
+ , obj_model :: String
+ } deriving (Show,Eq)
+
+data WbMouseState = WbMouseState
+ { mouse_left :: CBool
+ , mouse_middle :: CBool
+ , mouse_right :: CBool
+ , mouse_u :: CDouble
+ , mouse_v :: CDouble
+ , mouse_x :: CDouble
+ , mouse_y :: CDouble
+ , mouse_z :: CDouble
+ } deriving (Show,Eq)
+
+
+type WbFieldRef = Ptr WbField
+type WbNodeRef = Ptr WbNode
+type WbMutexRef = Ptr WbMutex
+type WbImageRef = Ptr WbImage
+type WbDeviceTag = CUShort
+type WbSimulationMode = CInt
+type WbNodeType = CInt
+type WbFieldType = CInt
+type WbUserInputEvent = CInt
+type WbRobotMode = CInt
+type WbJointType = CInt
+
+type WbuDriverIndicatorState = CInt
+type WbuDriverControlMode = CInt
+type WbuDriverWiperMode = CInt
+
+type WbTouchSensorType = CInt
+type WbGpsCoordinateSystem = CInt
+type WbDistanceSensorType = CInt
+
+typeMaps :: [(C.CIdentifier,TypeQ)]
+typeMaps =
+ [ ("WbFieldRef", [t|Ptr WbField|])
+ , ("WbNodeRef", [t|Ptr WbNode|])
+ , ("WbMutexRef", [t|Ptr WbMutex|])
+ , ("WbDeviceTag", [t|CUShort|])
+ , ("WbSimulationMode", [t|CInt|])
+ , ("WbNodeType", [t|CInt|])
+ , ("WbFieldType", [t|CInt|])
+ , ("WbUserInputEvent", [t|CInt|])
+ , ("WbRobotMode", [t|CInt|])
+ , ("WbuDriverIndicatorState", [t|CInt|])
+ , ("WbuDriverControlMode", [t|CInt|])
+ , ("WbuDriverWiperMode", [t|CInt|])
+ , ("WbCameraRecognitionObject", [t|WbCameraRecognitionObject|])
+ , ("WbTouchSensorType", [t|CInt|])
+ , ("WbRadarTarget", [t|WbRadarTarget|])
+ , ("WbRadioEvent", [t|Ptr ()|])
+ , ("WbRadioMessage", [t|Ptr ()|])
+ , ("WbJointType", [t|CInt|])
+ , ("WbMouseState", [t|WbMouseState|])
+ , ("WbGpsCoordinateSystem", [t|CInt|])
+ , ("WbDistanceSensorType", [t|CInt|])
+ , ("WbImageRef", [t|Ptr WbImage|])
+ ]
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..cd4753f
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"