program kresli;
uses crt, obrazce;
type ukazatel=^xb;
xb=record
dalsi:ukazatel;
pp:^bod;
end;
var b:^bod;
c:^cara;
k:^elipsa;
o:^obdelnik;
zac,akt:ukazatel;
kl:char;
byl_pohyb, konec:boolean;
label cyklus_poprve;
const bakt=12;
bostatni=14;
{**********************************************}
{**********************************************}
procedure zobrazto; {zobrazi vsechny objekty v zasobniku}
var pom:ukazatel;
begin
pom:=zac;
while pom<>nil do begin
if pom<>akt then pom^.pp^.svit(bostatni) else pom^.pp^.svit(bakt);
pom:=pom^.dalsi;
end;
end;
procedure zobraz_cele; {Preview}
var pom:ukazatel;
begin
vymaz;pom:=zac;
while pom<>nil do begin pom^.pp^.svit(bostatni);pom:=pom^.dalsi;end;
escejp;
end;
procedure hejbej(pom:ukazatel); {pohybovani s objektem, navic se neprekresluje}
var a:integer;
poprve:boolean;
begin
a:=pom^.pp^.cojsem; vymaz2; menu;
if a=1 then menub else menuo; {vykresleni menu k danemu objektu}
repeat {pohybovani s objektem}
pom^.pp^.svit(bakt);
pom^.pp^.svit(0);
pom^.pp^.pohyb(kl);
zobrazto;
kl:=readkey; if ord(kl)=0 then kl:=readkey;
byl_pohyb:=true;
until not ((ord(kl)=72) or (ord(kl)=80) or (ord(kl)=75) or (ord(kl)=77) or (ord(kl)=50) or
(ord(kl)=52) or (ord(kl)=54) or (ord(kl)=56) or (ord(kl)=43) or (ord(kl)=45));
pom^.pp^.svit(bakt);
end;
procedure zarad(q:ubod); {zaradi objekt do zasobniku}
var pom:ukazatel;
begin
new(pom);
new(pom^.pp);
pom^.pp:=q;
pom^.dalsi:=zac;
zac:=pom;
akt:=pom;
zobrazto;
end;
procedure kopiruj; {zkopiruje akualni objekt a zaradi do zasobniku}
var pom:ukazatel;
a0,a1,a2,a3,a4:integer;
begin
with akt^.pp^ do begin
a0:=cojsem;a1:=ukazx+10;a2:=ukazy+10;a3:=ukazsx;a4:=ukazsy; end;
case a0 of
1: zarad(new(ubod,init(a1,a2,a3,a4)));
{ 1: begin new(b,init(a1,a2,a3,a4)); zarad(b); end;}
2: begin new(c,init(a1,a2,a3,a4)); zarad(c); end;
3: begin new(k,init(a1,a2,a3,a4)); zarad(k); end;
4: begin new(o,init(a1,a2,a3,a4)); zarad(o); end;
end;
zobrazto;
end;
procedure smaz; {smazani objektu ze zasobniku}
var pom,pomm:ukazatel;
begin
if akt<>nil then begin
pom:=zac;
if pom=akt then begin {smazani pokud je na vrcholu zasobniku}
pom^.pp^.svit(0);
zac:=pom^.dalsi;
akt:=zac;
dispose(pom^.pp);
dispose(pom);
end
else begin {smazani pokud neni na vrcholu zasobniku}
while pom^.dalsi<>akt do pom:=pom^.dalsi;
akt^.pp^.svit(0);
pomm:=akt;
pom^.dalsi:=akt^.dalsi;
akt:=pom;
dispose(pomm^.pp);
dispose(pomm);
end;
end;
end;
procedure smaz_vse; {smaze vsechny objekty ze zasobniku}
var pom,pomm:ukazatel;
begin
if zac<>nil then begin
pom:=zac;
while pom<>nil do begin
pomm:=pom;
pom^.pp^.svit(0);
zac:=pom^.dalsi;
pom:=pom^.dalsi;
dispose(pomm^.pp);
dispose(pomm);
end;
end;
zac:=nil; akt:=nil;
end;
procedure LoadSave(LS:byte; soubor:string); {Ulozeni/Otevreni souboru z disku}
var f:file of integer;
pom:ukazatel;
a0,a1,a2,a3,a4:integer;
begin
assign(f,soubor);
if ls=0 then begin {Cast0: Otevreni souboru z disku}
reset(f);
while not eof(f) do begin
read(f,a0,a1,a2,a3,a4);
case a0 of
1: begin new(b,init(a1,a2,a3,a4)); zarad(b); end;
2: begin new(c,init(a1,a2,a3,a4)); zarad(c); end;
3: begin new(k,init(a1,a2,a3,a4)); zarad(k); end;
4: begin new(o,init(a1,a2,a3,a4)); zarad(o); end;
end;
end;
end;
if ls=1 then begin {Cast1: Ulozeni souboru na disk}
rewrite(f);
pom:=zac;
while pom<>nil do begin
with pom^.pp^ do begin
a0:=cojsem; a1:=ukazx;
a2:=ukazy; a3:=ukazsx; a4:=ukazsy;
end;
write(f,a0,a1,a2,a3,a4);
pom:=pom^.dalsi;
end;
end;
close(f);
end;
{*******************************************}
{ M A I N P R O G R A M }
{*******************************************}
begin
IniGra;
zac:=nil; akt:=nil; byl_pohyb:=false; konec:=false;
vymaz;vymaz2;menu; {nastaveni pocatecnich hodnot a obrazovky}
repeat {smycka na zpracovani prikazu z klavesnice}
kl:=readkey; if kl=#0 then kl:=readkey;
cyklus_poprve: {projede jeste jednou smycku bez cekani na stisk klavesy}
byl_pohyb:=false;
case ord(kl) of
59: begin {F1 bod}
new(b,init(100,100,0,0)); zarad(b); hejbej(akt);
end;
60: begin {F2 cara}
new(c,init(100,100,100,100)); zarad(c); hejbej(akt);
end;
61: begin {F3 elipsa}
new(k,init(100,100,100,100)); zarad(k); hejbej(akt);
end;
62: begin {F4 obdelnik}
new(o,init(100,100,100,100)); zarad(o); hejbej(akt);
end;
63: {F5 Kopirovani aktualniho objektu} kopiruj;
64: {F6 smaze vsechny objekty ze zasobniku} smaz_vse;
65: {nahrani z disku F7} loadsave(0,'data.dat');
66: {ulozeni na disk F8} loadsave(1,'data.dat');
67: {F9 Nahled} Zobraz_cele;
68: {F10 Napoveda} Help;
9: {TAB zmena aktualniho objektu}
if akt<>nil then if akt^.dalsi<>nil then akt:=akt^.dalsi else akt:=zac;
79: konec:=true;
83: {Del smazani aktualniho objektu} smaz;
else begin if (akt<>nil) then hejbej(akt); end;
{pokud je jina klavesa nez uvedena v casi Case, tak pohybuj s objektem}
end; {End Case}
vymaz2; menu; zobrazto;
if byl_pohyb then goto cyklus_poprve;
byl_pohyb:=false;
until konec;
CloGra;
end.
Zpět