implementation module mTaskLCD

import iTasks
import GenEq, StdMisc, StdArray
import mTask

derive toGenDynamic LCD
derive fromGenDynamic LCD

:: LCD =
  { cursorRow :: Int
  , cursorCol :: Int
  , sizeH     :: Int
  , sizeW     :: Int
  , lcdtxt    :: [String]
  }

:: Button = RightButton | UpButton | DownButton | LeftButton | SelectButton | NoButton

class lcd v where
  begin          :: (v LCD Expr) (v Int p) (v Int q) -> v () Expr
  print          :: (v LCD Expr) (v t p) -> v Int Expr  | stringQuotes t     // returns bytes written
  setCursor      :: (v LCD Expr) (v Int p) (v Int q) -> v () Expr
  liquidCrystal0 :: [DigitalPin] ((v LCD Expr)->Main (v b q)) -> Main (v b q)
  LCD            :: Int Int [DigitalPin] ((v LCD Expr)->Main (v b q)) -> Main (v b q)
  scrollLeft     :: (v LCD Expr) -> v () Expr
  scrollRight    :: (v LCD Expr) -> v () Expr
  pressed        :: (v Button Expr) -> v Bool Expr

instance lcd Code where
  begin     v x y = embed (v +.+ c ".begin" +.+ codeOp2 x ", " y)
  print     v x   = embed (v +.+ c ".print (" +.+ stringQuotes x +.+ c ")")
  setCursor v x y = embed (v +.+ c ".setCursor" +.+ codeOp2 x ", " y)
  scrollLeft  v   = embed (v +.+ c ".scrollDisplayLeft()")
  scrollRight v   = embed (v +.+ c ".scrollDisplayRight()")
  liquidCrystal0 [] f = liquidCrystal0 [D8, D9, D4, D5, D6, D7] f
  liquidCrystal0 pins f =
    {main =
     getCode \cd. fresh \n.
      let
          name = "lcd" + toString n
          rest = f (c name)
      in
      include "LiquidCrystal" +.+
      setCode Var +.+
        c ("LiquidCrystal " + name + "(" + argList pins + ");\n") +.+
      setCode cd +.+
        rest.main
    }
  LCD x y [] f = LCD x y [D8, D9, D4, D5, D6, D7] f
  LCD x y pins f =
    {main =
     getCode \cd. fresh \n.
      let
          name = "lcd" + toString n
          rest = f (c name)
      in
          include "LiquidCrystal" +.+
          setCode Var +.+
            c ("LiquidCrystal " + name + "(" + argList pins + ");\n") +.+
          setCode Setup +.+
            c (name + ".begin(" + toCode x + ", " + toCode y +");") +.+ nl +.+
          setCode cd +.+
            rest.main
    }
  pressed b = embed (c "pressed(" +.+ setMode SubExp +.+ b +.+ c ")")

instance lcd Eval where
  begin   (E v) x y = 
   x >>== \w. 
   y >>== \h. 
   yield () (E \r.v (Updt \lcd.{lcd & sizeH = h, sizeW = w, lcdtxt = repeatn h (toString (repeatn w ' '))}))
  print   (E v) x   =
    x >>== \a. let str = toCode a in 
    yield (size str) (E \r.v (Updt \lcd.lcdPrintStr str lcd))
  setCursor (E v) x y = 
    x >>== \w.
    y >>== \h.
    yield () (E \r.v (Updt \lcd.{lcd & cursorRow = h, cursorCol = w}))
  scrollLeft  v = rtrn ()
  scrollRight v = rtrn ()
  LCD w h pins f = defEval2 lcd f where
      lcd =
              { cursorRow = 0
              , cursorCol = 0
              , sizeH = h
              , sizeW = w
              , lcdtxt = repeatn h (toString (repeatn w ' '))
              }
  liquidCrystal0 pins f = defEval2 lcd f where
    lcd =
          { cursorRow = 0
          , cursorCol = 0
          , sizeH = 0
          , sizeW = 0
          , lcdtxt = []
          }
  pressed b = rtrn False

lcdPrintStr str lcd
  | lcd.cursorRow < 0 || lcd.cursorRow >= length lcd.lcdtxt ||
    lcd.cursorCol < 0 || lcd.cursorCol >= size (lcd.lcdtxt !! lcd.cursorRow)
    = lcd
  # line = lcd.lcdtxt !! lcd.cursorRow
  # endPos = size str + lcd.cursorCol
  | endPos >= lcd.sizeW
      # newLine = line % (0, lcd.cursorCol - 1) + str % (0, size str - lcd.cursorCol)
    = {lcd & lcdtxt = updateAt lcd.cursorRow newLine lcd.lcdtxt, cursorCol = lcd.sizeW - 1}
    # newLine = line % (0, lcd.cursorCol - 1) + str + line % (endPos, lcd.sizeW - 1)
    = {lcd & lcdtxt = updateAt lcd.cursorRow newLine lcd.lcdtxt, cursorCol = endPos}

printAt :: (v LCD Expr) (v Int b) (v Int c) (v t e) -> v Int Stmt 
    | lcd, seq v & stringQuotes t
printAt lcd x y z = setCursor lcd x y :. print lcd z

keySwitch :: (a Int b) (a c d,a c e,a c f,a c g,a c h,a c a0) -> a c Stmt | arith, boolExpr, seq a & If a h a0 b0 & If a g b0 c0 & If a f c0 d0 & If a e d0 e0 & If a d e0 f0 & type c
keySwitch v (right, up, down, left, select, nokey)
 =  v >>=. \w.
  If (w <. lit RightBound)
    right
  (If (w <. lit UpBound)
    up
  (If (w <. lit DownBound)
    down
  (If (w <.lit  LeftBound)
    left
  (If (w <. lit SelectBound)
    select
    nokey
  ))))

instance toCode Button where toCode b = toCode (consIndex{|*|} b)