diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,30 @@ +* Hackage: (http://hackage.haskell.org/package/hArduino) +* GitHub: (http://leventerkok.github.com/hArduino) + +* Latest Hackage released version: 0.3 + +### Version 0.3, 2013-02-10 + + * Library + * Add support for pull-up resistors + * Implement routines for waiting on digital triggers + * Add support for reading analog values and setting sampling frequency. + * Add support for LCDs (based on the Hitachi 44780 chip) + * Better handling for Ctrl-C interrupts + * Examples + * Add counter: use push buttons to count up and down + * Add analog-reading example + * Add LCD controller example + * Add wiring schematics for all sample programs + +### Version 0.2, 2013-01-28 + + * Rewrite the communication engine + * Digital input/output implementation + * Add switch example + +### Version 0.1, 2013-01-14 + + * Initial design + * Blink example operational + * Created home page at: http://leventerkok.github.com/hArduino diff --git a/INSTALL b/INSTALL --- a/INSTALL +++ b/INSTALL @@ -1,9 +1,4 @@ -The usbArduino library can be installed simply by issuing cabal install +The hArduino library can be installed simply by issuing cabal install like this: - cabal install sbv - -The package depends on the usb library itself, which in turn relies on -the availability of the libusb package on your platform. See notes -at https://github.com/basvandijk/bindings-libusb for details on how -to get the latter. + cabal install hArduino diff --git a/README b/README deleted file mode 100644 --- a/README +++ /dev/null @@ -1,1 +0,0 @@ -Please see http://leventerkok.github.com/hArduino. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +Please see http://leventerkok.github.com/hArduino. diff --git a/RELEASENOTES b/RELEASENOTES deleted file mode 100644 --- a/RELEASENOTES +++ /dev/null @@ -1,18 +0,0 @@ -Hackage: http://hackage.haskell.org/package/hArduino -GitHub: http://leventerkok.github.com/hArduino - -Latest Hackage released version: 0.2 - -====================================================================== -Version 0.2, 2013-01-28 - - - Rewrite the communication engine - - Digital input/output implementation - - Add switch example - -====================================================================== -Version 0.1, 2013-01-14 - - - Initial design - - Blink example operational - - Home page at: http://leventerkok.github.com/hArduino diff --git a/System/Hardware/Arduino.hs b/System/Hardware/Arduino.hs --- a/System/Hardware/Arduino.hs +++ b/System/Hardware/Arduino.hs @@ -17,6 +17,9 @@ -- Arduino! It simply allows you to control a board from Haskell, where you -- can exchange information with the board, send/receive commands from other -- peripherals connected, etc. +-- +-- See for a short video (4m29s) +-- of the blink example. ------------------------------------------------------------------------------- module System.Hardware.Arduino ( -- * Running the controller @@ -24,15 +27,20 @@ -- * Programming the Arduino -- ** Basic handshake with the board , queryFirmware - -- ** Controlling the pins - , setPinMode - -- ** Reading and Writing digital values - , digitalRead, digitalWrite - -- ** Misc utilities - , waitFor, delay - -- * Hardware components on the board - -- ** Pins - , pin, PinMode(..) + -- ** Accessing pins + , pin, Pin, PinMode(..), setPinMode + -- ** Digital I/O + -- *** Writing digital values + , digitalWrite + -- *** Reading digital values + , digitalRead, pullUpResistor, waitFor, waitAny, waitAnyHigh, waitAnyLow + -- ** Analog Communication + -- *** Setting up sampling interval + , setAnalogSamplingInterval + -- *** Reading analog values + , analogRead + -- * Misc utilities + , delay ) where diff --git a/System/Hardware/Arduino/Comm.hs b/System/Hardware/Arduino/Comm.hs --- a/System/Hardware/Arduino/Comm.hs +++ b/System/Hardware/Arduino/Comm.hs @@ -9,18 +9,23 @@ -- Basic serial communication routines ------------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} module System.Hardware.Arduino.Comm where import Control.Monad (when, forever) -import Control.Concurrent (myThreadId, throwTo, newChan, newMVar, putMVar, writeChan, readChan, forkIO, modifyMVar_) -import Control.Exception (tryJust, AsyncException(UserInterrupt)) +import Control.Concurrent (MVar, myThreadId, ThreadId, throwTo, newChan, newMVar, newEmptyMVar, putMVar, writeChan, readChan, forkIO, modifyMVar_, tryTakeMVar, killThread) +import Control.Exception (tryJust, AsyncException(UserInterrupt), handle, SomeException) import Control.Monad.State (runStateT, gets, liftIO, modify) -import Data.Bits (testBit) +import Data.Bits (testBit, (.&.)) +import Data.List (intercalate) +import Data.Maybe (listToMaybe) import System.Posix.Signals (installHandler, keyboardSignal, Handler(Catch)) +import System.Timeout (timeout) +import System.IO (stderr, hPutStrLn) import qualified Data.ByteString as B (unpack, length) -import qualified Data.Map as M (empty, mapWithKey) +import qualified Data.Map as M (empty, mapWithKey, insert, assocs, lookup) import qualified Data.Set as S (empty) import qualified System.Hardware.Serialport as S (withSerial, defaultSerialSettings, CommSpeed(CS57600), commSpeed, recv, send) @@ -49,31 +54,51 @@ _ <- installHandler keyboardSignal (Catch (throwTo tid UserInterrupt)) Nothing debugger <- mkDebugPrinter verbose debugger $ "Accessing arduino located at: " ++ show fp - let Arduino controller = do initialize + listenerTid <- newEmptyMVar + let Arduino controller = do initOK <- initialize listenerTid + if initOK + then program + else error "Communication time-out (5s) expired." program - S.withSerial fp S.defaultSerialSettings{S.commSpeed = S.CS57600} $ \port -> do + handle (\(e::SomeException) -> do cleanUp listenerTid + hPutStrLn stderr $ "*** hArduino:ERROR: " ++ show e + ++ concatMap ("\n*** " ++) [ "Make sure your Arduino is connected to " ++ fp + , "And StandardFirmata is running on it!" + ]) $ + S.withSerial fp S.defaultSerialSettings{S.commSpeed = S.CS57600} $ \port -> do let initBoardState = BoardState { - analogReportingPins = S.empty + boardCapabilities = BoardCapabilities M.empty + , analogReportingPins = S.empty , digitalReportingPins = S.empty , pinStates = M.empty , digitalWakeUpQueue = [] + , lcds = M.empty } bs <- newMVar initBoardState dc <- newChan let initState = ArduinoState { message = debugger + , bailOut = bailOut listenerTid , port = port , firmataID = "Unknown" , capabilities = BoardCapabilities M.empty , boardState = bs , deviceChannel = dc + , listenerTid = listenerTid } res <- tryJust catchCtrlC $ runStateT controller initState case res of Left () -> putStrLn "hArduino: Caught Ctrl-C, quitting.." _ -> return () + cleanUp listenerTid where catchCtrlC UserInterrupt = Just () catchCtrlC _ = Nothing + cleanUp tid = do mbltid <- tryTakeMVar tid + case mbltid of + Just t -> killThread t + _ -> return () + bailOut tid m ms = do cleanUp tid + error $ "\n*** hArduino:ERROR: " ++ intercalate "\n*** " (m:ms) -- | Send down a request. send :: Request -> Arduino () @@ -90,10 +115,14 @@ recv = do ch <- gets deviceChannel liftIO $ readChan ch +-- | Receive a sys-ex response with time-out. This is a blocking call, and will wait until +-- either the time-out expires or the message is received +recvTimeOut :: Int -> Arduino (Maybe Response) +recvTimeOut n = do ch <- gets deviceChannel + liftIO $ timeout n (readChan ch) + -- | Start a thread to listen to the board and populate the channel with incoming queries. --- NB. This function is run in a thread; so be careful not to throw error or die otherwise --- in here. -setupListener :: Arduino () +setupListener :: Arduino ThreadId setupListener = do serial <- gets port dbg <- gets message @@ -118,7 +147,20 @@ Right nonSysEx -> unpackageNonSysEx getBytes nonSysEx case resp of Unimplemented{} -> dbg $ "Ignoring the received response: " ++ show resp - DigitalMessage p l h -> do dbg $ "Updating port " ++ show p ++ " values with " ++ showByteList [l,h] + AnalogMessage mp l h -> modifyMVar_ bs $ \bst -> + do -- the mp is indexed at 0; need to find the mapping + let BoardCapabilities caps = boardCapabilities bst + mbP = listToMaybe [mappedPin | (mappedPin, (Just mp', _)) <- M.assocs caps, pinNo mp == mp'] + case mbP of + Nothing -> return bst -- Mapping hasn't happened yet + Just p -> do + let v = (128 * fromIntegral (h .&. 0x07) + fromIntegral (l .&. 0x7f)) :: Int + case pinValue `fmap` (p `M.lookup` pinStates bst) of + Just (Just (Right v')) + | abs (v - v') < 10 -> return () -- be quiet, otherwise prints too much + _ -> dbg $ "Updating analog pin " ++ show p ++ " values with " ++ showByteList [l,h] ++ " (" ++ show v ++ ")" + return bst{ pinStates = M.insert p PinData{pinMode = ANALOG, pinValue = Just (Right v)} (pinStates bst) } + DigitalMessage p l h -> do dbg $ "Updating digital port " ++ show p ++ " values with " ++ showByteList [l,h] modifyMVar_ bs $ \bst -> do let upd o od | p /= pinPort o = od -- different port, no change | pinMode od `notElem` [INPUT] = od -- not an input pin, ignore @@ -137,37 +179,55 @@ bs <- gets boardState tid <- liftIO $ forkIO $ forever (listener bs) debug $ "Started listener thread: " ++ show tid + return tid --- | Initialize our board, get capabilities, etc -initialize :: Arduino () -initialize = do - -- Step 1: Set up the listener thread - setupListener +-- | Initialize our board, get capabilities, etc. Returns True if initialization +-- went OK, False if not. +initialize :: MVar ThreadId -> Arduino Bool +initialize ltid = do + -- Step 0: Set up the listener thread + tid <- setupListener + liftIO $ putMVar ltid tid + -- Step 1: Send a reset to get things going + send SystemReset -- Step 2: Send query-firmware, and wait until we get a response - handshake QueryFirmware - (\r -> case r of {Firmware{} -> True; _ -> False}) - (\(Firmware v1 v2 m) -> modify (\s -> s{firmataID = "Firmware v" ++ show v1 ++ "." ++ show v2 ++ "(" ++ m ++ ")"})) - -- Step 3: Send a capabilities request - handshake CapabilityQuery - (\r -> case r of {Capabilities{} -> True; _ -> False}) - (\(Capabilities c) -> modify (\s -> s{capabilities = c})) - -- Step 4: Send analog-mapping query - handshake AnalogMappingQuery - (\r -> case r of {AnalogMapping{} -> True; _ -> False}) - (\(AnalogMapping bs) -> do BoardCapabilities m <- gets capabilities - modify (\s -> s{capabilities = BoardCapabilities (M.mapWithKey (mapAnalog bs) m)})) - -- We're done, print capabilities in debug mode - cs <- gets capabilities - dbg <- gets message - liftIO $ dbg $ "Handshake complete. Board capabilities:\n" ++ show cs - where handshake msg isOK process = do + -- To accommodate for the case when standard-Firmata may not be running, + -- we will time out after 10 seconds of waiting, which should be plenty + mbTo <- handshake QueryFirmware (Just (5000000 :: Int)) + (\r -> case r of {Firmware{} -> True; _ -> False}) + (\(Firmware v1 v2 m) -> modify (\s -> s{firmataID = "Firmware v" ++ show v1 ++ "." ++ show v2 ++ "(" ++ m ++ ")"})) + case mbTo of + Nothing -> return False -- timed out + Just () -> do -- Step 3: Send a capabilities request + _ <- handshake CapabilityQuery Nothing + (\r -> case r of {Capabilities{} -> True; _ -> False}) + (\(Capabilities c) -> modify (\s -> s{capabilities = c})) + -- Step 4: Send analog-mapping query + _ <- handshake AnalogMappingQuery Nothing + (\r -> case r of {AnalogMapping{} -> True; _ -> False}) + (\(AnalogMapping as) -> do BoardCapabilities m <- gets capabilities + -- need to put capabilities to both outer and inner state + let caps = BoardCapabilities (M.mapWithKey (mapAnalog as) m) + modify (\s -> s{capabilities = caps}) + bs <- gets boardState + liftIO $ modifyMVar_ bs $ \bst -> return bst{boardCapabilities = caps}) + -- We're done, print capabilities in debug mode + caps <- gets capabilities + dbg <- gets message + liftIO $ dbg $ "Handshake complete. Board capabilities:\n" ++ show caps + return True + where handshake msg mbTOut isOK process = do dbg <- gets message send msg - let wait = do resp <- recv - if isOK resp - then process resp - else do liftIO $ dbg $ "Skpping unexpected response: " ++ show resp - wait + let wait = do mbResp <- case mbTOut of + Nothing -> Just `fmap` recv + Just n -> recvTimeOut n + case mbResp of + Nothing -> return Nothing + Just resp -> if isOK resp + then Just `fmap` process resp + else do liftIO $ dbg $ "Skipping unexpected response: " ++ show resp + wait wait mapAnalog bs p c | i < rl && m /= 0x7f diff --git a/System/Hardware/Arduino/Data.hs b/System/Hardware/Arduino/Data.hs --- a/System/Hardware/Arduino/Data.hs +++ b/System/Hardware/Arduino/Data.hs @@ -12,10 +12,11 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} module System.Hardware.Arduino.Data where import Control.Applicative (Applicative) -import Control.Concurrent (Chan, MVar, modifyMVar, modifyMVar_, readMVar) +import Control.Concurrent (Chan, MVar, modifyMVar, modifyMVar_, withMVar, ThreadId) import Control.Monad.State (StateT, MonadIO, MonadState, gets, liftIO) import Data.Bits ((.&.), (.|.), setBit) import Data.List (intercalate) @@ -71,13 +72,15 @@ deriving (Eq, Show, Enum) -- | A request, as sent to Arduino -data Request = QueryFirmware -- ^ Query the Firmata version installed +data Request = SystemReset -- ^ Send system reset + | QueryFirmware -- ^ Query the Firmata version installed | CapabilityQuery -- ^ Query the capabilities of the board | AnalogMappingQuery -- ^ Query the mapping of analog pins | SetPinMode Pin PinMode -- ^ Set the mode on a pin | DigitalReport Port Bool -- ^ Digital report values on port enable/disable | AnalogReport Pin Bool -- ^ Analog report values on pin enable/disable | DigitalPortWrite Port Word8 Word8 -- ^ Set the values on a port digitally + | SamplingInterval Word8 Word8 -- ^ Set the sampling interval deriving Show -- | A response, as returned from the Arduino @@ -85,6 +88,7 @@ | Capabilities BoardCapabilities -- ^ Capabilities report | AnalogMapping [Word8] -- ^ Analog pin mappings | DigitalMessage Port Word8 Word8 -- ^ Status of a port + | AnalogMessage Pin Word8 Word8 -- ^ Status of an analog pin | Unimplemented (Maybe String) [Word8] -- ^ Represents messages currently unsupported instance Show Response where @@ -92,6 +96,7 @@ show (Capabilities b) = "Capabilities:\n" ++ show b show (AnalogMapping bs) = "AnalogMapping: " ++ showByteList bs show (DigitalMessage p l h) = "DigitalMessage " ++ show p ++ " = " ++ showByte l ++ " " ++ showByte h + show (AnalogMessage p l h) = "AnalogMessage " ++ show p ++ " = " ++ showByte l ++ " " ++ showByte h show (Unimplemented mbc bs) = "Unimplemeneted " ++ fromMaybe "" mbc ++ " " ++ showByteList bs -- | Resolution, as referred to in http://firmata.org/wiki/Protocol#Capability_Query @@ -118,22 +123,54 @@ } deriving Show +-- | LCD's connected to the board +newtype LCD = LCD Int + deriving (Eq, Ord, Show) + +-- | Hitachi LCD controller: See: . +-- We model only the 4-bit variant, with RS and EN lines only. (The most common Arduino usage.) +-- The data sheet can be seen at: . +data LCDController = Hitachi44780 { + lcdRS :: Pin -- ^ Hitachi pin @ 4@: Register-select + , lcdEN :: Pin -- ^ Hitachi pin @ 6@: Enable + , lcdD4 :: Pin -- ^ Hitachi pin @11@: Data line @4@ + , lcdD5 :: Pin -- ^ Hitachi pin @12@: Data line @5@ + , lcdD6 :: Pin -- ^ Hitachi pin @13@: Data line @6@ + , lcdD7 :: Pin -- ^ Hitachi pin @14@: Data line @7@ + , lcdRows :: Int -- ^ Number of rows (typically 1 or 2, upto 4) + , lcdCols :: Int -- ^ Number of cols (typically 16 or 20, upto 40) + , dotMode5x10 :: Bool -- ^ Set to True if 5x10 dots are used + } + deriving Show + +-- | State of the LCD, a mere 8-bit word for the Hitachi +data LCDData = LCDData { + lcdDisplayMode :: Word8 -- ^ Display mode (left/right/scrolling etc.) + , lcdDisplayControl :: Word8 -- ^ Display control (blink on/off, display on/off etc.) + , lcdGlyphCount :: Word8 -- ^ Count of custom created glyphs (typically at most 8) + , lcdController :: LCDController -- ^ Actual controller + } + -- | State of the board data BoardState = BoardState { - analogReportingPins :: S.Set Pin -- ^ Which analog pins are reporting - , digitalReportingPins :: S.Set Pin -- ^ Which digital pins are reporting - , pinStates :: M.Map Pin PinData -- ^ For-each pin, store its data - , digitalWakeUpQueue :: [MVar ()] -- ^ Semaphore list to wake-up upon receiving a digital message for this pin + boardCapabilities :: BoardCapabilities -- ^ Capabilities of the board + , analogReportingPins :: S.Set Pin -- ^ Which analog pins are reporting + , digitalReportingPins :: S.Set Pin -- ^ Which digital pins are reporting + , pinStates :: M.Map Pin PinData -- ^ For-each pin, store its data + , digitalWakeUpQueue :: [MVar ()] -- ^ Semaphore list to wake-up upon receiving a digital message + , lcds :: M.Map LCD LCDData -- ^ LCD's attached to the board } -- | State of the computation data ArduinoState = ArduinoState { - message :: String -> IO () -- ^ Current debugging routine - , port :: SerialPort -- ^ Serial port we are communicating on - , firmataID :: String -- ^ The ID of the board (as identified by the Board itself) - , capabilities :: BoardCapabilities -- ^ Capabilities of the board - , boardState :: MVar BoardState -- ^ Current state of the board - , deviceChannel :: Chan Response -- ^ Incoming messages from the board + message :: String -> IO () -- ^ Current debugging routine + , bailOut :: forall a. String -> [String] -> IO a -- ^ Clean-up and quit with a hopefully informative message + , port :: SerialPort -- ^ Serial port we are communicating on + , firmataID :: String -- ^ The ID of the board (as identified by the Board itself) + , boardState :: MVar BoardState -- ^ Current state of the board + , deviceChannel :: Chan Response -- ^ Incoming messages from the board + , capabilities :: BoardCapabilities -- ^ Capabilities of the board + , listenerTid :: MVar ThreadId -- ^ ThreadId of the listener } -- | The Arduino monad. @@ -145,6 +182,11 @@ debug s = do f <- gets message liftIO $ f s +-- | Bailing out: print the given string on stdout and die +die :: String -> [String] -> Arduino a +die m ms = do f <- gets bailOut + liftIO $ f m ms + -- | Which modes does this pin support? getPinModes :: Pin -> Arduino [PinMode] getPinModes p = do @@ -157,11 +199,12 @@ getPinData :: Pin -> Arduino PinData getPinData p = do bs <- gets boardState - bst <- liftIO $ readMVar bs - case p `M.lookup` pinStates bst of - Nothing -> die ("Trying to access " ++ show p ++ " without proper configuration.") - ["Make sure that you use 'setPinMode' to configure this pin first."] - Just pd -> return pd + err <- gets bailOut + liftIO $ withMVar bs $ \bst -> + case p `M.lookup` pinStates bst of + Nothing -> err ("Trying to access " ++ show p ++ " without proper configuration.") + ["Make sure that you use 'setPinMode' to configure this pin first."] + Just pd -> return pd -- | Given a pin, collect the digital value corresponding to the -- port it belongs to, where the new value of the current pin is given @@ -185,11 +228,7 @@ [b0, b1, b2, b3, b4, b5, b6, b7] = map getVal [0 .. 7] lsb = foldr (\(i, b) m -> if b then m `setBit` i else m) 0 (zip [0..] [b0, b1, b2, b3, b4, b5, b6]) msb = foldr (\(i, b) m -> if b then m `setBit` (i-7) else m) 0 (zip [7..] [b7]) - -- update internal-value of the pin - let bst' = bst {pinStates = M.insertWith (\_ o -> o{pinValue = Just (Left newValue)}) - curPin - PinData{pinMode = OUTPUT, pinValue = Just (Left newValue)} - (pinStates bst)} + bst' = bst{pinStates = M.insert curPin PinData{pinMode = OUTPUT, pinValue = Just (Left newValue)}(pinStates bst)} return (bst', (lsb, msb)) -- | Keep track of listeners on a digital message @@ -316,11 +355,42 @@ -> die ("Invalid mode " ++ show m ++ " set for " ++ show p) ["Supported modes for this pin are: " ++ unwords (if null ms then ["NONE"] else map show ms)] _ -> return () - -- register the pin mode + -- see if there was a mode already set for this pin + bs <- gets boardState + mbOldMode <- liftIO $ withMVar bs $ \bst -> + case p `M.lookup` pinStates bst of + Nothing -> return Nothing -- completely new, register + Just pd -> return $ Just $ pinMode pd + -- depending on old/new mode, determine what actions to take + let registerNewMode = modifyMVar_ bs $ \bst -> return bst{pinStates = M.insert p PinData{pinMode = m, pinValue = Nothing} (pinStates bst) } + case mbOldMode of + Nothing -> do liftIO registerNewMode + getModeActions p m + Just m' | m == m' -> return [] -- no mode change, nothing to do + | True -> do liftIO registerNewMode + remActs <- getRemovalActions p m' + addActs <- getModeActions p m + return $ remActs ++ addActs + +-- | A mode was removed from this pin, update internal state and determine any necessary actions to remove it +getRemovalActions :: Pin -> PinMode -> Arduino [Request] +getRemovalActions p INPUT = do -- This pin is no longer digital input bs <- gets boardState - liftIO $ modifyMVar_ bs $ \bst -> return bst{pinStates = M.insert p PinData{pinMode = m, pinValue = Nothing} (pinStates bst) } - -- now return extra actions we need to take for this mode - getModeActions p m + liftIO $ modifyMVar bs $ \bst -> do + let dPins = p `S.delete` digitalReportingPins bst + port = pinPort p + acts = [DigitalReport port False | port `notElem` map pinPort (S.elems dPins)] -- no need for a digital report on this port anymore + bst' = bst { digitalReportingPins = dPins } + return (bst', acts) +getRemovalActions p ANALOG = do -- This pin is no longer analog + bs <- gets boardState + liftIO $ modifyMVar bs $ \bst -> do + let aPins = analogReportingPins bst + acts = [AnalogReport p False | p `S.member` aPins] -- no need for an analog report on this port anymore + bst' = bst { analogReportingPins = p `S.delete` aPins } + return (bst', acts) +getRemovalActions _ OUTPUT = return [] +getRemovalActions p m = die ("hArduino: getRemovalActions: TBD: Unsupported mode: " ++ show m) ["On pin " ++ show p] -- | Depending on a mode-set call, determine what further -- actions should be executed, such as enabling/disabling pin/port reporting @@ -349,4 +419,5 @@ , digitalReportingPins = dPins } return (bst', acts1 ++ acts2) -getModeActions _ _ = return [] +getModeActions _ OUTPUT = return [] +getModeActions p m = die ("hArduino: getModeActions: TBD: Unsupported mode: " ++ show m) ["On pin " ++ show p] diff --git a/System/Hardware/Arduino/Examples/Blink.hs b/System/Hardware/Arduino/Examples/Blink.hs deleted file mode 100644 --- a/System/Hardware/Arduino/Examples/Blink.hs +++ /dev/null @@ -1,36 +0,0 @@ -------------------------------------------------------------------------------- --- | --- Module : System.Hardware.Arduino.Examples.Blink --- Copyright : (c) Levent Erkok --- License : BSD3 --- Maintainer : erkokl@gmail.com --- Stability : experimental --- --- The /hello world/ of the arduino world, blinking the led. -------------------------------------------------------------------------------- - -module System.Hardware.Arduino.Examples.Blink where - -import Control.Monad (forever) -import Control.Monad.Trans (liftIO) -import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout) - -import System.Hardware.Arduino - --- | Blink the led connected to port 13 on the Arduino UNO board. --- The blinking will synchronize with the printing of a dot on stdout. --- --- Depending on your set-up, you will need to change the path to the --- USB board. If you have problems, try changing the first argument --- to 'True' in the call to 'withArduino', which will hopefully print --- a useful diagnostic message. -blink :: IO () -blink = withArduino False "/dev/cu.usbmodemfd131" $ do - liftIO $ hSetBuffering stdout NoBuffering - let led = pin 13 - setPinMode led OUTPUT - forever $ do liftIO $ putStr "." - digitalWrite led True - delay 1000 - digitalWrite led False - delay 1000 diff --git a/System/Hardware/Arduino/Examples/Switch.hs b/System/Hardware/Arduino/Examples/Switch.hs deleted file mode 100644 --- a/System/Hardware/Arduino/Examples/Switch.hs +++ /dev/null @@ -1,49 +0,0 @@ -------------------------------------------------------------------------------- --- | --- Module : System.Hardware.Arduino.Examples.Switch --- Copyright : (c) Levent Erkok --- License : BSD3 --- Maintainer : erkokl@gmail.com --- Stability : experimental --- --- Reads the value of a push-button switch and displays it continuously -------------------------------------------------------------------------------- - -module System.Hardware.Arduino.Examples.Switch where - -import Control.Monad.Trans (liftIO) -import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout) - -import System.Hardware.Arduino - --- | Read the value of a push-button switch (NO - normally open) --- connected to input pin 2 on the Arduino. We will continuously --- monitor and print the value as it changes. Also, we'll turn --- the led on pin 7 on when the switch is pressed. --- --- The wiring diagram is fairly straightforward: --- --- Switch: ~10K pull-down resistor, between pin 2 and GND --- Push-button NO-switch (normally open) between pin-2 and 5V --- --- Led : ~10K pull-down resistor between pin-7 and led+ --- Led between GND and the resistor --- --- Don't neglect the resistors to make sure you don't do a short-circuit! -switch :: IO () -switch = withArduino False "/dev/cu.usbmodemfd131" $ do - liftIO $ hSetBuffering stdout NoBuffering - setPinMode led OUTPUT - setPinMode button INPUT - current <- digitalRead button - report (not current) current - go current - where button = pin 2 - led = pin 7 - report prev new - | prev /= new = do liftIO $ putStrLn $ "Button is currently " ++ if new then "ON" else "OFF" - digitalWrite led new - | True = return () - go prev = do new <- waitFor button - report prev new - go new diff --git a/System/Hardware/Arduino/Firmata.hs b/System/Hardware/Arduino/Firmata.hs --- a/System/Hardware/Arduino/Firmata.hs +++ b/System/Hardware/Arduino/Firmata.hs @@ -6,11 +6,165 @@ -- Maintainer : erkokl@gmail.com -- Stability : experimental -- --- The Firmata protocol, as implemented in Haskell. --- See: www.firmata.org +-- Implementation of the firmata protocol ------------------------------------------------------------------------------- -module System.Hardware.Arduino.Firmata - (module System.Hardware.Arduino.Firmata.Basics) - where -import System.Hardware.Arduino.Firmata.Basics +{-# LANGUAGE NamedFieldPuns #-} +module System.Hardware.Arduino.Firmata where + +import Control.Concurrent (newEmptyMVar, readMVar) +import Control.Monad (when, unless, void) +import Control.Monad.Trans (liftIO) +import Data.Bits ((.&.), shiftR) +import Data.Word (Word8) + +import System.Hardware.Arduino.Data +import System.Hardware.Arduino.Comm +import qualified System.Hardware.Arduino.Utils as U + +-- | Retrieve the Firmata firmware version running on the Arduino. The first +-- component is the major, second is the minor. The final value is a human +-- readable identifier for the particular board. +queryFirmware :: Arduino (Word8, Word8, String) +queryFirmware = do + send QueryFirmware + r <- recv + case r of + Firmware v1 v2 m -> return (v1, v2, m) + _ -> die "queryFirmware: Got unexpected response for query firmware call: " [show r] + +-- | Delay the computaton for a given number of milli-seconds +delay :: Int -> Arduino () +delay = liftIO . U.delay + +-- | Set the mode on a particular pin on the board +setPinMode :: Pin -> PinMode -> Arduino () +setPinMode p m = do + extras <- registerPinMode p m + send $ SetPinMode p m + mapM_ send extras + +-- | Set or clear a digital pin on the board +digitalWrite :: Pin -> Bool -> Arduino () +digitalWrite p v = do + -- first make sure we have this pin set as output + pd <- getPinData p + when (pinMode pd /= OUTPUT) $ die ("Invalid digitalWrite call on pin " ++ show p) + [ "The current mode for this pin is: " ++ show (pinMode pd) + , "For digitalWrite, it must be set to: " ++ show OUTPUT + , "via a proper call to setPinMode" + ] + case pinValue pd of + Just (Left b) | b == v -> return () -- no change, nothing to do + _ -> do (lsb, msb) <- computePortData p v + send $ DigitalPortWrite (pinPort p) lsb msb + +-- | Turn on/off internal pull-up resistor on an input pin +pullUpResistor :: Pin -> Bool -> Arduino () +pullUpResistor p v = do + -- first make sure we have this pin set as input + pd <- getPinData p + when (pinMode pd /= INPUT) $ die ("Invalid turnOnPullUpResistor call on pin " ++ show p) + [ "The current mode for this pin is: " ++ show (pinMode pd) + , "For turnOnPullUpResistor, it must be set to: " ++ show INPUT + , "via a proper call to setPinMode" + ] + (lsb, msb) <- computePortData p v + send $ DigitalPortWrite (pinPort p) lsb msb + +-- | Read the value of a pin in digital mode; this is a non-blocking call, returning +-- the current value immediately. See 'waitFor' for a version that waits for a change +-- in the pin first. +digitalRead :: Pin -> Arduino Bool +digitalRead p = do + -- first make sure we have this pin set as input + pd <- getPinData p + when (pinMode pd /= INPUT) $ die ("Invalid digitalRead call on pin " ++ show p) + [ "The current mode for this pin is: " ++ show (pinMode pd) + , "For digitalWrite, it must be set to: " ++ show INPUT + , "via a proper call to setPinMode" + ] + return $ case pinValue pd of + Just (Left v) -> v + _ -> False -- no (correctly-typed) value reported yet, default to False + +-- | Wait for a change in the value of the digital input pin. Returns the new value. +-- Note that this is a blocking call. For a non-blocking version, see 'digitalRead', which returns the current +-- value of a pin immediately. +waitFor :: Pin -> Arduino Bool +waitFor p = head `fmap` waitAny [p] + +-- | Wait for a change in any of the given pins. Once a change is detected, all the new values are +-- returned. Similar to 'waitFor', but is useful when we are watching multiple digital inputs. +waitAny :: [Pin] -> Arduino [Bool] +waitAny ps = map snd `fmap` waitGeneric ps + +-- | Wait for any of the given pins to go from low to high. If all of the pins are high to start +-- with, then we first wait for one of them to go low, and then wait for one of them to go back high. +-- Returns the new values. +waitAnyHigh :: [Pin] -> Arduino [Bool] +waitAnyHigh ps = do + curVals <- mapM digitalRead ps + when (and curVals) $ void $ waitAnyLow ps -- all are H to start with, wait for at least one to go low + vs <- waitGeneric ps -- wait for some change + if (False, True) `elem` vs + then return $ map snd vs + else waitAnyHigh ps + +-- | Wait for any of the given pins to go from high to low. If all of the pins are low to start +-- with, then we first wait for one of them to go high, and then wait for one of them to go back low. +-- Returns the new values. +waitAnyLow :: [Pin] -> Arduino [Bool] +waitAnyLow ps = do + curVals <- mapM digitalRead ps + unless (or curVals) $ void $ waitAnyHigh ps -- all are L to start with, wait for at least one to go high + vs <- waitGeneric ps -- wait for some change + if (True, False) `elem` vs + then return $ map snd vs + else waitAnyLow ps + +-- | A utility function, waits for any change on any given pin +-- and returns both old and new values. It's guaranteed that +-- at least one returned pair have differing values. +waitGeneric :: [Pin] -> Arduino [(Bool, Bool)] +waitGeneric ps = do + curVals <- mapM digitalRead ps + semaphore <- liftIO newEmptyMVar + let wait = do digitalWakeUp semaphore + liftIO $ readMVar semaphore + newVals <- mapM digitalRead ps + if curVals == newVals + then wait + else return $ zip curVals newVals + wait + +-- | Read the value of a pin in analog mode; this is a non-blocking call, immediately +-- returning the last sampled value. It returns @0@ if the voltage on the pin +-- is 0V, and @1023@ if it is 5V, properly scaled. (See `setAnalogSamplingInterval` for +-- sampling frequency.) +analogRead :: Pin -> Arduino Int +analogRead p = do + -- first make sure we have this pin set as analog + pd <- getPinData p + when (pinMode pd /= ANALOG) $ die ("Invalid analogRead call on pin " ++ show p) + [ "The current mode for this pin is: " ++ show (pinMode pd) + , "For analogRead, it must be set to: " ++ show ANALOG + , "via a proper call to setPinMode" + ] + return $ case pinValue pd of + Just (Right v) -> v + _ -> 0 -- no (correctly-typed) value reported yet, default to False + +-- | Set the analog sampling interval, in milliseconds. Arduino uses a default of 19ms to sample analog and I2C +-- signals, which is fine for many applications, but can be modified if needed. The argument +-- should be a number between @10@ and @16384@; @10@ being the minumum sampling interval supported by Arduino +-- and @16383@ being the largest value we can represent in 14 bits that this message can handle. (Note that +-- the largest value is just about @16@ seconds, which is plenty infrequent for all practical needs.) +setAnalogSamplingInterval :: Int -> Arduino () +setAnalogSamplingInterval i + | i < 10 || i > 16383 + = die ("hArduino: setAnalogSamplingInterval: Allowed interval is [10, 16383] ms, received: " ++ show i) [] + | True + = send $ SamplingInterval (fromIntegral lsb) (fromIntegral msb) + where lsb = i .&. 0x7f + msb = (i `shiftR` 7) .&. 0x7f diff --git a/System/Hardware/Arduino/Firmata/Basics.hs b/System/Hardware/Arduino/Firmata/Basics.hs deleted file mode 100644 --- a/System/Hardware/Arduino/Firmata/Basics.hs +++ /dev/null @@ -1,93 +0,0 @@ -------------------------------------------------------------------------------- --- | --- Module : System.Hardware.Arduino.Firmata.Basics --- Copyright : (c) Levent Erkok --- License : BSD3 --- Maintainer : erkokl@gmail.com --- Stability : experimental --- --- Basic components of the firmata protocol -------------------------------------------------------------------------------- - -{-# LANGUAGE NamedFieldPuns #-} -module System.Hardware.Arduino.Firmata.Basics where - -import Control.Concurrent (newEmptyMVar, readMVar) -import Control.Monad (when) -import Control.Monad.Trans (liftIO) -import Data.Word (Word8) - -import System.Hardware.Arduino.Data -import System.Hardware.Arduino.Comm -import qualified System.Hardware.Arduino.Utils as U - --- | Retrieve the Firmata firmware version running on the Arduino. The first --- component is the major, second is the minor. The final value is a human --- readable identifier for the particular board. -queryFirmware :: Arduino (Word8, Word8, String) -queryFirmware = do - send QueryFirmware - r <- recv - case r of - Firmware v1 v2 m -> return (v1, v2, m) - _ -> error $ "queryFirmware: Got unexpected response for query firmware call: " ++ show r - --- | Delay the computaton for a given number of milli-seconds -delay :: Int -> Arduino () -delay = liftIO . U.delay - --- | Set the mode on a particular pin on the board -setPinMode :: Pin -> PinMode -> Arduino () -setPinMode p m = do - extras <- registerPinMode p m - send $ SetPinMode p m - mapM_ send extras - --- | Set or clear a digital pin on the board -digitalWrite :: Pin -> Bool -> Arduino () -digitalWrite p v = do - -- first make sure we have this pin set as output - pd <- getPinData p - when (pinMode pd /= OUTPUT) $ U.die ("Invalid digitalWrite call on pin " ++ show p) - [ "The current mode for this pin is: " ++ show (pinMode pd) - , "For digitalWrite, it must be set to: " ++ show OUTPUT - , "via a proper call to setPinMode" - ] - (lsb, msb) <- computePortData p v - send $ DigitalPortWrite (pinPort p) lsb msb - --- | Read the value of a pin in digital mode; this is a non-blocking call, returning --- the current value immediately. See 'waitFor' for a version that waits for a change --- in the pin first. -digitalRead :: Pin -> Arduino Bool -digitalRead p = do - -- first make sure we have this pin set as input - pd <- getPinData p - when (pinMode pd /= INPUT) $ U.die ("Invalid digitalRead call on pin " ++ show p) - [ "The current mode for this pin is: " ++ show (pinMode pd) - , "For digitalWrite, it must be set to: " ++ show INPUT - , "via a proper call to setPinMode" - ] - return $ case pinValue pd of - Just (Left v) -> v - _ -> False -- no (correctly-typed) value reported yet, default to False - --- | Wait for a change in the value of the digital input pin. Returns the new value. --- Note that this is a blocking call. For a non-blocking version, see 'digitalRead', which returns the current --- value of a pin immediately. -waitFor :: Pin -> Arduino Bool -waitFor p = do - curVal <- digitalRead p - let wait = do sleepTillDigitalMessage - newVal <- digitalRead p - if newVal == curVal - then wait - else return newVal - wait - --- | Sleep until we receive a digital message from the board -sleepTillDigitalMessage :: Arduino () -sleepTillDigitalMessage = do - semaphore <- liftIO newEmptyMVar - digitalWakeUp semaphore - liftIO $ readMVar semaphore diff --git a/System/Hardware/Arduino/LCD.hs b/System/Hardware/Arduino/LCD.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/LCD.hs @@ -0,0 +1,432 @@ +------------------------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.LCD +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- LCD (Liquid Crystal Display) parts supported by hArduino. The Haskell code +-- below has partly been implemented following the Arduino LiquidCrystal project +-- source code: +-- +-- The Hitachi44780 data sheet is at: +-- +-- For an example program using this library, see "System.Hardware.Arduino.SamplePrograms.LCD". +------------------------------------------------------------------------------------------------- + +{-# LANGUAGE NamedFieldPuns #-} +module System.Hardware.Arduino.LCD( + -- * LCD types and registration + LCDController(..), lcdRegister + -- * Writing text on the LCD + , lcdClear, lcdWrite + -- * Moving the cursor + , lcdHome, lcdSetCursor + -- * Scrolling + , lcdAutoScrollOn, lcdAutoScrollOff + , lcdScrollDisplayLeft, lcdScrollDisplayRight + -- * Display properties + , lcdLeftToRight, lcdRightToLeft + , lcdBlinkOn, lcdBlinkOff + , lcdCursorOn, lcdCursorOff + , lcdDisplayOn, lcdDisplayOff + -- * Accessing internal symbols, + , LCDSymbol, lcdInternalSymbol, lcdWriteSymbol + -- Creating custom symbols + , lcdCreateSymbol + -- * Misc helpers + , lcdFlash + ) where + +import Control.Concurrent (modifyMVar, withMVar) +import Control.Monad (when) +import Control.Monad.State (gets, liftIO) +import Data.Bits (testBit, (.|.), (.&.), setBit, clearBit, shiftL, bit) +import Data.Char (ord, isSpace) +import Data.Maybe (fromMaybe) +import Data.Word (Word8) + +import qualified Data.Map as M + +import System.Hardware.Arduino.Data +import System.Hardware.Arduino.Firmata + +import qualified System.Hardware.Arduino.Utils as U + +--------------------------------------------------------------------------------------- +-- Low level interface, not available to the user +--------------------------------------------------------------------------------------- + +-- | Commands understood by Hitachi +data Cmd = LCD_INITIALIZE + | LCD_INITIALIZE_END + | LCD_FUNCTIONSET + | LCD_DISPLAYCONTROL Word8 + | LCD_CLEARDISPLAY + | LCD_ENTRYMODESET Word8 + | LCD_RETURNHOME + | LCD_SETDDRAMADDR Word8 + | LCD_CURSORSHIFT Word8 + | LCD_SETCGRAMADDR Word8 + +-- | Convert a command to a data-word +getCmdVal :: LCDController -> Cmd -> Word8 +getCmdVal Hitachi44780{lcdRows, dotMode5x10} = get + where multiLine -- bit 3 + | lcdRows > 1 = 0x08 :: Word8 + | True = 0x00 :: Word8 + dotMode -- bit 2 + | dotMode5x10 = 0x04 :: Word8 + | True = 0x00 :: Word8 + displayFunction = multiLine .|. dotMode + get LCD_INITIALIZE = 0x33 + get LCD_INITIALIZE_END = 0x32 + get LCD_FUNCTIONSET = 0x20 .|. displayFunction + get (LCD_DISPLAYCONTROL w) = 0x08 .|. w + get LCD_CLEARDISPLAY = 0x01 + get (LCD_ENTRYMODESET w) = 0x04 .|. w + get LCD_RETURNHOME = 0x02 + get (LCD_SETDDRAMADDR w) = 0x80 .|. w + get (LCD_CURSORSHIFT w) = 0x10 .|. 0x08 .|. w -- NB. LCD_DISPLAYMOVE (0x08) hard coded here + get (LCD_SETCGRAMADDR w) = 0x40 .|. w `shiftL` 3 + +-- | Initialize the LCD. Follows the data sheet , +-- page 46; figure 24. +initLCD :: LCD -> LCDController -> Arduino () +initLCD lcd c@Hitachi44780{lcdRS, lcdEN, lcdD4, lcdD5, lcdD6, lcdD7} = do + debug "Starting the LCD initialization sequence" + mapM_ (`setPinMode` OUTPUT) [lcdRS, lcdEN, lcdD4, lcdD5, lcdD6, lcdD7] + -- Wait for 50ms, data-sheet says at least 40ms for 2.7V version, so be safe + delay 50 + sendCmd c LCD_INITIALIZE + delay 5 + sendCmd c LCD_INITIALIZE_END + sendCmd c LCD_FUNCTIONSET + lcdCursorOff lcd + lcdBlinkOff lcd + lcdLeftToRight lcd + lcdAutoScrollOff lcd + lcdHome lcd + lcdClear lcd + lcdDisplayOn lcd + +-- | Get the controller associated with the LCD +getController :: LCD -> Arduino LCDController +getController lcd = do + bs <- gets boardState + err <- gets bailOut + liftIO $ withMVar bs $ \bst -> case lcd `M.lookup` lcds bst of + Nothing -> err ("hArduino: Cannot locate " ++ show lcd) [] + Just ld -> return $ lcdController ld + +-- | Send a command to the LCD controller +sendCmd :: LCDController -> Cmd -> Arduino () +sendCmd c = transmit False c . getCmdVal c + +-- | Send 4-bit data to the LCD controller +sendData :: LCDController -> Word8 -> Arduino () +sendData lcd n = do debug $ "Transmitting LCD data: " ++ U.showByte n + transmit True lcd n + +-- | By controlling the enable-pin, indicate to the controller that +-- the data is ready for it to process. +pulseEnable :: LCDController -> Arduino () +pulseEnable Hitachi44780{lcdEN} = do + debug "Sending LCD pulseEnable" + digitalWrite lcdEN False + delay 1 + digitalWrite lcdEN True + delay 1 + digitalWrite lcdEN False + delay 1 + +-- | Transmit data down to the LCD +transmit :: Bool -> LCDController -> Word8 -> Arduino () +transmit mode c@Hitachi44780{lcdRS, lcdEN, lcdD4, lcdD5, lcdD6, lcdD7} val = do + digitalWrite lcdRS mode + digitalWrite lcdEN False + let [b7, b6, b5, b4, b3, b2, b1, b0] = [val `testBit` i | i <- [7, 6 .. 0]] + -- Send down the first 4 bits + digitalWrite lcdD4 b4 + digitalWrite lcdD5 b5 + digitalWrite lcdD6 b6 + digitalWrite lcdD7 b7 + pulseEnable c + -- Send down the remaining batch + digitalWrite lcdD4 b0 + digitalWrite lcdD5 b1 + digitalWrite lcdD6 b2 + digitalWrite lcdD7 b3 + pulseEnable c + +-- | Helper function to simplify library programming, not exposed to the user. +withLCD :: LCD -> String -> (LCDController -> Arduino a) -> Arduino a +withLCD lcd what action = do + debug what + c <- getController lcd + action c + +--------------------------------------------------------------------------------------- +-- High level interface, exposed to the user +--------------------------------------------------------------------------------------- + +-- | Register an LCD controller. When registration is complete, the LCD will be initialized so that: +-- +-- * Set display ON (Use 'lcdDisplayOn' / 'lcdDisplayOff' to change.) +-- +-- * Set cursor OFF (Use 'lcdCursorOn' / 'lcdCursorOff' to change.) +-- +-- * Set blink OFF (Use 'lcdBlinkOn' / 'lcdBlinkOff' to change.) +-- +-- * Clear display (Use 'lcdClear' to clear, 'lcdWrite' to display text.) +-- +-- * Set entry mode left to write (Use 'lcdLeftToRight' / 'lcdRightToLeft' to control.) +-- +-- * Set autoscrolling OFF (Use 'lcdAutoScrollOff' / 'lcdAutoScrollOn' to control.) +-- +-- * Put the cursor into home position (Use 'lcdSetCursor' or 'lcdHome' to move around.) +lcdRegister :: LCDController -> Arduino LCD +lcdRegister controller = do + bs <- gets boardState + lcd <- liftIO $ modifyMVar bs $ \bst -> do + let n = M.size $ lcds bst + ld = LCDData { lcdDisplayMode = 0 + , lcdDisplayControl = 0 + , lcdGlyphCount = 0 + , lcdController = controller + } + return (bst {lcds = M.insert (LCD n) ld (lcds bst)}, LCD n) + case controller of + Hitachi44780{} -> initLCD lcd controller + return lcd + +-- | Write a string on the LCD at the current cursor position +lcdWrite :: LCD -> String -> Arduino () +lcdWrite lcd m = withLCD lcd ("Writing " ++ show m ++ " to LCD") $ \c -> mapM_ (sendData c) m' + where m' = map (\ch -> fromIntegral (ord ch) .&. 0xFF) m + +-- | Clear the LCD +lcdClear :: LCD -> Arduino () +lcdClear lcd = withLCD lcd "Sending clearLCD" $ \c -> + do sendCmd c LCD_CLEARDISPLAY + delay 2 -- give some time to make sure LCD is really cleared + +-- | Send the cursor to home position +lcdHome :: LCD -> Arduino () +lcdHome lcd = withLCD lcd "Sending the cursor home" $ \c -> + do sendCmd c LCD_RETURNHOME + delay 2 + +-- | Set the cursor location. The pair of arguments is the new column and row numbers +-- respectively: +-- +-- * The first value is the column, the second is the row. (This is counter-intuitive, but +-- is in line with what the standard Arduino programmers do, so we follow the same convention.) +-- +-- * Counting starts at 0 (both for column and row no) +-- +-- * If the new location is out-of-bounds of your LCD, we will put it the cursor to the closest +-- possible location on the LCD. +lcdSetCursor :: LCD -> (Int, Int) -> Arduino () +lcdSetCursor lcd (givenCol, givenRow) = withLCD lcd ("Sending the cursor to Row: " ++ show givenRow ++ " Col: " ++ show givenCol) set + where set c@Hitachi44780{lcdRows, lcdCols} = sendCmd c (LCD_SETDDRAMADDR offset) + where align :: Int -> Int -> Word8 + align i m + | i < 0 = 0 + | i >= m = fromIntegral $ m-1 + | True = fromIntegral i + col = align givenCol lcdCols + row = align givenRow lcdRows + -- The magic row-offsets come from various web sources + -- I don't follow the logic in these numbers, but it seems to work + rowOffsets = [(0, 0), (1, 0x40), (2, 0x14), (3, 0x54)] + offset = col + fromMaybe 0x54 (row `lookup` rowOffsets) + +-- | Scroll the display to the left by 1 character. Project idea: Using a tilt sensor, scroll the contents of the display +-- left/right depending on the tilt. +lcdScrollDisplayLeft :: LCD -> Arduino () +lcdScrollDisplayLeft lcd = withLCD lcd "Scrolling display to the left by 1" $ \c -> sendCmd c (LCD_CURSORSHIFT lcdMoveLeft) + where lcdMoveLeft = 0x00 + +-- | Scroll the display to the right by 1 character +lcdScrollDisplayRight :: LCD -> Arduino () +lcdScrollDisplayRight lcd = withLCD lcd "Scrolling display to the right by 1" $ \c -> sendCmd c (LCD_CURSORSHIFT lcdMoveRight) + where lcdMoveRight = 0x04 + +-- | Display characteristics helper, set the new control/mode and send +-- appropriate commands if anything changed +updateDisplayData :: String -> (Word8 -> Word8, Word8 -> Word8) -> LCD -> Arduino () +updateDisplayData what (f, g) lcd = do + debug what + bs <- gets boardState + err <- gets bailOut + ( LCDData {lcdDisplayControl = oldC, lcdDisplayMode = oldM} + , LCDData {lcdDisplayControl = newC, lcdDisplayMode = newM, lcdController = c}) + <- liftIO $ modifyMVar bs $ \bst -> + case lcd `M.lookup` lcds bst of + Nothing -> err ("hArduino: Cannot locate " ++ show lcd) [] + Just ld@LCDData{lcdDisplayControl, lcdDisplayMode} + -> do let ld' = ld { lcdDisplayControl = f lcdDisplayControl + , lcdDisplayMode = g lcdDisplayMode + } + return (bst{lcds = M.insert lcd ld' (lcds bst)}, (ld, ld')) + when (oldC /= newC) $ sendCmd c (LCD_DISPLAYCONTROL newC) + when (oldM /= newM) $ sendCmd c (LCD_ENTRYMODESET newM) + +-- | Update the display control word +updateDisplayControl :: String -> (Word8 -> Word8) -> LCD -> Arduino () +updateDisplayControl what f = updateDisplayData what (f, id) + +-- | Update the display mode word +updateDisplayMode :: String -> (Word8 -> Word8) -> LCD -> Arduino () +updateDisplayMode what g = updateDisplayData what (id, g) + +-- | Various control masks for the Hitachi44780 +data Hitachi44780Mask = LCD_BLINKON -- ^ bit @0@ Controls whether cursor blinks + | LCD_CURSORON -- ^ bit @1@ Controls whether cursor is on + | LCD_DISPLAYON -- ^ bit @2@ Controls whether display is on + | LCD_ENTRYSHIFTINCREMENT -- ^ bit @0@ Controls left/right scroll + | LCD_ENTRYLEFT -- ^ bit @1@ Controls left/right entry mode + +-- | Convert the mask value to the bit no +maskBit :: Hitachi44780Mask -> Int +maskBit LCD_BLINKON = 0 +maskBit LCD_CURSORON = 1 +maskBit LCD_DISPLAYON = 2 +maskBit LCD_ENTRYSHIFTINCREMENT = 0 +maskBit LCD_ENTRYLEFT = 1 + +-- | Clear by the mask +clearMask :: Hitachi44780Mask -> Word8 -> Word8 +clearMask m w = w `clearBit` maskBit m + +-- | Set by the mask +setMask :: Hitachi44780Mask -> Word8 -> Word8 +setMask m w = w `setBit` maskBit m + +-- | Do not blink the cursor +lcdBlinkOff :: LCD -> Arduino () +lcdBlinkOff = updateDisplayControl "Turning blinking off" (clearMask LCD_BLINKON) + +-- | Blink the cursor +lcdBlinkOn :: LCD -> Arduino () +lcdBlinkOn = updateDisplayControl "Turning blinking on" (setMask LCD_BLINKON) + +-- | Hide the cursor. Note that a blinking cursor cannot be hidden, you must first +-- turn off blinking. +lcdCursorOff :: LCD -> Arduino () +lcdCursorOff = updateDisplayControl "Not showing the cursor" (clearMask LCD_CURSORON) + +-- | Show the cursor +lcdCursorOn :: LCD -> Arduino () +lcdCursorOn = updateDisplayControl "Showing the cursor" (setMask LCD_CURSORON) + +-- | Turn the display off. Note that turning the display off does not mean you are +-- powering it down. It simply means that the characters will not be shown until +-- you turn it back on using 'lcdDisplayOn'. (Also, the contents will /not/ be +-- forgotten when you call this function.) Therefore, this function is useful +-- for temporarily hiding the display contents. +lcdDisplayOff :: LCD -> Arduino () +lcdDisplayOff = updateDisplayControl "Turning display off" (clearMask LCD_DISPLAYON) + +-- | Turn the display on +lcdDisplayOn :: LCD -> Arduino () +lcdDisplayOn = updateDisplayControl "Turning display on" (setMask LCD_DISPLAYON) + +-- | Set writing direction: Left to Right +lcdLeftToRight :: LCD -> Arduino () +lcdLeftToRight = updateDisplayMode "Setting left-to-right entry mode" (setMask LCD_ENTRYLEFT) + +-- | Set writing direction: Right to Left +lcdRightToLeft :: LCD -> Arduino () +lcdRightToLeft = updateDisplayMode "Setting right-to-left entry mode" (clearMask LCD_ENTRYLEFT) + +-- | Turn on auto-scrolling. In the context of the Hitachi44780 controller, this means that +-- each time a letter is added, all the text is moved one space to the left. This can be +-- confusing at first: It does /not/ mean that your strings will continuously scroll: +-- It just means that if you write a string whose length exceeds the column-count +-- of your LCD, then you'll see the tail-end of it. (Of course, this will create a scrolling +-- effect as the string is being printed character by character.) +-- +-- Having said that, it is easy to program a scrolling string program: Simply write your string +-- by calling 'lcdWrite', and then use the 'lcdScrollDisplayLeft' and 'lcdScrollDisplayRight' functions +-- with appropriate delays to simulate the scrolling. +lcdAutoScrollOn :: LCD -> Arduino () +lcdAutoScrollOn = updateDisplayMode "Setting auto-scroll ON" (setMask LCD_ENTRYSHIFTINCREMENT) + +-- | Turn off auto-scrolling. See the comments for 'lcdAutoScrollOn' for details. When turned +-- off (which is the default), you will /not/ see the characters at the end of your strings that +-- do not fit into the display. +lcdAutoScrollOff :: LCD -> Arduino () +lcdAutoScrollOff = updateDisplayMode "Setting auto-scroll OFF" (clearMask LCD_ENTRYSHIFTINCREMENT) + +-- | Flash contents of the LCD screen +lcdFlash :: LCD + -> Int -- ^ Flash count + -> Int -- ^ Delay amount (in milli-seconds) + -> Arduino () +lcdFlash lcd n d = sequence_ $ concat $ replicate n [lcdDisplayOff lcd, delay d, lcdDisplayOn lcd, delay d] + +-- | An abstract symbol type for user created symbols +newtype LCDSymbol = LCDSymbol Word8 + +-- | Create a custom symbol for later display. Note that controllers +-- have limited capability for such symbols, typically storing no more +-- than 8. The behavior is undefined if you create more symbols than your +-- LCD can handle. +-- +-- The input is a simple description of the glyph, as a list of precisely 8 +-- strings, each of which must have 5 characters. Any space character is +-- interpreted as a empty pixel, any non-space is a full pixel, corresponding +-- to the pixel in the 5x8 characters we have on the LCD. For instance, here's +-- a happy-face glyph you can use: +-- +-- > +-- > [ " " +-- > , "@ @" +-- > , " " +-- > , " " +-- > , "@ @" +-- > , " @@@ " +-- > , " " +-- > , " " +-- > ] +-- > +lcdCreateSymbol :: LCD -> [String] -> Arduino LCDSymbol +lcdCreateSymbol lcd glyph + | length glyph /= 8 || any (/= 5) (map length glyph) + = die "hArduino: lcdCreateSymbol: Invalid glyph description: must be 8x5!" ("Received:" : glyph) + | True + = do bs <- gets boardState + err <- gets bailOut + (i, c) <- liftIO $ modifyMVar bs $ \bst -> + case lcd `M.lookup` lcds bst of + Nothing -> err ("hArduino: Cannot locate " ++ show lcd) [] + Just ld@LCDData{lcdGlyphCount, lcdController} + -> do let ld' = ld { lcdGlyphCount = lcdGlyphCount + 1 } + return (bst{lcds = M.insert lcd ld' (lcds bst)}, (lcdGlyphCount, lcdController)) + sendCmd c (LCD_SETCGRAMADDR i) + let cvt :: String -> Word8 + cvt s = foldr (.|.) 0 [bit p | (ch, p) <- zip (reverse s) [0..], not (isSpace ch)] + mapM_ (sendData c . cvt) glyph + return $ LCDSymbol i + +-- | Display a user created symbol on the LCD. (See 'lcdCreateSymbol' for details.) +lcdWriteSymbol :: LCD -> LCDSymbol -> Arduino () +lcdWriteSymbol lcd (LCDSymbol i) = withLCD lcd ("Writing custom symbol " ++ show i ++ " to LCD") $ \c -> sendData c i + +-- | Access an internally stored symbol, one that is not available via its ASCII equivalent. See +-- the Hitachi datasheet for possible values: , Table 4 on page 17. +-- +-- For instance, to access the symbol right-arrow: +-- +-- * Locate it in the above table: Right-arrow is at the second-to-last row, 7th character from left. +-- +-- * Check the upper/higher bits as specified in the table: For Right-arrow, upper bits are @0111@ and the +-- lower bits are @1110@; which gives us the code @01111110@, or @0x7E@. +-- +-- * So, right-arrow can be accessed by symbol code 'lcdInternalSymbol' @0x7E@, which will give us a 'LCDSymbol' value +-- that can be passed to the 'lcdWriteSymbol' function. The code would look like this: @lcdWriteSymbol lcd (lcdInternalSymbol 0x7E)@. +lcdInternalSymbol :: Word8 -> LCDSymbol +lcdInternalSymbol = LCDSymbol diff --git a/System/Hardware/Arduino/Protocol.hs b/System/Hardware/Arduino/Protocol.hs --- a/System/Hardware/Arduino/Protocol.hs +++ b/System/Hardware/Arduino/Protocol.hs @@ -33,6 +33,7 @@ -- | Package a request as a sequence of bytes to be sent to the board -- using the Firmata protocol. package :: Request -> B.ByteString +package SystemReset = nonSysEx SYSTEM_RESET [] package QueryFirmware = sysEx REPORT_FIRMWARE [] package CapabilityQuery = sysEx CAPABILITY_QUERY [] package AnalogMappingQuery = sysEx ANALOG_MAPPING_QUERY [] @@ -40,6 +41,7 @@ package (DigitalReport p b) = nonSysEx (REPORT_DIGITAL_PORT p) [if b then 1 else 0] package (SetPinMode p m) = nonSysEx SET_PIN_MODE [fromIntegral (pinNo p), fromIntegral (fromEnum m)] package (DigitalPortWrite p l m) = nonSysEx (DIGITAL_MESSAGE p) [l, m] +package (SamplingInterval l m) = sysEx SAMPLING_INTERVAL [l, m] -- | Unpackage a SysEx response unpackageSysEx :: [Word8] -> Response @@ -67,12 +69,14 @@ unpackageNonSysEx :: (Int -> IO [Word8]) -> FirmataCmd -> IO Response unpackageNonSysEx getBytes c = grab c where unimplemented n = Unimplemented (Just (show c)) `fmap` getBytes n - grab (ANALOG_MESSAGE _pin) = unimplemented 2 + grab (ANALOG_MESSAGE p) = getBytes 2 >>= \[l, h] -> return (AnalogMessage p l h) grab (DIGITAL_MESSAGE p) = getBytes 2 >>= \[l, h] -> return (DigitalMessage p l h) + -- we should never see any of the following since they are "request" codes + -- TBD: Maybe we should put them in a different data-type grab (REPORT_ANALOG_PIN _pin) = unimplemented 1 grab (REPORT_DIGITAL_PORT _port) = unimplemented 1 - grab START_SYSEX = unimplemented 0 -- we should never see this + grab START_SYSEX = unimplemented 0 grab SET_PIN_MODE = unimplemented 2 - grab END_SYSEX = unimplemented 0 -- we should never see this + grab END_SYSEX = unimplemented 0 grab PROTOCOL_VERSION = unimplemented 2 grab SYSTEM_RESET = unimplemented 0 diff --git a/System/Hardware/Arduino/SamplePrograms/Analog.hs b/System/Hardware/Arduino/SamplePrograms/Analog.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/Analog.hs @@ -0,0 +1,43 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.Analog +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Reads the value of an analog input, controlled by a 10K potentiometer. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.Analog where + +import Control.Monad (when) +import Control.Monad.Trans (liftIO) + +import System.Hardware.Arduino + +-- | Read the value of an analog input line. We will print the value +-- on the screen, and also blink a led on the Arduino based on the +-- value. The smaller the value, the faster the blink. +-- +-- The circuit simply has a 10K potentiometer between 5V and GND, with +-- the wiper line connected to analog input 3. We also have a led between +-- pin 13 and GND. +-- +-- <> +analogVal :: IO () +analogVal = withArduino False "/dev/cu.usbmodemfd131" $ do + setPinMode led OUTPUT + setPinMode pot ANALOG + cur <- analogRead pot + liftIO $ print cur + go cur + where led = pin 13 + pot = pin 17 -- NB. Analog-3 is pin 17 on the UNO + go cur = do digitalWrite led True + delay cur + digitalWrite led False + delay cur + new <- analogRead pot + when (cur /= new) $ liftIO $ print new + go new diff --git a/System/Hardware/Arduino/SamplePrograms/Blink.hs b/System/Hardware/Arduino/SamplePrograms/Blink.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/Blink.hs @@ -0,0 +1,33 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.Blink +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- The /hello world/ of the arduino world, blinking the led. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.Blink where + +import Control.Monad (forever) + +import System.Hardware.Arduino + +-- | Blink the led connected to port 13 on the Arduino UNO board. +-- +-- Note that you do not need any other components to run this example: Just hook +-- up your Arduino to the computer and make sure StandardFirmata is running on it. +-- However, you can connect a LED between Pin13 and GND if you want to blink an +-- external led as well, as depicted below: +-- +-- <> +blink :: IO () +blink = withArduino False "/dev/cu.usbmodemfd131" $ do + let led = pin 13 + setPinMode led OUTPUT + forever $ do digitalWrite led True + delay 1000 + digitalWrite led False + delay 1000 diff --git a/System/Hardware/Arduino/SamplePrograms/Button.hs b/System/Hardware/Arduino/SamplePrograms/Button.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/Button.hs @@ -0,0 +1,38 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.Button +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Reads the value of a push-button and displays it's status continuously +-- on the computer screen and by lighting a led on the Arduino as long as +-- the button is pressed. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.Button where + +import Control.Monad.Trans (liftIO) + +import System.Hardware.Arduino + +-- | Read the value of a push-button (NO - normally open) +-- connected to input pin 2 on the Arduino. We will continuously +-- monitor and print the value as it changes. Also, we'll turn +-- the led on pin 13 on when the switch is pressed. +-- +-- The wiring is straightforward: Simply put a push-button between +-- digital input 2 and +5V, guarded by a 10K resistor: +-- +-- <> +button :: IO () +button = withArduino False "/dev/cu.usbmodemfd131" $ do + setPinMode led OUTPUT + setPinMode pb INPUT + go =<< digitalRead pb + where pb = pin 2 + led = pin 13 + go s = do liftIO $ putStrLn $ "Button is currently " ++ if s then "ON" else "OFF" + digitalWrite led s + go =<< waitFor pb diff --git a/System/Hardware/Arduino/SamplePrograms/Counter.hs b/System/Hardware/Arduino/SamplePrograms/Counter.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/Counter.hs @@ -0,0 +1,46 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.Counter +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Demonstrates using two push-buttons to count up and down. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.Counter where + +import Control.Monad.Trans (liftIO) + +import System.Hardware.Arduino + +-- | Two push-button switches, controlling a counter value. We will increment +-- the counter if the first one ('bUp') is pressed, and decrement the value if the +-- second one ('bDown') is pressed. We also have a led connected to pin 13 (either use +-- the internal or connect an external one), that we light up when the counter value +-- is 0. +-- +-- Wiring is very simple: Up-button connected to pin 4, Down-button connected +-- to pin 2, and a led on pin 13. +-- +-- <> +counter :: IO () +counter = withArduino False "/dev/cu.usbmodemfd131" $ do + setPinMode led OUTPUT + setPinMode bUp INPUT + setPinMode bDown INPUT + update (0::Int) + where bUp = pin 4 + bDown = pin 2 + led = pin 13 + update curVal = do + liftIO $ print curVal + digitalWrite led (curVal == 0) + [up, down] <- waitAnyHigh [bUp, bDown] + let newVal = case (up, down) of + (True, True) -> curVal -- simultaneous press + (True, False) -> curVal+1 + (False, True) -> curVal-1 + (False, False) -> curVal -- can't happen + update newVal diff --git a/System/Hardware/Arduino/SamplePrograms/LCD.hs b/System/Hardware/Arduino/SamplePrograms/LCD.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/LCD.hs @@ -0,0 +1,166 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.LCD +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Basic demo of an Hitachi HD44780 LCD +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.LCD where + +import Control.Monad.Trans (liftIO) +import Data.Char (isSpace) +import Numeric (showHex) + +import System.Hardware.Arduino +import System.Hardware.Arduino.LCD + +-- | Connections for a basic hitachi controller. +-- See for +-- pin layout. For this demo, simply connect the LCD pins to the Arduino +-- as follows: +-- +-- * LCD pin @01@ to GND +-- +-- * LCD pin @02@ to +5V +-- +-- * LCD pin @03@ to a 10K potentiometer's viper +-- +-- * LCD pin @04@ to Arduino pin @12@ +-- +-- * LCD pin @05@ to GND +-- +-- * LCD pin @06@ to Arduino pin @11@ +-- +-- * LCD pin @11@ to Arduino pin @5@ +-- +-- * LCD pin @12@ to Arduino pin @4@ +-- +-- * LCD pin @13@ to Arduino pin @3@ +-- +-- * LCD pin @14@ to Arduino pin @2@ +-- +-- * [If backlight is needed] LCD pin @15@ to +5V +-- +-- * [If backlight is needed] LCD pin @16@ to GND via 220ohm resistor +-- +-- <> +hitachi :: LCDController +-- Connections: ARDUINO Hitachi Description +-------------------------------- ------- --------- ---------------- +hitachi = Hitachi44780 { lcdRS = pin 12 -- 4 Register-select + , lcdEN = pin 11 -- 6 Enable + , lcdD4 = pin 5 -- 11 Data 4 + , lcdD5 = pin 4 -- 12 Data 5 + , lcdD6 = pin 3 -- 13 Data 6 + , lcdD7 = pin 2 -- 14 Data 7 + -- Other config variables for the display + , lcdRows = 2 -- 2 rows + , lcdCols = 16 -- of 16 columns + , dotMode5x10 = False -- Using the standard 5x8 dots + } + +-- | The happy glyph. See 'lcdCreateSymbol' for details on how to create new ones. +happy :: [String] +happy = [ " " + , "@ @" + , " " + , " " + , "@ @" + , " @@@ " + , " " + , " " + ] + +-- | The sad glyph. See 'lcdCreateSymbol' for details on how to create new ones. +sad :: [String] +sad = [ " " + , "@ @" + , " " + , " " + , " " + , " @@@ " + , "@ @" + , " " + ] + +-- | Access the LCD connected to Arduino, making it show messages +-- we read from the user and demonstrate other LCD control features offered +-- by hArduino. +lcdDemo :: IO () +lcdDemo = withArduino False "/dev/cu.usbmodemfd131" $ do + lcd <- lcdRegister hitachi + happySymbol <- lcdCreateSymbol lcd happy + sadSymbol <- lcdCreateSymbol lcd sad + lcdHome lcd + liftIO $ do putStrLn "Hitachi controller demo.." + putStrLn "" + putStrLn "Looking for an example? Try the following sequence:" + putStrLn " cursor 5 0" + putStrLn " happy" + putStrLn " write _" + putStrLn " happy" + putStrLn " flash 5" + putStrLn "" + putStrLn "Type ? to see all available commands." + let repl = do liftIO $ putStr "LCD> " + m <- liftIO getLine + case words m of + [] -> repl + ["quit"] -> return () + (cmd:_) -> case cmd `lookup` commands of + Nothing -> do liftIO $ putStrLn $ "Unknown command '" ++ cmd ++ "', type ? for help." + repl + Just (_, _, c) -> do c lcd (dropWhile isSpace (drop (length cmd) m)) (happySymbol, sadSymbol) + repl + repl + where help = liftIO $ do let (cmds, args, hlps) = unzip3 $ ("quit", "", "Quit the demo") : [(c, a, h) | (c, (a, h, _)) <- commands] + clen = 1 + maximum (map length cmds) + alen = 8 + maximum (map length args) + pad l s = take l (s ++ repeat ' ') + line (c, a, h) = putStrLn $ pad clen c ++ pad alen a ++ h + mapM_ line $ zip3 cmds args hlps + arg0 f _ [] _ = f + arg0 _ _ a _ = liftIO $ putStrLn $ "Unexpected arguments: " ++ show a + arg1 f lcd [] _ = f lcd + arg1 _ _ a _ = liftIO $ putStrLn $ "Unexpected arguments: " ++ show a + arg2 f lcd a _ = f lcd a + arg3 = id + grabNums n a f = case [v | [(v, "")] <- map reads (words a)] of + vs | length vs /= n -> liftIO $ putStrLn $ "Need " ++ show n ++ " numeric parameter" ++ if n == 1 then "." else "s." + vs -> f vs + symbol isHappy lcd _ (h, s) = lcdWriteSymbol lcd (if isHappy then h else s) + cursor lcd a = grabNums 2 a (\[col, row] -> lcdSetCursor lcd (col, row)) + flash lcd a = grabNums 1 a (\[n] -> lcdFlash lcd n 500) + code lcd a = grabNums 1 a (\[n] -> do lcdClear lcd + lcdHome lcd + lcdWriteSymbol lcd (lcdInternalSymbol n) + lcdWrite lcd $ " (Code: 0x" ++ showHex n "" ++ ")") + scroll toLeft lcd a = grabNums 1 a (\[n] -> do let scr | toLeft = lcdScrollDisplayLeft + | True = lcdScrollDisplayRight + sequence_ $ concat $ replicate n [scr lcd, delay 500]) + commands = [ ("?", ("", "Display this help message", arg0 help)) + , ("clear", ("", "Clear the LCD screen", arg1 lcdClear)) + , ("write", ("string", "Write to the LCD", arg2 lcdWrite)) + , ("home", ("", "Move cursor to home", arg1 lcdHome)) + , ("cursor", ("col row", "Move cursor to col row", arg2 cursor)) + , ("scrollOff", ("", "Turn off auto-scroll", arg1 lcdAutoScrollOff)) + , ("scrollOn", ("", "Turn on auto-scroll", arg1 lcdAutoScrollOn)) + , ("scrollLeft", ("n", "Scroll left by n chars", arg2 (scroll True))) + , ("scrollRight", ("n", "Scroll right by n char", arg2 (scroll False))) + , ("leftToRight", ("", "Set left to right direction", arg1 lcdLeftToRight)) + , ("rightToLeft", ("", "Set left to right direction", arg1 lcdRightToLeft)) + , ("blinkOn", ("", "Set blinking ON", arg1 lcdBlinkOn)) + , ("blinkOff", ("", "Set blinking ON", arg1 lcdBlinkOff)) + , ("cursorOn", ("", "Display the cursor", arg1 lcdCursorOn)) + , ("cursorOff", ("", "Do not display the cursor", arg1 lcdCursorOff)) + , ("displayOn", ("", "Turn the display on", arg1 lcdDisplayOn)) + , ("displayOff", ("", "Turn the display off", arg1 lcdDisplayOff)) + , ("flash", ("n", "Flash the display n times", arg2 flash)) + , ("happy", ("", "Draw a smiling face", arg3 (symbol True))) + , ("sad", ("", "Draw a sad face", arg3 (symbol False))) + , ("code", ("n", "Write symbol with code n", arg2 code)) + ] diff --git a/System/Hardware/Arduino/Utils.hs b/System/Hardware/Arduino/Utils.hs --- a/System/Hardware/Arduino/Utils.hs +++ b/System/Hardware/Arduino/Utils.hs @@ -60,10 +60,6 @@ -- | Turn a lo/hi encoded Arduino string constant into a Haskell string getString :: [Word8] -> String getString [] = "" -getString [a] = [chr (fromIntegral a)] -- shouldn't happen, but no need to error out either +getString [a] = [chr (fromIntegral a)] -- shouldn't happen getString (l:h:rest) = c : getString rest where c = chr $ fromIntegral $ h `shiftL` 8 .|. l - --- | Error out -die :: String -> [String] -> a -die m ms = error $ "\n*** hArduino:ERROR: " ++ intercalate "\n*** " (m:ms) diff --git a/hArduino.cabal b/hArduino.cabal --- a/hArduino.cabal +++ b/hArduino.cabal @@ -1,5 +1,5 @@ Name: hArduino -Version: 0.2 +Version: 0.3 Category: Hardware Synopsis: Control your Arduino board from Haskell. Description: Control Arduino from Haskell, using the Firmata protocol. @@ -11,6 +11,8 @@ can exchange information with the board, send/receive commands from other peripherals connected, etc. . + A short (4m29s) video of the blinking example: + . hArduino is work-in-progress. Comments, bug-reports, and patches are welcome. Copyright: Levent Erkok, 2013 License: BSD3 @@ -22,7 +24,7 @@ Maintainer: Levent Erkok (erkokl@gmail.com) Build-Type: Simple Cabal-Version: >= 1.14 -Extra-Source-Files: INSTALL, README, COPYRIGHT, RELEASENOTES +Extra-Source-Files: INSTALL, README.md, COPYRIGHT, CHANGES.md source-repository head type: git @@ -37,11 +39,14 @@ -- threaddelay is broken on Mac. See: http://hackage.haskell.org/trac/ghc/ticket/7299 , process Exposed-modules : System.Hardware.Arduino - , System.Hardware.Arduino.Examples.Blink - , System.Hardware.Arduino.Examples.Switch + , System.Hardware.Arduino.LCD + , System.Hardware.Arduino.SamplePrograms.Analog + , System.Hardware.Arduino.SamplePrograms.Blink + , System.Hardware.Arduino.SamplePrograms.Button + , System.Hardware.Arduino.SamplePrograms.Counter + , System.Hardware.Arduino.SamplePrograms.LCD Other-modules : System.Hardware.Arduino.Comm , System.Hardware.Arduino.Data , System.Hardware.Arduino.Firmata - , System.Hardware.Arduino.Firmata.Basics , System.Hardware.Arduino.Protocol , System.Hardware.Arduino.Utils