-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.LCD
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Basic demo of an Hitachi HD44780 LCD
-------------------------------------------------------------------------------

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module System.Hardware.Arduino.SamplePrograms.LCD where

import Control.Monad.Trans (liftIO)
import Data.Char           (isSpace)
import Numeric             (showHex)

import System.Hardware.Arduino
import System.Hardware.Arduino.Parts.LCD

-- | Connections for a basic hitachi controller.
-- See <http://en.wikipedia.org/wiki/Hitachi_HD44780_LCD_controller> for
-- pin layout. For this demo, simply connect the LCD pins to the Arduino
-- as follows:
--
--  * LCD pin @01@ to GND
--
--  * LCD pin @02@ to +5V
--
--  * LCD pin @03@ to a 10K potentiometer's viper
--
--  * LCD pin @04@ to Arduino pin @12@
--
--  * LCD pin @05@ to GND
--
--  * LCD pin @06@ to Arduino pin @11@
--
--  * LCD pin @11@ to Arduino pin @5@
--
--  * LCD pin @12@ to Arduino pin @4@
--
--  * LCD pin @13@ to Arduino pin @3@
--
--  * LCD pin @14@ to Arduino pin @2@
--
--  * [If backlight is needed] LCD pin @15@ to +5V
--
--  * [If backlight is needed] LCD pin @16@ to GND via 220ohm resistor
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/LCD.png>>
hitachi :: LCDController
-- Connections:                    ARDUINO        Hitachi   Description
--------------------------------   -----------    ---------  ----------------
hitachi :: LCDController
hitachi = Hitachi44780 { lcdRS :: Pin
lcdRS   = Word8 -> Pin
digital Word8
12  --     4      Register-select
                       , lcdEN :: Pin
lcdEN   = Word8 -> Pin
digital Word8
11  --     6      Enable
                       , lcdD4 :: Pin
lcdD4   = Word8 -> Pin
digital  Word8
5  --    11      Data 4
                       , lcdD5 :: Pin
lcdD5   = Word8 -> Pin
digital  Word8
4  --    12      Data 5
                       , lcdD6 :: Pin
lcdD6   = Word8 -> Pin
digital  Word8
3  --    13      Data 6
                       , lcdD7 :: Pin
lcdD7   = Word8 -> Pin
digital  Word8
2  --    14      Data 7
                       -- Other config variables for the display
                       , lcdRows :: Int
lcdRows     = Int
2    -- 2 rows
                       , lcdCols :: Int
lcdCols     = Int
16    -- of 16 columns
                       , dotMode5x10 :: Bool
dotMode5x10 = Bool
False -- Using the standard 5x8 dots
                       }

-- | The happy glyph. See 'lcdCreateSymbol' for details on how to create new ones.
happy :: [String]
happy :: [String]
happy = [ String
"     "
        , String
"@   @"
        , String
"     "
        , String
"     "
        , String
"@   @"
        , String
" @@@ "
        , String
"     "
        , String
"     "
        ]

-- | The sad glyph. See 'lcdCreateSymbol' for details on how to create new ones.
sad :: [String]
sad :: [String]
sad = [ String
"     "
      , String
"@   @"
      , String
"     "
      , String
"     "
      , String
"     "
      , String
" @@@ "
      , String
"@   @"
      , String
"     "
      ]

-- | Access the LCD connected to Arduino, making it show messages
-- we read from the user and demonstrate other LCD control features offered
-- by hArduino.
lcdDemo :: IO ()
lcdDemo :: IO ()
lcdDemo = Bool -> String -> Arduino () -> IO ()
withArduino Bool
False String
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
              LCD
lcd <- LCDController -> Arduino LCD
lcdRegister LCDController
hitachi
              LCDSymbol
happySymbol <- LCD -> [String] -> Arduino LCDSymbol
lcdCreateSymbol LCD
lcd [String]
happy
              LCDSymbol
sadSymbol   <- LCD -> [String] -> Arduino LCDSymbol
lcdCreateSymbol LCD
lcd [String]
sad
              LCD -> Arduino ()
lcdHome LCD
lcd
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do String -> IO ()
putStrLn String
"Hitachi controller demo.."
                          String -> IO ()
putStrLn String
""
                          String -> IO ()
putStrLn String
"Looking for an example? Try the following sequence:"
                          String -> IO ()
putStrLn String
"    cursor 5 0"
                          String -> IO ()
putStrLn String
"    happy"
                          String -> IO ()
putStrLn String
"    write _"
                          String -> IO ()
putStrLn String
"    happy"
                          String -> IO ()
putStrLn String
"    flash 5"
                          String -> IO ()
putStrLn String
""
                          String -> IO ()
putStrLn String
"Type ? to see all available commands."
              let repl :: Arduino ()
repl = do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
"LCD> "
                            String
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine
                            case String -> [String]
words String
m of
                              []       -> Arduino ()
repl
                              [String
"quit"] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                              (String
cmd:[String]
_)    -> case String
cmd forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String,
  (String, String,
   LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands of
                                              Maybe
  (String, String,
   LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ())
Nothing        -> do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unknown command '" forall a. [a] -> [a] -> [a]
++ String
cmd forall a. [a] -> [a] -> [a]
++ String
"', type ? for help."
                                                                   Arduino ()
repl
                                              Just (String
_, String
_, LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
c) -> do LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
c LCD
lcd (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) String
m)) (LCDSymbol
happySymbol, LCDSymbol
sadSymbol)
                                                                   Arduino ()
repl
              Arduino ()
repl
  where help :: Arduino ()
help = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do let ([String]
cmds, [String]
args, [String]
hlps) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall a b. (a -> b) -> a -> b
$ (String
"quit", String
"", String
"Quit the demo") forall a. a -> [a] -> [a]
: [(String
c, String
a, String
h) | (String
c, (String
a, String
h, LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
_)) <- [(String,
  (String, String,
   LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands]
                               clen :: Int
clen = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
cmds)
                               alen :: Int
alen = Int
8 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args)
                               pad :: Int -> String -> String
pad Int
l String
s = forall a. Int -> [a] -> [a]
take Int
l (String
s forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' ')
                               line :: (String, String, String) -> IO ()
line (String
c, String
a, String
h) = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Int -> String -> String
pad Int
clen String
c forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
alen String
a forall a. [a] -> [a] -> [a]
++ String
h
                           forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String, String) -> IO ()
line forall a b. (a -> b) -> a -> b
$ forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
cmds [String]
args [String]
hlps
        arg0 :: m () -> p -> [a] -> p -> m ()
arg0 m ()
f p
_   [] p
_ = m ()
f
        arg0 m ()
_ p
_   [a]
a  p
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unexpected arguments: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [a]
a
        arg1 :: (t -> m ()) -> t -> [a] -> p -> m ()
arg1 t -> m ()
f t
lcd [] p
_ = t -> m ()
f t
lcd
        arg1 t -> m ()
_ t
_   [a]
a  p
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unexpected arguments: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [a]
a
        arg2 :: (t -> t -> t) -> t -> t -> p -> t
arg2 t -> t -> t
f t
lcd t
a  p
_ = t -> t -> t
f t
lcd t
a
        arg3 :: a -> a
arg3            = forall a. a -> a
id
        grabNums :: Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
n String
a [a] -> m ()
f  = case [a
v | [(a
v, String
"")] <- forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => ReadS a
reads (String -> [String]
words String
a)] of
                            [a]
vs | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs forall a. Eq a => a -> a -> Bool
/= Int
n -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" numeric parameter" forall a. [a] -> [a] -> [a]
++ if Int
n forall a. Eq a => a -> a -> Bool
== Int
1 then String
"." else String
"s."
                            [a]
vs                  -> [a] -> m ()
f [a]
vs
        symbol :: Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
isHappy LCD
lcd p
_ (LCDSymbol
h, LCDSymbol
s) = LCD -> LCDSymbol -> Arduino ()
lcdWriteSymbol LCD
lcd (if Bool
isHappy then LCDSymbol
h else LCDSymbol
s)
        cursor :: LCD -> String -> Arduino ()
cursor LCD
lcd String
a = forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
2 String
a (\[Int
col, Int
row] -> LCD -> (Int, Int) -> Arduino ()
lcdSetCursor LCD
lcd (Int
col, Int
row))
        flash :: LCD -> String -> Arduino ()
flash  LCD
lcd String
a = forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
1 String
a (\[Int
n] -> LCD -> Int -> Int -> Arduino ()
lcdFlash LCD
lcd Int
n Int
500)
        code :: LCD -> String -> Arduino ()
code   LCD
lcd String
a = forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
1 String
a (\[Word8
n] -> do LCD -> Arduino ()
lcdClear LCD
lcd
                                                LCD -> Arduino ()
lcdHome LCD
lcd
                                                LCD -> LCDSymbol -> Arduino ()
lcdWriteSymbol LCD
lcd (Word8 -> LCDSymbol
lcdInternalSymbol Word8
n)
                                                LCD -> String -> Arduino ()
lcdWrite LCD
lcd forall a b. (a -> b) -> a -> b
$ String
" (Code: 0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
n String
"" forall a. [a] -> [a] -> [a]
++ String
")")
        scroll :: Bool -> LCD -> String -> Arduino ()
scroll Bool
toLeft LCD
lcd String
a = forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
1 String
a (\[Int
n] -> do let scr :: LCD -> Arduino ()
scr | Bool
toLeft = LCD -> Arduino ()
lcdScrollDisplayLeft
                                                               | Bool
True   = LCD -> Arduino ()
lcdScrollDisplayRight
                                                       forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
n [LCD -> Arduino ()
scr LCD
lcd, Int -> Arduino ()
delay Int
500])
        commands :: [(String,
  (String, String,
   LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands = [ (String
"?",           (String
"",        String
"Display this help message",   forall {m :: * -> *} {a} {p} {p}.
(MonadIO m, Show a) =>
m () -> p -> [a] -> p -> m ()
arg0 Arduino ()
help))
                   , (String
"clear",       (String
"",        String
"Clear the LCD screen",        forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdClear))
                   , (String
"write",       (String
"string",  String
"Write to the LCD",            forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
lcdWrite))
                   , (String
"home",        (String
"",        String
"Move cursor to home",         forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdHome))
                   , (String
"cursor",      (String
"col row", String
"Move cursor to col row",      forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
cursor))
                   , (String
"scrollOff",   (String
"",        String
"Turn off auto-scroll",        forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdAutoScrollOff))
                   , (String
"scrollOn",    (String
"",        String
"Turn on auto-scroll",         forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdAutoScrollOn))
                   , (String
"scrollLeft",  (String
"n",       String
"Scroll left by n chars",      forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 (Bool -> LCD -> String -> Arduino ()
scroll Bool
True)))
                   , (String
"scrollRight", (String
"n",       String
"Scroll right by n char",      forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 (Bool -> LCD -> String -> Arduino ()
scroll Bool
False)))
                   , (String
"leftToRight", (String
"",        String
"Set left to right direction", forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdLeftToRight))
                   , (String
"rightToLeft", (String
"",        String
"Set left to right direction", forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdRightToLeft))
                   , (String
"blinkOn",     (String
"",        String
"Set blinking ON",             forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdBlinkOn))
                   , (String
"blinkOff",    (String
"",        String
"Set blinking ON",             forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdBlinkOff))
                   , (String
"cursorOn",    (String
"",        String
"Display the cursor",          forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdCursorOn))
                   , (String
"cursorOff",   (String
"",        String
"Do not display the cursor",   forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdCursorOff))
                   , (String
"displayOn",   (String
"",        String
"Turn the display on",         forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdDisplayOn))
                   , (String
"displayOff",  (String
"",        String
"Turn the display off",        forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdDisplayOff))
                   , (String
"flash",       (String
"n",       String
"Flash the display n times",   forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
flash))
                   , (String
"happy",       (String
"",        String
"Draw a smiling face",         forall a. a -> a
arg3 (forall {p}.
Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
True)))
                   , (String
"sad",         (String
"",        String
"Draw a sad face",             forall a. a -> a
arg3 (forall {p}.
Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
False)))
                   , (String
"code",        (String
"n",       String
"Write symbol with code n",    forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
code))
                   ]