-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.SevenSegment
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Control a single seven-segment display, echoing user's key presses
-- on it verbatim. We use a shift-register to reduce the number of
-- pins we need on the Arduino to control the display.
-------------------------------------------------------------------------------

module System.Hardware.Arduino.SamplePrograms.SevenSegment  where

import Control.Monad       (forever)
import Control.Monad.Trans (liftIO)
import Data.Bits           (testBit)
import Data.Word           (Word8)
import System.IO           (hSetBuffering, stdin, BufferMode(NoBuffering))

import System.Hardware.Arduino
import System.Hardware.Arduino.Parts.ShiftRegisters
import System.Hardware.Arduino.Parts.SevenSegmentCodes

-- | Connections for the Texas Instruments 74HC595 shift-register. Datasheet: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>.
-- In our circuit, we merely use pins 8 thru 12 on the Arduino to control the 'serial', 'enable', 'rClock', 'sClock', and 'nClear'
-- lines, respectively. Since we do not need to read the output of the shift-register, we leave the 'mbBits' field unconnected.
sr :: SR_74HC595
sr :: SR_74HC595
sr = SR_74HC595 { serial :: Pin
serial  = Word8 -> Pin
digital Word8
8
                , nEnable :: Pin
nEnable = Word8 -> Pin
digital Word8
9
                , rClock :: Pin
rClock  = Word8 -> Pin
digital Word8
10
                , sClock :: Pin
sClock  = Word8 -> Pin
digital Word8
11
                , nClear :: Pin
nClear  = Word8 -> Pin
digital Word8
12
                , mbBits :: Maybe [Pin]
mbBits  = forall a. Maybe a
Nothing
                }

-- | Seven-segment display demo. For each key-press, we display an equivalent pattern
-- on the connected 7-segment-display. Note that most characters are not-mappable, so
-- we use approximations if available. We use a shift-register to reduce the pin
-- requirements on the Arduino, setting the bits serially.
--
-- Parts:
--
--   * The seven-segment digit we use is a common-cathode single-digit display, such as
--     TDSG5150 (<http://www.vishay.com/docs/83126/83126.pdf>), or Microvity's IS121,
--     but almost any such digit would do. Just pay attention to the line-connections,
--     and do not forget the limiting resistors: 220 ohm's should do nicely.
--
--   * The shift-register is Texas-Instruments 74HC595: <http://www.ti.com/lit/ds/symlink/sn74hc595.pdf>.
--     Make sure to connect the register output lines to the seven-segment displays with the corresponding
--     letters. That is, shift-registers @Q_A@ (Chip-pin 15) should connect to segment @A@; @Q_B@ (Chip-pin 1)
--     to segment @B@, and so on. We do not use the shift-register @Q_H'@ (Chip-pin 9) in this design.
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/SevenSegment.png>>
sevenSegment :: IO ()
sevenSegment :: IO ()
sevenSegment = Bool -> FilePath -> Arduino () -> IO ()
withArduino Bool
False FilePath
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
                  forall a. ShiftRegister a => a -> Arduino ()
initialize SR_74HC595
sr
                  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
                              FilePath -> IO ()
putStrLn FilePath
"Seven-Segment-Display demo."
                              FilePath -> IO ()
putStrLn FilePath
"For each key-press, we will try to display it as a 7-segment character."
                              FilePath -> IO ()
putStrLn FilePath
"If there is no good mapping (which is common), we'll just display a dot."
                              FilePath -> IO ()
putStrLn FilePath
""
                              FilePath -> IO ()
putStrLn FilePath
"Press-keys to be shown on the display, Ctrl-C to quit.."
                  forall (f :: * -> *) a b. Applicative f => f a -> f b
forever Arduino ()
repl
 where pushWord :: a -> Arduino ()
pushWord a
w = do forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a. ShiftRegister a => a -> Bool -> Arduino ()
push SR_74HC595
sr) [a
w forall a. Bits a => a -> Int -> Bool
`testBit` Int
i | Int
i <- [Int
0..Int
7]]
                       forall a. ShiftRegister a => a -> Arduino ()
store SR_74HC595
sr
       repl :: Arduino ()
repl = do Char
c <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Char
getChar
                 case Char -> Maybe Word8
char2SS Char
c of
                   Just Word8
w  -> forall {a}. Bits a => a -> Arduino ()
pushWord Word8
w
                   Maybe Word8
Nothing -> forall {a}. Bits a => a -> Arduino ()
pushWord (Word8
0x01::Word8) -- the dot, which also nicely covers the '.'