Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-compiler-and-rts
stdenv
Commits
84087228
Commit
84087228
authored
Dec 01, 1999
by
Peter Achten
Browse files
(PA) improved module dependencies
parent
22cd226f
Changes
53
Hide whitespace changes
Inline
Side-by-side
ObjectIO/ObjectIO/OS Windows/osdocumentinterface.icl
View file @
84087228
...
...
@@ -5,7 +5,7 @@ implementation module osdocumentinterface
import
StdMaybe
,
StdTuple
import
clCrossCall_12
,
ostoolbar
,
os
window
import
clCrossCall_12
,
ostoolbar
,
os
system
,
ostypes
from
commondef
import
FatalError
,
String
from
StdIOCommon
import
DocumentInterface
,
MDI
,
SDI
,
NDI
...
...
ObjectIO/ObjectIO/OS Windows/osmenu.dcl
View file @
84087228
...
...
@@ -7,8 +7,7 @@ definition module osmenu
from
menuCrossCall_12
import
HMENU
,
HITEM
from
osdocumentinterface
import
OSMenuBar
from
ostoolbox
import
OSToolbox
from
ostypes
import
HWND
from
oswindow
import
OSWindowPtr
from
ostypes
import
HWND
,
OSWindowPtr
// Types for menus and menu elements:
...
...
ObjectIO/ObjectIO/OS Windows/osmenu.icl
View file @
84087228
...
...
@@ -7,7 +7,7 @@ implementation module osmenu
import
StdBool
,
StdChar
,
StdClass
,
StdInt
,
StdString
import
menuCrossCall_12
from
osdocumentinterface
import
OSMenuBar
from
os
window
import
OSWindowPtr
,
OSNoWindowPtr
from
os
types
import
OSWindowPtr
,
OSNoWindowPtr
// Types for menus and menu elements:
...
...
ObjectIO/ObjectIO/OS Windows/ossystem.dcl
View file @
84087228
...
...
@@ -2,9 +2,25 @@ definition module ossystem
// Clean Object I/O library, version 1.2
from
StdString
import
String
from
ostypes
import
Rect
from
ostoolbox
import
OSToolbox
from
StdString
import
String
from
StdMaybe
import
Maybe
,
Just
,
Nothing
from
menuCrossCall_12
import
HMENU
from
osdocumentinterface
import
OSDInfo
,
OSMDInfo
,
OSSDInfo
,
OSInfo
,
OSToolbar
,
OSToolbarHandle
from
osfont
import
Font
from
ostoolbox
import
OSToolbox
from
ostypes
import
Rect
,
HWND
::
OSWindowMetrics
=
{
osmFont
::
Font
// The internal Font used in Windows for controls
,
osmFontMetrics
::
(
Int
,
Int
,
Int
)
// The ascent, descent, leading of osmFont
,
osmHeight
::
Int
// The height of the internal Font
,
osmHorMargin
::
Int
// The default horizontal margin
,
osmVerMargin
::
Int
// The default vertical margin
,
osmHorItemSpace
::
Int
// The default horizontal item space
,
osmVerItemSpace
::
Int
// The default vertical item space
,
osmHSliderHeight
::
Int
// The default height of a horizontal slider control
,
osmVSliderWidth
::
Int
// The default width of a vertical slider control
}
OSdirseparator
:==
'\\'
...
...
@@ -23,3 +39,14 @@ OSscreenrect :: !*OSToolbox -> (!Rect,!*OSToolbox)
OSprintSetupTypical
::
Bool
// MW11++
OSrefreshDesktop
::
!*
OSToolbox
->
*
OSToolbox
// OSGetProcessWindowDimensions returns Rect of process window in terms of screen coordinates
OSGetProcessWindowDimensions
::
!
OSDInfo
!*
OSToolbox
->
(!
Rect
,!*
OSToolbox
)
OSDefaultWindowMetrics
::
!*
OSToolbox
->
(!
OSWindowMetrics
,!*
OSToolbox
)
/* OSstripOuterSize isMDI isResizable
returns (dw,dh) required to add/subtract to view/outer size in order to obtain outer/view size.
*/
OSstripOuterSize
::
!
Bool
!
Bool
!*
OSToolbox
->
(!(!
Int
,!
Int
),!*
OSToolbox
)
ObjectIO/ObjectIO/OS Windows/ossystem.icl
View file @
84087228
...
...
@@ -2,10 +2,25 @@ implementation module ossystem // for Windows
// Clean Object I/O library, version 1.2
import
StdInt
,
StdReal
,
StdString
import
clCCall_12
,
clCrossCall_12
import
StdBool
,
StdInt
,
StdReal
,
StdString
import
StdMaybe
import
clCCall_12
,
clCrossCall_12
,
windowCrossCall_12
import
osdocumentinterface
,
osfont
from
ostypes
import
Rect
::
OSWindowMetrics
=
{
osmFont
::
Font
// The internal Font used in Windows for controls
,
osmFontMetrics
::
(
Int
,
Int
,
Int
)
// The ascent, descent, leading of osmFont
,
osmHeight
::
Int
// The height of the internal Font
,
osmHorMargin
::
Int
// The default horizontal margin
,
osmVerMargin
::
Int
// The default vertical margin
,
osmHorItemSpace
::
Int
// The default horizontal item space
,
osmVerItemSpace
::
Int
// The default vertical item space
,
osmHSliderHeight
::
Int
// The default height of a horizontal slider control
,
osmVSliderWidth
::
Int
// The default width of a vertical slider control
}
OSdirseparator
:==
'\\'
// OS separator between folder- and filenames in a pathname
OShomepath
::
!
String
->
String
...
...
@@ -47,3 +62,51 @@ OSprintSetupTypical = False
OSrefreshDesktop
::
!*
OSToolbox
->
*
OSToolbox
OSrefreshDesktop
tb
=
WinRefreshDesktop
tb
OSGetProcessWindowDimensions
::
!
OSDInfo
!*
OSToolbox
->
(!
Rect
,!*
OSToolbox
)
OSGetProcessWindowDimensions
osdinfo
tb
#
maybeOSInfo
=
getOSDInfoOSInfo
osdinfo
|
isNothing
maybeOSInfo
=
OSscreenrect
tb
|
otherwise
#
osinfo
=
fromJust
maybeOSInfo
#
((
x
,
y
),
tb
)
=
WinGetWindowPos
osinfo
.
osFrame
tb
#
((
w
,
h
),
tb
)
=
WinGetClientSize
osinfo
.
osClient
tb
=
({
rleft
=
x
,
rtop
=
y
,
rright
=
x
+
w
,
rbottom
=
y
+
h
},
tb
)
OSDefaultWindowMetrics
::
!*
OSToolbox
->
(!
OSWindowMetrics
,!*
OSToolbox
)
OSDefaultWindowMetrics
tb
#
(
font
,
tb
)
=
OSdialogfont
tb
#
((
ascent
,
descent
,
leading
,_),
tb
)
=
OSgetfontmetrics
False
0
font
tb
height
=
ascent
+
descent
+
leading
unit
=
(
toReal
height
)/
8.0
margin
=
toInt
(
unit
*
7.0
)
itemspace
=
toInt
(
unit
*
4.0
)
#
(
scrollWidth
,
scrollHeight
,
tb
)
=
WinScrollbarSize
tb
=
(
{
osmFont
=
font
,
osmFontMetrics
=
(
ascent
,
descent
,
leading
)
,
osmHeight
=
height
,
osmHorMargin
=
margin
,
osmVerMargin
=
margin
,
osmHorItemSpace
=
itemspace
,
osmVerItemSpace
=
itemspace
,
osmHSliderHeight
=
scrollHeight
,
osmVSliderWidth
=
scrollWidth
}
,
tb
)
/* OSstripOuterSize isMDI isResizable (width,height)
returns (dw,dh) required to add/subtract to view size/outer size in order to obtain
outer size/view size.
*/
OSstripOuterSize
::
!
Bool
!
Bool
!*
OSToolbox
->
(!(!
Int
,!
Int
),!*
OSToolbox
)
OSstripOuterSize
isMDI
isResizable
tb
|
isMDI
#
(
dw
,
dh
,
tb
)
=
WinMDIClientToOuterSizeDims
styleFlags
tb
=
((
dw
,
dh
),
tb
)
|
otherwise
#
(
dw
,
dh
,
tb
)
=
WinSDIClientToOuterSizeDims
styleFlags
tb
=
((
dw
,
dh
),
tb
)
where
styleFlags
=
if
isResizable
WS_THICKFRAME
0
ObjectIO/ObjectIO/OS Windows/ostoolbar.icl
View file @
84087228
...
...
@@ -7,8 +7,7 @@ implementation module ostoolbar
import
StdMisc
,
StdTuple
from
osbitmap
import
OSBitmap
,
OSgetBitmapSize
,
OSgetBitmapContent
from
ostypes
import
HWND
from
oswindow
import
OSNoWindowPtr
from
ostypes
import
HWND
,
OSWindowPtr
,
OSNoWindowPtr
from
pictCCall_12
import
WinCreateBitmap
import
clCrossCall_12
,
windowCrossCall_12
...
...
ObjectIO/ObjectIO/OS Windows/ostypes.dcl
View file @
84087228
...
...
@@ -14,3 +14,5 @@ definition module ostypes
:==
HWND
::
HWND
:==
Int
OSNoWindowPtr
:==
-1
ObjectIO/ObjectIO/OS Windows/ostypes.icl
View file @
84087228
...
...
@@ -14,3 +14,5 @@ implementation module ostypes
:==
HWND
::
HWND
:==
Int
OSNoWindowPtr
:==
-1
ObjectIO/ObjectIO/OS Windows/oswindow.dcl
View file @
84087228
...
...
@@ -4,23 +4,17 @@ definition module oswindow
// Clean Object I/O library, version 1.2
from
StdMaybe
import
Maybe
,
Just
,
Nothing
from
StdString
import
String
from
StdOverloaded
import
==
from
menuCrossCall_12
import
HMENU
from
StdMaybe
import
Maybe
,
Just
,
Nothing
from
osdocumentinterface
import
OSDInfo
,
OSMDInfo
,
OSSDInfo
,
OSInfo
,
OSToolbar
,
OSToolbarHandle
,
HMENU
,
HWND
from
osevent
import
OSEvent
,
CrossCallInfo
from
osfont
import
Font
from
osrgn
import
OSRgnHandle
from
ossystem
import
OSWindowMetrics
from
ostoolbox
import
OSToolbox
from
ostypes
import
Rect
,
OSWindowPtr
,
HWND
from
ostypes
import
Rect
,
OSWindowPtr
from
ospicture
import
OSPictContext
from
osdocumentinterface
import
OSDInfo
,
OSMDInfo
,
OSSDInfo
,
OSInfo
,
OSToolbar
,
OSToolbarHandle
OSNoWindowPtr
:==
-1
// OSGetProcessWindowDimensions returns Rect of process window in terms of screen coordinates
OSGetProcessWindowDimensions
::
!
OSDInfo
!*
OSToolbox
->
(!
Rect
,!*
OSToolbox
)
/* System dependent constants:
...
...
@@ -30,27 +24,9 @@ OSControlTitleSpecialChars :== [] // Special prefix characters that should b
/* System dependent metrics:
*/
::
OSWindowMetrics
=
{
osmFont
::
Font
// The internal Font used in Windows for controls
,
osmFontMetrics
::
(
Int
,
Int
,
Int
)
// The ascent, descent, leading of osmFont
,
osmHeight
::
Int
// The height of the internal Font
,
osmHorMargin
::
Int
// The default horizontal margin
,
osmVerMargin
::
Int
// The default vertical margin
,
osmHorItemSpace
::
Int
// The default horizontal item space
,
osmVerItemSpace
::
Int
// The default vertical item space
,
osmHSliderHeight
::
Int
// The default height of a horizontal slider control
,
osmVSliderWidth
::
Int
// The default width of a vertical slider control
}
OSDefaultWindowMetrics
::
!*
OSToolbox
->
(!
OSWindowMetrics
,!*
OSToolbox
)
OSMinWindowSize
::
(!
Int
,!
Int
)
OSMinCompoundSize
::
(!
Int
,!
Int
)
/* OSstripOuterSize isMDI isResizable
returns (dw,dh) required to add/subtract to view/outer size in order to obtain outer/view size.
*/
OSstripOuterSize
::
!
Bool
!
Bool
!*
OSToolbox
->
(!(!
Int
,!
Int
),!*
OSToolbox
)
/* Determine the size of controls:
OSgetButtonControlSize windowmetrics title
...
...
ObjectIO/ObjectIO/OS Windows/oswindow.icl
View file @
84087228
...
...
@@ -17,21 +17,6 @@ oswindowFatalError function error
=
FatalError
function
"oswindow"
error
OSGetProcessWindowDimensions
::
!
OSDInfo
!*
OSToolbox
->
(!
Rect
,!*
OSToolbox
)
OSGetProcessWindowDimensions
osdinfo
tb
#
maybeOSInfo
=
getOSDInfoOSInfo
osdinfo
|
isNothing
maybeOSInfo
=
OSscreenrect
tb
|
otherwise
#
osinfo
=
fromJust
maybeOSInfo
#
((
x
,
y
),
tb
)
=
OSgetWindowPos
osinfo
.
osFrame
tb
#
((
w
,
h
),
tb
)
=
OSgetWindowViewFrameSize
osinfo
.
osClient
tb
=
({
rleft
=
x
,
rtop
=
y
,
rright
=
x
+
w
,
rbottom
=
y
+
h
},
tb
)
OSNoWindowPtr
:==
-1
/* System dependent constants:
*/
OSControlTitleSpecialChars
...
...
@@ -40,39 +25,6 @@ OSControlTitleSpecialChars
/* System dependent metrics:
*/
::
OSWindowMetrics
=
{
osmFont
::
Font
// The internal Font used in Windows for controls
,
osmFontMetrics
::
(
Int
,
Int
,
Int
)
// The ascent, descent, leading of osmFont
,
osmHeight
::
Int
// The height of the internal Font
,
osmHorMargin
::
Int
// The default horizontal margin
,
osmVerMargin
::
Int
// The default vertical margin
,
osmHorItemSpace
::
Int
// The default horizontal item space
,
osmVerItemSpace
::
Int
// The default vertical item space
,
osmHSliderHeight
::
Int
// The default height of a horizontal slider control
,
osmVSliderWidth
::
Int
// The default width of a vertical slider control
}
OSDefaultWindowMetrics
::
!*
OSToolbox
->
(!
OSWindowMetrics
,!*
OSToolbox
)
OSDefaultWindowMetrics
tb
#
(
font
,
tb
)
=
OSdialogfont
tb
#
((
ascent
,
descent
,
leading
,_),
tb
)
=
OSgetfontmetrics
False
0
font
tb
height
=
ascent
+
descent
+
leading
unit
=
(
toReal
height
)/
8.0
margin
=
toInt
(
unit
*
7.0
)
itemspace
=
toInt
(
unit
*
4.0
)
#
(
scrollWidth
,
scrollHeight
,
tb
)
=
WinScrollbarSize
tb
=
(
{
osmFont
=
font
,
osmFontMetrics
=
(
ascent
,
descent
,
leading
)
,
osmHeight
=
height
,
osmHorMargin
=
margin
,
osmVerMargin
=
margin
,
osmHorItemSpace
=
itemspace
,
osmVerItemSpace
=
itemspace
,
osmHSliderHeight
=
scrollHeight
,
osmVSliderWidth
=
scrollWidth
}
,
tb
)
OSMinWindowSize
::
(!
Int
,!
Int
)
OSMinWindowSize
=
WinMinimumWinSize
...
...
@@ -80,21 +32,6 @@ OSMinWindowSize = WinMinimumWinSize
OSMinCompoundSize
::
(!
Int
,!
Int
)
OSMinCompoundSize
=
(
0
,
0
)
// PA: (0,0)<--WinMinimumWinSize (Check if this safe)
/* OSstripOuterSize isMDI isResizable (width,height)
returns (dw,dh) required to add/subtract to view size/outer size in order to obtain
outer size/view size.
*/
OSstripOuterSize
::
!
Bool
!
Bool
!*
OSToolbox
->
(!(!
Int
,!
Int
),!*
OSToolbox
)
OSstripOuterSize
isMDI
isResizable
tb
|
isMDI
#
(
dw
,
dh
,
tb
)
=
WinMDIClientToOuterSizeDims
styleFlags
tb
=
((
dw
,
dh
),
tb
)
|
otherwise
#
(
dw
,
dh
,
tb
)
=
WinSDIClientToOuterSizeDims
styleFlags
tb
=
((
dw
,
dh
),
tb
)
where
styleFlags
=
if
isResizable
WS_THICKFRAME
0
/* Determine the size of controls.
*/
...
...
ObjectIO/ObjectIO/OS Windows/processevent.icl
View file @
84087228
...
...
@@ -11,7 +11,7 @@ implementation module processevent
import
StdArray
,
StdBool
,
StdList
from
clCrossCall_12
import
CcWmDDEEXECUTE
,
CcWmPROCESSCLOSE
,
CcWmPROCESSDROPFILES
from
clCCall_12
import
WinGetCStringAndFree
,
CSTR
from
os
window
import
OSNoWindowPtr
,
OSWindowPtr
from
os
types
import
OSNoWindowPtr
,
OSWindowPtr
import
deviceevents
,
iostate
from
commondef
import
FatalError
from
processstack
import
topShowProcessShowState
...
...
ObjectIO/ObjectIO/OS Windows/windowevent.icl
View file @
84087228
...
...
@@ -10,7 +10,8 @@ implementation module windowevent
import
StdBool
,
StdFunc
,
StdList
,
StdMisc
,
StdTuple
import
clCCall_12
,
clCrossCall_12
,
windowCrossCall_12
from
oswindow
import
OSNoWindowPtr
,
fromOSscrollbarRange
,
OSscrollbarsAreVisible
from
ostypes
import
OSNoWindowPtr
from
oswindow
import
fromOSscrollbarRange
,
OSscrollbarsAreVisible
import
commondef
,
controlcreate
,
deviceevents
,
iostate
,
windowaccess
from
StdControlAttribute
import
isControlKeyboard
,
getControlKeyboardAtt
,
isControlMouse
,
getControlMouseAtt
,
...
...
@@ -19,7 +20,6 @@ from StdPSt import accPIO
from
StdWindowAttribute
import
isWindowKeyboard
,
getWindowKeyboardAtt
,
isWindowMouse
,
getWindowMouseAtt
,
isWindowCursor
,
getWindowCursorAtt
from
windowupdate
import
updatewindow
windoweventFatalError
::
String
String
->
.
x
...
...
ObjectIO/ObjectIO/StdControlClass.icl
View file @
84087228
...
...
@@ -8,7 +8,7 @@ implementation module StdControlClass
import
StdBool
,
StdFunc
,
StdInt
,
StdList
,
StdMisc
,
StdTuple
import
commondef
,
controldefaccess
,
controlvalidate
,
id
,
iostate
,
StdControlDef
,
StdPSt
,
windowhandle
,
windowvalidate
import
ospicture
,
ossystem
,
oswindow
import
ospicture
,
ossystem
,
ostypes
,
oswindow
class
Controls
cdef
where
...
...
ObjectIO/ObjectIO/StdControlReceiver.icl
View file @
84087228
...
...
@@ -6,9 +6,9 @@ implementation module StdControlReceiver
import
StdTuple
import
StdControlClass
,
StdReceiverAttribute
,
windowhandle
from
commondef
import
Select
,
Cond
from
receiveraccess
import
newReceiverHandle
,
newReceiverHandle2
from
os
window
import
OSNoWindowPtr
from
commondef
import
Select
,
Cond
from
receiveraccess
import
newReceiverHandle
,
newReceiverHandle2
from
os
types
import
OSNoWindowPtr
instance
Controls
(
Receiver
m
)
where
...
...
ObjectIO/ObjectIO/StdIO.dcl
View file @
84087228
...
...
@@ -13,6 +13,7 @@ import
StdKey
,
// Function and type definitions on keyboard
StdMaybe
,
// The Maybe data type
StdPSt
,
// Operations on PSt that are not device related
StdPStClass
,
// PSt/IOSt instances of common classes
StdSystem
,
// System dependent operations
StdFileSelect
,
// File selector dialogues
...
...
ObjectIO/ObjectIO/StdPSt.dcl
View file @
84087228
...
...
@@ -8,33 +8,10 @@ definition module StdPSt
// ********************************************************************************
import
StdFile
,
StdFileSelect
,
StdSound
,
StdTime
from
StdFunc
import
St
from
StdIOBasic
import
IdFun
from
StdIOCommon
import
DocumentInterface
,
MDI
,
SDI
,
NDI
from
StdIOCommon
import
IdFun
,
DocumentInterface
,
MDI
,
SDI
,
NDI
from
StdPicture
import
Picture
from
iostate
import
PSt
,
IOSt
from
channelenv
import
ChannelEnv
// MW11++
/* PSt is an environment instance of the following classes:
- FileSystem (see StdFile)
- FileEnv (see StdFile)
- FileSelectEnv (see StdFileSelect)
- TimeEnv (see StdTime)
- playSoundFile (see StdSound)
- ChannelEnv (see StdChannels) // MW11++
- Ids (see StdId) // MW11++
IOSt is also an environment instance of the classes FileEnv, TimeEnv & ChannelEnv
*/
instance
FileSystem
(
PSt
.
l
)
instance
FileEnv
(
PSt
.
l
),
(
IOSt
.
l
)
// MW11 added IOSt
instance
FileSelectEnv
(
PSt
.
l
)
instance
TimeEnv
(
PSt
.
l
),
(
IOSt
.
l
)
// MW11 added IOSt
instance
playSoundFile
(
PSt
.
l
)
instance
ChannelEnv
(
PSt
.
l
),
(
IOSt
.
l
)
// MW11 added IOSt
instance
Ids
(
PSt
.
l
)
/* accScreenPicture provides access to an initial Picture as it would be created in
...
...
ObjectIO/ObjectIO/StdPSt.icl
View file @
84087228
...
...
@@ -4,236 +4,15 @@ implementation module StdPSt
// Clean Object I/O library, version 1.2
import
StdEnv
,
StdFileSelect
import
StdSound
,
StdTime
import
deviceevents
,
commondef
from
iostate
import
PSt
,
IOSt
,
appIOToolbox
,
accIOToolbox
,
IOStGetWorld
,
IOStSetWorld
,
IOStGetDocumentInterface
,
IOStGetProcessAttributes
,
IOStSetProcessAttributes
import
StdBool
,
StdFunc
import
commondef
,
iostate
from
StdIOCommon
import
IdFun
from
StdProcessAttribute
import
isProcessActivate
,
isProcessDeactivate
from
scheduler
import
handleOneEventForDevices
import
osbeep
,
osfileselect
from
clCCall_12
import
WinPlaySound
from
osbeep
import
OSBeep
from
ospicture
import
peekScreen
from
ostoolbox
import
OSNewToolbox
,
WorldGetToolbox
,
WorldSetToolbox
import
StdReceiver
,
receiverid
,
receiverhandle
,
receiverdevice
,
channelenv
// MW11++
from
ostoolbox
import
OSToolbox
,
WorldGetToolbox
,
WorldSetToolbox
/* PSt is an environment instance of the class FileEnv (see StdFile).
*/
instance
FileSystem
(
PSt
.
l
)
where
fopen
::
!{#
Char
}
!
Int
!(
PSt
.
l
)
->
(!
Bool
,!*
File
,!
PSt
.
l
)
fopen
fName
fMode
pState
#
((
ok
,
file
),
pState
)
=
accFiles
(
fopen`
fName
fMode
)
pState
=
(
ok
,
file
,
pState
)
where
fopen`
::
!{#
Char
}
!
Int
!*
Files
->
(!(!
Bool
,!*
File
),!*
Files
)
fopen`
fName
fMode
files
#
(
ok
,
file
,
files
)
=
fopen
fName
fMode
files
=
((
ok
,
file
),
files
)
fclose
::
!*
File
!(
PSt
.
l
)
->
(!
Bool
,!
PSt
.
l
)
fclose
file
pState
=
accFiles
(
fclose
file
)
pState
stdio
::
!(
PSt
.
l
)
->
(!*
File
,!
PSt
.
l
)
stdio
pState
=
accFiles
stdio
pState
sfopen
::
!{#
Char
}
!
Int
!(
PSt
.
l
)
->
(!
Bool
,!
File
,!
PSt
.
l
)
sfopen
fName
fMode
pState
#
((
ok
,
sfile
),
pState
)
=
accFiles
(
sfopen`
fName
fMode
)
pState
=
(
ok
,
sfile
,
pState
)
where
sfopen`
::
!{#
Char
}
!
Int
!*
Files
->
(!(!
Bool
,!
File
),!*
Files
)
sfopen`
fName
fMode
files
#
(
ok
,
file
,
files
)
=
sfopen
fName
fMode
files
=
((
ok
,
file
),
files
)
/* PSt is an environment instance of the class FileEnv (see StdFile).
*/
instance
FileEnv
(
PSt
.
l
)
where
accFiles
::
!.(*
Files
->
(.
x
,*
Files
))
!*(
PSt
.
l
)
->
(!.
x
,!*
PSt
.
l
)
accFiles
accfun
pState
=:{
io
}
#
(
world
,
io
)
=
IOStGetWorld
io
(
x
,
world
)
=
accFiles
accfun
world
pState
=
{
pState
&
io
=
IOStSetWorld
world
io
}
=
(
x
,
pState
)
appFiles
::
!.(*
Files
->
*
Files
)
!*(
PSt
.
l
)
->
*
PSt
.
l
appFiles
appfun
pState
=:{
io
}
#
(
world
,
io
)
=
IOStGetWorld
io
world
=
appFiles
appfun
world
pState
=
{
pState
&
io
=
IOStSetWorld
world
io
}
=
pState
// MW11..
instance
FileEnv
(
IOSt
.
l
)
where
accFiles
accfun
io
#
(
world
,
io
)
=
IOStGetWorld
io
(
x
,
world
)
=
accFiles
accfun
world
io
=
IOStSetWorld
world
io
=
(
x
,
io
)
appFiles
appfun
io
#
(
world
,
io
)
=
IOStGetWorld
io
world
=
appFiles
appfun
world
io
=
IOStSetWorld
world
io
=
io
// ..MW11
/* PSt is an environment instance of the class FileSelectEnv (see StdFileSelect).
*/
instance
FileSelectEnv
(
PSt
.
l
)
where
selectInputFile
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!
PSt
.
l
)
selectInputFile
pState
#
(
ok
,
name
,
pState
,_)
=
OSselectinputfile
handleOSEvent
pState
OSNewToolbox
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
selectOutputFile
::
!
String
!
String
!(
PSt
.
l
)
->
(!
Maybe
String
,!
PSt
.
l
)
selectOutputFile
prompt
originalName
pState
#
(
ok
,
name
,
pState
,_)
=
OSselectoutputfile
handleOSEvent
pState
prompt
originalName
OSNewToolbox
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
selectDirectory
::
!(
PSt
.
l
)
->
(!
Maybe
String
,!
PSt
.
l
)
selectDirectory
pState
#
(
ok
,
name
,
pState
,_)
=
OSselectdirectory
handleOSEvent
pState
OSNewToolbox
=
(
if
ok
(
Just
name
)
Nothing
,
pState
)
// handleOSEvent turns handleOneEventForDevices into the form required by OSselect(in/out)putfile.
handleOSEvent
::
!
OSEvent
!(
PSt
.
l
)
->
PSt
.
l
handleOSEvent
osEvent
pState
=
thd3
(
handleOneEventForDevices
(
ScheduleOSEvent
osEvent
[])
pState
)
/* PSt is an environment instance of the class TimeEnv (see StdTime).
*/
/* MW11 was
instance TimeEnv (PSt .l) where
getBlinkInterval :: !(PSt .l) -> (!Int,!PSt .l)
getBlinkInterval pState=:{io}
# (world,io) = IOStGetWorld io
# (blink,world) = getBlinkInterval world
# pState = {pState & io=IOStSetWorld world io}
= (blink,pState)
getCurrentTime :: !(PSt .l) -> (!Time,!PSt .l)
getCurrentTime pState=:{io}
# (world,io) = IOStGetWorld io
# (time,world) = getCurrentTime world
# pState = {pState & io=IOStSetWorld world io}
= (time,pState)
getCurrentDate :: !(PSt .l) -> (!Date,!PSt .l)
getCurrentDate pState=:{io}
# (world,io) = IOStGetWorld io
# (date,world) = getCurrentDate world
# pState = {pState & io=IOStSetWorld world io}
= (date,pState)
*/
instance
TimeEnv
(
PSt
.
l
)
where
getBlinkInterval
::
!(
PSt
.
l
)
->
(!
Int
,!
PSt
.
l
)
getBlinkInterval
pState
=
accPIO
getBlinkInterval
pState
getCurrentTime
::
!(
PSt
.
l
)
->
(!
Time
,!
PSt
.
l
)
getCurrentTime
pState
=
accPIO
getCurrentTime
pState
getCurrentDate
::
!(
PSt
.
l
)
->
(!
Date
,!
PSt
.
l
)
getCurrentDate
pState
=
accPIO
getCurrentDate
pState
getCurrentTick
::
!(
PSt
.
l
)
->
(!
Tick
,!
PSt
.
l
)
getCurrentTick
pState
=
accPIO
getCurrentTick
pState
// MW11..
instance
TimeEnv
(
IOSt
.
l
)
where
getBlinkInterval
::
!(
IOSt
.
l
)
->
(!
Int
,!
IOSt
.
l
)
getBlinkInterval
io
#
(
world
,
io
)
=
IOStGetWorld
io
(
blink
,
world
)
=
getBlinkInterval
world
=
(
blink
,
IOStSetWorld
world
io
)
getCurrentTime
::
!(
IOSt
.
l
)
->
(!
Time
,!
IOSt
.
l
)