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

no message

parent d661e784
...@@ -23,8 +23,6 @@ import bounceDraw ...@@ -23,8 +23,6 @@ import bounceDraw
, barrel :: !Barrel // the shape of the barrel , barrel :: !Barrel // the shape of the barrel
, balls :: ![Ball] // the balls in the barrel , balls :: ![Ball] // the balls in the barrel
} }
:: NoState // NoState is a simple singleton type constructor
= NoState
:: *Bounce :: *Bounce
:== PSt Local // Synonym for PSt :== PSt Local // Synonym for PSt
......
...@@ -11,20 +11,17 @@ module clipboardview ...@@ -11,20 +11,17 @@ module clipboardview
import StdEnv // Import all standard library modules import StdEnv // Import all standard library modules
import StdIO // Import all standard gui library modules import StdIO // Import all standard gui library modules
:: NoState // NoState is a singleton type constructor
= NoState
Start :: *World -> *World // The main rule Start :: *World -> *World // The main rule
Start world Start world
# (ids,world) = openIds 3 world // Create 3 Id values # (ids,world) = openIds 3 world // Create 3 Id values
= startIO NDI // Evaluate an interactive process with: = startIO NDI // Evaluate an interactive process with:
NoState // no local process state Void // no local process state
(initialise ids) // the initialisation action (initialise ids) // the initialisation action
[] // only default attributes [] // only default attributes
world world
initialise ids pst initialise ids pst
# (error,pst) = openDialog NoState clipview pst // Open the clipview dialog # (error,pst) = openDialog Void clipview pst // Open the clipview dialog
| error<>NoError // In case of an error: | error<>NoError // In case of an error:
= closeProcess pst // terminate the interactive process = closeProcess pst // terminate the interactive process
| otherwise // Otherwise: | otherwise // Otherwise:
......
...@@ -10,16 +10,14 @@ module counter ...@@ -10,16 +10,14 @@ module counter
import StdEnv, StdIO import StdEnv, StdIO
:: NoState = NoState
Start :: *World -> *World Start :: *World -> *World
Start world Start world
= startIO NDI NoState initIO [] world = startIO NDI Void initIO [] world
initIO pst initIO pst
# (dialogid, pst) = accPIO openId pst # (dialogid, pst) = accPIO openId pst
# (displayid,pst) = accPIO openId pst # (displayid,pst) = accPIO openId pst
# (_,pst) = openDialog NoState (dialog dialogid displayid) pst # (_,pst) = openDialog Void (dialog dialogid displayid) pst
= pst = pst
where where
dialog dialogId displayId dialog dialogId displayId
......
...@@ -8,8 +8,8 @@ implementation module Help ...@@ -8,8 +8,8 @@ implementation module Help
// //
// ************************************************************************************************** // **************************************************************************************************
import StdArray, StdBool, StdFunc, StdInt, StdList, StdTuple, StdMisc import StdArray, StdBool, StdFile, StdFunc, StdInt, StdList, StdTuple, StdMisc
import StdId, StdProcess, StdPSt, StdSystem, StdWindow import StdId, StdProcess, StdPSt, StdPStClass, StdSystem, StdWindow
:: NoState = NoState :: NoState = NoState
:: InfoDef :== (Size,[InfoLine]) :: InfoDef :== (Size,[InfoLine])
...@@ -40,13 +40,6 @@ About :== False ...@@ -40,13 +40,6 @@ About :== False
Help :== True Help :== True
// fopen for use with accFiles
fopen2 fileName mode files
:== ((ok,file),files2)
where
(ok,file,files2)
= fopen fileName mode files
/* showAbout opens a window: /* showAbout opens a window:
- it has the title of the application name (String argument 1), - it has the title of the application name (String argument 1),
- it displays the about information of the application (found in the helpfile, name argument 2), - it displays the about information of the application (found in the helpfile, name argument 2),
...@@ -149,14 +142,14 @@ where ...@@ -149,14 +142,14 @@ where
readInfo :: Bool Fonts String String String (PSt .l) -> ((Size,[InfoLine]),PSt .l) readInfo :: Bool Fonts String String String (PSt .l) -> ((Size,[InfoLine]),PSt .l)
readInfo help fonts begin end filename pState readInfo help fonts begin end filename pState
# (metrics, pState) = getFontHeightAndAscent fonts pState # (metrics, pState) = getFontHeightAndAscent fonts pState
# ((succes,file),pState) = accFiles (fopen2 (applicationpath filename) FReadText) pState # (succes,file,pState) = fopen (applicationpath filename) FReadText pState
| not succes && help | not succes && help
= processInfoStrings fonts metrics [errpref+++"could not be found."] pState = processInfoStrings fonts metrics [errpref+++"could not be found."] pState
| not succes | not succes
= processInfoStrings fonts metrics ["\\DThis is a Clean program."] pState = processInfoStrings fonts metrics ["\\DThis is a Clean program."] pState
# (found,info,file) = readInfoFile begin end file # (found,info,file) = readInfoFile begin end file
# (_,pState) = accFiles (fclose file) pState # (_,pState) = fclose file pState
| not found && help | not found && help
= processInfoStrings fonts metrics [errpref+++"does not contain help information."] pState = processInfoStrings fonts metrics [errpref+++"does not contain help information."] pState
| not found | not found
......
...@@ -8,7 +8,7 @@ definition module Highscore ...@@ -8,7 +8,7 @@ definition module Highscore
// //
// ************************************************************************************************** // **************************************************************************************************
from StdFile import Files from StdFile import FileSystem
from StdString import String from StdString import String
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
from StdId import Id from StdId import Id
...@@ -20,10 +20,10 @@ from StdId import Id ...@@ -20,10 +20,10 @@ from StdId import Id
, score :: !Int , score :: !Int
} }
readHiScores :: !String !*Files -> (!(!*File,!HiScores),!*Files) readHiScores :: !String !*env -> (!(!*File,!HiScores),!*env) | FileSystem env
// Reads high score file from disk. // Reads high score file from disk.
writeHiScores :: !*File !HiScores !*Files -> *Files writeHiScores :: !*File !HiScores !*env -> *env | FileSystem env
// Writes high scores to disk. // Writes high scores to disk.
itsAHighScore :: !Int !Int !HiScores -> Bool itsAHighScore :: !Int !Int !HiScores -> Bool
......
...@@ -6,7 +6,8 @@ implementation module Highscore ...@@ -6,7 +6,8 @@ implementation module Highscore
*/ */
import StdEnv, StdIO import StdBool, StdEnum, StdFile, StdInt, StdList, StdMisc, StdString, StdTuple
import StdId, StdSystem, StdWindow
:: HiScores :: HiScores
:== [HiScore] :== [HiScore]
...@@ -16,15 +17,15 @@ import StdEnv, StdIO ...@@ -16,15 +17,15 @@ import StdEnv, StdIO
} }
// Read in the high scores: // Read in the high scores:
readHiScores :: !String !*Files -> (!(!*File,!HiScores),!*Files) readHiScores :: !String !*env -> (!(!*File,!HiScores),!*env) | FileSystem env
readHiScores fname files readHiScores fname env
# (exists,file,files) = fopen fpath FReadData files # (exists,file,env) = fopen fpath FReadData env
| exists | exists
# (highs,file) = readHighs file # (highs,file) = readHighs file
= ((file,highs),files) = ((file,highs),env)
| otherwise | otherwise
# (_,create,files) = fopen fpath FWriteData files # (_,create,env) = fopen fpath FWriteData env
= ((create,[]),files) = ((create,[]),env)
where where
fpath = homepath fname fpath = homepath fname
...@@ -44,11 +45,11 @@ where ...@@ -44,11 +45,11 @@ where
= ([{name=name,score=hi}:rest],file) = ([{name=name,score=hi}:rest],file)
// Write the high scores: // Write the high scores:
writeHiScores :: !*File !HiScores !*Files -> *Files writeHiScores :: !*File !HiScores !*env -> *env | FileSystem env
writeHiScores file highs files writeHiScores file highs env
# (ok,file) = freopen file FWriteData # (ok,file) = freopen file FWriteData
| not ok = abort "Could not reopen file.\n" | not ok = abort "Could not reopen file.\n"
| otherwise = snd (fclose (file<<<highs) files) | otherwise = snd (fclose (file<<<highs) env)
instance <<< HiScore where instance <<< HiScore where
(<<<) :: !*File !HiScore -> *File (<<<) :: !*File !HiScore -> *File
......
...@@ -8,12 +8,8 @@ implementation module Notice ...@@ -8,12 +8,8 @@ implementation module Notice
// //
// ************************************************************************************************** // **************************************************************************************************
import StdEnv, StdIO import StdMisc, StdTuple
import StdId, StdPSt, StdWindow
/* A simple state type.
*/
:: NoState
= NoState
/* The data type that defines a notice. /* The data type that defines a notice.
*/ */
......
...@@ -22,8 +22,6 @@ import StdEnv, StdIO ...@@ -22,8 +22,6 @@ import StdEnv, StdIO
= { pos :: Int = { pos :: Int
, tower :: Tower , tower :: Tower
} }
:: NoState
= NoState
ViewDomain :== {corner1={x=50,y=0},corner2={x=480,y=180}} ViewDomain :== {corner1={x=50,y=0},corner2={x=480,y=180}}
Speed1 :== ticksPerSecond / 2 Speed1 :== ticksPerSecond / 2
......
...@@ -12,6 +12,6 @@ import StdEnv, StdIO ...@@ -12,6 +12,6 @@ import StdEnv, StdIO
Start :: *World -> *World Start :: *World -> *World
Start world Start world
= startIO NDI 0 (snd o openDialog undef hello) [] world = startIO NDI Void (snd o openDialog undef hello) [] world
where where
hello = Dialog "" (TextControl "Hello world!" []) [WindowClose (noLS closeProcess)] hello = Dialog "" (TextControl "Hello world!" []) [WindowClose (noLS closeProcess)]
...@@ -19,8 +19,6 @@ initialLife ...@@ -19,8 +19,6 @@ initialLife
= { gen = makeGeneration = { gen = makeGeneration
, size= StartCellSize , size= StartCellSize
} }
:: NoState
= NoState
Start :: *World -> *World Start :: *World -> *World
Start world Start world
......
...@@ -13,10 +13,6 @@ module pickRGB ...@@ -13,10 +13,6 @@ module pickRGB
import StdEnv, StdIO import StdEnv, StdIO
:: NoState
= NoState
Start :: *World -> *World Start :: *World -> *World
Start world Start world
# (rgbid,world) = openR2Id world # (rgbid,world) = openR2Id world
...@@ -26,7 +22,7 @@ Start world ...@@ -26,7 +22,7 @@ Start world
where where
initrgb = {r=MaxRGB,g=MaxRGB,b=MaxRGB} initrgb = {r=MaxRGB,g=MaxRGB,b=MaxRGB}
startColourPicker rgbid pickcontrol world startColourPicker rgbid pickcontrol world
= startIO SDI NoState initialise [ProcessClose closeProcess] world = startIO SDI Void initialise [ProcessClose closeProcess] world
where where
initialise pst initialise pst
# (rgbsize,pst) = controlSize pickcontrol True Nothing Nothing Nothing pst # (rgbsize,pst) = controlSize pickcontrol True Nothing Nothing Nothing pst
......
...@@ -205,8 +205,8 @@ drawplayer2letters letters2Id letters iostate ...@@ -205,8 +205,8 @@ drawplayer2letters letters2Id letters iostate
= setControlLook letters2Id True (True,playerletterslook letters) iostate = setControlLook letters2Id True (True,playerletterslook letters) iostate
playerletterslook :: ![Char] SelectState UpdateState !*Picture -> *Picture playerletterslook :: ![Char] SelectState UpdateState !*Picture -> *Picture
playerletterslook ws _ _ picture playerletterslook ws _ {newFrame} picture
= seq [ drawletter c (i,0) \\ c<-ws & i<-[0..] ] picture = seq [ drawletter c (i,0) \\ c<-ws & i<-[0..] ] (unfill newFrame picture)
drawplayer1score :: !Id !Int !(IOSt .l) -> IOSt .l drawplayer1score :: !Id !Int !(IOSt .l) -> IOSt .l
drawplayer1score player1scoreId s iostate drawplayer1score player1scoreId s iostate
......
...@@ -11,9 +11,6 @@ import board, graphics, state, language, systemsettings ...@@ -11,9 +11,6 @@ import board, graphics, state, language, systemsettings
import Help, ListBox import Help, ListBox
:: NoState // NoState is a singleton type constructor
= NoState
/*************************************************************************************************************** /***************************************************************************************************************
The Start rule creates the GUI of the scrabble game and the initial program state. The Start rule creates the GUI of the scrabble game and the initial program state.
***************************************************************************************************************/ ***************************************************************************************************************/
......
...@@ -2,7 +2,7 @@ implementation module state ...@@ -2,7 +2,7 @@ implementation module state
import StdBool, StdList import StdBool, StdList
import StdPSt import StdPStClass
import graphics, board, language import graphics, board, language
import Random import Random
......
...@@ -37,8 +37,6 @@ import StdEnv, StdIO, Notice ...@@ -37,8 +37,6 @@ import StdEnv, StdIO, Notice
, width :: Int // Its widest character , width :: Int // Its widest character
, height :: Int // Its line height , height :: Int // Its line height
} }
:: NoState
= NoState
instance zero Entry where instance zero Entry where
zero = {maxwidth=0,fields=[""]} zero = {maxwidth=0,fields=[""]}
......
...@@ -14,14 +14,6 @@ module slidegame ...@@ -14,14 +14,6 @@ module slidegame
import StdEnv, StdIO, Random import StdEnv, StdIO, Random
/* Start simply creates the slide game process.
Note that the slide game process is polymorphic in the local and public process state.
Because we need to choose a value for these states we use the singleton type NoState.
*/
:: NoState // A dummy state
= NoState
/* openSlideGame first attempts to read in the bitmap. /* openSlideGame first attempts to read in the bitmap.
If successfull, openSlideGame then checks whether the given bitmap has proper dimensions. If successfull, openSlideGame then checks whether the given bitmap has proper dimensions.
If this is the case then a window is opened that will contain the slide game. If this is the case then a window is opened that will contain the slide game.
...@@ -41,7 +33,7 @@ Start world ...@@ -41,7 +33,7 @@ Start world
# (maybeFile,world) = selectInputFile world # (maybeFile,world) = selectInputFile world
| isNothing maybeFile | isNothing maybeFile
= world = world
# (maybeBitmap,world) = accFiles (openBitmap (fromJust maybeFile)) world # (maybeBitmap,world) = openBitmap (fromJust maybeFile) world
| isNothing maybeBitmap | isNothing maybeBitmap
= world = world
# bitmap = fromJust maybeBitmap # bitmap = fromJust maybeBitmap
...@@ -49,14 +41,15 @@ Start world ...@@ -49,14 +41,15 @@ Start world
blocksize = {w=bitmapsize.w/4,h=bitmapsize.h/4} blocksize = {w=bitmapsize.w/4,h=bitmapsize.h/4}
| not (ok_blocksize blocksize) | not (ok_blocksize blocksize)
= world = world
# (seed,world) = getNewRandomSeed world | otherwise
(okCoords,hole) = initlast [{col=col,row=row} \\ row<-[0..3],col<-[0..3]] # (seed,world) = getNewRandomSeed world
(_,coords,hole) = iteraten nr_shuffle shuffle (seed,zip2 okCoords okCoords,hole) (okCoords,hole) = initlast [{col=col,row=row} \\ row<-[0..3],col<-[0..3]]
# (windowId,world) = openId world (_,coords,hole) = iteraten nr_shuffle shuffle (seed,zip2 okCoords okCoords,hole)
# (allcids, world) = openIds 15 world # (windowId,world) = openId world
# (allr2ids,world) = openR2Ids 15 world # (allcids, world) = openIds 15 world
wdef = window bitmap blocksize windowId allcids allr2ids coords # (allr2ids,world) = openR2Ids 15 world
= startIO SDI NoState (snd o openWindow {curHole=hole} wdef) [ProcessClose closeProcess] world wdef = window bitmap blocksize windowId allcids allr2ids coords
= startIO SDI Void (snd o openWindow {curHole=hole} wdef) [ProcessClose closeProcess] world
where where
nr_shuffle = 200 nr_shuffle = 200
...@@ -119,8 +112,8 @@ where ...@@ -119,8 +112,8 @@ where
:== Bool // True iff the control is currently at its desired location :== Bool // True iff the control is currently at its desired location
:: SlideR2Id // Shorthand for the receiver id of a slide control :: SlideR2Id // Shorthand for the receiver id of a slide control
:== R2Id SlideMsgIn SlideMsgOut :== R2Id SlideMsgIn SlideMsgOut
:: SlideControl ls ps // Shorthand for the slide control constructor type :: SlideControl ls pst // Shorthand for the slide control constructor type
:== AddLS (:+: CustomButtonControl (Receiver2 SlideMsgIn SlideMsgOut)) ls ps :== AddLS (:+: CustomButtonControl (Receiver2 SlideMsgIn SlideMsgOut)) ls pst
slideControl :: Bitmap Size Id [SlideR2Id] ((Coord,Coord),(Id,SlideR2Id)) slideControl :: Bitmap Size Id [SlideR2Id] ((Coord,Coord),(Id,SlideR2Id))
-> SlideControl WindowState (PSt .l) -> SlideControl WindowState (PSt .l)
...@@ -143,31 +136,31 @@ where ...@@ -143,31 +136,31 @@ where
offset {col,row}= {vx=size.w*col,vy=size.h*row} offset {col,row}= {vx=size.w*col,vy=size.h*row}
slideMove :: (.(SlideState,WindowState),PSt .l) -> (.(SlideState,WindowState),PSt .l) slideMove :: (.(SlideState,WindowState),PSt .l) -> (.(SlideState,WindowState),PSt .l)
slideMove ((slide=:{curCoord},ls=:{curHole}),ps) slideMove ((slide=:{curCoord},ls=:{curHole}),pst)
| distCoord curCoord curHole<>1 | distCoord curCoord curHole<>1
= ((slide,ls),ps) = ((slide,ls),pst)
# slide = {slide & curCoord=curHole } # slide = {slide & curCoord=curHole }
ls = {ls & curHole =curCoord} ls = {ls & curHole =curCoord}
# (_,ps) = accPIO (setControlPos windowId [(cid,(LeftTop,OffsetVector (offset curHole)))]) ps # (_,pst) = accPIO (setControlPos windowId [(cid,(LeftTop,OffsetVector (offset curHole)))]) pst
# i_am_ok = curHole==okCoord # i_am_ok = curHole==okCoord
| not i_am_ok | not i_am_ok
= ((slide,ls),ps) = ((slide,ls),pst)
# (others_ok,ps)= seqList (map areYouOk others) ps # (others_ok,pst) = seqList (map areYouOk others) pst
| and others_ok | and others_ok
= ((slide,ls),appPIO (disableWindow windowId) ps) = ((slide,ls),appPIO (disableWindow windowId) pst)
| otherwise | otherwise
= ((slide,ls),ps) = ((slide,ls),pst)
areYouOk :: SlideR2Id (PSt .l) -> (Bool,PSt .l) areYouOk :: SlideR2Id (PSt .l) -> (Bool,PSt .l)
areYouOk r2id ps areYouOk r2id pst
# (response,ps) = syncSend2 r2id AreYouOk ps # (response,pst) = syncSend2 r2id AreYouOk pst
= (fromJust (snd response),ps) = (fromJust (snd response),pst)
receiver2 = Receiver2 r2id receive2 [] receiver2 = Receiver2 r2id receive2 []
receive2 :: SlideMsgIn ((SlideState,.ls),PSt .l) -> (SlideMsgOut,((SlideState,.ls),PSt .l)) receive2 :: SlideMsgIn ((SlideState,.ls),PSt .l) -> (SlideMsgOut,((SlideState,.ls),PSt .l))
receive2 AreYouOk (slide=:({curCoord},_),ps) receive2 AreYouOk (slide=:({curCoord},_),pst)
= (okCoord==curCoord,(slide,ps)) = (okCoord==curCoord,(slide,pst))
// The distance between two Coords: // The distance between two Coords:
distCoord :: !Coord !Coord -> Int distCoord :: !Coord !Coord -> Int
......
...@@ -11,22 +11,19 @@ module talk ...@@ -11,22 +11,19 @@ module talk
import StdEnv, StdIO import StdEnv, StdIO
// The essential data types. Other data types are given at the end of the program text.
// The message type of talk processes: // The message type of talk processes:
:: Message :: Message
= NewLine String // Transmit a line of text = NewLine String // Transmit a line of text
| Quit // Request termination | Quit // Request termination
:: NoState
= NoState // The singleton data type
// Start creates two talk processes A and B that communicate by means of message passing. // Start creates two talk processes A and B that communicate by means of message passing.
Start :: *World -> *World Start :: *World -> *World
Start world Start world
# (a, world) = openRId world # (a, world) = openRId world
# (b, world) = openRId world # (b, world) = openRId world
# (talkA,world) = talk "A" a b world # (talkA,world) = talk "A" a b world
# (talkB,world) = talk "B" b a world