From 3274f77263c3c7ec7931ac53c02ab6422812142b Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Feb 2017 16:06:40 +0100 Subject: [PATCH 01/16] update sub --- CleanSerial | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CleanSerial b/CleanSerial index a0ee53c..9ccc9f2 160000 --- a/CleanSerial +++ b/CleanSerial @@ -1 +1 @@ -Subproject commit a0ee53c6fd37e4ef3e031b37536ee1d52bf37119 +Subproject commit 9ccc9f2546625d903b1a92e902ff596fe59e7957 -- 2.20.1 From 9f47008270ad2ab66d7787eb29b0f83a82a8e42e Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Feb 2017 16:14:16 +0100 Subject: [PATCH 02/16] fix makefiles forgood --- CleanSerial | 2 +- Makefile | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/CleanSerial b/CleanSerial index 9ccc9f2..e883e83 160000 --- a/CleanSerial +++ b/CleanSerial @@ -1 +1 @@ -Subproject commit 9ccc9f2546625d903b1a92e902ff596fe59e7957 +Subproject commit e883e832ce7935571b7562623cf78c5a00d31842 diff --git a/Makefile b/Makefile index 9f52e89..e6f7f8d 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,12 @@ CLEAN_HOME?=/opt/clean CLM:=clm -override CLMFLAGS+=-dynamics -h 200M -nt -l -no-pie + +override CLMFLAGS+=-dynamics -h 200M -nt +GCCVERSIONGTEQ6:=$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6) +ifeq "$(GCCVERSIONGTEQ6)" "1" + override CLMFLAGS+=-l -no-pie +endif + CLMLIBS:=\ -I $(CLEAN_HOME)/lib/Platform\ -I $(CLEAN_HOME)/lib/Platform/Deprecated/StdLib\ -- 2.20.1 From 56d27bb3b0dc3c4502c8447b75e4cd56ceecab03 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Feb 2017 16:17:09 +0100 Subject: [PATCH 03/16] a --- CleanSerial | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CleanSerial b/CleanSerial index e883e83..96af278 160000 --- a/CleanSerial +++ b/CleanSerial @@ -1 +1 @@ -Subproject commit e883e832ce7935571b7562623cf78c5a00d31842 +Subproject commit 96af2783c31759b6c07a5514f9fd52060c9fcff6 -- 2.20.1 From 6c8939998c64aafb8cdfa40e52a227bf72767648 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Feb 2017 17:51:28 +0100 Subject: [PATCH 04/16] complete linux interface and rename folder --- .gitmodules | 2 +- Makefile | 2 +- {int => client}/.gitignore | 0 {int => client}/ChibiOS | 0 {int => client}/Makefile | 0 {int => client}/Makefile.linux | 0 {int => client}/chconf.h | 0 {int => client}/halconf.h | 0 {int => client}/interface.c | 0 {int => client}/interface.h | 0 {int => client}/interface_linux.c | 12 ++++++++++++ {int => client}/interpret.c | 0 {int => client}/interpret.h | 0 {int => client}/mTaskSymbols.h | 0 {int => client}/main.c | 0 {int => client}/mcuconf.h | 0 {int => client}/sds.c | 0 {int => client}/sds.h | 0 {int => client}/task.c | 0 {int => client}/task.h | 0 20 files changed, 14 insertions(+), 2 deletions(-) rename {int => client}/.gitignore (100%) rename {int => client}/ChibiOS (100%) rename {int => client}/Makefile (100%) rename {int => client}/Makefile.linux (100%) rename {int => client}/chconf.h (100%) rename {int => client}/halconf.h (100%) rename {int => client}/interface.c (100%) rename {int => client}/interface.h (100%) rename {int => client}/interface_linux.c (95%) rename {int => client}/interpret.c (100%) rename {int => client}/interpret.h (100%) rename {int => client}/mTaskSymbols.h (100%) rename {int => client}/main.c (100%) rename {int => client}/mcuconf.h (100%) rename {int => client}/sds.c (100%) rename {int => client}/sds.h (100%) rename {int => client}/task.c (100%) rename {int => client}/task.h (100%) diff --git a/.gitmodules b/.gitmodules index b97a1d2..5195bdd 100644 --- a/.gitmodules +++ b/.gitmodules @@ -2,5 +2,5 @@ path = CleanSerial url = https://gitlab.science.ru.nl/mlubbers/CleanSerial [submodule "int/ChibiOS"] - path = int/ChibiOS + path = client/ChibiOS url = https://github.com/ChibiOS/ChibiOS.git diff --git a/Makefile b/Makefile index e6f7f8d..49943f5 100644 --- a/Makefile +++ b/Makefile @@ -19,7 +19,7 @@ CLMLIBS:=\ -I $(CLEAN_HOME)/lib/TCPIP\ -I ./CleanSerial -BINARIES:= miTask #mTaskExamples mTaskInterpret miTask +BINARIES:= miTask mTaskExamples mTaskInterpret all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) int/mTaskSymbols.h diff --git a/int/.gitignore b/client/.gitignore similarity index 100% rename from int/.gitignore rename to client/.gitignore diff --git a/int/ChibiOS b/client/ChibiOS similarity index 100% rename from int/ChibiOS rename to client/ChibiOS diff --git a/int/Makefile b/client/Makefile similarity index 100% rename from int/Makefile rename to client/Makefile diff --git a/int/Makefile.linux b/client/Makefile.linux similarity index 100% rename from int/Makefile.linux rename to client/Makefile.linux diff --git a/int/chconf.h b/client/chconf.h similarity index 100% rename from int/chconf.h rename to client/chconf.h diff --git a/int/halconf.h b/client/halconf.h similarity index 100% rename from int/halconf.h rename to client/halconf.h diff --git a/int/interface.c b/client/interface.c similarity index 100% rename from int/interface.c rename to client/interface.c diff --git a/int/interface.h b/client/interface.h similarity index 100% rename from int/interface.h rename to client/interface.h diff --git a/int/interface_linux.c b/client/interface_linux.c similarity index 95% rename from int/interface_linux.c rename to client/interface_linux.c index dd94993..e6e2df0 100644 --- a/int/interface_linux.c +++ b/client/interface_linux.c @@ -96,6 +96,18 @@ void delay(long ms) usleep(ms*1000); } +void led_on(uint8_t i) +{ + debug("led %d on\n", i); + (void)i; +} + +void led_off(uint8_t i) +{ + debug("led %d off\n", i); + (void)i; +} + void setup(void) { int port = 8123, opti = 1; diff --git a/int/interpret.c b/client/interpret.c similarity index 100% rename from int/interpret.c rename to client/interpret.c diff --git a/int/interpret.h b/client/interpret.h similarity index 100% rename from int/interpret.h rename to client/interpret.h diff --git a/int/mTaskSymbols.h b/client/mTaskSymbols.h similarity index 100% rename from int/mTaskSymbols.h rename to client/mTaskSymbols.h diff --git a/int/main.c b/client/main.c similarity index 100% rename from int/main.c rename to client/main.c diff --git a/int/mcuconf.h b/client/mcuconf.h similarity index 100% rename from int/mcuconf.h rename to client/mcuconf.h diff --git a/int/sds.c b/client/sds.c similarity index 100% rename from int/sds.c rename to client/sds.c diff --git a/int/sds.h b/client/sds.h similarity index 100% rename from int/sds.h rename to client/sds.h diff --git a/int/task.c b/client/task.c similarity index 100% rename from int/task.c rename to client/task.c diff --git a/int/task.h b/client/task.h similarity index 100% rename from int/task.h rename to client/task.h -- 2.20.1 From 660b3e808d5782edabf342aeb4f3116ffe79706b Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 6 Feb 2017 18:04:51 +0100 Subject: [PATCH 05/16] iso for style --- client/task.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/client/task.c b/client/task.c index 4ac8ce5..3d9a644 100644 --- a/client/task.c +++ b/client/task.c @@ -19,6 +19,7 @@ void task_init(void) int task_register(void) { uint8_t ct; + uint16_t i; for(ct = 0; ct MAXTASKSIZE) die("Task is too long: %d", tasks[ct].tlen); //Read task bytecode - for(unsigned int i = 0; i Date: Wed, 8 Feb 2017 08:09:27 +0100 Subject: [PATCH 06/16] update --- Makefile | 8 +++----- client/Makefile.linux | 4 ++-- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index 49943f5..0beb478 100644 --- a/Makefile +++ b/Makefile @@ -21,19 +21,17 @@ CLMLIBS:=\ BINARIES:= miTask mTaskExamples mTaskInterpret -all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) int/mTaskSymbols.h +all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) client/mTaskSymbols.h + find $(CLEAN_HOME)/lib -path '*/WebPublic/*' -execdir cp -nR {} "$$PWD"/miTask-www/ \; CleanSerial/Clean\ System\ Files/TTY.o: make -C CleanSerial -int/mTaskSymbols.h: mTaskMakeSymbols +client/mTaskSymbols.h: mTaskMakeSymbols ./$< -nr > $@ %: %.icl $(wildcard *.[id]cl) $(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@ - mkdir -p $(basename $<)-www - find $(CLEAN_HOME)/lib -path '*/WebPublic/*' -execdir \ - cp -nR {} "$$PWD"/$(basename $<)-www/ \; clean: $(RM) -r $(BINARIES) Clean\ System\ Files miTask-data miTask-www diff --git a/client/Makefile.linux b/client/Makefile.linux index edf1195..43548ac 100644 --- a/client/Makefile.linux +++ b/client/Makefile.linux @@ -5,10 +5,10 @@ OBJS:=interpret.o sds.o task.o main.o interface.o all: mTaskSymbols.h $(PROG) interface.o: interface_linux.c - gcc $(CFLAGS) -c $< -o $@ + $(CC) $(CFLAGS) -c $< -o $@ $(PROG): $(OBJS) - gcc $(LDFLAGS) -o $@ $(OBJS) + $(CC) $(LDFLAGS) -o $@ $(OBJS) mTaskSymbols.h: CLMFLAGS=-nr make -BC ../.. mTaskInterpret -- 2.20.1 From 55afb005ced3bba3813163596cdc7288a318a3c2 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 8 Feb 2017 18:39:44 +0100 Subject: [PATCH 07/16] update message spec --- client/main.c | 11 ++++++----- client/sds.c | 19 ++++++++++++++++++- client/sds.h | 1 + client/task.c | 12 +++++++++--- client/task.h | 2 +- mTaskInterpret.dcl | 11 +++++++---- mTaskInterpret.icl | 17 ++++++++++++----- miTask.icl | 3 ++- 8 files changed, 56 insertions(+), 20 deletions(-) diff --git a/client/main.c b/client/main.c index 3388f21..90f6e5f 100644 --- a/client/main.c +++ b/client/main.c @@ -17,6 +17,7 @@ #define MSG_GET_TASK 't' #define MSG_DEL_TASK 'd' #define MSG_SDS_SPEC 's' +#define MSG_SDS_DEL 'a' #define MSG_SDS_UPD 'u' void read_message(void) @@ -24,7 +25,6 @@ void read_message(void) //Find next task if(input_available()){ uint8_t c = read_byte(); - uint8_t ct; debug("Receiving input: %c %02x\n", c, c); switch(c){ case MSG_SDS_SPEC: @@ -36,16 +36,17 @@ void read_message(void) //TODO do something with the return value sds_update(); break; + case MSG_SDS_DEL: + debug("Receiving a delete SDS request"); + sds_delete(); + break; case MSG_DEL_TASK: debug("Receiving a delete task request"); task_delete(); break; case MSG_GET_TASK: debug("Receiving a task"); - ct = task_register(); - write_byte('t'); - write16(ct); - write_byte('\n'); + task_register(); break; case '\0': break; diff --git a/client/sds.c b/client/sds.c index c5f69b6..c2fdbde 100644 --- a/client/sds.c +++ b/client/sds.c @@ -36,6 +36,20 @@ void sds_register(void) debug("Received sds %d: %d", sdss[cs].id, sdss[cs].value); sdss[cs].used = true; + + write_byte('s'); + write16(sdss[cs].id); + write_byte('\n'); +} + +void sds_delete(void) +{ + uint8_t cs; + cs = read16(); + sdss[cs].used = false; + write_byte('a'); + write16(sdss[cs].id); + write_byte('\n'); } bool sds_update(void) @@ -52,6 +66,9 @@ bool sds_update(void) sdss[cs].value = read16(); debug("Received sds update %d: %d", sdss[cs].id, sdss[cs].value); + write_byte('u'); + write16(sdss[cs].id); + write_byte('\n'); return true; } } @@ -64,7 +81,7 @@ void sds_publish(int id) for(cs = 0; cs String -encode (MTSds i v) = "s" +++ to16bit i +++ v +++ "\n" encode (MTTask to data) = "t" +++ to16bit to +++ to16bit (size data) +++ data +++ "\n" +encode (MTSds i v) = "s" +++ to16bit i +++ v +++ "\n" encode (MTUpd i v) = "u" +++ to16bit i +++ v +++ "\n" decode :: String -> MTaskMSGRecv decode x | size x == 0 = MTEmpty = case x.[0] of + 't' = MTTaskAck (from16bit (x % (1,3))) + 'd' = MTTaskDelAck (from16bit (x % (1,3))) + 'm' = MTMessage x + 's' = MTSDSAck (from16bit (x % (1,3))) + 'a' = MTSDSDelAck (from16bit (x % (1,3))) + 'p' = MTPub (from16bit (x % (1,3))) (x % (3,5)) '\0' = MTEmpty '\n' = MTEmpty - 'm' = MTMessage x - 't' = MTTaskAdded (from16bit (x % (1,3))) - 'u' = MTPub (from16bit (x % (1,3))) (x % (3,5)) _ = MTMessage x//abort ("Didn't understand message: " +++ join " " [toString (toInt c)\\c<-: x] +++ "\n") safePrint :== toString o toJSON @@ -49,9 +52,13 @@ instance toString MTaskMSGSend where +++ " value " +++ safePrint v instance toString MTaskMSGRecv where + toString (MTTaskAck i) = "Task added with id: " +++ toString i + toString (MTTaskDelAck i) = "Task deleted with id: " +++ toString i + toString (MTSDSAck i) = "SDS added with id: " +++ toString i + toString (MTSDSDelAck i) = "SDS deleted with id: " +++ toString i toString (MTPub i v) = "Publish id: " +++ toString i +++ " value " +++ safePrint v - toString (MTTaskAdded i) = "Task added with id: " +++ toString i + toString (MTMessage m) = m toString MTEmpty = "Empty message" bclength :: BC -> Int diff --git a/miTask.icl b/miTask.icl index 5436ffe..767cd98 100644 --- a/miTask.icl +++ b/miTask.icl @@ -113,7 +113,8 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in = updateSDSs xs m n updateSDSs _ m mtm = case mtm of MTMessage s = upd (\l->take 5 [s:l]) m @! () - mta=:(MTTaskAdded _) = upd (\l->take 5 [toString mta:l]) m @! () + mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! () + //TODO other recv msgs _ = return () lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String]) -- 2.20.1 From 184c730e7c9ab350be853218f5e1f9b8866531ce Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 9 Feb 2017 15:32:29 +0100 Subject: [PATCH 08/16] start with management tasks --- Makefile | 2 +- miTask.icl | 31 +++++++++++++++++++++++++++++-- 2 files changed, 30 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 0beb478..04e4d8c 100644 --- a/Makefile +++ b/Makefile @@ -22,7 +22,7 @@ CLMLIBS:=\ BINARIES:= miTask mTaskExamples mTaskInterpret all: CleanSerial/Clean\ System\ Files/TTY.o $(BINARIES) client/mTaskSymbols.h - find $(CLEAN_HOME)/lib -path '*/WebPublic/*' -execdir cp -nR {} "$$PWD"/miTask-www/ \; + #find $(CLEAN_HOME)/lib -path '*/WebPublic/*' -execdir cp -nR {} "$$PWD"/miTask-www/ \; CleanSerial/Clean\ System\ Files/TTY.o: make -C CleanSerial diff --git a/miTask.icl b/miTask.icl index 767cd98..e81f47d 100644 --- a/miTask.icl +++ b/miTask.icl @@ -24,11 +24,15 @@ import TTY derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED +derive class iTask MTaskDevice + :: SerTCP = Serial | TCP :: *Resource | TTYd !*TTY +:: MTaskDevice = SerialDevice String TTYSettings | TCPDevice String Int Start :: *World -> *World -Start world = startEngine mTaskTask world +Start world = startEngine (mTaskManager + >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world //Start world = startEngine mTaskTask world bc :: Main (ByteCode () Stmt) @@ -55,7 +59,6 @@ bc2 d = {main = ledOn d} bc3 :: UserLED -> Main (ByteCode () Stmt) bc3 d = {main = ledOff d} - withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a withDevice t = withShared ([], [], False) \ch-> enterInformation "Type" [] @@ -74,6 +77,30 @@ withDevice t = withShared ([], [], False) \ch-> isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] +mTaskManager :: Task () +mTaskManager = viewSharedInformation "Devices" [] deviceStore + ||- forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) @! () + where + deviceStore :: Shared [MTaskDevice] + deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just []) + +addDevice :: Task MTaskDevice +addDevice = enterInformation "Enter device type" [] + >>= \ty->case ty of + TCP = (enterInformation "Host" [] -&&- enterInformation "Port" []) + >>= return o uncurry TCPDevice + Serial = accWorld getDevices + >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) + >>= return o uncurry SerialDevice + where + getDevices :: !*World -> *(![String], !*World) + getDevices w = case readDirectory "/dev" w of + (Error (errcode, errmsg), w) = abort errmsg + (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w) + where + isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) + prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] + mTaskTask :: Task () mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in withDevice \ch-> -- 2.20.1 From 2c4e395dee21ed8398f0d4a2da62329ec29799fd Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 9 Feb 2017 19:32:08 +0100 Subject: [PATCH 09/16] started with layout --- miTask.icl | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/miTask.icl b/miTask.icl index e81f47d..151074e 100644 --- a/miTask.icl +++ b/miTask.icl @@ -10,6 +10,7 @@ from Text import class Text(startsWith,concat,split,join), instance Text String from Data.Func import $ import Data.Tuple +import Data.List import System.Directory import iTasks.UI.Definition @@ -78,12 +79,22 @@ withDevice t = withShared ([], [], False) \ch-> prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] mTaskManager :: Task () -mTaskManager = viewSharedInformation "Devices" [] deviceStore - ||- forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) @! () +mTaskManager = viewSharedInformation "Devices" [] deviceStore + ||- forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) + ||- whileUnchanged deviceStore (\l->showTabbed l <<@ ArrangeWithTabs) <<@ ArrangeHorizontal where deviceStore :: Shared [MTaskDevice] deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just []) + showTabbed :: [MTaskDevice] -> Task () + showTabbed [] = viewInformation "" [] "No devices yet" @! () + showTabbed [l:ls] = foldr (\e es->viewInformation "Dev" [] e ||- es) (viewInformation "Dev" [] l @! ()) ls + + mapPar :: (a -> Task a) [a] -> Task () + mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! () + allAtOnce t = foldr1 (||-) t @! () + //allAtOnce = (flip (@!) ()) o foldr1 (||-) + addDevice :: Task MTaskDevice addDevice = enterInformation "Enter device type" [] >>= \ty->case ty of -- 2.20.1 From 24a37bfbe248331eee720fc06c6aa0390be13005 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 10 Feb 2017 14:42:45 +0100 Subject: [PATCH 10/16] add some task control --- miTask.icl | 206 ++++++++++++++++++++++++++++++----------------------- 1 file changed, 115 insertions(+), 91 deletions(-) diff --git a/miTask.icl b/miTask.icl index 151074e..d84121a 100644 --- a/miTask.icl +++ b/miTask.icl @@ -29,7 +29,11 @@ derive class iTask MTaskDevice :: SerTCP = Serial | TCP :: *Resource | TTYd !*TTY -:: MTaskDevice = SerialDevice String TTYSettings | TCPDevice String Int +:: MTaskDevice = { + deviceConnected :: Maybe (Shared ([String], [String], Bool)), + deviceName :: String, + deviceSettings :: Either (String, Int) (String, TTYSettings) + } Start :: *World -> *World Start world = startEngine (mTaskManager @@ -60,35 +64,50 @@ bc2 d = {main = ledOn d} bc3 :: UserLED -> Main (ByteCode () Stmt) bc3 d = {main = ledOff d} -withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a -withDevice t = withShared ([], [], False) \ch-> - enterInformation "Type" [] - >>= \ty->case ty of - TCP = (enterInformation "Host" [] -&&- enterInformation "Port" []) - >>= \(port,host)->t ch -|| syncNetworkChannel host port ch - Serial = accWorld getDevices - >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) - >>= \(dev,set)->t ch -|| syncSerialChannel dev set ch - where - getDevices :: !*World -> *(![String], !*World) - getDevices w = case readDirectory "/dev" w of - (Error (errcode, errmsg), w) = abort errmsg - (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w) - where - isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) - prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] +:: MTaskDeviceStatus = {connected :: Bool, name :: String} +derive class iTask MTaskDeviceStatus mTaskManager :: Task () -mTaskManager = viewSharedInformation "Devices" [] deviceStore - ||- forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) - ||- whileUnchanged deviceStore (\l->showTabbed l <<@ ArrangeWithTabs) <<@ ArrangeHorizontal +mTaskManager = forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) + ||- viewSharedInformation "Devices" [ViewAs deviceviewer] deviceStore + ||- whileUnchanged deviceStore (\m->if (isEmpty m) + (viewInformation "No devices yet" [] "" @! ()) (connectDevice m)) @! () +// ) where + connectDevice :: [MTaskDevice] -> Task () + connectDevice [] = treturn () + connectDevice [d:ds] = (case d.deviceConnected of + (Just sh) = viewSharedInformation "Buffers" [] sh @! () + Nothing = viewInformation ("Connect " +++ d.deviceName) [] "" >>* [ + OnAction (Action "connect") (const $ Just $ connect d)] + ) -|| connectDevice ds + + connect :: MTaskDevice -> Task () + connect d=:{deviceSettings} = withShared ([], [], False) $ \ch-> + case deviceSettings of + Left (host, port) = syncNetworkChannel host port ch + Right (dev, sett) = syncSerialChannel dev sett ch + ||- viewSharedInformation "Buffers" [] ch @! () + + deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus] + deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName, + connected = if (isNothing d.deviceConnected) False True}\\d<-ds] + deviceStore :: Shared [MTaskDevice] deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just []) - showTabbed :: [MTaskDevice] -> Task () - showTabbed [] = viewInformation "" [] "No devices yet" @! () - showTabbed [l:ls] = foldr (\e es->viewInformation "Dev" [] e ||- es) (viewInformation "Dev" [] l @! ()) ls +// showTabbed :: [MTaskDevice] -> Task () +// showTabbed [] = viewInformation "" [] "No devices yet" @! () +// showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls +// +// manageDevice :: MTaskDevice -> Task () +// manageDevice md = +// either viewTCP viewSer md.deviceSettings +// ||- maybe +// (treturn () >>* [OnAction (Action "Connect") (always shutDown)] @! ()) +// (\b->viewSharedInformation "Buffers" [] b @! ()) +// md.deviceConnected +// <<@ ArrangeVertical mapPar :: (a -> Task a) [a] -> Task () mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! () @@ -96,13 +115,18 @@ mTaskManager = viewSharedInformation "Devices" [] deviceStore //allAtOnce = (flip (@!) ()) o foldr1 (||-) addDevice :: Task MTaskDevice -addDevice = enterInformation "Enter device type" [] - >>= \ty->case ty of +addDevice = enterInformation "Device name" [] + -&&- enterInformation "Device type" [] + >>= \(name, ty)->(case ty of TCP = (enterInformation "Host" [] -&&- enterInformation "Port" []) - >>= return o uncurry TCPDevice + >>= treturn o Left Serial = accWorld getDevices >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) - >>= return o uncurry SerialDevice + >>= treturn o Right + ) >>= \set->treturn {MTaskDevice | + deviceConnected=Nothing, + deviceName=name, + deviceSettings=set} where getDevices :: !*World -> *(![String], !*World) getDevices w = case readDirectory "/dev" w of @@ -112,69 +136,69 @@ addDevice = enterInformation "Enter device type" [] isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] -mTaskTask :: Task () -mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in - withDevice \ch-> - sendMsg msgs ch - ||- processMessages ch messageShare sdsShares - ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3] - >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch) - ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3] - >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch) - ||- viewSharedInformation "channels" [ViewAs lens] ch - ||- viewSharedInformation "messages" [] messageShare - ||- viewSh sdsShares ch - >>* [OnAction ActionFinish (always shutDown)] - where - messageShare :: Shared [String] - messageShare = sharedStore "mTaskMessagesRecv" [] - - processMessages ch msgs sdss = forever (watch ch - >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))]) - where - process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task () - process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r - where - process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ()) - - makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) - makeMsgs timeout bc - # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) - = (msgs, map f st.sdss) - where - f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) - dd [x,y] = toInt x*265 + toInt y - - updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task () - updateSDSs [(id, sh):xs] m n=:(MTPub i d) - | 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 5 [s:l]) m @! () - mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! () - //TODO other recv msgs - _ = return () - - lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String]) - lens (r,s,_) = (map toString r, map toString s) - - viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task () - viewSh [] ch = return () - viewSh [(i, sh):xs] ch - # sharename = "SDS-" +++ toString i - = ( - viewSharedInformation ("SDS-" +++ toString i) [] sh ||- - forever ( - enterInformation sharename [] - >>* [OnAction ActionOk - (ifValue (\j->j>=1 && j <= 3) - (\c->set c sh - >>= \_->sendMsg (toSDSUpdate i c) ch - @! () - ) - )] - ) - ) ||- viewSh xs ch +//mTaskTask :: Task () +//mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in +// withDevice \ch-> +// sendMsg msgs ch +// ||- processMessages ch messageShare sdsShares +// ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3] +// >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch) +// ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3] +// >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch) +// ||- viewSharedInformation "channels" [ViewAs lens] ch +// ||- viewSharedInformation "messages" [] messageShare +// ||- viewSh sdsShares ch +// >>* [OnAction ActionFinish (always shutDown)] +// where +// messageShare :: Shared [String] +// messageShare = sharedStore "mTaskMessagesRecv" [] +// +// processMessages ch msgs sdss = forever (watch ch +// >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))]) +// where +// process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task () +// process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r +// where +// process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ()) +// +// makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) +// makeMsgs timeout bc +// # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) +// = (msgs, map f st.sdss) +// where +// f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) +// dd [x,y] = toInt x*265 + toInt y +// +// updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task () +// updateSDSs [(id, sh):xs] m n=:(MTPub i d) +// | 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 5 [s:l]) m @! () +// mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! () +// //TODO other recv msgs +// _ = return () +// +// lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String]) +// lens (r,s,_) = (map toString r, map toString s) +// +// viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task () +// viewSh [] ch = return () +// viewSh [(i, sh):xs] ch +// # sharename = "SDS-" +++ toString i +// = ( +// viewSharedInformation ("SDS-" +++ toString i) [] sh ||- +// forever ( +// enterInformation sharename [] +// >>* [OnAction ActionOk +// (ifValue (\j->j>=1 && j <= 3) +// (\c->set c sh +// >>= \_->sendMsg (toSDSUpdate i c) ch +// @! () +// ) +// )] +// ) +// ) ||- viewSh xs ch sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task () sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! () -- 2.20.1 From 623ed5855ab2fca088c83c3c3bd4e3a6d18f1483 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 13 Feb 2017 19:43:56 +0100 Subject: [PATCH 11/16] started with layout --- install_clean.sh | 3 ++ miTask.icl | 115 +++++++++++++++++++++++++++-------------------- 2 files changed, 70 insertions(+), 48 deletions(-) diff --git a/install_clean.sh b/install_clean.sh index 005cbe7..e21a1c6 100755 --- a/install_clean.sh +++ b/install_clean.sh @@ -6,6 +6,9 @@ then exit 1; fi TARGET="$(realpath "$1")" +if [ -d "$TARGET" ]; then + mv "$TARGET" "$TARGET.$(date +%F)" +fi rm -fr "$TARGET" mkdir -p "$TARGET" curl -sSL ftp://ftp.cs.ru.nl/pub/Clean/builds/linux-x64/clean-bundle-complete-linux-x64-latest.tgz \ diff --git a/miTask.icl b/miTask.icl index d84121a..9af815e 100644 --- a/miTask.icl +++ b/miTask.icl @@ -20,25 +20,24 @@ import iTasks._Framework.TaskServer import iTasks._Framework.IWorld import iTasks._Framework.Store + import TTY derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED -derive class iTask MTaskDevice - -:: SerTCP = Serial | TCP :: *Resource | TTYd !*TTY +:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool) + +:: SerTCP = SerialDevice | TCPDevice :: MTaskDevice = { - deviceConnected :: Maybe (Shared ([String], [String], Bool)), - deviceName :: String, - deviceSettings :: Either (String, Int) (String, TTYSettings) + deviceConnected :: Maybe String, + deviceName :: String } Start :: *World -> *World Start world = startEngine (mTaskManager >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world -//Start world = startEngine mTaskTask world bc :: Main (ByteCode () Stmt) bc = sds \x=1 In sds \pinnetje=1 In {main = @@ -65,29 +64,71 @@ bc3 :: UserLED -> Main (ByteCode () Stmt) bc3 d = {main = ledOff d} :: MTaskDeviceStatus = {connected :: Bool, name :: String} -derive class iTask MTaskDeviceStatus +derive class iTask MTaskDeviceStatus, MTaskDevice mTaskManager :: Task () -mTaskManager = forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) - ||- viewSharedInformation "Devices" [ViewAs deviceviewer] deviceStore - ||- whileUnchanged deviceStore (\m->if (isEmpty m) - (viewInformation "No devices yet" [] "" @! ()) (connectDevice m)) @! () +mTaskManager = anyTask + [ viewmTasks @! () + , whileUnchanged deviceStore viewDevices + , addDevice deviceStore + , viewChannels deviceStore + ] <<@ ApplyLayout layout +// ||- whileUnchanged deviceStore (\m->if (isEmpty m) +// (viewInformation "No devices yet" [] "" @! ()) (connectDevice m)) @! () // ) where - connectDevice :: [MTaskDevice] -> Task () - connectDevice [] = treturn () - connectDevice [d:ds] = (case d.deviceConnected of - (Just sh) = viewSharedInformation "Buffers" [] sh @! () - Nothing = viewInformation ("Connect " +++ d.deviceName) [] "" >>* [ - OnAction (Action "connect") (const $ Just $ connect d)] - ) -|| connectDevice ds - - connect :: MTaskDevice -> Task () - connect d=:{deviceSettings} = withShared ([], [], False) $ \ch-> - case deviceSettings of - Left (host, port) = syncNetworkChannel host port ch - Right (dev, sett) = syncSerialChannel dev sett ch - ||- viewSharedInformation "Buffers" [] ch @! () + isValue (Value _ _) = True + isValue _ = False + + viewmTasks = viewInformation "MTasks" [] "" + + layout = sequenceLayouts + [ arrangeWithSideBar 0 LeftSide 260 True + , arrangeSplit Vertical True + , layoutSubs (SelectByPath [1, 0]) arrangeWithTabs + ] + + viewChannels :: (Shared [MTaskDevice]) -> Task () + viewChannels sh = whileUnchanged sh (\d->if (isEmpty d) + (viewInformation "No channels yet" [] "") + (viewInformation "Channels available" [] "")) @! () + + viewDevices :: [MTaskDevice] -> [Task ()] + viewDevices [] = viewInformation "No devices yet" [] "" @! () + viewDevices ds = [viewInformation "Device" [] d <<@ Title d.deviceName\\d<-ds] + + addDevice :: (Shared [MTaskDevice]) -> Task () + addDevice devices = enterInformation "Device type and name" [] + >>= \(name, ty)->get randomInt + >>= \ident->treturn (name +++ toString ident) + >>= \realname->let ch = channels realname in case ty of + TCPDevice = enterInformation "Hostname and port" [] + >>= \(host, port)->cont realname name ||- syncNetworkChannel host port ch + SerialDevice = accWorld getDevices + >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) + >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch + where + cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices) + dev rn nm = {deviceConnected=Just rn,deviceName=nm} + + channels :: String -> Shared Channels + channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False) + + getDevices :: !*World -> *(![String], !*World) + getDevices w = case readDirectory "/dev" w of + (Error (errcode, errmsg), w) = abort errmsg + (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w) + + isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) + prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] + +// connectDevice :: [MTaskDevice] -> Task () +// connectDevice [] = treturn () +// connectDevice [d:ds] = (case d.deviceConnected of +// (Just sh) = viewSharedInformation "Buffers" [] sh @! () +// Nothing = viewInformation ("Connect " +++ d.deviceName) [] "" >>* [ +// OnAction (Action "connect") (const $ Just $ connect d)] +// ) -|| connectDevice ds deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus] deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName, @@ -114,27 +155,6 @@ mTaskManager = forever (addDevice >>= \d->upd (\l->[d:l]) deviceStore) allAtOnce t = foldr1 (||-) t @! () //allAtOnce = (flip (@!) ()) o foldr1 (||-) -addDevice :: Task MTaskDevice -addDevice = enterInformation "Device name" [] - -&&- enterInformation "Device type" [] - >>= \(name, ty)->(case ty of - TCP = (enterInformation "Host" [] -&&- enterInformation "Port" []) - >>= treturn o Left - Serial = accWorld getDevices - >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) - >>= treturn o Right - ) >>= \set->treturn {MTaskDevice | - deviceConnected=Nothing, - deviceName=name, - deviceSettings=set} - where - getDevices :: !*World -> *(![String], !*World) - getDevices w = case readDirectory "/dev" w of - (Error (errcode, errmsg), w) = abort errmsg - (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w) - where - isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) - prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] //mTaskTask :: Task () //mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in @@ -263,7 +283,6 @@ syncNetworkChannel server port channel whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) whileConnected Nothing acc (msgs,send,sendStopped) = (Ok acc, Nothing, [], False) -// = (Ok acc, Just (msgs,[],sendStopped), map encode send, False) whileConnected (Just newData) acc (msgs,send,sendStopped) | sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) -- 2.20.1 From 68e65ffa79b10fc6762a0f7989a268126fc20c1b Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 14 Feb 2017 18:16:50 +0100 Subject: [PATCH 12/16] layout is working, now up to the communication --- miTask.icl | 40 +++++++++++++++++++++------------------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/miTask.icl b/miTask.icl index 9af815e..efff14d 100644 --- a/miTask.icl +++ b/miTask.icl @@ -69,38 +69,43 @@ derive class iTask MTaskDeviceStatus, MTaskDevice mTaskManager :: Task () mTaskManager = anyTask [ viewmTasks @! () + , viewShares , whileUnchanged deviceStore viewDevices - , addDevice deviceStore - , viewChannels deviceStore ] <<@ ApplyLayout layout -// ||- whileUnchanged deviceStore (\m->if (isEmpty m) -// (viewInformation "No devices yet" [] "" @! ()) (connectDevice m)) @! () -// ) where isValue (Value _ _) = True isValue _ = False - viewmTasks = viewInformation "MTasks" [] "" + viewmTasks = enterChoice "Available mTasks" [ChooseFromList id] ["ledder", "ledon", "ledoff"] + >>= viewInformation "" [] layout = sequenceLayouts [ arrangeWithSideBar 0 LeftSide 260 True , arrangeSplit Vertical True - , layoutSubs (SelectByPath [1, 0]) arrangeWithTabs ] - viewChannels :: (Shared [MTaskDevice]) -> Task () - viewChannels sh = whileUnchanged sh (\d->if (isEmpty d) - (viewInformation "No channels yet" [] "") - (viewInformation "Channels available" [] "")) @! () + viewShares :: Task () + viewShares = viewInformation () [] () - viewDevices :: [MTaskDevice] -> [Task ()] - viewDevices [] = viewInformation "No devices yet" [] "" @! () - viewDevices ds = [viewInformation "Device" [] d <<@ Title d.deviceName\\d<-ds] + viewDevices :: [MTaskDevice] -> Task () + viewDevices ds = anyTask [ + addDevice deviceStore <<@ Title "Add new device" @! (): + [viewDevice d <<@ Title d.deviceName\\d<-ds]] + <<@ ArrangeWithTabs @! () + + viewDevice :: MTaskDevice -> Task () + viewDevice d = (viewInformation "Device settings" [] d + ||- (case d.deviceConnected of + Just s = viewSharedInformation "Channels" [] (channels d.deviceName) @! () + Nothing = viewInformation "No channels yet" [] "" @! () + )) <<@ ArrangeHorizontal + + channels :: String -> Shared Channels + channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False) addDevice :: (Shared [MTaskDevice]) -> Task () addDevice devices = enterInformation "Device type and name" [] - >>= \(name, ty)->get randomInt - >>= \ident->treturn (name +++ toString ident) + >>= \(name, ty)->get randomInt @ ((+++) name o toString) >>= \realname->let ch = channels realname in case ty of TCPDevice = enterInformation "Hostname and port" [] >>= \(host, port)->cont realname name ||- syncNetworkChannel host port ch @@ -111,9 +116,6 @@ mTaskManager = anyTask cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices) dev rn nm = {deviceConnected=Just rn,deviceName=nm} - channels :: String -> Shared Channels - channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False) - getDevices :: !*World -> *(![String], !*World) getDevices w = case readDirectory "/dev" w of (Error (errcode, errmsg), w) = abort errmsg -- 2.20.1 From a1d6b27b5aa5cbb049abdba86c8c5af4e5c1040e Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 17 Feb 2017 16:08:45 +0100 Subject: [PATCH 13/16] share representation started --- miTask.icl | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/miTask.icl b/miTask.icl index efff14d..11daaa9 100644 --- a/miTask.icl +++ b/miTask.icl @@ -8,6 +8,8 @@ import mTask from Text import class Text(startsWith,concat,split,join), instance Text String +import qualified Data.Map as DM + from Data.Func import $ import Data.Tuple import Data.List @@ -85,7 +87,17 @@ mTaskManager = anyTask ] viewShares :: Task () - viewShares = viewInformation () [] () + viewShares = forever ( + enterChoiceWithShared "Shares" [ChooseFromList sdsvw] sdsShare + >>* [OnValue $ withValue $ Just o updateShare] + >>* [OnAction (Action "Back") (const $ Just $ treturn ())] + ) + where + sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v] + updateShare (k, v) = (viewInformation "Key" [] k + ||- updateInformation "Value" [] v) + >>= \nv->upd + viewDevices :: [MTaskDevice] -> Task () viewDevices ds = anyTask [ @@ -103,6 +115,9 @@ mTaskManager = anyTask channels :: String -> Shared Channels channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False) + sdsShare :: Shared [(Int, Int)] + sdsShare = sdsFocus "mTaskSDSs" $ memoryStore "" $ Just [(1, 1)] + addDevice :: (Shared [MTaskDevice]) -> Task () addDevice devices = enterInformation "Device type and name" [] >>= \(name, ty)->get randomInt @ ((+++) name o toString) -- 2.20.1 From 0781ce1e845d7ec4bd06a39105d5d0d68835c693 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Sun, 19 Feb 2017 11:20:10 +0100 Subject: [PATCH 14/16] move generics to a different directory, add task sending framework --- gCons.dcl => Generics/gCons.dcl | 2 +- gCons.icl => Generics/gCons.icl | 2 +- gdynamic.dcl => Generics/gdynamic.dcl | 2 +- gdynamic.icl => Generics/gdynamic.icl | 2 +- mTask.dcl | 5 ++- mTask.icl | 5 ++- mTaskCode.icl | 5 ++- mTaskExamples.icl | 2 +- mTaskInterpret.icl | 4 +- mTaskLCD.icl | 2 +- mTaskMakeSymbols.icl | 3 +- mTaskSerial.icl | 2 +- mTaskSimulation.icl | 5 ++- miTask.icl | 57 +++++++++++++++++++++------ 14 files changed, 72 insertions(+), 26 deletions(-) rename gCons.dcl => Generics/gCons.dcl (94%) rename gCons.icl => Generics/gCons.icl (97%) rename gdynamic.dcl => Generics/gdynamic.dcl (95%) rename gdynamic.icl => Generics/gdynamic.icl (98%) diff --git a/gCons.dcl b/Generics/gCons.dcl similarity index 94% rename from gCons.dcl rename to Generics/gCons.dcl index 571aefe..7877e11 100644 --- a/gCons.dcl +++ b/Generics/gCons.dcl @@ -1,4 +1,4 @@ -definition module gCons +definition module Generics.gCons /* Pieter Koopman 2015 diff --git a/gCons.icl b/Generics/gCons.icl similarity index 97% rename from gCons.icl rename to Generics/gCons.icl index 6e5aaa5..fc4debc 100644 --- a/gCons.icl +++ b/Generics/gCons.icl @@ -1,4 +1,4 @@ -implementation module gCons +implementation module Generics.gCons /* Pieter Koopman 2015 diff --git a/gdynamic.dcl b/Generics/gdynamic.dcl similarity index 95% rename from gdynamic.dcl rename to Generics/gdynamic.dcl index 2dea3c1..66e9bf8 100644 --- a/gdynamic.dcl +++ b/Generics/gdynamic.dcl @@ -1,4 +1,4 @@ -definition module gdynamic +definition module Generics.gdynamic /* Pieter Koopman 2015 diff --git a/gdynamic.icl b/Generics/gdynamic.icl similarity index 98% rename from gdynamic.icl rename to Generics/gdynamic.icl index 28966bf..3240d6d 100644 --- a/gdynamic.icl +++ b/Generics/gdynamic.icl @@ -1,4 +1,4 @@ -implementation module gdynamic +implementation module Generics.gdynamic /* Pieter Koopman 2015 diff --git a/mTask.dcl b/mTask.dcl index 114012c..ac9405c 100644 --- a/mTask.dcl +++ b/mTask.dcl @@ -14,12 +14,15 @@ todo: imporove setp: >>*. */ +import Generics.gCons +import Generics.gdynamic + import iTasks import iTasks._Framework.Generic from iTasks._Framework.Task import :: Task import StdClass -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTaskCode, mTaskSimulation, mTaskInterpret import mTaskSerial, mTaskLCD diff --git a/mTask.icl b/mTask.icl index 34703d2..66649d7 100644 --- a/mTask.icl +++ b/mTask.icl @@ -14,8 +14,11 @@ todo: imporove setp: >>*. */ +import Generics.gCons +import Generics.gdynamic + import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTaskCode import mTaskSerial, mTaskLCD diff --git a/mTaskCode.icl b/mTaskCode.icl index 410e05e..f1da0d8 100644 --- a/mTaskCode.icl +++ b/mTaskCode.icl @@ -1,7 +1,10 @@ implementation module mTaskCode +import Generics.gdynamic +import Generics.gCons + import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask instance toCode MTask where toCode (MTask x) = "Task " + toCode x diff --git a/mTaskExamples.icl b/mTaskExamples.icl index d916951..4de01e6 100644 --- a/mTaskExamples.icl +++ b/mTaskExamples.icl @@ -1,7 +1,7 @@ module mTaskExamples import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask Start = diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index c63c95d..f0cddf9 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -1,7 +1,9 @@ implementation module mTaskInterpret //import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap +import Generics.gCons + +import GenEq, StdMisc, StdArray, GenBimap import GenPrint import StdEnum import mTask diff --git a/mTaskLCD.icl b/mTaskLCD.icl index 56b4eb4..6c9d16b 100644 --- a/mTaskLCD.icl +++ b/mTaskLCD.icl @@ -1,7 +1,7 @@ implementation module mTaskLCD import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask derive consIndex Button diff --git a/mTaskMakeSymbols.icl b/mTaskMakeSymbols.icl index f92cb2a..356493f 100644 --- a/mTaskMakeSymbols.icl +++ b/mTaskMakeSymbols.icl @@ -1,7 +1,8 @@ module mTaskMakeSymbols //import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray, GenBimap +import Generics.gCons +import GenEq, StdMisc, StdArray, GenBimap import GenPrint import mTask import StdEnum diff --git a/mTaskSerial.icl b/mTaskSerial.icl index e0e9f58..d010f4d 100644 --- a/mTaskSerial.icl +++ b/mTaskSerial.icl @@ -1,7 +1,7 @@ implementation module mTaskSerial import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask instance serial Code where diff --git a/mTaskSimulation.icl b/mTaskSimulation.icl index 7c187f7..e158002 100644 --- a/mTaskSimulation.icl +++ b/mTaskSimulation.icl @@ -1,7 +1,10 @@ implementation module mTaskSimulation +import Generics.gdynamic +import Generics.gCons + import iTasks -import gdynamic, gCons, GenEq, StdMisc, StdArray +import GenEq, StdMisc, StdArray import mTask derive class iTask Display diff --git a/miTask.icl b/miTask.icl index 11daaa9..738f8c2 100644 --- a/miTask.icl +++ b/miTask.icl @@ -34,13 +34,33 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED :: SerTCP = SerialDevice | TCPDevice :: MTaskDevice = { deviceConnected :: Maybe String, - deviceName :: String + deviceName :: String, + deviceTasks :: [(String, Int)] + } +:: MTaskShare = { + identifier :: Int, + realShare :: String } Start :: *World -> *World Start world = startEngine (mTaskManager >>* [OnAction (Action "Shutdown") (always $ shutDown)]) world +memoryShare :: String a -> Shared a | iTask a +memoryShare s d = sdsFocus s $ memoryStore "" $ Just d + +deviceStore :: Shared [MTaskDevice] +deviceStore = memoryShare "mTaskDevices" [] + +sdsStore :: Shared [MTaskShare] +sdsStore = memoryShare "mTaskShares" [] + +bcStateStore :: Shared BCState +bcStateStore = memoryShare "mTaskBCState" zero + +mTaskTaskStore :: Shared [String] +mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"] + bc :: Main (ByteCode () Stmt) bc = sds \x=1 In sds \pinnetje=1 In {main = IF (digitalRead D3) ( @@ -65,8 +85,8 @@ bc2 d = {main = ledOn d} bc3 :: UserLED -> Main (ByteCode () Stmt) bc3 d = {main = ledOff d} -:: MTaskDeviceStatus = {connected :: Bool, name :: String} -derive class iTask MTaskDeviceStatus, MTaskDevice +:: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [(String, Int)]} +derive class iTask MTaskDeviceStatus, MTaskDevice, MTaskShare, BCState mTaskManager :: Task () mTaskManager = anyTask @@ -78,8 +98,23 @@ mTaskManager = anyTask isValue (Value _ _) = True isValue _ = False - viewmTasks = enterChoice "Available mTasks" [ChooseFromList id] ["ledder", "ledon", "ledoff"] - >>= viewInformation "" [] + viewmTasks = listmTasks + >&^ \sh->whileUnchanged sh $ \mi->case mi of + Nothing = viewInformation "No task selected" [] () + Just mTaskTask = get deviceStore + >>= \devices->case devices of + [] = viewInformation "No devices yet" [] () + ds = sendmTask mTaskTask ds @! () + where + listmTasks :: Task String + listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore + + sendmTask mTaskId ds = enterChoice "Choose Device" [ChooseFromDropdown (\t->t.deviceName)] ds <<@ Title mTaskId + >>* [OnAction (Action "Send") (withValue $ sendToDevice mTaskId)] + + sendToDevice mTask device = Just $ viewInformation "" [] device + + layout = sequenceLayouts [ arrangeWithSideBar 0 LeftSide 260 True @@ -87,16 +122,14 @@ mTaskManager = anyTask ] viewShares :: Task () - viewShares = forever ( + viewShares = forever $ enterChoiceWithShared "Shares" [ChooseFromList sdsvw] sdsShare >>* [OnValue $ withValue $ Just o updateShare] >>* [OnAction (Action "Back") (const $ Just $ treturn ())] - ) where sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v] updateShare (k, v) = (viewInformation "Key" [] k ||- updateInformation "Value" [] v) - >>= \nv->upd viewDevices :: [MTaskDevice] -> Task () @@ -129,7 +162,7 @@ mTaskManager = anyTask >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch where cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices) - dev rn nm = {deviceConnected=Just rn,deviceName=nm} + dev rn nm = {deviceConnected=Just rn,deviceName=nm,deviceTasks=[]} getDevices :: !*World -> *(![String], !*World) getDevices w = case readDirectory "/dev" w of @@ -149,11 +182,9 @@ mTaskManager = anyTask deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus] deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName, - connected = if (isNothing d.deviceConnected) False True}\\d<-ds] + connected = if (isNothing d.deviceConnected) False True, + tasks = d.deviceTasks}\\d<-ds] - deviceStore :: Shared [MTaskDevice] - deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just []) - // showTabbed :: [MTaskDevice] -> Task () // showTabbed [] = viewInformation "" [] "No devices yet" @! () // showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls -- 2.20.1 From 58e526fc46f667943873621c9029d7e5dd7c158e Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Sun, 19 Feb 2017 16:41:16 +0100 Subject: [PATCH 15/16] improve install script, add debug to the linux client, update jenkins behaviour --- client/Makefile.linux | 2 +- client/interface_linux.c | 1 + client/main.c | 7 ++-- install_clean.sh | 2 +- mTaskInterpret.dcl | 2 +- mTaskInterpret.icl | 8 ++--- miTask.icl | 74 +++++++++++++++++++++++++++------------- 7 files changed, 63 insertions(+), 33 deletions(-) diff --git a/client/Makefile.linux b/client/Makefile.linux index 43548ac..a08c84d 100644 --- a/client/Makefile.linux +++ b/client/Makefile.linux @@ -1,4 +1,4 @@ -CFLAGS:=-g -Wall -Wextra # -DDEBUG +CFLAGS:=-g -Wall -Wextra -DDEBUG PROG:=main OBJS:=interpret.o sds.o task.o main.o interface.o diff --git a/client/interface_linux.c b/client/interface_linux.c index e6e2df0..acfd0b8 100644 --- a/client/interface_linux.c +++ b/client/interface_linux.c @@ -153,6 +153,7 @@ void setup(void) fflush(stdout); if((fd = accept(sock_fd, (struct sockaddr*)NULL, NULL)) == -1) pdie("accept"); + printf("Accepted incoming connection\n"); } void debug(char *fmt, ...) diff --git a/client/main.c b/client/main.c index 90f6e5f..dc43de2 100644 --- a/client/main.c +++ b/client/main.c @@ -55,6 +55,9 @@ void read_message(void) default: debug("Unknown message: %X", c); } + } else { + delay(1000); + printf("no input...\n"); } } @@ -104,10 +107,10 @@ int main(int argc, char *argv[]){ setup(); sds_init(); task_init(); - //debug("booting up"); + debug("booting up"); while(true){ //Check for newetasks -// debug("loop"); + write_byte('\n'); loop(); delay(50); } diff --git a/install_clean.sh b/install_clean.sh index e21a1c6..63bcb5e 100755 --- a/install_clean.sh +++ b/install_clean.sh @@ -7,7 +7,7 @@ then fi TARGET="$(realpath "$1")" if [ -d "$TARGET" ]; then - mv "$TARGET" "$TARGET.$(date +%F)" + mv "$TARGET" "$TARGET.$(date +%F)" || rm -fr "$TARGET" fi rm -fr "$TARGET" mkdir -p "$TARGET" diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 319ffb3..8c8e422 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -114,4 +114,4 @@ toSDSUpdate :: Int Int -> [MTaskMSGSend] toByteVal :: BC -> [Char] toReadableByteCode :: (ByteCode a b) -> (String, BCState) -toRealByteCode :: (ByteCode a b) -> (String, BCState) +toRealByteCode :: (ByteCode a b) BCState -> (String, BCState) diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index f0cddf9..4876e93 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -229,9 +229,9 @@ instance zero BCState where zero = {freshl=[1..], freshs=[1..], sdss=[]} -toRealByteCode :: (ByteCode a b) -> (String, BCState) -toRealByteCode x -# (bc, st) = runBC x zero +toRealByteCode :: (ByteCode a b) BCState -> (String, BCState) +toRealByteCode x s +# (bc, st) = runBC x s # (bc, gtmap) = computeGotos bc 1 = (concat $ map (toString o toByteVal) (map (implGotos gtmap) bc), st) @@ -265,7 +265,7 @@ toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] + toSDSUpdate :: Int Int -> [MTaskMSGSend] toSDSUpdate i v = [MTUpd i (to16bit v)] -Start = toMessages 500 $ toRealByteCode (unMain bc) +Start = toMessages 500 $ toRealByteCode (unMain bc) zero where bc = sds \x=5 In sds \y=4 In diff --git a/miTask.icl b/miTask.icl index 738f8c2..1e62ea7 100644 --- a/miTask.icl +++ b/miTask.icl @@ -61,6 +61,9 @@ bcStateStore = memoryShare "mTaskBCState" zero mTaskTaskStore :: Shared [String] mTaskTaskStore = memoryShare "mTaskTasks" ["ledder", "ledon", "ledoff"] +mTaskMap :: Map String (Main (ByteCode () Stmt)) +mTaskMap = 'DM'.fromList [("ledder", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)] + bc :: Main (ByteCode () Stmt) bc = sds \x=1 In sds \pinnetje=1 In {main = IF (digitalRead D3) ( @@ -109,12 +112,37 @@ mTaskManager = anyTask listmTasks :: Task String listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore - sendmTask mTaskId ds = enterChoice "Choose Device" [ChooseFromDropdown (\t->t.deviceName)] ds <<@ Title mTaskId - >>* [OnAction (Action "Send") (withValue $ sendToDevice mTaskId)] - - sendToDevice mTask device = Just $ viewInformation "" [] device + sendmTask mTaskId ds = + (enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds + -&&- enterInformation "Timeout, 0 for one-shot" []) + >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)] + + sendToDevice :: String (MTaskDevice, Int) -> Task () + sendToDevice mTask (device, timeout) = get bcStateStore + @ toMessages timeout o toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) + >>= \(msgs, st1)->set st1 bcStateStore + //@ map f + >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device) + @! () + where + f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) + dd [x,y] = toInt x*265 + toInt y + +// = (msgs, map f st.sdss) +// where +// upd (\(r,s,ss)->(r,s++[],ss)) (channels device) @! () +// # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) +// = Just $ viewInformation "" [] device +// = (msgs, map f st.sdss) +// where +// f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) +// dd [x,y] = toInt x*265 + toInt y +// # +// = Just $ viewInformation "" [] device + channels :: MTaskDevice -> Shared Channels + channels d = memoryShare (fromJust d.deviceConnected) ([], [], False) layout = sequenceLayouts [ arrangeWithSideBar 0 LeftSide 260 True @@ -123,13 +151,14 @@ mTaskManager = anyTask viewShares :: Task () viewShares = forever $ - enterChoiceWithShared "Shares" [ChooseFromList sdsvw] sdsShare + enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore >>* [OnValue $ withValue $ Just o updateShare] >>* [OnAction (Action "Back") (const $ Just $ treturn ())] where sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v] - updateShare (k, v) = (viewInformation "Key" [] k - ||- updateInformation "Value" [] v) + updateShare s = viewInformation "" [] () +// updateShare (k, v) = (viewInformation "Key" [] k +// ||- updateInformation "Value" [] v) viewDevices :: [MTaskDevice] -> Task () @@ -141,28 +170,23 @@ mTaskManager = anyTask viewDevice :: MTaskDevice -> Task () viewDevice d = (viewInformation "Device settings" [] d ||- (case d.deviceConnected of - Just s = viewSharedInformation "Channels" [] (channels d.deviceName) @! () + Just s = viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! () Nothing = viewInformation "No channels yet" [] "" @! () )) <<@ ArrangeHorizontal - - channels :: String -> Shared Channels - channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False) - - sdsShare :: Shared [(Int, Int)] - sdsShare = sdsFocus "mTaskSDSs" $ memoryStore "" $ Just [(1, 1)] + where + dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) addDevice :: (Shared [MTaskDevice]) -> Task () addDevice devices = enterInformation "Device type and name" [] - >>= \(name, ty)->get randomInt @ ((+++) name o toString) - >>= \realname->let ch = channels realname in case ty of + >>= \(name, ty)->get randomInt @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[]}) + >>= \dev->let ch = channels dev in case ty of TCPDevice = enterInformation "Hostname and port" [] - >>= \(host, port)->cont realname name ||- syncNetworkChannel host port ch + >>= \(host, port)->cont dev ||- syncNetworkChannel host port ch SerialDevice = accWorld getDevices >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) - >>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch + >>= \(device, settings)->cont dev ||- syncSerialChannel device settings ch where - cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices) - dev rn nm = {deviceConnected=Just rn,deviceName=nm,deviceTasks=[]} + cont d = (upd (\l->[d:l]) devices >>| addDevice devices) getDevices :: !*World -> *(![String], !*World) getDevices w = case readDirectory "/dev" w of @@ -321,8 +345,9 @@ serialDeviceBackgroundTask rw iworld syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task () -syncNetworkChannel server port channel - = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! () +syncNetworkChannel server port channel = catchAll + (tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()) + (\v->traceValue v @! ()) where onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) onConnect _ (msgs,send,sendStopped) @@ -333,8 +358,9 @@ syncNetworkChannel server port channel = (Ok acc, Nothing, [], False) whileConnected (Just newData) acc (msgs,send,sendStopped) - | sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) - = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False) + = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) + //| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False) +// = (Ok acc, Just (msgs ++ [decode newData],[],False), [], False) onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool)) onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing) -- 2.20.1 From bdebf34a1e281db5b2de64d5dd177cf7ea5cee51 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Sun, 19 Feb 2017 18:12:57 +0100 Subject: [PATCH 16/16] clean up, move iTasks serial stuff to Cleanserial, add toplevel tasks for syncing --- CleanSerial | 2 +- miTask.icl | 116 ++++++++++++++++++++++++++-------------------------- 2 files changed, 58 insertions(+), 60 deletions(-) diff --git a/CleanSerial b/CleanSerial index 96af278..9ea6c24 160000 --- a/CleanSerial +++ b/CleanSerial @@ -1 +1 @@ -Subproject commit 96af2783c31759b6c07a5514f9fd52060c9fcff6 +Subproject commit 9ea6c24060fbe14dd26e8efc62a4c004a3ba395b diff --git a/miTask.icl b/miTask.icl index 1e62ea7..a20108c 100644 --- a/miTask.icl +++ b/miTask.icl @@ -23,7 +23,7 @@ import iTasks._Framework.IWorld import iTasks._Framework.Store -import TTY +import TTY, iTasksTTY derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED @@ -33,11 +33,14 @@ derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED :: SerTCP = SerialDevice | TCPDevice :: MTaskDevice = { + deviceTask :: Maybe TaskId, deviceConnected :: Maybe String, deviceName :: String, deviceTasks :: [(String, Int)] } :: MTaskShare = { + initValue :: Int, + withTask :: String, identifier :: Int, realShare :: String } @@ -98,8 +101,10 @@ mTaskManager = anyTask , whileUnchanged deviceStore viewDevices ] <<@ ApplyLayout layout where - isValue (Value _ _) = True - isValue _ = False + layout = sequenceLayouts + [ arrangeWithSideBar 0 LeftSide 260 True + , arrangeSplit Vertical True + ] viewmTasks = listmTasks >&^ \sh->whileUnchanged sh $ \mi->case mi of @@ -118,45 +123,38 @@ mTaskManager = anyTask >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)] sendToDevice :: String (MTaskDevice, Int) -> Task () - sendToDevice mTask (device, timeout) = get bcStateStore - @ toMessages timeout o toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) - >>= \(msgs, st1)->set st1 bcStateStore - //@ map f + sendToDevice mTask (device, timeout) = + get bcStateStore @ createBytecode + >>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords + >>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare + >>| makeShares sdss >>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device) @! () where - f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) - dd [x,y] = toInt x*265 + toInt y - -// = (msgs, map f st.sdss) -// where -// upd (\(r,s,ss)->(r,s++[],ss)) (channels device) @! () -// # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) -// = Just $ viewInformation "" [] device -// = (msgs, map f st.sdss) -// where -// f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d)) -// dd [x,y] = toInt x*265 + toInt y -// # -// = Just $ viewInformation "" [] device + createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) st + sharename i = fromJust (device.deviceConnected) +++ "-" +++ toString i + toSDSRecords st = [{MTaskShare | + initValue=toInt d1*265 + toInt d2, + withTask=mTask, + identifier=i, + realShare="mTaskSDS-" +++ toString i} + \\(i,[d1,d2])<-st.sdss] + makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ()) + getSDSStore :: MTaskShare -> Shared Int + getSDSStore sh = memoryShare sh.realShare 0 channels :: MTaskDevice -> Shared Channels channels d = memoryShare (fromJust d.deviceConnected) ([], [], False) - layout = sequenceLayouts - [ arrangeWithSideBar 0 LeftSide 260 True - , arrangeSplit Vertical True - ] - viewShares :: Task () - viewShares = forever $ - enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore - >>* [OnValue $ withValue $ Just o updateShare] - >>* [OnAction (Action "Back") (const $ Just $ treturn ())] - where - sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v] - updateShare s = viewInformation "" [] () + viewShares = forever $ viewSharedInformation "Shares" [] sdsStore @! () +// enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore +// >>* [OnValue $ withValue $ Just o updateShare] +// >>* [OnAction (Action "Back") (const $ Just $ treturn ())] +// where +// sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v] +// updateShare s = viewInformation "" [] () // updateShare (k, v) = (viewInformation "Key" [] k // ||- updateInformation "Value" [] v) @@ -176,25 +174,33 @@ mTaskManager = anyTask where dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) - addDevice :: (Shared [MTaskDevice]) -> Task () - addDevice devices = enterInformation "Device type and name" [] - >>= \(name, ty)->get randomInt @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[]}) - >>= \dev->let ch = channels dev in case ty of - TCPDevice = enterInformation "Hostname and port" [] - >>= \(host, port)->cont dev ||- syncNetworkChannel host port ch - SerialDevice = accWorld getDevices - >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) - >>= \(device, settings)->cont dev ||- syncSerialChannel device settings ch + addDevice :: (Shared [MTaskDevice]) -> Task SerTCP + addDevice devices = enterInformation "Device type" [] + >&^ \sh->whileUnchanged sh $ \mty->case mty of + Nothing = viewInformation "No type selected yet" [] "" @! () + Just ty = case ty of + TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" []) + >>= \(name, (host, port))->cont name (syncNetworkChannel host port) + SerialDevice = accWorld getTTYDevices + >>= \dl->(enterInformation "Name" [] -&&- enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) + >>= \(name, (dev, set))->cont name (syncSerialChannel dev set) where - cont d = (upd (\l->[d:l]) devices >>| addDevice devices) - - getDevices :: !*World -> *(![String], !*World) - getDevices w = case readDirectory "/dev" w of - (Error (errcode, errmsg), w) = abort errmsg - (Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w) - - isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) - prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] + cont :: String ((Shared Channels) -> Task ()) -> Task () + cont name synfun = get randomInt + @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[], deviceTask=Nothing}) + >>= \dev->appendTopLevelTask 'DM'.newMap True (synfun $ channels dev) + >>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices + @! () + +// >= \ty->get randomInt @ (\randint->{deviceConnected=Just (name +++ toString randint), deviceName=name, deviceTasks=[]}) +// >>= \dev->let ch = channels dev in case ty of +// TCPDevice = enterInformation "Hostname and port" [] +// >>= \(host, port)->cont dev ||- syncNetworkChannel host port ch +// SerialDevice = accWorld getDevices +// >>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero) +// >>= \(device, settings)->cont dev ||- syncSerialChannel device settings ch +// where +// cont d = (upd (\l->[d:l]) devices >>| addDevice devices) // connectDevice :: [MTaskDevice] -> Task () // connectDevice [] = treturn () @@ -245,14 +251,6 @@ mTaskManager = anyTask // messageShare :: Shared [String] // messageShare = sharedStore "mTaskMessagesRecv" [] // -// processMessages ch msgs sdss = forever (watch ch -// >>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))]) -// where -// process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task () -// process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r -// where -// process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ()) -// // makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) // makeMsgs timeout bc // # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) -- 2.20.1