Commit 84087228 authored by Peter Achten's avatar Peter Achten
Browse files

(PA) improved module dependencies

parent 22cd226f
......@@ -5,7 +5,7 @@ implementation module osdocumentinterface
import StdMaybe, StdTuple
import clCrossCall_12, ostoolbar, oswindow
import clCrossCall_12, ostoolbar, ossystem, ostypes
from commondef import FatalError,String
from StdIOCommon import DocumentInterface, MDI, SDI, NDI
......
......@@ -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:
......
......@@ -7,7 +7,7 @@ implementation module osmenu
import StdBool, StdChar, StdClass, StdInt, StdString
import menuCrossCall_12
from osdocumentinterface import OSMenuBar
from oswindow import OSWindowPtr, OSNoWindowPtr
from ostypes import OSWindowPtr, OSNoWindowPtr
// Types for menus and menu elements:
......
......@@ -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)
......@@ -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
......@@ -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
......
......@@ -14,3 +14,5 @@ definition module ostypes
:== HWND
:: HWND
:== Int
OSNoWindowPtr :== -1
......@@ -14,3 +14,5 @@ implementation module ostypes
:== HWND
:: HWND
:== Int
OSNoWindowPtr :== -1
......@@ -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
......
......@@ -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.
*/
......
......@@ -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 oswindow import OSNoWindowPtr, OSWindowPtr
from ostypes import OSNoWindowPtr, OSWindowPtr
import deviceevents, iostate
from commondef import FatalError
from processstack import topShowProcessShowState
......
......@@ -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
......
......@@ -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
......
......@@ -6,9 +6,9 @@ implementation module StdControlReceiver
import StdTuple
import StdControlClass, StdReceiverAttribute, windowhandle
from commondef import Select, Cond
from receiveraccess import newReceiverHandle, newReceiverHandle2
from oswindow import OSNoWindowPtr
from commondef import Select, Cond
from receiveraccess import newReceiverHandle, newReceiverHandle2
from ostypes import OSNoWindowPtr
instance Controls (Receiver m) where
......
......@@ -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
......
......@@ -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
......
......@@ -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)