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

Mart Lubbers's avatar
Mart Lubbers committed
3
4
import StdEnv

5
6
import System.OS
import Text
Mart Lubbers's avatar
Mart Lubbers committed
7

Mart Lubbers's avatar
Mart Lubbers committed
8
import Platform
Mart Lubbers's avatar
Mart Lubbers committed
9

10
import code from "ctty.o"
Mart Lubbers's avatar
Mart Lubbers committed
11
12
13
14
15

:: *TTY :== Int

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

instance toInt BaudRate where
Mart Lubbers's avatar
Mart Lubbers committed
25
26
27
28
29
	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
30
31

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

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

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

50
51
52
makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool Int -> TTYSettings
makeTTYSettings dp br bs pr sb xx st = {TTYSettings | devicePath=dp, baudrate=br,
	bytesize=bs, parity=pr, stop2bits=sb, xonxoff=xx, sleepTime=st}
53

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

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

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

Mart Lubbers's avatar
Mart Lubbers committed
80
81
82
83
84
85
86
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
87
TTYwrite :: !String !*TTY -> *TTY
Mart Lubbers's avatar
Mart Lubbers committed
88
TTYwrite _ _ = code {
Mart Lubbers's avatar
Mart Lubbers committed
89
		ccall ttywrite "SI:I"
Mart Lubbers's avatar
Mart Lubbers committed
90
91
	}

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

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