├── README.md ├── INSTALL ├── System └── Hardware │ ├── Arduino │ ├── SamplePrograms │ │ ├── Schematics │ │ │ ├── LCD.fzz │ │ │ ├── LCD.png │ │ │ ├── Analog.fzz │ │ │ ├── Analog.png │ │ │ ├── Blink.fzz │ │ │ ├── Blink.png │ │ │ ├── Button.fzz │ │ │ ├── Button.png │ │ │ ├── Counter.fzz │ │ │ ├── Counter.png │ │ │ ├── Piezo.fzz │ │ │ ├── Piezo.png │ │ │ ├── PulseIn.fzz │ │ │ ├── PulseIn.png │ │ │ ├── Servo.fzz │ │ │ ├── Servo.png │ │ │ ├── Distance.fzz │ │ │ ├── Distance.png │ │ │ ├── ServoAnalog.fzz │ │ │ ├── ServoAnalog.png │ │ │ ├── SevenSegment.fzz │ │ │ ├── SevenSegment.png │ │ │ └── HOWTO │ │ ├── Blink.hs │ │ ├── Button.hs │ │ ├── Analog.hs │ │ ├── JingleBells.hs │ │ ├── Counter.hs │ │ ├── Pulse.hs │ │ ├── Distance.hs │ │ ├── Servo.hs │ │ ├── Morse.hs │ │ ├── SevenSegment.hs │ │ ├── NumGuess.hs │ │ └── LCD.hs │ ├── Parts.hs │ ├── Parts │ │ ├── SevenSegmentCodes.hs │ │ ├── Piezo.hs │ │ ├── ShiftRegisters.hs │ │ ├── Servo.hs │ │ └── LCD.hs │ ├── Utils.hs │ ├── Protocol.hs │ ├── Comm.hs │ ├── Firmata.hs │ └── Data.hs │ └── Arduino.hs ├── .gitignore ├── COPYRIGHT ├── Setup.hs ├── Makefile ├── LICENSE ├── hArduino.cabal ├── CHANGES.md ├── .travis.yml └── StandardFirmata └── StandardFirmata.ino /README.md: -------------------------------------------------------------------------------- 1 | Please see http://leventerkok.github.io/hArduino. 2 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | The hArduino library can be installed simply by issuing cabal install 2 | like this: 3 | 4 | cabal install hArduino 5 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/LCD.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/LCD.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/LCD.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/LCD.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Analog.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Analog.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Analog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Analog.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Blink.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Blink.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Blink.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Blink.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Button.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Button.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Button.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Button.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Counter.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Counter.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Counter.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Counter.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Piezo.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Piezo.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Piezo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Piezo.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/PulseIn.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/PulseIn.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/PulseIn.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/PulseIn.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Servo.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Servo.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Servo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Servo.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .*~ 9 | tags 10 | TAGS 11 | parts 12 | dist-newstyle/ 13 | cabal.project.local* 14 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Distance.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Distance.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/Distance.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/Distance.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/ServoAnalog.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/ServoAnalog.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/ServoAnalog.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/ServoAnalog.png -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/SevenSegment.fzz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/SevenSegment.fzz -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/SevenSegment.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/LeventErkok/hArduino/HEAD/System/Hardware/Arduino/SamplePrograms/Schematics/SevenSegment.png -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2014, Levent Erkok (erkokl@gmail.com) 2 | All rights reserved. 3 | 4 | The usbArduino program is distributed with the BSD3 license. See the LICENSE file 5 | for details. 6 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Schematics/HOWTO: -------------------------------------------------------------------------------- 1 | - First use fritzing to create the FILE.fzz file for the schematics 2 | - Export from fritzing as a PNG file: FILE.png 3 | - Open the FILE.png in Preview: 4 | - Crop it on the sides 5 | - Clean-up etc. (Fritzing tends to put some junk, patch it with white cut/paste) 6 | - Tools->Adjust Size: To width 600 pixels (height auto-adjusted). Size should be ~75K 7 | - Save it! 8 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Main 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Setup module for the hArduino library 10 | ----------------------------------------------------------------------------- 11 | 12 | {-# OPTIONS_GHC -Wall #-} 13 | module Main(main) where 14 | 15 | import Distribution.Simple 16 | 17 | main :: IO () 18 | main = defaultMain 19 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Parts.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Parts 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Models of various Hardware components 10 | ------------------------------------------------------------------------------- 11 | module System.Hardware.Arduino.Parts( 12 | -- * Liquid Crystal Displays 13 | module System.Hardware.Arduino.Parts.LCD 14 | -- * Seven-Segment Conversion Codes 15 | , module System.Hardware.Arduino.Parts.SevenSegmentCodes 16 | -- * Shift-registers 17 | , module System.Hardware.Arduino.Parts.ShiftRegisters 18 | -- * Servo-motors 19 | , module System.Hardware.Arduino.Parts.Servo 20 | -- * Piezo-speakers 21 | , module System.Hardware.Arduino.Parts.Piezo 22 | ) where 23 | 24 | import System.Hardware.Arduino.Parts.LCD 25 | import System.Hardware.Arduino.Parts.SevenSegmentCodes 26 | import System.Hardware.Arduino.Parts.ShiftRegisters 27 | import System.Hardware.Arduino.Parts.Servo 28 | import System.Hardware.Arduino.Parts.Piezo 29 | 30 | {-# ANN module "HLint: ignore Use import/export shortcut" #-} 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # (c) Copyright Levent Erkok. All rights reserved. 2 | # 3 | # The hArduino library is distributed with the BSD3 license. See the LICENSE file 4 | # in the distribution for details. 5 | SHELL := /usr/bin/env bash 6 | TSTSRCS = $(shell find . -name '*.hs' -or -name '*.lhs' | grep -v Setup.hs) 7 | DEPSRCS = $(shell find . -name '*.hs' -or -name '*.lhs' -or -name '*.cabal' | grep -v Paths_hArduino.hs) 8 | CABAL = cabal 9 | TIME = /usr/bin/time 10 | 11 | define mkTags 12 | @find . -name \*.\*hs | xargs fast-tags 13 | endef 14 | 15 | .PHONY: all install sdist clean docs hlint tags 16 | 17 | all: install 18 | 19 | install: $(DEPSRCS) Makefile 20 | $(call mkTags) 21 | @$(CABAL) new-install --lib 22 | 23 | sdist: install 24 | $(CABAL) sdist 25 | 26 | veryclean: clean 27 | 28 | clean: 29 | @rm -rf dist-newstyle 30 | 31 | docs: 32 | cabal new-haddock --haddock-option=--hyperlinked-source --haddock-option=--no-warnings 33 | 34 | release: clean install sdist hlint docs 35 | @echo "*** hArduino is ready for release!" 36 | 37 | hlint: install 38 | @echo "Running HLint.." 39 | @hlint System -rhlintReport.html -i "Use otherwise" -i "Parse error" 40 | 41 | ghcid: 42 | ghcid --command="cabal new-repl --repl-options=-Wno-unused-packages" 43 | 44 | ci: 45 | haskell-ci hArduino.cabal --no-tests --no-benchmarks --no-doctest --no-hlint --email-notifications 46 | 47 | tags: 48 | $(call mkTags) 49 | -------------------------------------------------------------------------------- /System/Hardware/Arduino.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- hArduino allows Haskell programs to control Arduino boards () 10 | -- and peripherals, using the Firmata protocol (). 11 | -- 12 | -- For details, see: . 13 | ------------------------------------------------------------------------------- 14 | module System.Hardware.Arduino ( 15 | -- * Running the controller 16 | withArduino, Arduino 17 | -- * Programming the Arduino 18 | -- ** Pins 19 | , analog, digital, pin, Pin, PinMode(..), setPinMode 20 | -- ** Analog input/output (PWM) 21 | , analogRead, analogWrite 22 | -- ** Digital I/O 23 | , digitalWrite, digitalRead 24 | -- ** Programming with triggers 25 | , waitFor, waitAny, waitAnyHigh, waitAnyLow 26 | -- ** Receiving and sending pulses 27 | , pulse, pulseIn_hostTiming, pulseOut_hostTiming 28 | -- * Misc utilities 29 | , setAnalogSamplingInterval, pullUpResistor, delay, time, timeOut 30 | , queryFirmware 31 | ) 32 | where 33 | 34 | import System.Hardware.Arduino.Data 35 | import System.Hardware.Arduino.Comm 36 | import System.Hardware.Arduino.Firmata 37 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Blink.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Blink 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- The /hello world/ of the arduino world, blinking the led. 10 | ------------------------------------------------------------------------------- 11 | 12 | module System.Hardware.Arduino.SamplePrograms.Blink where 13 | 14 | import Control.Monad (forever) 15 | 16 | import System.Hardware.Arduino 17 | 18 | -- | Blink the led connected to port 13 on the Arduino UNO board. 19 | -- 20 | -- Note that you do not need any other components to run this example: Just hook 21 | -- up your Arduino to the computer and make sure StandardFirmata is running on it. 22 | -- However, you can connect a LED between Pin13 and GND if you want to blink an 23 | -- external led as well, as depicted below: 24 | -- 25 | -- <> 26 | blink :: IO () 27 | blink = withArduino False "/dev/cu.usbmodemFD131" $ do 28 | let led = digital 13 29 | setPinMode led OUTPUT 30 | forever $ do digitalWrite led True 31 | delay 1000 32 | digitalWrite led False 33 | delay 1000 34 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | usbArduino: Communicate with your Arduino board over USB 2 | 3 | Copyright (c) 2013, Levent Erkok (erkokl@gmail.com) 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | * Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | * Neither the name of the developer (Levent Erkok) nor the 14 | names of its contributors may be used to endorse or promote products 15 | derived from this software without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 20 | DISCLAIMED. IN NO EVENT SHALL LEVENT ERKOK BE LIABLE FOR ANY 21 | DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 22 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 23 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND 24 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Button.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Button 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Reads the value of a push-button and displays it's status continuously 10 | -- on the computer screen and by lighting a led on the Arduino as long as 11 | -- the button is pressed. 12 | ------------------------------------------------------------------------------- 13 | 14 | module System.Hardware.Arduino.SamplePrograms.Button where 15 | 16 | import Control.Monad.Trans (liftIO) 17 | 18 | import System.Hardware.Arduino 19 | 20 | -- | Read the value of a push-button (NO - normally open) 21 | -- connected to input pin 2 on the Arduino. We will continuously 22 | -- monitor and print the value as it changes. Also, we'll turn 23 | -- the led on pin 13 on when the switch is pressed. 24 | -- 25 | -- The wiring is straightforward: Simply put a push-button between 26 | -- digital input 2 and +5V, guarded by a 10K resistor: 27 | -- 28 | -- <> 29 | button :: IO () 30 | button = withArduino False "/dev/cu.usbmodemFD131" $ do 31 | setPinMode led OUTPUT 32 | setPinMode pb INPUT 33 | go =<< digitalRead pb 34 | where pb = digital 2 35 | led = digital 13 36 | go s = do liftIO $ putStrLn $ "Button is currently " ++ if s then "ON" else "OFF" 37 | digitalWrite led s 38 | go =<< waitFor pb 39 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Analog.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Analog 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Reads the value of an analog input, controlled by a 10K potentiometer. 10 | ------------------------------------------------------------------------------- 11 | 12 | module System.Hardware.Arduino.SamplePrograms.Analog where 13 | 14 | import Control.Monad (when) 15 | import Control.Monad.Trans (liftIO) 16 | 17 | import System.Hardware.Arduino 18 | 19 | -- | Read the value of an analog input line. We will print the value 20 | -- on the screen, and also blink a led on the Arduino based on the 21 | -- value. The smaller the value, the faster the blink. 22 | -- 23 | -- The circuit simply has a 10K potentiometer between 5V and GND, with 24 | -- the wiper line connected to analog input 3. We also have a led between 25 | -- pin 13 and GND. 26 | -- 27 | -- <> 28 | analogVal :: IO () 29 | analogVal = withArduino False "/dev/cu.usbmodemFD131" $ do 30 | setPinMode led OUTPUT 31 | setPinMode pot ANALOG 32 | cur <- analogRead pot 33 | liftIO $ print cur 34 | go cur 35 | where led = digital 13 36 | pot = analog 3 37 | go cur = do digitalWrite led True 38 | delay cur 39 | digitalWrite led False 40 | delay cur 41 | new <- analogRead pot 42 | when (cur /= new) $ liftIO $ print new 43 | go new 44 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/JingleBells.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.JingleBells 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- A (pretty bad!) rendering of Jingle Bells on a piezo speaker 10 | ------------------------------------------------------------------------------- 11 | 12 | module System.Hardware.Arduino.SamplePrograms.JingleBells where 13 | 14 | import System.Hardware.Arduino 15 | import System.Hardware.Arduino.Parts.Piezo 16 | 17 | -- | Notes for jingle-bells. Expecting a nice rendering from this encoding 18 | -- on a piezo speaker would be naive.. However, it's still recognizable! 19 | jingleBells :: [(Note, Duration)] 20 | jingleBells = m1 ++ m1 ++ m3 ++ m4 ++ wait ++ m5 ++ m6 ++ m7 ++ m8 ++ wait 21 | ++ m1 ++ m1 ++ m3 ++ m4 ++ wait ++ m5 ++ m6 ++ m15 ++ m16 22 | where m1 = [(E, Quarter), (E, Quarter), (E, Half)] 23 | m3 = [(E, Quarter), (G, Quarter), (C, Quarter), (D, Quarter)] 24 | m4 = [(E, Whole)] 25 | m5 = replicate 4 (F, Quarter) 26 | m6 = (F, Quarter) : replicate 3 (E, Quarter) 27 | m7 = [(E, Quarter), (D, Quarter), (D, Quarter), (E, Quarter)] 28 | m8 = [(D, Half), (G, Half)] 29 | m15 = [(G, Quarter), (G, Quarter), (F, Quarter), (D, Quarter)] 30 | m16 = [(C, Whole)] 31 | wait = [(R, Half)] 32 | 33 | -- | Play the jingle-bells on a PWM line, attached to pin 3. We use a 34 | -- tempo of @75@; which is fairly fast. For a slower rendring try @150@ 35 | -- or higher values. 36 | -- 37 | -- The circuit simple has a piezo speaker attached to pin 3. 38 | -- 39 | -- <> 40 | main :: IO () 41 | main = withArduino False "/dev/cu.usbmodemFD131" $ do 42 | pz <- speaker 75 (pin 3) 43 | playNotes pz jingleBells 44 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Counter.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Counter 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Demonstrates using two push-buttons to count up and down. 10 | ------------------------------------------------------------------------------- 11 | 12 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 13 | 14 | module System.Hardware.Arduino.SamplePrograms.Counter where 15 | 16 | import Control.Monad.Trans (liftIO) 17 | 18 | import System.Hardware.Arduino 19 | 20 | -- | Two push-button switches, controlling a counter value. We will increment 21 | -- the counter if the first one (@bUp@) is pressed, and decrement the value if the 22 | -- second one (@bDown@) is pressed. We also have a led connected to pin 13 (either use 23 | -- the internal or connect an external one), that we light up when the counter value 24 | -- is 0. 25 | -- 26 | -- Wiring is very simple: Up-button connected to pin 4, Down-button connected 27 | -- to pin 2, and a led on pin 13. 28 | -- 29 | -- <> 30 | counter :: IO () 31 | counter = withArduino False "/dev/cu.usbmodemFD131" $ do 32 | setPinMode led OUTPUT 33 | setPinMode bUp INPUT 34 | setPinMode bDown INPUT 35 | update (0::Int) 36 | where bUp = digital 4 37 | bDown = digital 2 38 | led = digital 13 39 | update curVal = do 40 | liftIO $ print curVal 41 | digitalWrite led (curVal == 0) 42 | ~[up, down] <- waitAnyHigh [bUp, bDown] 43 | let newVal = case (up, down) of 44 | (True, True) -> curVal -- simultaneous press 45 | (True, False) -> curVal+1 46 | (False, True) -> curVal-1 47 | (False, False) -> curVal -- can't happen 48 | update newVal 49 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Parts/SevenSegmentCodes.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Parts.SevenSegmentCodes 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Character to 7-segment display conversion. 10 | ------------------------------------------------------------------------------------------------- 11 | 12 | module System.Hardware.Arduino.Parts.SevenSegmentCodes(char2SS) where 13 | 14 | import Data.Word (Word8) 15 | 16 | -- | Convert a character to a bit-pattern, suitable for display on a seven-segment display. 17 | -- Note that most characters are just not representable in a 7-segment display, in which 18 | -- case we map it to 'Nothing'. However, some substitutions are done, for instance '(' is 19 | -- displayed the same as '['. 20 | -- 21 | -- The return value is a 'Word8', although only 7-bits are used; the least significant bit will 22 | -- always be 0. With the traditional coding, the bits correspond to segments ABCDEFG0, i.e., 23 | -- most-significant-bit will be for segment A, next for segment B, and so on. 24 | char2SS :: Char -> Maybe Word8 25 | char2SS = (`lookup` tbl) 26 | where tbl = [ ('"', 0x44), ('\'', 0x40), ('(', 0x9C), (')', 0xF0), ('-', 0x02), ('0', 0xFC), ('1', 0x60), ('2', 0xDA), ('3', 0xF2), ('4', 0x66), ('5', 0xB6) 27 | , ('6', 0xBE), ('7', 0xE0), ('8', 0xFE), ('9', 0xF6), ('=', 0x12), ('?', 0xCA), ('A', 0xEE), ('B', 0x3E), ('C', 0x9C), ('D', 0x7A), ('E', 0x9E) 28 | , ('F', 0x8E), ('G', 0xBC), ('H', 0x6E), ('I', 0x60), ('J', 0x78), ('L', 0x1C), ('N', 0x2A), ('O', 0xFC), ('P', 0xCE), ('R', 0x0A), ('S', 0xB6) 29 | , ('T', 0x1E), ('U', 0x7C), ('Y', 0x76), ('[', 0x9C), (']', 0xF0), ('_', 0x10), ('a', 0xFA), ('b', 0x3E), ('c', 0x1A), ('d', 0x7A), ('e', 0xDE) 30 | , ('f', 0x8E), ('g', 0xBC), ('h', 0x2E), ('i', 0x20), ('j', 0x78), ('l', 0x1C), ('n', 0x2A), ('o', 0x3A), ('p', 0xCE), ('q', 0xE7), ('r', 0x0A) 31 | , ('s', 0xB6), ('t', 0x1E), ('u', 0x38), ('y', 0x76), (' ', 0x00) 32 | ] 33 | -------------------------------------------------------------------------------- /hArduino.cabal: -------------------------------------------------------------------------------- 1 | Cabal-Version: 2.2 2 | Name: hArduino 3 | Version: 1.2 4 | Category: Hardware 5 | Synopsis: Control your Arduino board from Haskell. 6 | Description: hArduino allows Haskell programs to control Arduino boards () 7 | and peripherals, using the Firmata protocol (). 8 | . 9 | For details, see: . 10 | Copyright: Levent Erkok, 2013-2022 11 | License: BSD-3-Clause 12 | License-file: LICENSE 13 | Stability: Experimental 14 | Author: Levent Erkok 15 | Homepage: http://leventerkok.github.com/hArduino 16 | Bug-reports: http://github.com/LeventErkok/hArduino/issues 17 | Maintainer: Levent Erkok (erkokl@gmail.com) 18 | Build-Type: Simple 19 | Extra-Source-Files: INSTALL, README.md, COPYRIGHT, CHANGES.md 20 | 21 | source-repository head 22 | type: git 23 | location: git://github.com/LeventErkok/hArduino.git 24 | 25 | Library 26 | default-language : Haskell2010 27 | ghc-options : -Wall 28 | Build-depends : base >= 4 && < 5, serialport >= 0.4.5, bytestring, mtl, containers, time 29 | Exposed-modules : System.Hardware.Arduino 30 | , System.Hardware.Arduino.Parts 31 | , System.Hardware.Arduino.Parts.LCD 32 | , System.Hardware.Arduino.Parts.ShiftRegisters 33 | , System.Hardware.Arduino.Parts.SevenSegmentCodes 34 | , System.Hardware.Arduino.Parts.Servo 35 | , System.Hardware.Arduino.Parts.Piezo 36 | , System.Hardware.Arduino.SamplePrograms.Analog 37 | , System.Hardware.Arduino.SamplePrograms.Blink 38 | , System.Hardware.Arduino.SamplePrograms.Button 39 | , System.Hardware.Arduino.SamplePrograms.Counter 40 | , System.Hardware.Arduino.SamplePrograms.Distance 41 | , System.Hardware.Arduino.SamplePrograms.JingleBells 42 | , System.Hardware.Arduino.SamplePrograms.Morse 43 | , System.Hardware.Arduino.SamplePrograms.LCD 44 | , System.Hardware.Arduino.SamplePrograms.NumGuess 45 | , System.Hardware.Arduino.SamplePrograms.Pulse 46 | , System.Hardware.Arduino.SamplePrograms.SevenSegment 47 | , System.Hardware.Arduino.SamplePrograms.Servo 48 | Other-modules : System.Hardware.Arduino.Comm 49 | , System.Hardware.Arduino.Data 50 | , System.Hardware.Arduino.Firmata 51 | , System.Hardware.Arduino.Protocol 52 | , System.Hardware.Arduino.Utils 53 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Pulse.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Pulse 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Demonstrates 'pulseIn_hostTiming' and 'pulseOut_hostTiming' functions, sending 10 | -- and receiving pulses to/from the board. 11 | ------------------------------------------------------------------------------- 12 | 13 | module System.Hardware.Arduino.SamplePrograms.Pulse where 14 | 15 | import Control.Monad (forever) 16 | import Control.Monad.Trans (liftIO) 17 | 18 | import System.Hardware.Arduino 19 | 20 | ------------------------------------------------------------------------------- 21 | -- * Detecting pulses 22 | ------------------------------------------------------------------------------- 23 | 24 | -- | Computes the amount of time a push-button is connected to 25 | -- input pin 2 on the Arduino. We will wait for at most 5 seconds, 26 | -- as a further demonstration of the time-out facility. Note that the 27 | -- timing is done on the host side, so this measurement is inherently 28 | -- inaccurate. 29 | -- 30 | -- The wiring is straightforward: Simply put a push-button between 31 | -- digital input 2 and +5V, guarded by a 10K resistor: 32 | -- 33 | -- <> 34 | pulseInDemo :: IO () 35 | pulseInDemo = withArduino False "/dev/cu.usbmodemFD131" $ do 36 | setPinMode pb INPUT 37 | go 38 | where pb = digital 2 39 | go = forever $ do 40 | liftIO $ putStr "Ready, push-and-hold for less than 5 seconds: " 41 | mbDur <- pulseIn_hostTiming pb True (Just 5000000) 42 | liftIO $ putStrLn $ case mbDur of 43 | Nothing -> "Time out!" 44 | Just d -> "Button stayed high for: " ++ show d ++ " micro-seconds" 45 | 46 | ------------------------------------------------------------------------------- 47 | -- * Sending pulses 48 | ------------------------------------------------------------------------------- 49 | 50 | -- | Send pulses on a led as requested by the user. Note that the timing is computed 51 | -- on the host side, thus the duration of the pulse is subject to some error due to 52 | -- the Firmata communication overhead. 53 | -- 54 | -- Wiring: Simply a led on pin 13: 55 | -- 56 | -- <> 57 | pulseOutDemo :: IO () 58 | pulseOutDemo = withArduino False "/dev/cu.usbmodemFD131" $ do 59 | setPinMode led OUTPUT 60 | digitalWrite led False 61 | forever trigger 62 | where led = digital 13 63 | trigger = do liftIO $ putStr "Pulse duration? (microseconds) " 64 | d <- liftIO getLine 65 | case reads d of 66 | [(v, "")] -> pulseOut_hostTiming led True 0 v 67 | _ -> liftIO $ putStrLn "Please enter a number." 68 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Distance.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Distance 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Measuring distance using a HC-SR04 sensor. (Data sheet: .) 10 | -- 11 | -- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the high 12 | -- accuracy pulse-in command, which is needed for this sketch. However, there is a patch to add this 13 | -- command; see: for details on how to install it. You /should/ 14 | -- have this patched version of Firmata running on your board for this sketch to function properly. 15 | -- 16 | -- Accuracy: Keep in mind that measurements on a platform like Arduino is always subject to 17 | -- various errors. Relying on this program for precise distance measurements would be a mistake. 18 | -- The results here should be accurate to within about half-a-centimeter, provided you stay 19 | -- within the range of HC-SR04, which is between 2 to 400 cm. For anything more precise than 20 | -- this, you'll need to use a much more sensitive sensor. 21 | ------------------------------------------------------------------------------- 22 | 23 | module System.Hardware.Arduino.SamplePrograms.Distance where 24 | 25 | import Control.Monad (forever) 26 | import Control.Monad.Trans (liftIO) 27 | import Numeric (showGFloat) 28 | 29 | import System.Hardware.Arduino 30 | 31 | -- | Sound travels 343.2 meters per second (). 32 | -- The echo time is round-trip, from the sensor to the object and back. Thus, if echo is high 33 | -- for @d@ microseconds, then the distance in centimeters is: 34 | -- 35 | -- @ 36 | -- d * 10^-6 * 343.2 * 10^2 / 2 37 | -- = 1.716e-2 * d 38 | -- @ 39 | microSecondsToCentimeters :: Int -> Float 40 | microSecondsToCentimeters d = 1.716e-2 * fromIntegral d 41 | 42 | -- | Measure and display the distance continuously, as reported by an HC-SR04 sensor. 43 | -- 44 | -- Wiring: Simply connect VCC and GND of HC-SR04 to Arduino as usual. The @Echo@ line on the sensor is connected 45 | -- to Arduino pin 2. The @Trig@ line is connected on the board to the @Echo@ line, i.e., they both connect to the 46 | -- same pin on the Arduino. We also have a led on pin 13 that we will light-up 47 | -- if the distance detected is less than 5 centimeters, indicating an impending crash! 48 | -- 49 | -- <> 50 | distance :: IO () 51 | distance = withArduino False "/dev/cu.usbmodemFD131" $ do 52 | setPinMode sensor INPUT 53 | setPinMode led OUTPUT 54 | update 55 | where sensor = digital 2 56 | led = digital 13 57 | measure = do mbd <- pulse sensor True 10 Nothing 58 | case mbd of 59 | Nothing -> liftIO $ putStrLn "Distance: No measurement received." 60 | Just d -> do let c = microSecondsToCentimeters d 61 | liftIO $ putStrLn $ "Distance: " ++ showGFloat (Just 2) c " centimeters." 62 | digitalWrite led (c < 5) 63 | update = forever $ do measure 64 | delay 1000 65 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Servo.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Servo 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Demonstrates basic Servo motor control 10 | ------------------------------------------------------------------------------- 11 | 12 | module System.Hardware.Arduino.SamplePrograms.Servo where 13 | 14 | import Control.Monad (forever) 15 | import Control.Monad.Trans (liftIO) 16 | import Data.Char (toLower) 17 | 18 | import System.Hardware.Arduino 19 | import System.Hardware.Arduino.Parts.Servo 20 | 21 | -- | Control a servo, by executing user requests of blade movement. We allow 3 user commands: 22 | -- 23 | -- * @l@ to swipe from angle-0 to 180; 24 | -- 25 | -- * @r@ to swipe from angle-180 to 0; 26 | -- 27 | -- * Or any number between @0@ to @180@, which puts the servo to the desired position. 28 | -- 29 | -- Almost any servo motor would work with this example, though you should make sure to adjust min/max pulse durations 30 | -- in the 'attach' command to match the datasheet of the servo you have. In this example, we have used the HS-55 feather 31 | -- servo (), which has the values 600 to 2400 micro-seconds. 32 | -- 33 | -- To connect the servo to the Arduino, simply connect the VCC (red) and the GND (black) appropriately, and the signal line (white) 34 | -- to any SERVO capable pin, in this example we're using pin number 9: 35 | -- 36 | -- <> 37 | servo :: IO () 38 | servo = withArduino False "/dev/cu.usbmodemFD131" $ do 39 | s <- attach (digital 9) (Just 600) (Just 2400) 40 | forever (demo s) 41 | where demo s = do liftIO $ putStr "Enter l, r or the desired servo angle: " 42 | a <- liftIO getLine 43 | case (map toLower a, reads a) of 44 | ("l", _) -> mapM_ move [0 .. 180] 45 | ("r", _) -> mapM_ move [180, 179 .. 0] 46 | (_, [(v, "")]) | 0 <= v && v <= 180 47 | -> setAngle s v 48 | _ -> liftIO $ putStrLn "Invalid entry." 49 | where move a = setAngle s a >> delay 100 50 | 51 | -- | Control a servo, as guided by the input read from a potentiometer. The set-up is similar to the 'servo' example 52 | -- above, except instead of querying the user for the angle, we use the readings from a potentiometer connected to 53 | -- analog input number 2. We used a 10 KOhm potentiometer, but other pots would work just as well too: 54 | -- 55 | -- <> 56 | servoAnalog :: IO () 57 | servoAnalog = withArduino False "/dev/cu.usbmodemFD131" $ do 58 | s <- attach (digital 9) (Just 600) (Just 2400) 59 | setPinMode pot ANALOG 60 | liftIO $ putStrLn "Adjust the potentiometer to control the servo!" 61 | forever (demo s) 62 | where pot = analog 2 63 | demo s = do v <- analogRead pot 64 | setAngle s (cvt v) 65 | delay 100 66 | -- Analog input will be from 0 to 1023; convert it to 67 | -- angles, mapping 1023 to 0-degrees, and 0 to 180 68 | cvt i = ((1023-i) * 180) `div` 1023 69 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Parts/Piezo.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Parts.Piezo 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Abstractions for piezo speakers. 10 | ------------------------------------------------------------------------------------------------- 11 | 12 | module System.Hardware.Arduino.Parts.Piezo( 13 | -- * Declaring a piezo speaker 14 | Piezo, speaker 15 | -- * Notes you can play, and durations 16 | , Note(..), Duration(..) 17 | -- * Playing a note, rest, or silencing 18 | , playNote, rest, silence 19 | -- * Play a sequence of notes: 20 | , playNotes 21 | ) where 22 | 23 | import Data.Bits (shiftR, (.&.)) 24 | import Data.Maybe (fromMaybe) 25 | 26 | import System.Hardware.Arduino 27 | import System.Hardware.Arduino.Comm 28 | import System.Hardware.Arduino.Data 29 | 30 | -- | A piezo speaker. Note that this type is abstract, use 'speaker' to 31 | -- create an instance. 32 | data Piezo = Piezo { piezoPin :: IPin -- ^ The internal-pin that controls the speaker 33 | , tempo :: Int -- ^ Tempo for the melody 34 | } 35 | 36 | -- | Create a piezo speaker instance. 37 | speaker :: Int -- ^ Tempo. Higher numbers mean faster melodies; in general. 38 | -> Pin -- ^ Pin controlling the piezo. Should be a pin that supports PWM mode. 39 | -> Arduino Piezo 40 | speaker t p = do debug $ "Attaching speaker on pin: " ++ show p 41 | setPinMode p PWM 42 | (ip, _) <- convertAndCheckPin "Piezo.speaker" p PWM 43 | return Piezo { piezoPin = ip, tempo = t } 44 | 45 | -- | Musical notes, notes around middle-C 46 | data Note = A | B | C | D | E | F | G | R deriving (Eq, Show) -- R is for rest 47 | 48 | -- | Beat counts 49 | data Duration = Whole | Half | Quarter | Eight deriving (Eq, Show) 50 | 51 | -- | Convert a note to its frequency appropriate for Piezo 52 | frequency :: Note -> Int 53 | frequency n = fromMaybe 0 (n `lookup` fs) 54 | where fs = [(A, 440), (B, 493), (C, 261), (D, 294), (E, 329), (F, 349), (G, 392), (R, 0)] 55 | 56 | -- | Convert a duration to a delay amount 57 | interval :: Piezo -> Duration -> Int 58 | interval p Whole = 8 * interval p Eight 59 | interval p Half = 4 * interval p Eight 60 | interval p Quarter = 2 * interval p Eight 61 | interval p Eight = tempo p 62 | 63 | -- | Turn the speaker off 64 | silence :: Piezo -> Arduino () 65 | silence (Piezo p _) = send $ AnalogPinWrite p 0 0 66 | 67 | -- | Keep playing a given note on the piezo: 68 | setNote :: Piezo -> Note -> Arduino () 69 | setNote (Piezo p _) n = send $ AnalogPinWrite p (fromIntegral lsb) (fromIntegral msb) 70 | where f = frequency n 71 | lsb = f .&. 0x7f 72 | msb = (f `shiftR` 7) .&. 0x7f 73 | 74 | -- | Play the given note for the duration 75 | playNote :: Piezo -> (Note, Duration) -> Arduino () 76 | playNote pz (n, d) = do setNote pz n 77 | delay (interval pz d) 78 | silence pz 79 | 80 | -- | Play a sequence of notes with given durations: 81 | playNotes :: Piezo -> [(Note, Duration)] -> Arduino () 82 | playNotes pz = go 83 | where go [] = silence pz 84 | go (nd@(_, d):r) = do playNote pz nd 85 | delay (interval pz d `div` 3) -- heuristically found.. :-) 86 | go r 87 | 88 | -- | Rest for a given duration: 89 | rest :: Piezo -> Duration -> Arduino () 90 | rest pz d = delay (interval pz d) 91 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Utils.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Utils 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Internal utilities 10 | ------------------------------------------------------------------------------- 11 | module System.Hardware.Arduino.Utils where 12 | 13 | import Control.Concurrent (threadDelay) 14 | import Data.Bits ((.|.), shiftL, (.&.), shiftR) 15 | import Data.Char (isAlphaNum, isAscii, isSpace, chr) 16 | import Data.IORef (newIORef, readIORef, writeIORef) 17 | import Data.List (intercalate) 18 | import Data.Word (Word8, Word32) 19 | import Data.Time (getCurrentTime, utctDayTime) 20 | import Numeric (showHex, showIntAtBase) 21 | 22 | -- | Delay (wait) for the given number of milli-seconds 23 | delay :: Int -> IO () 24 | delay n = threadDelay (n*1000) 25 | 26 | -- | A simple printer that can keep track of sequence numbers. Used for debugging purposes. 27 | mkDebugPrinter :: Bool -> IO (String -> IO ()) 28 | mkDebugPrinter False = return (const (return ())) 29 | mkDebugPrinter True = do 30 | cnt <- newIORef (1::Int) 31 | let f s = do i <- readIORef cnt 32 | writeIORef cnt (i+1) 33 | tick <- utctDayTime `fmap` getCurrentTime 34 | let precision = 1000000 :: Integer 35 | micro = round . (fromIntegral precision *) . toRational $ tick 36 | putStrLn $ "[" ++ show i ++ ":" ++ show (micro :: Integer) ++ "] hArduino: " ++ s 37 | return f 38 | 39 | -- | Show a byte in a visible format. 40 | showByte :: Word8 -> String 41 | showByte i | isVisible = [c] 42 | | i <= 0xf = '0' : showHex i "" 43 | | True = showHex i "" 44 | where c = chr $ fromIntegral i 45 | isVisible = isAscii c && isAlphaNum c && isSpace c 46 | 47 | -- | Show a list of bytes 48 | showByteList :: [Word8] -> String 49 | showByteList bs = "[" ++ intercalate ", " (map showByte bs) ++ "]" 50 | 51 | -- | Show a number as a binary value 52 | showBin :: (Integral a, Show a) => a -> String 53 | showBin n = showIntAtBase 2 (head . show) n "" 54 | 55 | -- | Turn a lo/hi encoded Arduino string constant into a Haskell string 56 | getString :: [Word8] -> String 57 | getString = map (chr . fromIntegral) . fromArduinoBytes 58 | 59 | -- | Turn a lo/hi encoded Arduino sequence into a bunch of words, again weird 60 | -- encoding. 61 | fromArduinoBytes :: [Word8] -> [Word8] 62 | fromArduinoBytes [] = [] 63 | fromArduinoBytes [x] = [x] -- shouldn't really happen 64 | fromArduinoBytes (l:h:rest) = c : fromArduinoBytes rest 65 | where c = h `shiftL` 7 .|. l -- first seven bit comes from l; then extra stuff is in h 66 | 67 | -- | Turn a normal byte into a lo/hi Arduino byte. If you think this encoding 68 | -- is just plain weird, you're not alone. (I suspect it has something to do 69 | -- with error-correcting low-level serial communication of the past.) 70 | toArduinoBytes :: Word8 -> [Word8] 71 | toArduinoBytes w = [lo, hi] 72 | where lo = w .&. 0x7F -- first seven bits 73 | hi = (w `shiftR` 7) .&. 0x7F -- one extra high-bit 74 | 75 | -- | Convert a word to it's bytes, as would be required by Arduino comms 76 | word2Bytes :: Word32 -> [Word8] 77 | word2Bytes i = map fromIntegral [(i `shiftR` 24) .&. 0xFF, (i `shiftR` 16) .&. 0xFF, (i `shiftR` 8) .&. 0xFF, i .&. 0xFF] 78 | 79 | -- | Inverse conversion for word2Bytes 80 | bytes2Words :: (Word8, Word8, Word8, Word8) -> Word32 81 | bytes2Words (a, b, c, d) = fromIntegral a `shiftL` 24 .|. fromIntegral b `shiftL` 16 .|. fromIntegral c `shiftL` 8 .|. fromIntegral d 82 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/Morse.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.Morse 4 | -- Copyright : (c) Antoine R. Dumont, Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Morse code blinker. Original by Antoine R. Dumont, modified to simplify 10 | -- and fit into the existing examples structure. 11 | ------------------------------------------------------------------------------- 12 | module System.Hardware.Arduino.SamplePrograms.Morse where 13 | 14 | import Control.Monad (forever) 15 | import Control.Monad.Trans (liftIO) 16 | import Data.Char (toUpper) 17 | import Data.List (intercalate) 18 | import Data.Maybe (fromMaybe) 19 | 20 | import System.Hardware.Arduino 21 | 22 | -- | A dit or a dah is all we need for Morse: 23 | -- A @dit@ is a dot; and a @dah@ is a dash in the Morsian world. 24 | -- We use 'LBreak' and 'WBreak' to indicate a letter and a word break 25 | -- so we can insert some delay between letters and words as we 26 | -- transmit. 27 | data Morse = Dit | Dah | LBreak | WBreak 28 | deriving Show 29 | 30 | -- | Morse code dictionary 31 | dict :: [(Char, [Morse])] 32 | dict = map encode m 33 | where encode (k, s) = (k, map (\c -> if c == '.' then Dit else Dah) s) 34 | m = [ ('A', ".-" ), ('B', "-..." ), ('C', "-.-." ), ('D', "-.." ), ('E', "." ) 35 | , ('F', "..-." ), ('G', "--." ), ('H', "...." ), ('I', ".." ), ('J', ".---" ) 36 | , ('K', "-.-" ), ('L', ".-.." ), ('M', "--" ), ('N', "-." ), ('O', "---" ) 37 | , ('P', ".--." ), ('Q', "--.-" ), ('R', ".-." ), ('S', "..." ), ('T', "-" ) 38 | , ('U', "..-" ), ('V', "...-" ), ('W', ".--" ), ('X', "-..-" ), ('Y', "-.--" ) 39 | , ('Z', "--.." ), ('0', "-----"), ('1', ".----"), ('2', "..---"), ('3', "...--") 40 | , ('4', "....-"), ('5', "....."), ('6', "-...."), ('7', "--..."), ('8', "---..") 41 | , ('9', "----."), ('+', ".-.-."), ('/', "-..-."), ('=', "-...-") 42 | ] 43 | 44 | -- | Given a sentence, decode it. We simply drop any letters that we 45 | -- do not have a mapping for. 46 | decode :: String -> [Morse] 47 | decode = intercalate [WBreak] . map (intercalate [LBreak] . map cvt) . words 48 | where cvt c = fromMaybe [] $ toUpper c `lookup` dict 49 | 50 | -- | Given a morsified sentence, compute the delay times. A 'Left' value means 51 | -- turn the led on that long, a 'Right' value means turn it off that long. 52 | morsify :: [Morse] -> [Either Int Int] 53 | morsify = map t 54 | where unit = 300 55 | t Dit = Left $ 1 * unit 56 | t Dah = Left $ 3 * unit 57 | t LBreak = Right $ 3 * unit 58 | t WBreak = Right $ 7 * unit 59 | 60 | -- | Finally, turn a full sentence into a sequence of blink on/off codes 61 | transmit :: Pin -> String -> Arduino () 62 | transmit p = sequence_ . concatMap code . morsify . decode 63 | where code (Left i) = [digitalWrite p True, delay i, digitalWrite p False, delay i] 64 | code (Right i) = [digitalWrite p False, delay i] 65 | 66 | -- | A simple demo driver. To run this example, you only need the Arduino connected to your 67 | -- computer, no other hardware is needed. We use the internal led on pin 13. Of course, 68 | -- you can attach a led to pin 13 as well, for artistic effect. 69 | -- 70 | -- <> 71 | morseDemo :: IO () 72 | morseDemo = withArduino False "/dev/cu.usbmodemFD131" $ do 73 | setPinMode led OUTPUT 74 | forever send 75 | where led = digital 13 76 | send = do liftIO $ putStr "Message? " 77 | m <- liftIO getLine 78 | transmit led m 79 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/SevenSegment.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.SevenSegment 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Control a single seven-segment display, echoing user's key presses 10 | -- on it verbatim. We use a shift-register to reduce the number of 11 | -- pins we need on the Arduino to control the display. 12 | ------------------------------------------------------------------------------- 13 | 14 | module System.Hardware.Arduino.SamplePrograms.SevenSegment where 15 | 16 | import Control.Monad (forever) 17 | import Control.Monad.Trans (liftIO) 18 | import Data.Bits (testBit) 19 | import Data.Word (Word8) 20 | import System.IO (hSetBuffering, stdin, BufferMode(NoBuffering)) 21 | 22 | import System.Hardware.Arduino 23 | import System.Hardware.Arduino.Parts.ShiftRegisters 24 | import System.Hardware.Arduino.Parts.SevenSegmentCodes 25 | 26 | -- | Connections for the Texas Instruments 74HC595 shift-register. Datasheet: . 27 | -- In our circuit, we merely use pins 8 thru 12 on the Arduino to control the 'serial', 'enable', 'rClock', 'sClock', and 'nClear' 28 | -- lines, respectively. Since we do not need to read the output of the shift-register, we leave the 'mbBits' field unconnected. 29 | sr :: SR_74HC595 30 | sr = SR_74HC595 { serial = digital 8 31 | , nEnable = digital 9 32 | , rClock = digital 10 33 | , sClock = digital 11 34 | , nClear = digital 12 35 | , mbBits = Nothing 36 | } 37 | 38 | -- | Seven-segment display demo. For each key-press, we display an equivalent pattern 39 | -- on the connected 7-segment-display. Note that most characters are not-mappable, so 40 | -- we use approximations if available. We use a shift-register to reduce the pin 41 | -- requirements on the Arduino, setting the bits serially. 42 | -- 43 | -- Parts: 44 | -- 45 | -- * The seven-segment digit we use is a common-cathode single-digit display, such as 46 | -- TDSG5150 (), or Microvity's IS121, 47 | -- but almost any such digit would do. Just pay attention to the line-connections, 48 | -- and do not forget the limiting resistors: 220 ohm's should do nicely. 49 | -- 50 | -- * The shift-register is Texas-Instruments 74HC595: . 51 | -- Make sure to connect the register output lines to the seven-segment displays with the corresponding 52 | -- letters. That is, shift-registers @Q_A@ (Chip-pin 15) should connect to segment @A@; @Q_B@ (Chip-pin 1) 53 | -- to segment @B@, and so on. We do not use the shift-register @Q_H'@ (Chip-pin 9) in this design. 54 | -- 55 | -- <> 56 | sevenSegment :: IO () 57 | sevenSegment = withArduino False "/dev/cu.usbmodemFD131" $ do 58 | initialize sr 59 | liftIO $ do hSetBuffering stdin NoBuffering 60 | putStrLn "Seven-Segment-Display demo." 61 | putStrLn "For each key-press, we will try to display it as a 7-segment character." 62 | putStrLn "If there is no good mapping (which is common), we'll just display a dot." 63 | putStrLn "" 64 | putStrLn "Press-keys to be shown on the display, Ctrl-C to quit.." 65 | forever repl 66 | where pushWord w = do mapM_ (push sr) [w `testBit` i | i <- [0..7]] 67 | store sr 68 | repl = do c <- liftIO getChar 69 | case char2SS c of 70 | Just w -> pushWord w 71 | Nothing -> pushWord (0x01::Word8) -- the dot, which also nicely covers the '.' 72 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Parts/ShiftRegisters.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Parts.ShiftRegisters 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Abstractions for shift-register IC parts. 10 | ------------------------------------------------------------------------------------------------- 11 | 12 | {-# LANGUAGE NamedFieldPuns #-} 13 | module System.Hardware.Arduino.Parts.ShiftRegisters( 14 | -- * Shift register abstraction 15 | ShiftRegister(..) 16 | -- * Supported shift-registers 17 | -- ** Texas Instruments 7HC595 18 | , SR_74HC595(..) 19 | ) where 20 | 21 | import Data.Foldable (forM_) 22 | 23 | import System.Hardware.Arduino 24 | import System.Hardware.Arduino.Data (die) 25 | 26 | -- | A shift-register class as supported by the hArduino library. 27 | class ShiftRegister a where 28 | -- | Capacity 29 | size :: a -> Int 30 | -- | Display name 31 | name :: a -> String 32 | -- | Data sheet (typically a URL) 33 | dataSheet :: a -> String 34 | -- | Initialize the shift-register 35 | initialize :: a -> Arduino () 36 | -- | Disable the output, putting it into high-impedance state 37 | disable :: a -> Arduino () 38 | -- | Enable the output, getting it out of the high-impedance state 39 | enable :: a -> Arduino () 40 | -- | Clear the contents 41 | clear :: a -> Arduino () 42 | -- | Push a single bit down the shift-register 43 | push :: a -> Bool -> Arduino () 44 | -- | Store the pushed-in values in the storage register 45 | store :: a -> Arduino () 46 | -- | Read the current value stored 47 | read :: a -> Arduino [Bool] 48 | 49 | -- | The Texas-Instruments 74HC595 8-bit shift register with 3-state 50 | -- outputs. Data sheet: . 51 | -- 52 | -- This is a versatile 8-bit shift-register with separate serial and register 53 | -- clocks, allowing shifting to be done while the output remains untouched. We 54 | -- model all control pins provided. Note that the enable and clear lines are 55 | -- negated. 56 | data SR_74HC595 = SR_74HC595 { 57 | serial :: Pin -- ^ Chip Pin: 14: Serial input 58 | , nEnable :: Pin -- ^ Chip Pin: 13: Negated output-enable 59 | , rClock :: Pin -- ^ Chip Pin: 12: Register clock, positive triggered 60 | , sClock :: Pin -- ^ Chip Pin: 11: Serial clock, positive triggered 61 | , nClear :: Pin -- ^ Chip Pin: 10: Negated clear-data 62 | , mbBits :: Maybe [Pin] -- ^ Chip Pins: 15, 1-7, and 8: Sequence of output bits, connect only if reading is necessary 63 | } 64 | 65 | instance ShiftRegister SR_74HC595 where 66 | size _ = 8 67 | name _ = "TI SR_74HC595" 68 | dataSheet _ = "http://www.ti.com/lit/ds/symlink/sn74hc595.pdf" 69 | initialize sr@SR_74HC595{nEnable, serial, rClock, sClock, nClear, mbBits} = 70 | do mapM_ (`setPinMode` OUTPUT) [nEnable, nClear, serial, rClock, sClock] 71 | clear sr 72 | enable sr 73 | forM_ mbBits (mapM_ (`setPinMode` INPUT)) 74 | disable SR_74HC595{nEnable} = digitalWrite nEnable True 75 | enable SR_74HC595{nEnable} = digitalWrite nEnable False 76 | clear SR_74HC595{nClear} = do digitalWrite nClear False 77 | digitalWrite nClear True 78 | push SR_74HC595{serial, sClock} b = fallingEdge sClock $ digitalWrite serial b 79 | store SR_74HC595{rClock} = fallingEdge rClock (return ()) 80 | read sr@SR_74HC595{mbBits} = case mbBits of 81 | Nothing -> die (name sr ++ ": Not configured for bit-reading") 82 | [ "Datasheet: " ++ dataSheet sr 83 | , "Make sure to set the `bits' field when configuring" 84 | ] 85 | Just pins -> mapM digitalRead pins 86 | 87 | -- | Execute action, followed by a simulated falling edge on the given clock 88 | fallingEdge :: Pin -> Arduino a -> Arduino a 89 | fallingEdge clk action = do r <- action 90 | digitalWrite clk True 91 | digitalWrite clk False 92 | return r 93 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | * Hackage: (http://hackage.haskell.org/package/hArduino) 2 | * GitHub: (http://leventerkok.github.com/hArduino) 3 | 4 | * Latest Hackage released version: 1.2 5 | 6 | ### Version 1.2, 2022-12-14 7 | * Make hArduino compile with recent versions of GHC 8 | 9 | ### Version 1.1, 2016-03-27 10 | * Unfortunately the Firmata project moved on, and hArduino no longer 11 | works with the latest release of StandardFirmata. This release mainly 12 | makes a note of this fact, and points to an older version of StandardFirmata 13 | that hArduino has been tested against. Volunteers encouraged to 14 | contribute to bring hArduino up-to-date: Contact me if interested! 15 | 16 | In the mean-time, use the following version of StandardFirmata, which is 17 | known to work with hArduino: (http://github.com/LeventErkok/hArduino/blob/master/StandardFirmata/StandardFirmata.ino) 18 | 19 | * Make the pin-capabilities code robust, by explicitly catching 20 | (and ignoring) capabilities we do not know/care about. Previously 21 | we were simply using toEnum, which choked with new versions 22 | of Firmata as they added new options. Thanks to Can Akcura on 23 | Github for pointing out the issue. 24 | 25 | 26 | ### Version 0.9, 2014-02-09 27 | * Added example program for Morse encoding. 28 | Original idea by Antoine Dumont. Thanks! 29 | 30 | ### Version 0.8, 2013-12-15 31 | * Add support for Piezo speakers 32 | * Add simple musical note playing support, and a 33 | jingle-bells playing example. (Not a great 34 | rendering, but still recognizable!) 35 | 36 | ### Version 0.7, 2013-11-09 37 | * Export LCD type, for ease of programming 38 | * Added the number guessing game using the OSEpp shield. 39 | Thanks to David Palmer for lending me his shield to play with! 40 | 41 | ### Version 0.6, 2013-03-08 42 | 43 | * Make hArduino Windows friendly by removing dependence 44 | on the unix package. Thanks to Andriy Drozdyuk for pointing 45 | out the Windows compilation issue. (Tested on Windows 7.) 46 | 47 | ### Version 0.5, 2013-03-07 48 | 49 | * New hardware components supported: 50 | * Shift-registers 51 | * Seven-segment displays 52 | * Servo-motors 53 | * New examples: 54 | * PulseIn: Demonstrates the use of reading pulses 55 | * PulseOut: Demonstrates the use of sending pulses 56 | * Distance: Measure the distance using an HC-SC04 sensor 57 | * Seven-segment: Display characters on a seven-segment display 58 | * Servo: Control a servo board 59 | * New functions: 60 | * pulseIn_hostTiming/pulseOut_hostTiming: Send and receive pulses. 61 | * NB. These functions use host-timing: watch out for accuracy 62 | * pulse: Send and receive a digital pulse on a pin. 63 | * This function is more accurate than the pair above, as 64 | it uses a custom Firmata command to measure the pulse. 65 | However, you need a custom Firmata version to use this 66 | function, as the standard version that ships with Arduino 67 | as of March 2013 does not support this functionality yet. 68 | * time: Measure the time taken by an Arduino action 69 | * timeOut: Run an action only for the given-time-out 70 | 71 | ### Version 0.4, 2013-03-05 72 | 73 | * Bugfix: Remove spurious extra call to user program 74 | * Rework pin assignment logic, making use of analog/digital pins much more clearer. 75 | * Better exception handling 76 | * Remove threadDelay workaround on the Mac. NB. If you are running on OSX, then 77 | you need at least GHC 7.6.2! 78 | 79 | ### Version 0.3, 2013-02-10 80 | 81 | * Library 82 | * Add support for pull-up resistors 83 | * Implement routines for waiting on digital triggers 84 | * Add support for reading analog values and setting sampling frequency. 85 | * Add support for LCDs (based on the Hitachi 44780 chip) 86 | * Better handling for Ctrl-C interrupts 87 | * Examples 88 | * Counter: Use push buttons to count up and down 89 | * Analog: Reading analog values 90 | * LCD: Control an LCD, writing text/glyphs etc 91 | 92 | ### Version 0.2, 2013-01-28 93 | 94 | * Library 95 | * Rewrite the communication engine 96 | * Digital input/output implementation 97 | * Examples 98 | * Button: Detecting putton pushes 99 | 100 | ### Version 0.1, 2013-01-14 101 | 102 | * Library 103 | * Initial design 104 | * Created home page at: http://leventerkok.github.com/hArduino 105 | * Examples 106 | * Blink: Hello world! 107 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Parts/Servo.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Parts.Servo 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Abstractions for servo motors. See "System.Hardware.Arduino.SamplePrograms.Servo" for 10 | -- example uses. 11 | ------------------------------------------------------------------------------------------------- 12 | 13 | {-# LANGUAGE NamedFieldPuns #-} 14 | module System.Hardware.Arduino.Parts.Servo( 15 | -- * Attaching a servo motor on a pin 16 | Servo, attach 17 | -- * Setting servo position 18 | , setAngle 19 | ) where 20 | 21 | import Control.Monad (when) 22 | import Data.Bits (shiftR, (.&.)) 23 | import Data.Maybe (fromMaybe) 24 | 25 | import System.Hardware.Arduino 26 | import System.Hardware.Arduino.Comm 27 | import System.Hardware.Arduino.Data 28 | 29 | -- | A servo motor. Note that this type is abstract, use 'attach' to 30 | -- create an instance. 31 | data Servo = Servo { servoPin :: IPin -- ^ The internal-pin that controls the servo 32 | , minPulse :: Int -- ^ Pulse-width (microseconds) for the minumum (0-degree) angle. 33 | , maxPulse :: Int -- ^ Pulse-width (microseconds) for the maximum (typically 180-degree) angle. 34 | } 35 | 36 | -- | Create a servo motor instance. The default values for the min/max angle pulse-widths, while typical, 37 | -- may need to be adjusted based on the specs of the actual servo motor. Check the data-sheet for your 38 | -- servo to find the proper values. The default values of @544@ and @2400@ microseconds are typical, so you might 39 | -- want to start by passing 'Nothing' for both parameters and adjusting as necessary. 40 | attach :: Pin -- ^ Pin controlling the servo. Should be a pin that supports SERVO mode. 41 | -> Maybe Int -- ^ Pulse-width (in microseconds) for the minumum 0-degree angle. Default: @544@. 42 | -> Maybe Int -- ^ Pulse-width (in microseconds) for the maximum, typically 180-degree, angle. Default: @2400@. 43 | -> Arduino Servo 44 | attach p mbMin mbMax 45 | | Just m <- mbMin, m < 0 46 | = die "Servo.attach: minimum pulse width must be positive" ["Received: " ++ show m] 47 | | Just m <- mbMax, m < 0 48 | = die "Servo.attach: maximum pulse width must be positive" ["Received: " ++ show m] 49 | | True 50 | = do let minPulse = fromMaybe 544 mbMin 51 | maxPulse = fromMaybe 2400 mbMax 52 | debug $ "Attaching servo on pin: " ++ show p ++ " with parameters: " ++ show (minPulse, maxPulse) 53 | when (minPulse >= maxPulse) $ die "Servo.attach: min pulse duration must be less than max pulse duration" 54 | [ "Received min-pulse: " ++ show minPulse 55 | , "Received max-pulse: " ++ show maxPulse 56 | ] 57 | setPinMode p SERVO 58 | (ip, _) <- convertAndCheckPin "Servo.attach" p SERVO 59 | return Servo { servoPin = ip 60 | , minPulse = fromMaybe 544 mbMin 61 | , maxPulse = fromMaybe 2400 mbMax 62 | } 63 | 64 | -- | Set the angle of the servo. The argument should be a number between 0 and 180, 65 | -- indicating the desired angle setting in degrees. 66 | setAngle :: Servo -> Int -> Arduino () 67 | setAngle Servo{servoPin, minPulse, maxPulse} angle 68 | | angle < 0 || angle > 180 69 | = die "Servo.setAngle: angle must be between 0 and 180." ["Received: " ++ show angle] 70 | | True 71 | = do let duration = minPulse + ((maxPulse - minPulse) * angle) `div` 180 72 | debug $ "Setting servo on pin: " ++ show servoPin ++ " " ++ show angle ++ " degrees, via a pulse of " ++ show duration ++ " microseconds." 73 | -- In arduino, the most we can send is 16383; not that a servo should need such a large value, but 74 | -- just in case 75 | when (duration >= 16383) $ die "Servo.setAngle angle setting: out-of-range." 76 | [ "Servo pin : " ++ show servoPin 77 | , "Angle required : " ++ show angle 78 | , "Min pulse duration: " ++ show minPulse 79 | , "Max pulse duration: " ++ show maxPulse 80 | , "Duration needed : " ++ show duration 81 | , "Exceeds max value : 16383" 82 | ] 83 | let msb = fromIntegral $ (duration `shiftR` 7) .&. 0x7f 84 | lsb = fromIntegral $ duration .&. 0x7f 85 | send $ AnalogPinWrite servoPin lsb msb 86 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Protocol.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Protocol 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Internal representation of the firmata protocol. 10 | ------------------------------------------------------------------------------- 11 | 12 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 13 | 14 | module System.Hardware.Arduino.Protocol(package, unpackageSysEx, unpackageNonSysEx) where 15 | 16 | import Data.Word (Word8) 17 | 18 | import qualified Data.ByteString as B 19 | import qualified Data.Map as M 20 | 21 | import System.Hardware.Arduino.Data 22 | import System.Hardware.Arduino.Utils 23 | 24 | -- | Wrap a sys-ex message to be sent to the board 25 | sysEx :: SysExCmd -> [Word8] -> B.ByteString 26 | sysEx cmd bs = B.pack $ firmataCmdVal START_SYSEX 27 | : sysExCmdVal cmd 28 | : bs 29 | ++ [firmataCmdVal END_SYSEX] 30 | 31 | -- | Construct a non sys-ex message 32 | nonSysEx :: FirmataCmd -> [Word8] -> B.ByteString 33 | nonSysEx cmd bs = B.pack $ firmataCmdVal cmd : bs 34 | 35 | -- | Package a request as a sequence of bytes to be sent to the board 36 | -- using the Firmata protocol. 37 | package :: Request -> B.ByteString 38 | package SystemReset = nonSysEx SYSTEM_RESET [] 39 | package QueryFirmware = sysEx REPORT_FIRMWARE [] 40 | package CapabilityQuery = sysEx CAPABILITY_QUERY [] 41 | package AnalogMappingQuery = sysEx ANALOG_MAPPING_QUERY [] 42 | package (AnalogReport p b) = nonSysEx (REPORT_ANALOG_PIN p) [if b then 1 else 0] 43 | package (DigitalReport p b) = nonSysEx (REPORT_DIGITAL_PORT p) [if b then 1 else 0] 44 | package (SetPinMode p m) = nonSysEx SET_PIN_MODE [fromIntegral (pinNo p), fromIntegral (fromEnum m)] 45 | package (DigitalPortWrite p l m) = nonSysEx (DIGITAL_MESSAGE p) [l, m] 46 | package (AnalogPinWrite p l m) = nonSysEx (ANALOG_MESSAGE p) [l, m] 47 | package (SamplingInterval l m) = sysEx SAMPLING_INTERVAL [l, m] 48 | package (Pulse p b dur to) = sysEx PULSE ([fromIntegral (pinNo p), if b then 1 else 0] ++ concatMap toArduinoBytes (word2Bytes dur ++ word2Bytes to)) 49 | 50 | -- | Unpackage a SysEx response 51 | unpackageSysEx :: [Word8] -> Response 52 | unpackageSysEx [] = Unimplemented (Just "") [] 53 | unpackageSysEx (cmdWord:args) 54 | | Right cmd <- getSysExCommand cmdWord 55 | = case (cmd, args) of 56 | (REPORT_FIRMWARE, majV : minV : rest) -> Firmware majV minV (getString rest) 57 | (CAPABILITY_RESPONSE, bs) -> Capabilities (getCapabilities bs) 58 | (ANALOG_MAPPING_RESPONSE, bs) -> AnalogMapping bs 59 | (PULSE, xs) | length xs == 10 -> let [p, a, b, c, d] = fromArduinoBytes xs in PulseResponse (InternalPin p) (bytes2Words (a, b, c, d)) 60 | _ -> Unimplemented (Just (show cmd)) args 61 | | True 62 | = Unimplemented Nothing (cmdWord : args) 63 | 64 | getCapabilities :: [Word8] -> BoardCapabilities 65 | getCapabilities bs = BoardCapabilities $ M.fromList $ zipWith (\p c -> (p, PinCapabilities{analogPinNumber = Nothing, allowedModes = c})) 66 | (map InternalPin [(0::Word8)..]) (map pinCaps (chunk bs)) 67 | where chunk xs = case break (== 0x7f) xs of 68 | ([], []) -> [] 69 | (cur, 0x7f:rest) -> cur : chunk rest 70 | _ -> [xs] 71 | pinCaps (x:y:rest) = (findMode (fromIntegral x), y) : pinCaps rest 72 | pinCaps _ = [] 73 | 74 | -- Code defensively against capabilities we do not know 75 | findMode :: Int -> PinMode 76 | findMode 0 = INPUT 77 | findMode 1 = OUTPUT 78 | findMode 2 = ANALOG 79 | findMode 3 = PWM 80 | findMode 4 = SERVO 81 | findMode 5 = SHIFT 82 | findMode 6 = I2C 83 | findMode 7 = ONEWIRE 84 | findMode 8 = STEPPER 85 | findMode 9 = ENCODER 86 | findMode 10 = SERIAL 87 | findMode 11 = PULLUP 88 | findMode _ = UNSUPPORTED 89 | 90 | -- | Unpackage a Non-SysEx response 91 | unpackageNonSysEx :: (Int -> IO [Word8]) -> FirmataCmd -> IO Response 92 | unpackageNonSysEx getBytes c = grab c 93 | where unimplemented n = Unimplemented (Just (show c)) `fmap` getBytes n 94 | grab (ANALOG_MESSAGE p) = getBytes 2 >>= \[l, h] -> return (AnalogMessage p l h) 95 | grab (DIGITAL_MESSAGE p) = getBytes 2 >>= \[l, h] -> return (DigitalMessage p l h) 96 | -- we should never see any of the following since they are "request" codes 97 | -- TBD: Maybe we should put them in a different data-type 98 | grab (REPORT_ANALOG_PIN _pin) = unimplemented 1 99 | grab (REPORT_DIGITAL_PORT _port) = unimplemented 1 100 | grab START_SYSEX = unimplemented 0 101 | grab SET_PIN_MODE = unimplemented 2 102 | grab END_SYSEX = unimplemented 0 103 | grab PROTOCOL_VERSION = unimplemented 2 104 | grab SYSTEM_RESET = unimplemented 0 105 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/NumGuess.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.NumGuess 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Simple number guessing game on the OSEPP Keyboard shield. 10 | -- 11 | -- /Thanks to David Palmer for lending me his OSEPP shield to play with!/ 12 | ------------------------------------------------------------------------------- 13 | 14 | module System.Hardware.Arduino.SamplePrograms.NumGuess where 15 | 16 | import System.Hardware.Arduino 17 | import System.Hardware.Arduino.Parts.LCD 18 | 19 | -- | The OSepp LCD Shield is a 16x2 LCD using a Hitachi Controller 20 | -- Furthermore, it has backlight, and 5 buttons. The hook-up is 21 | -- quite straightforward, using our existing Hitachi44780 controller 22 | -- as an example. More information on this shield can be found at: 23 | -- 24 | -- 25 | osepp :: LCDController 26 | osepp = Hitachi44780 { lcdRS = digital 8 27 | , lcdEN = digital 9 28 | , lcdD4 = digital 4 29 | , lcdD5 = digital 5 30 | , lcdD6 = digital 6 31 | , lcdD7 = digital 7 32 | , lcdRows = 2 33 | , lcdCols = 16 34 | , dotMode5x10 = False 35 | } 36 | 37 | -- | There are 5 keys on the OSepp shield. 38 | data Key = KeyRight 39 | | KeyLeft 40 | | KeyUp 41 | | KeyDown 42 | | KeySelect 43 | 44 | -- | Initialize the shield. This is essentially simply registering the 45 | -- lcd with the HArduino library. In addition, we return two values to 46 | -- the user: 47 | -- 48 | -- * A function to control the back-light 49 | -- 50 | -- * A function to read (if any) key-pressed 51 | initOSepp :: Arduino (LCD, Bool -> Arduino (), Arduino (Maybe Key)) 52 | initOSepp = do lcd <- lcdRegister osepp 53 | let button = analog 0 54 | light = digital 10 55 | setPinMode button ANALOG 56 | setPinMode light OUTPUT 57 | -- Analog values obtained from OSEPP site, seems reliable 58 | let threshHolds = [ (KeyRight, 30) 59 | , (KeyUp, 150) 60 | , (KeyDown, 360) 61 | , (KeyLeft, 535) 62 | , (KeySelect, 760) 63 | ] 64 | backLight = digitalWrite light 65 | readButton = do val <- analogRead button 66 | let walk [] = Nothing 67 | walk ((k, t):keys) 68 | | val < t = Just k 69 | | True = walk keys 70 | return $ walk threshHolds 71 | return (lcd, backLight, readButton) 72 | 73 | -- | Number guessing game, as a simple LCD demo. User thinks of a number 74 | -- between @0@ and @1000@, and the Arduino guesses it. 75 | numGuess :: LCD -> (Bool -> Arduino ()) -> Arduino (Maybe Key) -> Arduino () 76 | numGuess lcd light readKey = game 77 | where home = lcdHome lcd 78 | write = lcdWrite lcd 79 | clear = lcdClear lcd 80 | go = lcdSetCursor lcd 81 | at (r, c) s = go (c, r) >> write s 82 | getKey = do mbK <- readKey 83 | case mbK of 84 | Nothing -> getKey 85 | Just k -> do delay 500 -- stabilize by waiting 0.5s 86 | return k 87 | game = do clear 88 | home 89 | light True 90 | at (0, 4) "HArduino!" 91 | at (1, 0) "# Guessing game" 92 | delay 2000 93 | guess 1 0 1000 94 | newGame = getKey >> game 95 | guess :: Int -> Int -> Int -> Arduino () 96 | guess rnd l h 97 | | h == l = do clear 98 | at (0, 0) $ "It must be: " ++ show h 99 | at (1, 0) $ "Guess no: " ++ show rnd 100 | newGame 101 | | h < l = do clear 102 | at (0, 0) "You lied!" 103 | newGame 104 | | True = do clear 105 | let g = (l+h) `div` 2 106 | at (0, 0) $ "(" ++ show rnd ++ ") Is it " ++ show g ++ "?" 107 | k <- getKey 108 | case k of 109 | KeyUp -> guess (rnd+1) (g+1) h 110 | KeyDown -> guess (rnd+1) l (g-1) 111 | KeySelect -> do at (1, 0) $ "Got it in " ++ show rnd ++ "!" 112 | newGame 113 | _ -> do at (1, 0) "Use up/down/select only.." 114 | delay 1000 115 | guess rnd l h 116 | 117 | -- | Entry to the classing number guessing game. Simply initialize the 118 | -- shield and call our game function. 119 | guessGame :: IO () 120 | guessGame = withArduino False "/dev/cu.usbmodemFD131" $ do 121 | (lcd, light, readButton) <- initOSepp 122 | numGuess lcd light readButton 123 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This Travis job script has been generated by a script via 2 | # 3 | # haskell-ci 'hArduino.cabal' '--no-tests' '--no-benchmarks' '--no-doctest' '--no-hlint' '--email-notifications' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.10.3 12 | # 13 | version: ~> 1.0 14 | language: c 15 | os: linux 16 | dist: xenial 17 | git: 18 | # whether to recursively clone submodules 19 | submodules: false 20 | cache: 21 | directories: 22 | - $HOME/.cabal/packages 23 | - $HOME/.cabal/store 24 | - $HOME/.hlint 25 | before_cache: 26 | - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log 27 | # remove files that are regenerated by 'cabal update' 28 | - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.* 29 | - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json 30 | - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache 31 | - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar 32 | - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx 33 | - rm -rfv $CABALHOME/packages/head.hackage 34 | jobs: 35 | include: 36 | - compiler: ghc-8.10.2 37 | addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.2","cabal-install-3.2"]}} 38 | os: linux 39 | - compiler: ghc-8.8.4 40 | addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.4","cabal-install-3.2"]}} 41 | os: linux 42 | before_install: 43 | - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//') 44 | - WITHCOMPILER="-w $HC" 45 | - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//') 46 | - HCPKG="$HC-pkg" 47 | - unset CC 48 | - CABAL=/opt/ghc/bin/cabal 49 | - CABALHOME=$HOME/.cabal 50 | - export PATH="$CABALHOME/bin:$PATH" 51 | - TOP=$(pwd) 52 | - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" 53 | - echo $HCNUMVER 54 | - CABAL="$CABAL -vnormal+nowrap" 55 | - set -o pipefail 56 | - TEST=--enable-tests 57 | - TEST=--disable-tests 58 | - BENCH=--enable-benchmarks 59 | - BENCH=--disable-benchmarks 60 | - HEADHACKAGE=false 61 | - rm -f $CABALHOME/config 62 | - | 63 | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config 64 | echo "remote-build-reporting: anonymous" >> $CABALHOME/config 65 | echo "write-ghc-environment-files: always" >> $CABALHOME/config 66 | echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config 67 | echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config 68 | echo "world-file: $CABALHOME/world" >> $CABALHOME/config 69 | echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config 70 | echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config 71 | echo "installdir: $CABALHOME/bin" >> $CABALHOME/config 72 | echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config 73 | echo "store-dir: $CABALHOME/store" >> $CABALHOME/config 74 | echo "install-dirs user" >> $CABALHOME/config 75 | echo " prefix: $CABALHOME" >> $CABALHOME/config 76 | echo "repository hackage.haskell.org" >> $CABALHOME/config 77 | echo " url: http://hackage.haskell.org/" >> $CABALHOME/config 78 | install: 79 | - ${CABAL} --version 80 | - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" 81 | - | 82 | echo "program-default-options" >> $CABALHOME/config 83 | echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config 84 | - cat $CABALHOME/config 85 | - rm -fv cabal.project cabal.project.local cabal.project.freeze 86 | - travis_retry ${CABAL} v2-update -v 87 | # Generate cabal.project 88 | - rm -rf cabal.project cabal.project.local cabal.project.freeze 89 | - touch cabal.project 90 | - | 91 | echo "packages: ." >> cabal.project 92 | - echo 'package hArduino' >> cabal.project 93 | - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project" 94 | - | 95 | - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(hArduino)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" 96 | - cat cabal.project || true 97 | - cat cabal.project.local || true 98 | - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi 99 | - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} 100 | - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" 101 | - rm cabal.project.freeze 102 | - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all 103 | - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all 104 | script: 105 | - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) 106 | # Packaging... 107 | - ${CABAL} v2-sdist all 108 | # Unpacking... 109 | - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ 110 | - cd ${DISTDIR} || false 111 | - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \; 112 | - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \; 113 | - PKGDIR_hArduino="$(find . -maxdepth 1 -type d -regex '.*/hArduino-[0-9.]*')" 114 | # Generate cabal.project 115 | - rm -rf cabal.project cabal.project.local cabal.project.freeze 116 | - touch cabal.project 117 | - | 118 | echo "packages: ${PKGDIR_hArduino}" >> cabal.project 119 | - echo 'package hArduino' >> cabal.project 120 | - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project" 121 | - | 122 | - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(hArduino)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" 123 | - cat cabal.project || true 124 | - cat cabal.project.local || true 125 | # Building... 126 | # this builds all libraries and executables (without tests/benchmarks) 127 | - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all 128 | # Building with tests and benchmarks... 129 | # build & run tests, build benchmarks 130 | - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all 131 | # cabal check... 132 | - (cd ${PKGDIR_hArduino} && ${CABAL} -vnormal check) 133 | # haddock... 134 | - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all 135 | # Building without installed constraints for packages in global-db... 136 | - rm -f cabal.project.local 137 | - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all 138 | 139 | # REGENDATA ("0.10.3",["hArduino.cabal","--no-tests","--no-benchmarks","--no-doctest","--no-hlint","--email-notifications"]) 140 | # EOF 141 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/SamplePrograms/LCD.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.SamplePrograms.LCD 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Basic demo of an Hitachi HD44780 LCD 10 | ------------------------------------------------------------------------------- 11 | 12 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 13 | 14 | module System.Hardware.Arduino.SamplePrograms.LCD where 15 | 16 | import Control.Monad.Trans (liftIO) 17 | import Data.Char (isSpace) 18 | import Numeric (showHex) 19 | 20 | import System.Hardware.Arduino 21 | import System.Hardware.Arduino.Parts.LCD 22 | 23 | -- | Connections for a basic hitachi controller. 24 | -- See for 25 | -- pin layout. For this demo, simply connect the LCD pins to the Arduino 26 | -- as follows: 27 | -- 28 | -- * LCD pin @01@ to GND 29 | -- 30 | -- * LCD pin @02@ to +5V 31 | -- 32 | -- * LCD pin @03@ to a 10K potentiometer's viper 33 | -- 34 | -- * LCD pin @04@ to Arduino pin @12@ 35 | -- 36 | -- * LCD pin @05@ to GND 37 | -- 38 | -- * LCD pin @06@ to Arduino pin @11@ 39 | -- 40 | -- * LCD pin @11@ to Arduino pin @5@ 41 | -- 42 | -- * LCD pin @12@ to Arduino pin @4@ 43 | -- 44 | -- * LCD pin @13@ to Arduino pin @3@ 45 | -- 46 | -- * LCD pin @14@ to Arduino pin @2@ 47 | -- 48 | -- * [If backlight is needed] LCD pin @15@ to +5V 49 | -- 50 | -- * [If backlight is needed] LCD pin @16@ to GND via 220ohm resistor 51 | -- 52 | -- <> 53 | hitachi :: LCDController 54 | -- Connections: ARDUINO Hitachi Description 55 | -------------------------------- ----------- --------- ---------------- 56 | hitachi = Hitachi44780 { lcdRS = digital 12 -- 4 Register-select 57 | , lcdEN = digital 11 -- 6 Enable 58 | , lcdD4 = digital 5 -- 11 Data 4 59 | , lcdD5 = digital 4 -- 12 Data 5 60 | , lcdD6 = digital 3 -- 13 Data 6 61 | , lcdD7 = digital 2 -- 14 Data 7 62 | -- Other config variables for the display 63 | , lcdRows = 2 -- 2 rows 64 | , lcdCols = 16 -- of 16 columns 65 | , dotMode5x10 = False -- Using the standard 5x8 dots 66 | } 67 | 68 | -- | The happy glyph. See 'lcdCreateSymbol' for details on how to create new ones. 69 | happy :: [String] 70 | happy = [ " " 71 | , "@ @" 72 | , " " 73 | , " " 74 | , "@ @" 75 | , " @@@ " 76 | , " " 77 | , " " 78 | ] 79 | 80 | -- | The sad glyph. See 'lcdCreateSymbol' for details on how to create new ones. 81 | sad :: [String] 82 | sad = [ " " 83 | , "@ @" 84 | , " " 85 | , " " 86 | , " " 87 | , " @@@ " 88 | , "@ @" 89 | , " " 90 | ] 91 | 92 | -- | Access the LCD connected to Arduino, making it show messages 93 | -- we read from the user and demonstrate other LCD control features offered 94 | -- by hArduino. 95 | lcdDemo :: IO () 96 | lcdDemo = withArduino False "/dev/cu.usbmodemFD131" $ do 97 | lcd <- lcdRegister hitachi 98 | happySymbol <- lcdCreateSymbol lcd happy 99 | sadSymbol <- lcdCreateSymbol lcd sad 100 | lcdHome lcd 101 | liftIO $ do putStrLn "Hitachi controller demo.." 102 | putStrLn "" 103 | putStrLn "Looking for an example? Try the following sequence:" 104 | putStrLn " cursor 5 0" 105 | putStrLn " happy" 106 | putStrLn " write _" 107 | putStrLn " happy" 108 | putStrLn " flash 5" 109 | putStrLn "" 110 | putStrLn "Type ? to see all available commands." 111 | let repl = do liftIO $ putStr "LCD> " 112 | m <- liftIO getLine 113 | case words m of 114 | [] -> repl 115 | ["quit"] -> return () 116 | (cmd:_) -> case cmd `lookup` commands of 117 | Nothing -> do liftIO $ putStrLn $ "Unknown command '" ++ cmd ++ "', type ? for help." 118 | repl 119 | Just (_, _, c) -> do c lcd (dropWhile isSpace (drop (length cmd) m)) (happySymbol, sadSymbol) 120 | repl 121 | repl 122 | where help = liftIO $ do let (cmds, args, hlps) = unzip3 $ ("quit", "", "Quit the demo") : [(c, a, h) | (c, (a, h, _)) <- commands] 123 | clen = 1 + maximum (map length cmds) 124 | alen = 8 + maximum (map length args) 125 | pad l s = take l (s ++ repeat ' ') 126 | line (c, a, h) = putStrLn $ pad clen c ++ pad alen a ++ h 127 | mapM_ line $ zip3 cmds args hlps 128 | arg0 f _ [] _ = f 129 | arg0 _ _ a _ = liftIO $ putStrLn $ "Unexpected arguments: " ++ show a 130 | arg1 f lcd [] _ = f lcd 131 | arg1 _ _ a _ = liftIO $ putStrLn $ "Unexpected arguments: " ++ show a 132 | arg2 f lcd a _ = f lcd a 133 | arg3 = id 134 | grabNums n a f = case [v | [(v, "")] <- map reads (words a)] of 135 | vs | length vs /= n -> liftIO $ putStrLn $ "Need " ++ show n ++ " numeric parameter" ++ if n == 1 then "." else "s." 136 | vs -> f vs 137 | symbol isHappy lcd _ (h, s) = lcdWriteSymbol lcd (if isHappy then h else s) 138 | cursor lcd a = grabNums 2 a (\[col, row] -> lcdSetCursor lcd (col, row)) 139 | flash lcd a = grabNums 1 a (\[n] -> lcdFlash lcd n 500) 140 | code lcd a = grabNums 1 a (\[n] -> do lcdClear lcd 141 | lcdHome lcd 142 | lcdWriteSymbol lcd (lcdInternalSymbol n) 143 | lcdWrite lcd $ " (Code: 0x" ++ showHex n "" ++ ")") 144 | scroll toLeft lcd a = grabNums 1 a (\[n] -> do let scr | toLeft = lcdScrollDisplayLeft 145 | | True = lcdScrollDisplayRight 146 | sequence_ $ concat $ replicate n [scr lcd, delay 500]) 147 | commands = [ ("?", ("", "Display this help message", arg0 help)) 148 | , ("clear", ("", "Clear the LCD screen", arg1 lcdClear)) 149 | , ("write", ("string", "Write to the LCD", arg2 lcdWrite)) 150 | , ("home", ("", "Move cursor to home", arg1 lcdHome)) 151 | , ("cursor", ("col row", "Move cursor to col row", arg2 cursor)) 152 | , ("scrollOff", ("", "Turn off auto-scroll", arg1 lcdAutoScrollOff)) 153 | , ("scrollOn", ("", "Turn on auto-scroll", arg1 lcdAutoScrollOn)) 154 | , ("scrollLeft", ("n", "Scroll left by n chars", arg2 (scroll True))) 155 | , ("scrollRight", ("n", "Scroll right by n char", arg2 (scroll False))) 156 | , ("leftToRight", ("", "Set left to right direction", arg1 lcdLeftToRight)) 157 | , ("rightToLeft", ("", "Set left to right direction", arg1 lcdRightToLeft)) 158 | , ("blinkOn", ("", "Set blinking ON", arg1 lcdBlinkOn)) 159 | , ("blinkOff", ("", "Set blinking ON", arg1 lcdBlinkOff)) 160 | , ("cursorOn", ("", "Display the cursor", arg1 lcdCursorOn)) 161 | , ("cursorOff", ("", "Do not display the cursor", arg1 lcdCursorOff)) 162 | , ("displayOn", ("", "Turn the display on", arg1 lcdDisplayOn)) 163 | , ("displayOff", ("", "Turn the display off", arg1 lcdDisplayOff)) 164 | , ("flash", ("n", "Flash the display n times", arg2 flash)) 165 | , ("happy", ("", "Draw a smiling face", arg3 (symbol True))) 166 | , ("sad", ("", "Draw a sad face", arg3 (symbol False))) 167 | , ("code", ("n", "Write symbol with code n", arg2 code)) 168 | ] 169 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Comm.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Comm 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Basic serial communication routines 10 | ------------------------------------------------------------------------------- 11 | 12 | {-# LANGUAGE LambdaCase #-} 13 | {-# LANGUAGE ScopedTypeVariables #-} 14 | 15 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 16 | 17 | module System.Hardware.Arduino.Comm where 18 | 19 | import Control.Monad (when, forever) 20 | import Control.Concurrent (MVar, ThreadId, newChan, newMVar, newEmptyMVar, putMVar, writeChan, readChan, forkIO, modifyMVar_, tryTakeMVar, killThread) 21 | import Control.Exception (tryJust, AsyncException(UserInterrupt), handle, SomeException) 22 | import Control.Monad.State (runStateT, gets, liftIO, modify) 23 | import Data.Bits (testBit, (.&.)) 24 | import Data.List (intercalate, isInfixOf) 25 | import Data.Maybe (listToMaybe) 26 | import Data.Word (Word8) 27 | import System.Timeout (timeout) 28 | import System.IO (stderr, hPutStrLn) 29 | 30 | import qualified Data.ByteString as B (unpack, length) 31 | import qualified Data.Map as M (empty, mapWithKey, insert, assocs, lookup) 32 | import qualified Data.Set as S (empty) 33 | import qualified System.Hardware.Serialport as S (withSerial, defaultSerialSettings, CommSpeed(CS57600), commSpeed, recv, send) 34 | 35 | import System.Hardware.Arduino.Data 36 | import System.Hardware.Arduino.Utils 37 | import System.Hardware.Arduino.Protocol 38 | 39 | -- | Run the Haskell program to control the board: 40 | -- 41 | -- * The file path argument should point to the device file that is 42 | -- associated with the board. (@COM1@ on Windows, 43 | -- @/dev/cu.usbmodemFD131@ on Mac, etc.) 44 | -- 45 | -- * The boolean argument controls verbosity. It should remain 46 | -- 'False' unless you have communication issues. The print-out 47 | -- is typically less-than-useful, but it might point to the root 48 | -- cause of the problem. 49 | -- 50 | -- See "System.Hardware.Arduino.Examples.Blink" for a simple example. 51 | withArduino :: Bool -- ^ If 'True', debugging info will be printed 52 | -> FilePath -- ^ Path to the USB port 53 | -> Arduino () -- ^ The Haskell controller program to run 54 | -> IO () 55 | withArduino verbose fp program = 56 | do debugger <- mkDebugPrinter verbose 57 | debugger $ "Accessing arduino located at: " ++ show fp 58 | lTid <- newEmptyMVar 59 | let Arduino controller = do initOK <- initialize lTid 60 | if initOK 61 | then program 62 | else error "Communication time-out (5s) expired." 63 | handle (\(e::SomeException) -> do cleanUp lTid 64 | let selfErr = "*** hArduino" `isInfixOf` show e 65 | hPutStrLn stderr $ if selfErr 66 | then dropWhile (== '\n') (show e) 67 | else "*** hArduino:ERROR: " ++ show e 68 | ++ concatMap ("\n*** " ++) [ "Make sure your Arduino is connected to " ++ fp 69 | , "And StandardFirmata is running on it!" 70 | ]) $ 71 | S.withSerial fp S.defaultSerialSettings{S.commSpeed = S.CS57600} $ \curPort -> do 72 | let initBoardState = BoardState { 73 | boardCapabilities = BoardCapabilities M.empty 74 | , analogReportingPins = S.empty 75 | , digitalReportingPins = S.empty 76 | , pinStates = M.empty 77 | , digitalWakeUpQueue = [] 78 | , lcds = M.empty 79 | } 80 | bs <- newMVar initBoardState 81 | dc <- newChan 82 | let initState = ArduinoState { 83 | message = debugger 84 | , bailOut = bailOutF lTid 85 | , port = curPort 86 | , firmataID = "Unknown" 87 | , capabilities = BoardCapabilities M.empty 88 | , boardState = bs 89 | , deviceChannel = dc 90 | , listenerTid = lTid 91 | } 92 | res <- tryJust catchCtrlC $ runStateT controller initState 93 | case res of 94 | Left () -> putStrLn "hArduino: Caught Ctrl-C, quitting.." 95 | _ -> return () 96 | cleanUp lTid 97 | where catchCtrlC UserInterrupt = Just () 98 | catchCtrlC _ = Nothing 99 | 100 | cleanUp tid = do mbltid <- tryTakeMVar tid 101 | maybe (pure ()) killThread mbltid 102 | 103 | bailOutF tid m ms = do cleanUp tid 104 | error $ "\n*** hArduino:ERROR: " ++ intercalate "\n*** " (m:ms) 105 | 106 | -- | Send down a request. 107 | send :: Request -> Arduino () 108 | send req = do debug $ "Sending: " ++ show req ++ " <" ++ unwords (map showByte (B.unpack p)) ++ ">" 109 | serial <- gets port 110 | sent <- liftIO $ S.send serial p 111 | when (sent /= lp) 112 | (debug $ "Send failed. Tried: " ++ show lp ++ "bytes, reported: " ++ show sent) 113 | where p = package req 114 | lp = B.length p 115 | 116 | -- | Receive a sys-ex response. This is a blocking call. 117 | recv :: Arduino Response 118 | recv = do ch <- gets deviceChannel 119 | liftIO $ readChan ch 120 | 121 | -- | Receive a sys-ex response with time-out. This is a blocking call, and will wait until 122 | -- either the time-out expires or the message is received 123 | recvTimeOut :: Int -> Arduino (Maybe Response) 124 | recvTimeOut n = do ch <- gets deviceChannel 125 | liftIO $ timeout n (readChan ch) 126 | 127 | -- | Start a thread to listen to the board and populate the channel with incoming queries. 128 | setupListener :: Arduino ThreadId 129 | setupListener = do 130 | serial <- gets port 131 | dbg <- gets message 132 | chan <- gets deviceChannel 133 | let getBytes n = do let go need sofar 134 | | need <= 0 = return $ reverse sofar 135 | | True = do b <- S.recv serial need 136 | case B.length b of 137 | 0 -> go need sofar 138 | l -> go (need - l) (b : sofar) 139 | chunks <- go n [] 140 | return $ concatMap B.unpack chunks 141 | collectSysEx sofar = do [b] <- getBytes 1 142 | if b == firmataCmdVal END_SYSEX 143 | then return $ reverse sofar 144 | else collectSysEx (b : sofar) 145 | listener bs = do 146 | [cmd] <- getBytes 1 147 | resp <- case getFirmataCmd cmd of 148 | Left unknown -> return $ Unimplemented (Just (show unknown)) [] 149 | Right START_SYSEX -> unpackageSysEx `fmap` collectSysEx [] 150 | Right nonSysEx -> unpackageNonSysEx getBytes nonSysEx 151 | case resp of 152 | Unimplemented{} -> dbg $ "Ignoring the received response: " ++ show resp 153 | -- NB. When Firmata sends back AnalogMessage, it uses the number in A0-A1-A2, etc., i.e., 0-1-2; which we 154 | -- need to properly interpret in our own pin mapping schema, where analogs come after digitals. 155 | AnalogMessage mp l h -> modifyMVar_ bs $ \bst -> 156 | do let BoardCapabilities caps = boardCapabilities bst 157 | mbP = listToMaybe [mappedPin | (mappedPin, PinCapabilities{analogPinNumber = Just mp'}) <- M.assocs caps, pinNo mp == mp'] 158 | case mbP of 159 | Nothing -> return bst -- Mapping hasn't happened yet 160 | Just p -> do 161 | let v = (128 * fromIntegral (h .&. 0x07) + fromIntegral (l .&. 0x7f)) :: Int 162 | case pinValue `fmap` (p `M.lookup` pinStates bst) of 163 | Just (Just (Right v')) 164 | | abs (v - v') < 10 -> return () -- be quiet, otherwise prints too much 165 | _ -> dbg $ "Updating analog pin " ++ show p ++ " values with " ++ showByteList [l,h] ++ " (" ++ show v ++ ")" 166 | return bst{ pinStates = M.insert p PinData{pinMode = ANALOG, pinValue = Just (Right v)} (pinStates bst) } 167 | DigitalMessage p l h -> do dbg $ "Updating digital port " ++ show p ++ " values with " ++ showByteList [l,h] 168 | modifyMVar_ bs $ \bst -> do 169 | let upd o od | p /= pinPort o = od -- different port, no change 170 | | pinMode od /= INPUT = od -- not an input pin, ignore 171 | | True = od{pinValue = Just (Left newVal)} 172 | where idx = pinPortIndex o 173 | newVal | idx <= 6 = l `testBit` fromIntegral idx 174 | | True = h `testBit` fromIntegral (idx - 7) 175 | let wakeUpQ = digitalWakeUpQueue bst 176 | bst' = bst{ pinStates = M.mapWithKey upd (pinStates bst) 177 | , digitalWakeUpQueue = [] 178 | } 179 | mapM_ (`putMVar` ()) wakeUpQ 180 | return bst' 181 | _ -> do dbg $ "Received " ++ show resp 182 | writeChan chan resp 183 | bs <- gets boardState 184 | tid <- liftIO $ forkIO $ forever (listener bs) 185 | debug $ "Started listener thread: " ++ show tid 186 | return tid 187 | 188 | -- | Initialize our board, get capabilities, etc. Returns True if initialization 189 | -- went OK, False if not. 190 | initialize :: MVar ThreadId -> Arduino Bool 191 | initialize ltid = do 192 | -- Step 0: Set up the listener thread 193 | tid <- setupListener 194 | liftIO $ putMVar ltid tid 195 | -- Step 1: Send a reset to get things going 196 | send SystemReset 197 | -- Step 2: Send query-firmware, and wait until we get a response 198 | -- To accommodate for the case when standard-Firmata may not be running, 199 | -- we will time out after 10 seconds of waiting, which should be plenty 200 | mbTo <- handshake QueryFirmware (Just (5000000 :: Int)) 201 | (\case Firmware{} -> True 202 | _ -> False) 203 | (\(Firmware v1 v2 m) -> modify (\s -> s{firmataID = "Firmware v" ++ show v1 ++ "." ++ show v2 ++ "(" ++ m ++ ")"})) 204 | case mbTo of 205 | Nothing -> return False -- timed out 206 | Just () -> do -- Step 3: Send a capabilities request 207 | _ <- handshake CapabilityQuery Nothing 208 | (\case Capabilities{} -> True 209 | _ -> False) 210 | (\(Capabilities c) -> modify (\s -> s{capabilities = c})) 211 | -- Step 4: Send analog-mapping query 212 | _ <- handshake AnalogMappingQuery Nothing 213 | (\case AnalogMapping{} -> True 214 | _ -> False) 215 | (\(AnalogMapping as) -> do BoardCapabilities m <- gets capabilities 216 | -- need to put capabilities to both outer and inner state 217 | let caps = BoardCapabilities (M.mapWithKey (mapAnalog as) m) 218 | modify (\s -> s{capabilities = caps}) 219 | bs <- gets boardState 220 | liftIO $ modifyMVar_ bs $ \bst -> return bst{boardCapabilities = caps}) 221 | -- We're done, print capabilities in debug mode 222 | caps <- gets capabilities 223 | dbg <- gets message 224 | liftIO $ dbg $ "Handshake complete. Board capabilities:\n" ++ show caps 225 | return True 226 | where handshake msg mbTOut isOK process = do 227 | dbg <- gets message 228 | send msg 229 | let wait = do mbResp <- case mbTOut of 230 | Nothing -> Just `fmap` recv 231 | Just n -> recvTimeOut n 232 | case mbResp of 233 | Nothing -> return Nothing 234 | Just resp -> if isOK resp 235 | then Just `fmap` process resp 236 | else do liftIO $ dbg $ "Skipping unexpected response: " ++ show resp 237 | wait 238 | wait 239 | mapAnalog :: [Word8] -> IPin -> PinCapabilities -> PinCapabilities 240 | mapAnalog as p c 241 | | i < rl && m /= 0x7f 242 | = c{analogPinNumber = Just m} 243 | | True -- out-of-bounds, or not analog; ignore 244 | = c 245 | where rl = length as 246 | i = fromIntegral (pinNo p) 247 | m = as !! i 248 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Firmata.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Firmata 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Implementation of the firmata protocol 10 | ------------------------------------------------------------------------------- 11 | 12 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 13 | 14 | module System.Hardware.Arduino.Firmata where 15 | 16 | import Control.Concurrent (newEmptyMVar, readMVar, withMVar, modifyMVar_, threadDelay) 17 | import Control.Monad (when, unless, void) 18 | import Control.Monad.State (StateT(..), gets) 19 | import Control.Monad.Trans (liftIO) 20 | import Data.Bits ((.&.), shiftR, setBit) 21 | import Data.Maybe (fromMaybe) 22 | import Data.Time (getCurrentTime, utctDayTime) 23 | import System.Timeout (timeout) 24 | import Data.Word (Word8) 25 | 26 | import qualified Data.Map as M 27 | 28 | import System.Hardware.Arduino.Data 29 | import System.Hardware.Arduino.Comm 30 | 31 | import qualified System.Hardware.Arduino.Utils as U 32 | 33 | -- | Retrieve the Firmata firmware version running on the Arduino. The first 34 | -- component is the major, second is the minor. The final value is a human 35 | -- readable identifier for the particular board. 36 | queryFirmware :: Arduino (Word8, Word8, String) 37 | queryFirmware = do 38 | send QueryFirmware 39 | r <- recv 40 | case r of 41 | Firmware v1 v2 m -> return (v1, v2, m) 42 | _ -> die "queryFirmware: Got unexpected response for query firmware call: " [show r] 43 | 44 | -- | Delay the computaton for a given number of milli-seconds 45 | delay :: Int -> Arduino () 46 | delay = liftIO . U.delay 47 | 48 | -- | Time a given action, result is measured in micro-seconds. 49 | time :: Arduino a -> Arduino (Int, a) 50 | time a = do start <- tick 51 | r <- a 52 | end <- r `seq` tick 53 | return (toMicroSeconds (end - start), r) 54 | where -- tick gets the current time in picoseconds 55 | tick = do t <- liftIO $ utctDayTime `fmap` getCurrentTime 56 | let precision = 1000000000000 :: Integer 57 | return . round . (fromIntegral precision *) . toRational $ t 58 | toMicroSeconds :: Integer -> Int 59 | toMicroSeconds t = fromIntegral $ t `quot` 1000000 60 | 61 | -- | Time-out a given action. Time-out amount is in micro-seconds. 62 | timeOut :: Int -> Arduino a -> Arduino (Maybe a) 63 | timeOut to (Arduino (StateT f)) = Arduino (StateT (\st -> do 64 | mbRes <- timeout to (f st) 65 | case mbRes of 66 | Nothing -> return (Nothing, st) 67 | Just (a, st') -> return (Just a, st'))) 68 | 69 | -- | Set the mode on a particular pin on the board 70 | setPinMode :: Pin -> PinMode -> Arduino () 71 | setPinMode p' m = do 72 | p <- getInternalPin p' 73 | extras <- registerPinMode p m 74 | send $ SetPinMode p m 75 | mapM_ send extras 76 | 77 | -- | Set or clear a digital pin on the board 78 | digitalWrite :: Pin -> Bool -> Arduino () 79 | digitalWrite p' v = do 80 | (p, pd) <- convertAndCheckPin "digitalWrite" p' OUTPUT 81 | case pinValue pd of 82 | Just (Left b) | b == v -> return () -- no change, nothing to do 83 | _ -> do (lsb, msb) <- computePortData p v 84 | send $ DigitalPortWrite (pinPort p) lsb msb 85 | 86 | -- | Turn on/off internal pull-up resistor on an input pin 87 | pullUpResistor :: Pin -> Bool -> Arduino () 88 | pullUpResistor p' v = do 89 | (p, _) <- convertAndCheckPin "pullUpResistor" p' INPUT 90 | (lsb, msb) <- computePortData p v 91 | send $ DigitalPortWrite (pinPort p) lsb msb 92 | 93 | -- | Read the value of a pin in digital mode; this is a non-blocking call, returning 94 | -- the current value immediately. See 'waitFor' for a version that waits for a change 95 | -- in the pin first. 96 | digitalRead :: Pin -> Arduino Bool 97 | digitalRead p' = do 98 | (_, pd) <- convertAndCheckPin "digitalRead" p' INPUT 99 | return $ case pinValue pd of 100 | Just (Left v) -> v 101 | _ -> False -- no (correctly-typed) value reported yet, default to False 102 | 103 | -- | Wait for a change in the value of the digital input pin. Returns the new value. 104 | -- Note that this is a blocking call. For a non-blocking version, see 'digitalRead', which returns the current 105 | -- value of a pin immediately. 106 | waitFor :: Pin -> Arduino Bool 107 | waitFor p = head `fmap` waitAny [p] 108 | 109 | -- | Wait for a change in any of the given pins. Once a change is detected, all the new values are 110 | -- returned. Similar to 'waitFor', but is useful when we are watching multiple digital inputs. 111 | waitAny :: [Pin] -> Arduino [Bool] 112 | waitAny ps = map snd `fmap` waitGeneric ps 113 | 114 | -- | Wait for any of the given pins to go from low to high. If all of the pins are high to start 115 | -- with, then we first wait for one of them to go low, and then wait for one of them to go back high. 116 | -- Returns the new values. 117 | waitAnyHigh :: [Pin] -> Arduino [Bool] 118 | waitAnyHigh ps = do 119 | curVals <- mapM digitalRead ps 120 | when (and curVals) $ void $ waitAnyLow ps -- all are H to start with, wait for at least one to go low 121 | vs <- waitGeneric ps -- wait for some change 122 | if (False, True) `elem` vs 123 | then return $ map snd vs 124 | else waitAnyHigh ps 125 | 126 | -- | Wait for any of the given pins to go from high to low. If all of the pins are low to start 127 | -- with, then we first wait for one of them to go high, and then wait for one of them to go back low. 128 | -- Returns the new values. 129 | waitAnyLow :: [Pin] -> Arduino [Bool] 130 | waitAnyLow ps = do 131 | curVals <- mapM digitalRead ps 132 | unless (or curVals) $ void $ waitAnyHigh ps -- all are L to start with, wait for at least one to go high 133 | vs <- waitGeneric ps -- wait for some change 134 | if (True, False) `elem` vs 135 | then return $ map snd vs 136 | else waitAnyLow ps 137 | 138 | -- | A utility function, waits for any change on any given pin 139 | -- and returns both old and new values. It's guaranteed that 140 | -- at least one returned pair have differing values. 141 | waitGeneric :: [Pin] -> Arduino [(Bool, Bool)] 142 | waitGeneric ps = do 143 | curVals <- mapM digitalRead ps 144 | semaphore <- liftIO newEmptyMVar 145 | let wait = do digitalWakeUp semaphore 146 | liftIO $ readMVar semaphore 147 | newVals <- mapM digitalRead ps 148 | if curVals == newVals 149 | then wait 150 | else return $ zip curVals newVals 151 | wait 152 | 153 | -- | 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@ 154 | -- does the following: 155 | -- 156 | -- * Set the pin to value @v@ for @duration@ microseconds. 157 | -- 158 | -- * Waits 2 microseconds 159 | -- 160 | -- * Waits until pin @p@ has value @not v@. 161 | -- 162 | -- * Returns, in micro-seconds, the duration the pin stayed @v@, counting from the 2 microsecond wait. 163 | -- 164 | -- Time-out parameter is used as follows: 165 | -- 166 | -- * If @mbTimeOut@ is @Nothing@, then 'pulse' will wait until the pin attains the value required and so long as it holds it. 167 | -- Note that very-long time-out values are unlikely to be accurate. 168 | -- 169 | -- * If @mbTimeOut@ is @Just t@ then, 'pulse' will stop if the above procedure does not complete within the given micro-seconds. 170 | -- In this case, the overall return value is @Nothing@. 171 | -- 172 | -- NB. Both the time-out value and the return value are given in micro-seconds. 173 | -- 174 | -- NB. As of March 2 2013; StandardFirmata that's distributed with the Arduino-App does /not/ support the Pulse-In command. 175 | -- However, there is a patch to add this command; see: for details. 176 | -- If you want to use hArduino's @pulseIn@ command, then you /have/ to install the above patch. Also see the function 177 | -- @pulseIn_hostOnly@, which works with the distributed StandardFirmata: It implements a version that is not as 178 | -- accurate in its timing, but might be sufficient if high precision is not required. 179 | pulse :: Pin -> Bool -> Int -> Maybe Int -> Arduino (Maybe Int) 180 | pulse p' v duration mbTo = do 181 | (p, _) <- convertAndCheckPin "pulse" p' INPUT 182 | let to = fromMaybe maxAllowed mbTo 183 | maxAllowed = 2147483647 -- works out to about 36 minutes; which is way beyond the accuracy provided by Arduino 184 | bad x = x < 0 || x > maxAllowed 185 | when (any bad [duration, to]) $ die ("Invalid duration/time-out values for pulse on pin " ++ show p) 186 | [ "Values should be between 0 and " ++ show maxAllowed 187 | , "Received: " ++ show (duration, to) 188 | ] 189 | send $ Pulse p v (fromIntegral duration) (fromIntegral to) 190 | r <- recv 191 | case r of 192 | PulseResponse pOut d | p == pOut -> case d of 193 | 0 -> return Nothing 194 | i -> return (Just (fromIntegral i)) 195 | _ -> die ("pulseIn: Got unexpected response for Pulse call on pin: " ++ show p') [show r] 196 | 197 | -- | A /hostOnly/ version of pulse-out on a digital-pin. Use this function only for cases where the 198 | -- precision required only matters for the host, not for the board. That is, due to the inherent 199 | -- delays involved in Firmata communication, the timing will /not/ be accurate, and should not 200 | -- be expected to work uniformly over different boards. Similar comments apply for 'pulseIn_hostTiming' 201 | -- as well. See the function 'pulse' for a more accurate version. 202 | pulseOut_hostTiming :: Pin -- ^ Pin to send the pulse on 203 | -> Bool -- ^ Pulse value 204 | -> Int -- ^ Time, in microseconds, to signal beginning of pulse; will send the opposite value for this amount 205 | -> Int -- ^ Pulse duration, measured in microseconds 206 | -> Arduino () 207 | pulseOut_hostTiming p' pulseValue dBefore dAfter 208 | | dBefore < 0 || dAfter < 0 209 | = die ("pulseOut: Invalid delay amounts: " ++ show (dBefore, dAfter)) 210 | [ "Pre-delay and pulse-amounts must be non-negative."] 211 | | True 212 | = do (p, pd) <- convertAndCheckPin "pulseOut_hostTiming" p' OUTPUT 213 | let curPort = pinPort p 214 | curIndex = pinPortIndex p 215 | bs <- gets boardState 216 | (setMask, resetMask) <- liftIO $ withMVar bs $ \bst -> do 217 | let values = [(pinPortIndex sp, pinValue spd) | (sp, spd) <- M.assocs (pinStates bst), curPort == pinPort sp, pinMode pd `elem` [INPUT, OUTPUT]] 218 | getVal nv i 219 | | i == curIndex = nv 220 | | Just (Just (Left ov)) <- i `lookup` values = ov 221 | | True = False 222 | mkMask val = let [b0, b1, b2, b3, b4, b5, b6, b7] = map (getVal val) [0 .. 7] 223 | lsb = foldr (\(i, b) m -> if b then m `setBit` i else m) 0 (zip [0..] [b0, b1, b2, b3, b4, b5, b6]) 224 | msb = foldr (\(i, b) m -> if b then m `setBit` (i-7) else m) 0 (zip [7..] [b7]) 225 | in (lsb, msb) 226 | return (mkMask pulseValue, mkMask (not pulseValue)) 227 | let writeThrough (lsb, msb) = send $ DigitalPortWrite curPort lsb msb 228 | -- make sure masks are pre computed, and clear the line 229 | fst setMask `seq` snd setMask `seq` fst resetMask `seq` snd resetMask `seq` writeThrough resetMask 230 | -- Wait before starting the pulse 231 | liftIO $ threadDelay dBefore 232 | -- Send the pulse 233 | writeThrough setMask 234 | liftIO $ threadDelay dAfter 235 | -- Finish the pulse 236 | writeThrough resetMask 237 | -- Do a final internal update to reflect the final value of the line 238 | liftIO $ modifyMVar_ bs $ \bst -> return bst{pinStates = M.insert p PinData{pinMode = OUTPUT, pinValue = Just (Left (not pulseValue))}(pinStates bst)} 239 | {-# ANN pulseOut_hostTiming "HLint: ignore Use camelCase" #-} 240 | 241 | -- | A /hostOnly/ version of pulse-in on a digital-pin. Use this function only for cases where the 242 | -- precision required only matters for the host, not for the board. That is, due to the inherent 243 | -- delays involved in Firmata communication, the timing will /not/ be accurate, and should not 244 | -- be expected to work uniformly over different boards. Similar comments apply for 'pulseOut_hostTiming' 245 | -- as well. See the function 'pulse' for a more accurate version. 246 | pulseIn_hostTiming :: Pin -> Bool -> Maybe Int -> Arduino (Maybe Int) 247 | pulseIn_hostTiming p v mbTo = case mbTo of 248 | Nothing -> Just `fmap` measure 249 | Just to -> timeOut to measure 250 | where waitTill f = do curVal <- digitalRead p 251 | unless (f curVal) $ waitTill f 252 | measure = do waitTill (== v) -- wait until pulse starts 253 | (t, _) <- time $ waitTill (/= v) -- wait till pulse ends, measuring the time 254 | return $ fromIntegral t 255 | {-# ANN pulseIn_hostTiming "HLint: ignore Use camelCase" #-} 256 | 257 | -- | Read the value of a pin in analog mode; this is a non-blocking call, immediately 258 | -- returning the last sampled value. It returns @0@ if the voltage on the pin 259 | -- is 0V, and @1023@ if it is 5V, properly scaled. (See `setAnalogSamplingInterval` for 260 | -- sampling frequency.) 261 | analogRead :: Pin -> Arduino Int 262 | analogRead p' = do 263 | (_, pd) <- convertAndCheckPin "analogRead" p' ANALOG 264 | return $ case pinValue pd of 265 | Just (Right v) -> v 266 | _ -> 0 -- no (correctly-typed) value reported yet, default to 0 267 | 268 | -- | Write a PWM analog value to a pin. The argument is an 'Int', indicating the duty cycle. 269 | -- @0@ means off; @255@ means always on. Intermediate values will create a square wave 270 | -- on that pin with the given duty-cycle 271 | analogWrite :: Pin -> Int -> Arduino () 272 | analogWrite p' dc = do 273 | (p, _) <- convertAndCheckPin "analogWrite" p' PWM 274 | when (dc < 0 || dc > 255) $ die ("Invalid duty-cycle value for PWM write on pin " ++ show p) 275 | [ "Values should be between 0 and 255" 276 | , "Received: " ++ show dc 277 | ] 278 | send $ AnalogPinWrite p (fromIntegral lsb) (fromIntegral msb) 279 | where lsb = dc .&. 0x7f 280 | msb = (dc `shiftR` 7) .&. 0x7f 281 | 282 | -- | Set the analog sampling interval, in milliseconds. Arduino uses a default of 19ms to sample analog and I2C 283 | -- signals, which is fine for many applications, but can be modified if needed. The argument 284 | -- should be a number between @10@ and @16384@; @10@ being the minumum sampling interval supported by Arduino 285 | -- and @16383@ being the largest value we can represent in 14 bits that this message can handle. (Note that 286 | -- the largest value is just about @16@ seconds, which is plenty infrequent for all practical needs.) 287 | setAnalogSamplingInterval :: Int -> Arduino () 288 | setAnalogSamplingInterval i 289 | | i < 10 || i > 16383 290 | = die ("hArduino: setAnalogSamplingInterval: Allowed interval is [10, 16383] ms, received: " ++ show i) [] 291 | | True 292 | = send $ SamplingInterval (fromIntegral lsb) (fromIntegral msb) 293 | where lsb = i .&. 0x7f 294 | msb = (i `shiftR` 7) .&. 0x7f 295 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Parts/LCD.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Parts.LCD 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- LCD (Liquid Crystal Display) parts supported by hArduino. The Haskell code 10 | -- below has partly been implemented following the Arduino LiquidCrystal project 11 | -- source code: 12 | -- 13 | -- The Hitachi44780 data sheet is at: 14 | -- 15 | -- For an example program using this library, see "System.Hardware.Arduino.SamplePrograms.LCD". 16 | ------------------------------------------------------------------------------------------------- 17 | 18 | {-# LANGUAGE NamedFieldPuns #-} 19 | 20 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 21 | 22 | module System.Hardware.Arduino.Parts.LCD( 23 | -- * LCD types and registration 24 | LCD, LCDController(..), lcdRegister 25 | -- * Writing text on the LCD 26 | , lcdClear, lcdWrite 27 | -- * Moving the cursor 28 | , lcdHome, lcdSetCursor 29 | -- * Scrolling 30 | , lcdAutoScrollOn, lcdAutoScrollOff 31 | , lcdScrollDisplayLeft, lcdScrollDisplayRight 32 | -- * Display properties 33 | , lcdLeftToRight, lcdRightToLeft 34 | , lcdBlinkOn, lcdBlinkOff 35 | , lcdCursorOn, lcdCursorOff 36 | , lcdDisplayOn, lcdDisplayOff 37 | -- * Accessing internal symbols, 38 | , LCDSymbol, lcdInternalSymbol, lcdWriteSymbol 39 | -- Creating custom symbols 40 | , lcdCreateSymbol 41 | -- * Misc helpers 42 | , lcdFlash 43 | ) where 44 | 45 | import Control.Concurrent (modifyMVar, withMVar) 46 | import Control.Monad (when) 47 | import Control.Monad.State (gets, liftIO) 48 | import Data.Bits (testBit, (.|.), (.&.), setBit, clearBit, shiftL, bit) 49 | import Data.Char (ord, isSpace) 50 | import Data.Maybe (fromMaybe) 51 | import Data.Word (Word8) 52 | 53 | import qualified Data.Map as M 54 | 55 | import System.Hardware.Arduino.Data 56 | import System.Hardware.Arduino.Firmata 57 | 58 | import qualified System.Hardware.Arduino.Utils as U 59 | 60 | import System.Exit (exitFailure) 61 | 62 | --------------------------------------------------------------------------------------- 63 | -- Low level interface, not available to the user 64 | --------------------------------------------------------------------------------------- 65 | 66 | -- | Commands understood by Hitachi 67 | data Cmd = LCD_INITIALIZE 68 | | LCD_INITIALIZE_END 69 | | LCD_FUNCTIONSET 70 | | LCD_DISPLAYCONTROL Word8 71 | | LCD_CLEARDISPLAY 72 | | LCD_ENTRYMODESET Word8 73 | | LCD_RETURNHOME 74 | | LCD_SETDDRAMADDR Word8 75 | | LCD_CURSORSHIFT Word8 76 | | LCD_SETCGRAMADDR Word8 77 | 78 | -- | Convert a command to a data-word 79 | getCmdVal :: LCDController -> Cmd -> Word8 80 | getCmdVal Hitachi44780{lcdRows, dotMode5x10} = get 81 | where multiLine -- bit 3 82 | | lcdRows > 1 = 0x08 :: Word8 83 | | True = 0x00 :: Word8 84 | dotMode -- bit 2 85 | | dotMode5x10 = 0x04 :: Word8 86 | | True = 0x00 :: Word8 87 | displayFunction = multiLine .|. dotMode 88 | get LCD_INITIALIZE = 0x33 89 | get LCD_INITIALIZE_END = 0x32 90 | get LCD_FUNCTIONSET = 0x20 .|. displayFunction 91 | get (LCD_DISPLAYCONTROL w) = 0x08 .|. w 92 | get LCD_CLEARDISPLAY = 0x01 93 | get (LCD_ENTRYMODESET w) = 0x04 .|. w 94 | get LCD_RETURNHOME = 0x02 95 | get (LCD_SETDDRAMADDR w) = 0x80 .|. w 96 | get (LCD_CURSORSHIFT w) = 0x10 .|. 0x08 .|. w -- NB. LCD_DISPLAYMOVE (0x08) hard coded here 97 | get (LCD_SETCGRAMADDR w) = 0x40 .|. w `shiftL` 3 98 | 99 | -- | Initialize the LCD. Follows the data sheet , 100 | -- page 46; figure 24. 101 | initLCD :: LCD -> LCDController -> Arduino () 102 | initLCD lcd c@Hitachi44780{lcdRS, lcdEN, lcdD4, lcdD5, lcdD6, lcdD7} = do 103 | debug "Starting the LCD initialization sequence" 104 | mapM_ (`setPinMode` OUTPUT) [lcdRS, lcdEN, lcdD4, lcdD5, lcdD6, lcdD7] 105 | -- Wait for 50ms, data-sheet says at least 40ms for 2.7V version, so be safe 106 | delay 50 107 | sendCmd c LCD_INITIALIZE 108 | delay 5 109 | sendCmd c LCD_INITIALIZE_END 110 | sendCmd c LCD_FUNCTIONSET 111 | lcdCursorOff lcd 112 | lcdBlinkOff lcd 113 | lcdLeftToRight lcd 114 | lcdAutoScrollOff lcd 115 | lcdHome lcd 116 | lcdClear lcd 117 | lcdDisplayOn lcd 118 | 119 | -- | Get the controller associated with the LCD 120 | getController :: LCD -> Arduino LCDController 121 | getController lcd = do 122 | bs <- gets boardState 123 | err <- gets bailOut 124 | liftIO $ withMVar bs $ \bst -> case lcd `M.lookup` lcds bst of 125 | Nothing -> do err ("hArduino: Cannot locate " ++ show lcd) [] 126 | exitFailure 127 | Just ld -> return $ lcdController ld 128 | 129 | -- | Send a command to the LCD controller 130 | sendCmd :: LCDController -> Cmd -> Arduino () 131 | sendCmd c = transmit False c . getCmdVal c 132 | 133 | -- | Send 4-bit data to the LCD controller 134 | sendData :: LCDController -> Word8 -> Arduino () 135 | sendData lcd n = do debug $ "Transmitting LCD data: " ++ U.showByte n 136 | transmit True lcd n 137 | 138 | -- | By controlling the enable-pin, indicate to the controller that 139 | -- the data is ready for it to process. 140 | pulseEnable :: LCDController -> Arduino () 141 | pulseEnable Hitachi44780{lcdEN} = do 142 | debug "Sending LCD pulseEnable" 143 | digitalWrite lcdEN False 144 | delay 1 145 | digitalWrite lcdEN True 146 | delay 1 147 | digitalWrite lcdEN False 148 | delay 1 149 | 150 | -- | Transmit data down to the LCD 151 | transmit :: Bool -> LCDController -> Word8 -> Arduino () 152 | transmit mode c@Hitachi44780{lcdRS, lcdEN, lcdD4, lcdD5, lcdD6, lcdD7} val = do 153 | digitalWrite lcdRS mode 154 | digitalWrite lcdEN False 155 | let [b7, b6, b5, b4, b3, b2, b1, b0] = [val `testBit` i | i <- [7, 6 .. 0]] 156 | -- Send down the first 4 bits 157 | digitalWrite lcdD4 b4 158 | digitalWrite lcdD5 b5 159 | digitalWrite lcdD6 b6 160 | digitalWrite lcdD7 b7 161 | pulseEnable c 162 | -- Send down the remaining batch 163 | digitalWrite lcdD4 b0 164 | digitalWrite lcdD5 b1 165 | digitalWrite lcdD6 b2 166 | digitalWrite lcdD7 b3 167 | pulseEnable c 168 | 169 | -- | Helper function to simplify library programming, not exposed to the user. 170 | withLCD :: LCD -> String -> (LCDController -> Arduino a) -> Arduino a 171 | withLCD lcd what action = do 172 | debug what 173 | c <- getController lcd 174 | action c 175 | 176 | --------------------------------------------------------------------------------------- 177 | -- High level interface, exposed to the user 178 | --------------------------------------------------------------------------------------- 179 | 180 | -- | Register an LCD controller. When registration is complete, the LCD will be initialized so that: 181 | -- 182 | -- * Set display ON (Use 'lcdDisplayOn' / 'lcdDisplayOff' to change.) 183 | -- 184 | -- * Set cursor OFF (Use 'lcdCursorOn' / 'lcdCursorOff' to change.) 185 | -- 186 | -- * Set blink OFF (Use 'lcdBlinkOn' / 'lcdBlinkOff' to change.) 187 | -- 188 | -- * Clear display (Use 'lcdClear' to clear, 'lcdWrite' to display text.) 189 | -- 190 | -- * Set entry mode left to write (Use 'lcdLeftToRight' / 'lcdRightToLeft' to control.) 191 | -- 192 | -- * Set autoscrolling OFF (Use 'lcdAutoScrollOff' / 'lcdAutoScrollOn' to control.) 193 | -- 194 | -- * Put the cursor into home position (Use 'lcdSetCursor' or 'lcdHome' to move around.) 195 | lcdRegister :: LCDController -> Arduino LCD 196 | lcdRegister controller = do 197 | bs <- gets boardState 198 | lcd <- liftIO $ modifyMVar bs $ \bst -> do 199 | let n = M.size $ lcds bst 200 | ld = LCDData { lcdDisplayMode = 0 201 | , lcdDisplayControl = 0 202 | , lcdGlyphCount = 0 203 | , lcdController = controller 204 | } 205 | return (bst {lcds = M.insert (LCD n) ld (lcds bst)}, LCD n) 206 | case controller of 207 | Hitachi44780{} -> initLCD lcd controller 208 | return lcd 209 | 210 | -- | Write a string on the LCD at the current cursor position 211 | lcdWrite :: LCD -> String -> Arduino () 212 | lcdWrite lcd m = withLCD lcd ("Writing " ++ show m ++ " to LCD") $ \c -> mapM_ (sendData c) m' 213 | where m' = map (\ch -> fromIntegral (ord ch) .&. 0xFF) m 214 | 215 | -- | Clear the LCD 216 | lcdClear :: LCD -> Arduino () 217 | lcdClear lcd = withLCD lcd "Sending clearLCD" $ \c -> 218 | do sendCmd c LCD_CLEARDISPLAY 219 | delay 2 -- give some time to make sure LCD is really cleared 220 | 221 | -- | Send the cursor to home position 222 | lcdHome :: LCD -> Arduino () 223 | lcdHome lcd = withLCD lcd "Sending the cursor home" $ \c -> 224 | do sendCmd c LCD_RETURNHOME 225 | delay 2 226 | 227 | -- | Set the cursor location. The pair of arguments is the new column and row numbers 228 | -- respectively: 229 | -- 230 | -- * The first value is the column, the second is the row. (This is counter-intuitive, but 231 | -- is in line with what the standard Arduino programmers do, so we follow the same convention.) 232 | -- 233 | -- * Counting starts at 0 (both for column and row no) 234 | -- 235 | -- * If the new location is out-of-bounds of your LCD, we will put it the cursor to the closest 236 | -- possible location on the LCD. 237 | lcdSetCursor :: LCD -> (Int, Int) -> Arduino () 238 | lcdSetCursor lcd (givenCol, givenRow) = withLCD lcd ("Sending the cursor to Row: " ++ show givenRow ++ " Col: " ++ show givenCol) set 239 | where set c@Hitachi44780{lcdRows, lcdCols} = sendCmd c (LCD_SETDDRAMADDR offset) 240 | where align :: Int -> Int -> Word8 241 | align i m 242 | | i < 0 = 0 243 | | i >= m = fromIntegral $ m-1 244 | | True = fromIntegral i 245 | col = align givenCol lcdCols 246 | row = align givenRow lcdRows 247 | -- The magic row-offsets come from various web sources 248 | -- I don't follow the logic in these numbers, but it seems to work 249 | rowOffsets = [(0, 0), (1, 0x40), (2, 0x14), (3, 0x54)] 250 | offset = col + fromMaybe 0x54 (row `lookup` rowOffsets) 251 | 252 | -- | Scroll the display to the left by 1 character. Project idea: Using a tilt sensor, scroll the contents of the display 253 | -- left/right depending on the tilt. 254 | lcdScrollDisplayLeft :: LCD -> Arduino () 255 | lcdScrollDisplayLeft lcd = withLCD lcd "Scrolling display to the left by 1" $ \c -> sendCmd c (LCD_CURSORSHIFT lcdMoveLeft) 256 | where lcdMoveLeft = 0x00 257 | 258 | -- | Scroll the display to the right by 1 character 259 | lcdScrollDisplayRight :: LCD -> Arduino () 260 | lcdScrollDisplayRight lcd = withLCD lcd "Scrolling display to the right by 1" $ \c -> sendCmd c (LCD_CURSORSHIFT lcdMoveRight) 261 | where lcdMoveRight = 0x04 262 | 263 | -- | Display characteristics helper, set the new control/mode and send 264 | -- appropriate commands if anything changed 265 | updateDisplayData :: String -> (Word8 -> Word8, Word8 -> Word8) -> LCD -> Arduino () 266 | updateDisplayData what (f, g) lcd = do 267 | debug what 268 | bs <- gets boardState 269 | err <- gets bailOut 270 | ( LCDData {lcdDisplayControl = oldC, lcdDisplayMode = oldM} 271 | , LCDData {lcdDisplayControl = newC, lcdDisplayMode = newM, lcdController = c}) 272 | <- liftIO $ modifyMVar bs $ \bst -> 273 | case lcd `M.lookup` lcds bst of 274 | Nothing -> do err ("hArduino: Cannot locate " ++ show lcd) [] 275 | exitFailure 276 | Just ld@LCDData{lcdDisplayControl, lcdDisplayMode} 277 | -> do let ld' = ld { lcdDisplayControl = f lcdDisplayControl 278 | , lcdDisplayMode = g lcdDisplayMode 279 | } 280 | return (bst{lcds = M.insert lcd ld' (lcds bst)}, (ld, ld')) 281 | when (oldC /= newC) $ sendCmd c (LCD_DISPLAYCONTROL newC) 282 | when (oldM /= newM) $ sendCmd c (LCD_ENTRYMODESET newM) 283 | 284 | -- | Update the display control word 285 | updateDisplayControl :: String -> (Word8 -> Word8) -> LCD -> Arduino () 286 | updateDisplayControl what f = updateDisplayData what (f, id) 287 | 288 | -- | Update the display mode word 289 | updateDisplayMode :: String -> (Word8 -> Word8) -> LCD -> Arduino () 290 | updateDisplayMode what g = updateDisplayData what (id, g) 291 | 292 | -- | Various control masks for the Hitachi44780 293 | data Hitachi44780Mask = LCD_BLINKON -- ^ bit @0@ Controls whether cursor blinks 294 | | LCD_CURSORON -- ^ bit @1@ Controls whether cursor is on 295 | | LCD_DISPLAYON -- ^ bit @2@ Controls whether display is on 296 | | LCD_ENTRYSHIFTINCREMENT -- ^ bit @0@ Controls left/right scroll 297 | | LCD_ENTRYLEFT -- ^ bit @1@ Controls left/right entry mode 298 | 299 | -- | Convert the mask value to the bit no 300 | maskBit :: Hitachi44780Mask -> Int 301 | maskBit LCD_BLINKON = 0 302 | maskBit LCD_CURSORON = 1 303 | maskBit LCD_DISPLAYON = 2 304 | maskBit LCD_ENTRYSHIFTINCREMENT = 0 305 | maskBit LCD_ENTRYLEFT = 1 306 | 307 | -- | Clear by the mask 308 | clearMask :: Hitachi44780Mask -> Word8 -> Word8 309 | clearMask m w = w `clearBit` maskBit m 310 | 311 | -- | Set by the mask 312 | setMask :: Hitachi44780Mask -> Word8 -> Word8 313 | setMask m w = w `setBit` maskBit m 314 | 315 | -- | Do not blink the cursor 316 | lcdBlinkOff :: LCD -> Arduino () 317 | lcdBlinkOff = updateDisplayControl "Turning blinking off" (clearMask LCD_BLINKON) 318 | 319 | -- | Blink the cursor 320 | lcdBlinkOn :: LCD -> Arduino () 321 | lcdBlinkOn = updateDisplayControl "Turning blinking on" (setMask LCD_BLINKON) 322 | 323 | -- | Hide the cursor. Note that a blinking cursor cannot be hidden, you must first 324 | -- turn off blinking. 325 | lcdCursorOff :: LCD -> Arduino () 326 | lcdCursorOff = updateDisplayControl "Not showing the cursor" (clearMask LCD_CURSORON) 327 | 328 | -- | Show the cursor 329 | lcdCursorOn :: LCD -> Arduino () 330 | lcdCursorOn = updateDisplayControl "Showing the cursor" (setMask LCD_CURSORON) 331 | 332 | -- | Turn the display off. Note that turning the display off does not mean you are 333 | -- powering it down. It simply means that the characters will not be shown until 334 | -- you turn it back on using 'lcdDisplayOn'. (Also, the contents will /not/ be 335 | -- forgotten when you call this function.) Therefore, this function is useful 336 | -- for temporarily hiding the display contents. 337 | lcdDisplayOff :: LCD -> Arduino () 338 | lcdDisplayOff = updateDisplayControl "Turning display off" (clearMask LCD_DISPLAYON) 339 | 340 | -- | Turn the display on 341 | lcdDisplayOn :: LCD -> Arduino () 342 | lcdDisplayOn = updateDisplayControl "Turning display on" (setMask LCD_DISPLAYON) 343 | 344 | -- | Set writing direction: Left to Right 345 | lcdLeftToRight :: LCD -> Arduino () 346 | lcdLeftToRight = updateDisplayMode "Setting left-to-right entry mode" (setMask LCD_ENTRYLEFT) 347 | 348 | -- | Set writing direction: Right to Left 349 | lcdRightToLeft :: LCD -> Arduino () 350 | lcdRightToLeft = updateDisplayMode "Setting right-to-left entry mode" (clearMask LCD_ENTRYLEFT) 351 | 352 | -- | Turn on auto-scrolling. In the context of the Hitachi44780 controller, this means that 353 | -- each time a letter is added, all the text is moved one space to the left. This can be 354 | -- confusing at first: It does /not/ mean that your strings will continuously scroll: 355 | -- It just means that if you write a string whose length exceeds the column-count 356 | -- of your LCD, then you'll see the tail-end of it. (Of course, this will create a scrolling 357 | -- effect as the string is being printed character by character.) 358 | -- 359 | -- Having said that, it is easy to program a scrolling string program: Simply write your string 360 | -- by calling 'lcdWrite', and then use the 'lcdScrollDisplayLeft' and 'lcdScrollDisplayRight' functions 361 | -- with appropriate delays to simulate the scrolling. 362 | lcdAutoScrollOn :: LCD -> Arduino () 363 | lcdAutoScrollOn = updateDisplayMode "Setting auto-scroll ON" (setMask LCD_ENTRYSHIFTINCREMENT) 364 | 365 | -- | Turn off auto-scrolling. See the comments for 'lcdAutoScrollOn' for details. When turned 366 | -- off (which is the default), you will /not/ see the characters at the end of your strings that 367 | -- do not fit into the display. 368 | lcdAutoScrollOff :: LCD -> Arduino () 369 | lcdAutoScrollOff = updateDisplayMode "Setting auto-scroll OFF" (clearMask LCD_ENTRYSHIFTINCREMENT) 370 | 371 | -- | Flash contents of the LCD screen 372 | lcdFlash :: LCD 373 | -> Int -- ^ Flash count 374 | -> Int -- ^ Delay amount (in milli-seconds) 375 | -> Arduino () 376 | lcdFlash lcd n d = sequence_ $ concat $ replicate n [lcdDisplayOff lcd, delay d, lcdDisplayOn lcd, delay d] 377 | 378 | -- | An abstract symbol type for user created symbols 379 | newtype LCDSymbol = LCDSymbol Word8 380 | 381 | -- | Create a custom symbol for later display. Note that controllers 382 | -- have limited capability for such symbols, typically storing no more 383 | -- than 8. The behavior is undefined if you create more symbols than your 384 | -- LCD can handle. 385 | -- 386 | -- The input is a simple description of the glyph, as a list of precisely 8 387 | -- strings, each of which must have 5 characters. Any space character is 388 | -- interpreted as a empty pixel, any non-space is a full pixel, corresponding 389 | -- to the pixel in the 5x8 characters we have on the LCD. For instance, here's 390 | -- a happy-face glyph you can use: 391 | -- 392 | -- > 393 | -- > [ " " 394 | -- > , "@ @" 395 | -- > , " " 396 | -- > , " " 397 | -- > , "@ @" 398 | -- > , " @@@ " 399 | -- > , " " 400 | -- > , " " 401 | -- > ] 402 | -- > 403 | lcdCreateSymbol :: LCD -> [String] -> Arduino LCDSymbol 404 | lcdCreateSymbol lcd glyph 405 | | length glyph /= 8 || any ((/= 5) . length) glyph 406 | = die "hArduino: lcdCreateSymbol: Invalid glyph description: must be 8x5!" ("Received:" : glyph) 407 | | True 408 | = do bs <- gets boardState 409 | err <- gets bailOut 410 | (i, c) <- liftIO $ modifyMVar bs $ \bst -> 411 | case lcd `M.lookup` lcds bst of 412 | Nothing -> do err ("hArduino: Cannot locate " ++ show lcd) [] 413 | exitFailure 414 | Just ld@LCDData{lcdGlyphCount, lcdController} 415 | -> do let ld' = ld { lcdGlyphCount = lcdGlyphCount + 1 } 416 | return (bst{lcds = M.insert lcd ld' (lcds bst)}, (lcdGlyphCount, lcdController)) 417 | sendCmd c (LCD_SETCGRAMADDR i) 418 | let cvt :: String -> Word8 419 | cvt s = foldr (.|.) 0 [bit p | (ch, p) <- zip (reverse s) [0..], not (isSpace ch)] 420 | mapM_ (sendData c . cvt) glyph 421 | return $ LCDSymbol i 422 | 423 | -- | Display a user created symbol on the LCD. (See 'lcdCreateSymbol' for details.) 424 | lcdWriteSymbol :: LCD -> LCDSymbol -> Arduino () 425 | lcdWriteSymbol lcd (LCDSymbol i) = withLCD lcd ("Writing custom symbol " ++ show i ++ " to LCD") $ \c -> sendData c i 426 | 427 | -- | Access an internally stored symbol, one that is not available via its ASCII equivalent. See 428 | -- the Hitachi datasheet for possible values: , Table 4 on page 17. 429 | -- 430 | -- For instance, to access the symbol right-arrow: 431 | -- 432 | -- * Locate it in the above table: Right-arrow is at the second-to-last row, 7th character from left. 433 | -- 434 | -- * Check the upper/higher bits as specified in the table: For Right-arrow, upper bits are @0111@ and the 435 | -- lower bits are @1110@; which gives us the code @01111110@, or @0x7E@. 436 | -- 437 | -- * So, right-arrow can be accessed by symbol code 'lcdInternalSymbol' @0x7E@, which will give us a 'LCDSymbol' value 438 | -- that can be passed to the 'lcdWriteSymbol' function. The code would look like this: @lcdWriteSymbol lcd (lcdInternalSymbol 0x7E)@. 439 | lcdInternalSymbol :: Word8 -> LCDSymbol 440 | lcdInternalSymbol = LCDSymbol 441 | -------------------------------------------------------------------------------- /StandardFirmata/StandardFirmata.ino: -------------------------------------------------------------------------------- 1 | /* 2 | * Firmata is a generic protocol for communicating with microcontrollers 3 | * from software on a host computer. It is intended to work with 4 | * any host computer software package. 5 | * 6 | * To download a host software package, please clink on the following link 7 | * to open the download page in your default browser. 8 | * 9 | * http://firmata.org/wiki/Download 10 | */ 11 | 12 | /* 13 | Copyright (C) 2006-2008 Hans-Christoph Steiner. All rights reserved. 14 | Copyright (C) 2010-2011 Paul Stoffregen. All rights reserved. 15 | Copyright (C) 2009 Shigeru Kobayashi. All rights reserved. 16 | Copyright (C) 2009-2011 Jeff Hoefs. All rights reserved. 17 | 18 | This library is free software; you can redistribute it and/or 19 | modify it under the terms of the GNU Lesser General Public 20 | License as published by the Free Software Foundation; either 21 | version 2.1 of the License, or (at your option) any later version. 22 | 23 | See file LICENSE.txt for further informations on licensing terms. 24 | 25 | formatted using the GNU C formatting and indenting 26 | */ 27 | 28 | /* 29 | * TODO: use Program Control to load stored profiles from EEPROM 30 | */ 31 | 32 | #include 33 | #include 34 | #include 35 | 36 | // move the following defines to Firmata.h? 37 | #define I2C_WRITE B00000000 38 | #define I2C_READ B00001000 39 | #define I2C_READ_CONTINUOUSLY B00010000 40 | #define I2C_STOP_READING B00011000 41 | #define I2C_READ_WRITE_MODE_MASK B00011000 42 | #define I2C_10BIT_ADDRESS_MODE_MASK B00100000 43 | 44 | #define MAX_QUERIES 8 45 | #define MINIMUM_SAMPLING_INTERVAL 10 46 | 47 | #define REGISTER_NOT_SPECIFIED -1 48 | 49 | /*============================================================================== 50 | * GLOBAL VARIABLES 51 | *============================================================================*/ 52 | 53 | /* analog inputs */ 54 | int analogInputsToReport = 0; // bitwise array to store pin reporting 55 | 56 | /* digital input ports */ 57 | byte reportPINs[TOTAL_PORTS]; // 1 = report this port, 0 = silence 58 | byte previousPINs[TOTAL_PORTS]; // previous 8 bits sent 59 | 60 | /* pins configuration */ 61 | byte pinConfig[TOTAL_PINS]; // configuration of every pin 62 | byte portConfigInputs[TOTAL_PORTS]; // each bit: 1 = pin in INPUT, 0 = anything else 63 | int pinState[TOTAL_PINS]; // any value that has been written 64 | 65 | /* timer variables */ 66 | unsigned long currentMillis; // store the current value from millis() 67 | unsigned long previousMillis; // for comparison with currentMillis 68 | int samplingInterval = 19; // how often to run the main loop (in ms) 69 | 70 | /* i2c data */ 71 | struct i2c_device_info { 72 | byte addr; 73 | byte reg; 74 | byte bytes; 75 | }; 76 | 77 | /* for i2c read continuous more */ 78 | i2c_device_info query[MAX_QUERIES]; 79 | 80 | byte i2cRxData[32]; 81 | boolean isI2CEnabled = false; 82 | signed char queryIndex = -1; 83 | unsigned int i2cReadDelayTime = 0; // default delay time between i2c read request and Wire.requestFrom() 84 | 85 | Servo servos[MAX_SERVOS]; 86 | /*============================================================================== 87 | * FUNCTIONS 88 | *============================================================================*/ 89 | 90 | void readAndReportData(byte address, int theRegister, byte numBytes) { 91 | // allow I2C requests that don't require a register read 92 | // for example, some devices using an interrupt pin to signify new data available 93 | // do not always require the register read so upon interrupt you call Wire.requestFrom() 94 | if (theRegister != REGISTER_NOT_SPECIFIED) { 95 | Wire.beginTransmission(address); 96 | #if ARDUINO >= 100 97 | Wire.write((byte)theRegister); 98 | #else 99 | Wire.send((byte)theRegister); 100 | #endif 101 | Wire.endTransmission(); 102 | delayMicroseconds(i2cReadDelayTime); // delay is necessary for some devices such as WiiNunchuck 103 | } else { 104 | theRegister = 0; // fill the register with a dummy value 105 | } 106 | 107 | Wire.requestFrom(address, numBytes); // all bytes are returned in requestFrom 108 | 109 | // check to be sure correct number of bytes were returned by slave 110 | if(numBytes == Wire.available()) { 111 | i2cRxData[0] = address; 112 | i2cRxData[1] = theRegister; 113 | for (int i = 0; i < numBytes; i++) { 114 | #if ARDUINO >= 100 115 | i2cRxData[2 + i] = Wire.read(); 116 | #else 117 | i2cRxData[2 + i] = Wire.receive(); 118 | #endif 119 | } 120 | } 121 | else { 122 | if(numBytes > Wire.available()) { 123 | Firmata.sendString("I2C Read Error: Too many bytes received"); 124 | } else { 125 | Firmata.sendString("I2C Read Error: Too few bytes received"); 126 | } 127 | } 128 | 129 | // send slave address, register and received bytes 130 | Firmata.sendSysex(SYSEX_I2C_REPLY, numBytes + 2, i2cRxData); 131 | } 132 | 133 | void outputPort(byte portNumber, byte portValue, byte forceSend) 134 | { 135 | // pins not configured as INPUT are cleared to zeros 136 | portValue = portValue & portConfigInputs[portNumber]; 137 | // only send if the value is different than previously sent 138 | if(forceSend || previousPINs[portNumber] != portValue) { 139 | Firmata.sendDigitalPort(portNumber, portValue); 140 | previousPINs[portNumber] = portValue; 141 | } 142 | } 143 | 144 | /* ----------------------------------------------------------------------------- 145 | * check all the active digital inputs for change of state, then add any events 146 | * to the Serial output queue using Serial.print() */ 147 | void checkDigitalInputs(void) 148 | { 149 | /* Using non-looping code allows constants to be given to readPort(). 150 | * The compiler will apply substantial optimizations if the inputs 151 | * to readPort() are compile-time constants. */ 152 | if (TOTAL_PORTS > 0 && reportPINs[0]) outputPort(0, readPort(0, portConfigInputs[0]), false); 153 | if (TOTAL_PORTS > 1 && reportPINs[1]) outputPort(1, readPort(1, portConfigInputs[1]), false); 154 | if (TOTAL_PORTS > 2 && reportPINs[2]) outputPort(2, readPort(2, portConfigInputs[2]), false); 155 | if (TOTAL_PORTS > 3 && reportPINs[3]) outputPort(3, readPort(3, portConfigInputs[3]), false); 156 | if (TOTAL_PORTS > 4 && reportPINs[4]) outputPort(4, readPort(4, portConfigInputs[4]), false); 157 | if (TOTAL_PORTS > 5 && reportPINs[5]) outputPort(5, readPort(5, portConfigInputs[5]), false); 158 | if (TOTAL_PORTS > 6 && reportPINs[6]) outputPort(6, readPort(6, portConfigInputs[6]), false); 159 | if (TOTAL_PORTS > 7 && reportPINs[7]) outputPort(7, readPort(7, portConfigInputs[7]), false); 160 | if (TOTAL_PORTS > 8 && reportPINs[8]) outputPort(8, readPort(8, portConfigInputs[8]), false); 161 | if (TOTAL_PORTS > 9 && reportPINs[9]) outputPort(9, readPort(9, portConfigInputs[9]), false); 162 | if (TOTAL_PORTS > 10 && reportPINs[10]) outputPort(10, readPort(10, portConfigInputs[10]), false); 163 | if (TOTAL_PORTS > 11 && reportPINs[11]) outputPort(11, readPort(11, portConfigInputs[11]), false); 164 | if (TOTAL_PORTS > 12 && reportPINs[12]) outputPort(12, readPort(12, portConfigInputs[12]), false); 165 | if (TOTAL_PORTS > 13 && reportPINs[13]) outputPort(13, readPort(13, portConfigInputs[13]), false); 166 | if (TOTAL_PORTS > 14 && reportPINs[14]) outputPort(14, readPort(14, portConfigInputs[14]), false); 167 | if (TOTAL_PORTS > 15 && reportPINs[15]) outputPort(15, readPort(15, portConfigInputs[15]), false); 168 | } 169 | 170 | // ----------------------------------------------------------------------------- 171 | /* sets the pin mode to the correct state and sets the relevant bits in the 172 | * two bit-arrays that track Digital I/O and PWM status 173 | */ 174 | void setPinModeCallback(byte pin, int mode) 175 | { 176 | if (pinConfig[pin] == I2C && isI2CEnabled && mode != I2C) { 177 | // disable i2c so pins can be used for other functions 178 | // the following if statements should reconfigure the pins properly 179 | disableI2CPins(); 180 | } 181 | if (IS_PIN_SERVO(pin) && mode != SERVO && servos[PIN_TO_SERVO(pin)].attached()) { 182 | servos[PIN_TO_SERVO(pin)].detach(); 183 | } 184 | if (IS_PIN_ANALOG(pin)) { 185 | reportAnalogCallback(PIN_TO_ANALOG(pin), mode == ANALOG ? 1 : 0); // turn on/off reporting 186 | } 187 | if (IS_PIN_DIGITAL(pin)) { 188 | if (mode == INPUT) { 189 | portConfigInputs[pin/8] |= (1 << (pin & 7)); 190 | } else { 191 | portConfigInputs[pin/8] &= ~(1 << (pin & 7)); 192 | } 193 | } 194 | pinState[pin] = 0; 195 | switch(mode) { 196 | case ANALOG: 197 | if (IS_PIN_ANALOG(pin)) { 198 | if (IS_PIN_DIGITAL(pin)) { 199 | pinMode(PIN_TO_DIGITAL(pin), INPUT); // disable output driver 200 | digitalWrite(PIN_TO_DIGITAL(pin), LOW); // disable internal pull-ups 201 | } 202 | pinConfig[pin] = ANALOG; 203 | } 204 | break; 205 | case INPUT: 206 | if (IS_PIN_DIGITAL(pin)) { 207 | pinMode(PIN_TO_DIGITAL(pin), INPUT); // disable output driver 208 | digitalWrite(PIN_TO_DIGITAL(pin), LOW); // disable internal pull-ups 209 | pinConfig[pin] = INPUT; 210 | } 211 | break; 212 | case OUTPUT: 213 | if (IS_PIN_DIGITAL(pin)) { 214 | digitalWrite(PIN_TO_DIGITAL(pin), LOW); // disable PWM 215 | pinMode(PIN_TO_DIGITAL(pin), OUTPUT); 216 | pinConfig[pin] = OUTPUT; 217 | } 218 | break; 219 | case PWM: 220 | if (IS_PIN_PWM(pin)) { 221 | pinMode(PIN_TO_PWM(pin), OUTPUT); 222 | analogWrite(PIN_TO_PWM(pin), 0); 223 | pinConfig[pin] = PWM; 224 | } 225 | break; 226 | case SERVO: 227 | if (IS_PIN_SERVO(pin)) { 228 | pinConfig[pin] = SERVO; 229 | if (!servos[PIN_TO_SERVO(pin)].attached()) { 230 | servos[PIN_TO_SERVO(pin)].attach(PIN_TO_DIGITAL(pin)); 231 | } 232 | } 233 | break; 234 | case I2C: 235 | if (IS_PIN_I2C(pin)) { 236 | // mark the pin as i2c 237 | // the user must call I2C_CONFIG to enable I2C for a device 238 | pinConfig[pin] = I2C; 239 | } 240 | break; 241 | default: 242 | Firmata.sendString("Unknown pin mode"); // TODO: put error msgs in EEPROM 243 | } 244 | // TODO: save status to EEPROM here, if changed 245 | } 246 | 247 | void analogWriteCallback(byte pin, int value) 248 | { 249 | if (pin < TOTAL_PINS) { 250 | switch(pinConfig[pin]) { 251 | case SERVO: 252 | if (IS_PIN_SERVO(pin)) 253 | servos[PIN_TO_SERVO(pin)].write(value); 254 | pinState[pin] = value; 255 | break; 256 | case PWM: 257 | if (IS_PIN_PWM(pin)) 258 | analogWrite(PIN_TO_PWM(pin), value); 259 | pinState[pin] = value; 260 | break; 261 | } 262 | } 263 | } 264 | 265 | void digitalWriteCallback(byte port, int value) 266 | { 267 | byte pin, lastPin, mask=1, pinWriteMask=0; 268 | 269 | if (port < TOTAL_PORTS) { 270 | // create a mask of the pins on this port that are writable. 271 | lastPin = port*8+8; 272 | if (lastPin > TOTAL_PINS) lastPin = TOTAL_PINS; 273 | for (pin=port*8; pin < lastPin; pin++) { 274 | // do not disturb non-digital pins (eg, Rx & Tx) 275 | if (IS_PIN_DIGITAL(pin)) { 276 | // only write to OUTPUT and INPUT (enables pullup) 277 | // do not touch pins in PWM, ANALOG, SERVO or other modes 278 | if (pinConfig[pin] == OUTPUT || pinConfig[pin] == INPUT) { 279 | pinWriteMask |= mask; 280 | pinState[pin] = ((byte)value & mask) ? 1 : 0; 281 | } 282 | } 283 | mask = mask << 1; 284 | } 285 | writePort(port, (byte)value, pinWriteMask); 286 | } 287 | } 288 | 289 | 290 | // ----------------------------------------------------------------------------- 291 | /* sets bits in a bit array (int) to toggle the reporting of the analogIns 292 | */ 293 | //void FirmataClass::setAnalogPinReporting(byte pin, byte state) { 294 | //} 295 | void reportAnalogCallback(byte analogPin, int value) 296 | { 297 | if (analogPin < TOTAL_ANALOG_PINS) { 298 | if(value == 0) { 299 | analogInputsToReport = analogInputsToReport &~ (1 << analogPin); 300 | } else { 301 | analogInputsToReport = analogInputsToReport | (1 << analogPin); 302 | } 303 | } 304 | // TODO: save status to EEPROM here, if changed 305 | } 306 | 307 | void reportDigitalCallback(byte port, int value) 308 | { 309 | if (port < TOTAL_PORTS) { 310 | reportPINs[port] = (byte)value; 311 | } 312 | // do not disable analog reporting on these 8 pins, to allow some 313 | // pins used for digital, others analog. Instead, allow both types 314 | // of reporting to be enabled, but check if the pin is configured 315 | // as analog when sampling the analog inputs. Likewise, while 316 | // scanning digital pins, portConfigInputs will mask off values from any 317 | // pins configured as analog 318 | } 319 | 320 | /*============================================================================== 321 | * SYSEX-BASED commands 322 | *============================================================================*/ 323 | 324 | void sysexCallback(byte command, byte argc, byte *argv) 325 | { 326 | byte mode; 327 | byte slaveAddress; 328 | byte slaveRegister; 329 | byte data; 330 | unsigned int delayTime; 331 | 332 | switch(command) { 333 | case I2C_REQUEST: 334 | mode = argv[1] & I2C_READ_WRITE_MODE_MASK; 335 | if (argv[1] & I2C_10BIT_ADDRESS_MODE_MASK) { 336 | Firmata.sendString("10-bit addressing mode is not yet supported"); 337 | return; 338 | } 339 | else { 340 | slaveAddress = argv[0]; 341 | } 342 | 343 | switch(mode) { 344 | case I2C_WRITE: 345 | Wire.beginTransmission(slaveAddress); 346 | for (byte i = 2; i < argc; i += 2) { 347 | data = argv[i] + (argv[i + 1] << 7); 348 | #if ARDUINO >= 100 349 | Wire.write(data); 350 | #else 351 | Wire.send(data); 352 | #endif 353 | } 354 | Wire.endTransmission(); 355 | delayMicroseconds(70); 356 | break; 357 | case I2C_READ: 358 | if (argc == 6) { 359 | // a slave register is specified 360 | slaveRegister = argv[2] + (argv[3] << 7); 361 | data = argv[4] + (argv[5] << 7); // bytes to read 362 | readAndReportData(slaveAddress, (int)slaveRegister, data); 363 | } 364 | else { 365 | // a slave register is NOT specified 366 | data = argv[2] + (argv[3] << 7); // bytes to read 367 | readAndReportData(slaveAddress, (int)REGISTER_NOT_SPECIFIED, data); 368 | } 369 | break; 370 | case I2C_READ_CONTINUOUSLY: 371 | if ((queryIndex + 1) >= MAX_QUERIES) { 372 | // too many queries, just ignore 373 | Firmata.sendString("too many queries"); 374 | break; 375 | } 376 | queryIndex++; 377 | query[queryIndex].addr = slaveAddress; 378 | query[queryIndex].reg = argv[2] + (argv[3] << 7); 379 | query[queryIndex].bytes = argv[4] + (argv[5] << 7); 380 | break; 381 | case I2C_STOP_READING: 382 | byte queryIndexToSkip; 383 | // if read continuous mode is enabled for only 1 i2c device, disable 384 | // read continuous reporting for that device 385 | if (queryIndex <= 0) { 386 | queryIndex = -1; 387 | } else { 388 | // if read continuous mode is enabled for multiple devices, 389 | // determine which device to stop reading and remove it's data from 390 | // the array, shifiting other array data to fill the space 391 | for (byte i = 0; i < queryIndex + 1; i++) { 392 | if (query[i].addr = slaveAddress) { 393 | queryIndexToSkip = i; 394 | break; 395 | } 396 | } 397 | 398 | for (byte i = queryIndexToSkip; i 0) { 416 | i2cReadDelayTime = delayTime; 417 | } 418 | 419 | if (!isI2CEnabled) { 420 | enableI2CPins(); 421 | } 422 | 423 | break; 424 | case SERVO_CONFIG: 425 | if(argc > 4) { 426 | // these vars are here for clarity, they'll optimized away by the compiler 427 | byte pin = argv[0]; 428 | int minPulse = argv[1] + (argv[2] << 7); 429 | int maxPulse = argv[3] + (argv[4] << 7); 430 | 431 | if (IS_PIN_SERVO(pin)) { 432 | if (servos[PIN_TO_SERVO(pin)].attached()) 433 | servos[PIN_TO_SERVO(pin)].detach(); 434 | servos[PIN_TO_SERVO(pin)].attach(PIN_TO_DIGITAL(pin), minPulse, maxPulse); 435 | setPinModeCallback(pin, SERVO); 436 | } 437 | } 438 | break; 439 | case SAMPLING_INTERVAL: 440 | if (argc > 1) { 441 | samplingInterval = argv[0] + (argv[1] << 7); 442 | if (samplingInterval < MINIMUM_SAMPLING_INTERVAL) { 443 | samplingInterval = MINIMUM_SAMPLING_INTERVAL; 444 | } 445 | } else { 446 | //Firmata.sendString("Not enough data"); 447 | } 448 | break; 449 | case EXTENDED_ANALOG: 450 | if (argc > 1) { 451 | int val = argv[1]; 452 | if (argc > 2) val |= (argv[2] << 7); 453 | if (argc > 3) val |= (argv[3] << 14); 454 | analogWriteCallback(argv[0], val); 455 | } 456 | break; 457 | case CAPABILITY_QUERY: 458 | Serial.write(START_SYSEX); 459 | Serial.write(CAPABILITY_RESPONSE); 460 | for (byte pin=0; pin < TOTAL_PINS; pin++) { 461 | if (IS_PIN_DIGITAL(pin)) { 462 | Serial.write((byte)INPUT); 463 | Serial.write(1); 464 | Serial.write((byte)OUTPUT); 465 | Serial.write(1); 466 | } 467 | if (IS_PIN_ANALOG(pin)) { 468 | Serial.write(ANALOG); 469 | Serial.write(10); 470 | } 471 | if (IS_PIN_PWM(pin)) { 472 | Serial.write(PWM); 473 | Serial.write(8); 474 | } 475 | if (IS_PIN_SERVO(pin)) { 476 | Serial.write(SERVO); 477 | Serial.write(14); 478 | } 479 | if (IS_PIN_I2C(pin)) { 480 | Serial.write(I2C); 481 | Serial.write(1); // to do: determine appropriate value 482 | } 483 | Serial.write(127); 484 | } 485 | Serial.write(END_SYSEX); 486 | break; 487 | case PIN_STATE_QUERY: 488 | if (argc > 0) { 489 | byte pin=argv[0]; 490 | Serial.write(START_SYSEX); 491 | Serial.write(PIN_STATE_RESPONSE); 492 | Serial.write(pin); 493 | if (pin < TOTAL_PINS) { 494 | Serial.write((byte)pinConfig[pin]); 495 | Serial.write((byte)pinState[pin] & 0x7F); 496 | if (pinState[pin] & 0xFF80) Serial.write((byte)(pinState[pin] >> 7) & 0x7F); 497 | if (pinState[pin] & 0xC000) Serial.write((byte)(pinState[pin] >> 14) & 0x7F); 498 | } 499 | Serial.write(END_SYSEX); 500 | } 501 | break; 502 | case ANALOG_MAPPING_QUERY: 503 | Serial.write(START_SYSEX); 504 | Serial.write(ANALOG_MAPPING_RESPONSE); 505 | for (byte pin=0; pin < TOTAL_PINS; pin++) { 506 | Serial.write(IS_PIN_ANALOG(pin) ? PIN_TO_ANALOG(pin) : 127); 507 | } 508 | Serial.write(END_SYSEX); 509 | break; 510 | } 511 | } 512 | 513 | void enableI2CPins() 514 | { 515 | byte i; 516 | // is there a faster way to do this? would probaby require importing 517 | // Arduino.h to get SCL and SDA pins 518 | for (i=0; i < TOTAL_PINS; i++) { 519 | if(IS_PIN_I2C(i)) { 520 | // mark pins as i2c so they are ignore in non i2c data requests 521 | setPinModeCallback(i, I2C); 522 | } 523 | } 524 | 525 | isI2CEnabled = true; 526 | 527 | // is there enough time before the first I2C request to call this here? 528 | Wire.begin(); 529 | } 530 | 531 | /* disable the i2c pins so they can be used for other functions */ 532 | void disableI2CPins() { 533 | isI2CEnabled = false; 534 | // disable read continuous mode for all devices 535 | queryIndex = -1; 536 | // uncomment the following if or when the end() method is added to Wire library 537 | // Wire.end(); 538 | } 539 | 540 | /*============================================================================== 541 | * SETUP() 542 | *============================================================================*/ 543 | 544 | void systemResetCallback() 545 | { 546 | // initialize a defalt state 547 | // TODO: option to load config from EEPROM instead of default 548 | if (isI2CEnabled) { 549 | disableI2CPins(); 550 | } 551 | for (byte i=0; i < TOTAL_PORTS; i++) { 552 | reportPINs[i] = false; // by default, reporting off 553 | portConfigInputs[i] = 0; // until activated 554 | previousPINs[i] = 0; 555 | } 556 | // pins with analog capability default to analog input 557 | // otherwise, pins default to digital output 558 | for (byte i=0; i < TOTAL_PINS; i++) { 559 | if (IS_PIN_ANALOG(i)) { 560 | // turns off pullup, configures everything 561 | setPinModeCallback(i, ANALOG); 562 | } else { 563 | // sets the output to 0, configures portConfigInputs 564 | setPinModeCallback(i, OUTPUT); 565 | } 566 | } 567 | // by default, do not report any analog inputs 568 | analogInputsToReport = 0; 569 | 570 | /* send digital inputs to set the initial state on the host computer, 571 | * since once in the loop(), this firmware will only send on change */ 572 | /* 573 | TODO: this can never execute, since no pins default to digital input 574 | but it will be needed when/if we support EEPROM stored config 575 | for (byte i=0; i < TOTAL_PORTS; i++) { 576 | outputPort(i, readPort(i, portConfigInputs[i]), true); 577 | } 578 | */ 579 | } 580 | 581 | void setup() 582 | { 583 | Firmata.setFirmwareVersion(FIRMATA_MAJOR_VERSION, FIRMATA_MINOR_VERSION); 584 | 585 | Firmata.attach(ANALOG_MESSAGE, analogWriteCallback); 586 | Firmata.attach(DIGITAL_MESSAGE, digitalWriteCallback); 587 | Firmata.attach(REPORT_ANALOG, reportAnalogCallback); 588 | Firmata.attach(REPORT_DIGITAL, reportDigitalCallback); 589 | Firmata.attach(SET_PIN_MODE, setPinModeCallback); 590 | Firmata.attach(START_SYSEX, sysexCallback); 591 | Firmata.attach(SYSTEM_RESET, systemResetCallback); 592 | 593 | Firmata.begin(57600); 594 | systemResetCallback(); // reset to default config 595 | } 596 | 597 | /*============================================================================== 598 | * LOOP() 599 | *============================================================================*/ 600 | void loop() 601 | { 602 | byte pin, analogPin; 603 | 604 | /* DIGITALREAD - as fast as possible, check for changes and output them to the 605 | * FTDI buffer using Serial.print() */ 606 | checkDigitalInputs(); 607 | 608 | /* SERIALREAD - processing incoming messagse as soon as possible, while still 609 | * checking digital inputs. */ 610 | while(Firmata.available()) 611 | Firmata.processInput(); 612 | 613 | /* SEND FTDI WRITE BUFFER - make sure that the FTDI buffer doesn't go over 614 | * 60 bytes. use a timer to sending an event character every 4 ms to 615 | * trigger the buffer to dump. */ 616 | 617 | currentMillis = millis(); 618 | if (currentMillis - previousMillis > samplingInterval) { 619 | previousMillis += samplingInterval; 620 | /* ANALOGREAD - do all analogReads() at the configured sampling interval */ 621 | for(pin=0; pin -1) { 631 | for (byte i = 0; i < queryIndex + 1; i++) { 632 | readAndReportData(query[i].addr, query[i].reg, query[i].bytes); 633 | } 634 | } 635 | } 636 | } 637 | -------------------------------------------------------------------------------- /System/Hardware/Arduino/Data.hs: -------------------------------------------------------------------------------- 1 | ------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : System.Hardware.Arduino.Data 4 | -- Copyright : (c) Levent Erkok 5 | -- License : BSD3 6 | -- Maintainer : erkokl@gmail.com 7 | -- Stability : experimental 8 | -- 9 | -- Underlying data structures 10 | ------------------------------------------------------------------------------- 11 | 12 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 13 | {-# LANGUAGE NamedFieldPuns #-} 14 | {-# LANGUAGE RankNTypes #-} 15 | 16 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} 17 | 18 | module System.Hardware.Arduino.Data where 19 | 20 | import Control.Concurrent (Chan, MVar, modifyMVar, modifyMVar_, withMVar, ThreadId) 21 | import Control.Monad (when) 22 | import Control.Monad.State (StateT, MonadIO, MonadState, gets, liftIO) 23 | import Data.Bits ((.&.), (.|.), setBit) 24 | import Data.List (intercalate) 25 | import Data.Maybe (fromMaybe, listToMaybe) 26 | import Data.Word (Word8, Word32) 27 | import System.Hardware.Serialport (SerialPort) 28 | 29 | import qualified Data.Map as M 30 | import qualified Data.Set as S 31 | 32 | import System.Hardware.Arduino.Utils 33 | 34 | import System.Exit (exitFailure) 35 | 36 | -- | A port (containing 8 pins) 37 | newtype Port = Port { portNo :: Word8 -- ^ The port number 38 | } 39 | deriving (Eq, Ord) 40 | 41 | -- | Show instance for Port 42 | instance Show Port where 43 | show p = "Port" ++ show (portNo p) 44 | 45 | -- | A pin on the Arduino, as specified by the user via 'pin', 'digital', and 'analog' functions. 46 | data Pin = DigitalPin {userPinNo :: Word8} 47 | | AnalogPin {userPinNo :: Word8} 48 | | MixedPin {userPinNo :: Word8} 49 | 50 | -- | Show instance for Pin 51 | instance Show Pin where 52 | show (DigitalPin w) = "DPin" ++ show w 53 | show (AnalogPin w) = "APin" ++ show w 54 | show (MixedPin w) = "Pin" ++ show w 55 | 56 | -- | A pin on the Arduino, as viewed by the library; i.e., real-pin numbers 57 | newtype IPin = InternalPin { pinNo :: Word8 } 58 | deriving (Eq, Ord) 59 | 60 | -- | Show instance for IPin 61 | instance Show IPin where 62 | show (InternalPin w) = "IPin" ++ show w 63 | 64 | -- | Declare a pin by its index. For maximum portability, prefer 'digital' 65 | -- and 'analog' functions, which will adjust pin indexes properly based on 66 | -- which board the program is running on at run-time, as Arduino boards 67 | -- differ in their pin numbers. This function is provided for cases where 68 | -- a pin is used in mixed-mode, i.e., both for digital and analog purposes, 69 | -- as Arduino does not really distinguish pin usage. In these cases, the 70 | -- user has the proof obligation to make sure that the index used is supported 71 | -- on the board with appropriate capabilities. 72 | pin :: Word8 -> Pin 73 | pin = MixedPin 74 | 75 | -- | Declare an digital pin on the board. For instance, to refer to digital pin no 12 76 | -- use 'digital' @12@. 77 | digital :: Word8 -> Pin 78 | digital = DigitalPin 79 | 80 | -- | Declare an analog pin on the board. For instance, to refer to analog pin no 0 81 | -- simply use 'analog' @0@. 82 | -- 83 | -- Note that 'analog' @0@ on an Arduino UNO will be appropriately adjusted 84 | -- internally to refer to pin 14, since UNO has 13 digital pins, while on an 85 | -- Arduino MEGA, it will refer to internal pin 55, since MEGA has 54 digital pins; 86 | -- and similarly for other boards depending on their capabilities. 87 | -- (Also see the note on 'pin' for pin mappings.) 88 | analog :: Word8 -> Pin 89 | analog = AnalogPin 90 | 91 | -- | On the Arduino, pins are grouped into banks of 8. 92 | -- Given a pin, this function determines which port it belongs to 93 | pinPort :: IPin -> Port 94 | pinPort p = Port (pinNo p `quot` 8) 95 | 96 | -- | On the Arduino, pins are grouped into banks of 8. 97 | -- Given a pin, this function determines which index it belongs to in its port 98 | pinPortIndex :: IPin -> Word8 99 | pinPortIndex p = pinNo p `rem` 8 100 | 101 | -- | The mode for a pin. 102 | data PinMode = INPUT -- ^ Digital input 103 | | OUTPUT -- ^ Digital output 104 | | ANALOG -- ^ Analog input 105 | | PWM -- ^ PWM (Pulse-Width-Modulation) output 106 | | SERVO -- ^ Servo Motor controller 107 | | SHIFT -- ^ Shift controller 108 | | I2C -- ^ I2C (Inter-Integrated-Circuit) connection 109 | | ONEWIRE -- ^ NB. No explicit support 110 | | STEPPER -- ^ NB. No explicit support 111 | | ENCODER -- ^ NB. No explicit support 112 | | SERIAL -- ^ NB. No explicit support 113 | | PULLUP -- ^ NB. No explicit support 114 | | UNSUPPORTED -- ^ A mode we do not understand or support 115 | deriving (Eq, Show, Enum) 116 | 117 | -- | A request, as sent to Arduino 118 | data Request = SystemReset -- ^ Send system reset 119 | | QueryFirmware -- ^ Query the Firmata version installed 120 | | CapabilityQuery -- ^ Query the capabilities of the board 121 | | AnalogMappingQuery -- ^ Query the mapping of analog pins 122 | | SetPinMode IPin PinMode -- ^ Set the mode on a pin 123 | | DigitalReport Port Bool -- ^ Digital report values on port enable/disable 124 | | AnalogReport IPin Bool -- ^ Analog report values on pin enable/disable 125 | | DigitalPortWrite Port Word8 Word8 -- ^ Set the values on a port digitally 126 | | AnalogPinWrite IPin Word8 Word8 -- ^ Send an analog-write; used for servo control 127 | | SamplingInterval Word8 Word8 -- ^ Set the sampling interval 128 | | Pulse IPin Bool Word32 Word32 -- ^ Request for a pulse reading on a pin, value, duration, timeout 129 | deriving Show 130 | 131 | -- | A response, as returned from the Arduino 132 | data Response = Firmware Word8 Word8 String -- ^ Firmware version (maj/min and indentifier 133 | | Capabilities BoardCapabilities -- ^ Capabilities report 134 | | AnalogMapping [Word8] -- ^ Analog pin mappings 135 | | DigitalMessage Port Word8 Word8 -- ^ Status of a port 136 | | AnalogMessage IPin Word8 Word8 -- ^ Status of an analog pin 137 | | PulseResponse IPin Word32 -- ^ Repsonse to a PulseInCommand 138 | | Unimplemented (Maybe String) [Word8] -- ^ Represents messages currently unsupported 139 | 140 | -- | Show instance for Response 141 | instance Show Response where 142 | show (Firmware majV minV n) = "Firmware v" ++ show majV ++ "." ++ show minV ++ " (" ++ n ++ ")" 143 | show (Capabilities b) = "Capabilities:\n" ++ show b 144 | show (AnalogMapping bs) = "AnalogMapping: " ++ showByteList bs 145 | show (DigitalMessage p l h) = "DigitalMessage " ++ show p ++ " = " ++ showByte l ++ " " ++ showByte h 146 | show (AnalogMessage p l h) = "AnalogMessage " ++ show p ++ " = " ++ showByte l ++ " " ++ showByte h 147 | show (PulseResponse p v) = "PulseResponse " ++ show p ++ " = " ++ show v ++ " (microseconds)" 148 | show (Unimplemented mbc bs) = "Unimplemeneted " ++ fromMaybe "" mbc ++ " " ++ showByteList bs 149 | 150 | -- | Resolution, as referred to in http://firmata.org/wiki/Protocol#Capability_Query 151 | -- TODO: Not quite sure how this is used, so merely keep it as a Word8 now 152 | type Resolution = Word8 153 | 154 | -- | Capabilities of a pin 155 | data PinCapabilities = PinCapabilities { 156 | analogPinNumber :: Maybe Word8 -- ^ Analog pin number, if any 157 | , allowedModes :: [(PinMode, Resolution)] -- ^ Allowed modes and resolutions 158 | } 159 | 160 | -- | What the board is capable of and current settings 161 | newtype BoardCapabilities = BoardCapabilities (M.Map IPin PinCapabilities) 162 | 163 | -- | Show instance for BoardCapabilities 164 | instance Show BoardCapabilities where 165 | show (BoardCapabilities m) = intercalate "\n" (map sh (M.toAscList m)) 166 | where sh (p, PinCapabilities{analogPinNumber, allowedModes}) = show p ++ sep ++ unwords [show md | (md, _) <- allowedModes] 167 | where sep = maybe ": " (\i -> "[A" ++ show i ++ "]: ") analogPinNumber 168 | 169 | -- | Data associated with a pin 170 | data PinData = PinData { 171 | pinMode :: PinMode 172 | , pinValue :: Maybe (Either Bool Int) 173 | } 174 | deriving Show 175 | 176 | -- | LCD's connected to the board 177 | newtype LCD = LCD Int 178 | deriving (Eq, Ord, Show) 179 | 180 | -- | Hitachi LCD controller: See: . 181 | -- We model only the 4-bit variant, with RS and EN lines only. (The most common Arduino usage.) 182 | -- The data sheet can be seen at: . 183 | data LCDController = Hitachi44780 { 184 | lcdRS :: Pin -- ^ Hitachi pin @ 4@: Register-select 185 | , lcdEN :: Pin -- ^ Hitachi pin @ 6@: Enable 186 | , lcdD4 :: Pin -- ^ Hitachi pin @11@: Data line @4@ 187 | , lcdD5 :: Pin -- ^ Hitachi pin @12@: Data line @5@ 188 | , lcdD6 :: Pin -- ^ Hitachi pin @13@: Data line @6@ 189 | , lcdD7 :: Pin -- ^ Hitachi pin @14@: Data line @7@ 190 | , lcdRows :: Int -- ^ Number of rows (typically 1 or 2, upto 4) 191 | , lcdCols :: Int -- ^ Number of cols (typically 16 or 20, upto 40) 192 | , dotMode5x10 :: Bool -- ^ Set to True if 5x10 dots are used 193 | } 194 | deriving Show 195 | 196 | -- | State of the LCD, a mere 8-bit word for the Hitachi 197 | data LCDData = LCDData { 198 | lcdDisplayMode :: Word8 -- ^ Display mode (left/right/scrolling etc.) 199 | , lcdDisplayControl :: Word8 -- ^ Display control (blink on/off, display on/off etc.) 200 | , lcdGlyphCount :: Word8 -- ^ Count of custom created glyphs (typically at most 8) 201 | , lcdController :: LCDController -- ^ Actual controller 202 | } 203 | 204 | -- | State of the board 205 | data BoardState = BoardState { 206 | boardCapabilities :: BoardCapabilities -- ^ Capabilities of the board 207 | , analogReportingPins :: S.Set IPin -- ^ Which analog pins are reporting 208 | , digitalReportingPins :: S.Set IPin -- ^ Which digital pins are reporting 209 | , pinStates :: M.Map IPin PinData -- ^ For-each pin, store its data 210 | , digitalWakeUpQueue :: [MVar ()] -- ^ Semaphore list to wake-up upon receiving a digital message 211 | , lcds :: M.Map LCD LCDData -- ^ LCD's attached to the board 212 | } 213 | 214 | -- | State of the computation 215 | data ArduinoState = ArduinoState { 216 | message :: String -> IO () -- ^ Current debugging routine 217 | , bailOut :: String -> [String] -> IO () -- ^ Clean-up and quit with a hopefully informative message 218 | , port :: SerialPort -- ^ Serial port we are communicating on 219 | , firmataID :: String -- ^ The ID of the board (as identified by the Board itself) 220 | , boardState :: MVar BoardState -- ^ Current state of the board 221 | , deviceChannel :: Chan Response -- ^ Incoming messages from the board 222 | , capabilities :: BoardCapabilities -- ^ Capabilities of the board 223 | , listenerTid :: MVar ThreadId -- ^ ThreadId of the listener 224 | } 225 | 226 | -- | The Arduino monad. 227 | newtype Arduino a = Arduino (StateT ArduinoState IO a) 228 | deriving (Functor, Applicative, Monad, MonadIO, MonadState ArduinoState) 229 | 230 | -- | Debugging only: print the given string on stdout. 231 | debug :: String -> Arduino () 232 | debug s = do f <- gets message 233 | liftIO $ f s 234 | 235 | -- | Bailing out: print the given string on stdout and die 236 | die :: String -> [String] -> Arduino a 237 | die m ms = do f <- gets bailOut 238 | liftIO $ do f m ms 239 | exitFailure 240 | 241 | -- | Which modes does this pin support? 242 | getPinModes :: IPin -> Arduino [PinMode] 243 | getPinModes p = do 244 | BoardCapabilities caps <- gets capabilities 245 | case p `M.lookup` caps of 246 | Nothing -> return [] 247 | Just PinCapabilities{allowedModes} -> return $ map fst allowedModes 248 | 249 | -- | Current state of the pin 250 | getPinData :: IPin -> Arduino PinData 251 | getPinData p = do 252 | bs <- gets boardState 253 | err <- gets bailOut 254 | liftIO $ withMVar bs $ \bst -> 255 | case p `M.lookup` pinStates bst of 256 | Nothing -> do err ("Trying to access " ++ show p ++ " without proper configuration.") 257 | ["Make sure that you use 'setPinMode' to configure this pin first."] 258 | exitFailure 259 | Just pd -> return pd 260 | 261 | -- | Given a pin, collect the digital value corresponding to the 262 | -- port it belongs to, where the new value of the current pin is given 263 | -- The result is two bytes: 264 | -- 265 | -- * First lsb: pins 0-6 on the port 266 | -- * Second msb: pins 7-13 on the port 267 | -- 268 | -- In particular, the result is suitable to be sent with a digital message 269 | computePortData :: IPin -> Bool -> Arduino (Word8, Word8) 270 | computePortData curPin newValue = do 271 | let curPort = pinPort curPin 272 | let curIndex = pinPortIndex curPin 273 | bs <- gets boardState 274 | liftIO $ modifyMVar bs $ \bst -> do 275 | let values = [(pinPortIndex p, pinValue pd) | (p, pd) <- M.assocs (pinStates bst), curPort == pinPort p, pinMode pd `elem` [INPUT, OUTPUT]] 276 | getVal i 277 | | i == curIndex = newValue 278 | | Just (Just (Left v)) <- i `lookup` values = v 279 | | True = False 280 | [b0, b1, b2, b3, b4, b5, b6, b7] = map getVal [0 .. 7] 281 | lsb = foldr (\(i, b) m -> if b then m `setBit` i else m) 0 (zip [0..] [b0, b1, b2, b3, b4, b5, b6]) 282 | msb = foldr (\(i, b) m -> if b then m `setBit` (i-7) else m) 0 (zip [7..] [b7]) 283 | bst' = bst{pinStates = M.insert curPin PinData{pinMode = OUTPUT, pinValue = Just (Left newValue)}(pinStates bst)} 284 | return (bst', (lsb, msb)) 285 | 286 | -- | Keep track of listeners on a digital message 287 | digitalWakeUp :: MVar () -> Arduino () 288 | digitalWakeUp semaphore = do 289 | bs <- gets boardState 290 | liftIO $ modifyMVar_ bs $ \bst -> return bst{digitalWakeUpQueue = semaphore : digitalWakeUpQueue bst} 291 | 292 | -- | Firmata commands, see: http://firmata.org/wiki/Protocol#Message_Types 293 | data FirmataCmd = ANALOG_MESSAGE IPin -- ^ @0xE0@ pin 294 | | DIGITAL_MESSAGE Port -- ^ @0x90@ port 295 | | REPORT_ANALOG_PIN IPin -- ^ @0xC0@ pin 296 | | REPORT_DIGITAL_PORT Port -- ^ @0xD0@ port 297 | | START_SYSEX -- ^ @0xF0@ 298 | | SET_PIN_MODE -- ^ @0xF4@ 299 | | END_SYSEX -- ^ @0xF7@ 300 | | PROTOCOL_VERSION -- ^ @0xF9@ 301 | | SYSTEM_RESET -- ^ @0xFF@ 302 | deriving Show 303 | 304 | -- | Compute the numeric value of a command 305 | firmataCmdVal :: FirmataCmd -> Word8 306 | firmataCmdVal (ANALOG_MESSAGE p) = 0xE0 .|. pinNo p 307 | firmataCmdVal (DIGITAL_MESSAGE p) = 0x90 .|. portNo p 308 | firmataCmdVal (REPORT_ANALOG_PIN p) = 0xC0 .|. pinNo p 309 | firmataCmdVal (REPORT_DIGITAL_PORT p) = 0xD0 .|. portNo p 310 | firmataCmdVal START_SYSEX = 0xF0 311 | firmataCmdVal SET_PIN_MODE = 0xF4 312 | firmataCmdVal END_SYSEX = 0xF7 313 | firmataCmdVal PROTOCOL_VERSION = 0xF9 314 | firmataCmdVal SYSTEM_RESET = 0xFF 315 | 316 | -- | Convert a byte to a Firmata command 317 | getFirmataCmd :: Word8 -> Either Word8 FirmataCmd 318 | getFirmataCmd w = classify 319 | where extract m | w .&. m == m = Just $ fromIntegral (w .&. 0x0F) 320 | | True = Nothing 321 | classify | w == 0xF0 = Right START_SYSEX 322 | | w == 0xF4 = Right SET_PIN_MODE 323 | | w == 0xF7 = Right END_SYSEX 324 | | w == 0xF9 = Right PROTOCOL_VERSION 325 | | w == 0xFF = Right SYSTEM_RESET 326 | | Just i <- extract 0xE0 = Right $ ANALOG_MESSAGE (InternalPin i) 327 | | Just i <- extract 0x90 = Right $ DIGITAL_MESSAGE (Port i) 328 | | Just i <- extract 0xC0 = Right $ REPORT_ANALOG_PIN (InternalPin i) 329 | | Just i <- extract 0xD0 = Right $ REPORT_DIGITAL_PORT (Port i) 330 | | True = Left w 331 | 332 | -- | Sys-ex commands, see: http://firmata.org/wiki/Protocol#Sysex_Message_Format 333 | data SysExCmd = RESERVED_COMMAND -- ^ @0x00@ 2nd SysEx data byte is a chip-specific command (AVR, PIC, TI, etc). 334 | | ANALOG_MAPPING_QUERY -- ^ @0x69@ ask for mapping of analog to pin numbers 335 | | ANALOG_MAPPING_RESPONSE -- ^ @0x6A@ reply with mapping info 336 | | CAPABILITY_QUERY -- ^ @0x6B@ ask for supported modes and resolution of all pins 337 | | CAPABILITY_RESPONSE -- ^ @0x6C@ reply with supported modes and resolution 338 | | PIN_STATE_QUERY -- ^ @0x6D@ ask for a pin's current mode and value 339 | | PIN_STATE_RESPONSE -- ^ @0x6E@ reply with a pin's current mode and value 340 | | EXTENDED_ANALOG -- ^ @0x6F@ analog write (PWM, Servo, etc) to any pin 341 | | SERVO_CONFIG -- ^ @0x70@ set max angle, minPulse, maxPulse, freq 342 | | STRING_DATA -- ^ @0x71@ a string message with 14-bits per char 343 | | PULSE -- ^ @0x74@ Pulse, see: https://github.com/rwldrn/johnny-five/issues/18 344 | | SHIFT_DATA -- ^ @0x75@ shiftOut config/data message (34 bits) 345 | | I2C_REQUEST -- ^ @0x76@ I2C request messages from a host to an I/O board 346 | | I2C_REPLY -- ^ @0x77@ I2C reply messages from an I/O board to a host 347 | | I2C_CONFIG -- ^ @0x78@ Configure special I2C settings such as power pins and delay times 348 | | REPORT_FIRMWARE -- ^ @0x79@ report name and version of the firmware 349 | | SAMPLING_INTERVAL -- ^ @0x7A@ sampling interval 350 | | SYSEX_NON_REALTIME -- ^ @0x7E@ MIDI Reserved for non-realtime messages 351 | | SYSEX_REALTIME -- ^ @0x7F@ MIDI Reserved for realtime messages 352 | deriving Show 353 | 354 | -- | Convert a 'SysExCmd' to a byte 355 | sysExCmdVal :: SysExCmd -> Word8 356 | sysExCmdVal RESERVED_COMMAND = 0x00 357 | sysExCmdVal ANALOG_MAPPING_QUERY = 0x69 358 | sysExCmdVal ANALOG_MAPPING_RESPONSE = 0x6A 359 | sysExCmdVal CAPABILITY_QUERY = 0x6B 360 | sysExCmdVal CAPABILITY_RESPONSE = 0x6C 361 | sysExCmdVal PIN_STATE_QUERY = 0x6D 362 | sysExCmdVal PIN_STATE_RESPONSE = 0x6E 363 | sysExCmdVal EXTENDED_ANALOG = 0x6F 364 | sysExCmdVal SERVO_CONFIG = 0x70 365 | sysExCmdVal STRING_DATA = 0x71 366 | sysExCmdVal PULSE = 0x74 367 | sysExCmdVal SHIFT_DATA = 0x75 368 | sysExCmdVal I2C_REQUEST = 0x76 369 | sysExCmdVal I2C_REPLY = 0x77 370 | sysExCmdVal I2C_CONFIG = 0x78 371 | sysExCmdVal REPORT_FIRMWARE = 0x79 372 | sysExCmdVal SAMPLING_INTERVAL = 0x7A 373 | sysExCmdVal SYSEX_NON_REALTIME = 0x7E 374 | sysExCmdVal SYSEX_REALTIME = 0x7F 375 | 376 | -- | Convert a byte into a 'SysExCmd' 377 | getSysExCommand :: Word8 -> Either Word8 SysExCmd 378 | getSysExCommand 0x00 = Right RESERVED_COMMAND 379 | getSysExCommand 0x69 = Right ANALOG_MAPPING_QUERY 380 | getSysExCommand 0x6A = Right ANALOG_MAPPING_RESPONSE 381 | getSysExCommand 0x6B = Right CAPABILITY_QUERY 382 | getSysExCommand 0x6C = Right CAPABILITY_RESPONSE 383 | getSysExCommand 0x6D = Right PIN_STATE_QUERY 384 | getSysExCommand 0x6E = Right PIN_STATE_RESPONSE 385 | getSysExCommand 0x6F = Right EXTENDED_ANALOG 386 | getSysExCommand 0x70 = Right SERVO_CONFIG 387 | getSysExCommand 0x71 = Right STRING_DATA 388 | getSysExCommand 0x75 = Right SHIFT_DATA 389 | getSysExCommand 0x76 = Right I2C_REQUEST 390 | getSysExCommand 0x77 = Right I2C_REPLY 391 | getSysExCommand 0x78 = Right I2C_CONFIG 392 | getSysExCommand 0x79 = Right REPORT_FIRMWARE 393 | getSysExCommand 0x7A = Right SAMPLING_INTERVAL 394 | getSysExCommand 0x7E = Right SYSEX_NON_REALTIME 395 | getSysExCommand 0x7F = Right SYSEX_REALTIME 396 | getSysExCommand 0x74 = Right PULSE 397 | getSysExCommand n = Left n 398 | 399 | -- | Keep track of pin-mode changes 400 | registerPinMode :: IPin -> PinMode -> Arduino [Request] 401 | registerPinMode p m = do 402 | -- first check that the requested mode is supported for this pin 403 | BoardCapabilities caps <- gets capabilities 404 | case p `M.lookup` caps of 405 | Nothing 406 | -> die ("Invalid access to unsupported pin: " ++ show p) 407 | ("Available pins are: " : [" " ++ show k | (k, _) <- M.toAscList caps]) 408 | Just PinCapabilities{allowedModes} 409 | | m `notElem` map fst allowedModes 410 | -> die ("Invalid mode " ++ show m ++ " set for " ++ show p) 411 | ["Supported modes for this pin are: " ++ unwords (if null allowedModes then ["NONE"] else map show allowedModes)] 412 | _ -> return () 413 | -- see if there was a mode already set for this pin 414 | bs <- gets boardState 415 | mbOldMode <- liftIO $ withMVar bs $ \bst -> 416 | case p `M.lookup` pinStates bst of 417 | Nothing -> return Nothing -- completely new, register 418 | Just pd -> return $ Just $ pinMode pd 419 | -- depending on old/new mode, determine what actions to take 420 | let registerNewMode = modifyMVar_ bs $ \bst -> return bst{pinStates = M.insert p PinData{pinMode = m, pinValue = Nothing} (pinStates bst) } 421 | case mbOldMode of 422 | Nothing -> do liftIO registerNewMode 423 | getModeActions p m 424 | Just m' | m == m' -> return [] -- no mode change, nothing to do 425 | | True -> do liftIO registerNewMode 426 | remActs <- getRemovalActions p m' 427 | addActs <- getModeActions p m 428 | return $ remActs ++ addActs 429 | 430 | -- | A mode was removed from this pin, update internal state and determine any necessary actions to remove it 431 | getRemovalActions :: IPin -> PinMode -> Arduino [Request] 432 | getRemovalActions p INPUT = do -- This pin is no longer digital input 433 | bs <- gets boardState 434 | liftIO $ modifyMVar bs $ \bst -> do 435 | let dPins = p `S.delete` digitalReportingPins bst 436 | port = pinPort p 437 | acts = [DigitalReport port False | port `notElem` map pinPort (S.elems dPins)] -- no need for a digital report on this port anymore 438 | bst' = bst { digitalReportingPins = dPins } 439 | return (bst', acts) 440 | getRemovalActions p ANALOG = do -- This pin is no longer analog 441 | bs <- gets boardState 442 | liftIO $ modifyMVar bs $ \bst -> do 443 | let aPins = analogReportingPins bst 444 | acts = [AnalogReport p False | p `S.member` aPins] -- no need for an analog report on this port anymore 445 | bst' = bst { analogReportingPins = p `S.delete` aPins } 446 | return (bst', acts) 447 | getRemovalActions _ OUTPUT = return [] 448 | getRemovalActions p m = die ("hArduino: getRemovalActions: TBD: Unsupported mode: " ++ show m) ["On pin " ++ show p] 449 | 450 | -- | Depending on a mode-set call, determine what further 451 | -- actions should be executed, such as enabling/disabling pin/port reporting 452 | getModeActions :: IPin -> PinMode -> Arduino [Request] 453 | getModeActions p INPUT = do -- This pin is just configured for digital input 454 | bs <- gets boardState 455 | liftIO $ modifyMVar bs $ \bst -> do 456 | let aPins = analogReportingPins bst 457 | dPins = digitalReportingPins bst 458 | port = pinPort p 459 | acts1 = [AnalogReport p False | p `S.member` aPins] -- there was an analog report, remove it 460 | acts2 = [DigitalReport port True | port `notElem` map pinPort (S.elems dPins)] -- there was no digital report, add it 461 | bst' = bst { analogReportingPins = p `S.delete` analogReportingPins bst 462 | , digitalReportingPins = p `S.insert` digitalReportingPins bst 463 | } 464 | return (bst', acts1 ++ acts2) 465 | getModeActions p ANALOG = do -- This pin just configured for analog 466 | bs <- gets boardState 467 | liftIO $ modifyMVar bs $ \bst -> do 468 | let aPins = analogReportingPins bst 469 | dPins = p `S.delete` digitalReportingPins bst 470 | port = pinPort p 471 | acts1 = [AnalogReport p True | p `S.notMember` aPins] -- there was no analog report, add it 472 | acts2 = [DigitalReport port False | port `notElem` map pinPort (S.elems dPins)] -- no need for a digital report, remove it 473 | bst' = bst { analogReportingPins = p `S.insert` analogReportingPins bst 474 | , digitalReportingPins = dPins 475 | } 476 | return (bst', acts1 ++ acts2) 477 | getModeActions _ PWM = return [] 478 | getModeActions _ OUTPUT = return [] 479 | getModeActions _ SERVO = return [] 480 | getModeActions p m = die ("hArduino: getModeActions: TBD: Unsupported mode: " ++ show m) ["On pin " ++ show p] 481 | 482 | -- | On the arduino, digital pin numbers are in 1-to-1 match with 483 | -- the board pins. However, ANALOG pins come at an offset, determined by 484 | -- the capabilities query. Users of the library refer to these pins 485 | -- simply by their natural numbers, which makes for portable programs 486 | -- between boards that have different number of digital pins. We adjust 487 | -- for this shift here. 488 | getInternalPin :: Pin -> Arduino IPin 489 | getInternalPin (MixedPin p) = return $ InternalPin p 490 | getInternalPin (DigitalPin p) = return $ InternalPin p 491 | getInternalPin (AnalogPin p) 492 | = do BoardCapabilities caps <- gets capabilities 493 | case listToMaybe [realPin | (realPin, PinCapabilities{analogPinNumber = Just n}) <- M.toAscList caps, p == n] of 494 | Nothing -> die ("hArduino: " ++ show p ++ " is not a valid analog-pin on this board.") 495 | -- Try to be helpful in case they are trying to use a large value thinking it needs to be offset 496 | ["Hint: To refer to analog pin number k, simply use 'pin k', not 'pin (k+noOfDigitalPins)'" | p > 13] 497 | Just rp -> return rp 498 | 499 | -- | Similar to getInternalPin above, except also makes sure the pin is in a required mode. 500 | convertAndCheckPin :: String -> Pin -> PinMode -> Arduino (IPin, PinData) 501 | convertAndCheckPin what p' m = do 502 | p <- getInternalPin p' 503 | pd <- getPinData p 504 | let user = userPinNo p' 505 | board = pinNo p 506 | bInfo 507 | | user == board = "" 508 | | True = " (On board " ++ show p ++ ")" 509 | when (pinMode pd /= m) $ die ("Invalid " ++ what ++ " call on pin " ++ show p' ++ bInfo) 510 | [ "The current mode for this pin is: " ++ show (pinMode pd) 511 | , "For " ++ what ++ ", it must be set to: " ++ show m 512 | , "via a proper call to setPinMode" 513 | ] 514 | return (p, pd) 515 | --------------------------------------------------------------------------------