From 1da5b3a977c7196f13c1f0fdc2501b0377e44414 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
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