home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / JOCKDEM5.ZIP / FASTDEM3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-31  |  10.7 KB  |  334 lines
  1. Program FastTTT5_Demo_3;
  2. uses CRT, FastTTT5;
  3.  
  4. var
  5.    Ch : char;
  6.  
  7. Procedure Intro_Screen;
  8. begin
  9.     TextBackground(Black);
  10.     Textcolor(white);
  11.     Clrscr;
  12.     Box(20,1,60,5,yellow,black,2);
  13.     Box(3,7,78,25,15,1,1);
  14.     ClearText(4,8,77,24,white,blue);
  15.     VertLine(33,8,10,white,blue,1);
  16.     VertLine(47,8,10,white,blue,1);
  17.     HorizLine(5,75,11,white,blue,2);
  18.     WriteAT(74,1,white,black,'V 5.0');
  19.     WriteCenter(2,green,black,'TECHNOJOCK''S');
  20.     WriteCenter(3,green,black,'TURBO');
  21.     WriteCenter(4,green,black,'TOOLKIT');
  22.     WriteVert(1,16,lightgray,black,'Technojock');
  23.     WriteVert(80,16,lightgray,black,'Technojock');
  24.     WriteBetween(33,47,8,white,blue,'Procedures');
  25.     WriteBetween(33,47,9,white,blue,'&');
  26.     WriteBetween(33,47,10,white,blue,'Functions');
  27.     WriteAT(9,12,yellow,blue,'This is a demonstration of some of the procedures and functions');
  28.     WriteAT(9,13,yellow,blue,'contained in the unit FastTTT5.TPU. The screen is updated very');
  29.     WriteAT(9,14,yellow,blue,'quickly using an inline procedure.');
  30.     WriteAT(9,16,yellow,blue,'The procedures in FastTTT5.TPU include box and line drawing,');
  31.     WriteAT(9,17,yellow,blue,'text centering on the screen or between two X coordinates,');
  32.     WriteAT(9,18,yellow,blue,'vertical text writing and much more.');
  33.     WriteAT(9,20,lightcyan,blue,'Other utilities in the TTT series include window management, screen');
  34.     WriteAT(9,21,lightcyan,blue,'management, fullscreen input routines, pulldown menus, directory');
  35.     WriteAT(9,22,lightcyan,blue,'listers, string handling, full mouse support and much much more!');
  36. end;
  37.  
  38. Procedure Animate;      {the following procedure was written by Pete Knarr}
  39.                         {to demo the animation posibilities using TTT}
  40.   Var
  41.     Ip:Char;
  42.  
  43.   Procedure Curtain;
  44.      Var
  45.        Total,Cnt,I,J:Integer;
  46.        Count,Line1,Line2:String;
  47.     Begin
  48.       WriteAT(1,1,0,0,'  ');GotoXY(1,2);
  49.       Port[$3D9]:=1;
  50.       TextBackGround(1);ClrScr;
  51.       Box(20,7,62,19,14,4,2);
  52.       Window(21,8,61,18);TextBackGround(4);ClrScr;
  53.       WriteVert(41,8,12,0,'║║║║║║║║║║║');
  54.       TextColor(15);
  55.       GotoXY(4,3);Write('Press Any Key ...');
  56.       GotoXY(4,5);Write('To see Pete');
  57.       GotoXY(4,6);Write('Knarr''s superb');
  58.       GotoXY(4,7);Write('demo built with');
  59.       GotoXY(4,8);Write('the Toolkit.');
  60.       Window(1,1,80,25);
  61.       WriteAT(1,1,1,1,'  ');
  62.       GotoXY(2,1);
  63.       Repeat Ip:=ReadKey Until Ip<>'';
  64.       TextBackGround(0);
  65.       For I:=1 to 9 Do
  66.         Begin
  67.           Sound(I*100);
  68.           Window(41-I*2,8,41+2*I,18);
  69.           ClrScr;
  70.           WriteAT(42-I*2,12,0,0,'  ');GotoXY(3,5);
  71.           Delay(20)
  72.        End;
  73.       WriteVert(22,8,12,0,'║║║║║║║║║║║');
  74.       WriteVert(60,8,12,0,'║║║║║║║║║║║');
  75.       Delay(50);
  76.       NoSound;
  77.       Window(1,1,80,25);
  78.       Line1:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  79.       WriteAT(1,1,1,1,'  ');GotoXY(2,1);
  80.       J:=8;
  81.       Cnt:=0;
  82.       Total:=0;
  83.       For I:=8 to 36 Do
  84.         Begin
  85.           If I<11 Then
  86.             Begin
  87.               WriteAT(23,8,14,0,Line1[I-7]);
  88.               Sound(100);
  89.               Delay(10);
  90.               NoSound;
  91.               Delay(70);
  92.               Case I of
  93.                  9:WriteAT(23,9,14,0,Line1[I-8]);
  94.                 10:Begin
  95.                      WriteAT(23,9,14,0,Line1[I-8]);
  96.                      WriteAT(23,10,14,0,Line1[I-9])
  97.                    End
  98.               End
  99.            End
  100.          Else
  101.            Begin
  102.              If I>Length(Line1)+7 Then
  103.                Begin
  104.                  If J<12 Then
  105.                    WriteAT(23,J,14,0,' ');
  106.                  J:=J+1
  107.                End
  108.              Else
  109.                Begin
  110.                  WriteAT(23,8,14,0,Line1[I-8]);
  111.                  WriteAT(23,9,14,0,Line1[I-9]);
  112.                  WriteAT(23,10,14,0,Line1[I-10])
  113.                End;
  114.              WriteAT(13+I,10,14,0,Line1[I-10]);
  115.              Sound(100);
  116.              Delay(10);
  117.              NoSound;
  118.              Delay(70);
  119.              If I<20 Then
  120.                WriteAT(13+I,10,14,0,Line1[I-10]);
  121.              Cnt:=Cnt+1;
  122.              Total:=Total+1;
  123.            End;
  124.           Str(Cnt:2,Count);
  125.           WriteAT(56,10,15,0,Count);
  126.           Str(Total:2,Count);
  127.           WriteAT(56,14,15,0,Count)
  128.         End;
  129.       Line2:=Line1;
  130.       For I:=23 to 27 Do
  131.         Begin
  132.           Line2:=' '+Line2;
  133.           WriteAT(23,10,14,0,Line2);
  134.           Sound(1354);
  135.           Delay(10);
  136.           NoSound;
  137.           Delay(20)
  138.         End;
  139.       J:=8;
  140.       Cnt:=0;
  141.       For I:=8 to 36 Do
  142.         Begin
  143.           If I<13 Then
  144.             Begin
  145.               WriteAT(23,8,14,0,Line1[I-7]);
  146.               Sound(100);
  147.               Delay(10);
  148.               NoSound;
  149.               Delay(70);
  150.               Case I of
  151.                  9:WriteAT(23,9,14,0,Line1[I-8]);
  152.                 10:Begin
  153.                      WriteAT(23,9,14,0,Line1[I-8]);
  154.                      WriteAT(23,10,14,0,Line1[I-9])
  155.                    End;
  156.                 11:Begin
  157.                      WriteAT(23,9,14,0,Line1[I-8]);
  158.                      WriteAT(23,10,14,0,Line1[I-9]);
  159.                      WriteAT(23,11,14,0,Line1[I-10])
  160.                    End;
  161.                 12:Begin
  162.                      WriteAT(23,9,14,0,Line1[I-8]);
  163.                      WriteAT(23,10,14,0,Line1[I-9]);
  164.                      WriteAT(23,11,14,0,Line1[I-10]);
  165.                      WriteAT(23,12,14,0,Line1[I-11])
  166.                    End
  167.               End
  168.             End
  169.           Else
  170.             Begin
  171.               If I>Length(Line1)+6 Then
  172.                 Begin
  173.                   If J<15 Then
  174.                     WriteAT(23,J,14,0,' ');
  175.                   J:=J+1
  176.                 End
  177.               Else
  178.                 Begin
  179.                   WriteAT(23,8,14,0,Line1[I-8]);
  180.                   WriteAT(23,9,14,0,Line1[I-9]);
  181.                   WriteAT(23,10,14,0,Line1[I-10]);
  182.                   WriteAT(23,11,14,0,Line1[I-11]);
  183.                   WriteAT(23,12,14,0,Line1[I-12])
  184.                 End;
  185.               WriteAT(11+I,12,14,0,Line1[I-12]);
  186.               Sound(100);
  187.               Delay(10);
  188.               NoSound;
  189.               Delay(70);
  190.               If I<20 Then
  191.               WriteAT(11+I,12,14,0,Line1[I-12])
  192.             End;
  193.           Str(Cnt:2,Count);
  194.           WriteAT(56,12,15,0,Count);
  195.           Str(Total:2,Count);
  196.           WriteAT(56,14,15,0,Count);
  197.           If I>9 Then
  198.             Begin
  199.               Cnt:=Cnt+1;
  200.               Total:=Total+1
  201.             End
  202.         End;
  203.       Line2:=Line1;
  204.       For I:=23 to 27 Do
  205.         Begin
  206.           Line2:=' '+Line2;
  207.           WriteAT(23,12,14,0,Line2);
  208.           Sound(677);
  209.           Delay(10);
  210.           NoSound;
  211.           Delay(20)
  212.         End;
  213.       WriteAT(28,14,15,0,'Two Alphabets Exactly Equal');
  214.       WriteCenter(16,12,0,'AMAZING !!');
  215.       WriteCenter(22,0,7,' Press Any Key to Partly Close ');
  216.       Repeat Ip:=ReadKey Until Ip<>'';
  217.       For I:=9 DownTo 1 Do
  218.         Begin
  219.           Sound(I*110);
  220.           WriteVert(41-I*2,8,15,5,'           ');
  221.           WriteVert(41+2*I,8,15,5,'           ');
  222.           Delay(10)
  223.         End;
  224.       Sound(2500);Delay(30);
  225.       WriteVert(41,8,13,0,'║║║║║║║║║║║');
  226.       Window(1,1,80,25);
  227.       WriteAT(1,1,1,1,'  ');
  228.       GotoXY(2,1);
  229.       NoSound;
  230.       WriteCenter(22,0,7,' Press Any Key to Completely Close ');
  231.       Repeat Ip:=ReadKey Until Ip<>'';
  232.       WriteCenter(22,1,1,'                                   ');
  233.       For I:=19 DownTo 1 Do
  234.         Begin
  235.           If I>9 Then
  236.             Sound(I*150)
  237.           Else
  238.             Sound(2000-I*200);
  239.           If I=10 Then
  240.             Begin
  241.               WriteVert(31,8,12,0,'║║║║║║║║║║║');
  242.               WriteVert(51,8,12,0,'║║║║║║║║║║║');
  243.               WriteAT(41,15,14,0,Chr(2));
  244.               WriteAT(36,16,14,0,
  245. Chr(192)+Chr(196)+Chr(196)+Chr(196)+Chr(196)+Chr(197)+Chr(196)+Chr(196)+Chr(196)+Chr(196)+Chr(217));
  246.               WriteAT(41,17,14,0,Chr(179));
  247.               WriteAT(40,18,14,0,'/ \');
  248.               Delay(100);
  249.               Sound(I*200);
  250.               Delay(250);
  251.               Sound(I*150);
  252.               Delay(400)
  253.             End
  254.           Else If I>10 Then Delay(20);
  255.           WriteVert(41-I,8,15,4,'           ');
  256.           WriteVert(41+I,8,15,4,'           ')
  257.         End;
  258.       Sound(3000);Delay(30);
  259.       WriteVert(41,8,12,0,'║║║║║║║║║║║');
  260.       WriteAT(24,13,15,4,'And Finished !');
  261.       WriteAT(45,13,15,4,'Press  Any Key');
  262.       Line1:='«»«»«»«»«»«»«»';
  263.       WriteAT(24,14,7,4,Line1);
  264.       WriteAT(45,14,7,4,Line1);
  265.       Box(20,7,62,19,7,4,2);
  266.       WriteAT(41,16,14,4,Chr(2));
  267.       NoSound;
  268.       For I:=0 to 4 Do
  269.         Begin
  270.           WriteAT(65+I*2,20+I,15,1,Chr(220));
  271.           WriteAT(17-I*2,20+I,15,1,Chr(220));
  272.           WriteAT(17-I*2,6-I,15,1,Chr(223));
  273.           WriteAT(65+I*2,6-I,15,1,Chr(223));
  274.           WriteAT(41,6-I,15,1,Chr(223));
  275.           WriteAT(41,20+I,15,1,Chr(220));
  276.           WriteAT(17-I*2,13,15,1,Chr(223));
  277.           WriteAT(65+I*2,13,15,1,Chr(223))
  278.         End;
  279.       WriteAT(7,13,15,1,Chr(223));
  280.       WriteAT(75,13,15,1,Chr(223));
  281.       WriteAT(3,2,1,1,'  ');GotoXY(4,2);
  282.       Box(1,1,80,25,14,4,2);
  283.       Line1:=Replicate(23,Chr(219));
  284.       WriteVert(2,2,4,4,Line1);
  285.       WriteVert(79,2,4,4,Line1);
  286.       Line1:=Replicate(23,Chr(178));
  287.       WriteVert(3,2,0,7,Line1);
  288.       WriteVert(78,2,0,7,Line1);
  289.       WriteCenter(1,0,7,' The Wonders of TTT from TechnoJock''s Turbo Toolkit 5.0 ');
  290.       WriteCenter(2,15,1,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  291.       WriteCenter(25,0,7,' By TechnoJock Software, Inc.  (c) 1986, 1989');
  292.       WriteCenter(24,15,1,'________________________________________');
  293.       Repeat Ip:=ReadKey Until Ip<>'';
  294.       Window(1,1,80,25);
  295.       J:=1;
  296.       I:=1;
  297.       TextBackGround(0);
  298.       While I<40 Do
  299.         Begin
  300.           Window(40-I,13-J,40+I,13+J);
  301.           ClrScr;
  302.           Inc(I,4);
  303.           Inc(J,1);
  304.           Sound(I*70);
  305.           Delay(10);
  306.           NoSound;
  307.           Delay(65)
  308.         End;
  309.       Window(1,2,80,25);
  310.       Port[$3D9]:=0;TextBackGround(0);ClrScr;
  311.       Window(1,1,80,25);
  312.       WriteAT(1,1,14,4,Chr(205));
  313.       WriteAT(80,1,14,4,Chr(205));
  314.       WriteCenter(2,15,0,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~');
  315.       GotoXY(1,3)
  316.     End;
  317.  
  318.   Begin       {procedure animate}
  319.     ClrScr;
  320.     Curtain
  321.   End;   {animate}
  322.  
  323. begin
  324.     Intro_Screen;
  325.     WriteCenter(24,white+blink,blue,'Press any key to continue');
  326.     Ch := readkey;
  327.     Animate;
  328.     WriteAT(1,24,white,black,'Run DemoTTT.exe for the main demo program');
  329.     WriteAT(1,25,white,black,'TechnoJock''s Turbo Toolkit v5.0');
  330.     Ch := Readkey;
  331.     ClrScr;
  332. end.
  333.  
  334.