348 lines
7.7 KiB
Plaintext
348 lines
7.7 KiB
Plaintext
program Visualization;
|
||
|
||
uses Crt, Graph, BGIP;
|
||
|
||
const CompareColor = 14;
|
||
HaveToSwapC = 12;
|
||
MarkDelay = 500;
|
||
Bool_Active = 11;
|
||
Bool_AText = 0;
|
||
Bool_Disabl = 9;
|
||
Bool_DText = 15;
|
||
|
||
var xmax, ymax, xmed, ymed: word;
|
||
xarr: array[1..10] of byte;
|
||
|
||
procedure InitGraphics;
|
||
var grDriver, grMode: integer;
|
||
begin
|
||
grDriver := VGA;
|
||
grMode := VGAHi;
|
||
InitGraph(grDriver, grMode, BGIPath);
|
||
xmax := GetMaxX+1; { Bildschirmbreite in Pixeln }
|
||
ymax := GetMaxY+1; { Bildschirmh”he in Pixeln }
|
||
xmed := xmax DIV 2;
|
||
ymed := ymax DIV 2;
|
||
end;
|
||
|
||
procedure Outit;
|
||
begin
|
||
TextMode(CO80);
|
||
WriteLn('VMode : ',xmax,'x',ymax);
|
||
WriteLn('Center: ',xmed,'x',ymed);
|
||
WriteLn;
|
||
WriteLn('Programm beendet.');
|
||
end;
|
||
|
||
function V2S(x: byte): string;
|
||
var tmp: string;
|
||
begin
|
||
Str(x,tmp);
|
||
V2S := tmp;
|
||
end;
|
||
|
||
procedure SwapVal(var x1,x2: integer);
|
||
var tmp: integer;
|
||
begin
|
||
tmp := x1;
|
||
x1 := x2;
|
||
x2 := tmp;
|
||
end;
|
||
|
||
procedure SwapValB(var x1,x2: byte);
|
||
var tmp: byte;
|
||
begin
|
||
tmp := x1;
|
||
x1 := x2;
|
||
x2 := tmp;
|
||
end;
|
||
|
||
procedure InitArray;
|
||
var i: byte;
|
||
begin
|
||
Randomize;
|
||
for i:=1 to 10 do xarr[i] := Random(256);
|
||
end;
|
||
|
||
procedure MakeBox(el: byte;x,y: integer);
|
||
var tw: word;
|
||
begin
|
||
SetTextJustify(CenterText,CenterText);
|
||
tw := TextWidth(V2S(xarr[el]));
|
||
SetFillStyle(SolidFill,1);
|
||
Bar(x-tw DIV 2-2,y-5,x+tw DIV 2+2,y+5);
|
||
SetColor(11);
|
||
SetLineStyle(SolidLn,0,NormWidth);
|
||
Rectangle(x-tw DIV 2-2,y-5,x+tw DIV 2+2,y+5);
|
||
SetColor(15);
|
||
OutTextXY(x,y+1,V2S(xarr[el]));
|
||
end;
|
||
|
||
procedure ClearBox(el: byte;x,y: integer);
|
||
var tw: word;
|
||
begin
|
||
SetFillStyle(SolidFill,0);
|
||
tw := TextWidth(V2S(xarr[el]));
|
||
Bar(x-tw DIV 2-2,y-5,x+tw DIV 2+2,y+5);
|
||
end;
|
||
|
||
procedure OutArrayPlain(title: string);
|
||
var i: byte;
|
||
begin
|
||
ClearViewPort;
|
||
for i:=1 to 10 do begin
|
||
MakeBox(i,64*i-32,40);
|
||
SetColor(7);
|
||
OutTextXY(64*i-32,30,V2S(i));
|
||
end;
|
||
SetColor(14);
|
||
OutTextXY(320,15,title);
|
||
end;
|
||
|
||
procedure Mark(el,col: byte);
|
||
var tw: word;
|
||
x : integer;
|
||
begin
|
||
tw := TextWidth(V2S(xarr[el]));
|
||
x := 64*el-32;
|
||
SetColor(col);
|
||
SetLineStyle(SolidLn,0,ThickWidth);
|
||
Line(x-tw DIV 2-2,48,x+tw DIV 2+2,48);
|
||
end;
|
||
|
||
procedure Connect(el1,el2,col,depth: byte);
|
||
var x: integer;
|
||
begin
|
||
SetColor(col);
|
||
Mark(el1,col);
|
||
Mark(el2,col);
|
||
x := 64*el1-32;
|
||
MoveTo(x,49);
|
||
SetLineStyle(SolidLn,0,NormWidth);
|
||
LineTo(x,49+depth*20);
|
||
x := 64*el2-32;
|
||
LineTo(x,49+depth*20);
|
||
LineTo(x,49);
|
||
end;
|
||
|
||
procedure ClearConns;
|
||
begin
|
||
SetFillStyle(SolidFill,0);
|
||
Bar(5,47,635,149);
|
||
end;
|
||
|
||
procedure Swap(el1,el2: byte);
|
||
var i: integer;
|
||
x1,x2: integer;
|
||
lo,hi: integer;
|
||
m1,m2: integer;
|
||
SwapDelay: integer;
|
||
begin
|
||
if (el1=el2) then Exit;
|
||
x1 := 64*el1-32;
|
||
x2 := 64*el2-32;
|
||
if (x2<x1) then begin
|
||
SwapVal(x1,x2);
|
||
SwapValB(el1,el2);
|
||
end;
|
||
SwapDelay := 1000 DIV (x2-x1);
|
||
for i:=40 to 80 do begin
|
||
ClearBox(el1,x1,i);
|
||
MakeBox(el1,x1,i+1);
|
||
ClearBox(el2,x2,i);
|
||
MakeBox(el2,x2,i+1);
|
||
Delay(SwapDelay);
|
||
end;
|
||
|
||
for i:=x1 to x2-1 do begin
|
||
m1 := i;
|
||
m2 := x1+x2-i;
|
||
ClearBox(el1,m1,81);
|
||
MakeBox(el1,m1+1,81);
|
||
ClearBox(el1,m2,81);
|
||
MakeBox(el2,m2-1,81);
|
||
Delay(SwapDelay);
|
||
end;
|
||
|
||
for i:=80 downto 40 do begin
|
||
ClearBox(el2,x1,i+1);
|
||
MakeBox(el2,x1,i);
|
||
ClearBox(el1,x2,i+1);
|
||
MakeBox(el1,x2,i);
|
||
Delay(SwapDelay);
|
||
end;
|
||
SwapValB(xarr[el1],xarr[el2]);
|
||
end;
|
||
|
||
procedure ShowValue(desc: string;val: integer;el,col,depth: byte);
|
||
var OT: string;
|
||
begin
|
||
SetFillStyle(SolidFill,0);
|
||
Bar(0,320+depth*10-5,640,320+depth*10+5);
|
||
SetColor(col);
|
||
SetTextJustify(LeftText,CenterText);
|
||
OT := desc+': '+V2S(val);
|
||
OutTextXY(5,320+depth*10,OT);
|
||
if (el<>0) then begin
|
||
Mark(el,10);
|
||
SetLineStyle(SolidLn,0,NormWidth);
|
||
MoveTo(64*el-32,49);
|
||
LineTo(64*el-32,320+depth*10);
|
||
LineTo(TextWidth(OT)+10,320+depth*10);
|
||
Delay(MarkDelay);
|
||
SetColor(0);
|
||
MoveTo(64*el-32,49);
|
||
LineTo(64*el-32,320+depth*10);
|
||
LineTo(TextWidth(OT)+10,320+depth*10);
|
||
SetColor(CompareColor);
|
||
MoveTo(64*el-32,49);
|
||
LineTo(64*el-32,69);
|
||
Mark(el,CompareColor);
|
||
end;
|
||
end;
|
||
|
||
procedure Bool(text1,text2: string;what: boolean;depth: byte);
|
||
var OT: string;
|
||
begin
|
||
SetTextJustify(CenterText,CenterText);
|
||
if (what) then begin
|
||
SetFillStyle(SolidFill,Bool_Active);
|
||
SetColor(Bool_AText);
|
||
OT := text1;
|
||
end else begin
|
||
SetFillStyle(SolidFill,Bool_Disabl);
|
||
SetColor(Bool_DText);
|
||
OT := text2;
|
||
end;
|
||
Bar(320,240+(depth-1)*20,639,240+(depth)*20);
|
||
OutTextXY(480,240+(depth)*20-10,OT);
|
||
end;
|
||
|
||
{###########################################################################
|
||
###########################################################################
|
||
##################### SORTIER ALGORITHMEN #################################
|
||
###########################################################################
|
||
###########################################################################}
|
||
|
||
procedure Sort_Simple;
|
||
var i,j: integer;
|
||
begin
|
||
for i:=1 to 9 do
|
||
for j:=i+1 to 10 do begin
|
||
Connect(i,j,CompareColor,1);
|
||
Delay(MarkDelay);
|
||
if xarr[j]<xarr[i] then begin
|
||
Connect(i,j,HaveToSwapC,1);
|
||
Delay(MarkDelay);
|
||
ClearConns;
|
||
Swap(i,j);
|
||
end;
|
||
ClearConns;
|
||
end;
|
||
end;
|
||
|
||
procedure Sort_Selectionsort;
|
||
var i,j,minpos: integer;
|
||
begin
|
||
for i:=1 to 9 do begin
|
||
minpos := i;
|
||
ShowValue('minpos',minpos,0,15,1);
|
||
for j:=i+1 to 10 do begin
|
||
Connect(i,j,CompareColor,1);
|
||
Delay(MarkDelay);
|
||
if xarr[j]<xarr[minpos] then begin
|
||
minpos:=j;
|
||
ShowValue('minpos',minpos,j,10,1);
|
||
Delay(MarkDelay);
|
||
end;
|
||
ClearConns;
|
||
end;
|
||
if (i<>minpos) then begin
|
||
Connect(i,minpos,HaveToSwapC,1);
|
||
Delay(MarkDelay);
|
||
ClearConns;
|
||
end;
|
||
Swap(i,minpos);
|
||
end;
|
||
end;
|
||
|
||
procedure Sort_Bubblesort;
|
||
var i: integer;
|
||
canswap: boolean;
|
||
begin
|
||
repeat
|
||
canswap:=false;
|
||
Bool('Konnte was tauschen','Konnte (noch) nichts tauschen',canswap,1);
|
||
for i:=1 to 9 do begin
|
||
Connect(i,i+1,CompareColor,1);
|
||
Delay(MarkDelay);
|
||
if xarr[i]>xarr[i+1] then begin
|
||
Connect(i,i+1,HaveToSwapC,1);
|
||
Delay(MarkDelay);
|
||
ClearConns;
|
||
Bool('TAUSCHE','',true,1);
|
||
Swap(i,i+1);
|
||
canswap := true;
|
||
end;
|
||
Bool('Konnte was tauschen','Konnte (noch) nichts tauschen',canswap,1);
|
||
ClearConns;
|
||
end;
|
||
until (NOT canswap);
|
||
end;
|
||
|
||
|
||
|
||
|
||
|
||
|
||
{###########################################################################
|
||
###########################################################################
|
||
######################### DER LETZTE REST #################################
|
||
###########################################################################
|
||
###########################################################################}
|
||
|
||
procedure WaitForKey;
|
||
var x: byte;
|
||
begin
|
||
repeat
|
||
x := Random(16);
|
||
SetColor(x);
|
||
SetTextJustify(CenterText,CenterText);
|
||
OutTextXY(320,240,'SORTIERUNG ABGESCHLOSSEN - bitte eine Taste dr<64>cken');
|
||
Delay(1);
|
||
until keypressed;
|
||
ReadKey;
|
||
end;
|
||
|
||
procedure Simplest_DEMO;
|
||
begin
|
||
InitArray;
|
||
OutArrayPlain('einfachste Sortierung');
|
||
Sort_Simple;
|
||
WaitForKey;
|
||
end;
|
||
|
||
procedure Selection_DEMO;
|
||
begin
|
||
InitArray;
|
||
OutArrayPlain('Selectionsort');
|
||
Sort_Selectionsort;
|
||
WaitForKey;
|
||
end;
|
||
|
||
procedure Bubble_DEMO;
|
||
begin
|
||
InitArray;
|
||
OutArrayPlain('Bubblesort');
|
||
Sort_Bubblesort;
|
||
WaitForKey;
|
||
end;
|
||
|
||
begin
|
||
InitGraphics;
|
||
{ Simplest_DEMO; }
|
||
Selection_DEMO;
|
||
Bubble_DEMO;
|
||
Outit;
|
||
end.
|