Listing: 1 (*# check(stack=>off, 2 index=>off, 3 range=>off, 4 overflow=>off, 5 nil_ptr=>off) *) 6 7 8 (*%F _mthread*) This program is only valid in multithread model (*%E*) 9 MODULE Demo; 10 IMPORT SYSTEM,IO,Window,Lib,Process ; 11 FROM Lib IMPORT RANDOM ; ***** ^ duplicate identifier 12 13 14 CONST 15 xNum = Window.ScreenWidth; ***** ^ not supported yet ***** ^ not supported yet 16 yNum = Window.ScreenDepth; ***** ^ not supported yet ***** ^ not supported yet 17 CarNum = 100 ; 18 19 TYPE 20 xCoord = [0..xNum-1] ; 21 yCoord = [0..yNum-1] ; 22 23 Coord = RECORD 24 x : xCoord ; 25 y : yCoord ; 26 END ; ***** ^ not supported yet 27 28 Direction = (East,South,North,West) ; 29 30 DirSet = SET OF Direction ; ***** ^ not supported yet 31 32 Location = RECORD 33 Entry,Exit : DirSet ; 34 Occupied : BOOLEAN ; 35 Scenery : SHORTCARD ; 36 END ; ***** ^ not supported yet 37 38 DA = ARRAY Direction OF Direction ; ***** ^ not supported yet ***** ^ not supported yet 39 40 CarRange = [0..CarNum-1] ; ***** ^ not supported yet 41 42 CONST 43 44 Reverse = DA(West,North,South,East) ; (* reverse of Direction *) ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 46 47 VAR 48 49 World : ARRAY xCoord,yCoord OF Location; ***** ^ not supported yet 50 51 Car : ARRAY CarRange OF 52 RECORD 53 Pos : Coord; 54 Color : Window.Color; 55 Speed : CARDINAL ; (* MPH*10 *) 56 LastD : Direction ; 57 END; 58 59 ToNorth : ARRAY yCoord OF CARDINAL ; 60 ToSouth : ARRAY yCoord OF CARDINAL ; 61 ToEast : ARRAY xCoord OF CARDINAL ; 62 ToWest : ARRAY xCoord OF CARDINAL ; 63 64 IsBW : BOOLEAN ; 65 66 VAR (*W+*) (* Volatile *) 67 68 AvSpeed : CARDINAL; 69 MaxCar : CarRange ; 70 71 (*$W=*) 72 73 74 PROCEDURE Plot(x : xCoord; y : yCoord ); 75 76 TYPE 77 Chars = ARRAY SHORTCARD [0..15] OF SHORTCARD ; 78 CONST 79 Road = Chars(176,32,32,201,32,200,186,204,32,205,187,203,188,202,185,206); 80 VAR 81 loc : Location; 82 sc : SHORTCARD ; 83 color : Window.Color ; 84 BEGIN 85 loc := World[x,y] ; 86 sc := Road[SHORTCARD(loc.Entry+loc.Exit)]; 87 IF sc=176 THEN 88 IF IsBW THEN color := Window.LightGray 89 ELSE color := Window.Brown 90 END ; 91 ELSIF sc=32 THEN RETURN 92 ELSE color := Window.LightGray ; 93 END ; 94 Window.TextColor(color); 95 Window.DirectWrite(x+1,y+1,ADR(sc),1) ; 96 END Plot; 97 98 PROCEDURE PlotCar( v : CarRange ; dir : Direction ); 99 100 TYPE 101 Chars = ARRAY Direction OF SHORTCARD ; 102 CONST 103 CarSym = Chars(16,31,30,17) ; 104 BEGIN 105 Window.TextColor(Car[v].Color); 106 Window.DirectWrite(Car[v].Pos.x+1,Car[v].Pos.y+1,ADR(CarSym[dir]),1) ; 107 END PlotCar; 108 109 110 111 PROCEDURE NewCar ; 112 VAR 113 x : xCoord ; 114 y : yCoord ; 115 v : CarRange ; 116 d : Direction ; 117 BEGIN 118 INC(MaxCar) ; 119 v := MaxCar ; 120 d := MAX(Direction); 121 LOOP 122 IF d=MAX(Direction) THEN 123 REPEAT 124 x := RANDOM(xNum); y := RANDOM(yNum) ; 125 UNTIL NOT World[x,y].Occupied ; 126 d := MIN(Direction) ; 127 ELSE 128 INC(d) ; 129 END ; 130 IF d IN World[x,y].Exit THEN EXIT END ; 131 END ; 132 World[x,y].Occupied := TRUE ; 133 WITH Car[v] DO 134 Pos.x := x ; Pos.y := y ; 135 Speed := RANDOM(100) ; 136 LastD := Direction(RANDOM(4)); 137 END ; 138 IF IsBW THEN Car[v].Color := Window.White ; 139 ELSE Car[v].Color := Window.Color( 9+RANDOM(7) ) ; 140 END ; 141 PlotCar(v,d) ; 142 END NewCar ; 143 144 PROCEDURE ParkCar ( v : CarRange ) ; 145 VAR 146 x : xCoord ; 147 y : yCoord ; 148 BEGIN 149 x := Car[v].Pos.x ; y := Car[v].Pos.y ; 150 IF MaxCar = 0 THEN HALT END ; 151 World[x,y].Occupied := FALSE ; 152 Plot(x,y); 153 WHILE vSpeedLimit THEN Speed := SpeedLimit END ; 174 IF Speedexit THEN 198 (* Cornering *) 199 Speed := Speed DIV 2 ; 200 LastD := exit ; 201 END ; 202 END ; 203 PlotCar(v,exit); 204 RETURN ; 205 END; 206 END; 207 INCL(tried,exit); 208 IF tried = DirSet{East..West} THEN 209 Car[v].Speed := 0 (* Stop *) ; RETURN ; 210 RETURN ; 211 END; 212 END; 213 END MoveCar; 214 215 216 217 218 219 PROCEDURE InitWorld; 220 221 PROCEDURE ok( x:xCoord ; y:yCoord ) : BOOLEAN; 222 223 (* Returns whether we have planning permission to build road at x,y *) 224 (* Tries to avoid making very small plots of land *) 225 226 BEGIN 227 RETURN ( World[ x,y ].Exit = DirSet{} ) OR 228 ( World[ ToEast[x],y ].Exit = DirSet{} ) OR 229 ( World[ ToEast[x],ToSouth[y] ].Exit = DirSet{} ) OR 230 ( World[ x,ToSouth[y] ].Exit = DirSet{} ) ; 231 END ok; 232 233 234 VAR 235 x,newx : xCoord ; 236 y,newy : yCoord ; 237 n : CARDINAL; 238 newdir, 239 newentry: Direction; 240 v : CarRange ; 241 BEGIN 242 FOR x := MIN(xCoord) TO MAX(xCoord) DO 243 ToEast[x] := (x+1)MOD xNum ; 244 ToWest[x] := (x+xNum-1)MOD xNum ; 245 END ; 246 FOR y := MIN(yCoord) TO MAX(yCoord) DO 247 ToSouth[y] := (y+1)MOD yNum ; 248 ToNorth[y] := (y+yNum-1)MOD yNum ; 249 END ; 250 Lib.Fill(ADR(World),SIZE(World),0) ; 251 x := xNum DIV 2; y := yNum DIV 2; 252 newx := x; newy := y; 253 newdir := Direction(RANDOM(4)); 254 n := 1000 + RANDOM(1000); 255 (* initialise map using randomish walk of n steps *) 256 WHILE n <> 0 DO 257 DEC(n); 258 IF RANDOM(4)=0 THEN 259 newdir := Direction(RANDOM(4)); 260 END; 261 WHILE newdir IN World[x,y].Entry DO (* enforce one-way streets *) 262 newdir := Direction(RANDOM(4)) ; 263 END; 264 newx := x; newy := y; 265 CASE newdir OF 266 | East : newx := ToEast[x] ; 267 | South : newy := ToSouth[y] ; 268 | North : newy := ToNorth[y] ; 269 | West : newx := ToWest[x] ; 270 END; 271 newentry := Reverse[newdir] ; 272 IF NOT ( newentry IN World[newx,newy].Entry ) THEN 273 INCL( World[newx,newy].Entry, newentry ); 274 IF (RANDOM(50)=0) OR 275 ( ok( newx, newy ) AND 276 ok( ToWest[newx], newy ) AND 277 ok( ToWest[newx], ToNorth[newy] ) AND 278 ok( newx, ToNorth[newy] ) 279 ) 280 THEN 281 INCL( World[x,y].Exit, newdir ); 282 Plot( x, y ); 283 Plot( newx,newy ); 284 Plot( ToEast[x],y ); 285 Plot( ToWest[x],y ); 286 Plot( x, ToNorth[y] ); 287 Plot( x, ToSouth[y] ); 288 x := newx; y := newy; 289 ELSE 290 EXCL( World[newx,newy].Entry, newentry ); 291 END; 292 ELSE 293 x := newx; y := newy; 294 END; 295 END; 296 (* make some cars *) 297 MaxCar := MAX(CARDINAL) ; 298 FOR v := 1 TO CarNum-RANDOM(50) DO 299 NewCar ; 300 END; 301 END InitWorld; 302 303 304 305 PROCEDURE Statistics ; 306 CONST 307 MsgWindowDef = Window.WinDef ( 5,5, 37,10, 308 Window.Blue,Window.LightGray, 309 FALSE,TRUE,FALSE,TRUE, 310 Window.SingleFrame, 311 Window.Red, Window.LightGray ); 312 VAR 313 MsgW : Window.WinType; 314 MsgX,MsgY : CARDINAL; 315 WD : Window.WinDef ; 316 count : CARDINAL ; 317 change : BOOLEAN ; 318 BEGIN 319 WD := MsgWindowDef ; 320 IF IsBW THEN 321 WD.Foreground := Window.Black ; 322 WD.FrameBack := Window.LightGray ; 323 WD.FrameFore := Window.Black ; 324 END ; 325 326 MsgW := Window.Open( WD ); 327 Window.SetTitle(MsgW,' TopSpeed Modula-2 Demo ',Window.CenterUpperTitle) ; 328 MsgX := 5 ; MsgY := 5 ; 329 Window.Use(MsgW); 330 count := 200 ; 331 LOOP 332 Process.Delay(1) ; 333 IO.WrLn; 334 IO.WrStr('Cars: ');IO.WrCard(MaxCar+1,1) ; 335 IO.WrStr(' Average Speed: ');IO.WrCard(AvSpeed DIV 10, 1 ); 336 IO.WrChar('.');IO.WrCard(AvSpeed MOD 10, 1 ); 337 IF count=0 THEN 338 MsgX := RANDOM(50); 339 MsgY := RANDOM(20); 340 count := 200 ; 341 ELSE 342 DEC(count) ; 343 END ; 344 change := TRUE ; 345 IF WD.X1+2MsgX+2 THEN DEC(WD.X1,3);DEC(WD.X2,3); 347 ELSIF WD.Y1=MsgY THEN change := FALSE ; 348 END ; 349 IF WD.Y1MsgY THEN DEC(WD.Y1);DEC(WD.Y2); 351 END ; 352 IF change THEN 353 Window.Change(MsgW,WD.X1,WD.Y1,WD.X2,WD.Y2) ; 354 END ; 355 END ; 356 END Statistics; 357 358 359 PROCEDURE RunSimulation ; 360 VAR 361 v : CARDINAL; 362 i : CARDINAL; 363 SumSpeed : CARDINAL ; 364 up : BOOLEAN ; 365 c : CHAR ; 366 BEGIN 367 up := TRUE ; 368 LOOP 369 SumSpeed := 0; 370 v := MaxCar+1 ; 371 REPEAT 372 DEC(v) ; 373 MoveCar(v) ; 374 SumSpeed := SumSpeed + Car[v].Speed ; 375 UNTIL v=0; 376 IF IO.KeyPressed() THEN 377 c := IO.RdKey() ; 378 EXIT 379 END ; 380 AvSpeed := SumSpeed DIV (MaxCar+1); 381 (* Add or subtract card *) 382 IF RANDOM(5)=0 THEN 383 IF MaxCar=1 THEN up := TRUE 384 ELSIF MaxCar=CarNum-1 THEN up := FALSE ; 385 END ; 386 IF up THEN NewCar ELSE ParkCar(RANDOM(MaxCar+1)) END ; 387 Window.TextColor(Window.Black) ; 388 END ; 389 END ; 390 END RunSimulation ; 391 392 PROCEDURE Intro ; 393 VAR 394 DescWin : Window.WinType ; 395 r : CARDINAL ; 396 BEGIN 397 Window.CursorOff ; 398 Window.SetProcessLocks(Process.Lock,Process.Unlock) ; 399 DescWin := Window.Open(Window.WinDef(0,11,79,25,Window.LightGray,Window.Black, 400 FALSE,TRUE,FALSE,TRUE, 401 Window.DoubleFrame,Window.Black,Window.LightGray)) ; 402 403 Window.SetTitle(DescWin,' TopSpeed Modula-2 : Traffic Simulation ',Window.CenterUpperTitle); 404 IO.WrLn; 405 IO.WrStr(' This program is a simple simulation of traffic flow in a closed road system.'); 406 IO.WrLn; 407 IO.WrStr(' Up to 200 cars move randomly within a one-way network of roads.');IO.WrLn; 408 IO.WrLn; 409 IO.WrStr(' The average speed is monitored by a separate process and displayed in');IO.WrLn; 410 IO.WrStr(' the Statistics window. 30.0 MPH indicates no congestion.');IO.WrLn; 411 IO.WrLn; 412 IO.WrStr(' Any resemblance to rush-hour traffic in New York is purely coincidental.');IO.WrLn; 413 IO.WrLn; IO.WrLn; Window.TextColor(Window.White) ; 414 IO.WrStr(' Press any key to start the simulation and then any key to terminate.');IO.WrLn; 415 Window.Use(Window.FullScreen); 416 Window.SetWrap(FALSE) ; 417 Window.TextBackground(Window.Black) ; 418 IF IsBW THEN 419 Window.TextColor(Window.LightGray) ; 420 ELSE 421 Window.TextColor(Window.Green) ; 422 END ; 423 FOR r := 1 TO Window.ScreenDepth DO 424 Window.GotoXY(1,r) ; 425 IO.WrCharRep(CHAR(178),Window.ScreenWidth) ; 426 END ; 427 Window.TextBackground(Window.Black) ; 428 Lib.RANDOMIZE; 429 InitWorld; 430 WHILE NOT IO.KeyPressed() DO END ; 431 IF IO.RdKey()=' ' THEN END ; 432 Window.Close(DescWin) ; 433 END Intro; 434 435 (*%F _OS2*) 436 PROCEDURE CheckBW ; 437 VAR 438 R : SYSTEM.Registers ; 439 BEGIN 440 R.AH := 15 ; 441 Lib.Intr(R,10H) ; 442 IsBW := (R.AL = 0)OR(R.AL = 2)OR(R.AL = 5)OR(R.AL = 6)OR(R.AL = 7) ; 443 END CheckBW ; 444 (*%E*) 445 446 BEGIN 447 (*%F _OS2*) 448 CheckBW ; 449 (*%E*) 450 Intro ; 451 AvSpeed := 300 ; 452 Process.StartScheduler ; 453 Process.StartProcess(Statistics,2000H,1) ; 454 RunSimulation ; 455 (*%F _OS2*) 456 Lib.NoSound ; 457 (*%E*) 458 Window.GotoXY(1,Window.ScreenDepth); 459 Window.CursorOn ; 460 END Demo. 16 errors