Platform.icl 4.04 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
implementation module Platform

Diederik van Arkel's avatar
Diederik van Arkel committed
3
import StdInt, StdMisc, StdFile
4
import StdTuple,StdOverloaded,StdArray
Diederik van Arkel's avatar
Diederik van Arkel committed
5
import StdPSt
Diederik van Arkel's avatar
Diederik van Arkel committed
6
7
import StdIOCommon
import StdSystem
Diederik van Arkel's avatar
Diederik van Arkel committed
8

Diederik van Arkel's avatar
Diederik van Arkel committed
9
10
PlatformDependant win mac
	:== mac
Diederik van Arkel's avatar
Diederik van Arkel committed
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

initPlatformCommandLine :: !*(PSt .l) -> (![String],!*PSt .l)
initPlatformCommandLine ps
	= ([],ps)

installPlatformEventHandlers :: !*(PSt .l) -> *(PSt .l)
installPlatformEventHandlers ps
	| install_apple_event_handlers == 0
//		= trace_n "apple events installed" ps
		= ps
//	= trace_n "installing apple events failed :-(" ps
	= ps

openPlatformWindowMenu :: !*(PSt .l) -> *(PSt .l)
openPlatformWindowMenu ps
	= ps
//	= openWindowMenu ps

29
// FIXME: should be IdePlatform
Diederik van Arkel's avatar
Diederik van Arkel committed
30
31
32
33
34
35
36
37
batchOptions	:: !*World -> (!Bool,Bool,String,*File,!*World)
batchOptions world
	# interact		= True
	  force_update	= undef
	  prj_name		= undef
	  logfile		= undef
	= (interact,force_update,prj_name,logfile,world)

38
// FIXME: should be IdePlatform
Diederik van Arkel's avatar
Diederik van Arkel committed
39
40
41
42
43
44
wAbort			:: !String !*World -> *World
wAbort message world
	# stderr	= fwrites message stderr
	# (_,world)	= fclose stderr world
	= world

45
// FIXME: should be IdePlatform
Diederik van Arkel's avatar
Diederik van Arkel committed
46
47
48
pAbort			:: !(PSt .a) -> PSt .a
pAbort ps = ps

Diederik van Arkel's avatar
Diederik van Arkel committed
49
50
51
52
53
54
install_apple_event_handlers :: Int
install_apple_event_handlers
	= code ()(r=D0) {
		call	.install_apple_event_handlers
	}

Diederik van Arkel's avatar
Diederik van Arkel committed
55
56
TempDir	:: String
TempDir = applicationpath "Temp"
Diederik van Arkel's avatar
Diederik van Arkel committed
57
58
59
60
61
62

EnvsDir		:: String
EnvsDir = applicationpath "Config"

PrefsDir	:: String
PrefsDir = applicationpath "Config"
Diederik van Arkel's avatar
Diederik van Arkel committed
63
64
65

BitmapDir	:: String
BitmapDir = applicationpath "Bitmaps"
Diederik van Arkel's avatar
Diederik van Arkel committed
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

//////////////

//import dodebug
trace_n` _ f :== f

import windowaccess, iostate, StdBool,menuwindowmenu
import code from library "winmod_library"

getWindowModified :: !Id !(IOSt .l) -> (!Maybe Bool,!IOSt .l)
getWindowModified id ioState
	# (found,wDevice,ioState)	= ioStGetDevice WindowDevice ioState
	| not found
		= (Nothing,ioState)
	# windows					= windowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= (Nothing,ioStSetDevice (WindowSystemState windows) ioState)
	| otherwise
		# (mod,wsH,ioState)		= getWindowModified wsH ioState
		= (Just mod,ioStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
where
	getWindowModified wsH=:{wshIds={wPtr}} ioState
		# (mod,ioState)			= accIOToolbox (IsWindowModified wPtr) ioState
90
		= trace_n` ("getWindowModified",wPtr,mod) (mod<>0,wsH,ioState)
Diederik van Arkel's avatar
Diederik van Arkel committed
91
	
92
	IsWindowModified :: !OSWindowPtr !*OSToolbox -> (!Int,!*OSToolbox)
Diederik van Arkel's avatar
Diederik van Arkel committed
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
	IsWindowModified wPtr ioState = code {
		ccall IsWindowModified "PI:I:I"
		}

setWindowModified :: !Id !String !Bool !(IOSt .l) -> IOSt .l
setWindowModified id windowName mod ioState
	# windowTitle				= if mod (""+++windowName) windowName
	# ioState					= changeWindowInWindowMenu id windowTitle ioState

	# (found,wDevice,ioState)	= ioStGetDevice WindowDevice ioState
	| not found
		= ioState
	# windows					= windowSystemStateGetWindowHandles wDevice
	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
	| not found
		= ioStSetDevice (WindowSystemState windows) ioState
	| otherwise
		# (wsH,ioState)			= setWindowModified wsH mod ioState
		= ioStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
where
	setWindowModified wsH=:{wshIds={wPtr}} mod ioState
		# (err,ioState)			= accIOToolbox (SetWindowModified wPtr (if mod (1 << 24) 0)) ioState
		= trace_n` ("setWindowModified",wPtr,mod,err) (wsH,ioState)
	
	SetWindowModified :: !OSWindowPtr !Int !*OSToolbox -> (!OSStatus,!*OSToolbox)
	SetWindowModified wPtr mod ioState = code {
		ccall SetWindowModified "PII:I:I"
		}

:: OSStatus	:== Int
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

onOSX :: Bool
onOSX =: fst (runningCarbonOSX OSNewToolbox)

runningCarbonOSX tb
	# (err,res,tb)	= Gestalt "sysv" tb
	| err <> 0 = abort "Gestalt failed.\n"
	= (res >= 0x01000, tb)

Gestalt :: !String !*Int -> (!Int,!Int,!*Int)
Gestalt sSel tb
	| size sSel <> 4 = abort "Gestalt not called with four-char selector.\n"
	# iSel	= ((toInt sSel.[0]) << 24) bitor ((toInt sSel.[1]) << 16) bitor ((toInt sSel.[2]) << 8) bitor ((toInt sSel.[3]) << 0)
	= Gestalt iSel tb
where
	Gestalt :: !Int !*Int -> (!Int,!Int,!*Int)
	Gestalt _ _ = code {
		ccall Gestalt "PI:II:I"
		}