diff --git a/Makefile b/Makefile index eaca6ba6ed880663463265c9e1920e1541943d5a..6c1672b9f0130790dc4b79afdf17c1ba4ab521e7 100644 --- a/Makefile +++ b/Makefile @@ -13,5 +13,11 @@ Clean\ System\ Files/ctty.o: $(DETECTED_OS)/tty.c mkdir -p Clean\ System\ Files gcc -c "$<" -o "$@" +Monitor.prj: + cpm project $(basename $@) create + cpm project $@ target iTasks + cpm project $@ set -h 2000m -s 20m -dynamics + cpm project $@ path add "$$PWD/POSIX" + clean: $(RM) -r $(DETECTED_OS)/Clean\ System\ Files/* Clean\ System\ Files/* test diff --git a/Monitor.icl b/Monitor.icl index 7c5c3b65b7418a38f41064c6d6bc9a6cf57f32ec..b96ac76e38e899767e2be2aea7d1d63e51703247 100644 --- a/Monitor.icl +++ b/Monitor.icl @@ -2,6 +2,7 @@ module Monitor import iTasks import iTasksTTY +import Data.Either import StdTuple Start w = startEngine monitor w @@ -9,7 +10,7 @@ Start w = startEngine monitor w monitor :: Task () monitor = enterTTYSettings <<@ ApplyLayout frameCompact >>! \ts->withShared ([], [], False) \channels-> - syncSerialChannel ts id id channels + syncSerialChannel ts id (\s->(Right [s], "")) channels ||- viewSharedInformation "Incoming messages" [ViewAs (take 20 o fst3)] channels ||- forever ( enterInformation "Send line of text" [] diff --git a/POSIX/Platform.dcl b/POSIX/Platform.dcl index f2be3c39e4ffa4e38abc52935aede2f95424f810..ac3a2548f371f7b5bc5fe15012fe9ade56fcf633 100644 --- a/POSIX/Platform.dcl +++ b/POSIX/Platform.dcl @@ -1 +1,3 @@ definition module Platform + +getDevices :: !*World -> !*([String], !*World) diff --git a/POSIX/Platform.icl b/POSIX/Platform.icl index 76a52e6290fd6c3b8d923a5f7349700ed05ed060..907f57adbe2dc4be7635862da5b6dc9c5fda33a7 100644 --- a/POSIX/Platform.icl +++ b/POSIX/Platform.icl @@ -1 +1,10 @@ implementation module Platform + +import Data.Error +import StdMisc, StdOverloaded, StdString +import System.Directory + +getDevices :: !*World -> !*([String], !*World) +getDevices w = case readDirectory "/dev" w of + (Error (errcode, errmsg), w) = abort errmsg + (Ok entries, w) = (entries, w) diff --git a/TTY.dcl b/TTY.dcl index 2c124942ba882c7faf44913a6be4545216fd0e2d..10397f7f26820232668962bfc825584bdbbe7007 100644 --- a/TTY.dcl +++ b/TTY.dcl @@ -21,6 +21,7 @@ from StdClass import class zero instance zero TTYSettings +getTTYDevices :: !*World -> *(![String], !*World) makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool -> TTYSettings TTYclose :: !*TTY !*env -> (!Bool, !*env) diff --git a/TTY.icl b/TTY.icl index 927522aed5f460b8cb6210e36bad926b27304df7..27925b6a7024d488e92c7182559144d700bddf3e 100644 --- a/TTY.icl +++ b/TTY.icl @@ -1,6 +1,10 @@ implementation module TTY -import _SystemArray +import StdFunc +import StdList +import System.OS +import Text +import StdArray import StdClass import StdString import StdChar @@ -35,6 +39,16 @@ instance toInt Parity where ParityNone = 0; ParityOdd = 1; ParityEven = 2; ParitySpace = 3; ParityMark = 4 +getTTYDevices :: !*World -> *(![String], !*World) +getTTYDevices w + # (ds, w) = getDevices w + = (IF_WINDOWS + (filter (startsWith "COM") ds) + (map ((+++) "/dev/") (filter isTTY ds)) + , w) +where + isTTY s = not (isEmpty (filter (flip startsWith s) ["tty", "rfcomm"])) + makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool -> TTYSettings makeTTYSettings dp br bs pr sb xx = {TTYSettings | devicePath=dp, baudrate=br, bytesize=bs, parity=pr, stop2bits=sb, xonxoff=xx} diff --git a/Windows/Platform.dcl b/Windows/Platform.dcl index f2be3c39e4ffa4e38abc52935aede2f95424f810..ac3a2548f371f7b5bc5fe15012fe9ade56fcf633 100644 --- a/Windows/Platform.dcl +++ b/Windows/Platform.dcl @@ -1 +1,3 @@ definition module Platform + +getDevices :: !*World -> !*([String], !*World) diff --git a/Windows/Platform.icl b/Windows/Platform.icl index 76a52e6290fd6c3b8d923a5f7349700ed05ed060..0cee57137bf8d42cf9f7c041890538f5dffba60f 100644 --- a/Windows/Platform.icl +++ b/Windows/Platform.icl @@ -1 +1,17 @@ implementation module Platform + +getDevices :: !*World -> !*([String], !*World) +getDevices w + # (ph, w) = getProcessheap w + # (ptr, w) = heapAlloc ph 0 4096 w + # (ret, w) = realQDD 0 ptr 4096 w + | ret == 0 = abort "error in QueryDosDevice" + # res = derefString ptr + # (ok, w) = heapFree ph 0 ptr w + = split "\0" res + +realQDD :: !Pointer !Pointer !Int !*env -> !*(Int, !*env) +realQDD _ _ _ _ = + = code { + ccall QueryDosDevice "ppI:I:A" + } diff --git a/iTasksTTY.dcl b/iTasksTTY.dcl index 027feac0fe31a22c56a569b1039a8a594ebc4ce3..0fbaeaf5b2e45dbbe9ac8d4f7bd771bfdd78a608 100644 --- a/iTasksTTY.dcl +++ b/iTasksTTY.dcl @@ -5,8 +5,6 @@ import iTasks derive class iTask TTYSettings -getTTYDevices :: !*env -> *(![String], !*env) - enterTTYSettings :: Task TTYSettings syncSerialChannel :: TTYSettings (b -> String) (String -> (Either String [a], String)) (Shared ([a],[b],Bool)) -> Task () | iTask a & iTask b diff --git a/iTasksTTY.icl b/iTasksTTY.icl index edfae69812dbc143ef4362a93003f56e497cc1fc..c525df2a3801a1e987a9661d6f4df3c669aa96c9 100644 --- a/iTasksTTY.icl +++ b/iTasksTTY.icl @@ -1,5 +1,6 @@ implementation module iTasksTTY +import System.OS import TTY import StdList @@ -29,14 +30,6 @@ import iTasks.Internal.TaskEval derive class iTask TTYSettings, Parity, BaudRate, ByteSize -getTTYDevices :: !*env -> *(![String], !*env) -getTTYDevices 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 = ["tty", "rfcomm"] - enterTTYSettings :: Task TTYSettings enterTTYSettings = accWorld getTTYDevices >>= \ds->(