Skip to content

GitLab

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

no message

parent d661e784
Hide whitespace changes
Inline Side-by-side
ObjectIO/ObjectIO Examples/bounce/bounce.icl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/clipboard viewer/clipboardview.icl
View file @ bbd36764
......@@ -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:
......
ObjectIO/ObjectIO Examples/counter/counter.icl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/gui utilities/Help.icl
View file @ bbd36764
......@@ -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),
......@@ -149,14 +142,14 @@ 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
# (metrics, pState) = getFontHeightAndAscent fonts 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
# (found,info,file) = readInfoFile begin end file
# (_,pState) = fclose file pState
| not found && help
= processInfoStrings fonts metrics [errpref+++"does not contain help information."] pState
| not found
......
ObjectIO/ObjectIO Examples/gui utilities/Highscore.dcl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/gui utilities/Highscore.icl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/gui utilities/Notice.icl
View file @ bbd36764
......@@ -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.
*/
......
ObjectIO/ObjectIO Examples/hanoi/Hanoi.icl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/hello world/hello.icl
View file @ bbd36764
......@@ -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)]
ObjectIO/ObjectIO Examples/life/LifeGameExample.icl
View file @ bbd36764
......@@ -19,8 +19,6 @@ initialLife
= { gen = makeGeneration
, size= StartCellSize
}
:: NoState
= NoState
Start :: *World -> *World
Start world
......
ObjectIO/ObjectIO Examples/rgb selector/pickRGB.icl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/scrabble/graphics.icl
View file @ bbd36764
......@@ -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
......
ObjectIO/ObjectIO Examples/scrabble/scrabble.icl
View file @ bbd36764
......@@ -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.
***************************************************************************************************************/
......
ObjectIO/ObjectIO Examples/scrabble/state.icl
View file @ bbd36764
......@@ -2,7 +2,7 @@ implementation module state
import StdBool, StdList
import StdPSt
import StdPStClass
import graphics, board, language
import Random
......
ObjectIO/ObjectIO Examples/simple database/database.icl
View file @ bbd36764
......@@ -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=[""]}
......
ObjectIO/ObjectIO Examples/slidegame/slidegame.icl
View file @ bbd36764
......@@ -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,14 +41,15 @@ Start world
blocksize = {w=bitmapsize.w/4,h=bitmapsize.h/4}
| not (ok_blocksize blocksize)
= world
# (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)
# (windowId,world) = openId 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
| 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)
# (windowId,world) = openId world
# (allcids, world) = openIds 15 world
# (allr2ids,world) = openR2Ids 15 world
wdef = window bitmap blocksize windowId allcids allr2ids coords
= 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 = {slide & curCoord=curHole }
ls = {ls & curHole =curCoord}
# (_,ps) = accPIO (setControlPos windowId [(cid,(LeftTop,OffsetVector (offset curHole)))]) ps
# i_am_ok = curHole==okCoord
= ((slide,ls),pst)
# slide = {slide & curCoord=curHole }
ls = {ls & curHole =curCoord}
# (_,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
......
ObjectIO/ObjectIO Examples/talk/talk.icl
View file @ bbd36764
......@@ -11,22 +11,19 @@ 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
= NewLine String // Transmit a line of text
| Quit // Request termination
// Start creates two talk processes A and B that communicate by means of message passing.
Start :: *World -> *World
Start world
# (a, world) = openRId world
# (b, world) = openRId world
# (talkA,world) = talk "A" a b world
# (talkB,world) = talk "B" b a world
= startProcesses [talkA,talkB] world
# (a, world) = openRId world
# (b, world) = openRId world
# (talkA,world) = talk "A" a b world
# (talkB,world) = talk "B" b a world
= startProcesses [talkA,talkB] world
/* talk name me you
defines a talk process named name, to which messages can be sent of type Message
......@@ -34,40 +31,40 @@ Start world
*/
talk :: String (RId Message) (RId Message) *World -> (Process,*World)
talk name me you world
# (wId, world) = openId world
# (outId,world) = openId world
# (inId, world) = openId world
input = EditControl "" (PixelWidth (hmm 50.0)) 5
[ ControlId inId
, ControlKeyboard inputfilter Able (noLS1 (input wId inId you))
, ControlResize editResize
, ControlTip "Type your message here"
]
output = EditControl "" (PixelWidth (hmm 50.0)) 5
[ ControlId outId
, ControlPos (Below inId,NoOffset)
, ControlSelectState Unable
, ControlResize editResize
, ControlTip "Received messages appear here"
]
= ( Process SDI NoState (initialise input output wId outId inId) [ProcessClose (quit you)]
, world
)
# (wId, world) = openId world
# (outId,world) = openId world
# (inId, world) = openId world
input = EditControl "" (PixelWidth (hmm 50.0)) 5
[ ControlId inId
, ControlKeyboard inputfilter Able (noLS1 (input wId inId you))
, ControlResize editResize
, ControlTip "Type your message here"
]
output = EditControl "" (PixelWidth (hmm 50.0)) 5
[ ControlId outId
, ControlPos (Below inId,NoOffset)
, ControlSelectState Unable
, ControlResize editResize
, ControlTip "Received messages appear here"
]
= ( Process SDI Void (initialise input output wId outId inId) [ProcessClose (quit you)]
, world
)
where
initialise input output wId outId inId pst
# (size,pst) = controlSize (input:+:output) True Nothing Nothing Nothing pst
talkwindow = Window ("Talk "+++name) (input:+:output)
# (size,pst) = controlSize (input:+:output) True Nothing Nothing Nothing pst
talkwindow = Window ("Talk "+++name) (input:+:output)
[ WindowId wId
, WindowViewSize size
]
menu = Menu ("&Talk "+++name)
menu = Menu ("&Talk "+++name)
( MenuItem "&Quit" [MenuShortKey 'q',MenuFunction (noLS (quit you))]
) []
receiver = Receiver me (noLS1 (receive wId outId)) []
# (_,pst) = openWindow undef talkwindow pst
# (_,pst) = openMenu undef menu pst
# (_,pst) = openReceiver undef receiver pst
= pst
receiver = Receiver me (noLS1 (receive wId outId)) []
# (_,pst) = openWindow undef talkwindow pst
# (_,pst) = openMenu undef menu pst
# (_,pst) = openReceiver undef receiver pst
= pst
/* editResize handles the resize of the two input fields.
*/
......@@ -81,13 +78,13 @@ editResize _ _ newWindowSize=:{h}
*/
inputfilter :: KeyboardState -> Bool
inputfilter keystate
= getKeyboardStateKeyState keystate<>KeyUp
= getKeyboardStateKeyState keystate<>KeyUp
input :: Id Id (RId Message) KeyboardState (PSt .l) -> PSt .l
input wId inId you _ pst
# (Just window,pst) = accPIO (getWindow wId) pst
text = fromJust (snd (getControlText inId window))
= snd (asyncSend you (NewLine text) pst)
# (Just window,pst) = accPIO (getWindow wId) pst
text = fromJust (snd (getControlText inId window))
= snd (asyncSend you (NewLine text) pst)
/* The message passing protocol of a talk process.
On receipt of:
......@@ -97,12 +94,12 @@ input wId inId you _ pst
*/
receive :: Id Id Message (PSt .l) -> PSt .l
receive wId outId (NewLine text) pst=:{io}
= {pst & io=setEditControlCursor outId (size text) (setControlText outId text io)}
= {pst & io=setEditControlCursor outId (size text) (setControlText outId text io)}
receive _ _ Quit pst
= closeProcess pst
= closeProcess pst
/* The quit command first sends the Quit message to the other talk process and then quits itself.
*/
quit :: (RId Message) (PSt .l) -> PSt .l
quit you pst
= closeProcess (snd (syncSend you Quit pst))
= closeProcess (snd (syncSend you Quit pst))
ObjectIO/ObjectIO Examples/turing/Turing.icl
View file @ bbd36764
......@@ -108,40 +108,21 @@ 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