From 1da5b3a977c7196f13c1f0fdc2501b0377e44414 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Tue, 24 Apr 2018 12:06:02 +0200 Subject: [PATCH] Add windows stuff for detecting devices --- Makefile | 6 ++++++ Monitor.icl | 3 ++- POSIX/Platform.dcl | 2 ++ POSIX/Platform.icl | 9 +++++++++ TTY.dcl | 1 + TTY.icl | 16 +++++++++++++++- Windows/Platform.dcl | 2 ++ Windows/Platform.icl | 16 ++++++++++++++++ iTasksTTY.dcl | 2 -- iTasksTTY.icl | 9 +-------- 10 files changed, 54 insertions(+), 12 deletions(-) diff --git a/Makefile b/Makefile index eaca6ba..6c1672b 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 7c5c3b6..b96ac76 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 f2be3c3..ac3a254 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 76a52e6..907f57a 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 2c12494..10397f7 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 927522a..27925b6 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 f2be3c3..ac3a254 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 76a52e6..0cee571 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 027feac..0fbaeaf 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 edfae69..c525df2 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->( -- GitLab