TTY.icl 2.36 KB
Newer Older
Mart Lubbers's avatar
Mart Lubbers committed
1 2
implementation module TTY

Mart Lubbers's avatar
Mart Lubbers committed
3
import StdFunc, StdBool
4 5 6 7
import StdList
import System.OS
import Text
import StdArray
8
import StdClass
Mart Lubbers's avatar
Mart Lubbers committed
9 10
import StdString
import StdChar
Mart Lubbers's avatar
Mart Lubbers committed
11
import Platform
Mart Lubbers's avatar
Mart Lubbers committed
12

13
import code from "ctty."
Mart Lubbers's avatar
Mart Lubbers committed
14 15 16 17 18

:: *TTY :== Int

instance zero TTYSettings where
	zero = {TTYSettings |
Mart Lubbers's avatar
Mart Lubbers committed
19
		devicePath = "/dev/ttyACM0",
Mart Lubbers's avatar
Mart Lubbers committed
20 21 22
		baudrate = B9600,
		bytesize = BytesizeEight,
		parity = ParityNone,
Mart Lubbers's avatar
Mart Lubbers committed
23
		stop2bits = False,
Mart Lubbers's avatar
Mart Lubbers committed
24 25 26
		xonxoff = False}

instance toInt BaudRate where
Mart Lubbers's avatar
Mart Lubbers committed
27 28 29 30 31
	toInt b = case b of
		B0 = 0; B50 = 1; B75 = 2; B110 = 3; B134 = 4; B150 = 5; B200 = 6
		B300 = 7; B600 = 8; B1200 = 9; B1800 = 10; B2400 = 11; B4800 = 12
		B9600 = 13; B19200 = 14; B38400 = 15; B57600 = 16; B115200 = 17
		B230400 = 18
Mart Lubbers's avatar
Mart Lubbers committed
32 33

instance toInt ByteSize where
Mart Lubbers's avatar
Mart Lubbers committed
34 35
	toInt b = case b of
		BytesizeFive = 0; BytesizeSix = 1; BytesizeSeven = 2; BytesizeEight = 3
Mart Lubbers's avatar
Mart Lubbers committed
36 37

instance toInt Parity where
Mart Lubbers's avatar
Mart Lubbers committed
38
	toInt p = case p of
39 40
		ParityNone = 0; ParityOdd = 1; ParityEven = 2; ParitySpace = 3;
		ParityMark = 4
Mart Lubbers's avatar
Mart Lubbers committed
41

42 43 44 45
getTTYDevices :: !*World -> *(![String], !*World)
getTTYDevices w
	# (ds, w) = getDevices w
	= (IF_WINDOWS
Mart Lubbers's avatar
Mart Lubbers committed
46
		(filter (\s->startsWith "COM" s && size s > 3 && isDigit s.[3]) ds)
47 48 49 50 51
		(map ((+++) "/dev/") (filter isTTY ds))
	  , w)
where
	isTTY s = not (isEmpty (filter (flip startsWith s) ["tty", "rfcomm"]))

52 53 54 55
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}

Mart Lubbers's avatar
Mart Lubbers committed
56 57 58
TTYopen :: !TTYSettings !*env -> (!Bool, !*TTY, !*env)
TTYopen ts w = TTYopen2
	ts.devicePath
Mart Lubbers's avatar
Mart Lubbers committed
59 60 61
	(toInt ts.baudrate)
	(toInt ts.bytesize)
	(toInt ts.parity)
Mart Lubbers's avatar
Mart Lubbers committed
62
	ts.stop2bits
Mart Lubbers's avatar
Mart Lubbers committed
63 64 65
	ts.xonxoff
	w
	where
Mart Lubbers's avatar
Mart Lubbers committed
66
		TTYopen2 :: !String !Int !Int !Int !Bool !Bool !*env -> (!Bool, !*TTY, !*env)
Mart Lubbers's avatar
Mart Lubbers committed
67 68 69 70 71
		TTYopen2 _ _ _ _ _ _ _ = code {
				ccall ttyopen "SIIIII:VII:A"
			}

TTYclose :: !*TTY !*env -> (!Bool, !*env)
Mart Lubbers's avatar
Mart Lubbers committed
72
TTYclose _ _ = code {
Mart Lubbers's avatar
Mart Lubbers committed
73 74 75
		ccall ttyclose "I:I:A"
	}

Mart Lubbers's avatar
Mart Lubbers committed
76 77 78
TTYread :: !*TTY -> (!Int, !*TTY)
TTYread _ = code {
		ccall ttyread "I:VII"
79
	}
Mart Lubbers's avatar
Mart Lubbers committed
80

Mart Lubbers's avatar
Mart Lubbers committed
81 82 83 84 85 86 87
TTYreadline :: !*TTY -> (!String, !*TTY)
TTYreadline tty = case TTYread tty of
	(10, tty) = ("", tty)
	(c, tty)
	# (rest, tty) = TTYreadline tty
	= ({#toChar c} +++ rest, tty)

Mart Lubbers's avatar
Mart Lubbers committed
88
TTYwrite :: !String !*TTY -> *TTY
Mart Lubbers's avatar
Mart Lubbers committed
89
TTYwrite _ _ = code {
Mart Lubbers's avatar
Mart Lubbers committed
90
		ccall ttywrite "SI:I"
Mart Lubbers's avatar
Mart Lubbers committed
91 92
	}

Mart Lubbers's avatar
Mart Lubbers committed
93 94 95 96 97
TTYavailable :: !*TTY -> (!Bool, !*TTY)
TTYavailable _ = code {
		ccall ttyavailable "I:VII"
	}

Mart Lubbers's avatar
Mart Lubbers committed
98
TTYerror :: !*env -> (!String, !*env)
Mart Lubbers's avatar
Mart Lubbers committed
99
TTYerror _ = code {
100
		ccall ttyerror ":VS:A"
Mart Lubbers's avatar
Mart Lubbers committed
101
	}