mTaskLCD.icl

   1 implementation module mTaskLCD
   2
   3 import iTasks
   4 import GenEq, StdMisc, StdArray
   5 import mTask
   6
   7 derive consIndex Button
   8 derive toGenDynamic LCD
   9 derive fromGenDynamic LCD
  10
  11 :: LCD =
  12   { cursorRow :: Int
  13   , cursorCol :: Int
  14   , sizeH     :: Int
  15   , sizeW     :: Int
  16   , lcdtxt    :: [String]
  17   }
  18
  19 :: Button = RightButton | UpButton | DownButton | LeftButton | SelectButton | NoButton
  20
  21 class lcd v where
  22   begin          :: (v LCD Expr) (v Int p) (v Int q) -> v () Expr
  23   print          :: (v LCD Expr) (v t p) -> v Int Expr  | stringQuotes t     // returns bytes written
  24   setCursor      :: (v LCD Expr) (v Int p) (v Int q) -> v () Expr
  25   liquidCrystal0 :: [DigitalPin] ((v LCD Expr)->Main (v b q)) -> Main (v b q)
  26   LCD            :: Int Int [DigitalPin] ((v LCD Expr)->Main (v b q)) -> Main (v b q)
  27   scrollLeft     :: (v LCD Expr) -> v () Expr
  28   scrollRight    :: (v LCD Expr) -> v () Expr
  29   pressed        :: (v Button Expr) -> v Bool Expr
  30
  31 instance lcd Code where
  32   begin     v x y = embed (v +.+ c ".begin" +.+ codeOp2 x ", " y)
  33   print     v x   = embed (v +.+ c ".print (" +.+ stringQuotes x +.+ c ")")
  34   setCursor v x y = embed (v +.+ c ".setCursor" +.+ codeOp2 x ", " y)
  35   scrollLeft  v   = embed (v +.+ c ".scrollDisplayLeft()")
  36   scrollRight v   = embed (v +.+ c ".scrollDisplayRight()")
  37   liquidCrystal0 [] f = liquidCrystal0 [D8, D9, D4, D5, D6, D7] f
  38   liquidCrystal0 pins f =
  39     {main =
  40      getCode \cd. fresh \n.
  41       let
  42           name = "lcd" + toString n
  43           rest = f (c name)
  44       in
  45       include "LiquidCrystal" +.+
  46       setCode Var +.+
  47         c ("LiquidCrystal " + name + "(" + argList pins + ");\n") +.+
  48       setCode cd +.+
  49         rest.main
  50     }
  51   LCD x y [] f = LCD x y [D8, D9, D4, D5, D6, D7] f
  52   LCD x y pins f =
  53     {main =
  54      getCode \cd. fresh \n.
  55       let
  56           name = "lcd" + toString n
  57           rest = f (c name)
  58       in
  59           include "LiquidCrystal" +.+
  60           setCode Var +.+
  61             c ("LiquidCrystal " + name + "(" + argList pins + ");\n") +.+
  62           setCode Setup +.+
  63             c (name + ".begin(" + toCode x + ", " + toCode y +");") +.+ nl +.+
  64           setCode cd +.+
  65             rest.main
  66     }
  67   pressed b = embed (c "pressed(" +.+ setMode SubExp +.+ b +.+ c ")")
  68
  69 instance lcd Eval where
  70   begin   (E v) x y =
  71    x >>== \w.
  72    y >>== \h.
  73    yield () (E \r.v (Updt \lcd.{lcd & sizeH = h, sizeW = w, lcdtxt = repeatn h (toString (repeatn w ' '))}))
  74   print   (E v) x   =
  75     x >>== \a. let str = toCode a in
  76     yield (size str) (E \r.v (Updt \lcd.lcdPrintStr str lcd))
  77   setCursor (E v) x y =
  78     x >>== \w.
  79     y >>== \h.
  80     yield () (E \r.v (Updt \lcd.{lcd & cursorRow = h, cursorCol = w}))
  81   scrollLeft  v = rtrn ()
  82   scrollRight v = rtrn ()
  83   LCD w h pins f = defEval2 lcd f where
  84       lcd =
  85               { cursorRow = 0
  86               , cursorCol = 0
  87               , sizeH = h
  88               , sizeW = w
  89               , lcdtxt = repeatn h (toString (repeatn w ' '))
  90               }
  91   liquidCrystal0 pins f = defEval2 lcd f where
  92     lcd =
  93           { cursorRow = 0
  94           , cursorCol = 0
  95           , sizeH = 0
  96           , sizeW = 0
  97           , lcdtxt = []
  98           }
  99   pressed b = rtrn False
 100
 101 lcdPrintStr str lcd
 102   | lcd.cursorRow < 0 || lcd.cursorRow >= length lcd.lcdtxt ||
 103     lcd.cursorCol < 0 || lcd.cursorCol >= size (lcd.lcdtxt !! lcd.cursorRow)
 104     = lcd
 105   # line = lcd.lcdtxt !! lcd.cursorRow
 106   # endPos = size str + lcd.cursorCol
 107   | endPos >= lcd.sizeW
 108       # newLine = line % (0, lcd.cursorCol - 1) + str % (0, size str - lcd.cursorCol)
 109     = {lcd & lcdtxt = updateAt lcd.cursorRow newLine lcd.lcdtxt, cursorCol = lcd.sizeW - 1}
 110     # newLine = line % (0, lcd.cursorCol - 1) + str + line % (endPos, lcd.sizeW - 1)
 111     = {lcd & lcdtxt = updateAt lcd.cursorRow newLine lcd.lcdtxt, cursorCol = endPos}
 112
 113 printAt :: (v LCD Expr) (v Int b) (v Int c) (v t e) -> v Int Stmt
 114     | lcd, seq v & stringQuotes t
 115 printAt lcd x y z = setCursor lcd x y :. print lcd z
 116
 117 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
 118 keySwitch v (right, up, down, left, select, nokey)
 119  =  v >>=. \w.
 120   If (w <. lit RightBound)
 121     right
 122   (If (w <. lit UpBound)
 123     up
 124   (If (w <. lit DownBound)
 125     down
 126   (If (w <.lit  LeftBound)
 127     left
 128   (If (w <. lit SelectBound)
 129     select
 130     nokey
 131   ))))
 132
 133 instance toCode Button where toCode b = toCode (consIndex{|*|} b)