C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/MULTI12/MUL_DEMO.PAS

Pascal/Delphi Source File | 1989-06-04 | 14KB | 654 lines

program MultiDemo;

{ Demonstrates the capabilities of the Multi unit }

uses multi,crt,dos;

type  ScreenState = (free, used);          { Is screen position free? }

      BufferType  = Record                 { Declaration of messages to be }
                      p1,p2  : Pointer;    { sent to message semaphores }
                      number : Integer;
                    End;

      WindowType  = Record                 { Window descriptor }
                      X,
                      Y,
                      Xsize,
                      Ysize  : Integer;
                    End;


var   screen      : Array(.0..81,0..26.) of ScreenState;
      WindowTable : Array(.1..20.) of WindowType;

      DosSem,                              { Semaphores used to guard }
      CrtSem,                              { non-shareble resources: DOS, }
      KbdSem      : Semaphore;             { screen and keyboard }

      WindowSem,                           { Message semaphores used for }
      NumberSem,                           { communication between processes }
      PrimeSem,
      BufferSem1,
      BufferSem2,
      BallSem     : MsgSemaphore;

      i,j,                                 { Index variables }
      NoWindows   : Integer;               { No. of windows on screen }

      proc1,                               { Handles on process descriptors }
      proc2,
      proc3,
      proc4,
      proc5,
      proc6,
      proc7,
      proc8       : Process;

      buf         : ^BufferType;
      ptr         : Pointer;


Procedure SetCursor(Cursor: Word);

{ Sets cursortype according to Cursor }

   var  Reg : Registers;

   begin
     with Reg do
     begin
       AH := 1;
       BH := 0;
       CX := Cursor;
       Intr($10, Reg);
     end; { with }
   end; { SetCursor }


Procedure MakeWindow(X, Y, Xsize, Ysize: Integer; Heading: String);

{ Reserves screenspace for window and draws border around it }

   const NEcorner = #187;                { Characters for double-line border }
         SEcorner = #188;
         SWcorner = #200;
         NWcorner = #201;
         Hor      = #205;
         Vert     = #186;

   var   i,j : Integer;

   Begin
     Window(1,1,80,25);

     { Reserve screen space }
     For i:=X to X+Xsize-1 Do
       For j:=Y to Y+Ysize-1 Do screen(.i,j.):=used;

     { Draw border - sides }
     i:=X;
     For j:=Y+1 to Y+Ysize-2 Do
     Begin
       GotoXY(i,j);
       Write(Vert);
     End;

     i:=X+Xsize-1;
     For j:=Y+1 to Y+Ysize-2 Do
     Begin
       GotoXY(i,j);
       Write(Vert);
     End;

     j:=Y;
     For i:=X+1 to X+Xsize-2 Do
     Begin
       GotoXY(i,j);
       Write(Hor);
     End;

     j:=Y+Ysize-1;
     For i:=X+1 to X+Xsize-2 Do
     Begin
       GotoXY(i,j);
       Write(Hor);
     End;

     { Draw border - corners }
     GotoXY(X,Y);
     Write(NWcorner);
     GotoXY(X+Xsize-1,Y);
     Write(NEcorner);
     GotoXY(X+Xsize-1,Y+Ysize-1);
     Write(SEcorner);
     GotoXY(X,Y+Ysize-1);
     Write(SWcorner);

     { Make Heading }
     GotoXY(X+(Xsize-Length(Heading)) div 2,Y);
     Write(heading);

     { Save in table }
     NoWindows:=NoWindows+1;
     WindowTable(.NoWindows.).X:=X;
     WindowTable(.NoWindows.).Y:=Y;
     WindowTable(.NoWindows.).Xsize:=Xsize;
     WindowTable(.NoWindows.).Ysize:=Ysize;

   End; { MakeWindow }


Procedure SelectWindow(i : Integer);

   { Specifies which window will receive subsequent output }

   Begin
     With WindowTable(.i.) Do
     Begin
       Window(X+1,Y+1,X+Xsize-2,Y+Ysize-2);
     End;
   End; { SelectWindow }


Procedure RemoveWindow(n: Integer);

   { Removes window number n }

   var i,j : Integer;

   Begin
     Wait(CrtSem);
     SelectWindow(n);
     With WindowTable(.n.) Do
     Begin
       Window(X,Y,X+Xsize,Y+Ysize);
       For i:=X to X+Xsize Do
         For j:=Y to Y+Ysize Do screen(.i,j.):=free;
     End; { With }
     ClrScr;
     Signal(CrtSem);
   End; { SelectWindow }


Procedure Delay(DelayTime : Word);

{ Waits DelayTime seconds before returning - Does busy waiting }

   var ReturnTime,
       Hour,
       Minute,
       Second,
       Sec100     : Word;

   Begin
     Wait(DosSem);
     GetTime(Hour,Minute,Second,Sec100);
     Signal(DosSem);
     ReturnTime:=(Second+DelayTime) Mod 60;

     Repeat
       Wait(DosSem);
       GetTime(Hour,Minute,Second,Sec100);
       Signal(DosSem);
     Until
       Second=ReturnTime;
   End; { Delay }


Procedure ball;

{ flies a ball around the screen bouncing off windowes }

   const ball = #09;

   var   x,y,
         dx,dy,
         len   : Real;
         Msg   : Pointer;

   Begin
     { Start ball at random free position }
     Randomize;
     Repeat
        x:=Random*80+1;
        y:=Random*25+1;
     Until
        screen(.trunc(x),trunc(y).)=free;

     { Choose random velocities }
     dx:=Random-0.5;
     dy:=(Random-0.5)/2;
     len:=sqrt(dx*dx+dy*dy)*1.5;
     dx:=dx/len;
     dy:=dy/len;

     Repeat
       While screen(.trunc(x+dx),trunc(y+dy).)=used Do
       Begin
         If trunc(y)<>trunc(y+dy)
         Then dy:=-dy+(Random-0.5)/20;
         If trunc(x)<>trunc(x+dx)
         Then dx:=-dx+(Random-0.5)/10;
         len:=sqrt(dx*dx+dy*dy)*1.5;
         dx:=dx/len;
         dy:=dy/len;
       End;

       Wait(CrtSem);
       Window(1,1,80,25);
       GotoXY(trunc(x+dx),trunc(y+dy));
       write(ball);
       GotoXY(trunc(x),trunc(y));
       write(' ');
       Signal(CrtSem);

       x:=x+dx;
       y:=y+dy;

       GetMsg(BallSem,Msg,Return);
     Until
       Msg<>nil;

       GotoXY(trunc(x),trunc(y));
       write(' ');

       die;
   End; { ball }


Procedure numbers;

{ Generates numbers to be tested for prime-ness and sends them to the
  message semaphore NumberSem. }

  var i      : Integer;
      buf    : ^BufferType;
      ptr    : Pointer;

  Begin
    For i:=2 to Maxint Do
    Begin
      { Reserve screen and print message }
      Wait(CrtSem);
      SelectWindow(2);
      ClrScr;
      Writeln;
      Write(' Sending ',i,'...');
      Signal(CrtSem);

      { Request buffer and send number }
      GetMsg(BufferSem1,ptr,stay);
      buf:=ptr;
      buf^.number:=i;
      PutMsg(NumberSem,ptr);
    End;

    Die;
  End; { Numbers }


Procedure TestNumber;

{ Tests a number from NumberSem for prime-ness. If it is a prime, it is
  sent to PrimeSem }

  var buf    : ^BufferType;
      ptr    : Pointer;
      window,
      i,
      number : Integer;
      prime  : Boolean;


  Begin
    { Get allocated windownumber }
    GetMsg(WindowSem,ptr,stay);
    buf:=ptr;
    Window:=buf^.number;

    { Return buffer to pool }
    PutMsg(BufferSem1,ptr);

    Repeat
      { Get a number to test }
      GetMsg(NumberSem,ptr,stay);
      buf:=ptr;
      Number:=buf^.Number;
      PutMsg(BufferSem1,ptr);

      { Is it a death sentence? }
      If number<0 Then
      Begin
        Wait(CrtSem);
        SelectWindow(Window);
        ClrScr;
        HighVideo;
        Write('Arrgghh....');
        NormVideo;
        Signal(CrtSem);

        Delay(5);

        RemoveWindow(Window);
        Die;
      End; { If }

      { Announce test }
      Wait(CrtSem);
      SelectWindow(Window);
      ClrScr;
      Write('Testing ',Number);
      Signal(CrtSem);

      { Do test }
      i:=2;
      prime:=true;
      While prime and (i<=Sqrt(Number)) Do
      Begin
        prime:=(number mod i<>0);
        inc(i);
      End;

      If prime
      Then Begin
             Wait(CrtSem);
             SelectWindow(Window);
             ClrScr;
             Write(Number,' is a prime!');
             Signal(CrtSem);

             GetMsg(BufferSem2,ptr,stay);
             buf:=ptr;
             buf^.number:=number;
             PutMsg(PrimeSem,ptr);
           End
      Else Begin
             Wait(CrtSem);
             SelectWindow(Window);
             ClrScr;
             Writeln('Shucks! ',number,' is');
             Write('divisible by ',i-1);
             Signal(CrtSem);
           End;
    Until
       false;
  End; { TestNumber }


Procedure PrintPrimes;

{ Reads primes from PrimeSem and prints them on screen }

  var buf    : ^BufferType;
      ptr    : Pointer;

  Begin
    Repeat
       GetMsg(PrimeSem,ptr,stay);
       buf:=ptr;

       Wait(CrtSem);
       SelectWindow(3);
       With WindowTable(.3.) Do
         GotoXY(Xsize-2,Ysize-2);
       Writeln;
       Write(buf^.number:7);
       Signal(CrtSem);

       PutMsg(BufferSem2,ptr);
    Until
      false;
  End; { PrintPrimes }


Procedure jabberwocky;

{ Reads the Poem Jabberwocky from disk and prints it on the screen. }

var JabFile : text;
    line    : String;

Begin
  wait(DosSem);
  Assign(JabFile,'JABWOCK.DAT');
  Reset(JabFile);
  signal(DosSem);

  While not eof(JabFile) Do
  Begin
    Wait(DosSem);
    Readln(Jabfile,line);
    Signal(DosSem);

    Wait(CrtSem);
    SelectWindow(7);
    With WindowTable(.7.) Do
      GotoXY(Xsize-2,Ysize-2);
    Writeln;
    Write(' ',line);
    Signal(CrtSem);
    Delay(1);
  End;

  Wait(DosSem);
  Close(JabFile);
  Signal(DosSem);

  Die;

End; { Jabberwocky }



Procedure control;

{ Controls multiprogram. Spawns sub-processes }


var buf : ^BufferType;
    ptr : Pointer;
    i   : Integer;
    c   : Char;



   Procedure pause;

   { Waits for a keystroke }

   var keystroke : Boolean;

   Begin
     While not KeyPressed Do
     Begin
       Wait(KbdSem);
       Signal(KbdSem);
     End;

     Wait(KbdSem);
     c:=ReadKey;
     Signal(KbdSem);
   End; { pause }


Begin
  MakeWindow( 5,18,45,7,' Multi-Program Demo ');

  Wait(CrtSem);
  SelectWindow(1);
  ClrScr;
  Writeln(' Welcome to the demonstration of the');
  Writeln(' multi-program unit. This window is a');
  Writeln(' process under the multi-program. In');
  Writeln(' a minute we''ll add some other processes.');
  Write  (' Hit any key to continue.');
  Signal(CrtSem);

  pause;

  Wait(CrtSem);
  MakeWindow( 5, 2,18,5,' Numbers ');
  MakeWindow(51, 2,12,6,' Primes ');
  MakeWindow(27, 2,18,4,' Test_1 ');
  MakeWindow(27, 7,18,4,' Test_2 ');
  MakeWindow(27,12,18,4,' Test_3 ');

  { Send window-numbers to test-processes }
  For i:=4 to 6 Do
  Begin
    GetMsg(BufferSem1,ptr,stay);
    buf:=ptr;
    buf^.number:=i;
    PutMsg(WindowSem,ptr);
  End;

  CreateProcess(@PrintPrimes,2000,proc2);
  CreateProcess(@TestNumber,2000,proc3);
  CreateProcess(@TestNumber,2000,proc4);
  CreateProcess(@TestNumber,2000,proc5);
  CreateProcess(@Numbers,2000,proc6);

  SelectWindow(1);
  ClrScr;
  Writeln(' First we''ll start a group of processes');
  Writeln(' which calculate prime numbers.');
  Writeln(' The processes communicate via message');
  Writeln(' semaphores.');
  Write  (' Hit any key to continue.');
  Signal(CrtSem);

  pause;

  Wait(CrtSem);
  SelectWindow(1);
  ClrScr;
  Writeln(' The process ''numbers'' generates numbers');
  Writeln(' to be tested for prime-ness and sends');
  Writeln(' them to a group of test-processes which');
  Writeln(' test whether they are primes or not.');
  Write  (' Hit any key to continue.');
  Signal(CrtSem);

  pause;

  Wait(CrtSem);
  SelectWindow(1);
  ClrScr;
  Writeln(' If they find a prime number, it is sent');
  Writeln(' to the process ''Primes'' which will print');
  Writeln(' it on the screen.');
  Writeln;
  Write  (' Hit any key to continue.');
  Signal(CrtSem);

  pause;

  Wait(CrtSem);
  MakeWindow(53,12,28,11,' Jabberwocky ');

  CreateProcess(@Jabberwocky,2000,proc7);

  SelectWindow(1);
  ClrScr;
  Writeln(' Next we''ll start a process which will');
  Writeln(' read the poem Jabberwocky by Lewis Carrol');
  Writeln(' from disk and print it on the screen');
  Writeln;
  Write  (' Hit any key to continue.');
  Signal(CrtSem);

  pause;

  CreateProcess(@ball,2000,proc8);

  Wait(CrtSem);
  SelectWindow(1);
  ClrScr;
  Writeln(' Now we''ll start a process which');
  Writeln(' will bounce a ball around the screen. ');
  Writeln(' There are now eight processes in the ');
  Writeln(' multiprogram.');
  Write  (' Hit any key to continue.');
  Signal(CrtSem);

  pause;

  Wait(CrtSem);
  SelectWindow(1);
  ClrScr;
  Writeln(' Finally we''ll commit a minor atrocity:');
  Writeln(' killing one of the test-processes.');
  Writeln;
  Writeln;
  Write  (' Hit any key to end program.');
  Signal(CrtSem);

  { Send a negative number (= death sentence) to one of the test processes. }
  GetMsg(BufferSem1,ptr,stay);
  buf:=ptr;
  buf^.number:=-1;
  PutMsg(NumberSem,ptr);

  pause;

  Wait(DosSem);
  Wait(CrtSem);
  Wait(KbdSem);
  stopmulti;

End; { Control }


Begin { Main }
  ClrScr;
  NoWindows:=0;
  SetCursor($2000);

  { Initalize screen table }
  For i:=1 to 80 Do
    For j:=1 to 25 Do screen(.i,j.):=free;
  For i:=0 to 81 Do
  Begin
    screen(.i, 0.):=used;
    screen(.i,25.):=used;
  End;
  For j:=1 to 25 Do
  Begin
    screen(. 0,j.):=used;
    screen(.81,j.):=used;
  End;

  { Initalize semaphores }
  InitSem(DosSem);
  InitSem(CrtSem);
  InitSem(KbdSem);
  InitMsgSem(BufferSem1);
  InitMsgSem(BufferSem2);
  InitMsgSem(WindowSem);
  InitMsgSem(NumberSem);
  InitMsgSem(PrimeSem);
  InitMsgSem(BallSem);

  { Mark various ressources as 'free' }
  Signal(DosSem);
  Signal(CrtSem);
  Signal(KbdSem);

  { Generate buffer-pools }
  For i:=1 to 10 Do
  Begin
    new(buf);
    ptr:=buf;
    PutMsg(BufferSem1,ptr);
    new(buf);
    ptr:=buf;
    PutMsg(BufferSem2,ptr);
  End;

  CreateProcess(@control,2000,proc1);

  StartMulti(Timer);

  SetCursor($607);
End.