Commit 1da5b3a9 authored by Mart Lubbers's avatar Mart Lubbers

Add windows stuff for detecting devices

parent 3820fba8
......@@ -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
......@@ -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" []
......
definition module Platform
getDevices :: !*World -> !*([String], !*World)
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)
......@@ -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)
......
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}
......
definition module Platform
getDevices :: !*World -> !*([String], !*World)
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"
}
......@@ -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
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->(
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment