hArduino 0.3 → 0.4

raw patch · 24 files changed

+1352/−587 lines, 24 filesdep +timedep −processdep ~serialportPVP ok

version bump matches the API change (PVP)

Dependencies added: time

Dependencies removed: process

Dependency ranges changed: serialport

API changes (from Hackage documentation)

Files

• CHANGES.md +44/−11
• System/Hardware/Arduino.hs +6/−2
• System/Hardware/Arduino/Comm.hs +18/−13
• System/Hardware/Arduino/Data.hs +124/−50
• System/Hardware/Arduino/Firmata.hs +145/−36
• System/Hardware/Arduino/LCD.hs +0/−432
• System/Hardware/Arduino/Parts.hs +27/−0
• System/Hardware/Arduino/Parts/LCD.hs +432/−0
• System/Hardware/Arduino/Parts/Servo.hs +85/−0
• System/Hardware/Arduino/Parts/SevenSegmentCodes.hs +32/−0
• System/Hardware/Arduino/Parts/ShiftRegisters.hs +92/−0
• System/Hardware/Arduino/Protocol.hs +5/−1
• System/Hardware/Arduino/SamplePrograms/Analog.hs +2/−2
• System/Hardware/Arduino/SamplePrograms/Blink.hs +1/−1
• System/Hardware/Arduino/SamplePrograms/Button.hs +2/−2
• System/Hardware/Arduino/SamplePrograms/Counter.hs +3/−3
• System/Hardware/Arduino/SamplePrograms/Distance.hs +64/−0
• System/Hardware/Arduino/SamplePrograms/LCD.hs +9/−9
• System/Hardware/Arduino/SamplePrograms/PulseIn.hs +40/−0
• System/Hardware/Arduino/SamplePrograms/PulseOut.hs +36/−0
• System/Hardware/Arduino/SamplePrograms/Servo.hs +68/−0
• System/Hardware/Arduino/SamplePrograms/SevenSegment.hs +71/−0
• System/Hardware/Arduino/Utils.hs +34/−18
• hArduino.cabal +12/−7

@@ -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!

@@ -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 

@@ -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

@@ -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)

@@ -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: <http://github.com/rwldrn/johnny-five/issues/18> 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

@@ -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: <http://code.google.com/p/arduino/source/browse/trunk/libraries/LiquidCrystal/>------ The Hitachi44780 data sheet is at: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>------ 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 <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>,--- 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: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>, 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

@@ -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" #-}

@@ -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: <http://code.google.com/p/arduino/source/browse/trunk/libraries/LiquidCrystal/>+--+-- The Hitachi44780 data sheet is at: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>+--+-- 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 <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>,+-- 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: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>, 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

@@ -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

@@ -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)+             ]

@@ -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: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>.+--+-- 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

@@ -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

@@ -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

@@ -25,7 +25,7 @@ --  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Blink.png>> 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

@@ -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

@@ -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)

@@ -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: <http://www.micropik.com/PDF/HCSR04.pdf>.)+--+-- 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: <http://github.com/rwldrn/johnny-five/issues/18> 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 (<http://en.wikipedia.org/wiki/Speed_of_sound>).+-- 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!+--+--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Distance.png>>+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

@@ -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 <http://en.wikipedia.org/wiki/Hitachi_HD44780_LCD_controller> for@@ -49,14 +49,14 @@ -- --  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/LCD.png>> 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

@@ -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:+--+--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Pulse.png>>+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"

@@ -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:+--+--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Blink.png>>+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."

@@ -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 (<http://www.servocity.com/html/hs-55_sub-micro.html>), 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:+--+--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Servo.png>>+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:+--+--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/ServoAnalog.png>>+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

@@ -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: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>.+-- 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 (<http://www.vishay.com/docs/83126/83126.pdf>), 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: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>.+--     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.+--+--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/SevenSegment.png>>+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 '.'

@@ -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 <http://hackage.haskell.org/trac/ghc/ticket/7299>--- 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

@@ -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