íåò;
Âûõîäíûå äàííûå:
True: ðèñóåì êóáèê;
False: íà ýòîì ìåñòå óæå åñòü êóáèê, çíà÷èò íå ðèñóåì;
3. procedure stroika;
Íàçíà÷åíèå: ðèñóåò êóáèê è çàïèñûâàåò åãî êîîðäèíàòû â ôàéë;
Âõîäíûå äàííûå: íåò;
Âûõîäíûå äàííûå: íåò;
4. procedure search_y;
Íàçíà÷åíèå: èùåò ïîäõîäÿùèå êîîðäèíàòû äëÿ ïîñòðîåíèÿ êóáèêà;
Âõîäíûå äàííûå: íåò;
Âûõîäíûå äàííûå: íåò;
5. procedure build_level;
Íàçíà÷åíèå: ñòðîèò ýòàï, èñïîëüçóÿ âûøåîïèñàííûå ïîäïðîãðàììû;
Âõîäíûå äàííûå: íåò;
Âûõîäíûå äàííûå: íåò;
Òåêñò ïðîãðàììû:
program markedit;
uses graph,crt,mymouse;
type t_kubik=-10..640;
t_arr=array[1..494] of t_kubik;
var x,y:word;
f,f_s:text;
a:t_arr;
i:1..494;
procedure initgr;
var grdriver,grmode:integer;
begin
grdriver:=vga;
grmode:=vgahi;
initgraph(grdriver,grmode,'');
if GraphResult <> grOk then halt;
end;
procedure text_na_ekran;
var f:text;
a:char;
begin
assign(f,'stroika.txt');
reset(f);
textmode(1);
textbackground(3);
textcolor(0);
clrscr;
while not eof(f) do
begin
while not(eof(f)) do
begin
read(f,a);
write(a);
end;
writeln;
end;
while not(keypressed) do
case readkey of
' ':exit;
end;
close(f);
end;
function netu:boolean;
var k:1..494;
begin
for k:=1 to 494 do
begin
if a[k]=x then
if a[k+1]=y then
begin netu:=false; exit; end;
end;
netu:=true;
end;
procedure stroika;
var color:1..15;
pattern:1..12;
begin
if netu then
begin
writeln(f,x,' ',y);
a[i]:=x;
a[i+1]:=y;
inc(i,2);
color:=random(14)+1;
pattern:=random(11)+1;
setcolor(color);
setfillstyle(pattern,color);
bar3d(x,y,48+x,y-20,0,false);
end;
end;
procedure search_y;
begin
case y of
22..42: begin y:=42; stroika; end;
43..63: begin y:=63; stroika; end;
64..84: begin y:=84; stroika; end;
85..105: begin y:=105; stroika; end;
106..126:begin y:=126; stroika; end;
127..147:begin y:=147; stroika; end;
148..168:begin y:=168; stroika; end;
169..189:begin y:=189; stroika; end;
190..210:begin y:=210; stroika; end;
211..231:begin y:=231; stroika; end;
232..252:begin y:=252; stroika; end;
263..273:begin y:=273; stroika; end;
274..294:begin y:=294; stroika; end;
295..315:begin y:=315; stroika; end;
316..336:begin y:=336; stroika; end;
337..357:begin y:=357; stroika; end;
358..378:begin y:=378; stroika; end;
379..399:begin y:=399; stroika; end;
400..420:begin y:=420; stroika; end;
end;
end;
procedure build_level;
var buttoncount,errorcode:byte;
lb,rb,tb:boolean;
x_pred:word;
s,s_l:string;
number:0..10;
spusk:1..500;
code:integer;
begin
initmouse(buttoncount,errorcode);
cleardevice;
{à ¬ª }
setcolor(random(14)+1);
rectangle(0,21,getmaxx,getmaxy);
setcolor(brown);
s:='when finish --- press the right button of the mouse';
settextstyle(7{GothicFont},horizdir,2);
settextjustify(1,1);
outtextxy(getmaxx div 2,5,s);
setYrange(21,420);
setXrange(1,637);
assign(f,'level.den');
rewrite(f);
x:=10;y:=10;
setmouseXY(x,y);
x_pred:=0;
mouseon;
repeat
getmouseXY(x,y,lb,rb,tb);
if lb then begin
mouseoff;
if x<>x_pred then
case x of
1..49: begin x:=1; search_y; end;
50..98: begin x:=50; search_y; end;
99..147:begin x:=99; search_y; end;
148..196:begin x:=148; search_y; end;
197..245:begin x:=197; search_y; end;
246..294:begin x:=246; search_y; end;
295..343:begin x:=295; search_y; end;
344..392:begin x:=344; search_y; end;
393..441:begin x:=393; search_y; end;
442..490:begin x:=442; search_y; end;
491..539:begin x:=491; search_y; end;
540..588:begin x:=540; search_y; end;
589..637:begin x:=589; search_y; end;
end;
x_pred:=x;
mouseon; end;
until rb;
setfillstyle(1,black);
bar(4,getmaxy div 5-8,130,getmaxy div 5 +300+20);
setcolor(yellow);
s:='Save as: ';
spusk:=getmaxy div 5;
settextstyle(4{GothicFont},horizdir,4);
settextjustify(lefttext,centertext);
outtextxy(4,spusk,s);
for number:=1 to 10 do
begin
inc(spusk,30);
str(number,s_l);
s:='Level '+s_l;
settextstyle(4{GothicFont},horizdir,4);
settextjustify(lefttext,centertext);
outtextxy(4,spusk,s);
end;
close(f);
repeat
if keypressed then
begin
s:=readkey;
val(s,number,code);
case number of
0:begin
assign(f_s,'levels\level10.den');
erase(f_s);
rename(f,'levels\level10.den');
exit;
end
else if number in [1..9] then
begin
assign(f_s,'levels\level'+s+'.den');
erase(f_s);
rename(f,'levels\level'+s+'.den');
exit;
end;
end;
end;
until false;
end;
var j:1..494;
begin
{for j:=1 to 494 do
a[j]:=0;}
i:=1;
randomize;
text_na_ekran;
initgr;
build_level;
mouseoff;
closegraph;
end.
Ñïèñîê èñïîëüçóåìîé ëèòåðàòóðû:
1. ßí Áåëåöêèé «Òóðáî Ïàñêàëü ñ ãðàôèêîé äëÿ ïåðñîíàëüíûõ êîìïüþòåðîâ»
2. Walasek J.Konwersacyjne otoczenie programowe Pascala. WNT, Warsawa
3. Turbo Tutor. Borland International. Scotts Valley, California
4. Cherry G. Pascal Programming Structures. Reston Publishing Company. Reston, Virginia