home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / sprite / demo3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-18  |  6.0 KB  |  171 lines
  1. {$R-}    {Bereichsprüfung aus}
  2. {$B+}    {vollständige Auswertung boolscher Ausdrücke}
  3. {$S+}    {Stackprüfung an}
  4. {$I+}    {I/O-Prüfung an}
  5. {$N-}    {kein numerischer Coprozessor}
  6. {$M 65500,16384,655360} {3.0-Standardvorgaben für Stack&Heap}
  7.  
  8.  
  9.     (* ************************************************************* *)
  10.     (*                                                               *)
  11.     (*  This program shows how to set up a relatively complicated    *)
  12.     (*  animation sequence using multipage page-flipping techniques  *)
  13.     (*                                                               *)
  14.     (*                             (c) Donald L. Pavia               *)
  15.     (*       Ver 2.0               Department of Chemistry           *)
  16.     (*     February 1986           Western Washington University     *)
  17.     (*                             Bellingham, Washington 98225      *)
  18.     (*                                                               *)
  19.     (* ************************************************************* *)
  20.  
  21.  
  22. program SpriteDemo3;
  23.  
  24. {----------------------------------------------------------------------------}
  25.  
  26. uses
  27.   Crt,
  28.   turbo3,
  29.   Graph3;
  30.  
  31. {$I Sprites.Lib}
  32. {----------------------------------------------------------------------------}
  33. procedure Introduction;
  34.  
  35. begin
  36.      TextColor (1);
  37.      gotoxy  (3,5); write ('Display of Sprites and Animation');
  38.      gotoxy  (3,7); write ('    ( multi-page techniques )');
  39.      TextColor (3);
  40.      gotoxy (5,21); write ('Donald Pavia, December 1985');
  41.  
  42.      LoadTable ('Demo3.tab');
  43.  
  44.      TextColor (2); gotoxy (12,15); write ('Press <ENTER> ');
  45.      read (Kbd,Wait);
  46. {! 4. Kbd e^rfordert das Unit Turbo3 - verwenden Sie ReadKey (im Unit Crt)}
  47.      FillChar (ColorBuffer,16383,0);
  48.  
  49. end; { procedure Introduction }
  50. {----------------------------------------------------------------------------}
  51.  
  52. BEGIN
  53.      clrscr;
  54.      GraphColorMode; GraphBackGround (1); Palette (2);
  55.      Introduction;
  56.  
  57.     {------ Draw and Save BackGround -------------------------------------}
  58.  
  59.      draw (75,25,175,25,1);   draw (175,25,175,110,1);
  60.      draw (175,110,75,110,1); draw (75,110,75,25,1);
  61.  
  62.      TextColor (1);
  63.      gotoxy (25,7); write ('Chemistry In');
  64.      gotoxy (25,8); write ('  Action !  ');
  65.  
  66.      WorkBuffer := ColorBuffer;                    { copy to workbuffer }
  67.      BackGroundBuffer := ColorBuffer;         { save a copy for refresh }
  68.    {----------------------------------------------------------------------}
  69.  
  70. REPEAT                         { Animation Begins }
  71.        times := 0;
  72.  
  73.    {---- Lighted Burner and Standing Flask -------------------------------}
  74.  
  75.    REPEAT
  76.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65); Show;
  77.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65); Show;
  78.      times := times + 1;
  79.    UNTIL times = 10; times := 0;
  80.  
  81.    {---- Test Tube is Heated ---------------------------------------------}
  82.  
  83.    REPEAT
  84.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  85.      Spwrite (2,100,48); Show;
  86.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  87.      Spwrite (2,100,48); Show; times := times + 1;
  88.    UNTIL times = 12;  times := 0;
  89.  
  90.    {---- Boiling Begins --------------------------------------------------}
  91.  
  92.    REPEAT
  93.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  94.      Spwrite (2,100,48); Show;
  95.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  96.      Spwrite (3,100,48); Show; times := times + 1;
  97.    UNTIL times = 12;
  98.  
  99.    {---- Move Test Tube to Right -----------------------------------------}
  100.  
  101.    for times := 1 to 6 do begin
  102.      Spwrite (16,148,77); Spwrite (22,100,79);
  103.      if odd (times) then Spwrite (23,100,65) else Spwrite (24,100,65);
  104.      Spwrite (4,116+4*times,44); Show; end;
  105.  
  106.    {---- Pour Into Flask -------------------------------------------------}
  107.  
  108.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  109.      Spwrite (5,136,57); Show;
  110.  
  111.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  112.      Spwrite (5,136,57); Show;
  113.  
  114.      Spwrite (9,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  115.      Spwrite (5,136,57); Show;
  116.  
  117.      Spwrite (10,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  118.      Spwrite (6,136,57); Show;
  119.  
  120.      Spwrite (11,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  121.      Spwrite (7,136,57); Show;
  122.  
  123.      Spwrite (12,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  124.      Spwrite (8,136,57); Show;
  125.  
  126.      Spwrite (13,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  127.      Spwrite (8,136,57); Show;
  128.  
  129.      Spwrite (13,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  130.      Spwrite (17,136,57); Show;
  131.  
  132.      Spwrite (13,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  133.      Spwrite (1,132,57); Show; times := 0;
  134.  
  135.    {---- Reaction/Precipitation Occurs in Flask --------------------------}
  136.  
  137.    REPEAT
  138.      Spwrite (14,148,77); Spwrite (22,100,79); Spwrite (24,100,65); Show;
  139.      Spwrite (14,148,77); Spwrite (22,100,79); Spwrite (23,100,65); Show;
  140.      times := times + 1;
  141.    UNTIL times = 6; times := 0;
  142.  
  143.    REPEAT
  144.      Spwrite (15,148,77); Spwrite (22,100,79); Spwrite (24,100,65); Show;
  145.      Spwrite (15,148,77); Spwrite (22,100,79); Spwrite (23,100,65); Show;
  146.      times := times + 1;
  147.    UNTIL times = 12; times := 0;
  148.  
  149.    {---- Flame is Extinguished -------------------------------------------}
  150.  
  151.    REPEAT
  152.      Spwrite (15,148,77); Spwrite (22,100,79); Show;
  153.      Spwrite (15,148,77); Spwrite (22,100,79); Show; times := times + 1;
  154.    UNTIL times = 6;
  155.  
  156.    {---- The End ---------------------------------------------------------}
  157.  
  158.      TextColor (3);
  159.      gotoxy (8,20); write ('Repeat Again ? Y/N ?  ');
  160.  
  161.      repeat  read (Kbd,Again);  until UpCase(Again) in ['Y','N'];
  162. {! 5. Kbd erfordert^ das Unit Turbo3 - verwenden Sie ReadKey (im Unit Crt)}
  163.  
  164.      FillChar (WorkBuffer,16383,0); FillChar (ColorBuffer,16383,0);
  165.  
  166. UNTIL UpCase(Again) = 'N';
  167.  
  168.      gotoxy (1,23); TextMode (c80); clrscr;         { exit gracefully }
  169.  
  170. END.
  171.