home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / vp21beta.zip / AEXMPSRC.RAR / RATRACE / RATRACE.PAS
Pascal/Delphi Source File  |  2000-08-15  |  2KB  |  86 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 2.1.            █}
  4. {█      Multi-threaded example                           █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995-2000 vpascal.com              █}
  7. {█                                                       █}
  8. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  9.  
  10. program RatRace;
  11.  
  12. {$PMTYPE VIO}
  13. {$X+,Delphi+,Use32+}
  14.  
  15. uses
  16.   VpSysLow, Crt, Dos;
  17.  
  18. const
  19.   RatColors: array[1..8] of Byte =
  20.     ( DarkGray     ,
  21.       LightBlue    ,
  22.       LightGreen   ,
  23.       LightCyan    ,
  24.       LightRed     ,
  25.       LightMagenta ,
  26.       Yellow       ,
  27.       White
  28.     );
  29.  
  30.   RatBody: String[11] = '---<O[x]Oo.';
  31.   FinishDrawPos: Integer = 16;
  32.  
  33. var
  34.   I: Integer;
  35.   ThreadId: Longint;
  36.   ScreenSemaphore: Longint;
  37.  
  38. const
  39.   Idx: Integer = 0;
  40.  
  41. threadvar
  42.   Number: Integer;
  43.  
  44. function Rat( P : Pointer): Longint;
  45. var
  46.   Step, S: Integer;
  47. begin
  48.   Step := 1;
  49.   Inc(Idx);
  50.   Number := Idx;
  51.   repeat
  52.     SemRequestMutex(ScreenSemaphore, semInfinite);
  53.     TextColor(Longint(p));
  54.     S := Step;
  55.     if Step <> 1 then Dec(S);
  56.     GotoXY(S, 2 + Number * 2);
  57.     RatBody[7] := Chr(Number + Ord('0'));
  58.     if Step <> 1 then Write(' ');
  59.     Write(RatBody);
  60.     Inc(Step);
  61.     if WhereX = 80 then Break;
  62.     SemReleaseMutex(ScreenSemaphore);
  63.     Delay(Random(300));
  64.   until False;
  65.   GotoXY(FinishDrawPos, 24);
  66.   Inc(FinishDrawPos);
  67.   Write(Number);
  68.   SemReleaseMutex(ScreenSemaphore);
  69. end;
  70.  
  71. begin
  72.   ScreenSemaphore := SemCreateMutex(nil, False, False);
  73.   TextMode(CO80);
  74.   ClrScr;
  75.   TextColor(White);
  76.   Writeln('Virtual Pascal multi-thread example v2.1  (C) 1995-2000 vpascal.com' );
  77.   Write('                            The Rat Race!');
  78.   GotoXY(1, 24);
  79.   Write('Finish order: ');
  80.   GotoXY(25, 25);
  81.   Write('Press any key to exit');
  82.   for I := Low(RatColors) to High(RatColors) do
  83.     BeginThread(nil, 16*1024, Rat, Pointer(RatColors[I]), 0, ThreadId);
  84.   ReadKey;
  85. end.
  86.