Skip to content
Browse files

monad to encapsulate stop action

  • Loading branch information...
1 parent 63f9711 commit 33d5e9671419faa601f9129a8a55ca3ec40b1e9e @JPMoresmau committed Mar 26, 2012
Showing with 112 additions and 68 deletions.
  1. +6 −3 nxt-samples.cabal
  2. +17 −20 src/Bumper.hs
  3. +26 −9 src/Gator.hs
  4. +63 −36 src/Robotics/NXT/Samples/Helpers.hs
View
9 nxt-samples.cabal
@@ -13,9 +13,11 @@ license-file: LICENSE
copyright: (c)JP Moresmau 2012
executable bumper
- build-depends: base >= 4,
+ build-depends:
+ base >= 4,
NXT,
- transformers
+ transformers,
+ mtl
hs-source-dirs: src
ghc-options: -Wall -rtsopts
main-is: Bumper.hs
@@ -24,7 +26,8 @@ executable bumper
executable gator
build-depends:
base >= 4,
- GLUT
+ GLUT,
+ mtl
hs-source-dirs: src
ghc-options: -Wall -rtsopts
other-modules: Robotics.NXT.Samples.Helpers
View
37 src/Bumper.hs
@@ -10,10 +10,11 @@ import Robotics.NXT.Samples.Helpers
import System.Environment (getArgs)
import Control.Concurrent (threadDelay,forkIO)
import Control.Monad.IO.Class (liftIO)
-import Control.Monad (forever)
import Data.IORef
import System.IO
+import Control.Monad.State.Lazy (evalStateT)
+import Control.Monad.Trans.Class (lift)
-- | the main method
main :: IO()
@@ -29,32 +30,28 @@ main = do
return ()
)
withNXT device (do
- reset [B,C]
- forever $ loop $ pollForStopIOR iorC
- reset [B,C]
+ evalStateT (do
+ reset [B,C]
+ forever loop
+ reset [B,C]
+ ) (pollForStopIOR iorC)
liftIO $ threadDelay 1000000 -- wait before killing everything probably not needed after reset
)
--killThread tid
--- | waits for user to press space, this stops the robot
-waitForStop :: IORef Bool-> IO()
-waitForStop iorC=do
- c<-getChar
- if c == ' ' then
- do atomicModifyIORef iorC (\ a -> (False, a))
- return ()
- else waitForStop iorC
+
-- | the main loop for the robot
-loop :: PollForStop -- ^ the stopping action
- -> NXT()
-loop iorC= do
- move iorC [B,C] 75 [0,0] 0 -- move forever
- setInputModeConfirm One Switch BooleanMode -- set the sensor on port One to switch mode
- pollForScaled iorC One 0 -- wait for sensor to be triggered
+loop :: --PollForStop -- ^ the stopping action
+ -- ->
+ StopSt()
+loop = do
+ move [B,C] 75 [0,0] 0 -- move forever
+ lift $ setInputModeConfirm One Switch BooleanMode -- set the sensor on port One to switch mode
+ pollForScaled One 0 -- wait for sensor to be triggered
stop [B,C] -- stop
- move iorC [B,C] (-75) [0,0] 360 -- reverse
- move iorC [B,C] (-75) [100,-100] 360 -- turn
+ move [B,C] (-75) [0,0] 360 -- reverse
+ move [B,C] (-75) [100,-100] 360 -- turn
stop [B,C] -- stop
View
35 src/Gator.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-- | the alligator moves towards a detected target and bites...
--
module Main where
@@ -9,27 +10,43 @@ import Control.Monad.IO.Class (liftIO)
import Control.Concurrent
import Robotics.NXT.Sensor.Ultrasonic
+import Control.Monad.State.Lazy (evalStateT)
+import Data.IORef (newIORef)
+import System.IO (hSetBuffering, stdin, stdout, BufferMode(NoBuffering))
main :: IO()
main = do
(device:_)<-getArgs
+ iorC<-newIORef True
+ forkIO (do
+ hSetBuffering stdin NoBuffering
+ hSetBuffering stdout NoBuffering -- does not Work on windows
+ putStrLn "press space to stop robot"
+ waitForStop iorC
+ putStrLn "stopping..."
+ return ()
+ )
withNXT device (do
- reset [A]
+ let poll=pollForStopIOR iorC
usInit Four
- let poll=pollNeverStop
- pollForUltrasonic poll Four 60
- move poll [B,C] (-75) [0,0] 800
- bite poll A
+ evalStateT (do
+ reset [A]
+ forever (do
+ pollForUltrasonic Four 60
+ move [B,C] (-100) [0,0] 800
+ bite A
+ )
+ ) poll
usSetMode Four Off
)
-bite :: PollForStop -> OutputPort -> NXT()
-bite poll port=do
- move poll [port] 75 [0] 10
+bite :: OutputPort -> StopSt ()
+bite port=do
+ move [port] 75 [0] 10
reset [port]
liftIO $ threadDelay 20000
- move poll [port] (-75) [0] 5
+ move [port] (-75) [0] 5
reset [port]
View
99 src/Robotics/NXT/Samples/Helpers.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
-- | helper method around the NXT library calls
module Robotics.NXT.Samples.Helpers where
@@ -9,65 +10,72 @@ import Control.Monad.IO.Class (liftIO)
import Control.Monad (when, unless)
import Data.IORef
+import Control.Monad.State.Lazy (StateT, get)
+import Control.Monad.Trans.Class (lift)
type PollForStop= NXT Bool
+type StopSt=StateT PollForStop NXT
+
-- | reset the NXT brick motors
reset :: [OutputPort] -- ^ the output ports
- -> NXT()
+ -> StopSt()
reset = mapM_ resetMotor
-- | reset a motor
resetMotor :: OutputPort -- ^ the output port
- -> NXT()
-resetMotor p= mapM_ (resetMotorPosition p) [InternalPosition,AbsolutePosition,RelativePosition]
+ -> StopSt()
+resetMotor p= lift $ mapM_ (resetMotorPosition p) [InternalPosition,AbsolutePosition,RelativePosition]
-- | stop the motors on the given port
-stop :: [OutputPort] -> NXT()
-stop ports=mapM_ (\p->setOutputStateConfirm p 0 [Regulated,Brake] (regulate ports) 0 MotorRunStateIdle 0) ports
+stop :: [OutputPort] -> StopSt()
+stop ports=lift $ mapM_ (\p->setOutputStateConfirm p 0 [Regulated,Brake] (regulate ports) 0 MotorRunStateIdle 0) ports
-- | move motors on the given ports till the limit has been reached or the stop signal sent
-move :: PollForStop -- ^ the stopping action
- -> [OutputPort] -- ^ the output port
+move :: --PollForStop -- ^ the stopping action
+ -- ->
+ [OutputPort] -- ^ the output port
-> OutputPower -- ^ the power to apply
-> [TurnRatio] -- ^ the turn ratio between engine
-> TachoLimit -- ^ the move limit
- -> NXT()
-move iorC ports power ratios limit=pollForStop iorC $ do
+ -> StopSt()
+move ports power ratios limit=pollForStop $ do
let port1= head ports
- OutputState _ _ _ _ _ _ _ count _ _<-getOutputState port1
- mapM_ (\(p,r)->setOutputStateConfirm p power [Regulated,MotorOn] (regulate ports) r MotorRunStateRunning limit) $ zip ports ratios
- when (limit>0) (pollForCount iorC port1 (count+limit))
+ OutputState _ _ _ _ _ _ _ count _ _<-lift $ getOutputState port1
+ mapM_ (\(p,r)->lift $ setOutputStateConfirm p power [Regulated,MotorOn] (regulate ports) r MotorRunStateRunning limit) $ zip ports ratios
+ when (limit>0) (pollForCount port1 (count+limit))
regulate :: [OutputPort] -> RegulationMode
regulate [_]=RegulationModeIdle
regulate [] =RegulationModeIdle
regulate _ = RegulationModeMotorSync
-- | wait for the given motor to have reached the limit
-pollForCount :: PollForStop -- ^ the stopping action
- -> OutputPort -- ^ the output port
+pollForCount :: --PollForStop -- ^ the stopping action
+ -- ->
+ OutputPort -- ^ the output port
-> TachoLimit -- ^ the limit
- -> NXT()
-pollForCount iorC port limit=pollForStop iorC $ do
- OutputState _ _ _ _ _ state _ count _ _<-getOutputState port
+ -> StopSt()
+pollForCount port limit=pollForStop $ do
+ OutputState _ _ _ _ _ state _ count _ _<-lift $ getOutputState port
when (state/=MotorRunStateIdle && count<limit) (do
liftIO $ threadDelay 500
- pollForCount iorC port limit
+ pollForCount port limit
)
-- | wait for the input value to reach the given value
-pollForScaled :: PollForStop -- ^ the stopping action
- -> InputPort -- ^ the input port
+pollForScaled :: -- PollForStop -- ^ the stopping action
+ -- ->
+ InputPort -- ^ the input port
-> ScaledValue -- ^ the value to wait for
- -> NXT()
-pollForScaled iorC port v=pollForStop iorC $ do
- InputValue _ _ _ _ _ _ _ scalV _<-getInputValues port
+ -> StopSt()
+pollForScaled port v=pollForStop $ do
+ InputValue _ _ _ _ _ _ _ scalV _<-lift $ getInputValues port
when (scalV==v) ( do
liftIO $ threadDelay 500
- pollForScaled iorC port v
+ pollForScaled port v
)
pollForStopIOR :: IORef Bool -- ^ the stop signal ioref
@@ -78,25 +86,44 @@ pollNeverStop :: PollForStop
pollNeverStop = return True
-- | only perform the given action if the user hasn't said stop
-pollForStop :: PollForStop -- ^ the stopping action
- -> NXT() -- ^ the action to perform
- -> NXT()
-pollForStop pfs f=do
- c<-pfs
+pollForStop :: --PollForStop -- ^ the stopping action
+ -- ->
+ StopSt () -- ^ the action to perform
+ -> StopSt ()
+pollForStop f=do
+ c<-lift =<< get
when c f
+
+forever :: StopSt () -- ^ the action to perform
+ -> StopSt ()
+forever f=do
+ c<-lift =<< get
+ when c (do
+ f
+ forever f)
-pollForUltrasonic :: PollForStop
- -> InputPort
+pollForUltrasonic :: --PollForStop
+ -- ->
+ InputPort
-> Measurement
- -> NXT ()
-pollForUltrasonic iorC port v=pollForStop iorC $ do
- mM<-usGetMeasurement port 0
+ -> StopSt ()
+pollForUltrasonic port v=pollForStop $ do
+ mM<-lift $ usGetMeasurement port 0
ok<-case mM of
Just m->do
liftIO $ print m
return $ m<v
Nothing->return False
unless ok ( do
liftIO $ threadDelay 50000
- pollForUltrasonic iorC port v
- )
+ pollForUltrasonic port v
+ )
+
+-- | waits for user to press space, this stops the robot
+waitForStop :: IORef Bool-> IO()
+waitForStop iorC=do
+ c<-getChar
+ if c == ' ' then
+ do atomicModifyIORef iorC (\ a -> (False, a))
+ return ()
+ else waitForStop iorC

0 comments on commit 33d5e96

Please sign in to comment.
Something went wrong with that request. Please try again.