Commit 70c977fd authored by Peter Achten's avatar Peter Achten
Browse files

(PA) improved module dependencies

parent 84087228
......@@ -8,7 +8,7 @@ definition module StdControlDef
// ********************************************************************************
import StdIOCommon
import StdIOCommon, StdPictureDef
:: ButtonControl ls pst
......
......@@ -6,7 +6,7 @@ implementation module StdControlDef
// Definition of controls.
import StdIOCommon
import StdIOCommon, StdPictureDef
:: ButtonControl ls pst = ButtonControl String [ControlAttribute *(ls,pst)]
......
......@@ -62,7 +62,7 @@ instance toVector Size // {w,h}->{vx=w,vy=h}
instance toString Size
:: Point2
:: Point2
= { x :: !Int
, y :: !Int
}
......
......@@ -10,7 +10,7 @@ definition module StdIOCommon
import StdOverloaded, StdString
import StdBitmap, StdIOBasic, StdKey, StdMaybe
from id import Id, RId, R2Id, RIdtoId, R2IdtoId, toString, ==
from id import Id, RId, R2Id, RIdtoId, R2IdtoId, toString, ==
/* The SelectState and MarkState types. */
......
......@@ -10,7 +10,7 @@ definition module StdId
from StdMaybe import Maybe, Just, Nothing
from id import Id, RId, R2Id, RIdtoId, R2IdtoId, toString, ==
from iostate import IOSt
from iostate import PSt, IOSt
class Ids env where
openId :: !*env -> (!Id, !*env)
......@@ -34,6 +34,7 @@ class Ids env where
instance Ids World
instance Ids (IOSt .l)
instance Ids (PSt .l)
getParentId :: !Id !(IOSt .l) -> (!Maybe Id,!IOSt .l)
/* getParentId returns the Id of the parent top-level GUI object
......
......@@ -4,7 +4,7 @@ implementation module StdId
// Clean Object I/O library, version 1.2
import StdBool, StdInt, StdEnum
import id, iostate, world
import id, iostate, StdPSt, world
class Ids env where
......@@ -83,6 +83,14 @@ instance Ids (IOSt .l) where
# (idseed,ioState) = IOStGetIdSeed ioState
= ([toR2Id nr \\ nr<-[idseed-n+1..idseed]],IOStSetIdSeed (idseed-n) ioState)
instance Ids (PSt .l) where
openId pSt = accPIO openId pSt
openIds i pSt=:{io} = accPIO (openIds i) pSt
openRId pSt = accPIO openRId pSt
openRIds i pSt = accPIO (openRIds i) pSt
openR2Id pSt = accPIO openR2Id pSt
openR2Ids i pSt = accPIO (openR2Ids i) pSt
getParentId :: !Id !(IOSt .l) -> (!Maybe Id,!IOSt .l)
getParentId id ioState
......
definition module StdPStClass
// ********************************************************************************
// Clean Standard Object I/O library, version 1.2
//
// StdPStClass collects (PSt .l) and (IOSt .l) class instances.
// ********************************************************************************
import StdFile, StdFileSelect, StdSound, StdTime
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
implementation module StdPStClass
// Clean Object I/O library, version 1.2
import StdFile, StdTuple
import iostate, StdFileSelect, StdSound, StdTime
from scheduler import handleOneEventForDevices
from StdPSt import accPIO
from clCCall_12 import WinPlaySound
import osfileselect
from ostoolbox import OSNewToolbox
/* 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)
getCurrentTime io
# (world,io) = IOStGetWorld io
(time,world) = getCurrentTime world
= (time,IOStSetWorld world io)
getCurrentDate :: !(IOSt .l) -> (!Date,!IOSt .l)
getCurrentDate io
# (world,io) = IOStGetWorld io
(date,world) = getCurrentDate world
= (date, IOStSetWorld world io)
getCurrentTick :: !(IOSt .l) -> (!Tick,!IOSt .l)
getCurrentTick io
# (world,io) = IOStGetWorld io
(tick,world) = getCurrentTick world
= (tick, IOStSetWorld world io)
// ..MW11
instance playSoundFile (PSt .l) where
playSoundFile :: !String !(PSt .l) -> (!Bool,!PSt .l)
playSoundFile soundFileName pState=:{io}
# (ok,io) = accIOToolbox (WinPlaySound soundFileName) io
= (ok,{pState & io=io})
......@@ -9,6 +9,7 @@ definition module StdProcess
import StdProcessDef
from iostate import PSt, IOSt
/* General process topology creation functions:
......
......@@ -9,7 +9,7 @@ definition module StdWindowDef
// ********************************************************************************
import StdIOCommon
import StdIOCommon, StdPictureDef
:: Dialog c ls pst = Dialog Title (c ls pst) [WindowAttribute *(ls,pst)]
......
......@@ -6,7 +6,7 @@ implementation module StdWindowDef
// Window definitions.
import StdIOCommon
import StdIOCommon, StdPictureDef
:: Dialog c ls pst = Dialog Title (c ls pst) [WindowAttribute *(ls,pst)]
......
definition module channelenv
import StdFile
from StdTime import TimeEnv, Date, Tick, Time
from StdId import Ids
import id
class ChannelEnv env | Ids env & TimeEnv env & FileEnv env
where
channelEnvKind :: !*env -> (!Int, !*env)
mb_close_inet_receiver_without_id :: !Bool !(!Int, !Int) !*env -> *env
// :: !Bool !(!EndpointRef, !InetReceiverCategory) !*env -> *env
// mb_close_inet_receiver_without_id:
// iff the Boolean is True, this function closes the receiver, which is identified through
// the (!EndpointRef, !InetReceiverCategory) pair
//channelEnvKind can return the following values:
WORLD :== 0
IOST :== 1
PST :== 2
implementation module channelenv
import StdFile
import id
import StdTime
from StdId import Ids
class ChannelEnv env | Ids env & TimeEnv env & FileEnv env
where
channelEnvKind :: !*env -> (!Int, !*env)
mb_close_inet_receiver_without_id :: !Bool !(!Int, !Int) !*env -> *env
//channelEnvKind can return the following values:
// (some C functions rely on these values)
WORLD :== 0
IOST :== 1
PST :== 2
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment