demo

diff --git a/int/interface.c b/int/interface.c
index 6809110..8106945 100644 (file)
--- a/int/interface.c
+++ b/int/interface.c
@@ -30,10 +30,6 @@ uint64_t dpins[] = {LINE_ARD_D0, LINE_ARD_D1, LINE_ARD_D2, LINE_ARD_D3,
        LINE_ARD_D14, LINE_ARD_D15};
 void write_dpin(uint8_t i, bool b)
 {
-       if(i == 0){ palWriteLine(LINE_LED1, b ? PAL_HIGH : PAL_LOW);
-       } else if(i == 1){ palWriteLine(LINE_LED2, b ? PAL_HIGH : PAL_LOW);
-       } else if(i == 2){ palWriteLine(LINE_LED3, b ? PAL_HIGH : PAL_LOW);
-       }
        palWriteLine(dpins[i], b ? PAL_HIGH : PAL_LOW);
 }
 
@@ -57,6 +53,28 @@ uint8_t read_apin(uint8_t i)
        (void) i;
 }
 
+void led_on(uint8_t i)
+{
+       if(i == 0){
+               palWriteLine(LINE_LED1, PAL_HIGH);
+       } else if(i == 1){
+               palWriteLine(LINE_LED2, PAL_HIGH);
+       } else if(i == 2){
+               palWriteLine(LINE_LED3, PAL_HIGH);
+       }
+}
+
+void led_off(uint8_t i)
+{
+       if(i == 0){
+               palWriteLine(LINE_LED1, PAL_LOW);
+       } else if(i == 1){
+               palWriteLine(LINE_LED2, PAL_LOW);
+       } else if(i == 2){
+               palWriteLine(LINE_LED3, PAL_LOW);
+       }
+}
+
 long millis(void){
        return ST2MS(chVTGetSystemTime());
 }

diff --git a/int/interface.h b/int/interface.h
index d3361df..f3920eb 100644 (file)
--- a/int/interface.h
+++ b/int/interface.h
@@ -22,6 +22,9 @@ bool read_dpin(uint8_t i);
 void write_apin(uint8_t i, uint8_t a);
 uint8_t read_apin(uint8_t i);
 
+void led_on(uint8_t i);
+void led_off(uint8_t i);
+
 long millis(void);
 bool input_available(void);
 void delay(long ms);

diff --git a/int/interpret.c b/int/interpret.c
index 683638f..39c24b0 100644 (file)
--- a/int/interpret.c
+++ b/int/interpret.c
@@ -139,6 +139,12 @@ void run_task(struct task *t)
                        write_dpin(program[pc++], stack[sp-1]);
                        sp--;
                        break;
+               case BCLEDON: trace("LedOn(%d)", program[pc]);
+                       led_on(program[pc++]);
+                       break;
+               case BCLEDOFF: trace("LedOn(%d)", program[pc]);
+                       led_off(program[pc++]);
+                       break;
                default:
                        trace("unrecognized");
                        die("Unrecognized command: %d", program[pc-1]);

diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h
index 3eb218a..57959af 100644 (file)
--- a/int/mTaskSymbols.h
+++ b/int/mTaskSymbols.h
@@ -23,14 +23,16 @@
 #define BCJMP 20
 #define BCJMPT 21
 #define BCJMPF 22
-#define BCSERIALAVAIL 23
-#define BCSERIALPRINT 24
-#define BCSERIALPRINTLN 25
-#define BCSERIALREAD 26
-#define BCSERIALPARSEINT 27
-#define BCANALOGREAD 28
-#define BCANALOGWRITE 29
-#define BCDIGITALREAD 30
-#define BCDIGITALWRITE 31
-#define BCTEST 32
+#define BCLEDON 23
+#define BCLEDOFF 24
+#define BCSERIALAVAIL 25
+#define BCSERIALPRINT 26
+#define BCSERIALPRINTLN 27
+#define BCSERIALREAD 28
+#define BCSERIALPARSEINT 29
+#define BCANALOGREAD 30
+#define BCANALOGWRITE 31
+#define BCDIGITALREAD 32
+#define BCDIGITALWRITE 33
+#define BCTEST 34
 #endif

diff --git a/mTask.dcl b/mTask.dcl
index c7a6a3a..114012c 100644 (file)
--- a/mTask.dcl
+++ b/mTask.dcl
@@ -32,6 +32,7 @@ import mTaskSerial, mTaskLCD
 :: DigitalPin 
    = D0 | D1 | D2 | D3 | D4 | D5 |D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13
 :: AnalogPin = A0 | A1 | A2 | A3 | A4 | A5
+:: UserLED = LED1 | LED2 | LED3
 :: PinMode   = INPUT | OUTPUT | INPUT_PULLUP
 :: Pin     = Digital DigitalPin | Analog AnalogPin
 
@@ -127,6 +128,10 @@ class time v where
   delay  :: (v Long p) -> (v Long Expr)
   millis ::         (v Long Expr)
 
+class userLed v where
+       ledOn :: UserLED -> (v () Stmt)
+       ledOff :: UserLED -> (v () Stmt)
+
 class pio p t where pio :: p -> v t Upd | aIO v & dIO v
 instance pio AnalogPin Int
 instance pio AnalogPin Bool

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 0cf8ef3..0105944 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -50,6 +50,9 @@ decode :: String -> MTaskMSGRecv
        | BCJmp Int
        | BCJmpT Int
        | BCJmpF Int
+       //UserLED
+       | BCLedOn [Char]
+       | BCLedOff [Char]
        //Serial
        | BCSerialAvail
        | BCSerialPrint
@@ -81,12 +84,14 @@ instance toByteCode Char
 instance toByteCode String
 instance toByteCode Long
 instance toByteCode Button
+instance toByteCode UserLED
 
 instance toChar Pin
 instance arith ByteCode
 instance boolExpr ByteCode
 instance analogIO ByteCode
 instance digitalIO ByteCode
+instance userLed ByteCode
 //instance If ByteCode Stmt Stmt Stmt
 //instance If ByteCode e Stmt Stmt
 //instance If ByteCode Stmt e Stmt

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 180939c..1833e62 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -64,6 +64,8 @@ bclength (BCAnalogRead _) = 2
 bclength (BCAnalogWrite _) = 2
 bclength (BCDigitalRead _) = 2
 bclength (BCDigitalWrite _) = 2
+bclength (BCLedOn _) = 2
+bclength (BCLedOff _) = 2
 bclength (BCJmp i) = 2
 bclength (BCJmpT i) = 2
 bclength (BCJmpF i) = 2
@@ -82,6 +84,8 @@ toByteVal b
                (BCAnalogWrite i) = [toChar i]
                (BCDigitalRead i) = [toChar i]
                (BCDigitalWrite i) = [toChar i]
+               (BCLedOn i) = i
+               (BCLedOff i) = i
                (BCJmp i) = [toChar i]
                (BCJmpT i) = [toChar i]
                (BCJmpF i) = [toChar i]
@@ -114,13 +118,14 @@ instance toByteCode Long where toByteCode (L n) = toByteCode n
 instance toByteCode Char where toByteCode c = [c]
 instance toByteCode String where toByteCode s = undef
 instance toByteCode Button where toByteCode s = [toChar $ consIndex{|*|} s]
+instance toByteCode UserLED where toByteCode s = [toChar $ consIndex{|*|} s]
 
 instance toChar Pin where
        toChar (Digital p) = toChar $ consIndex{|*|} p
        toChar (Analog p) = toChar $ consIndex{|*|} p
 
 derive gPrint BC, AnalogPin, Pin, DigitalPin
-derive consIndex BC, Pin, Button
+derive consIndex BC, Pin, Button, UserLED
 derive consName BC, Pin, Button
 
 instance arith ByteCode where
@@ -207,6 +212,10 @@ instance serial ByteCode where
        serialRead = retrn [BCSerialRead]
        serialParseInt = retrn [BCSerialParseInt]
 
+instance userLed ByteCode where
+       ledOn l = retrn [BCLedOn $ toByteCode l]
+       ledOff l = retrn [BCLedOff $ toByteCode l]
+
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
 
@@ -241,11 +250,6 @@ toReadableByteCode x
 # (bc, gtmap) = computeGotos bc 0
 = (join "\n" $ map readable (map (implGotos gtmap) bc), st)
 
-//Start :: String
-//Start = toReadableByteCode bc
-//     where
-//             bc :: ByteCode Int Expr
-//             bc = (lit 36 +. lit 42) +. lit 44
 toMessages :: Int (String, BCState) -> ([MTaskMSGSend], BCState)
 toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st)
 
@@ -253,15 +257,11 @@ toSDSUpdate :: Int Int -> [MTaskMSGSend]
 toSDSUpdate i v = [MTUpd i (to16bit v)]
 
 Start = toMessages 500 $ toRealByteCode (unMain bc)
-//Start = fst $ toReadableByteCode $ unMain bc
        where
                bc = sds \x=5 In 
                        sds \y=4 In
                        {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
 
-//pub :: (ByteCode a b) -> ByteCode a b
-//pub x = fmp makePub x
-
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 

diff --git a/miTask.icl b/miTask.icl
index 407e930..2757450 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -21,7 +21,7 @@ import iTasks._Framework.Store
 import TTY
 
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
-derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP
+derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED
 
 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY
@@ -39,20 +39,20 @@ bc = sds \x=1 In sds \pinnetje=1 In {main =
                        noOp
                ) :.
                IF (pinnetje ==. lit 1) (
-                       digitalWrite D0 (lit True)
+                       ledOn LED1
                ) (
                        IF (pinnetje ==. lit 2) (
-                               digitalWrite D1 (lit True)
+                               ledOn LED2
                        ) (
-                               digitalWrite D2 (lit True)
+                               ledOn LED3
                        )
                )}
 
-bc2 :: DigitalPin -> Main (ByteCode () Stmt)
-bc2 d = {main = digitalWrite d (lit True) :. noOp}
+bc2 :: UserLED -> Main (ByteCode () Stmt)
+bc2 d = {main = ledOn d}
 
-bc3 :: DigitalPin -> Main (ByteCode () Stmt)
-bc3 d = {main = digitalWrite d (lit False) :. noOp}
+bc3 :: UserLED -> Main (ByteCode () Stmt)
+bc3 d = {main = ledOff d}
 
 
 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
@@ -78,9 +78,9 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
        withDevice \ch->
                        sendMsg msgs ch
                ||- processMessages ch messageShare sdsShares
-               ||- forever (enterChoice "Choose led to enable" [] [D0, D1, D2]
+               ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3]
                                >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)
-               ||- forever (enterChoice "Choose led to disable" [] [D0, D1, D2]
+               ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3]
                                >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
                ||- viewSharedInformation "channels" [ViewWith lens] ch
                ||- viewSharedInformation "messages" [] messageShare
@@ -111,8 +111,8 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
                | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
                = updateSDSs xs m n
                updateSDSs _ m mtm = case mtm of
-                       MTMessage s = upd (\l->take 20 [s:l]) m @! ()
-                       mta=:(MTTaskAdded _) = upd (\l->take 20 [toString mta:l]) m @! ()
+                       MTMessage s = upd (\l->take 5 [s:l]) m @! ()
+                       mta=:(MTTaskAdded _) = upd (\l->take 5 [toString mta:l]) m @! ()
                        _ = return ()
 
                lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])