ostime.icl 1.97 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
implementation module ostime

//	Clean Object I/O library, version 1.2

import	StdClass, StdInt, StdOverloaded
import	ostoolbox

::	OSTime
	=	OSTime !Int

OSMaxTickCount	:==	2^31-1

OSMaxTime :: OSTime
OSMaxTime = OSTime OSMaxTickCount

OSGetTime :: !*OSToolbox -> (!OSTime,!*OSToolbox)
OSGetTime tb
	# (tickcount,tb)	= GetMessageTime tb
	= (OSTime tickcount,tb)
where
	GetMessageTime :: !*OSToolbox -> (!Int,!*OSToolbox)
	GetMessageTime tb = WinGetTickCount tb

OSWait :: !Int .x !*OSToolbox -> (.x,!*OSToolbox)
OSWait delay x tb
	= (x,WinWait delay tb)

OSGetBlinkInterval :: !*OSToolbox -> (!Int,!*OSToolbox)
OSGetBlinkInterval tb
	= WinGetBlinkTime tb

OSGetCurrentTime :: !*OSToolbox -> (!(!Int,!Int,!Int),!*OSToolbox)
OSGetCurrentTime tb
	= WinGetTime tb

OSGetCurrentDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
OSGetCurrentDate tb
	= WinGetDate tb

instance - OSTime where
	(-) :: !OSTime !OSTime -> OSTime
	(-) (OSTime new) (OSTime old)
		| old<=new
			= OSTime (new-old)
			= OSTime (OSMaxTickCount-old+new)

47
48
49
50
51
instance < OSTime where
	(<) :: !OSTime !OSTime -> Bool
	(<) (OSTime t1) (OSTime t2)
		= t1<t2

Peter Achten's avatar
Peter Achten committed
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
instance toInt OSTime where
	toInt :: !OSTime -> Int
	toInt (OSTime t) = t

instance fromInt OSTime where
	fromInt :: !Int -> OSTime
	fromInt t = OSTime (max 0 t)


WinGetTime :: !*OSToolbox -> (!(!Int,!Int,!Int),!*OSToolbox)
WinGetTime tb
	= code
	{
		.inline WinGetTime
			ccall WinGetTime "I-IIII"
		.end
	}

WinGetDate :: !*OSToolbox -> (!(!Int,!Int,!Int,!Int),!*OSToolbox)
WinGetDate tb
	= code
	{
		.inline WinGetDate
			ccall WinGetDate "I-IIIII"
		.end
	}

WinWait :: !Int !*OSToolbox -> *OSToolbox
WinWait i tb
	= code
	{
		.inline WinWait
			ccall WinWait "II-I"
		.end
	}

WinGetBlinkTime :: !*OSToolbox -> (!Int,!*OSToolbox)
WinGetBlinkTime tb
	= code
	{
		.inline WinGetBlinkTime
			ccall WinGetBlinkTime "I-II"
		.end
	}

WinGetTickCount ::  !*OSToolbox -> (!Int, !*OSToolbox)
WinGetTickCount _
	= code
	{
		.inline WinGetTickCount
			ccall WinGetTickCount "I-II"
		.end
	}