mTaskLCD.icl

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