Commit 4c3d1aaf authored by Peter Achten's avatar Peter Achten
Browse files

(PA) checked new version.

parent 76f0d880
......@@ -68,9 +68,9 @@ where
showdifference :: (PSt Local) -> PSt Local
showdifference pst=:{ls={name1,name2}}
# pst = closeWindow showid pst
# (files,pst) = accFiles (openfilepair (name1,name2)) pst
# (files,pst) = openfilepair (name1,name2) pst
(maybeDifference,files) = comparefilepair 1 files
# pst = appFiles (closefilepair files) pst
# pst = closefilepair files pst
| isNothing maybeDifference
= appPIO beep pst
# (error,pst) = openDialog undef (dialog (fromJust maybeDifference)) pst
......
......@@ -28,7 +28,7 @@ where
, ControlId displayId
, ControlSelectState Unable
]
:+: CompoundControl
:+: LayoutControl
( ButtonControl "&-"
[ ControlFunction (upd (-1))
, ControlTip "Decrement counter value"
......
......@@ -44,13 +44,13 @@ openNotice notice pst
/* noticeToDialog converts a Notice expression into a Dialog expression.
*/
noticeToDialog :: Id Id (Notice .ls (PSt .l))
-> Dialog (:+: (CompoundControl (ListLS TextControl))
-> Dialog (:+: (LayoutControl (ListLS TextControl))
(:+: ButtonControl
(ListLS ButtonControl)
)) .ls (PSt .l)
noticeToDialog wId okId (Notice texts (NoticeButton text f) buttons)
= Dialog ""
( CompoundControl
( LayoutControl
( ListLS
[ TextControl text [ControlPos (Left,zero)]
\\ text <- texts
......
......@@ -146,15 +146,15 @@ where
/* The definition of the assembled colour picking control: */
:: ColourPickControl ls pst
/* :== ( CompoundControl
( :+: (CompoundControl (ListLS RGBPickControl)))
/* :== ( LayoutControl
( :+: (LayoutControl (ListLS RGBPickControl)))
( :+: ColourBoxControl
ColourPickAccess
))
) ls pst
*/ :== NewLS
( CompoundControl
( :+: (CompoundControl (ListLS (:+: SliderControl TextControl)))
( LayoutControl
( :+: (LayoutControl (ListLS (:+: SliderControl TextControl)))
( :+: CustomControl
(Receiver2 In Out)
))
......@@ -163,8 +163,8 @@ where
ColourPickControl :: RGBId [Id] RGBColour (Maybe ItemPos) -> ColourPickControl .ls (PSt .l)
ColourPickControl rgbid ids initrgb maybePos
= { newLS = initrgb
, newDef= CompoundControl
( CompoundControl
, newDef= LayoutControl
( LayoutControl
( ListLS
[ RGBPickControl initrgb rpicks did (\rgb->rgb.r) (\x rgb->{rgb&r=x}) left
, RGBPickControl initrgb gpicks did (\rgb->rgb.g) (\x rgb->{rgb&g=x}) left
......
......@@ -4,7 +4,12 @@ module slidegame
// **************************************************************************************************
//
// A simple slide game that uses bitmaps to show nice pictures.
// On Macintosh one should select a PICT file; on Windows(95/NT) one should select a BMP file.
// On Macintosh:
// * Make sure the application has sufficient 'Extra memory' (Application options)
// * Select a PICT file;
// On Windows(95/NT):
// * Make sure the application has sufficient 'Heap' (Application options)
// * Select a BMP file.
//
// The program has been written in Clean 1.3.2 and uses the Clean Standard Object I/O library 1.2
//
......@@ -21,11 +26,11 @@ import StdEnv, StdIO, Random
The local state of the window keeps track of the current position of the hole.
*/
:: WindowState
= { curHole :: Coord // The current position of the hole
= { curHole :: !Coord // The current position of the hole
}
:: Coord
= { col :: Int // The zero based column number
, row :: Int // The zero based row number
= { col :: !Int // The zero based column number
, row :: !Int // The zero based row number
}
Start :: *World -> *World
......
......@@ -59,11 +59,11 @@ where
cell = CellContents pos tape
dialog ids = Dialog "Change Tape Cell"
( CompoundControl
( LayoutControl
( TextControl "Write:" []
:+: EditControl "" (PixelWidth (hmm 15.0)) 1 [ControlId celId]
) [ControlPos (Center,zero)]
:+: CompoundControl
:+: LayoutControl
( ButtonControl "Cancel" [ControlFunction (noLS (Cancel pos cell))]
:+: ButtonControl "OK" [ControlFunction (noLS (Ok pos )),ControlId okId]
) [ControlPos (Center,zero)]
......@@ -104,7 +104,7 @@ where
ctos c = if (c==' ') "" (toString c)
dialog ids = Dialog "Change Transition"
( CompoundControl
( LayoutControl
( TextControl "From:" [ ControlPos (Left,zero)
, ControlWidth (PixelWidth (hmm 20.0))
]
......@@ -116,7 +116,7 @@ where
:+: EditControl (ctos transition.sigma) (PixelWidth (hmm 25.0)) 1 [ ControlId headId
]
) [ControlHMargin 0 0,ControlVMargin 0 0]
:+: CompoundControl
:+: LayoutControl
( TextControl "To:" [ ControlPos (Left,zero)
, ControlWidth (PixelWidth (hmm 20.0))
]
......@@ -128,7 +128,7 @@ where
:+: EditControl (ctos transition.move) (PixelWidth (hmm 25.0)) 1 [ ControlId moveId
]
) [ControlHMargin 0 0,ControlVMargin 0 0]
:+: CompoundControl
:+: LayoutControl
( ButtonControl "Cancel" [ControlFunction (noLS (Cancel tnr transition))]
:+: ButtonControl "Remove" [ControlFunction (noLS (Remove tnr))]
:+: ButtonControl "OK" [ControlFunction (noLS (Ok tnr)),ControlId okId]
......@@ -190,7 +190,7 @@ where
dialog ids = Dialog "Change State"
( TextControl "State:" [ControlPos (Left,zero)]
:+: EditControl "" (PixelWidth (hmm 25.0)) 1 [ControlId editId]
:+: CompoundControl
:+: LayoutControl
( ButtonControl "Cancel" [ControlFunction (noLS (Cancel state))]
:+: ButtonControl "OK" [ControlId okId,ControlFunction (noLS Ok)]
) [ControlPos (Center,zero)]
......
......@@ -177,7 +177,9 @@ where
// The function for the Quit command: stop the program and write the high scores to file.
Quit :: (PSt Local) -> PSt Local
Quit pst=:{ls=ls=:{hifile,state={best}}}
= writeHiScores hifile best (closeProcess {pst & ls={ls & hifile=undef}})
# pst = {pst & ls={ls & hifile=undef}}
# pst = closeProcess pst
= writeHiScores hifile best pst
// Set a new speed (called when one of the Options commands is chosen).
SetSpeed :: Int (PSt Local) -> PSt Local
......
......@@ -14,7 +14,7 @@ chatPort :== 2000
remote :== "martinpc.cs.kun.nl"
CR :== '\xD' // carriage return
:: *LS // the ls part of th PSt
:: *LS // the ls part of the PSt
= { sndChan :: TCP_SChannel
, nickname :: String
}
......@@ -23,6 +23,7 @@ CR :== '\xD' // carriage return
:: NoState
= NoState // The singleton data type
Start :: *World -> *World
Start world
= startIO SDI { sndChan=undef, nickname=""} initialize [ProcessWindowSize zero] world
......
......@@ -84,7 +84,7 @@ loop listener channels console world
broadcastString :: !String ![ChanInfo] ![ChanInfo] !*World -> ([ChanInfo],!*World)
broadcastString string [] akku world
= (reverse akku, world)
= (u_reverse akku, world)
broadcastString string [channel=:{sndChan}:channels] akku world
# (sndChan, world) = send (toByteSeq string) sndChan world
= broadcastString string channels [{channel & sndChan=sndChan}:akku] world
......@@ -114,3 +114,8 @@ zip3 :: ![TCP_SChannel] ![!TCP_RChannel] ![String] -> [!ChanInfo]
zip3 [] [] [] = []
zip3 [sndChan:a] [rcvChan:b] [nickname:c]
= [{sndChan=sndChan, rcvChan=rcvChan, nickname=nickname} : zip3 a b c]
u_reverse list = reverse_ list []
where
reverse_ [hd:tl] list = reverse_ tl [hd:list]
reverse_ [] list = list
......@@ -8,7 +8,7 @@ module downloadHTTP
//
// **************************************************************************************************
import StdEnv, StdTCP, StdMaybe
import StdEnv, StdTCP, StdIO
from StdSystem import ticksPerSecond
server :== "www.cs.kun.nl"
......@@ -57,5 +57,3 @@ Start world
world = closeRChannel rc world
world = closeChannel sc world
= fclose console world
Markdown is supported
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