-----------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.NumGuess
-- Copyright   :  (c) Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Simple number guessing game on the OSEPP Keyboard shield.
--
-- /Thanks to David Palmer for lending me his OSEPP shield to play with!/
-------------------------------------------------------------------------------

module System.Hardware.Arduino.SamplePrograms.NumGuess where

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

-- | The OSepp LCD Shield is a 16x2 LCD using a Hitachi Controller
-- Furthermore, it has backlight, and 5 buttons. The hook-up is
-- quite straightforward, using our existing Hitachi44780 controller
-- as an example. More information on this shield can be found at:
--
--     <http://osepp.com/products/shield-arduino-compatible/16x2-lcd-display-keypad-shield/>
osepp :: LCDController
osepp :: LCDController
osepp = Hitachi44780 { lcdRS :: Pin
lcdRS = Word8 -> Pin
digital Word8
8
                     , lcdEN :: Pin
lcdEN = Word8 -> Pin
digital Word8
9
                     , lcdD4 :: Pin
lcdD4 = Word8 -> Pin
digital Word8
4
                     , lcdD5 :: Pin
lcdD5 = Word8 -> Pin
digital Word8
5
                     , lcdD6 :: Pin
lcdD6 = Word8 -> Pin
digital Word8
6
                     , lcdD7 :: Pin
lcdD7 = Word8 -> Pin
digital Word8
7
                     , lcdRows :: Int
lcdRows = Int
2
                     , lcdCols :: Int
lcdCols = Int
16
                     , dotMode5x10 :: Bool
dotMode5x10 = Bool
False
                     }

-- | There are 5 keys on the OSepp shield.
data Key = KeyRight
         | KeyLeft
         | KeyUp
         | KeyDown
         | KeySelect

-- | Initialize the shield. This is essentially simply registering the
-- lcd with the HArduino library. In addition, we return two values to
-- the user:
--
--   * A function to control the back-light
--
--   * A function to read (if any) key-pressed
initOSepp :: Arduino (LCD, Bool -> Arduino (), Arduino (Maybe Key))
initOSepp :: Arduino (LCD, Bool -> Arduino (), Arduino (Maybe Key))
initOSepp = do LCD
lcd <- LCDController -> Arduino LCD
lcdRegister LCDController
osepp
               let button :: Pin
button = Word8 -> Pin
analog Word8
0
                   light :: Pin
light  = Word8 -> Pin
digital Word8
10
               Pin -> PinMode -> Arduino ()
setPinMode Pin
button PinMode
ANALOG
               Pin -> PinMode -> Arduino ()
setPinMode Pin
light  PinMode
OUTPUT
               -- Analog values obtained from OSEPP site, seems reliable
               let threshHolds :: [(Key, Int)]
threshHolds = [ (Key
KeyRight,   Int
30)
                                 , (Key
KeyUp,     Int
150)
                                 , (Key
KeyDown,   Int
360)
                                 , (Key
KeyLeft,   Int
535)
                                 , (Key
KeySelect, Int
760)
                                 ]
                   backLight :: Bool -> Arduino ()
backLight  = Pin -> Bool -> Arduino ()
digitalWrite Pin
light
                   readButton :: Arduino (Maybe Key)
readButton = do Int
val <- Pin -> Arduino Int
analogRead Pin
button
                                   let walk :: [(a, Int)] -> Maybe a
walk []            = forall a. Maybe a
Nothing
                                       walk ((a
k, Int
t):[(a, Int)]
keys)
                                         | Int
val forall a. Ord a => a -> a -> Bool
< Int
t        = forall a. a -> Maybe a
Just a
k
                                         | Bool
True           = [(a, Int)] -> Maybe a
walk [(a, Int)]
keys
                                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {a}. [(a, Int)] -> Maybe a
walk [(Key, Int)]
threshHolds
               forall (m :: * -> *) a. Monad m => a -> m a
return (LCD
lcd, Bool -> Arduino ()
backLight, Arduino (Maybe Key)
readButton)

-- | Number guessing game, as a simple LCD demo. User thinks of a number
-- between @0@ and @1000@, and the Arduino guesses it.
numGuess :: LCD -> (Bool -> Arduino ()) -> Arduino (Maybe Key) -> Arduino ()
numGuess :: LCD -> (Bool -> Arduino ()) -> Arduino (Maybe Key) -> Arduino ()
numGuess LCD
lcd Bool -> Arduino ()
light Arduino (Maybe Key)
readKey = Arduino ()
game
  where home :: Arduino ()
home  = LCD -> Arduino ()
lcdHome      LCD
lcd
        write :: String -> Arduino ()
write = LCD -> String -> Arduino ()
lcdWrite     LCD
lcd
        clear :: Arduino ()
clear = LCD -> Arduino ()
lcdClear     LCD
lcd
        go :: (Int, Int) -> Arduino ()
go    = LCD -> (Int, Int) -> Arduino ()
lcdSetCursor LCD
lcd
        at :: (Int, Int) -> String -> Arduino ()
at (Int
r, Int
c) String
s = (Int, Int) -> Arduino ()
go (Int
c, Int
r) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Arduino ()
write String
s
        getKey :: Arduino Key
getKey = do Maybe Key
mbK <- Arduino (Maybe Key)
readKey
                    case Maybe Key
mbK of
                      Maybe Key
Nothing -> Arduino Key
getKey
                      Just Key
k  -> do Int -> Arduino ()
delay Int
500 -- stabilize by waiting 0.5s
                                    forall (m :: * -> *) a. Monad m => a -> m a
return Key
k
        game :: Arduino ()
game = do Arduino ()
clear
                  Arduino ()
home
                  Bool -> Arduino ()
light Bool
True
                  (Int, Int) -> String -> Arduino ()
at (Int
0, Int
4) String
"HArduino!"
                  (Int, Int) -> String -> Arduino ()
at (Int
1, Int
0) String
"# Guessing game"
                  Int -> Arduino ()
delay Int
2000
                  Int -> Int -> Int -> Arduino ()
guess Int
1 Int
0 Int
1000
        newGame :: Arduino ()
newGame = Arduino Key
getKey forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Arduino ()
game
        guess :: Int -> Int -> Int -> Arduino ()
        guess :: Int -> Int -> Int -> Arduino ()
guess Int
rnd Int
l Int
h
          | Int
h forall a. Eq a => a -> a -> Bool
== Int
l = do Arduino ()
clear
                        (Int, Int) -> String -> Arduino ()
at (Int
0, Int
0) forall a b. (a -> b) -> a -> b
$ String
"It must be: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
h
                        (Int, Int) -> String -> Arduino ()
at (Int
1, Int
0) forall a b. (a -> b) -> a -> b
$ String
"Guess no: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
rnd
                        Arduino ()
newGame
          | Int
h forall a. Ord a => a -> a -> Bool
< Int
l = do Arduino ()
clear
                       (Int, Int) -> String -> Arduino ()
at (Int
0, Int
0) String
"You lied!"
                       Arduino ()
newGame
          | Bool
True  = do Arduino ()
clear
                       let g :: Int
g = (Int
lforall a. Num a => a -> a -> a
+Int
h) forall a. Integral a => a -> a -> a
`div` Int
2
                       (Int, Int) -> String -> Arduino ()
at (Int
0, Int
0) forall a b. (a -> b) -> a -> b
$ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
rnd forall a. [a] -> [a] -> [a]
++ String
") Is it " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
g forall a. [a] -> [a] -> [a]
++ String
"?"
                       Key
k <- Arduino Key
getKey
                       case Key
k of
                         Key
KeyUp     -> Int -> Int -> Int -> Arduino ()
guess (Int
rndforall a. Num a => a -> a -> a
+Int
1) (Int
gforall a. Num a => a -> a -> a
+Int
1) Int
h
                         Key
KeyDown   -> Int -> Int -> Int -> Arduino ()
guess (Int
rndforall a. Num a => a -> a -> a
+Int
1) Int
l (Int
gforall a. Num a => a -> a -> a
-Int
1)
                         Key
KeySelect -> do (Int, Int) -> String -> Arduino ()
at (Int
1, Int
0) forall a b. (a -> b) -> a -> b
$ String
"Got it in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
rnd forall a. [a] -> [a] -> [a]
++ String
"!"
                                         Arduino ()
newGame
                         Key
_         -> do (Int, Int) -> String -> Arduino ()
at (Int
1, Int
0) String
"Use up/down/select only.."
                                         Int -> Arduino ()
delay Int
1000
                                         Int -> Int -> Int -> Arduino ()
guess Int
rnd Int
l Int
h

-- | Entry to the classing number guessing game. Simply initialize the
-- shield and call our game function.
guessGame :: IO ()
guessGame :: IO ()
guessGame = Bool -> String -> Arduino () -> IO ()
withArduino Bool
False String
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
                 (LCD
lcd, Bool -> Arduino ()
light, Arduino (Maybe Key)
readButton) <- Arduino (LCD, Bool -> Arduino (), Arduino (Maybe Key))
initOSepp
                 LCD -> (Bool -> Arduino ()) -> Arduino (Maybe Key) -> Arduino ()
numGuess LCD
lcd Bool -> Arduino ()
light Arduino (Maybe Key)
readButton