summaryrefslogtreecommitdiff
path: root/files/practicum/Boid.icl
blob: 918206698acf0d5c45d502e8597f0902d92cd18b (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
module Boid

/*	Dit raamwerk toont een verzameling boids.
	Zie voor achtergrondinformatie:
		http://www.red3d.com/cwr/boids/
		http://www.vergenet.net/~conrad/boids/pseudocode.html
	Zet de 'Environment' op 'Object IO' en 'Project Options' op 'No Console'.
*/
import StdEnv, StdIO, support

::	BoidSt
 =	{	boids		:: ![Boid]
 	,	colours		:: ![Colour]
 	}
::	Boid
 =	{	pos			:: !Pos
 	,	vel			:: !Vel
 	,	col			:: !Colour
 	}

Start				:: *World -> *World
Start world			= startIO SDI {boids=[],colours=flatten (repeat colours)} (openIds 2 `bind` initGUI) [ProcessClose closeProcess] world

initGUI				:: [Id] (PSt BoidSt) -> PSt BoidSt
initGUI [windowId,timerId] pSt=:{ls}
# (errors,pSt)		= seqList [openWindow NilLS window,openTimer undef timer,openMenu undef menu] pSt
| all ((==) NoError) errors
					= pSt
| otherwise			= abort "Could not create the entire GUI.\n"
where
	window			= Window "Boids" NilLS
						[ WindowClose			(noLS closeProcess)
						, WindowViewSize		windowsize
						, WindowLook			True (look ls.boids)
						, WindowMouse			onlyDown Able (noLS1 mouse)
						, WindowId				windowId
						, WindowPen				[PenBack background]
						]
	timer			= Timer (ticksPerSecond / 20) NilLS [TimerFunction (noLS1 (const lockstep)),TimerId timerId,TimerSelectState Unable]
	menu			= Menu "&File"
						(   MenuItem "&Clear"	[MenuShortKey 'c',MenuFunction (noLS clear)]
						:+: MenuSeparator		[]
						:+: MenuItem "S&tep"	[MenuShortKey 't',MenuFunction (noLS lockstep)]
						:+: MenuItem "&Go"		[MenuShortKey 'g',MenuFunction (noLS (appPIO (enableTimer  timerId)))]
						:+: MenuItem "&Halt"	[MenuShortKey 'h',MenuFunction (noLS (appPIO (disableTimer timerId)))]
						:+: MenuSeparator		[]
						:+: MenuItem "&Quit"	[MenuShortKey 'q',MenuFunction (noLS closeProcess)]
						)	[]
	onlyDown mst	= case mst of
						MouseDown _ _ _ = True
						_				= False

/*	look tekent de boids.
*/	look			:: [Boid] SelectState UpdateState *Picture -> *Picture
	look boids _ {newFrame} picture
					= foldr (\{pos,col} -> appPicture (fillAt (toPoint2 wsize pos) boidbody o setPenColour col)) (unfill newFrame picture) boids
	where
		wsize		= rectangleSize newFrame

/*	lockstep berekent de volgende toestand van alle boids.
*/	lockstep pSt=:{ls}
		= appPIO (setWindowLook windowId True (True,look new_boids)) {pSt & ls={ls & boids = new_boids}}
	where
		new_boids	= simulatie ls.boids

/*	clear wist alle boids.
*/	clear pSt=:{ls}	= appPIO (setWindowLook windowId True (True,look [])) ({pSt & ls={ls & boids=[]}})

/*	mouse creeert een nieuwe boid met snelheid nul op de positie van de muis.
*/	mouse mSt pSt=:{ls=ls=:{boids,colours}}
					= case mSt of
						MouseDown pos _ _ 
							# (wsize,pSt)	= accPIO (getWindowViewFrame windowId) pSt
							# new			= {pos=fromPoint2 (rectangleSize wsize) pos,vel=zero,col=hd colours}
							# boids			= [new:boids]
							# pSt			= {pSt & ls={ls & boids=boids,colours=tl colours}}
							# pSt			= appPIO (setWindowLook windowId True (True,look boids)) pSt
							= pSt
						otherwise			= pSt

windowsize			= {w=640,h=400}	
colours				= [Red,Green,Blue,Cyan,Magenta,Yellow,LightGrey,Grey,DarkGrey]

boidbody			= circle 3
background			= Black
threshhold_dist		= 0.02
threshhold_wall		= 0.01
viewing_distance	= 0.3

/** Dit is de functie die je zelf moet schrijven. 
	Bereken de volgende toestand voor alle boids in de lijst.
*/
simulatie :: [Boid] -> [Boid]
simulatie ...