-----------------------------------------------------------------------------
-- |
-- 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 <- LCDController -> Arduino LCD
lcdRegister LCDController
osepp
               let button = Word8 -> Pin
analog Word8
0
                   light  = Word8 -> Pin
digital Word8
10
               setPinMode button ANALOG
               setPinMode light  OUTPUT
               -- Analog values obtained from OSEPP site, seems reliable
               let threshHolds = [ (Key
KeyRight,   Int
30)
                                 , (Key
KeyUp,     Int
150)
                                 , (Key
KeyDown,   Int
360)
                                 , (Key
KeyLeft,   Int
535)
                                 , (Key
KeySelect, Int
760)
                                 ]
                   backLight  = Pin -> Bool -> Arduino ()
digitalWrite Pin
light
                   readButton = do val <- Pin -> Arduino Int
analogRead Pin
button
                                   let walk []            = Maybe a
forall a. Maybe a
Nothing
                                       walk ((a
k, Int
t):[(a, Int)]
keys)
                                         | Int
val Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
t        = a -> Maybe a
forall a. a -> Maybe a
Just a
k
                                         | Bool
True           = [(a, Int)] -> Maybe a
walk [(a, Int)]
keys
                                   return $ walk threshHolds
               return (lcd, backLight, 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) Arduino () -> Arduino () -> Arduino ()
forall a b. Arduino a -> Arduino b -> Arduino b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Arduino ()
write String
s
        getKey :: Arduino Key
getKey = do mbK <- Arduino (Maybe Key)
readKey
                    case mbK of
                      Maybe Key
Nothing -> Arduino Key
getKey
                      Just Key
k  -> do Int -> Arduino ()
delay Int
500 -- stabilize by waiting 0.5s
                                    Key -> Arduino Key
forall a. a -> Arduino a
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 Arduino Key -> Arduino () -> Arduino ()
forall a b. Arduino a -> Arduino b -> Arduino b
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l = do Arduino ()
clear
                        (Int, Int) -> String -> Arduino ()
at (Int
0, Int
0) (String -> Arduino ()) -> String -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String
"It must be: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h
                        (Int, Int) -> String -> Arduino ()
at (Int
1, Int
0) (String -> Arduino ()) -> String -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String
"Guess no: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
rnd
                        Arduino ()
newGame
          | Int
h Int -> Int -> Bool
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
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
h) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                       (Int, Int) -> String -> Arduino ()
at (Int
0, Int
0) (String -> Arduino ()) -> String -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
rnd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") Is it " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
g String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"?"
                       k <- Arduino Key
getKey
                       case k of
                         Key
KeyUp     -> Int -> Int -> Int -> Arduino ()
guess (Int
rndInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
gInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
h
                         Key
KeyDown   -> Int -> Int -> Int -> Arduino ()
guess (Int
rndInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
l (Int
gInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                         Key
KeySelect -> do (Int, Int) -> String -> Arduino ()
at (Int
1, Int
0) (String -> Arduino ()) -> String -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String
"Got it in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
rnd String -> String -> String
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" (Arduino () -> IO ()) -> Arduino () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                 (lcd, light, readButton) <- Arduino (LCD, Bool -> Arduino (), Arduino (Maybe Key))
initOSepp
                 numGuess lcd light readButton