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

no message

parent d661e784
......@@ -23,8 +23,6 @@ import bounceDraw
, barrel :: !Barrel // the shape of the barrel
, balls :: ![Ball] // the balls in the barrel
}
:: NoState // NoState is a simple singleton type constructor
= NoState
:: *Bounce
:== PSt Local // Synonym for PSt
......
......@@ -11,20 +11,17 @@ module clipboardview
import StdEnv // Import all standard 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
# (ids,world) = openIds 3 world // Create 3 Id values
= startIO NDI // Evaluate an interactive process with:
NoState // no local process state
Void // no local process state
(initialise ids) // the initialisation action
[] // only default attributes
world
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:
= closeProcess pst // terminate the interactive process
| otherwise // Otherwise:
......
......@@ -10,16 +10,14 @@ module counter
import StdEnv, StdIO
:: NoState = NoState
Start :: *World -> *World
Start world
= startIO NDI NoState initIO [] world
= startIO NDI Void initIO [] world
initIO pst
# (dialogid, pst) = accPIO openId pst
# (displayid,pst) = accPIO openId pst
# (_,pst) = openDialog NoState (dialog dialogid displayid) pst
# (_,pst) = openDialog Void (dialog dialogid displayid) pst
= pst
where
dialog dialogId displayId
......
......@@ -8,8 +8,8 @@ implementation module Help
//
// **************************************************************************************************
import StdArray, StdBool, StdFunc, StdInt, StdList, StdTuple, StdMisc
import StdId, StdProcess, StdPSt, StdSystem, StdWindow
import StdArray, StdBool, StdFile, StdFunc, StdInt, StdList, StdTuple, StdMisc
import StdId, StdProcess, StdPSt, StdPStClass, StdSystem, StdWindow
:: NoState = NoState
:: InfoDef :== (Size,[InfoLine])
......@@ -40,13 +40,6 @@ About :== False
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:
- 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),
......@@ -150,13 +143,13 @@ where
readInfo :: Bool Fonts String String String (PSt .l) -> ((Size,[InfoLine]),PSt .l)
readInfo help fonts begin end filename 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
= processInfoStrings fonts metrics [errpref+++"could not be found."] pState
| not succes
= processInfoStrings fonts metrics ["\\DThis is a Clean program."] pState
# (found,info,file) = readInfoFile begin end file
# (_,pState) = accFiles (fclose file) pState
# (_,pState) = fclose file pState
| not found && help
= processInfoStrings fonts metrics [errpref+++"does not contain help information."] pState
| not found
......
......@@ -8,7 +8,7 @@ definition module Highscore
//
// **************************************************************************************************
from StdFile import Files
from StdFile import FileSystem
from StdString import String
from StdPSt import PSt, IOSt
from StdId import Id
......@@ -20,10 +20,10 @@ from StdId import Id
, score :: !Int
}
readHiScores :: !String !*Files -> (!(!*File,!HiScores),!*Files)
readHiScores :: !String !*env -> (!(!*File,!HiScores),!*env) | FileSystem env
// Reads high score file from disk.
writeHiScores :: !*File !HiScores !*Files -> *Files
writeHiScores :: !*File !HiScores !*env -> *env | FileSystem env
// Writes high scores to disk.
itsAHighScore :: !Int !Int !HiScores -> Bool
......
......@@ -6,7 +6,8 @@ implementation module Highscore
*/
import StdEnv, StdIO
import StdBool, StdEnum, StdFile, StdInt, StdList, StdMisc, StdString, StdTuple
import StdId, StdSystem, StdWindow
:: HiScores
:== [HiScore]
......@@ -16,15 +17,15 @@ import StdEnv, StdIO
}
// Read in the high scores:
readHiScores :: !String !*Files -> (!(!*File,!HiScores),!*Files)
readHiScores fname files
# (exists,file,files) = fopen fpath FReadData files
readHiScores :: !String !*env -> (!(!*File,!HiScores),!*env) | FileSystem env
readHiScores fname env
# (exists,file,env) = fopen fpath FReadData env
| exists
# (highs,file) = readHighs file
= ((file,highs),files)
= ((file,highs),env)
| otherwise
# (_,create,files) = fopen fpath FWriteData files
= ((create,[]),files)
# (_,create,env) = fopen fpath FWriteData env
= ((create,[]),env)
where
fpath = homepath fname
......@@ -44,11 +45,11 @@ where
= ([{name=name,score=hi}:rest],file)
// Write the high scores:
writeHiScores :: !*File !HiScores !*Files -> *Files
writeHiScores file highs files
writeHiScores :: !*File !HiScores !*env -> *env | FileSystem env
writeHiScores file highs env
# (ok,file) = freopen file FWriteData
| not ok = abort "Could not reopen file.\n"
| otherwise = snd (fclose (file<<<highs) files)
| otherwise = snd (fclose (file<<<highs) env)
instance <<< HiScore where
(<<<) :: !*File !HiScore -> *File
......
......@@ -8,12 +8,8 @@ implementation module Notice
//
// **************************************************************************************************
import StdEnv, StdIO
/* A simple state type.
*/
:: NoState
= NoState
import StdMisc, StdTuple
import StdId, StdPSt, StdWindow
/* The data type that defines a notice.
*/
......
......@@ -22,8 +22,6 @@ import StdEnv, StdIO
= { pos :: Int
, tower :: Tower
}
:: NoState
= NoState
ViewDomain :== {corner1={x=50,y=0},corner2={x=480,y=180}}
Speed1 :== ticksPerSecond / 2
......
......@@ -12,6 +12,6 @@ import StdEnv, StdIO
Start :: *World -> *World
Start world
= startIO NDI 0 (snd o openDialog undef hello) [] world
= startIO NDI Void (snd o openDialog undef hello) [] world
where
hello = Dialog "" (TextControl "Hello world!" []) [WindowClose (noLS closeProcess)]
......@@ -19,8 +19,6 @@ initialLife
= { gen = makeGeneration
, size= StartCellSize
}
:: NoState
= NoState
Start :: *World -> *World
Start world
......
......@@ -13,10 +13,6 @@ module pickRGB
import StdEnv, StdIO
:: NoState
= NoState
Start :: *World -> *World
Start world
# (rgbid,world) = openR2Id world
......@@ -26,7 +22,7 @@ Start world
where
initrgb = {r=MaxRGB,g=MaxRGB,b=MaxRGB}
startColourPicker rgbid pickcontrol world
= startIO SDI NoState initialise [ProcessClose closeProcess] world
= startIO SDI Void initialise [ProcessClose closeProcess] world
where
initialise pst
# (rgbsize,pst) = controlSize pickcontrol True Nothing Nothing Nothing pst
......
......@@ -205,8 +205,8 @@ drawplayer2letters letters2Id letters iostate
= setControlLook letters2Id True (True,playerletterslook letters) iostate
playerletterslook :: ![Char] SelectState UpdateState !*Picture -> *Picture
playerletterslook ws _ _ picture
= seq [ drawletter c (i,0) \\ c<-ws & i<-[0..] ] picture
playerletterslook ws _ {newFrame} picture
= seq [ drawletter c (i,0) \\ c<-ws & i<-[0..] ] (unfill newFrame picture)
drawplayer1score :: !Id !Int !(IOSt .l) -> IOSt .l
drawplayer1score player1scoreId s iostate
......
......@@ -11,9 +11,6 @@ import board, graphics, state, language, systemsettings
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.
***************************************************************************************************************/
......
......@@ -2,7 +2,7 @@ implementation module state
import StdBool, StdList
import StdPSt
import StdPStClass
import graphics, board, language
import Random
......
......@@ -37,8 +37,6 @@ import StdEnv, StdIO, Notice
, width :: Int // Its widest character
, height :: Int // Its line height
}
:: NoState
= NoState
instance zero Entry where
zero = {maxwidth=0,fields=[""]}
......
......@@ -14,14 +14,6 @@ module slidegame
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.
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.
......@@ -41,7 +33,7 @@ Start world
# (maybeFile,world) = selectInputFile world
| isNothing maybeFile
= world
# (maybeBitmap,world) = accFiles (openBitmap (fromJust maybeFile)) world
# (maybeBitmap,world) = openBitmap (fromJust maybeFile) world
| isNothing maybeBitmap
= world
# bitmap = fromJust maybeBitmap
......@@ -49,6 +41,7 @@ Start world
blocksize = {w=bitmapsize.w/4,h=bitmapsize.h/4}
| not (ok_blocksize blocksize)
= world
| otherwise
# (seed,world) = getNewRandomSeed world
(okCoords,hole) = initlast [{col=col,row=row} \\ row<-[0..3],col<-[0..3]]
(_,coords,hole) = iteraten nr_shuffle shuffle (seed,zip2 okCoords okCoords,hole)
......@@ -56,7 +49,7 @@ Start world
# (allcids, world) = openIds 15 world
# (allr2ids,world) = openR2Ids 15 world
wdef = window bitmap blocksize windowId allcids allr2ids coords
= startIO SDI NoState (snd o openWindow {curHole=hole} wdef) [ProcessClose closeProcess] world
= startIO SDI Void (snd o openWindow {curHole=hole} wdef) [ProcessClose closeProcess] world
where
nr_shuffle = 200
......@@ -119,8 +112,8 @@ where
:== Bool // True iff the control is currently at its desired location
:: SlideR2Id // Shorthand for the receiver id of a slide control
:== R2Id SlideMsgIn SlideMsgOut
:: SlideControl ls ps // Shorthand for the slide control constructor type
:== AddLS (:+: CustomButtonControl (Receiver2 SlideMsgIn SlideMsgOut)) ls ps
:: SlideControl ls pst // Shorthand for the slide control constructor type
:== AddLS (:+: CustomButtonControl (Receiver2 SlideMsgIn SlideMsgOut)) ls pst
slideControl :: Bitmap Size Id [SlideR2Id] ((Coord,Coord),(Id,SlideR2Id))
-> SlideControl WindowState (PSt .l)
......@@ -143,31 +136,31 @@ where
offset {col,row}= {vx=size.w*col,vy=size.h*row}
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
= ((slide,ls),ps)
= ((slide,ls),pst)
# slide = {slide & curCoord=curHole }
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
| not i_am_ok
= ((slide,ls),ps)
# (others_ok,ps)= seqList (map areYouOk others) ps
= ((slide,ls),pst)
# (others_ok,pst) = seqList (map areYouOk others) pst
| and others_ok
= ((slide,ls),appPIO (disableWindow windowId) ps)
= ((slide,ls),appPIO (disableWindow windowId) pst)
| otherwise
= ((slide,ls),ps)
= ((slide,ls),pst)
areYouOk :: SlideR2Id (PSt .l) -> (Bool,PSt .l)
areYouOk r2id ps
# (response,ps) = syncSend2 r2id AreYouOk ps
= (fromJust (snd response),ps)
areYouOk r2id pst
# (response,pst) = syncSend2 r2id AreYouOk pst
= (fromJust (snd response),pst)
receiver2 = Receiver2 r2id receive2 []
receive2 :: SlideMsgIn ((SlideState,.ls),PSt .l) -> (SlideMsgOut,((SlideState,.ls),PSt .l))
receive2 AreYouOk (slide=:({curCoord},_),ps)
= (okCoord==curCoord,(slide,ps))
receive2 AreYouOk (slide=:({curCoord},_),pst)
= (okCoord==curCoord,(slide,pst))
// The distance between two Coords:
distCoord :: !Coord !Coord -> Int
......
......@@ -11,13 +11,10 @@ module talk
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:
:: Message
= NewLine String // Transmit a line of text
| 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 :: *World -> *World
......@@ -50,7 +47,7 @@ talk name me you world
, ControlResize editResize
, ControlTip "Received messages appear here"
]
= ( Process SDI NoState (initialise input output wId outId inId) [ProcessClose (quit you)]
= ( Process SDI Void (initialise input output wId outId inId) [ProcessClose (quit you)]
, world
)
where
......
......@@ -108,41 +108,22 @@ where
, WindowLook True (tmLook tm)
, WindowMouse tmMouseFilter Able (noLS1 EditTransitions)
, WindowClose (noLS DoQuit)
, WindowHScroll (hscroll 24)
, WindowVScroll (vscroll 8)
, WindowHScroll (stdScrollFunction Horizontal 24)
, WindowVScroll (stdScrollFunction Vertical 8)
]
tapewd = Window "Tape" NilLS
[ WindowId tapeWdID
, WindowViewDomain {zero & corner2={x=MaxX,y=92}}
, WindowViewSize {w=400,h=60}
, WindowViewSize {w=500,h=92}
, WindowLook True (tpLook tape)
, WindowMouse tpMouseFilter Able (noLS1 EditTape)
, WindowClose (noLS DoQuit)
, WindowHScroll (hscroll 24)
, WindowVScroll (vscroll 8)
, WindowHScroll (stdScrollFunction Horizontal 24)
, WindowVScroll (stdScrollFunction Vertical 8)
, WindowPos (Below windowID,zero)
]
timer = Timer Speed3 NilLS [TimerId timerID,TimerSelectState Unable,TimerFunction (noLS1 TimerStep)]
hscroll dx viewFrame {sliderThumb} move
= case move of
SliderIncSmall -> sliderThumb+dx
SliderDecSmall -> sliderThumb-dx
SliderIncLarge -> sliderThumb+width
SliderDecLarge -> sliderThumb-width
SliderThumb x -> x
where
width = (rectangleSize viewFrame).w
vscroll dy viewFrame {sliderThumb} move
= case move of
SliderIncSmall -> sliderThumb+dy
SliderDecSmall -> sliderThumb-dy
SliderIncLarge -> sliderThumb+height
SliderDecLarge -> sliderThumb-height
SliderThumb x -> x
where
height = (rectangleSize viewFrame).h
// Open a new empty Turing machine.
DoNew :: (PSt Tm) -> PSt Tm
DoNew pst=:{ls={saved}}
......@@ -174,7 +155,7 @@ where
// Save the Turing machine.
DoSave :: (PSt Tm) -> PSt Tm
DoSave pst=:{ls=tm=:{tmstate={turing},name}}
# (success,pst) = accFiles (WriteTuringToFile turing name) pst
# (success,pst) = WriteTuringToFile turing name pst
| success
# pst = {pst & ls={tm & saved=True}}
# pst = appPIO (disableMenuElements [saveItemId]) pst
......@@ -191,7 +172,7 @@ where
# fname = fromJust fname
| RemovePath fname==HelpFile
= Alert "The Turing machine cannot be saved to" ("the help file \'"+++HelpFile+++"\'.") pst
# (success,pst) = accFiles (WriteTuringToFile turing fname) pst
# (success,pst) = WriteTuringToFile turing fname pst
| not success
= Alert "The Turing machine has not been saved." "The file could not be opened." pst
# pst = appPIO (setWindowTitle windowID (RemovePath fname)) pst
......@@ -224,7 +205,7 @@ where
fstring = " \'"+++fname+++"\'"
| fname==HelpFile
= Alert ("The help file"+++fstring) "cannot be opened as a T.M." pst
# ((status,turing),pst) = accFiles (ReadTuring name) pst
# ((status,turing),pst) = ReadTuring name pst
| status==0
# tmstate = {turing=turing,transition=0,command=None}
# pst = appListPIO
......
......@@ -2,7 +2,7 @@ implementation module tmdialog
import StdBool, StdChar, StdFunc, StdList, StdMisc, StdTuple
import StdControl, StdId, StdMenuElement, StdPSt, StdSystem, StdWindow
import StdControl, StdId, StdMenuElement, StdPSt, StdPStClass, StdSystem, StdWindow
import showtm, tmfile, Notice
......@@ -251,4 +251,4 @@ where
SvBfClSave :: (PSt Tm) -> PSt Tm
SvBfClSave pst=:{ls=tm=:{tmstate={turing},name,tmids={saveItemId}},io}
# pst = {pst & ls={tm & saved=True}, io=disableMenuElements [saveItemId] io}
= snd (accFiles (WriteTuringToFile turing name) pst)
= snd (WriteTuringToFile turing name pst)
definition module tmfile
from StdString import String
from StdFile import Files
from StdFile import FileSystem
from tm import Turing, Transition, Tape, State, Head
WriteTuringToFile :: Turing !String !*Files -> (!Bool,!*Files)
ReadTuring :: !String !*Files -> (!(!Int,!Turing),!*Files)
WriteTuringToFile :: Turing !String !*env -> (!Bool,!*env) | FileSystem env
ReadTuring :: !String !*env -> (!(!Int,!Turing),!*env) | FileSystem env
RemovePath :: !String -> String
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