Procedure Neo_Final;Program yeta;
Uses crt;
const dim=20;{max_rozm} c=10;
{limit_chisel, you can change dim=2..20; c=1..10}
Label go1;
type matrix=array[0..dim,0..dim] of integer;
var x:byte; {rozmir matryci}
way:array[0..dim,0..dim] of boolean;
a,b:matrix; {umova,best_ways,best_paths}
i,j{cikl},col{color},iter {tries_with_help}:byte;
sum{user_way},max{best_user_way},limit{best_way}:integer;
wrabbit:boolean; {help}
raize:boolean; {goto_next_level}
R:byte;
dd:string[6];
yn,yn0:char;
{"Matrix" print; x helps go faster as dimension grows}
procedure M_Print(s:string);
var i:byte;
Begin
for i:=1 to length(s) do
Begin
write(s[i]); delay(100-2*x);
if s[i]=':' then delay(100); {dovsha pauza ":"}
end;{for}
End;
{constant speed of print; for Snake & CopyRight}
procedure M_Print_Z(s:string); {final}
var i:byte;
Begin
for i:=1 to length(s) do
Begin
if (i<>38) or (s[i]<>':') then write(s[i])
else {zheltye glaza}
begin textcolor(yellow); write(':'); delay(100); textcolor(white); end;{if}
Delay(100);
end;{for}
End;
procedure M_Print_Light(s:string;n:byte);
var i:byte;
Begin
for i:=1 to length(s) do
Begin
TextColor(White);
gotoxy(i,n); write(s[i]);
Delay(40);
gotoxy(i,n); Textcolor(LightGray); write(s[i]); delay(10);
end;{for}
Delay(1000); writeln;
End;
procedure CopyRight; {pyshe na potochnomy kursori}
var wx,wy:byte;
Begin
wx:=wherex; wy:=wherey;
Gotoxy(wx,wy); TextColor(lightgray);
M_Print_Z(' CopyRight:'); delay(400);
gotoxy(wx,wy+1); {sliduuchiy radok}
TextColor(LightMagenta); Write(' *-');
TextColor(White); Write('AteyA');
TextColor(LightMagenta); Write('-* ');
Hidecursor; delay(1000); TextColor(Black);
End;
procedure ShowMatrix(G:matrix;z:byte); {z - simvoliv na cifru}
var i,j:byte;
Begin
TextColor(15);
for i:=1 to x do
Begin
for j:=1 to x do begin write(G[i,j]:z); delay(60-2*x) end;
delay(120-4*x); {pauza v kinci radka}
if (x<20) or (limit<100) then {osoblyvist dla x=20} writeln;
end; {for}
End;
{================OSNOVNI-REKURSYVNI-FUNKCII=====================}
{zapovnennja tablyci optymalnyh baliv do kozhnoj tochky matryci
-1 <<znak nezapovnenosti; 0-rjadok i 0-stovpchik - dopomizhni
0 0 0 0 <-b[0,i]
0-1-1-1 <-b[1,i]
0-1-1-1 .......
0-1-1-1 <-b[x,i]
\b[j,0]...*b[x,x]*<<tut bude maximalna kilkist baliv}
function Cherepashka(x,y:byte):longint;
Begin
if b[x,y]=-1 then
if Cherepashka(x-1,y)>cherepashka(x,y-1) then b[x,y]:=Cherepashka(x-1,y)+a[x,y]
else b[x,y]:=Cherepashka(x,y-1)+a[x,y];
Cherepashka:=b[x,y];
End;
{zapovnue signalnu bulivsku matrycu vsima mozhlyvymy shlyahamy}
procedure path(i,j:integer);
Begin
if (i>1) or (j>1) then begin
if B[i-1,j]+A[i,j]=B[i,j] then
begin way[i-1,j]:=true; if i>1 then path(i-1,j) end;
if B[i,j-1]+A[i,j]=B[i,j] then
begin way[i,j-1]:=true; if j>1 then path(i,j-1) end;
End;
End;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
procedure WriteRezult; {pidsumok 4ergovoi sproby}
Begin
gotoxy(12,x+2);
M_Print('Efektyvnist=');
write((sum*100/B[x,x]):0:0,'%. ');
if sum>max then {max - maximum 4erepashky, sum - potochny rezultat}
Begin
max:=sum;
gotoxy(0,x+10); M_Print('Your Maximum='); write(max)
end; {if}
End;
procedure BlinkMatrix_fin; {4pashka ne znajshla shlah, zaraz jj zjidat`}
var i,j:byte;
count:integer; {0..x*x - kilkist "perevernutyh" klitynok}
ver:array[1..dim,1..dim] of boolean; {vidmichae "perevernuti" klitynky}
begin randomize(x*x*x); TextColor(green);
Repeat
i:=1+random(x);j:=1+random(x); {i,j=[1..x] - dovilny element Matryci}
if not ver[i,j] then begin {jaksho ne perevernuta}
gotoxy(2*j,i+1); write(a[i,j]); {napysaly zelenym}
ver[i,j]:=true;Inc(count); delay((x*x-count+3)div 3);
End;
until count=x*x;
End;
procedure BlinkMatrix; {znajdene rishennja, perehid v nastupny vymir}
{postupovo-vypadkove zapovnennja matryci}
var i,j:byte;
count:integer;
ver:array[1..dim,1..dim] of boolean;
begin randomize(x*x*x);
Repeat
i:=1+random(x);j:=1+random(x);
if not ver[i,j] then begin
gotoxy(2*j,i+1);
if (not way[i,j]) then TextColor(green) else TextColor(white); write(a[i,j]);
ver[i,j]:=true; Inc(count);
delay((x*x-count+3)div 3); {balans shvydkosti vid nerivnomirnosti}
end; {if}
until count=x*x;
End;
{----------------------------}
{zadaju mnozhinu kol`oriv}
function color(c:1..15):1..11;
Begin
Case c of
2: color:=15;
6: color:=14;
7: color:=13;
8: color:=12;
10: color:=11
else color:=c
end {case}
End;
{vysvitlenna Elementa Matryci a[i,j] kolorom col z pauzou}
procedure M_Put(i,j:byte;col:1..11;del:byte;c:char);
Begin
gotoxy(2*j,i+1); textcolor(col);write(c);delay(del);
End;
{~~~~~~~Entire Final. Riznokolorova aryfmetyka, 3D-zirok...~~~~~~~}
procedure Neo_Final;
var i,j,i1,j1,col:byte; k,r:longint; key:char;
stars:array[1..dim,1..dim] of boolean;
Begin
{0-0-0, don`t ask me WHAT`s it...}
Date: 2015-12-24; view: 1050
|