X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=mTaskInterpret.icl;h=f1eeedc1793e44bb5ae314bee21e7264fa4a8be9;hb=8782aef8ee6b8e0d3be35bee36b519212bdd8de9;hp=80d458a1a6e4085e0e50debd289ac75ba2e38910;hpb=0403d4e20b0d43efad9b17bb9f51d53559aad738;p=mTask.git diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 80d458a..f1eeedc 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -40,6 +40,8 @@ import Text.Encodings.Base64 import Tasks.Examples +instance == BCValue where (==) a b = toByteCode a == toByteCode b + encode :: MTaskMSGSend -> String encode (MTTask to data) = "t" +++ toByteCode to +++ to16bit (size data) +++ data +++ "\n" encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n" @@ -124,7 +126,7 @@ parseBCValue c s = case c of castfbc :: a -> (String -> a) | mTaskType a castfbc _ = fromByteCode -instance toByteCode Bool where toByteCode b = {#'b',if b '\x01' '\0'} +instance toByteCode Bool where toByteCode b = {'b',if b '\x01' '\0'} instance toByteCode Int where toByteCode n = {'i',toChar $ n/256,toChar $ n rem 256} instance toByteCode Long where toByteCode (L n) = {'l',toChar $ n/256,toChar $ n rem 256} instance toByteCode Char where toByteCode c = {'c',c} @@ -196,12 +198,13 @@ gEq{|BCValue|} (BCValue e) (BCValue f) = toByteCode e == toByteCode f derive class gCons Long, UserLED, Button, AnalogPin, DigitalPin, PinMode, Pin derive class iTask UserLED, Long, Pin, Button, AnalogPin, DigitalPin, PinMode, MTaskDeviceSpec -op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b Expr +op2 :: (ByteCode a p1) (ByteCode a p2) BC -> ByteCode b p3 op2 (BC x) (BC y) bc = BC $ x >>| y >>| tell [bc] -op :: (ByteCode a p) BC -> ByteCode a Expr +op :: (ByteCode a p) BC -> ByteCode b c op (BC x) bc = BC $ x >>| tell [bc] +tell` :: [BC] -> (ByteCode a p) tell` x = BC $ tell x instance arith ByteCode where @@ -231,7 +234,7 @@ instance digitalIO ByteCode where digitalWrite p b = op b (BCDigitalWrite $ pin p) instance aIO ByteCode where - aIO p = undef + aIO p = tell` [BCAnalogRead $ pin p] instance dIO ByteCode where dIO p = tell` [BCDigitalRead $ pin p] @@ -254,6 +257,7 @@ freshs = get >>= \st=:{freshs=[fr:frs]}->put {st & freshs=frs} >>| pure fr instance noOp ByteCode where noOp = tell` [BCNop] +unBC :: (ByteCode a p) -> RWS () [BC] BCState () unBC (BC x) = x instance sds ByteCode where @@ -288,8 +292,8 @@ instance serial ByteCode where serialParseInt = tell` [BCSerialParseInt] instance userLed ByteCode where - ledOn (BC l) = BC $ l >>| tell [BCLedOn] - ledOff (BC l) = BC $ l >>| tell [BCLedOff] + ledOn l = op l BCLedOn + ledOff l = op l BCLedOff instance retrn ByteCode where retrn = tell` [BCReturn] @@ -356,15 +360,21 @@ toMessages interval x s instance == BCShare where (==) a b = a.sdsi == b.sdsi //Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero -Start = fst $ toReadableByteCode (unMain $ countAndLed) zero +Start = fst $ toReadableByteCode (unMain $ bc) zero //Start = fst $ toReadableByteCode (unMain $ blink LED1) zero //Start = let (bcs, st) = toReadableByteCode (unMain bc) zero // in (bcs, st.sdss) where // bc = {main = ledOn (lit LED1)} - bc = sds \x=5 In - sds \y=4 In - {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)} +// bc = sds \x=5 In +// sds \y=4 In +// {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)} + bc = {main = + IF (analogRead A0 >. lit 50) + ( digitalWrite D0 (lit True) ) + ( digitalWrite D0 (lit False) ) + } + to16bit :: Int -> String to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))