home *** CD-ROM | disk | FTP | other *** search
/ Frostbyte's 1980s DOS Shareware Collection / floppyshareware.zip / floppyshareware / USCX / TPSPRITE.ZIP / DEMO3.PAS < prev    next >
Pascal/Delphi Source File  |  1986-02-15  |  6KB  |  156 lines
  1.  
  2.     (* ************************************************************* *)
  3.     (*                                                               *)
  4.     (*  This program shows how to set up a relatively complicated    *)
  5.     (*  animation sequence using multipage page-flipping techniques  *)
  6.     (*                                                               *)
  7.     (*                             (c) Donald L. Pavia               *)
  8.     (*       Ver 2.0               Department of Chemistry           *)
  9.     (*     February 1986           Western Washington University     *)
  10.     (*                             Bellingham, Washington 98225      *)
  11.     (*                                                               *)
  12.     (* ************************************************************* *)
  13.  
  14.  
  15. program SpriteDemo3;
  16.  
  17. {----------------------------------------------------------------------------}
  18. {$I Sprites.Lib}
  19. {----------------------------------------------------------------------------}
  20. procedure Introduction;
  21.  
  22. begin
  23.      TextColor (1);
  24.      gotoxy  (3,5); write ('Display of Sprites and Animation');
  25.      gotoxy  (3,7); write ('    ( multi-page techniques )');
  26.      TextColor (3);
  27.      gotoxy (5,21); write ('Donald Pavia, December 1985');
  28.  
  29.      LoadTable ('Demo3.tab');
  30.  
  31.      TextColor (2); gotoxy (12,15); write ('Press <ENTER> ');
  32.      read (Kbd,Wait);
  33.      FillChar (ColorBuffer,16383,0);
  34.  
  35. end; { procedure Introduction }
  36. {----------------------------------------------------------------------------}
  37.  
  38. BEGIN
  39.      clrscr;
  40.      GraphColorMode; GraphBackGround (1); Palette (2);
  41.      Introduction;
  42.  
  43.     {------ Draw and Save BackGround -------------------------------------}
  44.  
  45.      draw (75,25,175,25,1);   draw (175,25,175,110,1);
  46.      draw (175,110,75,110,1); draw (75,110,75,25,1);
  47.  
  48.      TextColor (1);
  49.      gotoxy (25,7); write ('Chemistry In');
  50.      gotoxy (25,8); write ('  Action !  ');
  51.  
  52.      WorkBuffer := ColorBuffer;                    { copy to workbuffer }
  53.      BackGroundBuffer := ColorBuffer;         { save a copy for refresh }
  54.    {----------------------------------------------------------------------}
  55.  
  56. REPEAT                         { Animation Begins }
  57.        times := 0;
  58.  
  59.    {---- Lighted Burner and Standing Flask -------------------------------}
  60.  
  61.    REPEAT
  62.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65); Show;
  63.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65); Show;
  64.      times := times + 1;
  65.    UNTIL times = 10; times := 0;
  66.  
  67.    {---- Test Tube is Heated ---------------------------------------------}
  68.  
  69.    REPEAT
  70.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  71.      Spwrite (2,100,48); Show;
  72.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  73.      Spwrite (2,100,48); Show; times := times + 1;
  74.    UNTIL times = 12;  times := 0;
  75.  
  76.    {---- Boiling Begins --------------------------------------------------}
  77.  
  78.    REPEAT
  79.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  80.      Spwrite (2,100,48); Show;
  81.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  82.      Spwrite (3,100,48); Show; times := times + 1;
  83.    UNTIL times = 12;
  84.  
  85.    {---- Move Test Tube to Right -----------------------------------------}
  86.  
  87.    for times := 1 to 6 do begin
  88.      Spwrite (16,148,77); Spwrite (22,100,79);
  89.      if odd (times) then Spwrite (23,100,65) else Spwrite (24,100,65);
  90.      Spwrite (4,116+4*times,44); Show; end;
  91.  
  92.    {---- Pour Into Flask -------------------------------------------------}
  93.  
  94.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  95.      Spwrite (5,136,57); Show;
  96.  
  97.      Spwrite (16,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  98.      Spwrite (5,136,57); Show;
  99.  
  100.      Spwrite (9,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  101.      Spwrite (5,136,57); Show;
  102.  
  103.      Spwrite (10,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  104.      Spwrite (6,136,57); Show;
  105.  
  106.      Spwrite (11,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  107.      Spwrite (7,136,57); Show;
  108.  
  109.      Spwrite (12,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  110.      Spwrite (8,136,57); Show;
  111.  
  112.      Spwrite (13,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  113.      Spwrite (8,136,57); Show;
  114.  
  115.      Spwrite (13,148,77); Spwrite (22,100,79); Spwrite (24,100,65);
  116.      Spwrite (17,136,57); Show;
  117.  
  118.      Spwrite (13,148,77); Spwrite (22,100,79); Spwrite (23,100,65);
  119.      Spwrite (1,132,57); Show; times := 0;
  120.  
  121.    {---- Reaction/Precipitation Occurs in Flask --------------------------}
  122.  
  123.    REPEAT
  124.      Spwrite (14,148,77); Spwrite (22,100,79); Spwrite (24,100,65); Show;
  125.      Spwrite (14,148,77); Spwrite (22,100,79); Spwrite (23,100,65); Show;
  126.      times := times + 1;
  127.    UNTIL times = 6; times := 0;
  128.  
  129.    REPEAT
  130.      Spwrite (15,148,77); Spwrite (22,100,79); Spwrite (24,100,65); Show;
  131.      Spwrite (15,148,77); Spwrite (22,100,79); Spwrite (23,100,65); Show;
  132.      times := times + 1;
  133.    UNTIL times = 12; times := 0;
  134.  
  135.    {---- Flame is Extinguished -------------------------------------------}
  136.  
  137.    REPEAT
  138.      Spwrite (15,148,77); Spwrite (22,100,79); Show;
  139.      Spwrite (15,148,77); Spwrite (22,100,79); Show; times := times + 1;
  140.    UNTIL times = 6;
  141.  
  142.    {---- The End ---------------------------------------------------------}
  143.  
  144.      TextColor (3);
  145.      gotoxy (8,20); write ('Repeat Again ? Y/N ?  ');
  146.  
  147.      repeat  read (Kbd,Again);  until UpCase(Again) in ['Y','N'];
  148.  
  149.      FillChar (WorkBuffer,16383,0); FillChar (ColorBuffer,16383,0);
  150.  
  151. UNTIL UpCase(Again) = 'N';
  152.  
  153.      gotoxy (1,23); TextMode (c80); clrscr;         { exit gracefully }
  154.  
  155. END.
  156.