Skip to content

GitLab

Commit 42aafe76 authored by Peter Achten's avatar Peter Achten
Browse files

no message

parent 93fa6b9b
Hide whitespace changes
Inline Side-by-side
ObjectIO/ObjectIO Examples/About these demos.txt 0 → 100644
View file @ 42aafe76
About these demos
=================
This folder contains the sources of example programs that demonstrate the features of the Clean Object I/O System.
The following example programs have been converted from the 0.8 I/O library to the Object I/O library
to give you some impression of the differences between the two libraries. We intend to convert all
0.8 example programs in time.
* 'gui utilities': This folder contains a number of useful modules for interactive applications:
* Help: A function to create a Dialog that displays information about the application and
a function to create a Window that displays information about the use of the application.
Both the 'about' and 'help' information reside in the same file.
* Highscore: Functions to read and write high scores to disk, and to present a list of high scores
in a dialog.
* Random: Functions to generate random numbers.
* hanoi: Hanoi gives a graphical representation of the famous 'towers of hanoi'.
* life: Life gives a graphical user interface to play with Conway's Game of Life.
* simple database: This program browses and changes one database at a time.
* turing: This program is a simple programming environment and interpreter for Turing Machines.
* worm: This program is a simple game with a worm having to eat food. No fancy graphics involved.
New example programs that demonstrate more typical Object I/O features such as process creation, message passing,
and local state, are the following:
* bounce: This program creates two interactive processes. Each process contains a barrel in which
balls are bouncing against the walls and each other. When a ball leaves the barrel it is
sent to the other process.
* clipboard viewer: This program shows the current content of the clipboard and lets you change it.
* compare: This program compares two different text files.
* counter: This program opens a window with a composite counter control with a local integer state.
* 'gui utilities': Two new modules have been added to this folder:
* ListBox: A new Controls instance that can be used in windows and dialogues to display a list of
items in a scrollable control.
* Notice: A new Dialogs instance that can be used to display simple messages and have button
alternatives.
* hello world: The famous "Hello World!" example program as an interactive program.
* rgb selector: This program opens a dialog to create RGB colours.
* scrabble: A more extensive application which implements the well-known game Scrabble.
* slidegame: This program makes use of bitmaps for a simple slide game.
* talk: This program creates two interactive processes. Each process contains a window in which the
user can type text that is being sent to the other process. In the window the received
text from the other process is also displayed.
* typist: This program creates two interactive processes. One process presents a window in which text
can be typed. The other process monitors the typing speed of the other process during a
session of one minute.
ObjectIO/ObjectIO Examples/bounce/bounce.icl 0 → 100644
View file @ 42aafe76
module bounce
// **************************************************************************************************
//
// A program that creates two interactive processes that bounce balls in an open-ended barrel.
//
// The program has been written in Clean 1.3.2 and uses the Clean Standard Object I/O library 1.2
//
// **************************************************************************************************
import StdEnv, StdIO
import bounceDraw
:: Message // The message type:
= BallsArrive [Ball] // balls that have crossed process border
| BounceOpened // the other bounce process has been created
| QuitBounce // quit the bounce process
:: Local // The local program state:
= { talkTo :: !RId Message // who to play with
, barrel :: !Barrel // the shape of the barrel
, balls :: ![Ball] // the balls in the barrel
}
:: NoState // NoState is a simple singleton type constructor
= NoState
:: *Bounce x
:== PSt Local x // Synonym for PSt
// Create the initial interactive process:
Start :: *World -> *World
Start world
# (rIdA,world) = openRId world
# (rIdB,world) = openRId world
# (wIdA,world) = openId world
# (wIdB,world) = openId world
# (tIdA,world) = openId world
# (tIdB,world) = openId world
= startProcesses [ bounce wIdB tIdB rIdB rIdA "Bounce B" RightTop rightBarrelSetUp
, bounce wIdA tIdA rIdA rIdB "Bounce A" LeftTop leftBarrelSetUp
] world
bounce :: Id Id (RId Message) (RId Message) Title ItemLoc (Barrel,[Ball]) -> ProcessGroup Process
bounce wId tId me you name itemLoc (barrel,balls)
= ProcessGroup 0 (Process SDI initLocal initIO [ProcessClose quit])
where
barrelDomain = barrel.bDomain
barrelSize = rectangleSize barrelDomain
maxSize = maxFixedWindowSize
windowSize = {w=min barrelSize.w (maxSize.w/2),h=min barrelSize.h (maxSize.h/2)}
splitWalls = splitWallsInBarrel barrel
initLocal = {talkTo=you,barrel=barrel,balls=balls}
initIO pst
# (error,pst) = openWindow undef window pst
| error<>NoError
= abort "bounce could not open window."
# (error,pst) = openMenu undef menu pst
| error<>NoError
= abort "bounce could not open menu."
# (error,pst) = openTimer undef timer pst
| error<>NoError
= abort "bounce could not open timer."
# (error,pst) = openReceiver undef receiver pst
| error<>NoError
= abort "bounce could not open receiver."
| otherwise
= pst
// window defines the window that displays the barrel and the current balls.
window = Window name NilLS
[ WindowId wId
, WindowLook False (updateBalls initLocal)
, WindowViewSize windowSize
, WindowPos (itemLoc,NoOffset)
]
updateBalls :: Local SelectState UpdateState *Picture -> *Picture
updateBalls {balls,barrel} _ {oldFrame,newFrame,updArea} picture
# picture = drawBarrel area scale barrel picture
# picture = seq (map (drawBall scale domain.corner1) balls) picture
= picture
where
domain = barrel.bDomain
windowSize = rectangleSize newFrame
barrelSize = rectangleSize domain
scale = scaleSize windowSize barrelSize
area = if (oldFrame==newFrame) updArea [newFrame]
// menu defines the bounce menu. It contains only the quit command to terminate the application.
menu = Menu name
( MenuItem "About Bounce..." [MenuFunction (noLS bounceHelp)]
:+: MenuSeparator []
:+: MenuItem "Quit" [MenuFunction (noLS quit),MenuShortKey 'q']
) []
quit :: (Bounce .x) -> Bounce .x
quit bounce=:{ls={talkTo}}
= closeProcess (snd (syncSend talkTo QuitBounce bounce))
// timer defines the timer that will calculate the movements of the current balls as often as possible.
timer = Timer 0 NilLS
[ TimerId tId
, TimerFunction (noLS1 (bounceBalls splitWalls))
]
where
bounceBalls :: !(![SingleWall],![SingleWall]) NrOfIntervals (Bounce .x) -> Bounce .x
bounceBalls splitWalls _ bounce=:{ls=local=:{talkTo,balls,barrel},io}
# (windowSize,io) = getWindowViewSize wId io
scale = scaleSize windowSize barrelSize
eraseOld = map (eraseBall scale base) balls
drawNew = map (drawBall scale base) ins
local = {local & balls=ins}
# io = appWindowPicture wId (seq (eraseOld++drawNew)) io
# io = setWindowLook wId False (False,updateBalls local) io
# bounce = {bounce & ls=local,io=io}
| isEmpty outs = bounce
| otherwise = snd (syncSend talkTo (BallsArrive outs) bounce)
where
nextBallPos = nextBallPositions splitWalls balls
ballsMoved = map moveBall nextBallPos
domain = barrel.bDomain
base = domain.corner1
barrelSize = rectangleSize domain
(ins,outs) = splitBallsInBarrel domain ballsMoved
// receiver defines the receiver that will receive new balls and termination requests.
receiver :: *Receiver Message .ls (Bounce .x)
receiver = Receiver me (noLS1 (receive splitWalls)) []
where
receive :: !(![SingleWall],![SingleWall]) !Message !(Bounce .x) -> Bounce .x
receive (horizontal,vertical) (BallsArrive newBalls) bounce=:{ls}
#! newBalls = map correctBall newBalls
= {bounce & ls={ls & balls=newBalls++ls.balls}}
where
correctBall :: !Ball -> Ball
correctBall ball=:{bCenter,bSpeed}
# ball = {ball & bCenter=movePoint (~bSpeed) bCenter}
# ball = checkVerticalWalls vertical ball
# ball = checkHorizontalWalls horizontal ball
# ball = moveBall ball
= ball
receive _ BounceOpened bounce
= appPIO (enableTimer tId) bounce
receive _ QuitBounce bounce
= closeProcess bounce
// bounceHelp opens a dialog that tells something about this application.
bounceHelp :: (Bounce .x) -> Bounce .x
bounceHelp bounce
# (okId, bounce) = accPIO openId bounce
# ((error,_),bounce)= openModalDialog undef (dDef okId) bounce
| error<>NoError = abort "bounce could not open About bounce dialog."
| otherwise = bounce
where
dDef okId = Dialog "About bounce"
( TextControl "This is a Clean program"
[ControlPos center]
:+: ButtonControl "Ok" [ControlId okId
,ControlPos center
,ControlFunction (noLS close)
]
)
[ WindowOk okId
]
center = (Center,NoOffset)
close :: (Bounce .x) -> Bounce .x
close bounce
# (Just id,bounce) = accPIO getActiveWindow bounce
# bounce = closeWindow id bounce
= bounce
// Determine which balls are inside and which are outside the barrel:
splitBallsInBarrel :: !ViewDomain ![Ball] -> (![Ball],![Ball])
splitBallsInBarrel domain balls
= seq (map (ballInOrOut domain) balls) ([],[])
where
ballInOrOut :: !ViewDomain !Ball !(![Ball],![Ball]) -> (![Ball],![Ball])
ballInOrOut {corner1={x=left,y=top},corner2={x=right,y=bottom}} ball=:{bCenter} (ins,outs)
| between bCenter.x left right && between bCenter.y top bottom
= ([ball:ins],outs)
| otherwise
= (ins,[ball:outs])
nextBallPositions :: !(![SingleWall],![SingleWall]) ![Ball] -> [Ball]
nextBallPositions (horizontal,vertical) balls
= map (checkHorizontalWalls horizontal) (
map (checkVerticalWalls vertical) (
computeNextBallPositions [] balls))
where
computeNextBallPositions :: ![Ball] ![Ball] -> [Ball]
computeNextBallPositions ballsDone [ball:balls]
= computeNextBallPositions [ballDone:newBallsDone] newBalls
where
(newBallsDone,newBalls,ballDone) = checkBallCollisions ballsDone balls ball
checkBallCollisions :: ![Ball] ![Ball] !Ball -> (![Ball],![Ball],!Ball)
checkBallCollisions balls1 balls2 ball
= (newBalls1,newBalls2,ball2)
where
(newBalls1,ball1) = checkBallCollision balls1 ball
(newBalls2,ball2) = checkBallCollision balls2 ball1
checkBallCollision :: ![Ball] !Ball -> (![Ball],!Ball)
checkBallCollision [ball2=:{bCenter=center2,bRadius=radius2,bSpeed=step2}:others]
ball1=:{bCenter=center1,bRadius=radius1,bSpeed=step1}
| dist (moveBall ball1).bCenter center2<=toReal (radius1+radius2)
# (others,ball1) = checkBallCollision others {ball1 & bSpeed=step2}
= ([{ball2 & bSpeed=step1}:others],ball1)
| otherwise
# (others,ball1) = checkBallCollision others ball1
= ([ball2:others],ball1)
checkBallCollision others ball
= (others,ball)
computeNextBallPositions ballsDone _
= ballsDone
checkHorizontalWalls :: ![SingleWall] !Ball -> Ball
checkHorizontalWalls [((a,b),interior):walls] ball=:{bCenter,bRadius,bSpeed}
| interior<>startInterior = checkHorizontalWalls walls ball
| not collision = checkHorizontalWalls walls ball1
| otherwise = ball1
where
c = (moveBall ball).bCenter
speed1 = if collision {bSpeed & vy=0-bSpeed.vy} bSpeed
collision = (between c.x (a.x-bRadius) (b.x+bRadius))
&& (sign bSpeed.vy<>interior)
&& (if posSign (a.y+signRadius>=c.y)
(a.y+signRadius<=c.y))
signRadius = interior*bRadius
posSign = interior>0
startInterior = sign (bCenter.y-a.y)
ball1 = {ball & bSpeed=speed1}
checkHorizontalWalls _ ball
= ball
checkVerticalWalls :: ![SingleWall] !Ball -> Ball
checkVerticalWalls [((a,b),interior):walls] ball=:{bCenter,bRadius,bSpeed}
| interior<>startInterior = checkVerticalWalls walls ball
| not collision = checkVerticalWalls walls ball1
| otherwise = ball1
where
c = (moveBall ball).bCenter
speed1 = if collision {bSpeed & vx=0-bSpeed.vx} bSpeed
collision = (between c.y (a.y-bRadius) (b.y+bRadius))
&& ((sign bSpeed.vx<>interior)
&& (if posSign (a.x+signRadius>=c.x)
(a.x+signRadius<=c.x)))
signRadius = interior*bRadius
posSign = interior>0
startInterior = sign (bCenter.x-a.x)
ball1 = {ball & bSpeed=speed1}
checkVerticalWalls _ ball = ball
moveBall :: !Ball -> Ball
moveBall ball=:{bCenter,bSpeed}
= {ball & bCenter=movePoint bSpeed bCenter}
ObjectIO/ObjectIO Examples/bounce/bounceDraw.dcl 0 → 100644
View file @ 42aafe76
definition module bounceDraw
import bounceTypes
drawBarrel :: !UpdateArea !Scale !Barrel !*Picture -> *Picture
drawBall :: !Scale !Point2 !Ball !*Picture -> *Picture
eraseBall :: !Scale !Point2 !Ball !*Picture -> *Picture
ObjectIO/ObjectIO Examples/bounce/bounceDraw.icl 0 → 100644
View file @ 42aafe76
implementation module bounceDraw
import StdInt, StdReal, StdList, StdFunc
import bounceTypes
drawBarrel :: !UpdateArea !Scale !Barrel !*Picture -> *Picture
drawBarrel updArea scale barrel picture
# picture = setPenColour Grey picture
# picture = seq (map fill updArea) picture
# picture = unfillAt base polygon picture
= picture
where
(base,polygon) = BarrelToPolygon scale barrel
drawBall :: !Scale !Point2 !Ball !*Picture -> *Picture
drawBall (kx,ky) base {bCenter,bRadius,bColour} picture
# picture = setPenColour bColour picture
# picture = fillAt center oval picture
# picture = setPenColour Black picture
# picture = drawAt center oval picture
= picture
where
k = min kx ky
r = (max (toInt (k*(toReal bRadius))) 2)-1
offset = bCenter-base
center = {x=toInt (kx*(toReal offset.x)),y=toInt (ky*(toReal offset.y))}
oval = {oval_rx=r,oval_ry=r}
eraseBall :: !Scale !Point2 !Ball !*Picture -> *Picture
eraseBall (kx,ky) base {bCenter,bRadius} picture
# picture = unfillAt center oval picture
# picture = undrawAt center oval picture
= picture
where
r = (max (toInt (k*(toReal bRadius))) 2)-1
k = min kx ky
offset = bCenter-base
center = {x=toInt (kx*(toReal offset.x)),y=toInt (ky*(toReal offset.y))}
oval = {oval_rx=r,oval_ry=r}
ObjectIO/ObjectIO Examples/bounce/bounceTypes.dcl 0 → 100644
View file @ 42aafe76
definition module bounceTypes
import StdInt, StdClass, StdPicture, StdIOCommon
:: Barrel
= { bBase :: Point2 // the base point of the barrel
, bWalls :: [Wall] // the walls of the barrel
, bDomain :: BarrelDomain // the enclosing rectangular area of the barrel
}
:: Wall
:== ( !Vector2 // the displacement of the wall (a la Polygon)
, !Interior // the sign at what side the wall faces the interior
)
:: SingleWall
:== ( !Line // the exact pixel position of the wall
, !Interior
)
:: Line :== (!Point2,!Point2)
:: BarrelDomain :== Rectangle
:: Interior :== Int
:: Scale :== (!Real,!Real) // (horizontal scale, vertical scale)
:: Radius :== Int
:: Ball
= { bCenter :: Point2 // the center of the ball
, bRadius :: Radius // the radius of the ball
, bSpeed :: Vector2 // the direction and speed of the ball
, bColour :: Colour // the colour of the ball
}
rightBarrelSetUp :: (Barrel,[Ball])
leftBarrelSetUp :: (Barrel,[Ball])
BarrelToPolygon :: !Scale !Barrel -> (!Point2,!Polygon)
splitWallsInBarrel :: !Barrel -> (![SingleWall],![SingleWall])
between :: !a !a !a -> Bool | Ord a
dist :: !Point2 !Point2 -> Real
scaleSize :: !Size !Size -> Scale
ObjectIO/ObjectIO Examples/bounce/bounceTypes.icl 0 → 100644
View file @ 42aafe76
implementation module bounceTypes
import StdInt, StdBool, StdReal, StdList, StdFunc, StdTuple
import StdPicture, StdIOCommon
:: Barrel
= { bBase :: Point2 // the base point of the barrel
, bWalls :: [Wall] // the walls of the barrel
, bDomain :: BarrelDomain // the enclosing rectangular area of the barrel
}
:: Wall
:== ( !Vector2 // the displacement of the wall (a la Polygon)
, !Interior // the sign at what side the wall faces the interior
)
:: SingleWall
:== ( !Line // the exact pixel position of the wall
, !Interior
)
:: Line :== (!Point2,!Point2)
:: BarrelDomain :== Rectangle
:: Interior :== Int
:: Scale :== (!Real,!Real) // (horizontal scale, vertical scale)
:: Radius :== Int
:: Ball
= { bCenter :: Point2 // the center of the ball
, bRadius :: Radius // the radius of the ball
, bSpeed :: Vector2 // the direction and speed of the ball
, bColour :: Colour // the colour of the ball
}
leftBarrelSetUp :: (Barrel,[Ball])
leftBarrelSetUp
= ( { bBase = {x=600,y=100}
, bWalls = [ ({vx = -400,vy = 0 }, 1)
, ({vx = 0, vy = -99}, -1)
, ({vx = -199,vy = 0 }, 1)
, ({vx = 0, vy = 299}, 1)
, ({vx = 199, vy = 0 }, -1)
, ({vx = 0, vy = -100}, -1)
, ({vx = 400, vy = 0 }, -1)
]
, bDomain = {corner1={x=(-10),y=(-10)},corner2={x=600,y=310}}
}
, [ {bCenter={x=30,y=150},bRadius=15,bSpeed={vx=10,vy=3}, bColour=Red }
, {bCenter={x=60,y=150},bRadius=10,bSpeed={vx=5, vy=(-9)},bColour=Yellow}
]
)
rightBarrelSetUp :: (Barrel,[Ball])
rightBarrelSetUp
= ( { bBase = {x=600,y=100}
, bWalls = [ ({vx = 400, vy = 0 }, 1)
, ({vx = 0, vy = -99 }, 1)
, ({vx = 200, vy = 0 }, 1)
, ({vx = 0, vy = 299 },-1)
, ({vx = -200,vy = 0 },-1)
, ({vx = 0, vy = -100}, 1)
, ({vx = -400,vy = 0 },-1)
]
, bDomain = {corner1={x=600,y=(-10)},corner2={x=1210,y=310}}
}
, [ {bCenter={x=750,y=150},bRadius=8,bSpeed={vx=6,vy=(-9)},bColour=Magenta}
, {bCenter={x=800,y=140},bRadius=9,bSpeed={vx=(-2),vy=3},bColour=Blue }
]
)
BarrelToPolygon :: !Scale !Barrel -> (!Point2,!Polygon)
BarrelToPolygon scale {bBase,bWalls,bDomain}
= (scalebase scale bBase bDomain,{polygon_shape=map (scalewall scale) bWalls})
where
scalebase :: !Scale !Point2 !BarrelDomain -> Point2
scalebase (kx,ky) base {corner1}
= {x=toInt (kx*(toReal offset.x)),y=toInt (ky*(toReal offset.y))}
where
offset = base-corner1
scalewall :: !Scale !Wall -> Vector2
scalewall (kx,ky) ({vx,vy},_)
= {vx=toInt (kx*(toReal vx)),vy=toInt (ky*(toReal vy))}
splitWallsInBarrel :: !Barrel -> (![SingleWall],![SingleWall])
splitWallsInBarrel {bBase,bWalls}
= (horizontal,vertical)
where
(_,horizontal,vertical) = seq (map splitwall bWalls) (bBase,[],[])
splitwall :: !Wall !(!Point2,![SingleWall],![SingleWall]) -> (!Point2,![SingleWall],![SingleWall])
splitwall wall=:(v,interior) (base,horizontal,vertical)
| v.vx==0 = (base1,horizontal,[wall1:vertical])
| otherwise = (base1,[wall1:horizontal],vertical)
where
base1 = movePoint v base
wall1 = (orientLine (base,base1),interior)
orientLine :: !Line -> Line
orientLine (a=:{x=aX,y=aY},b=:{x=bX,y=bY})
| aX==bX
# (minY,maxY) = minmax aY bY
= ({a & y=minY},{b & y=maxY})
| otherwise
# (minX,maxX) = minmax aX bX
= ({a & x=minX},{b & x=maxX})
// Common functions:
between :: !a !a !a -> Bool | Ord a
between x low high
| x<=high = x>=low
| otherwise = False
minmax :: !a !a -> (!a,!a) | Ord a
minmax x y
| x<y = (x,y)
| otherwise = (y,x)
dist :: !Point2 !Point2 -> Real
dist {x=x1,y=y1} {x=x2,y=y2}
= sqrt (dX*dX+dY*dY)
where
dX = toReal (x2-x1)
dY = toReal (y2-y1)
scaleSize :: !Size !Size -> Scale
scaleSize size1 size2
= ((toReal size1.w)/(toReal size2.w),(toReal size1.h)/(toReal size2.h))
ObjectIO/ObjectIO Examples/clipboard viewer/clipboardview.icl 0 → 100644
View file @ 42aafe76
module clipboardview
// **************************************************************************************************
//
// A program that can show and set the current content of the clipboard.
//
// The program has been written in Clean 1.3.2 and uses the Clean Standard Object I/O library 1.2
//
// **************************************************************************************************
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: