diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -1,8 +1,38 @@ * Hackage: (http://hackage.haskell.org/package/hArduino) * GitHub: (http://leventerkok.github.com/hArduino) -* Latest Hackage released version: 0.3 +* Latest Hackage released version: 0.4 +### Version 0.4, 2013-03-05 + + * New hardware components supported: + * Shift-registers + * Seven-segment displays + * Servo-motors + * New examples: + * PulseIn: Demonstrates the use of reading pulses + * PulseOut: Demonstrates the use of sending pulses + * Distance: Measure the distance using an HC-SC04 sensor + * Seven-segment: Display characters on a seven-segment display + * Servo: Control a servo board + * New functions: + * pulseIn_hostTiming/pulseOut_hostTiming: Send and receive pulses. + * NB. These functions use host-timing: watch out for accuracy + * pulse: Send and receive a digital pulse on a pin. + * This function is more accurate than the pair above, as + it uses a custom Firmata command to measure the pulse. + However, you need a custom Firmata version to use this + function, as the standard version that ships with Arduino + as of March 2013 does not support this functionality yet. + * time: Measure the time taken by an Arduino action + * timeOut: Run an action only for the given-time-out + * Other: + * Bugfix: Remove spurious extra call to user program + * Rework pin assignment logic, making use of analog/digital pins much more clearer. + * Better exception handling + * Remove threadDelay workaround on the Mac. NB. If you are running on OSX, then + you need at least GHC 7.6.2! + ### Version 0.3, 2013-02-10 * Library @@ -12,19 +42,22 @@ * 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 + * Counter: Use push buttons to count up and down + * Analog: Reading analog values + * LCD: Control an LCD, writing text/glyphs etc ### Version 0.2, 2013-01-28 - * Rewrite the communication engine - * Digital input/output implementation - * Add switch example + * Library + * Rewrite the communication engine + * Digital input/output implementation + * Examples + * Button: Detecting putton pushes ### Version 0.1, 2013-01-14 - * Initial design - * Blink example operational - * Created home page at: http://leventerkok.github.com/hArduino + * Library + * Initial design + * Created home page at: http://leventerkok.github.com/hArduino + * Examples + * Blink: Hello world! diff --git a/System/Hardware/Arduino.hs b/System/Hardware/Arduino.hs --- a/System/Hardware/Arduino.hs +++ b/System/Hardware/Arduino.hs @@ -28,19 +28,23 @@ -- ** Basic handshake with the board , queryFirmware -- ** Accessing pins - , pin, Pin, PinMode(..), setPinMode + , analog, digital, pin, Pin, PinMode(..), setPinMode -- ** Digital I/O -- *** Writing digital values , digitalWrite -- *** Reading digital values , digitalRead, pullUpResistor, waitFor, waitAny, waitAnyHigh, waitAnyLow + -- *** Receiving and sending pulses, host timing + , pulseIn_hostTiming, pulseOut_hostTiming + -- ** Pulse trigger and measurement + , pulse -- ** Analog Communication -- *** Setting up sampling interval , setAnalogSamplingInterval -- *** Reading analog values , analogRead -- * Misc utilities - , delay + , delay, time, timeOut ) 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 @@ -18,8 +18,9 @@ import Control.Exception (tryJust, AsyncException(UserInterrupt), handle, SomeException) import Control.Monad.State (runStateT, gets, liftIO, modify) import Data.Bits (testBit, (.&.)) -import Data.List (intercalate) +import Data.List (intercalate, isInfixOf) import Data.Maybe (listToMaybe) +import Data.Word (Word8) import System.Posix.Signals (installHandler, keyboardSignal, Handler(Catch)) import System.Timeout (timeout) import System.IO (stderr, hPutStrLn) @@ -59,12 +60,14 @@ if initOK then program else error "Communication time-out (5s) expired." - program 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!" - ]) $ + let selfErr = "*** hArduino" `isInfixOf` show e + hPutStrLn stderr $ if selfErr + then dropWhile (== '\n') (show e) + else "*** 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 { boardCapabilities = BoardCapabilities M.empty @@ -147,10 +150,11 @@ Right nonSysEx -> unpackageNonSysEx getBytes nonSysEx case resp of Unimplemented{} -> dbg $ "Ignoring the received response: " ++ show resp + -- NB. When Firmata sends back AnalogMessage, it uses the number in A0-A1-A2, etc., i.e., 0-1-2; which we + -- need to properly interpret in our own pin mapping schema, where analogs come after digitals. 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'] + do let BoardCapabilities caps = boardCapabilities bst + mbP = listToMaybe [mappedPin | (mappedPin, PinCapabilities{analogPinNumber = Just mp'}) <- M.assocs caps, pinNo mp == mp'] case mbP of Nothing -> return bst -- Mapping hasn't happened yet Just p -> do @@ -229,11 +233,12 @@ else do liftIO $ dbg $ "Skipping unexpected response: " ++ show resp wait wait - mapAnalog bs p c + mapAnalog :: [Word8] -> IPin -> PinCapabilities -> PinCapabilities + mapAnalog as p c | i < rl && m /= 0x7f - = (Just m, snd c) + = c{analogPinNumber = Just m} | True -- out-of-bounds, or not analog; ignore = c - where rl = length bs + where rl = length as i = fromIntegral (pinNo p) - m = bs !! i + m = as !! i 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 @@ -17,11 +17,12 @@ import Control.Applicative (Applicative) import Control.Concurrent (Chan, MVar, modifyMVar, modifyMVar_, withMVar, ThreadId) +import Control.Monad (when) import Control.Monad.State (StateT, MonadIO, MonadState, gets, liftIO) import Data.Bits ((.&.), (.|.), setBit) import Data.List (intercalate) -import Data.Maybe (fromMaybe) -import Data.Word (Word8) +import Data.Maybe (fromMaybe, listToMaybe) +import Data.Word (Word8, Word32) import System.Hardware.Serialport (SerialPort) import qualified Data.Map as M @@ -37,28 +38,58 @@ instance Show Port where show p = "Port" ++ show (portNo p) --- | A pin on the Arduino -data Pin = Pin { pinNo :: Word8 -- ^ The pin number - } - deriving (Eq, Ord) +-- | A pin on the Arduino, as specified by the user via 'pin', 'digital', and 'analog' functions. +data Pin = DigitalPin {userPinNo :: Word8} + | AnalogPin {userPinNo :: Word8} + | MixedPin {userPinNo :: Word8} instance Show Pin where - show p | i < 10 = "Pin0" ++ show i - | True = "Pin" ++ show i - where i = pinNo p + show (DigitalPin w) = "DPin" ++ show w + show (AnalogPin w) = "APin" ++ show w + show (MixedPin w) = "Pin" ++ show w --- | Declare a pin on the board by its number. +-- | A pin on the Arduino, as viewed by the library; i.e., real-pin numbers +data IPin = InternalPin { pinNo :: Word8 } + deriving (Eq, Ord) + +instance Show IPin where + show (InternalPin w) = "IPin" ++ show w + +-- | Declare a pin by its index. For maximum portability, prefer 'digital' +-- and 'analog' functions, which will adjust pin indexes properly based on +-- which board the program is running on at run-time, as Arduino boards +-- differ in their pin numbers. This function is provided for cases where +-- a pin is used in mixed-mode, i.e., both for digital and analog purposes, +-- as Arduino does not really distinguish pin usage. In these cases, the +-- user has the proof obligation to make sure that the index used is supported +-- on the board with appropriate capabilities. pin :: Word8 -> Pin -pin = Pin +pin = MixedPin +-- | Declare an digital pin on the board. For instance, to refer to digital pin no 12 +-- use 'digital' @12@. +digital :: Word8 -> Pin +digital = DigitalPin + +-- | Declare an analog pin on the board. For instance, to refer to analog pin no 0 +-- simply use 'analog' @0@. +-- +-- Note that 'analog' @0@ on an Arduino UNO will be appropriately adjusted +-- internally to refer to pin 14, since UNO has 13 digital pins, while on an +-- Arduino MEGA, it will refer to internal pin 55, since MEGA has 54 digital pins; +-- and similarly for other boards depending on their capabilities. +-- (Also see the note on 'pin' for pin mappings.) +analog :: Word8 -> Pin +analog = AnalogPin + -- | On the Arduino, pins are grouped into banks of 8. -- Given a pin, this function determines which port it belongs to -pinPort :: Pin -> Port +pinPort :: IPin -> Port pinPort p = Port (pinNo p `quot` 8) -- | On the Arduino, pins are grouped into banks of 8. -- Given a pin, this function determines which index it belongs to in its port -pinPortIndex :: Pin -> Word8 +pinPortIndex :: IPin -> Word8 pinPortIndex p = pinNo p `rem` 8 -- | The mode for a pin. @@ -72,15 +103,17 @@ deriving (Eq, Show, Enum) -- | A request, as sent to Arduino -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 +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 IPin PinMode -- ^ Set the mode on a pin + | DigitalReport Port Bool -- ^ Digital report values on port enable/disable + | AnalogReport IPin Bool -- ^ Analog report values on pin enable/disable + | DigitalPortWrite Port Word8 Word8 -- ^ Set the values on a port digitally + | AnalogPinWrite IPin Word8 Word8 -- ^ Send an analog-write; used for servo control + | SamplingInterval Word8 Word8 -- ^ Set the sampling interval + | Pulse IPin Bool Word32 Word32 -- ^ Request for a pulse reading on a pin, value, duration, timeout deriving Show -- | A response, as returned from the Arduino @@ -88,7 +121,8 @@ | 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 + | AnalogMessage IPin Word8 Word8 -- ^ Status of an analog pin + | PulseResponse IPin Word32 -- ^ Repsonse to a PulseInCommand | Unimplemented (Maybe String) [Word8] -- ^ Represents messages currently unsupported instance Show Response where @@ -97,6 +131,7 @@ 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 (PulseResponse p v) = "PulseResponse " ++ show p ++ " = " ++ show v ++ " (microseconds)" show (Unimplemented mbc bs) = "Unimplemeneted " ++ fromMaybe "" mbc ++ " " ++ showByteList bs -- | Resolution, as referred to in http://firmata.org/wiki/Protocol#Capability_Query @@ -104,17 +139,18 @@ type Resolution = Word8 -- | Capabilities of a pin -type PinCapabilities = ( Maybe Word8 -- Analog pin number, if any - , [(PinMode, Resolution)] - ) +data PinCapabilities = PinCapabilities { + analogPinNumber :: Maybe Word8 -- ^ Analog pin number, if any + , allowedModes :: [(PinMode, Resolution)] -- ^ Allowed modes and resolutions + } -- | What the board is capable of and current settings -newtype BoardCapabilities = BoardCapabilities (M.Map Pin PinCapabilities) +newtype BoardCapabilities = BoardCapabilities (M.Map IPin PinCapabilities) instance Show BoardCapabilities where show (BoardCapabilities m) = intercalate "\n" (map sh (M.toAscList m)) - where sh (p, (mbA, pc)) = show p ++ sep ++ unwords [show md | (md, _) <- pc] - where sep = maybe ": " (\i -> "[A" ++ show i ++ "]: ") mbA + where sh (p, PinCapabilities{analogPinNumber, allowedModes}) = show p ++ sep ++ unwords [show md | (md, _) <- allowedModes] + where sep = maybe ": " (\i -> "[A" ++ show i ++ "]: ") analogPinNumber -- | Data associated with a pin data PinData = PinData { @@ -153,12 +189,12 @@ -- | State of the board data BoardState = BoardState { - 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 + boardCapabilities :: BoardCapabilities -- ^ Capabilities of the board + , analogReportingPins :: S.Set IPin -- ^ Which analog pins are reporting + , digitalReportingPins :: S.Set IPin -- ^ Which digital pins are reporting + , pinStates :: M.Map IPin 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 @@ -188,15 +224,15 @@ liftIO $ f m ms -- | Which modes does this pin support? -getPinModes :: Pin -> Arduino [PinMode] +getPinModes :: IPin -> Arduino [PinMode] getPinModes p = do BoardCapabilities caps <- gets capabilities case p `M.lookup` caps of - Nothing -> return [] - Just (_, ps) -> return (map fst ps) + Nothing -> return [] + Just PinCapabilities{allowedModes} -> return $ map fst allowedModes -- | Current state of the pin -getPinData :: Pin -> Arduino PinData +getPinData :: IPin -> Arduino PinData getPinData p = do bs <- gets boardState err <- gets bailOut @@ -214,7 +250,7 @@ -- * Second msb: pins 7-13 on the port -- -- In particular, the result is suitable to be sent with a digital message -computePortData :: Pin -> Bool -> Arduino (Word8, Word8) +computePortData :: IPin -> Bool -> Arduino (Word8, Word8) computePortData curPin newValue = do let curPort = pinPort curPin let curIndex = pinPortIndex curPin @@ -238,9 +274,9 @@ liftIO $ modifyMVar_ bs $ \bst -> return bst{digitalWakeUpQueue = semaphore : digitalWakeUpQueue bst} -- | Firmata commands, see: http://firmata.org/wiki/Protocol#Message_Types -data FirmataCmd = ANALOG_MESSAGE Pin -- ^ @0xE0@ pin +data FirmataCmd = ANALOG_MESSAGE IPin -- ^ @0xE0@ pin | DIGITAL_MESSAGE Port -- ^ @0x90@ port - | REPORT_ANALOG_PIN Pin -- ^ @0xC0@ pin + | REPORT_ANALOG_PIN IPin -- ^ @0xC0@ pin | REPORT_DIGITAL_PORT Port -- ^ @0xD0@ port | START_SYSEX -- ^ @0xF0@ | SET_PIN_MODE -- ^ @0xF4@ @@ -271,9 +307,9 @@ | w == 0xF7 = Right END_SYSEX | w == 0xF9 = Right PROTOCOL_VERSION | w == 0xFF = Right SYSTEM_RESET - | Just i <- extract 0xE0 = Right $ ANALOG_MESSAGE (Pin i) + | Just i <- extract 0xE0 = Right $ ANALOG_MESSAGE (InternalPin i) | Just i <- extract 0x90 = Right $ DIGITAL_MESSAGE (Port i) - | Just i <- extract 0xC0 = Right $ REPORT_ANALOG_PIN (Pin i) + | Just i <- extract 0xC0 = Right $ REPORT_ANALOG_PIN (InternalPin i) | Just i <- extract 0xD0 = Right $ REPORT_DIGITAL_PORT (Port i) | True = Left w @@ -288,6 +324,7 @@ | EXTENDED_ANALOG -- ^ @0x6F@ analog write (PWM, Servo, etc) to any pin | SERVO_CONFIG -- ^ @0x70@ set max angle, minPulse, maxPulse, freq | STRING_DATA -- ^ @0x71@ a string message with 14-bits per char + | PULSE -- ^ @0x74@ Pulse, see: https://github.com/rwldrn/johnny-five/issues/18 | SHIFT_DATA -- ^ @0x75@ shiftOut config/data message (34 bits) | I2C_REQUEST -- ^ @0x76@ I2C request messages from a host to an I/O board | I2C_REPLY -- ^ @0x77@ I2C reply messages from an I/O board to a host @@ -310,6 +347,7 @@ sysExCmdVal EXTENDED_ANALOG = 0x6F sysExCmdVal SERVO_CONFIG = 0x70 sysExCmdVal STRING_DATA = 0x71 +sysExCmdVal PULSE = 0x74 sysExCmdVal SHIFT_DATA = 0x75 sysExCmdVal I2C_REQUEST = 0x76 sysExCmdVal I2C_REPLY = 0x77 @@ -339,10 +377,11 @@ getSysExCommand 0x7A = Right SAMPLING_INTERVAL getSysExCommand 0x7E = Right SYSEX_NON_REALTIME getSysExCommand 0x7F = Right SYSEX_REALTIME +getSysExCommand 0x74 = Right PULSE getSysExCommand n = Left n -- | Keep track of pin-mode changes -registerPinMode :: Pin -> PinMode -> Arduino [Request] +registerPinMode :: IPin -> PinMode -> Arduino [Request] registerPinMode p m = do -- first check that the requested mode is supported for this pin BoardCapabilities caps <- gets capabilities @@ -350,10 +389,10 @@ Nothing -> die ("Invalid access to unsupported pin: " ++ show p) ("Available pins are: " : [" " ++ show k | (k, _) <- M.toAscList caps]) - Just (_, ms) - | m `notElem` map fst ms + Just PinCapabilities{allowedModes} + | m `notElem` map fst allowedModes -> 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)] + ["Supported modes for this pin are: " ++ unwords (if null allowedModes then ["NONE"] else map show allowedModes)] _ -> return () -- see if there was a mode already set for this pin bs <- gets boardState @@ -373,7 +412,7 @@ 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 :: IPin -> PinMode -> Arduino [Request] getRemovalActions p INPUT = do -- This pin is no longer digital input bs <- gets boardState liftIO $ modifyMVar bs $ \bst -> do @@ -394,7 +433,7 @@ -- | Depending on a mode-set call, determine what further -- actions should be executed, such as enabling/disabling pin/port reporting -getModeActions :: Pin -> PinMode -> Arduino [Request] +getModeActions :: IPin -> PinMode -> Arduino [Request] getModeActions p INPUT = do -- This pin is just configured for digital input bs <- gets boardState liftIO $ modifyMVar bs $ \bst -> do @@ -420,4 +459,39 @@ } return (bst', acts1 ++ acts2) getModeActions _ OUTPUT = return [] +getModeActions _ SERVO = return [] getModeActions p m = die ("hArduino: getModeActions: TBD: Unsupported mode: " ++ show m) ["On pin " ++ show p] + +-- | On the arduino, digital pin numbers are in 1-to-1 match with +-- the board pins. However, ANALOG pins come at an offset, determined by +-- the capabilities query. Users of the library refer to these pins +-- simply by their natural numbers, which makes for portable programs +-- between boards that have different number of digital pins. We adjust +-- for this shift here. +getInternalPin :: Pin -> Arduino IPin +getInternalPin (MixedPin p) = return $ InternalPin p +getInternalPin (DigitalPin p) = return $ InternalPin p +getInternalPin (AnalogPin p) + = do BoardCapabilities caps <- gets capabilities + case listToMaybe [realPin | (realPin, PinCapabilities{analogPinNumber = Just n}) <- M.toAscList caps, p == n] of + Nothing -> die ("hArduino: " ++ show p ++ " is not a valid analog-pin on this board.") + -- Try to be helpful in case they are trying to use a large value thinking it needs to be offset + ["Hint: To refer to analog pin number k, simply use 'pin k', not 'pin (k+noOfDigitalPins)'" | p > 13] + Just rp -> return rp + +-- | Similar to getInternalPin above, except also makes sure the pin is in a required mode. +convertAndCheckPin :: String -> Pin -> PinMode -> Arduino (IPin, PinData) +convertAndCheckPin what p' m = do + p <- getInternalPin p' + pd <- getPinData p + let user = userPinNo p' + board = pinNo p + bInfo + | user == board = "" + | True = " (On board " ++ show p ++ ")" + when (pinMode pd /= m) $ die ("Invalid " ++ what ++ " call on pin " ++ show p' ++ bInfo) + [ "The current mode for this pin is: " ++ show (pinMode pd) + , "For " ++ what ++ ", it must be set to: " ++ show m + , "via a proper call to setPinMode" + ] + return (p, pd) 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 @@ -12,14 +12,21 @@ {-# LANGUAGE NamedFieldPuns #-} module System.Hardware.Arduino.Firmata where -import Control.Concurrent (newEmptyMVar, readMVar) +import Control.Concurrent (newEmptyMVar, readMVar, withMVar, modifyMVar_, threadDelay) import Control.Monad (when, unless, void) +import Control.Monad.State (StateT(..), gets) import Control.Monad.Trans (liftIO) -import Data.Bits ((.&.), shiftR) +import Data.Bits ((.&.), shiftR, setBit) +import Data.Maybe (fromMaybe) +import Data.Time (getCurrentTime, utctDayTime) +import System.Timeout (timeout) import Data.Word (Word8) +import qualified Data.Map as M + 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 @@ -37,23 +44,39 @@ delay :: Int -> Arduino () delay = liftIO . U.delay +-- | Time a given action, result is measured in micro-seconds. +time :: Arduino a -> Arduino (Int, a) +time a = do start <- tick + r <- a + end <- r `seq` tick + return (toMicroSeconds (end - start), r) + where -- tick gets the current time in picoseconds + tick = do t <- liftIO $ utctDayTime `fmap` getCurrentTime + let precision = 1000000000000 :: Integer + return . round . (fromIntegral precision *) . toRational $ t + toMicroSeconds :: Integer -> Int + toMicroSeconds t = fromIntegral $ t `quot` 1000000 + +-- | Time-out a given action. Time-out amount is in micro-seconds. +timeOut :: Int -> Arduino a -> Arduino (Maybe a) +timeOut to (Arduino (StateT f)) = Arduino (StateT (\st -> do + mbRes <- timeout to (f st) + case mbRes of + Nothing -> return (Nothing, st) + Just (a, st') -> return (Just a, st'))) + -- | Set the mode on a particular pin on the board setPinMode :: Pin -> PinMode -> Arduino () -setPinMode p m = do +setPinMode p' m = do + p <- getInternalPin p' 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" - ] +digitalWrite p' v = do + (p, pd) <- convertAndCheckPin "digitalWrite" p' OUTPUT case pinValue pd of Just (Left b) | b == v -> return () -- no change, nothing to do _ -> do (lsb, msb) <- computePortData p v @@ -61,14 +84,8 @@ -- | 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" - ] +pullUpResistor p' v = do + (p, _) <- convertAndCheckPin "pullUpResistor" p' INPUT (lsb, msb) <- computePortData p v send $ DigitalPortWrite (pinPort p) lsb msb @@ -76,14 +93,8 @@ -- 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" - ] +digitalRead p' = do + (_, pd) <- convertAndCheckPin "digitalRead" p' INPUT return $ case pinValue pd of Just (Left v) -> v _ -> False -- no (correctly-typed) value reported yet, default to False @@ -138,22 +149,120 @@ else return $ zip curVals newVals wait +-- | Send down a pulse, and measure how long the pin reports a corresponding pulse, with a potential time-out. The call @pulse p v duration mbTimeOut@ +-- does the following: +-- +-- * Set the pin to value @v@ for @duration@ microseconds. +-- +-- * Waits 2 microseconds +-- +-- * Waits until pin @p@ has value @not v@. +-- +-- * Returns, in micro-seconds, the duration the pin stayed @v@, counting from the 2 microsecond wait. +-- +-- Time-out parameter is used as follows: +-- +-- * If @mbTimeOut@ is @Nothing@, then 'pulse' will wait until the pin attains the value required and so long as it holds it. +-- Note that very-long time-out values are unlikely to be accurate. +-- +-- * If @mbTimeOut@ is @Just t@ then, 'pulse' will stop if the above procedure does not complete within the given micro-seconds. +-- In this case, the overall return value is @Nothing@. +-- +-- NB. Both the time-out value and the return value are given in micro-seconds. +-- +-- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the Pulse-In command. +-- However, there is a patch to add this command; see: for details. +-- If you want to use hArduino's 'pulseIn' command, then you /have/ to install the above patch. Also see the function +-- 'pulseIn_hostOnly', which works with the distributed StandardFirmata: It implements a version that is not as +-- accurate in its timing, but might be sufficient if high precision is not required. +pulse :: Pin -> Bool -> Int -> Maybe Int -> Arduino (Maybe Int) +pulse p' v duration mbTo = do + (p, _) <- convertAndCheckPin "pulse" p' INPUT + let to = fromMaybe maxAllowed mbTo + maxAllowed = 2147483647 -- works out to about 36 minutes; which is way beyond the accuracy provided by Arduino + bad x = x < 0 || x > maxAllowed + when (any bad [duration, to]) $ die ("Invalid duration/time-out values for pulse on pin " ++ show p) + [ "Values should be between 0 and " ++ show maxAllowed + , "Received: " ++ show (duration, to) + ] + send $ Pulse p v (fromIntegral duration) (fromIntegral to) + r <- recv + case r of + PulseResponse pOut d | p == pOut -> case d of + 0 -> return Nothing + i -> return (Just (fromIntegral i)) + _ -> die ("pulseIn: Got unexpected response for Pulse call on pin: " ++ show p') [show r] + +-- | A /hostOnly/ version of pulse-out on a digital-pin. Use this function only for cases where the +-- precision required only matters for the host, not for the board. That is, due to the inherent +-- delays involved in Firmata communication, the timing will /not/ be accurate, and should not +-- be expected to work uniformly over different boards. Similar comments apply for 'pulseIn_hostTiming' +-- as well. See the function 'pulse' for a more accurate version. +pulseOut_hostTiming :: Pin -- ^ Pin to send the pulse on + -> Bool -- ^ Pulse value + -> Int -- ^ Time, in microseconds, to signal beginning of pulse; will send the opposite value for this amount + -> Int -- ^ Pulse duration, measured in microseconds + -> Arduino () +pulseOut_hostTiming p' pulseValue dBefore dAfter + | dBefore < 0 || dAfter < 0 + = die ("pulseOut: Invalid delay amounts: " ++ show (dBefore, dAfter)) + [ "Pre-delay and pulse-amounts must be non-negative."] + | True + = do (p, pd) <- convertAndCheckPin "pulseOut_hostTiming" p' OUTPUT + let curPort = pinPort p + curIndex = pinPortIndex p + bs <- gets boardState + (setMask, resetMask) <- liftIO $ withMVar bs $ \bst -> do + let values = [(pinPortIndex sp, pinValue spd) | (sp, spd) <- M.assocs (pinStates bst), curPort == pinPort sp, pinMode pd `elem` [INPUT, OUTPUT]] + getVal nv i + | i == curIndex = nv + | Just (Just (Left ov)) <- i `lookup` values = ov + | True = False + mkMask val = let [b0, b1, b2, b3, b4, b5, b6, b7] = map (getVal val) [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]) + in (lsb, msb) + return (mkMask pulseValue, mkMask (not pulseValue)) + let writeThrough (lsb, msb) = send $ DigitalPortWrite curPort lsb msb + -- make sure masks are pre computed, and clear the line + fst setMask `seq` snd setMask `seq` fst resetMask `seq` snd resetMask `seq` writeThrough resetMask + -- Wait before starting the pulse + liftIO $ threadDelay dBefore + -- Send the pulse + writeThrough setMask + liftIO $ threadDelay dAfter + -- Finish the pulse + writeThrough resetMask + -- Do a final internal update to reflect the final value of the line + liftIO $ modifyMVar_ bs $ \bst -> return bst{pinStates = M.insert p PinData{pinMode = OUTPUT, pinValue = Just (Left (not pulseValue))}(pinStates bst)} +{-# ANN pulseOut_hostTiming "HLint: ignore Use camelCase" #-} + +-- | A /hostOnly/ version of pulse-in on a digital-pin. Use this function only for cases where the +-- precision required only matters for the host, not for the board. That is, due to the inherent +-- delays involved in Firmata communication, the timing will /not/ be accurate, and should not +-- be expected to work uniformly over different boards. Similar comments apply for 'pulseOut_hostTiming' +-- as well. See the function 'pulse' for a more accurate version. +pulseIn_hostTiming :: Pin -> Bool -> Maybe Int -> Arduino (Maybe Int) +pulseIn_hostTiming p v mbTo = case mbTo of + Nothing -> Just `fmap` measure + Just to -> timeOut to measure + where waitTill f = do curVal <- digitalRead p + unless (f curVal) $ waitTill f + measure = do waitTill (== v) -- wait until pulse starts + (t, _) <- time $ waitTill (/= v) -- wait till pulse ends, measuring the time + return $ fromIntegral t +{-# ANN pulseIn_hostTiming "HLint: ignore Use camelCase" #-} + -- | 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" - ] +analogRead p' = do + (_, pd) <- convertAndCheckPin "analogRead" p' ANALOG return $ case pinValue pd of Just (Right v) -> v - _ -> 0 -- no (correctly-typed) value reported yet, default to False + _ -> 0 -- no (correctly-typed) value reported yet, default to 0 -- | 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 diff --git a/System/Hardware/Arduino/LCD.hs b/System/Hardware/Arduino/LCD.hs deleted file mode 100644 --- a/System/Hardware/Arduino/LCD.hs +++ /dev/null @@ -1,432 +0,0 @@ -------------------------------------------------------------------------------------------------- --- | --- 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/Parts.hs b/System/Hardware/Arduino/Parts.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/Parts.hs @@ -0,0 +1,27 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.Parts +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Models of various Hardware components +------------------------------------------------------------------------------- +module System.Hardware.Arduino.Parts( + -- * Liquid Crystal Displays + module System.Hardware.Arduino.Parts.LCD + -- * Seven-Segment Conversion Codes + , module System.Hardware.Arduino.Parts.SevenSegmentCodes + -- * Shift-registers + , module System.Hardware.Arduino.Parts.ShiftRegisters + -- * Servo-motors + , module System.Hardware.Arduino.Parts.Servo + ) where + +import System.Hardware.Arduino.Parts.LCD +import System.Hardware.Arduino.Parts.SevenSegmentCodes +import System.Hardware.Arduino.Parts.ShiftRegisters +import System.Hardware.Arduino.Parts.Servo + +{-# ANN module "HLint: ignore Use import/export shortcut" #-} diff --git a/System/Hardware/Arduino/Parts/LCD.hs b/System/Hardware/Arduino/Parts/LCD.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/Parts/LCD.hs @@ -0,0 +1,432 @@ +------------------------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.Parts.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.Parts.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/Parts/Servo.hs b/System/Hardware/Arduino/Parts/Servo.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/Parts/Servo.hs @@ -0,0 +1,85 @@ +------------------------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.Parts.Servo +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Abstractions for servo motors. See "System.Hardware.Arduino.SamplePrograms.Servo" for +-- example uses. +------------------------------------------------------------------------------------------------- + +{-# LANGUAGE NamedFieldPuns #-} +module System.Hardware.Arduino.Parts.Servo( + -- * Attaching a servo motor on a pin + Servo, attach + -- * Setting servo position + , setAngle + ) where + +import Control.Monad (when) +import Data.Bits (shiftR, (.&.)) +import Data.Maybe (fromMaybe) + +import System.Hardware.Arduino +import System.Hardware.Arduino.Comm +import System.Hardware.Arduino.Data + +-- | A servo motor. Note that this type is abstract, use 'attach' to +-- create an instance. +data Servo = Servo { servoPin :: IPin -- ^ The internal-pin that controls the servo + , minPulse :: Int -- ^ Pulse-width (microseconds) for the minumum (0-degree) angle. + , maxPulse :: Int -- ^ Pulse-width (microseconds) for the maximum (typically 180-degree) angle. + } + +-- | Create a servo motor instance. The default values for the min/max angle pulse-widths, while typical, +-- may need to be adjusted based on the specs of the actual servo motor. Check the data-sheet for your +-- servo to find the proper values. The default values of @544@ and @2400@ microseconds are typical, so you might +-- want to start by passing 'Nothing' for both parameters and adjusting as necessary. +attach :: Pin -- ^ Pin controlling the servo. Should be a pin that supports SERVO mode. + -> Maybe Int -- ^ Pulse-width (in microseconds) for the minumum 0-degree angle. Default: @544@. + -> Maybe Int -- ^ Pulse-width (in microseconds) for the maximum, typically 180-degree, angle. Default: @2400@. + -> Arduino Servo +attach p mbMin mbMax + | Just m <- mbMin, m < 0 + = die "Servo.attach: minimum pulse width must be positive" ["Received: " ++ show m] + | Just m <- mbMax, m < 0 + = die "Servo.attach: maximum pulse width must be positive" ["Received: " ++ show m] + | True + = do let minPulse = fromMaybe 544 mbMin + maxPulse = fromMaybe 2400 mbMax + debug $ "Attaching servo on pin: " ++ show p ++ " with parameters: " ++ show (minPulse, maxPulse) + when (minPulse >= maxPulse) $ die "Servo.attach: min pulse duration must be less than max pulse duration" + [ "Received min-pulse: " ++ show minPulse + , "Received max-pulse: " ++ show maxPulse + ] + setPinMode p SERVO + (ip, _) <- convertAndCheckPin "Servo.attach" p SERVO + return Servo { servoPin = ip + , minPulse = fromMaybe 544 mbMin + , maxPulse = fromMaybe 2400 mbMax + } + +-- | Set the angle of the servo. The argument should be a number between 0 and 180, +-- indicating the desired angle setting in degrees. +setAngle :: Servo -> Int -> Arduino () +setAngle Servo{servoPin, minPulse, maxPulse} angle + | angle < 0 || angle > 180 + = die "Servo.setAngle: angle must be between 0 and 180." ["Received: " ++ show angle] + | True + = do let duration = minPulse + ((maxPulse - minPulse) * angle) `div` 180 + debug $ "Setting servo on pin: " ++ show servoPin ++ " " ++ show angle ++ " degrees, via a pulse of " ++ show duration ++ " microseconds." + -- In arduino, the most we can send is 16383; not that a servo should need such a large value, but + -- just in case + when (duration >= 16383) $ die "Servo.setAngle angle setting: out-of-range." + [ "Servo pin : " ++ show servoPin + , "Angle required : " ++ show angle + , "Min pulse duration: " ++ show minPulse + , "Max pulse duration: " ++ show maxPulse + , "Duration needed : " ++ show duration + , "Exceeds max value : 16383" + ] + let msb = fromIntegral $ (duration `shiftR` 7) .&. 0x7f + lsb = fromIntegral $ duration .&. 0x7f + send $ AnalogPinWrite servoPin lsb msb diff --git a/System/Hardware/Arduino/Parts/SevenSegmentCodes.hs b/System/Hardware/Arduino/Parts/SevenSegmentCodes.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/Parts/SevenSegmentCodes.hs @@ -0,0 +1,32 @@ +------------------------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.Parts.SevenSegmentCodes +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Character to 7-segment display conversion. +------------------------------------------------------------------------------------------------- + +module System.Hardware.Arduino.Parts.SevenSegmentCodes(char2SS) where + +import Data.Word (Word8) + +-- | Convert a character to a bit-pattern, suitable for display on a seven-segment display. +-- Note that most characters are just not representable in a 7-segment display, in which +-- case we map it to 'Nothing'. However, some substitutions are done, for instance '(' is +-- displayed the same as '['. +-- +-- The return value is a 'Word8', although only 7-bits are used; the least significant bit will +-- always be 0. With the traditional coding, the bits correspond to segments ABCDEFG0, i.e., +-- most-significant-bit will be for segment A, next for segment B, and so on. +char2SS :: Char -> Maybe Word8 +char2SS = (`lookup` tbl) + where tbl = [ ('"', 0x44), ('\'', 0x40), ('(', 0x9C), (')', 0xF0), ('-', 0x02), ('0', 0xFC), ('1', 0x60), ('2', 0xDA), ('3', 0xF2), ('4', 0x66), ('5', 0xB6) + , ('6', 0xBE), ('7', 0xE0), ('8', 0xFE), ('9', 0xF6), ('=', 0x12), ('?', 0xCA), ('A', 0xEE), ('B', 0x3E), ('C', 0x9C), ('D', 0x7A), ('E', 0x9E) + , ('F', 0x8E), ('G', 0xBC), ('H', 0x6E), ('I', 0x60), ('J', 0x78), ('L', 0x1C), ('N', 0x2A), ('O', 0xFC), ('P', 0xCE), ('R', 0x0A), ('S', 0xB6) + , ('T', 0x1E), ('U', 0x7C), ('Y', 0x76), ('[', 0x9C), (']', 0xF0), ('_', 0x10), ('a', 0xFA), ('b', 0x3E), ('c', 0x1A), ('d', 0x7A), ('e', 0xDE) + , ('f', 0x8E), ('g', 0xBC), ('h', 0x2E), ('i', 0x20), ('j', 0x78), ('l', 0x1C), ('n', 0x2A), ('o', 0x3A), ('p', 0xCE), ('q', 0xE7), ('r', 0x0A) + , ('s', 0xB6), ('t', 0x1E), ('u', 0x38), ('y', 0x76), (' ', 0x00) + ] diff --git a/System/Hardware/Arduino/Parts/ShiftRegisters.hs b/System/Hardware/Arduino/Parts/ShiftRegisters.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/Parts/ShiftRegisters.hs @@ -0,0 +1,92 @@ +------------------------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.Parts.ShiftRegisters +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Abstractions for shift-register IC parts. +------------------------------------------------------------------------------------------------- + +{-# LANGUAGE NamedFieldPuns #-} +module System.Hardware.Arduino.Parts.ShiftRegisters( + -- * Shift register abstraction + ShiftRegister(..) + -- * Supported shift-registers + -- ** Texas Instruments 7HC595 + , SR_74HC595(..) + ) where + +import Data.Foldable (forM_) + +import System.Hardware.Arduino +import System.Hardware.Arduino.Data (die) + +-- | A shift-register class as supported by the hArduino library. +class ShiftRegister a where + -- | Capacity + size :: a -> Int + -- | Display name + name :: a -> String + -- | Data sheet (typically a URL) + dataSheet :: a -> String + -- | Initialize the shift-register + initialize :: a -> Arduino () + -- | Disable the output, putting it into high-impedance state + disable :: a -> Arduino () + -- | Enable the output, getting it out of the high-impedance state + enable :: a -> Arduino () + -- | Clear the contents + clear :: a -> Arduino () + -- | Push a single bit down the shift-register + push :: a -> Bool -> Arduino () + -- | Store the pushed-in values in the storage register + store :: a -> Arduino () + -- | Read the current value stored + read :: a -> Arduino [Bool] + +-- | The Texas-Instruments 74HC595 8-bit shift register with 3-state +-- outputs. Data sheet: . +-- +-- This is a versatile 8-bit shift-register with separate serial and register +-- clocks, allowing shifting to be done while the output remains untouched. We +-- model all control pins provided. Note that the enable and clear lines are +-- negated. +data SR_74HC595 = SR_74HC595 { + serial :: Pin -- ^ Chip Pin: 14: Serial input + , nEnable :: Pin -- ^ Chip Pin: 13: Negated output-enable + , rClock :: Pin -- ^ Chip Pin: 12: Register clock, positive triggered + , sClock :: Pin -- ^ Chip Pin: 11: Serial clock, positive triggered + , nClear :: Pin -- ^ Chip Pin: 10: Negated clear-data + , mbBits :: Maybe [Pin] -- ^ Chip Pins: 15, 1-7, and 8: Sequence of output bits, connect only if reading is necessary + } + +instance ShiftRegister SR_74HC595 where + size _ = 8 + name _ = "TI SR_74HC595" + dataSheet _ = "http://www.ti.com/lit/ds/symlink/sn74hc595.pdf" + initialize sr@SR_74HC595{nEnable, serial, rClock, sClock, nClear, mbBits} = + do mapM_ (`setPinMode` OUTPUT) [nEnable, nClear, serial, rClock, sClock] + clear sr + enable sr + forM_ mbBits (mapM_ (`setPinMode` INPUT)) + disable SR_74HC595{nEnable} = digitalWrite nEnable True + enable SR_74HC595{nEnable} = digitalWrite nEnable False + clear SR_74HC595{nClear} = do digitalWrite nClear False + digitalWrite nClear True + push SR_74HC595{serial, sClock} b = fallingEdge sClock $ digitalWrite serial b + store SR_74HC595{rClock} = fallingEdge rClock (return ()) + read sr@SR_74HC595{mbBits} = case mbBits of + Nothing -> die (name sr ++ ": Not configured for bit-reading") + [ "Datasheet: " ++ dataSheet sr + , "Make sure to set the `bits' field when configuring" + ] + Just pins -> mapM digitalRead pins + +-- | Execute action, followed by a simulated falling edge on the given clock +fallingEdge :: Pin -> Arduino a -> Arduino a +fallingEdge clk action = do r <- action + digitalWrite clk True + digitalWrite clk False + return r 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 @@ -41,7 +41,9 @@ 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 (AnalogPinWrite p l m) = nonSysEx (ANALOG_MESSAGE p) [l, m] package (SamplingInterval l m) = sysEx SAMPLING_INTERVAL [l, m] +package (Pulse p b dur to) = sysEx PULSE ([fromIntegral (pinNo p), if b then 1 else 0] ++ concatMap toArduinoBytes (word2Bytes dur ++ word2Bytes to)) -- | Unpackage a SysEx response unpackageSysEx :: [Word8] -> Response @@ -52,12 +54,14 @@ (REPORT_FIRMWARE, majV : minV : rest) -> Firmware majV minV (getString rest) (CAPABILITY_RESPONSE, bs) -> Capabilities (getCapabilities bs) (ANALOG_MAPPING_RESPONSE, bs) -> AnalogMapping bs + (PULSE, xs) | length xs == 10 -> let [p, a, b, c, d] = fromArduinoBytes xs in PulseResponse (InternalPin p) (bytes2Words (a, b, c, d)) _ -> Unimplemented (Just (show cmd)) args | True = Unimplemented Nothing (cmdWord : args) getCapabilities :: [Word8] -> BoardCapabilities -getCapabilities bs = BoardCapabilities $ M.fromList $ zipWith (\p c -> (p, (Nothing, c))) (map pin [0..]) (map pinCaps (chunk bs)) +getCapabilities bs = BoardCapabilities $ M.fromList $ zipWith (\p c -> (p, PinCapabilities{analogPinNumber = Nothing, allowedModes = c})) + (map InternalPin [(0::Word8)..]) (map pinCaps (chunk bs)) where chunk xs = case break (== 0x7f) xs of ([], []) -> [] (cur, 0x7f:rest) -> cur : chunk rest diff --git a/System/Hardware/Arduino/SamplePrograms/Analog.hs b/System/Hardware/Arduino/SamplePrograms/Analog.hs --- a/System/Hardware/Arduino/SamplePrograms/Analog.hs +++ b/System/Hardware/Arduino/SamplePrograms/Analog.hs @@ -32,8 +32,8 @@ cur <- analogRead pot liftIO $ print cur go cur - where led = pin 13 - pot = pin 17 -- NB. Analog-3 is pin 17 on the UNO + where led = digital 13 + pot = analog 3 go cur = do digitalWrite led True delay cur digitalWrite led False diff --git a/System/Hardware/Arduino/SamplePrograms/Blink.hs b/System/Hardware/Arduino/SamplePrograms/Blink.hs --- a/System/Hardware/Arduino/SamplePrograms/Blink.hs +++ b/System/Hardware/Arduino/SamplePrograms/Blink.hs @@ -25,7 +25,7 @@ -- <> blink :: IO () blink = withArduino False "/dev/cu.usbmodemfd131" $ do - let led = pin 13 + let led = digital 13 setPinMode led OUTPUT forever $ do digitalWrite led True delay 1000 diff --git a/System/Hardware/Arduino/SamplePrograms/Button.hs b/System/Hardware/Arduino/SamplePrograms/Button.hs --- a/System/Hardware/Arduino/SamplePrograms/Button.hs +++ b/System/Hardware/Arduino/SamplePrograms/Button.hs @@ -31,8 +31,8 @@ setPinMode led OUTPUT setPinMode pb INPUT go =<< digitalRead pb - where pb = pin 2 - led = pin 13 + where pb = digital 2 + led = digital 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 --- a/System/Hardware/Arduino/SamplePrograms/Counter.hs +++ b/System/Hardware/Arduino/SamplePrograms/Counter.hs @@ -31,9 +31,9 @@ setPinMode bUp INPUT setPinMode bDown INPUT update (0::Int) - where bUp = pin 4 - bDown = pin 2 - led = pin 13 + where bUp = digital 4 + bDown = digital 2 + led = digital 13 update curVal = do liftIO $ print curVal digitalWrite led (curVal == 0) diff --git a/System/Hardware/Arduino/SamplePrograms/Distance.hs b/System/Hardware/Arduino/SamplePrograms/Distance.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/Distance.hs @@ -0,0 +1,64 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.Distance +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Measuring distance using a HC-SR04 sensor. (Data sheet: .) +-- +-- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the high +-- accuracy pulse-in command, which is needed for this sketch. However, there is a patch to add this +-- command; see: for details on how to install it. You /should/ +-- have this patched version of Firmata running on your board for this sketch to function properly. +-- +-- Accuracy: Keep in mind that measurements on a platform like Arduino is always subject to +-- various errors. Relying on this program for precise distance measurements would be a mistake. +-- The results here should be accurate to within about half-a-centimeter, provided you stay +-- within the range of HC-SR04, which is between 2 to 400 cm. For anything more precise than +-- this, you'll need to use a much more sensitive sensor. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.Distance where + +import Control.Monad (forever) +import Control.Monad.Trans (liftIO) +import Numeric (showGFloat) + +import System.Hardware.Arduino + +-- | Sound travels 343.2 meters per seconds (). +-- The echo time is round-trip, from the sensor to the object and back. Thus, if echo is high +-- for @d@ microseconds, then the distance in centimeters is: +-- +-- @ +-- d * 10^-6 * 343.2 * 10^2 / 2 +-- = 1.716e-2 * d +-- @ +microSecondsToCentimeters :: Int -> Float +microSecondsToCentimeters d = 1.716e-2 * fromIntegral d + +-- | Measure and display the distance continuously, as reported by an HC-SR04 sensor. +-- +-- Wiring: Simply connect VCC and GND of HC-SR04 to Arduino as usual. The @Echo@ line on the sensor is connected +-- to Arduino pin 2. The @Trig@ line is connected on the board to the @Echo@ line, i.e., they both connect to the +-- same pin on the Arduino. We also have a led on pin 13 that we will light-up +-- if the distance detected is less than 2 centimeters, indicating an impending crash! +-- +-- <> +distance :: IO () +distance = withArduino False "/dev/cu.usbmodemfd131" $ do + setPinMode sensor INPUT + setPinMode led OUTPUT + update + where sensor = digital 2 + led = digital 13 + measure = do mbd <- pulse sensor True 10 Nothing + case mbd of + Nothing -> liftIO $ putStrLn "Distance: No measurement received." + Just d -> do let c = microSecondsToCentimeters d + liftIO $ putStrLn $ "Distance: " ++ showGFloat (Just 2) c " centimeters." + digitalWrite led (c < 2) + update = forever $ do measure + delay 1000 diff --git a/System/Hardware/Arduino/SamplePrograms/LCD.hs b/System/Hardware/Arduino/SamplePrograms/LCD.hs --- a/System/Hardware/Arduino/SamplePrograms/LCD.hs +++ b/System/Hardware/Arduino/SamplePrograms/LCD.hs @@ -16,7 +16,7 @@ import Numeric (showHex) import System.Hardware.Arduino -import System.Hardware.Arduino.LCD +import System.Hardware.Arduino.Parts.LCD -- | Connections for a basic hitachi controller. -- See for @@ -49,14 +49,14 @@ -- -- <> 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 +-- Connections: ARDUINO Hitachi Description +-------------------------------- ----------- --------- ---------------- +hitachi = Hitachi44780 { lcdRS = digital 12 -- 4 Register-select + , lcdEN = digital 11 -- 6 Enable + , lcdD4 = digital 5 -- 11 Data 4 + , lcdD5 = digital 4 -- 12 Data 5 + , lcdD6 = digital 3 -- 13 Data 6 + , lcdD7 = digital 2 -- 14 Data 7 -- Other config variables for the display , lcdRows = 2 -- 2 rows , lcdCols = 16 -- of 16 columns diff --git a/System/Hardware/Arduino/SamplePrograms/PulseIn.hs b/System/Hardware/Arduino/SamplePrograms/PulseIn.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/PulseIn.hs @@ -0,0 +1,40 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.PulseIn +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Computes the time a button is held pressed, demonstrating the use of +-- the 'pulseIn_hostOnly' function with a time-out. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.PulseIn where + +import Control.Monad (forever) +import Control.Monad.Trans (liftIO) + +import System.Hardware.Arduino + +-- | Computes the amount of time a push-button is connected to +-- input pin 2 on the Arduino. We will wait for at most 5 seconds, +-- as a further demonstration of the time-out facility. Note that the +-- timing is done on the host side, so this measurement is inherently +-- inaccurate. +-- +-- The wiring is straightforward: Simply put a push-button between +-- digital input 2 and +5V, guarded by a 10K resistor: +-- +-- <> +pulseDemo :: IO () +pulseDemo = withArduino False "/dev/cu.usbmodemfd131" $ do + setPinMode pb INPUT + go + where pb = digital 2 + go = forever $ do + liftIO $ putStr "Ready, push-and-hold for less than 5 seconds: " + mbDur <- pulseIn_hostTiming pb True (Just 5000000) + liftIO $ putStrLn $ case mbDur of + Nothing -> "Time out!" + Just d -> "Button stayed high for: " ++ show d ++ " micro-seconds" diff --git a/System/Hardware/Arduino/SamplePrograms/PulseOut.hs b/System/Hardware/Arduino/SamplePrograms/PulseOut.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/PulseOut.hs @@ -0,0 +1,36 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.PulseOut +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Demonstrates the use of pulseOut +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.PulseOut where + +import Control.Monad (forever) +import Control.Monad.Trans (liftIO) + +import System.Hardware.Arduino + +-- | Send pulses on a led as requested by the user. Note that the timing is computed +-- on the host side, thus the duration of the pulse is subject to some error due to +-- the Firmata communication overhead. +-- +-- Wiring: Simply a led on pin 13: +-- +-- <> +pulseDemo :: IO () +pulseDemo = withArduino False "/dev/cu.usbmodemfd131" $ do + setPinMode led OUTPUT + digitalWrite led False + forever trigger + where led = digital 13 + trigger = do liftIO $ putStr "Pulse duration? (microseconds) " + d <- liftIO getLine + case reads d of + [(v, "")] -> pulseOut_hostTiming led True 0 v + _ -> liftIO $ putStrLn "Please enter a number." diff --git a/System/Hardware/Arduino/SamplePrograms/Servo.hs b/System/Hardware/Arduino/SamplePrograms/Servo.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/Servo.hs @@ -0,0 +1,68 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.Servo +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Demonstrates basic Servo motor control +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.Servo where + +import Control.Monad (forever) +import Control.Monad.Trans (liftIO) +import Data.Char (toLower) + +import System.Hardware.Arduino +import System.Hardware.Arduino.Parts.Servo + +-- | Control a servo, by executing user requests of blade movement. We allow 3 user commands: +-- +-- * @l@ to swipe from angle-0 to 180; +-- +-- * @r@ to swipe from angle-180 to 0; +-- +-- * Or any number between @0@ to @180@, which puts the servo to the desired position. +-- +-- Almost any servo motor would work with this example, though you should make sure to adjust min/max pulse durations +-- in the 'attach' command to match the datasheet of the servo you have. In this example, we have used the HS-55 feather +-- servo (), which has the values 600 to 2400 micro-seconds. +-- +-- To connect the servo to the Arduino, simply connect the VCC (red) and the GND (black) appropriately, and the signal line (white) +-- to any SERVO capable pin, in this example we're using pin number 9: +-- +-- <> +servo :: IO () +servo = withArduino False "/dev/cu.usbmodemfd131" $ do + s <- attach (digital 9) (Just 600) (Just 2400) + forever (demo s) + where demo s = do liftIO $ putStr "Enter l, r or the desired servo angle: " + a <- liftIO getLine + case (map toLower a, reads a) of + ("l", _) -> mapM_ move [0 .. 180] + ("r", _) -> mapM_ move [180, 179 .. 0] + (_, [(v, "")]) | 0 <= v && v <= 180 + -> setAngle s v + _ -> liftIO $ putStrLn "Invalid entry." + where move a = setAngle s a >> delay 100 + +-- | Control a servo, as guided by the input read from a potentiometer. The set-up is similar to the 'servo' example +-- above, except instead of querying the user for the angle, we use the readings from a potentiometer connected to +-- analog input number 2. We used a 10 KOhm potentiometer, but other pots would work just as well too: +-- +-- <> +servoAnalog :: IO () +servoAnalog = withArduino False "/dev/cu.usbmodemfd131" $ do + s <- attach (digital 9) (Just 600) (Just 2400) + setPinMode pot ANALOG + liftIO $ putStrLn "Adjust the potentiometer to control the servo!" + forever (demo s) + where pot = analog 2 + demo s = do v <- analogRead pot + setAngle s (cvt v) + delay 100 + -- Analog input will be from 0 to 1023; convert it to + -- angles, mapping 1023 to 0-degrees, and 0 to 180 + cvt i = ((1023-i) * 180) `div` 1023 diff --git a/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs b/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs new file mode 100644 --- /dev/null +++ b/System/Hardware/Arduino/SamplePrograms/SevenSegment.hs @@ -0,0 +1,71 @@ +------------------------------------------------------------------------------- +-- | +-- Module : System.Hardware.Arduino.SamplePrograms.SevenSegment +-- Copyright : (c) Levent Erkok +-- License : BSD3 +-- Maintainer : erkokl@gmail.com +-- Stability : experimental +-- +-- Control a single seven-segment display, echoing user's key presses +-- on it verbatim. We use a shift-register to reduce the number of +-- pins we need on the Arduino to control the display. +------------------------------------------------------------------------------- + +module System.Hardware.Arduino.SamplePrograms.SevenSegment where + +import Control.Monad (forever) +import Control.Monad.Trans (liftIO) +import Data.Bits (testBit) +import Data.Word (Word8) +import System.IO (hSetBuffering, stdin, BufferMode(NoBuffering)) + +import System.Hardware.Arduino +import System.Hardware.Arduino.Parts.ShiftRegisters +import System.Hardware.Arduino.Parts.SevenSegmentCodes + +-- | Connections for the Texas Instruments 74HC595 shift-register. Datasheet: . +-- In our circuit, we merely use pins 8 thru 12 on the Arduino to control the 'serial', 'enable', 'rClock', 'sClock', and 'nClear' +-- lines, respectively. Since we do not need to read the output of the shift-register, we leave the 'bits' field unconnected. +sr :: SR_74HC595 +sr = SR_74HC595 { serial = digital 8 + , nEnable = digital 9 + , rClock = digital 10 + , sClock = digital 11 + , nClear = digital 12 + , mbBits = Nothing + } + +-- | Seven-segment display demo. For each key-press, we display an equivalent pattern +-- on the connected 7-segment-display. Note that most characters are not-mappable, so +-- we use approximations if available. We use a shift-register to reduce the pin +-- requirements on the Arduino, setting the bits serially. +-- +-- Parts: +-- +-- * The seven-segment digit we use is a common-cathode single-digit display, such as +-- TDSG5150 (), or Microvity's IS121, +-- but almost any such digit would do. Just pay attention to the line-connections, +-- and do not forget the limiting resistors: 220 ohm's should do nicely. +-- +-- * The shift-register is Texas-Instruments 74HC595: . +-- Make sure to connect the register output lines to the seven-segment displays with the corresponding +-- letters. That is, shift-registers @Q_A@ (Chip-pin 15) should connect to segment @A@; @Q_B@ (Chip-pin 1) +-- to segment @B@, and so on. We do not use the shift-register @Q_H'@ (Chip-pin 9) in this design. +-- +-- <> +sevenSegment :: IO () +sevenSegment = withArduino False "/dev/cu.usbmodemfd131" $ do + initialize sr + liftIO $ do hSetBuffering stdin NoBuffering + putStrLn "Seven-Segment-Display demo." + putStrLn "For each key-press, we will try to display it as a 7-segment character." + putStrLn "If there is no good mapping (which is common), we'll just display a dot." + putStrLn "" + putStrLn "Press-keys to be shown on the display, Ctrl-C to quit.." + forever repl + where pushWord w = do mapM_ (push sr) [w `testBit` i | i <- [0..7]] + store sr + repl = do c <- liftIO getChar + case char2SS c of + Just w -> pushWord w + Nothing -> pushWord (0x01::Word8) -- the dot, which also nicely covers the '.' 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 @@ -11,25 +11,17 @@ module System.Hardware.Arduino.Utils where import Control.Concurrent (threadDelay) -import Control.Monad (void) -import Data.Bits ((.|.), shiftL) +import Data.Bits ((.|.), shiftL, (.&.), shiftR) import Data.Char (isAlphaNum, isAscii, isSpace, chr) import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (intercalate) -import Data.Word (Word8) -import System.Process (system) -import System.Info (os) -import Numeric (showHex, showIntAtBase, showFFloat) +import Data.Word (Word8, Word32) +import Data.Time (getCurrentTime, utctDayTime) +import Numeric (showHex, showIntAtBase) -- | Delay (wait) for the given number of milli-seconds --- NB. The 'threadDelay' function is broken on Mac, see --- Until there's a new GHC release that fixes this issue, we temporarily use system/sleep on Mac. delay :: Int -> IO () -delay n - | os == "darwin" - = void $ system $ "sleep " ++ showFFloat (Just 2) (fromIntegral n / (1000 :: Double)) "" - | True - = threadDelay (n*1000) +delay n = threadDelay (n*1000) -- | A simple printer that can keep track of sequence numbers. Used for debugging purposes. mkDebugPrinter :: Bool -> IO (String -> IO ()) @@ -38,7 +30,10 @@ cnt <- newIORef (1::Int) let f s = do i <- readIORef cnt writeIORef cnt (i+1) - putStrLn $ "[" ++ show i ++ "] hArduino: " ++ s + tick <- utctDayTime `fmap` getCurrentTime + let precision = 1000000 :: Integer + micro = round . (fromIntegral precision *) . toRational $ tick + putStrLn $ "[" ++ show i ++ ":" ++ show (micro :: Integer) ++ "] hArduino: " ++ s return f -- | Show a byte in a visible format. @@ -59,7 +54,28 @@ -- | Turn a lo/hi encoded Arduino string constant into a Haskell string getString :: [Word8] -> String -getString [] = "" -getString [a] = [chr (fromIntegral a)] -- shouldn't happen -getString (l:h:rest) = c : getString rest - where c = chr $ fromIntegral $ h `shiftL` 8 .|. l +getString = map (chr . fromIntegral) . fromArduinoBytes + +-- | Turn a lo/hi encoded Arduino sequence into a bunch of words, again weird +-- encoding. +fromArduinoBytes :: [Word8] -> [Word8] +fromArduinoBytes [] = [] +fromArduinoBytes [x] = [x] -- shouldn't really happen +fromArduinoBytes (l:h:rest) = c : fromArduinoBytes rest + where c = h `shiftL` 7 .|. l -- first seven bit comes from l; then extra stuff is in h + +-- | Turn a normal byte into a lo/hi Arduino byte. If you think this encoding +-- is just plain weird, you're not alone. (I suspect it has something to do +-- with error-correcting low-level serial communication of the past.) +toArduinoBytes :: Word8 -> [Word8] +toArduinoBytes w = [lo, hi] + where lo = w .&. 0x7F -- first seven bits + hi = (w `shiftR` 7) .&. 0x7F -- one extra high-bit + +-- | Convert a word to it's bytes, as would be required by Arduino comms +word2Bytes :: Word32 -> [Word8] +word2Bytes i = map fromIntegral [(i `shiftR` 24) .&. 0xFF, (i `shiftR` 16) .&. 0xFF, (i `shiftR` 8) .&. 0xFF, i .&. 0xFF] + +-- | Inverse conversion for word2Bytes +bytes2Words :: (Word8, Word8, Word8, Word8) -> Word32 +bytes2Words (a, b, c, d) = fromIntegral a `shiftL` 24 .|. fromIntegral b `shiftL` 16 .|. fromIntegral c `shiftL` 8 .|. fromIntegral d diff --git a/hArduino.cabal b/hArduino.cabal --- a/hArduino.cabal +++ b/hArduino.cabal @@ -1,5 +1,5 @@ Name: hArduino -Version: 0.3 +Version: 0.4 Category: Hardware Synopsis: Control your Arduino board from Haskell. Description: Control Arduino from Haskell, using the Firmata protocol. @@ -33,18 +33,23 @@ Library default-language: Haskell2010 ghc-options : -Wall - Build-depends : base >= 4 && < 5, serialport, bytestring - , mtl , unix, containers - -- NB. process is only needed for "sleep", since - -- threaddelay is broken on Mac. See: http://hackage.haskell.org/trac/ghc/ticket/7299 - , process + Build-depends : base >= 4 && < 5, serialport >= 0.4.5, bytestring, mtl, unix, containers, time Exposed-modules : System.Hardware.Arduino - , System.Hardware.Arduino.LCD + , System.Hardware.Arduino.Parts + , System.Hardware.Arduino.Parts.LCD + , System.Hardware.Arduino.Parts.ShiftRegisters + , System.Hardware.Arduino.Parts.SevenSegmentCodes + , System.Hardware.Arduino.Parts.Servo , System.Hardware.Arduino.SamplePrograms.Analog , System.Hardware.Arduino.SamplePrograms.Blink , System.Hardware.Arduino.SamplePrograms.Button , System.Hardware.Arduino.SamplePrograms.Counter + , System.Hardware.Arduino.SamplePrograms.Distance , System.Hardware.Arduino.SamplePrograms.LCD + , System.Hardware.Arduino.SamplePrograms.PulseIn + , System.Hardware.Arduino.SamplePrograms.PulseOut + , System.Hardware.Arduino.SamplePrograms.SevenSegment + , System.Hardware.Arduino.SamplePrograms.Servo Other-modules : System.Hardware.Arduino.Comm , System.Hardware.Arduino.Data , System.Hardware.Arduino.Firmata