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

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 |
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
44
		(filter (\s->startsWith "COM" s && size s > 3 && isDigit s.[3]) ds)
45 46 47
		(map ((+++) "/dev/") (filter isTTY ds))
	  , w)
where
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

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
	}