Skip to content
GitLab
Commit 87693c9d authored by Peter Achten's avatar Peter Achten
Browse files

(PA) modifications for Clean 2.0 compatibility.

parent d40c8434
Hide whitespace changes
Inline Side-by-side
libraries/ObjectIO/ObjectIO Examples/bounce/bounce.icl
View file @ 87693c9d
......@@ -52,6 +52,7 @@ where
splitWalls = splitWallsInBarrel barrel
initLocal = {talkTo=you,barrel=barrel,balls=balls}
initIO :: Bounce -> Bounce
initIO pst
# (error,pst) = openWindow undef window pst
| error<>NoError
......@@ -67,14 +68,68 @@ where
= 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)
where
// 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)
]
// 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']
) []
// 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 -> Bounce
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
receiver = Receiver me (noLS1 (receive splitWalls)) []
where
receive :: !(![SingleWall],![SingleWall]) !Message !Bounce -> Bounce
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
updateBalls :: Local SelectState UpdateState *Picture -> *Picture
updateBalls {balls,barrel} _ {oldFrame,newFrame,updArea} picture
......@@ -88,64 +143,10 @@ where
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 -> Bounce
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 -> Bounce
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
receiver = Receiver me (noLS1 (receive splitWalls)) []
where
receive :: !(![SingleWall],![SingleWall]) !Message !Bounce -> Bounce
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 -> Bounce
bounceHelp bounce
......
libraries/ObjectIO/ObjectIO Examples/compare/compare.icl
View file @ 87693c9d
......@@ -50,7 +50,7 @@ where
where
compare :: (PSt Local) -> PSt Local
compare pst
# (maybeFirstFile,pst) = selectInputFile pst
# (maybeFirstFile,pst) = selectInputFile pst
| isNothing maybeFirstFile
= {pst & ls=noFilesSelected}
# (maybeSecondFile,pst) = selectInputFile pst
......
libraries/ObjectIO/ObjectIO Examples/gui utilities/Help.dcl
View file @ 87693c9d
......@@ -8,8 +8,8 @@ definition module Help
//
// **************************************************************************************************
from StdString import String
from StdPSt import PSt, IOSt
import StdString
from StdPSt import PSt, IOSt
showAbout :: String String (PSt .l) -> PSt .l
/* showAbout opens a window:
......
libraries/ObjectIO/ObjectIO Examples/gui utilities/Help.icl
View file @ 87693c9d
......@@ -199,13 +199,13 @@ where
= (({w=maxx,h=maxy},[]),pState)
centerInfoLine :: Font Int InfoLine (PSt .l) -> (InfoLine,PSt .l)
centerInfoLine nft maxx info=:(inft=:NoFont centered,x,y,line) pState
centerInfoLine nft maxx info=:(inft=:(NoFont centered),x,y,line) pState
| not centered
= (info,pState)
| otherwise
# (width,pState) = accPIO (accScreenPicture (getFontStringWidth nft line)) pState
= ((inft,(maxx-width)/2,y,line),pState)
centerInfoLine nft maxx info=:(inft=:InfoFont font centered,x,y,line) pState
centerInfoLine nft maxx info=:(inft=:(InfoFont font centered),x,y,line) pState
| not centered
= (info,pState)
| otherwise
......
libraries/ObjectIO/ObjectIO Examples/gui utilities/Highscore.dcl
View file @ 87693c9d
......@@ -8,10 +8,10 @@ definition module Highscore
//
// **************************************************************************************************
from StdFile import FileSystem
from StdString import String
from StdPSt import PSt, IOSt
from StdId import Id
import StdString
from StdFile import FileSystem, Files
from StdPSt import PSt, IOSt
from StdId import Id
:: HiScores
:== [HiScore]
......
libraries/ObjectIO/ObjectIO Examples/gui utilities/Random.icl
View file @ 87693c9d
......@@ -2,7 +2,7 @@ implementation module Random
import StdInt, StdClass
from StdTime import getCurrentTime, Time
import StdTime
:: RandomSeed :== Int
......
libraries/ObjectIO/ObjectIO Examples/scrabble/Nederlands/language.dcl
View file @ 87693c9d
definition module language
import StdList, StdArray, _SystemArray, StdEnum
import StdList, StdArray, /*_SystemArray,*/ StdEnum
import StdIOCommon, StdSystem, StdTime
import board
......
libraries/ObjectIO/ObjectIO Examples/scrabble/Nederlands/language.icl
View file @ 87693c9d
implementation module language
import StdBool, StdList, StdArray, _SystemArray, StdEnum
import StdBool, StdList, StdArray, /*_SystemArray,*/ StdEnum
import StdIOCommon, StdSystem, StdTime
import types
......
libraries/ObjectIO/ObjectIO Examples/scrabble/Windows95/systemsettings.icl
View file @ 87693c9d
......@@ -12,9 +12,6 @@ import StdPictureDef
// Font information:
//font size :== snd (SelectFont "MS Sans Serif" [] 8)
//letterfont :== snd (SelectFont "Times" ["Bold"] 9)
//smallfont :== snd (SelectFont "Small Fonts" [] 6)
font size :== {SansSerifFontDef & fSize=8}
letterfont :== { SerifFontDef & fSize=9,fStyles=[BoldStyle]}
smallfont :== { SmallFontDef & fSize=6}
......
libraries/ObjectIO/ObjectIO Examples/scrabble/board.dcl
View file @ 87693c9d
definition module board
from StdString import String
import StdString
import StdClass, StdFile
import types
......
libraries/ObjectIO/ObjectIO Examples/scrabble/board.icl
View file @ 87693c9d
......@@ -206,7 +206,7 @@ where
# (ls,possible,lwrds,wwrds) = tryaddtoline ls word p (n-1)
= ([l:ls],possible,lwrds,wwrds)
hdtl :: ![.x] -> (.x,[.x])
hdtl :: !v:[u:x] -> v:(u:x,v:[u:x]), [v<=u]
hdtl [x:xs] = (x,xs)
tryaddtolines [r:rs] w p j
# (rs,possible,scorenewletters,worddoubling) = tryaddtolines rs w p (j-1)
......
libraries/ObjectIO/ObjectIO Examples/scrabble/scrabble.icl
View file @ 87693c9d
module scrabble
/* Original program written by Paul de Mast in the functional programming language Amanda.
This program is the translated and adapted version to Clean 1.3.2, using the 1.2 object I/O library.
*/
// **************************************************************************************************
//
// This program implements the Scrabble game (without blank letters).
// Original program written by Paul de Mast in the functional programming language Amanda.
// This program is the translated and adapted version to Clean 1.3.2.
// It uses the Clean Standard Object I/O library 1.2.
//
// **************************************************************************************************
import StdEnv, StdIO
......
libraries/ObjectIO/ObjectIO Examples/scrabble/types.icl
View file @ 87693c9d
......@@ -125,7 +125,7 @@ where
# (lines,f) = readlines f
length = size line
| length>1
= ([fromString (line%(0,length-2)):lines],f) // remove '\n'
= ([line%(0,length-2):lines],f) // remove '\n'
| otherwise
= (lines,f)
......
libraries/ObjectIO/ObjectIO Examples/simple database/database.icl
View file @ 87693c9d
......@@ -717,7 +717,7 @@ moveinlist src dest l // should be in StdList
where
(beforedest,atdest) = splitAt dest l
splitby :: a !.[a] -> [.[a]] | == a
splitby :: a !.[a] -> [.[a]] | Eq a
splitby x ys
= case rest of [] -> [firstpart]; [r:rs] -> [firstpart:splitby x rs]
where
......
libraries/ObjectIO/ObjectIO Examples/turing/showtm.icl
View file @ 87693c9d
implementation module showtm
import StdArray, StdClass, StdInt
import StdArray, StdBool, StdClass, StdInt
from StdString import length, %
from StdChar import toString
from StdBool import &&, otherwise
import StdPicture
import tm
......@@ -43,9 +42,9 @@ where
# pic = DrawCellBorders x y1 y2 pic
= pic
where
x = Offset-4
y1 = TapeY -13
y2 = TapeY +5
x = Offset - 4
y1 = TapeY - 13
y2 = TapeY + 5
DrawCellBorders :: !Int Int Int !*Picture -> *Picture
DrawCellBorders x y1 y2 pic
......@@ -128,9 +127,9 @@ ShowTapePart {content,head} start end pic
# pic = DrawHeadRect (HeadPos head) Red pic
= pic
where
x = Offset-4
y1 = TapeY -13
y2 = TapeY +5
x = Offset - 4
y1 = TapeY - 13
y2 = TapeY + 5
ShowContPart :: Int Int !Int String Int !Int !*Picture -> *Picture
ShowContPart i l x s f t pic
......
libraries/ObjectIO/ObjectIO Examples/turing/tm.dcl
View file @ 87693c9d
definition module tm
from StdString import String
import StdString
:: TmState
= { turing :: !Turing
......
libraries/ObjectIO/ObjectIO Examples/turing/tmfile.dcl
View file @ 87693c9d
definition module tmfile
from StdString import String
from StdFile import FileSystem
import StdString
from StdFile import FileSystem, Files
from tm import Turing, Transition, Tape, State, Head
WriteTuringToFile :: Turing !String !*env -> (!Bool,!*env) | FileSystem env
......
libraries/ObjectIO/ObjectIO Examples/typist/monitor.icl
View file @ 87693c9d
......@@ -54,17 +54,29 @@ where
# (error,pst) = openReceiver False receiver pst
| error<>NoError = abort "monitor could not open receiver."
| otherwise = pst
where
// window is the single document of the monitor process.
window = Window "Monitor" NilLS
[ WindowId wId
, WindowPos pos
, WindowViewDomain pDomain
, WindowLook True (monitorlook initLocal)
, WindowInit (noLS (appPIO (appWindowPicture wId (setPenFont font))))
]
pDomain = {corner1=zero,corner2={x=WindowWidth,y=WindowHeight}}
// window is the single document of the monitor process.
window = Window "Monitor" NilLS
[ WindowId wId
, WindowPos pos
, WindowViewDomain pDomain
, WindowLook True (monitorlook initLocal)
, WindowInit (noLS (appPIO (appWindowPicture wId (setPenFont font))))
]
pDomain = {corner1=zero,corner2={x=WindowWidth,y=WindowHeight}}
// The timer gathers per second the number of good and bad key hits.
// The monitor window is updated by drawing only the new diagram bars.
timer = Timer ticksPerSecond NilLS
[ TimerId tId
, TimerSelectState Unable
, TimerFunction (noLS1 (showKeyHits False))
]
// The receiver is the interface of the monitor process to the typist process.
receiver :: *Receiver MonitorMessage Bool (PSt Monitor)
receiver= Receiver monitorId receive []
// monitorlook defines the look of the monitor window.
monitorlook :: Monitor SelectState UpdateState *Picture -> *Picture
......@@ -75,14 +87,6 @@ where
# picture = seq (snd (smap drawKeyHitColumn (0,counts))) picture
| tracking = picture
| otherwise = drawTotalAndAverage font metrics counts picture
// The timer gathers per second the number of good and bad key hits.
// The monitor window is updated by drawing only the new diagram bars.
timer = Timer ticksPerSecond NilLS
[ TimerId tId
, TimerSelectState Unable
, TimerFunction (noLS1 (showKeyHits False))
]
showKeyHits :: Bool NrOfIntervals (PSt Monitor) -> PSt Monitor
showKeyHits final dt monitor=:{ls=local=:{count,counts,time},io}
......@@ -95,10 +99,6 @@ where
newlocal = {local & count=initcount,counts=counts++newcounts,time=time+dt}
drawfs = snd (smap drawKeyHitColumn (time,newcounts))
// The receiver is the interface of the monitor process to the typist process.
receiver :: *Receiver MonitorMessage Bool (PSt Monitor)
receiver= Receiver monitorId receive []
receive :: MonitorMessage (Bool,PSt Monitor) -> (Bool,PSt Monitor)
// Starting a tracking session enables the timer and clears all previous tracking information.
......@@ -114,8 +114,8 @@ where
where
incCount :: Char Monitor -> Monitor
incCount c local=:{count}
| c=='\b' = {local & count={count & bads=count.bads+1}}
| otherwise = {local & count={count & oks =count.oks +1}}
| c=='\b' = {local & count={count & bads=count.bads + 1}}
| otherwise = {local & count={count & oks =count.oks + 1}}
// Ending a session disables the timer and presents the number and average of key hits.
receive EndSession (firstkeyreceived,monitor=:{ls=local=:{time}})
......
libraries/ObjectIO/ObjectIO Examples/worm/worm.icl
View file @ 87693c9d
......@@ -76,23 +76,23 @@ where
# pict = setPenFont font pict
= pict
filemenu = Menu "File"
( MenuItem "Play" [MenuId playID,MenuShortKey 'r',MenuFunction (noLS Play)]
:+: MenuItem "Halt" [MenuId haltID,MenuShortKey '.',MenuFunction (noLS Halt),MenuSelectState Unable]
filemenu = Menu "&File"
( MenuItem "&Play" [MenuId playID,MenuShortKey 'r',MenuFunction (noLS Play)]
:+: MenuItem "&Halt" [MenuId haltID,MenuShortKey '.',MenuFunction (noLS Halt),MenuSelectState Unable]
:+: MenuSeparator []
:+: MenuItem "About Worm..." [MenuFunction (noLS (showAbout "Worm" HelpFile))]
:+: MenuItem "Help" [MenuFunction (noLS (showHelp HelpFile))]
:+: MenuItem "&About Worm..." [MenuFunction (noLS (showAbout "Worm" HelpFile))]
:+: MenuItem "H&elp" [MenuFunction (noLS (showHelp HelpFile))]
:+: MenuSeparator []
:+: MenuItem "Quit" [MenuId quitID,MenuShortKey 'q',MenuFunction (noLS Quit)]
:+: MenuItem "&Quit" [MenuId quitID,MenuShortKey 'q',MenuFunction (noLS Quit)]
) [MenuId fileID]
optionsmenu = Menu "Options"
optionsmenu = Menu "&Options"
( RadioMenu
[ ("Slow" ,Nothing,Just '1',noLS (SetSpeed EasySpeed) )
, ("Medium",Nothing,Just '2',noLS (SetSpeed MediumSpeed))
, ("Fast" ,Nothing,Just '3',noLS (SetSpeed HardSpeed) )
[ ("&Slow" ,Nothing,Just '1',noLS (SetSpeed EasySpeed) )
, ("&Medium",Nothing,Just '2',noLS (SetSpeed MediumSpeed))
, ("&Fast" ,Nothing,Just '3',noLS (SetSpeed HardSpeed) )
] 1 []
:+: MenuSeparator []
:+: MenuItem "High Scores" [MenuShortKey 'h',MenuFunction (noLS ShowBest)]
:+: MenuItem "&High Scores" [MenuShortKey 'h',MenuFunction (noLS ShowBest)]
)
[ MenuId levelID
]
......
libraries/ObjectIO/Tcp Examples/chat/chatClient.icl
View file @ 87693c9d
......@@ -20,9 +20,6 @@ CR :== '\xD' // carriage return
}
:: *PState :== PSt LS
:: NoState
= NoState // The singleton data type
Start :: *World -> *World
Start world
= startIO SDI { sndChan=undef, nickname=""} initialize [ProcessWindowSize zero] world
......@@ -49,10 +46,10 @@ initialize ps
ControlFunction (noLS1 ok (dialogId, nicknameId, rmtsiteId)),
ControlPos (Right, zero)]
) [WindowId dialogId, WindowOk buttonId]
# ((errReport, _), ps) = openModalDialog NoState dDef ps
# ((errReport, _), ps) = openModalDialog Void dDef ps
| errReport<>NoError
= abort "can't open modal dialog"
# (_, ps) = openWindow NoState (Window "dummy" NilLS [WindowViewSize {w=100,h=30}]) ps
# (_, ps) = openWindow Void (Window "dummy" NilLS [WindowViewSize {w=100,h=30}]) ps
= ps
where
ok (dialogId, nicknameId, rmtsiteId) ps
......@@ -97,7 +94,7 @@ initialize ps
, MenuFunction (noLS quit)
]
) []
# (errReport,ps) = openMenu NoState menu ps
# (errReport,ps) = openMenu Void menu ps
| errReport<>NoError
= abort "chat could not open menu."
......@@ -106,7 +103,7 @@ initialize ps
// open send notifier to eventually flush the send channels buffer
# (errReport, sChannel, ps)
= openSendNotifier NoState
= openSendNotifier Void
(SendNotifier sChannel (noLS1 sReceiver) []) ps
| errReport<>NoError
= abort "chat could not open receiver."
......
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