program x;
uses crt,graph;
Var gd,gm:integer;
begin
clrscr;
detectgraph (gd,gm);
initgraph (gd,gm,'tp\7');
Line (60,150,60,450);
Line (60,150,240,150);
Line (60,450,240,450);
Line (240,150,240,450);
Line (60,150,240,60);
Line (240,150,390,60);
Line (240,60,390,60);
Line (390,60,390,350);
Line (390,350,240,450);
Line (82,140,255,140);
Line (255,140,255,440);
Line (90,180,150,180);
Line (150,180,150,240);
Line (150,240,90,240);
Line (90,240,90,180);
Line (120,180,120,210);
Line (90,240,120,210);
Line (120,210,150,210);
Line (90,270,150,270);
Line (150,270,150,330);
Line (150,330,90,330);
Line (90,330,90,270);
Line (90,330,120,300);
Line (120,270,120,300);
Line (120,300,150,300);
Line (90,360,150,360);
Line (150,360,150,420);
Line (150,420,90,420);
Line (90,420,90,360);
Line (120,360,120,390);
Line (120,390,90,420);
Line (120,390,150,390);
Line (180,330,180,450);
Line (180,330,240,330);
Line (180,390,185,390);
Line (255,175,390,93);
Line (270,185,380,117);
Line (330,150,330,175);
Line (255,240,390,150);
Line (255,300,390,210);
Line (255,360,390,270);
Line (255,420,390,330);
Readln
end.

program grafika_01;
uses crt,graph;
var
gr1,gr2,x,y,a,b,c,d,i:integer;
begin
a:=200;b:=1;c:=260;d:=100;i:=0;
gr1:=detect;
gr2:=vgahi;
initgraph(gr1,gr2,'C:PascalBGI');
SetFillStyle(1,1);
Bar(0,0,640,480);
SetFillStyle(1,2);
Bar(0,460,640,480);
SetFillStyle(1,6);
Bar(80,340,200,460);
Bar(85,270,115,320);
SetFillStyle(1,9);
Bar(120,380,160,420);
SetColor(0);
Rectangle(120,380,160,420);
Line(140,380,140,420);
Line(140,400,160,400);
Line(60,340,140,280);
line(140,280,220,340);
Line(220,340,60,340);
SetFillStyle(1,6);
FloodFill(140,310,0);
SetFillStyle(1,9);
Sector(140,325,0,180,20,20);
line(140,325,140,305);
Line(140,325,154,315);
Line(140,325,126,315);
SetFillStyle(1,14);
FillEllipse(490,100,40,40);
SetFillStyle(1,7);
FillEllipse(492,104,4,4);
FillEllipse(488,86,6,6);
FillEllipse(500,75,2,3);
FillEllipse(480,120,4,2);
FillEllipse(520,90,2,2);
SetFillStyle(1,6);
Bar(450,340,460,460);
SetFillStyle(1,2);
Arc(415,320,40,320,20);
Arc(455,320,40,140,20);
Arc(455,320,220,320,20);
Arc(495,320,220,500,20);
Arc(435,320,75,135,30);
Arc(475,320,45,105,30);
Arc(435,320,225,315,30);
Arc(475,320,225,320,30);
Arc(455,300,20,160,25);
FloodFill(455,320,0);
x:=0;
y:=460;
SetColor(2);
repeat
Line(x,y,x+10,y-10);
Line(x+10,y,x+30,y-20);
x:=x+20;
until x>=640;
repeat
SetfillStyle(1,1);
Bar(0,140,520,200);
Bar(0,0,200,265);
SetColor(1);
SetColor(0);
if c<0 then begin c:=260;i:=0;d:=100 end;
SetFillStyle(1,15);
Arc(a-40,170,40,320,20);
Arc(a,170,40,140,20);
Arc(a,170,220,320,20);
Arc(a+40,170,220,500,20);
Arc(a-20,170,45,135,30);
Arc(a+20,170,45,135,30);
Arc(a-20,170,225,315,30);
Arc(a+20,170,225,320,30);
FloodFill(a+1,171,0);
SetFillStyle(1,7);
FillEllipse(d,c,8+i,5+i);
FillEllipse(d,c-10,14+i,10+i);
FillEllipse(d,c-25,19+i,15+i);
FillEllipse(d,c-45,25+i,19+i);
c:=c-11;
d:=d+5*b;
i:=i-1;
if a=460 then b:=-1;
if a=40 then b:=1;
a:=a+10*b; delay(64000); delay(64000);
until keypressed;
readln;
end.

Program laba13a;
uses
 graph,crt;
Var
 xc,yc,x,y,vx,vy:array[1..950] of integer;
 l:array[1..950] of boolean;
 gd,gm,x1,x2,y1,y2,x3,x4,y3,y4,y8,dx:integer;
 n,i,j,m:integer;
 c:char;
 p:boolean;
Procedure cam(x1,x2,y1,y2:integer);
begin
 SetFillStyle(1,10);
 bar(x1,y1,x2,y2);          { Tela camoLetuka }
 
 x3:=((x2-x1) div 2)-5+X1;  { KoopduHaTbl }
 x4:=((x2-x1) div 2)+5+X1;   { HoJKu }
 bar(x3,y2+1,x4,y2+9);           {HojKa}
 
 bar(x3-25,y2+9,x4+25,y2+15);    {nlatfoPma}
 
 setcolor(10);
 y8:=round((y2-y1) div 2)+y1;
 FillEllipse(x1,y8,20,15);     {Cama kabuHa}
                         {noDDepjKa Dl9 lonocTeU}
 bar(x3+3,y1-10,x4-3,y1);    {Cama noddepjka}
 bar(x3-33,y1-13,x4+33,y1-10); {Cama lonaCtb}
 
 bar(x2,y2-9,x2+45,y2);  {KoopDuHaTbl}
 FillEllipse(x2+41,y2-10,10,10);{nPaBou 4aCtu}
end;
procedure del(x1,y1,x2,y2:integer); {YdaLeHue caMoLeTuka}
begin
 SetFillStyle(1,1);
 bar(x1,y1-9,x2,y2+15);
 setcolor(1);
 y8:=round((y2-y1) div 2)+y1;
 FillEllipse(x1,y8,20,15);
 bar(x3-33,y1-13,x4+33,y1-10);
 bar(x2,y2-9,x2+45,y2);
 FillEllipse(x2+41,y2-10,10,10);
end;
procedure boom(x1,y1:integer);
begin
 ClearDevice;
 for i:=1 to 500 do
 begin
  X[i]:= x1+ i mod 10;
  Y[i]:= y1+ i div 10;
  PutPixel(X[i], Y[i], 15);
  VX[i]:= -10 + random(25);
  VY[i]:= -10 + random(25);
  l[i]:=true;
  if vx[i]=0 then
   vx[i]:=10;
  if vy[i]=0 then
   vy[i]:=10
 end;
 for i:=1 to 150 do
 begin
  sound(random(80));
  delay(1);
  nosound
 end;
 Delay(1000);
 SetColor(0);
 Repeat
  p:=false;
  for i:=1 to 500 do
  begin
  if l[i] then
  begin
   if(X[i]+VX[i] > 0) and (X[i]+VX[i] < Getmaxx) and
     (Y[i]+VY[i] > 0) and
     (getpixel(x[i]+vx[i],y[i]+vy[i])<>6) and (getpixel(x[i]+vx[i],y[i]+vy[i])<>4)
   then
   begin
    PutPixel(X[i],Y[i],0);
    X[i]:= X[i]+VX[i];
    Y[i]:= Y[i]+VY[i];
    PutPixel(X[i], Y[i], 14);
    p:=true
   end
    else
    begin
     l[i]:=false;
     VX[i]:= 0;
     VY[i]:= 0;
     sound(200);
     delay(2);
     nosound
    end;
  end;
  if i=300 then
    setbkcolor(random(20+1))
  end;
 Until not(p);
 exit;
end;
procedure goPa;
var
 i,j:integer;
begin
 SetFillStyle(1,6);
 i:=1;
 while i<=getmaxx do
 begin
  repeat
   j:=random(450)
  until j>200;
  bar(i,j,i+40,getmaxy);
  inc(i,15);
 end;
 i:=random(getmaxx-115);
 repeat
  j:=random(getmaxy-22);
 until j>300;
 SetFillStyle(1,4);
 bar(i,j,i+60,j+21);
 SetFillStyle(1,0);
 bar(i-25,0,i+115,j)
end;
Procedure nobeda;
begin
 closegraph;
 Gotoxy(30,12);
 Writeln('nocaDka bblLa ycneLLIHoU');
 readln;
end;
begin
 clrscr;
 repeat
  Gotoxy(30,12);
  writeln('Bblbepute ckoPoCtb ot 0-9');
  c:=readkey;
 until c in [#48..#57];
 case c of
  #48: dx:=0;
  #49: dx:=2;
  #50: dx:=4;
  #51: dx:=6;
  #52: dx:=8;
  #53: dx:=10;
  #54: dx:=12;
  #55: dx:=14;
  #56: dx:=16;
  #57: dx:=18;
 end;
 gd:=Detect;
 InitGraph(gd,gm,'c:\tp7\bgi');
 setbkcolor(1);
 randomize;
 gopa;
 x1:=getmaxx div 2;
 y1:=getmaxy div 2 -150;
 
 cam(x1,x1+60,y1,y1+30);
 if dx=0 then
 begin
  repeat
   dx:=15;
   p:=true;
   if y1+46+dx<getmaxy then
   begin
    m:=x3-25;
    n:=y1+53;
    p:=true;
    while (m<=x4+25) and (p) do
    begin
     if getpixel(m,n)=6 then
     begin
      boom(x1,y1);
      c:=#27;
      p:=false;
     end;
      inc(m);
     end;
    if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8+5)=6) or (getpixel(x1-20,y8+10)=6)
    then
     p:=false;
    if (getpixel(x1-15,y8+15)=6) or (getpixel(x1-10,y8+17)=6) or (getpixel(x1-5,y8+19)=6)
    then
     p:=false;
    m:=x1+61;
    while (m<=x1+110) and (p) do
    begin
    if getpixel(m,y1+37)=6 then
    begin
     boom(x1,y1);
     c:=#27;
     p:=false;
    end;
    inc(m);
    end;
   if not(p) then
   begin
    boom(x1,y1);
    p:=false;
   end
   else
   begin
    SetFillStyle(1,1);
    del(x1,y1,x1+60,y1+30);
    y1:=y1+dx;
    cam(x1,x1+60,y1,y1+30)
   end
  end
  else
  begin
   SetFillStyle(1,1);
   del(x1,y1,x1+60,y1+30);
  if y1+46+1<=getmaxy then
  begin
   y1:=y1+1;
   cam(x1,x1+60,y1,y1+30)
  end
  else
   cam(x1,x1+60,y1,y1+30)
  end;
  Delay(60000);
 until not(p)
 end
 
 else
 begin
 
  repeat
   if keypressed then
   begin
    c:=readkey;
    case ord(c) of  {Huz,Bepx,Lebo,npabo}
     49: dx:=2;
     50: dx:=4;
     51: dx:=6;
     52: dx:=8;
     53: dx:=10;
     54: dx:=12;
     55: dx:=14;
     56: dx:=16;
     57: dx:=18;
         {////////BnpaBo//////////////}
     77: if x1+111+dx<getmaxx then
          begin
           p:=true;
           if getpixel(x1+115,y1+25)=6 then
           begin
             boom(x1,y1);
             c:=#27;
             p:=false;
           end;
           Putpixel(x1+115,y1+25,9);
           m:=x1+61;
           while (m<=x1+110) and (p) do
           begin
            if getpixel(m,y1+33)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;
            inc(m);
           end;
           m:=y1+32;
           while (m<=y1+45) and (p) do
           begin
            if getpixel(x1+64,m)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;
            inc(m);
           end;
           if p then
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
            x1:=x1+dx;
            cam(x1,x1+60,y1,y1+30);
            m:=x1+61;
           end;
          end
         else
         begin
          SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);;
           if x1+111+1<=getmaxx then
           begin
            x1:=x1+1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
          end;
         {////////BnpaBo//////////////}
 
         {////////BLeBo//////////////}
     75: if x1-dx-20>0 then
          begin
           p:=true;
           if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8+5)=6) or (getpixel(x1-20,y8+10)=6)
           then
            p:=false;
           if (getpixel(x1-15,y8+15)=6) or (getpixel(x1-10,y8+17)=6) or (getpixel(x1-5,y8+19)=6)
           then
            p:=false;
            if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8-5)=6) or (getpixel(x1-20,y8-10)=6)
           then
            p:=false;
           if (getpixel(x1-15,y8-15)=6) or (getpixel(x1-10,y8-17)=6)
            then
            p:=false;
           m:=y8+19;
            while (m<y8+31) and (p) do
            begin
            if GetPixel(x1-5,m)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;
             inc(m);
            end;
           m:=y8-17;
           while (m>=y8-28) and p do
           begin
            if GetPixel(x1-10,m)=6 then
            begin
             boom(x1,y1);
             c:=#27;
             p:=false;
            end;   
            dec(m);
           end;
           if not(p) then
           begin
            boom(x1,y1);
            c:=#27;
            p:=false;
           end
           else
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
            x1:=x1-dx;
            cam(x1,x1+60,y1,y1+30);
           end
          end
          else
          begin
           SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);
           if x1-1-20>=0 then
           begin
            x1:=x1-1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
          end;
       {////////BLeBo//////////////}
 
       {////////BBepX//////////////}
     72: if y1-13-dx>0 then
          begin
           SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);
           y1:=y1-dx;
           cam(x1,x1+60,y1,y1+30);
          end
         else
         begin
          SetFillStyle(1,1);
           del(x1,y1,x1+60,y1+30);
           if y1-13-1>=0 then
           begin
            y1:=y1-1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
          end;
         {////////BBepX//////////////}
 
         {////////BHu3//////////////}
     80: if y1+46+dx<getmaxy then
          begin
           p:=true;
           m:=x3-5;
           n:=y1+60;
            while (m<=x4+5) and (p) do
            begin
             if getpixel(m,n)=4 then
              p:=false;
             inc(m);
            end;
           if not p then
           begin
            c:=#27;
            nobeda;
           end;
           m:=x3-25;
           n:=y1+50;
           p:=true;
            while (m<=x4+25) and (p) do
            begin
             if getpixel(m,n)=6 then
             begin
              boom(x1,y1);
              c:=#27;
              p:=false;
             end;
             inc(m);
            end;
           if (getpixel(x1-25,y8)=6) or (getpixel(x1-23,y8+5)=6) or (getpixel(x1-20,y8+10)=6)
           then
            p:=false;
           if (getpixel(x1-15,y8+15)=6) or (getpixel(x1-10,y8+17)=6) or (getpixel(x1-5,y8+19)=6)
           then
            p:=false;
            m:=x1+61;
            while (m<=x1+110) and (p) do
            begin
             if getpixel(m,y1+35)=6 then
             begin
              boom(x1,y1);
              c:=#27;
              p:=false;
             end;
             inc(m);
            end;
           if not(p) then
           begin
              boom(x1,y1);
              c:=#27;
              p:=false;
             end
           else
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
            y1:=y1+dx;
            cam(x1,x1+60,y1,y1+30)
           end
           end
           else
           begin
            SetFillStyle(1,1);
            del(x1,y1,x1+60,y1+30);
           if y1+46+1<=getmaxy then
           begin
            y1:=y1+1;
            cam(x1,x1+60,y1,y1+30)
           end
           else
            cam(x1,x1+60,y1,y1+30)
           end
         {////////BHu3//////////////}
    end;
   end;
  until c=#27;
 end;
 closegraph;
end.

uses graph, crt;
const n=8;{изменяя "n" вы получите любой другой многоугольник}
var poly:array[1..n+1] of pointtype;
 r,x,y,i,driver,mode:integer;
 alpha:real;
 s:string;
begin
 write('radius: ');
 readln(r);
 alpha:=0;
 driver:=detect;
 InitGraph (driver,mode, 'd:\bp\bgi');
 if GraphResult<>GroK then halt(1);
 clearviewPort;
 repeat
 x:=GetMaxX shr 1;
 y:=GetMaxY shr 1;
 for i:=1 to n +1 do begin
 poly[i].X:=x+round(R*Cos(alpha+(i-1)*2*pi/n));
 poly[i].Y:=y+Round(R*sin(alpha+(i-1)*2*pi/n));
 end;
 SetColor(10);
 DrawPoly(n+1,poly);
alpha:= alpha+pi/180;
 delay(1000);
 setcolor(0);
 DrawPoly(n+1,poly);
 until KeyPressed;
 closeGraph;
 end.

uses crt,graph;
var
i,d,m:integer;
k:integer;
p:char;
begin
d:=detect;
initgraph(d,m,'');
cleardevice;
circle(200,225,20);
circle(200,200,50);
circle(400,225,20);
circle(400,200,50);
arc(300,300,180,359,100);
p:=readkey;
if p=#13 then
begin
for i:=1 to getmaxx do
begin
k:=k+10;
cleardevice;
setcolor(red);
line(5+k,300,50+k,300);
line(25+k,300,25+k,265);
line(20+k,300,25+k,280);
line(25+k,275,40+k,270);
line(40+k,270,35+k,300);
line(25+k,275,33+k,280);
line(33+k,280,13+k,300);
circle(25+k,260,5);
circle(23+k,260,1);
circle(27+k,260,1);
delay(15000);
cleardevice;
line(5+k,300,50+k,300);
line(25+k,300,25+k,265);
line(35+k,300,25+k,280);
line(25+k,275,38+k,275);
line(42+k,285,5+k,300);
line(25+k,275,42+k,285);
line(38+k,275,25+k,300);
circle(25+k,260,5);
circle(23+k,260,1);
circle(27+k,260,1);
delay(15000);
clrscr;
if k>getmaxx then k:=1;
if keypressed then break;
end;
end;
closegraph;
readkey
end.

uses crt,graph;
  const r=20;h=5;
  var gd,gm,i,n,t,x,y,p:integer;
   begin
  clrscr;
  gd:=Detect;
  initgraph(gd,gm,' ');
  setcolor(green);
  setlinestyle(0,1,1);
  line(0,479,639,479);
  x:=r;y:=r;
  t:=479-2*r;
  n:=t div h;
  p:=h;
  while n<>0 do begin
  for i:=1 to n do begin
  setcolor(yellow);
  circle(x,y,r);
  setfillstyle(1,2);
  floodfill(x,y,2);
  delay(100);
  setcolor(0);
  circle(x,y,r);
  setfillstyle(1,0);
  floodfill(x,y,0);
  y:=y+p;
  x:=x+1;
  end;
 if p>0 then  begin t:=round(3*t/4);n:=t div h end;
 p:=-p end;
 setcolor(12);
 circle(x,y,r);
 setfillstyle(1,2);
 floodfill(x,y,12);
 repeat until keypressed;
  closegraph
 end.

program Iniziali;
 uses graph,crt;
 const m=13; d=16; v=18;  pi=3.14;
 var mx,my,mx1,my1:array[1..m] of integer;
 dx,dy,dx1,dy1:array[1..d] of integer;
 vx,vy,vx1,vy1:array[1..v] of integer;
 a,b,i,j,n,l,GraphDriver,GraphMode,GraphError:integer;
 alpha,beta:real;
 f:text;
begin
  GraphDriver :=  9;
   GraphMode := 1;
  InitGraph(GraphDriver, GraphMode,'');
  GraphError := GraphResult;
  if GraphError <> grOk then begin
    writeln ('osibka pri inizializazii graph');
    writeln(GraphErrorMsg(GraphError));
     halt(1);
    end;
    setbkcolor(15);
    setcolor(1);
 
    a:=450;
    b:=100;
 
    assign(f,'c:\projects\graphika\lab2\m.pas');
    reset(f);
    for i:=1 to m do
     readln(f,mx[i],my[i]);
 
    assign(f,'c:\projects\graphika\lab2\d.pas');
    reset(f);
    for i:=1 to d do
     readln(f,dx[i],dy[i]);
 
     assign(f,'c:\projects\graphika\lab2\v.pas');
    reset(f);
    for i:=1 to v do
     readln(f,vx[i],vy[i]);
 
 
    for i:=2 to m do
     begin
      line(mx[i-1],my[i-1],mx[i],my[i]);
     end;
 
    for i:=2 to d do
     begin
      if i<=12 then line(dx[i-1],dy[i-1],dx[i],dy[i])
       else
       while i<16 do
        begin
         i:=i+1;
         line(dx[i-1],dy[i-1],dx[i],dy[i]);
        end;
     end;
 
    for i:=2 to v do
     begin
      line(vx[i-1],vy[i-1],vx[i],vy[i]);
     end;
 
 
    for j:=1 to 72 do {216}
    begin
 
 
    SetActivePage(j);
 
    cleardevice;
 
       if j < 38 then alpha := alpha + 0.1 else alpha := alpha - 0.1;
       if j < 38 then beta := beta + 0.1 else beta := beta - 0.1;
 
      for i:=1 to v do
      begin
 
 
       vx1[i]:=round(alpha*vx[i]+(1-alpha)*a);
 
       vy1[i]:=round(beta*vy[i]+(1-beta)*b);
 
 
      end;
 
      setcolor(green);
     for i:=2 to v do
 
      begin
       {if (i <> 9) and (i <> 14) then line(vx1[i-1],vy1[i-1],vx1[i],vy1[i]);}
 
       setfillstyle(1,red);
 
       if (i<>9) and (i<>14) then  line(vx1[i-1],vy1[i-1],vx1[i],vy1[i]);
       if i > 17 then floodfill(round((vx1[12]+vx1[15])/2),round((vy1[12]+vy1[15])/2),green);
 
 
 
      end;
 
 
     setcolor(blue);
     for i:=1 to m do
      begin
       mx1[i]:=round(mx[i]*cos(j*5*pi/180)+my[i]*sin(j*5*pi/180)-100*cos(j*5*pi/180)-125*sin(j*5*pi/180)+125);
 
       my1[i]:=round(-mx[i]*sin(j*5*pi/180)+my[i]*cos(j*5*pi/180)+100*sin(j*5*pi/180)-125*cos(j*5*pi/180)+100);
 
      end;
 
     for i:=2 to m do
     begin
      line(mx1[i-1],my1[i-1],mx1[i],my1[i]);
     end;
     setfillstyle(1,yellow);
     floodfill(125,100,blue);
 
     for i:=1 to d do
      begin
       dx1[i]:=round(dx[i]*cos(j*(-5)*pi/180)+dy[i]*sin(j*(-5)*pi/180)-270*cos(j*(-5)*pi/180)-115*sin(j*(-5)*pi/180)+270);
 
 
       dy1[i]:=round(-dx[i]*sin(j*(-5)*pi/180)+dy[i]*cos(j*(-5)*pi/180)+270*sin(j*(-5)*pi/180)-115*cos(j*(-5)*pi/180)+115);
      end;
 
     for i:=2 to d do
      begin
       if i < 13 then  line(dx1[i-1],dy1[i-1],dx1[i],dy1[i]);
      if i = 13 then
         begin
           setfillstyle(1,5);
           floodfill(270,115,blue);
         end;
       if i > 13 then line(dx1[i-1],dy1[i-1],dx1[i],dy1[i]);
      end;
     setfillstyle(1,white);
     floodfill(270,115,blue);
 
    SetVisualPage(j);
    delay(5000);
 
    end;
 
    readln;
    closegraph;
end.

program Bukvi3D;
 uses graph,crt;
 const m=36; d=34; v=36;  pi=3.14;
 var mx,my,mx1,my1,mz,mz1,mx2,my2,mz2,mxe,mxe1,mye,mye1:array[1..m] of integer;
 dx,dy,dx1,dy1,dz,dz1,dx2,dy2,dz2:array[1..d] of integer;
 vx,vy,vz,vx1,vy1,vz1,vx2,vy2,vz2:array[1..v] of integer;
 mfe,mfe1:array[1..60] of pointtype;
 dfe,dfe1:array[1..60] of pointtype;
 vfe,vfe1:array[1..60] of pointtype;
 
 
 i,j,n,l,GraphDriver,GraphMode,GraphError:integer;
 f:text;
 
 
procedure Mekr;      { процедура преобразования координат буквы М    }
 begin                    {  из кабинетной 3D проекции на плоскось экрана  }
  for i:=1 to m do
     begin
      mx2[i]:=round(1*mx1[i]+0*my1[i]-cos(pi/3)*mz1[i]+100);
      my2[i]:=round(0*mx1[i]-1*my1[i]-sin(pi/3)*mz1[i]+200);
     end;
 end;
 
procedure Dekr;         { преобразование координат буквы Д}
 begin
  for i:=1 to d do
     begin
      dx2[i]:=round(1*dx1[i]+0*dy1[i]-cos(pi/3)*dz1[i]+250);
      dy2[i]:=round(0*dx1[i]-1*dy1[i]-sin(pi/3)*dz1[i]+200);
     end;
 end;
 
procedure Vekr;         { преобразование координат буквы В}
 begin
  for i:=1 to v do
     begin
      vx2[i]:=round(1*vx1[i]+0*vy1[i]-cos(pi/3)*vz1[i]+400);
      vy2[i]:=round(0*vx1[i]-1*vy1[i]-sin(pi/3)*vz1[i]+200);
     end;
 end;
 
 
procedure fmekr;        { процедура закраски передней грани буквы М}
 begin
   for i:=1 to 12 do
    begin
     mfe[i].x:=mx2[i];
     mfe[i].y:=my2[i];
    end;
   setfillstyle(1,green);
   drawpoly(12,mfe);
   fillpoly(12,mfe);
 end;
procedure fmekr1;        { процедура закраски задней грани буквы М}
 begin
   for i:=1 to 12 do
    begin
     mfe1[i].x:=mx2[i+13];
     mfe1[i].y:=my2[i+13];
    end;
   setfillstyle(1,green);
   drawpoly(12,mfe1);
   fillpoly(12,mfe1);
 end;
 
procedure fdekr;        { процедура закраски передней грани буквы Д}
 begin
   for i:=1 to 17 do
    begin
     dfe[i].x:=dx2[i];
     dfe[i].y:=dy2[i];
    end;
   setfillstyle(1,yellow);
   drawpoly(17,dfe);
   fillpoly(17,dfe);
 end;
 
 
procedure fdekr1;          { процедура закраски задней грани буквы М}
 begin
   for i:=1 to 17 do
    begin
     dfe1[i].x:=dx2[i+17];
     dfe1[i].y:=dy2[i+17];
    end;
   setfillstyle(1,yellow);
   drawpoly(17,dfe1);
   fillpoly(17,dfe1);
 end;
 
procedure fvekr;      { процедура закраски передней грани буквы В}
 begin
   for i:=1 to 18 do
    begin
     vfe[i].x:=vx2[i];
     vfe[i].y:=vy2[i];
    end;
   setfillstyle(1,red);
   drawpoly(18,vfe);
   fillpoly(18,vfe);
 end;
procedure fvekr1;         { процедура закраски задней грани буквы В}
 begin
   for i:=1 to 18 do
    begin
     vfe1[i].x:=vx2[i+18];
     vfe1[i].y:=vy2[i+18];
    end;
   setfillstyle(1,red);
   drawpoly(18,vfe1);
   fillpoly(18,vfe1);
 end;
 
procedure risM;       { рисуем саму букву М на плоскости }
  begin
  Mekr;
   for i:=2 to m do
     begin
      line(mx2[i-1],my2[i-1],mx2[i],my2[i]);
     end;
   for i:=1 to 12 do
     begin
     line(mx2[i],my2[i],mx2[i+13],my2[i+13]);
     end;
  end;
 
procedure risD;       { рисуем  Д на плоскости }
 begin
  Dekr;
  for i:=2 to d do
    if (i <> 14) and (i<>18) and (i<>31) then  line(dx2[i-1],dy2[i-1],dx2[i],dy2[i]);
  for i := 1 to 14 do
    line(dx2[i],dy2[i],dx2[i+17],dy2[i+17]);
 end;
 
procedure  risV;      { рисуем В на плоскости}
 begin
   Vekr;
   for i:=2 to v do
     begin
      if (i<>9) and (i<>14) and (i<>19) and (i<>27) and (i<>32) then line(vx2[i-1],vy2[i-1],vx2[i],vy2[i]);
     end;
   for i:=1 to 14 do
    line(vx2[i],vy2[i],vx2[i+18],vy2[i+18]);
 end;
 
 
begin
  GraphDriver :=  9;
   GraphMode := 1;
  InitGraph(GraphDriver, GraphMode,'');
  GraphError := GraphResult;
  if GraphError <> grOk then begin
    writeln ('osibka pri inizializazii graph');
    writeln(GraphErrorMsg(GraphError));
     halt(1);
    end;
    setbkcolor(15);
    setcolor(1);
 
    assign(f,'c:\projects\graphika\lab3\m.txt');    { Считываем координаты М}
    reset(f);
    for i:=1 to m do
     begin
      readln(f,mx[i],my[i],mz[i]);
      mx1[i]:=mx[i]; my1[i]:=my[i]; mz1[i]:=mz[i];
 
     end;
 
 
 
    assign(f,'c:\projects\graphika\lab3\d.txt');            { Считываем координаты Д}
    reset(f);
    for i:=1 to d do
     begin
      readln(f,dx[i],dy[i],dz[i]);
      dx1[i]:=dx[i]; dy1[i]:=dy[i]; dz1[i]:=dz[i];
     end;
 
    assign(f,'c:\projects\graphika\lab3\v.txt');        { Считываем координаты В}
    reset(f);
    for i:=1 to v do
     begin
      readln(f,vx[i],vy[i],vz[i]);
      vx1[i]:=vx[i]; vy1[i]:=vy[i]; vz1[i]:=vz[i];
     end;
 
 
      risM;   fmekr; fmekr1;           { рисуем первоначально буквы}
      risD;   fdekr; fdekr1;
      risV;   fvekr; fvekr1;
 
 
    outtext('press enter key');
    readln;
 
 
 
 for j:=1 to 72 do
  begin
 
   {            PERVI'I POVOROT             }
 
{ для улучшения визуального восприятия используем 2-х страничный режим экрана}
 
{первый поворот осуществляется вокруг оси Z}
 
 
  SetActivePage(j);  
   cleardevice;
 
   for i:=1 to m do
    begin
     mx1[i]:=round(mx[i]*cos(-5*j*pi/180)+my[i]*sin(-5*j*pi/180));
     my1[i]:=round(-mx[i]*sin(-5*j*pi/180)+my[i]*cos(-5*j*pi/180));
     mz1[i]:=mz[i]*1;
    end;
 
   for i:=1 to d do
    begin
     dx1[i]:=round(dx[i]*cos(-5*j*pi/180)+dy[i]*sin(-5*j*pi/180));
     dy1[i]:=round(-dx[i]*sin(-5*j*pi/180)+dy[i]*cos(-5*j*pi/180));
     dz1[i]:=dz[i]*1;
    end;
 
    for i:=1 to v do
    begin
     vx1[i]:=round(vx[i]*cos(-5*j*pi/180)+vy[i]*sin(-5*j*pi/180));
     vy1[i]:=round(-vx[i]*sin(-5*j*pi/180)+vy[i]*cos(-5*j*pi/180));
     vz1[i]:=vz[i]*1;
    end;
 
 
 
    risM;  risD;  risV;
    fmekr; fmekr1;
    fdekr; fdekr1;
    fvekr; fvekr1;
 
 
  SetVisualPage(j);
  delay(2500);
 
  end;
 
 
for j:=1 to 72 do
 begin
 
 {           VTOROI POVOROT               }
 
{второй поворот осуществляется вокруг оси Y}
 
  SetActivePage(j);
 cleardevice;
 
   for i:=1 to m do
    begin
     mx1[i]:=round(mx[i]*cos(5*j*pi/180)+mz[i]*sin(5*j*pi/180));
     my1[i]:=my[i]*1;
     mz1[i]:=round(-mx[i]*sin(5*j*pi/180)+mz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to d do
    begin
     dx1[i]:=round(dx[i]*cos(5*j*pi/180)+dz[i]*sin(5*j*pi/180));
     dy1[i]:=dy[i]*1;
     dz1[i]:=round(-dx[i]*sin(5*j*pi/180)+dz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to v do
    begin
     vx1[i]:=round(vx[i]*cos(5*j*pi/180)+vz[i]*sin(5*j*pi/180));
     vy1[i]:=vy[i]*1;
     vz1[i]:=round(-vx[i]*sin(5*j*pi/180)+vz[i]*cos(5*j*pi/180));
    end;
 
 
    risM;  risD;  risV;
    fmekr; fmekr1;
    fdekr; fdekr1;
    fvekr; fvekr1;
 
 
 SetVisualPage(j);
 delay(2500);
 end;
 
 
 for j:=1 to 72 do
  begin
 
  {          TRETII POVOROT             }
 
{третий поворот осуществляется вокруг оси X}
 
   SetActivePage(j);
   cleardevice;
 
   for i:=1 to m do
    begin
     mx1[i]:=mx[i]*1;
     my1[i]:=round(my[i]*cos(5*j*pi/180)+mz[i]*sin(5*j*pi/180));
     mz1[i]:=round(-my[i]*sin(5*j*pi/180)+mz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to d do
    begin
     dx1[i]:=dx[i]*1;
     dy1[i]:=round(dy[i]*cos(5*j*pi/180)+dz[i]*sin(5*j*pi/180));
     dz1[i]:=round(-dy[i]*sin(5*j*pi/180)+dz[i]*cos(5*j*pi/180));
    end;
 
    for i:=1 to v do
    begin
     vx1[i]:=vx[i]*1;
     vy1[i]:=round(vy[i]*cos(5*j*pi/180)+vz[i]*sin(5*j*pi/180));
     vz1[i]:=round(-vy[i]*sin(5*j*pi/180)+vz[i]*cos(5*j*pi/180));
    end;
 
 
    risM;  risD;  risV;
    fmekr; fmekr1;
    fdekr; fdekr1;
    fvekr; fvekr1;
 
 
   SetVisualPage(j);
   delay(2500);
  end;
 
 
    readln;
    closegraph;
end.

program lr_19;
uses crt,graph;
type fun=function(x:real):real;
var gd,gm:integer;
{$f+}
function f(x:real):real;
begin
f:=0.25*x*sqr(x)+x-1.2502
end;
{$f-}
procedure Graffun(xn,xk,ok:real;xa,ya,xb,yb:integer;f:fun);
var y,x,hx,hx1,ymin,ymax,mx,my,yy,sx,sy:real;
    i,x1,y1,x2,y2,hy:integer;
    st:string;
procedure maxmin;
begin
x:=xn;
ymax:=-1e30;
ymin:=1e30;
while x<=xk do
      begin
      y:=f(x);
      if y>ymax then ymax:=y;
      if y<ymin then ymin:=y;
      x:=x+hx1
      end;
ymax:=round(ymax/ok+0.4999)*ok;
ymin:=round(ymin/ok-0.5)*ok;
end;
procedure graf;
begin
setlinestyle(0,0,3);
x:=xn;
setcolor(4);
x1:=round(mx*x+sx);
y1:=round(-my*f(x)+sy);
while x<=xk-hx1 do
 begin
  x:=x+hx1;
  x2:=round(mx*x+sx);
  y2:=round(-my*f(x)+sy);
  line(x1,y1,x2,y2);
  x1:=x2;
  y1:=y2
 end
end;
begin
hx1:=(xk-xn)/200;
maxmin;
hx:=(xk-xn)/10;
hy:=(yb-ya) div 8;
mx:=(xb-xa)/(xk-xn);
my:=(yb-ya)/(ymax-ymin);
sy:=ya+my*ymax;
sx:=xa-mx*xn;
setfillstyle(1,7);
bar(xa,ya,xb,yb);
setlinestyle(0,0,1);
settextjustify(1,2);
settextstyle(0,0,1);
x:=xn;
i:=round(mx*x+sx);
while i<=xb+1 do
 begin
  setcolor(15);
  line(i,ya,i,yb);
  setcolor(14);
  str(x:4:2,st);
  outtextxy(i,yb+3,st);
  x:=x+hx;
  i:=round(mx*x+sx)
 end;
settextjustify(2,1);
i:=yb;
while i>=ya do
 begin
  setcolor(15);
  line(xa,i,xb,i);
  yy:=(sy-i)/my;
  setcolor(14);
  str(yy:4:2,st);
  outtextxy(xa-3,i,st);
  i:=i-hy
 end;
graf;
end;
procedure Kurcorx(xn,xk,ok:real;xa,ya,xb,yb:integer;f:fun);
var my,sy,ymin,ymax,x,mx,sx,y,hx,hx1:real;
    i,y1,i1,hi:integer;
    st:string;
    ch:char;
procedure maxmin;
begin
x:=xn;
ymax:=-1e30;
ymin:=1e30;
while x<=xk do
  begin
   y:=f(x);
   if y>ymax then ymax:=y;
   if y<ymin then ymin:=y;
   x:=x+hx1
 end;
ymax:=round(ymax/ok+0.4999)*ok;
ymin:=round(ymin/ok-0.5)*ok;
end;
procedure out;
begin
setcolor(11); setlinestyle(0,0,3);
hx1:=(xk-xn)/200;
maxmin;
x:=(i-sx)/mx;
my:=(yb-ya)/(ymax-ymin);
sy:=ya+my*ymax;
y1:=round(-my*f(x)+sy);
line(i,y1,i,y1+10);
line(i,y1,i-3,y1+5);
line(i,y1,i+3,y1+5)
end;
procedure quit;
begin
setfillstyle(1,1);
bar(xb+15,yb-55,xb+86,yb-43);
setcolor(15);
settextjustify(0,0);
outtextxy(xb+18,yb-45,'QUIT-ESC');
end;
begin
mx:=(xb-xa)/(xk-xn);
sx:=xa-mx*xn;
hi:=4;i:=xa;i1:=yb;
quit;
setwritemode(xorput);
out;
while true do
 begin
  ch:=readkey; if ch=#27 then exit;
  if ch=#0 then
   begin
    ch:=readkey;
    case ch of
    #75:begin
        out;
        i:=i-hi;
        {i1:=i1+hi;}
        if i<xa then i:=xa;
        {if i1>yb then i1:=yb;}
        out
        end;
    #77:begin
        out;
        i:=i+hi;
        {i1:=i1-hi;}
        if i>xb then i:=xb;
        {if i1<ya then i1:=ya;}
        out
        end;
    #71:begin
        out;
        i:=xa;
        out
        end;
    #79:begin
        out;
        i:=xb;
        out
        end;
    end;
x:=(i-sx)/mx;
y:=f(x);
setviewport(xb+15,yb-30,getmaxx,yb,false);
setcolor(14);
clearviewport;
str(x:4:2,st);
outtextxy(4,12,'X='+st);
str(y:5:2,st);
outtextxy(4,27,'F='+st);
setviewport(0,0,getmaxx,getmaxy,true);
end
end
end;
begin
gd:=detect;
initgraph(gd,gm,'');
setbkcolor(9);
Graffun(1.5,6.5,0.5,60,8,getmaxx-90,getmaxy-23,f);
Kurcorx(1.5,6.5,0.5,60,8,getmaxx-90,getmaxy-23,f);
closegraph;
end.