home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
02
/
tricks
/
schneefl.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-11-14
|
6KB
|
244 lines
(* ------------------------------------------------------ *)
(* SCHNEEFL.PAS *)
(* (c) 1989 Uwe Peter Schmit & TOOLBOX *)
(* ------------------------------------------------------ *)
PROGRAM Schneeflocke;
USES Crt, Graph;
TYPE
Punkte = RECORD
x, y : INTEGER
END;
Zeiger = ^Ecke;
Ecke = RECORD
Punkt : Punkte;
Next : Zeiger
END;
VAR
Itermax : BYTE;
GraphDriver, GraphMode, i : INTEGER;
Ydif : REAL;
p1, p2, p3 : Punkte;
s : Zeiger;
p : POINTER;
PROCEDURE Init;
VAR
Xasp, Yasp : WORD;
BEGIN
GraphDriver := Detect;
InitGraph(GraphDriver, GraphMode, 'C:\TURBO');
IF GraphResult <> grOk THEN BEGIN
WriteLn('Graphics init error: ',
GraphErrorMsg(GraphDriver));
Halt(1);
END;
SetGraphMode(GraphMode);
GetAspectRatio(Xasp, Yasp);
Ydif := Xasp/Yasp;
END;
PROCEDURE Dreieck;
VAR
h1, h2 : Zeiger;
BEGIN
Mark(p);
New(s);
s^.Punkt := p1;
New(h1);
h1^.Punkt := p3;
s^.Next := h1;
New(h2);
h2^.Punkt := p2;
h1^.Next := h2;
h2^.Next := s;
END;
PROCEDURE Zeichne_Dreieck;
VAR
h : Zeiger;
BEGIN
SetColor(white);
h := s^.Next;
MoveTo(s^.Punkt.x, ROUND(Ydif*s^.Punkt.y));
WHILE h <> s DO BEGIN
LineTo(h^.Punkt.x, ROUND(Ydif*h^.Punkt.y));
h := h^.Next
END;
LineTo(s^.Punkt.x, ROUND(Ydif*s^.Punkt.y));
END;
PROCEDURE Abketten;
BEGIN
Release(p);
END;
PROCEDURE Berechne_P3;
CONST
m = 0.8660254; {0.5 * SQRT(3) / Höhe des Dreiecks}
VAR
h, hs : Punkte;
BEGIN
h.x := p2.x-p1.x; {h-senkrecht: (-h.y, h.x)}
h.y := p2.y-p1.y; {p3 = p1+h+m*h-senkrecht}
p3.x := ROUND(p1.x + 0.5*h.x - m*h.y);
p3.y := ROUND(p1.y + 0.5*h.y + m*h.x)
END;
PROCEDURE Koch;
VAR
h1, h2, e1, e2 : Zeiger;
i, j : SHORTINT;
x, y : INTEGER;
BEGIN
h1 := s;
h2 := h1^.Next;
REPEAT
x := h2^.Punkt.x - h1^.Punkt.x;
y := h2^.Punkt.y - h1^.Punkt.y;
p1.x := ROUND(h1^.Punkt.x + x/3);
p1.y := ROUND(h1^.punkt.y + y/3);
p2.x := ROUND(h2^.punkt.x - x/3);
p2.y := ROUND(h2^.punkt.y - y/3);
SetColor(black);
FOR i := -1 TO 1 DO
FOR j := -1 TO 1 DO BEGIN
MoveTo(p1.x, ROUND(Ydif * p1.y) + i);
LineTo(p2.x, ROUND(Ydif * p2.y) + j);
END; {alte Linie löschen}
Berechne_P3;
SetColor(white);
MoveTo(p1.x, ROUND(Ydif * p1.y)); { neues }
LineTo(p3.x, ROUND(Ydif * p3.y)); { Dreieck }
LineTo(p2.x, ROUND(Ydif * p2.y)); { zeichnen }
New(e1);
e1^.Punkt := p1;
h1^.Next := e1;
New(e2);
e2^.Punkt := p3;
e1^.Next := e2;
New(e1);
e1^.Punkt := p2;
e2^.Next := e1;
e1^.Next := h2;
h1 := h2;
h2 := h1^.Next;
UNTIL h1 = s;
END;
PROCEDURE Schnee_;
VAR
i, j : BYTE;
h1, h2, Pkt1, Pkt2, Mitte : Punkte;
PROCEDURE Berechne_Mitte;
CONST
m1 = 0.8660254; { SQRT(3) / 2 }
m2 = 0.2886751; { SQRT(3) / 6 }
VAR
h, hs : Punkte;
BEGIN
h.x := p2.x-p1.x;
h.y := p2.y-p1.y; {h-senkrecht: (-h.y, h.x)}
p3.x := ROUND(p1.x + h.x/2 - m1*h.y);
p3.y := ROUND(p1.y + h.y/2 + m1*h.x);
Mitte.x := ROUND(p1.x + h.x/2 - m2*h.y);
Mitte.y := ROUND(p1.y + h.y/2 + m2*h.x)
END;
BEGIN
Berechne_Mitte;
Pkt1 := p1;
Pkt2 := p2;
h1.x := Mitte.x - p1.x;
h1.y := Mitte.y - p1.y;
h2.x := Mitte.x - p2.x;
h2.y := Mitte.y - p2.y;
FOR i := 0 TO 9 DO BEGIN
p1.x := ROUND(Pkt1.x + i/10 * h1.x);
p1.y := ROUND(Pkt1.y + i/10 * h1.y);
p2.x := ROUND(Pkt2.x + i/10 * h2.x);
p2.y := ROUND(Pkt2.y + i/10 * h2.y);
Berechne_P3;
Dreieck;
Zeichne_Dreieck;
FOR j := 1 TO IterMax DO Koch;
Abketten;
END;
END;
PROCEDURE Lese_Daten_Ein;
BEGIN
WriteLn(^J^J^J^J);
WriteLn('------------------------------------------',
^J);
Write(' Punkt 1 (X-Koordinate) : ');
ReadLn(p1.x);
Write(' Punkt 1 (Y-Koordinate) : ');
ReadLn(p1.y);
WriteLn;
Write(' Punkt 2 (X-Koordinate) : ');
ReadLn(p2.x);
Write(' Punkt 2 (Y-Koordinate) : ');
ReadLn(p2.y);
Berechne_P3;
WriteLn;
WriteLn(' Punkt 3 (X-Koordinate) : ', p3.x);
WriteLn(' Punkt 3 (Y-Koordinate) : ', p3.y);
Write(^J, ' Iterationen : ');
ReadLn(IterMax)
END;
PROCEDURE Menue;
VAR
ch : CHAR;
PROCEDURE K;
VAR
i : BYTE;
BEGIN
Lese_Daten_Ein;
SetGraphMode(GraphMode);
Dreieck;
Zeichne_Dreieck;
FOR i := 1 TO IterMax DO Koch;
Abketten;
ch := ReadKey
END;
PROCEDURE S;
BEGIN
Lese_Daten_Ein;
SetGraphMode(GraphMode);
Schnee_;
ch := ReadKey
END;
BEGIN
REPEAT RestoreCrtMode;
WriteLn(^J^J^J^J);
WriteLn('------------------------------------------',
^J);
WriteLn(' [K]och''sche Schneeflocke',^J);
WriteLn(' [S]chneeflocke',^J);
WriteLn(' [E]nde',^J);
WriteLn('------------------------------------------',
^J);
REPEAT
ch := UpCase(ReadKey);
UNTIL ch IN ['K', 'S', 'E', #27];
CASE ch OF
'K' : K;
'S' : S;
END;
UNTIL ch IN ['E', #27];
END;
BEGIN Init;
Menue;
CloseGraph;
END.
(* ------------------------------------------------------ *)
(* Ende von SCHNEEF.PAS *)