Topspeed_JPI/TS-V3/EXAMPLES/DEMO.LST

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 v<MaxCar DO
  154      Car[v] := Car[v+1] ; INC(v) ;
  155    END ;
  156    DEC(MaxCar) ;
  157  END ParkCar ;
  158  
  159  
  160  
  161  PROCEDURE MoveCar ( v:CarRange ) ;
  162  VAR
  163    exit      : Direction;
  164    x,newx    : xCoord ;
  165    y,newy    : yCoord ;
  166    tried     : DirSet ;
  167  CONST
  168    SpeedLimit = 450 ; (* 30 MPH ?! *)
  169  BEGIN
  170    WITH Car[v] DO
  171      IF Speed < SpeedLimit THEN
  172        INC(Speed,RANDOM(80)) ;
  173        IF Speed>SpeedLimit THEN Speed := SpeedLimit END ;
  174        IF Speed<RANDOM(SpeedLimit) THEN RETURN END ;
  175      END ;
  176      x := Pos.x; y := Pos.y;
  177    END ;
  178    tried := DirSet{};
  179    LOOP
  180      exit := Direction(RANDOM(4));
  181      IF exit IN World[x,y].Exit THEN
  182        newx := x; newy := y;
  183        CASE exit OF
  184        | East  : newx := ToEast[x];
  185        | South : newy := ToSouth[y];
  186        | North : newy := ToNorth[y];
  187        | West  : newx := ToWest[x];
  188        END;
  189        IF World[newx,newy].Occupied  THEN
  190          Car[v].Speed := Car[v].Speed DIV 4 (* Brake *) ; RETURN ;
  191        ELSE
  192          World[x,y].Occupied := FALSE ;
  193          Plot(x,y);
  194          World[newx,newy].Occupied := TRUE ;
  195          WITH Car[v] DO
  196            Pos.x := newx; Pos.y := newy;
  197            IF LastD<>exit 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+2<MsgX THEN INC(WD.X1,3);INC(WD.X2,3);
  346      ELSIF WD.X1>MsgX+2 THEN DEC(WD.X1,3);DEC(WD.X2,3);
  347      ELSIF WD.Y1=MsgY THEN change := FALSE ;
  348      END ;
  349      IF    WD.Y1<MsgY THEN INC(WD.Y1);INC(WD.Y2);
  350      ELSIF WD.Y1>MsgY 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