From f90517d738696125a067f113edf93f404873115b Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 2 Feb 2017 14:40:02 +0100 Subject: [PATCH] demo --- int/interface.c | 26 ++++++++++++++++++++++---- int/interface.h | 3 +++ int/interpret.c | 6 ++++++ int/mTaskSymbols.h | 22 ++++++++++++---------- mTask.dcl | 5 +++++ mTaskInterpret.dcl | 5 +++++ mTaskInterpret.icl | 20 ++++++++++---------- miTask.icl | 24 ++++++++++++------------ 8 files changed, 75 insertions(+), 36 deletions(-) diff --git a/int/interface.c b/int/interface.c index 6809110..8106945 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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]) -- 2.20.1