program sinus;
{Nakresli na obrazovku graf funkce sinus}
uses Graph;
const xzoom=32;
      yzoom=xzoom;
var gd,gm:integer;
    x,x0,y0:integer;

begin
 gd:=Detect;
 InitGraph(gd,gm,' ');

 y0:=GetMaxY div 2;
 x0:=GetMaxX div 2;

 for x:=-10*xzoom to 10*xzoom do
  PutPixel(x0+x,y0+round(sin(x/xzoom)*yzoom),15);

 readln;
 CloseGraph;
end.

*********************************************************************

program sachovnice;
{Vykresli v levem hornim rohu obrazovky prazdnou sachovnici}
uses Graph;
var gd,gm:integer;
    i,j:integer;
begin
 gd:=Detect;
 InitGraph(gd,gm,' ');


 for i:=0 to 7 do
  for j:=0 to 7 do
   begin
    SetFillStyle(CloseDotFill, ((i+j+1) mod 2)*7);
    Bar(i*20,j*20,i*20+20,j*20+20);
   end;

 Readln;
 CloseGraph;
end.

***********************************************************************

program rotace;
{Nakresli dve kruznice, rotujici kolem ve vzdalenosti r kolem stredu obrazovky
prvni kruznice ma polomer r1, barvu c1 a obiha rychlosti v1,
druha kruznice ma polomer r2, barvu c2 a obiha rychlosti v2.}
uses Graph,Crt;

const r=100;
      r1=15;
      r2=20;
      c1=Red;
      c2=Yellow;
      v1=2;
      v2=-3;

var gd,gm:integer;
    s,t:real;
    x0,y0:word;

begin
 gd:=Detect;
 InitGraph(gd,gm,' ');

 y0:=GetMaxY div 2;
 x0:=GetMaxX div 2;
 s:=-maxlongint;
 t:=maxlongint;
 repeat
  {Neprve smazeme predchozi obrazek}
  SetColor(GetBkColor);
  Circle(x0+round(r*sin(s)),y0+round(r*cos(s)),r1);
  Circle(x0+round(r*sin(t)),y0+round(r*cos(t)),r2);

  {A pote nakreslime novy}
  s:=s+v1/360;
  t:=t+v2/360;
  SetColor(c1);
  Circle(x0+round(r*sin(s)),y0+round(r*cos(s)),r1);
  SetColor(c2);
  Circle(x0+round(r*sin(t)),y0+round(r*cos(t)),r2);
  Delay(8);
 until KeyPressed;

 CloseGraph;
end.


************************************************************************

program hodiny;
{Nakresli rucickove hodiny.
Aby se zamezilo blikani animace,
nejprve nakresli novou pozici rucicek a teprve pote smaze starou.
Vyzaduje to par promennych navic.
Musime take osetrit to, ze pokud se rucicka nepohla, nesmime ji smazat.
Vypisuje i milisekundy (textove), ale prislusny udaj je vzhledem k rychlosti
pascalovskych grafickych funkci znacne zastaraly.
}

uses Graph,Crt,Dos;
const presnost=0.0001; {Jak velka zmena minut + sec/60 povede k prekresleni rucicky}

function Max(a,b:Integer):Integer;
begin
 if a>b then Max:=a else Max:=b;
end;

function Roman(I:byte):string;
begin
 case i of
  1:Roman:='I';
  2:Roman:='II';
  3:Roman:='III';
  4:Roman:='IV';
  5:Roman:='V';
  6:Roman:='VI';
  7:Roman:='VII';
  8:Roman:='VIII';
  9:Roman:='IX';
  10:Roman:='X';
  11:Roman:='XI';
  12:Roman:='XII';
  else Roman:='Neni hodina';
 end;
end;

var gd,gm:integer;
    x,y,r,i:integer;
    r1,r2:word;
    hour,minute,second,sec100:word;
    h,m:real;
    lh,lm,ls:real; {Minuly udaj, tedy ten, co je jiz zapotrebi smazat}
                   {Aby grafika neblikala, mazeme rucicku teprve pote,
                   co jiz jsme nakreslili novou, takze si holt musime
                   zapamatovat, co mame smazat}
    s:string;

begin
 gd:=Detect;
 InitGraph(gd,gm,' ');
 x:=GetMaxX div 2;
 y:=GetMaxY div 2;
 r:=Max(GetMaxX,GetMaxY)*4 div 11;
 SetColor(14);
 Circle(x,y,r);
 r:=r*5 div 6;
 for I:=1 to 12 do
  OutTextXY(x+round(r*sin(i*pi/6)),y-round(r*cos(i*pi/6)),Roman(I));

 r2:=r*6 div 7;

 r1:=r div 30;
 FillEllipse(x,y,r1,r1);
 SetFillStyle(EmptyFill,GetColor);
 repeat
  GetTime(Hour, Minute, Second, Sec100);
  Line(x+round(r1*sin(second*pi/30)),y-round(r1*cos(second*pi/30)),
             x+round(r2*sin(second*pi/30)),y-round(r2*cos(second*pi/30)));
  Str(Sec100,s);
  OutTextXY(x-7,y+r2 div 2,s);
  m:=minute+second/60;
  Line(x+round(r1*sin(m*pi/30)),y-round(r1*cos(m*pi/30)),
             x+round(r2*sin(m*pi/30)),y-round(r2*cos(m*pi/30)));
  h:=hour+m/60;
  Line(x+round(r1*sin(h*pi/6)),y-round(r1*cos(h*pi/6)),
             x+round(r2*sin(h*pi/6))*2div 3,y-round(r2*cos(h*pi/6))*2div 3);

  Delay(1);
  SetColor(GetBkColor);
  Bar(x-7,y+(r2 div 2),x+7,y+r2 div 2+7);
  if ls<>second then
  Line(x+round(r1*sin(ls*pi/30)),y-round(r1*cos(ls*pi/30)),
             x+round(r2*sin(ls*pi/30)),y-round(r2*cos(ls*pi/30)));
  if abs(lm-m)>presnost then
  Line(x+round(r1*sin(lm*pi/30)),y-round(r1*cos(lm*pi/30)),
             x+round(r2*sin(lm*pi/30)),y-round(r2*cos(lm*pi/30)));
  if abs(lh-h)>presnost then
  Line(x+round(r1*sin(lh*pi/6)),y-round(r1*cos(lh*pi/6)),
             x+round(r2*sin(lh*pi/6))*2div 3,y-round(r2*cos(lh*pi/6))*2div 3);
  SetColor(14);

  ls:=second;
  lh:=h;
  lm:=m;

 until KeyPressed;

 CloseGraph;
end.

****************************************************************************

program MandelBrot;
{Vykresli Mandelbrotovu mnozinu, pricemz hranici obarvi.
Mandelbrotova mnozina se nachazi ve kruhu o polomeru 2 a stredu 0.
Po nakresleni je nekolik moznosti:
1) Q ... ukonci program
2) P ... dokresli souradnicove osy
3) M ... zapne mys a necha vas vybrat novou vykreslovanou oblast
         1. kliknuti levy dolni roh oblasti
         2. kliknuti pravy horni roh oblasti
         zadate-li to jinak, obrazek se otoci.
4) N ... nove zadani, znovu vas necha zadat vykreslovane souradnice
Preji prijemne brouzdani po teto uchvatne mape.
}


uses Graph,Crt;
const kroku=100;
      popisx=8;
      popisy=8;
      popis_presnost1=6;
      popis_presnost2=4;

procedure ZadejData(var x1,y1,x2,y2:Extended;s:Openstring);
begin
 RestoreCrtMode;
 write(s);
 writeln('Zadej souradnice leveho dolniho rohu oblasti:');
 write('                                             x:');
 readln(x1);
 write('                                             y:');
 readln(y1);
 writeln;

 writeln('Zadej souradnice praveho horniho rohu oblasti:');
 write('                                             x:');
 readln(x2);
 write('                                             y:');
 readln(y2);
 writeln;

 SetGraphMode(GetGraphMode);
end;

procedure ShowCross(x1,y1,x2,y2:Extended); {Ukaze zamerovaci kriz}
var s:string;
    i,j:integer;
    stepx,stepy:Extended;
begin
 stepx:=(x2-x1)/GetMaxX;
 stepy:=(y1-y2)/GetMaxY;

 line(GetMaxX div 2,0,GetMaxX div 2,GetMaxY);
 line(0,GetMaxY div 2,GetMaxX,GetMaxY div 2);
 for i:=0 to popisx do
  begin
   j:=GetMaxX*I div (popisx+1);
   Str(x1+j*stepx:popis_presnost1:popis_presnost2,s);
   OutTextXY(j,GetMaxY div 2+2,s);
   Line(j,GetMaxY div 2+2,j,GetMaxY div 2-3);
  end;

 for i:=0 to popisy do
  begin
   j:=GetMaxY*I div (popisy+1);
   Str(y2+j*stepy:popis_presnost1:popis_presnost2,s);
   OutTextXY(GetMaxX div 2+2,j,s);
   Line(GetMaxX div 2-2,j,GetMaxX div 2+2,j);
  end;
end;

procedure GetPoint(var r,s:Extended); {Ziska souradnice kliknuti}
const LeftButton=1;
var x,y:word;
    Buttons:word;
begin
 repeat
   asm
    mov ax,5
    mov bx,0 {prave tlacitko}
    int 33h
    mov X,CX
    mov Y,DX
    mov Buttons,BX
   end; {asm}
 until (Buttons)<>0;
 r:=x;
 s:=y;
end;

procedure Mouse(puvx1,puvy1,puvx2,puvy2:Extended;var x1,y1,x2,y2:Extended); {Zjisti novy vykreslovany obdelnik}
var stepx,stepy:Extended;
begin
 stepx:=(puvx2-puvx1)/GetMaxX;
 stepy:=(puvy1-puvy2)/GetMaxY;
 asm {Zapne mys a ukaze kurzor}
  mov ax,00h
  int 33h
  mov ax,01h
  int 33h
 end;
 Getpoint(x1,y1);
 x1:=puvx1+stepx*x1;
 y1:=puvy2+stepy*y1;

 Getpoint(x2,y2);
 x2:=puvx1+stepx*x2;
 y2:=puvy2+stepy*y2;

 asm  {Vypne kurzor mysi}
  mov ax,02h
  int 33h
 end;
end;


procedure Kresli(x1,y1,x2,y2:Extended); {Jadro celeho programu, vykresli obarveny obdelnik Gaussovy roviny na obrazovku}
var stepx,stepy:Extended;
    zx,zy:Extended;
    tx,ty,sx,sy:Extended;
    i,j:Integer;
    iter:Integer;
begin
 stepx:=(x2-x1)/GetMaxX;
 stepy:=(y1-y2)/GetMaxY; {Tohle vypada moc placate}
 {stepy:=-stepx;} {Zbavime se placatosti. Na ose y je u obrazovky
                  prohozena orientace, proto to -}
 zx:=x1;
 for i:=0 to GetMaxX do
  begin
  zx:=zx+stepx;
  zy:=y2;
  for j:=0 to GetMaxY do
   begin
    zy:=zy+stepy;
    tx:=zx;
    ty:=zy;
    iter:=0;
    while (iter<kroku) and (tx*tx+ty*ty<=4) do
     begin
      inc(iter);           {Vlastni algoritmus, ktery zjistuje
                           zda bod do mnoziny patri ci ne.
                           Strucne receno, nevypadne-li dostatecne
                           dlouho, tak prohlasime, ze je v ni.}
      sx:=tx*tx-ty*ty+zx;
      sy:=2*tx*ty+zy;
      tx:=sx;
      ty:=sy;
     end;
    if iter=kroku then putpixel(i,j,black) else
       if iter>kroku div 2 then putpixel(i,j,iter mod 4) {Pobliz hranice barvicky}
        else putpixel(i,j,blue);
   end;
 end;
end;

var gd,gm:integer;
    x1,y1,x2,y2:extended;
    c:char;

begin  {Vlastni telo je jako vzdy jednoduche}
 gd:=Detect;
 InitGraph(gd,gm,' ');

 ZadejData(x1,y1,x2,y2,'');
 Kresli(x1,y1,x2,y2);

  repeat
   c:=readkey;
   c:=UpCase(c);
   case c of
    'N': begin ZadejData(x1,y1,x2,y2,'NOVE ZADANI'#13#10#13#10); Kresli(x1,y1,x2,y2); end;
    'Q': begin CloseGraph; Exit; end;
    'P': ShowCross(x1,y1,x2,y2);
    'M': begin Mouse(x1,y1,x2,y2,x1,y1,x2,y2); Kresli(x1,y1,x2,y2); end;
  end;
 until false;
end.