home *** CD-ROM | disk | FTP | other *** search
- (*
- __________________________________________________________________________
-
- :Program. HyperKubus.mod
- :Contents. Zeigt einen vierdimensionalen Würfel, der mit der
- :Contents. Maus in allen vier Dimensionen rotiert werden kann.
- :Contents. Schwarz-weiß oder anaglyph (mit Rot-Grün-Brille).
- :Author. Franz Dimbeck
- :Address. Troppauerstraße 48, D-8058 Erding.
- :Phone. 08122 18135
- :Copyright. Public Domain
- :Language. Modula-2
- :Translator. M2-Amiga V3.3d
- :History. V1.0 16-Apr-90
- :Support. Nach einem Artikel von Alexander Keewatin Dewdney
- :Support. in Spektrum der Wissenschaft, Computer-Kurzweil 1987.
- :Remark. Wer sich zu lange mit dem Programm beschäftigt,
- :Remark. verschwindet in der vierten Dimension.
-
- ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
- *)
-
- MODULE HyperKubus; (* $R- $V- $S- $F- $L- *)
-
-
- FROM Arts IMPORT AllLevelTermProc,Assert;
-
- FROM GfxMacros IMPORT SetWrMsk;
-
- FROM Graphics IMPORT Draw,Move,RastPortPtr,RectFill,SetAPen,SetRGB4,
- Text,ViewModeSet,ViewPortPtr;
-
- FROM Intuition IMPORT CloseScreen,CloseWindow,customScreen,
- IDCMPFlagSet,NewScreen,NewWindow,OpenScreen,
- OpenWindow,ScreenPtr,ScreenToFront,ShowTitle,
- WindowFlags,WindowFlagSet,WindowPtr;
-
- FROM MathLibFFP IMPORT sin,cos,pi;
-
- FROM SYSTEM IMPORT ADR ,FFP;
-
- CONST
- EckZ = 15; (* Der HyperKubus hat 16 Ecken [0..15] *)
- Licht = 300.0; (* Abstand in Z-Richtung des
- Brennpunkts für Zentralprojektion *)
- Winkel = 3; (* Unter diesem Winkel (in Grad) treffen sich die
- Sehstrahlen der Augen auf dem HyperKubus - für
- die anaglyphe Darstellung *)
- TYPE
- Hyper = ARRAY [0..15] OF ARRAY [0..3] OF FFP;
- (* Enthält die 4 Koordinaten der 16 Eckpunkte *)
-
- Vmod = (mono,anaglyph3D,anaglyph4D);
- (* Darstellungsarten *)
- VAR
- Ecke,
- Temp :Hyper;
- Darstellung :Vmod;
- Punkte :ARRAY [0..15] OF ARRAY[0..1] OF INTEGER;
- Pfad :ARRAY[0..32] OF INTEGER;
- i,j,xo,yo,
- Wahl,AWahl,
- xa,xt,ya :LONGINT;
- Sn :[0..1];
- NewWin :ARRAY [0..1] OF NewWindow;
- NewScr :ARRAY [0..1] OF NewScreen;
- MyWindow :ARRAY [0..1] OF WindowPtr;
- MyScreen :ARRAY [0..1] OF ScreenPtr;
- MyRast :ARRAY [0..1] OF RastPortPtr;
- MyView :ARRAY [0..1] OF ViewPortPtr;
- ok,auto,
- quit,neg :BOOLEAN;
- Taste :CHAR;
- Txt,ATxt :ARRAY [0..5] OF ARRAY [0..5] OF CHAR;
- Ciapra [0BFE001H]: SET OF (s0,s1,s2,s3,s4,s5,lmb); (* für Mausknopf *)
-
-
-
- PROCEDURE MyScreenWindow;
- (* zwei Screens für double-buffering *)
- VAR i :[0..1] ;
- BEGIN
- FOR i := 0 TO 1 DO;
- MyScreen[i] := NIL;
- WITH NewScr[i] DO
- width :=320;
- leftEdge :=0;
- topEdge :=0;
- height :=256;
- depth :=2;
- detailPen :=0;
- blockPen :=0;
- viewModes :=ViewModeSet{};
- type :=customScreen;
- font :=NIL;
- defaultTitle :=NIL;
- gadgets :=NIL;
- customBitMap :=NIL;
- END;
- MyScreen[i] := OpenScreen(NewScr[i]);
- Assert(MyScreen[i]<>NIL,ADR("Konnte Plot3-Screen nicht öffnen"));
- ShowTitle(MyScreen[i],FALSE);
- MyView[i] := ADR(MyScreen[i]^.viewPort);
- SetRGB4(MyView[i],0,0,0,0);
- SetRGB4(MyView[i],1,0,15,15);
- SetRGB4(MyView[i],2,15,0,15);
- SetRGB4(MyView[i],3,0,0,0);
- MyWindow[i] := NIL;
- WITH NewWin[i] DO
- leftEdge :=0;
- topEdge :=0;
- width :=320;
- height :=256;
- detailPen :=0;
- blockPen :=0;
- idcmpFlags :=IDCMPFlagSet{};
- flags :=WindowFlagSet {backDrop,
- borderless,
- activate,
- noCareRefresh};
- title :=NIL;
- type :=customScreen;
- firstGadget :=NIL;
- checkMark :=NIL;
- screen :=MyScreen[i];
- bitMap :=NIL;
- END;
- MyWindow[i] := OpenWindow(NewWin[i]);
- Assert(MyWindow[i]<>NIL,ADR("konnte Fenster nicht öffnen"));
- MyRast[i] := MyWindow[i]^.rPort;
- SetAPen(MyRast[i],3);
- END;
- END MyScreenWindow;
-
- PROCEDURE Cleanup;
- VAR i :[0..1];
- BEGIN
- FOR i := 0 TO 1 DO
- IF MyWindow[i]#NIL THEN
- CloseWindow(MyWindow[i]);
- END;
- IF MyScreen[i]#NIL THEN
- CloseScreen(MyScreen[i]);
- END;
- END;
- END Cleanup;
-
- PROCEDURE InitPfad;
- (* Reihenfolge der Ecken zum Zeichnen der Kanten *)
- BEGIN
- Pfad[0] := 0; Pfad[1] := 1; Pfad[2] := 3; Pfad[3] := 2;
- Pfad[4] := 6; Pfad[5] := 14; Pfad[6] := 10; Pfad[7] := 8;
- Pfad[8] := 9; Pfad[9] := 11; Pfad[10] := 3; Pfad[11] := 7;
- Pfad[12] := 15; Pfad[13] := 14; Pfad[14] := 12; Pfad[15] := 13;
- Pfad[16] := 9; Pfad[17] := 1; Pfad[18] := 5; Pfad[19] := 7;
- Pfad[20] := 6; Pfad[21] := 4; Pfad[22] := 12; Pfad[23] := 8;
- Pfad[24] := 0; Pfad[25] := 4; Pfad[26] := 5; Pfad[27] := 13;
- Pfad[28] := 15; Pfad[29] := 11; Pfad[30] := 10; Pfad[31] := 2;
- Pfad[32] := 0;
- END InitPfad;
-
- PROCEDURE InitEcke;
- (* Initialiseren der Koordinaten des nicht gedrehten HyperKubus *)
- VAR
- i,x,y,z,w :INTEGER;
- BEGIN
- i := -1;
- FOR x := 0 TO 1 DO
- FOR y := 0 TO 1 DO
- FOR z := 0 TO 1 DO
- FOR w := 0 TO 1 DO;
- INC(i);
- Ecke[i,0] := FFP(w*100-50);
- Ecke[i,1] := FFP(z*100-50);
- Ecke[i,2] := FFP(y*100-50);
- Ecke[i,3] := FFP(x*100-50);
- END;
- END;
- END;
- END;
- END InitEcke;
-
-
- (* R O T A T I O N:
- ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
- Die folgenden sechs Prozeduren drehen den HyperKubus in den
- sechs möglichen Richtungen. Im vierdimensionalen Raum kann eine
- Drehung nicht durch eine Drehachse angegeben werden, da es ja
- zu jeder Ebene zwei verschiedene Richtungen gibt, die auf ihr
- senkrecht stehen. Es muß daher die Drehebene angegeben werden.
- Die Prozedur "Rot12" rotiert den HyperKubus also in der Ebene,
- die von den Koordinatenachsen 1 und 2 gebildet werden, d.h. in
- der x/y-Ebene.
- "d" gibt den Rotationswinkel in Grad an,
- "alt" ist die Matrix mit den zu rotierende Koordinaten
- das Ergebnis wird in der Matrix Temp abgespeichert.
- *)
-
- PROCEDURE Rot12( d:INTEGER; VAR alt :Hyper);
- VAR
- a1,a2,s,c,w:FFP;
- i :INTEGER;
- BEGIN
- w := FFP(d)/180.0*pi;
- s := sin(w);
- c := cos(w);
- FOR i := 0 TO 15 DO
- Temp[i,2] := alt[i,2];
- Temp[i,3] := alt[i,2];
- a1 := alt[i,0];
- a2 := alt[i,1];
- Temp[i,0] := a1*c - a2*s;
- Temp[i,1] := a1*s + a2*c;
- END;
- END Rot12;
-
- PROCEDURE Rot13( d:INTEGER; VAR alt:Hyper);
- VAR
- a1,a3,s,c,w:FFP;
- i :INTEGER;
- BEGIN
- w := FFP(d)/180.0*pi;
- s := sin(w);
- c := cos(w);
- FOR i := 0 TO 15 DO
- Temp[i,1] := alt[i,1];
- Temp[i,3] := alt[i,3];
- a1 := alt[i,0];
- a3 := alt[i,2];
- Temp[i,0] := a1*c - a3*s;
- Temp[i,2] := a1*s + a3*c;
- END;
- END Rot13;
-
- PROCEDURE Rot23( d:INTEGER; VAR alt:Hyper);
- VAR
- a2,a3,s,c,w:FFP;
- i :INTEGER;
- BEGIN
- w := FFP(d)/180.0*pi;
- s := sin(w);
- c := cos(w);
- FOR i := 0 TO 15 DO
- Temp[i,0] := alt[i,0];
- Temp[i,3] := alt[i,3];
- a2 := alt[i,1];
- a3 := alt[i,2];
- Temp[i,1] := a2*c - a3*s;
- Temp[i,2] := a2*s + a3*c;
- END;
- END Rot23;
-
- PROCEDURE Rot14( d:INTEGER; VAR alt:Hyper);
- VAR
- a1,a4,s,c,w:FFP;
- i :INTEGER;
- BEGIN
- w := FFP(d)/180.0*pi;
- s := sin(w);
- c := cos(w);
- FOR i := 0 TO 15 DO
- Temp[i,1] := alt[i,1];
- Temp[i,2] := alt[i,2];
- a1 := alt[i,0];
- a4 := alt[i,3];
- Temp[i,0] := a1*c - a4*s;
- Temp[i,3] := a1*s + a4*c;
- END;
- END Rot14;
-
- PROCEDURE Rot24( d:INTEGER; VAR alt:Hyper);
- VAR
- a2,a4,s,c,w:FFP;
- i :INTEGER;
- BEGIN
- w := FFP(d)/180.0*pi;
- s := sin(w);
- c := cos(w);
- FOR i := 0 TO 15 DO
- Temp[i,0] := alt[i,0];
- Temp[i,2] := alt[i,2];
- a2 := alt[i,1];
- a4 := alt[i,3];
- Temp[i,1] := a2*c - a4*s;
- Temp[i,3] := a2*s + a4*c;
- END;
- END Rot24;
-
- PROCEDURE Rot34( d:INTEGER; VAR alt:Hyper);
- VAR
- a3,a4,s,c,w:FFP;
- i :INTEGER;
- BEGIN
- w := FFP(d)/180.0*pi;
- s := sin(w);
- c := cos(w);
- FOR i := 0 TO 15 DO
- Temp[i,0] := alt[i,0];
- Temp[i,1] := alt[i,1];
- a3 := alt[i,2];
- a4 := alt[i,3];
- Temp[i,2] := a3*c - a4*s;
- Temp[i,3] := a3*s + a4*c;
- END;
-
- END Rot34;
- (*------------- Ende der Rotationsprozeduren --------------------*)
-
-
- (* Die Prozedur "Calc" berechnet die Zentralprojektion in z-Richtung.
- Das Ergebnis wird in der Matrix "Punkte" abgelegt.
- *)
- PROCEDURE Calc;
- VAR
- i : INTEGER;
- BEGIN
- FOR i := 0 TO 15 DO;
- Punkte[i,0] := 160+INTEGER((Temp[i,0]*Licht)/(Licht-Temp[i,2]));
- Punkte[i,1] := 105+INTEGER((Temp[i,1]*Licht)/(Licht-Temp[i,2]));
- END;
- END Calc;
-
- PROCEDURE Zeichne;
- VAR
- i : INTEGER;
- R : [0..1];
- BEGIN
- R := 1-Sn;
- SetAPen (MyRast[R],0);
- RectFill(MyRast[R],41,0,279,213);
- SetAPen (MyRast[R],3);
- IF Darstellung#mono THEN
- SetWrMsk(MyRast[1-Sn],1);
- END;
- Calc;
- Move(MyRast[R],Punkte[0,0],Punkte[0,1]);
- FOR i := 1 TO 32 DO;
- Draw(MyRast[R],Punkte[Pfad[i],0],Punkte[Pfad[i],1]);
- END;
- IF (Darstellung#mono) THEN
- SetWrMsk(MyRast[1-Sn],2);
- IF (Darstellung=anaglyph3D) THEN
- Rot13(Winkel,Temp);
- ELSE (* Darstellung=anaglyph4D *)
- Rot14(Winkel,Temp);
- END;
- Calc;
- Move(MyRast[R],Punkte[0,0],Punkte[0,1]);
- FOR i := 1 TO 32 DO;
- Draw(MyRast[R],Punkte[Pfad[i],0],Punkte[Pfad[i],1]);
- END;
- END;
- SetWrMsk(MyRast[1-Sn],3);
- END Zeichne;
-
- PROCEDURE Kasten (h,v : INTEGER; an:BOOLEAN);
- VAR R : [0..1];
- BEGIN
- v := v*20;
- FOR R := 0 TO 1 DO;
- SetWrMsk(MyRast[R],3);
- IF an THEN
- SetAPen(MyRast[R],3);
- ELSE
- SetAPen(MyRast[R],0);
- END;
- Move(MyRast[R],h*53+3,217+v);
- Draw(MyRast[R],h*53+50,217+v);Draw(MyRast[R],h*53+50,233+v);
- Draw(MyRast[R],h*53+3,233+v);Draw(MyRast[R],h*53+3,217+v);
- Move(MyRast[R],h*53+4,218+v);
- Draw(MyRast[R],h*53+49,218+v);Draw(MyRast[R],h*53+49,232+v);
- Draw(MyRast[R],h*53+4,232+v);Draw(MyRast[R],h*53+4,218+v);
- END;
- END Kasten;
-
- PROCEDURE Auswahl;
- VAR
- R : [0..1];
- Select : INTEGER;
- BEGIN
- Select := xo/53;
- IF (Select>5) THEN Select := 5 END;
- IF yo > 235 THEN
- i := -2; j := -3;
- Wahl := Select;
- Kasten(AWahl,1,FALSE);
- Kasten(Wahl,1,TRUE);
- AWahl := Wahl;
- ELSE
- CASE Select OF
- | 0..2 :Kasten(ORD(Darstellung),0,FALSE);
- Kasten(Select,0,TRUE);
- Darstellung := VAL(Vmod,Select);
- | 3 :neg := NOT neg;
- Kasten(3,0,neg);
- FOR R := 0 TO 1 DO
- IF neg THEN
- SetRGB4(MyView[R],0,0,0,0);
- SetRGB4(MyView[R],1,15,0,0);
- SetRGB4(MyView[R],2,0,15,0);
- SetRGB4(MyView[R],3,15,15,0);
- ELSE
- SetRGB4(MyView[R],0,15,15,15);
- SetRGB4(MyView[R],1,0,15,15);
- SetRGB4(MyView[R],2,15,0,15);
- SetRGB4(MyView[R],3,0,0,5);
- END;
- END;
- | 4 :auto := NOT auto;
- Kasten(4,0,auto);
- | 5 :quit := TRUE;
- Kasten(5,0,quit);
- END; (* CASE Select OF *)
- END; (* IF yo > 235 THEN ELSE *)
- WHILE NOT(lmb IN Ciapra) DO ; END;
- END Auswahl;
-
- PROCEDURE Titel;
- BEGIN
- SetAPen(MyRast[1],3);
- RectFill(MyRast[1],41,8,273,82);
- SetAPen(MyRast[1],0);
- RectFill(MyRast[1],43,10,271,80);
- Move(MyRast[1],80,38);
- SetAPen(MyRast[1],3);
- Text(MyRast[1],ADR("H Y P E R K U B U S"),19);
- Move(MyRast[1],48,62);
- Text(MyRast[1],ADR("Ein Würfel in 4 Dimensionen"),27);
- Move(MyRast[1],56,120);
- Text(MyRast[1],ADR("Mausbewegungen drehen den"),25);
- Move(MyRast[1],80,130);
- Text(MyRast[1],ADR("Würfel im 3-D Raum."),19);
- Move(MyRast[1],48,150);
- Text(MyRast[1],ADR("Die linke Maustaste rotiert"),27);
- Move(MyRast[1],68,160);
- Text(MyRast[1],ADR("den Würfel auch in die"),22);
- Move(MyRast[1],88,170);
- Text(MyRast[1],ADR("vierte Dimension."),17);
- SetRGB4(MyView[0],0,15,15,15);
- SetRGB4(MyView[1],0,15,15,15);
- END Titel;
-
- PROCEDURE Init;
- BEGIN
- MyScreenWindow;
- AllLevelTermProc(Cleanup);
- InitPfad;
- InitEcke;
- Titel;
- Sn := 0;
- Txt[0] := "ROT14";Txt[1] := "ROT24";Txt[2] := "ROT34";
- Txt[3] := "14R24";Txt[4] := "14R34";Txt[5] := "24R34";
- ATxt[0] := " 2-D ";ATxt[1] := " 3-D ";ATxt[2] := " 4-D ";
- ATxt[3] := " NEG ";ATxt[4] := "AUTO ";ATxt[5] := "QUIT!";
- FOR i := 0 TO 1 DO
- SetAPen(MyRast[i],3);
- Move(MyRast[i],0,215);
- Draw(MyRast[i],319,215);Draw(MyRast[i],319,255);
- Draw(MyRast[i],0,255);Draw(MyRast[i],0,215);
- Move(MyRast[i],0,235);Draw(MyRast[i],319,235);
- FOR j := 0 TO 5 DO
- Move(MyRast[i],j*53,215);Draw(MyRast[i],j*53,255);
- Move(MyRast[i],j*53+7,248);Text(MyRast[i],ADR(Txt[j]),5);
- Move(MyRast[i],j*53+7,228);Text(MyRast[i],ADR(ATxt[j]),5);
- END;
- END;
- Sn := 0;
- auto := FALSE; neg := FALSE;
- xo := 120 ; yo := 240; Auswahl;
- xo := 60; yo := 230; Auswahl;
- i := 0; j := 0; xt := 0;
- xo := MyWindow[Sn]^.mouseX; yo := MyWindow[Sn]^.mouseY;
- END Init;
-
-
- BEGIN (* Hauptprogramm *)
- Init;
- WHILE NOT quit DO
- IF ((xo#MyWindow[Sn]^.mouseX)
- OR (yo#MyWindow[Sn]^.mouseY))
- OR NOT(lmb IN Ciapra)
- OR auto THEN
- ScreenToFront(MyScreen[Sn]);
- xo := MyWindow[Sn]^.mouseX;
- yo := MyWindow[Sn]^.mouseY;
- IF (auto OR (NOT (lmb IN Ciapra))) THEN
- IF (yo>215) AND NOT(lmb IN Ciapra) THEN
- Auswahl;
- END;
- INC(i,2); INC(j,3);
- i := i MOD 360; j := j MOD 360;
- END;
- ya := yo;
- IF yo>214 THEN
- ya := 214; xa := xt;
- ELSE
- xa := xo; xt := xo;
- END;
- ya := ya*360/214; xa :=xa*360/320;
- Rot23(ya,Ecke); (* Rotation um die x-Achse, 4.Dimens unveränd.*)
- CASE Wahl OF
- | 0 : Rot14(j,Temp); (* Rotationen *)
- | 1 : Rot24(j,Temp); (* mit *)
- | 2 : Rot34(j,Temp); (* Veränderung *)
- | 3 : Rot14(j,Temp);Rot24(i,Temp); (* der *)
- | 4 : Rot14(j,Temp);Rot34(i,Temp); (* vierten *)
- | 5 : Rot24(j,Temp);Rot34(i,Temp); (* Dimension *)
- END;
- Rot13(xa,Temp); (* Rotation um die y-Achse, 4.Dimens unveränd.*)
- Zeichne;
- Sn := 1-Sn;
- END; (* IF *)
- END; (* WHILE NOT quit *)
-
-
- (* End-Sequenz *)
- FOR i := 0 TO 33 DO
- ScreenToFront(MyScreen[Sn]);
- FOR j := 0 TO 15 DO
- FOR xo := 0 TO 3 DO
- Temp[j,xo] :=Temp[j,xo]*0.9;
- END;
- END;
- Rot13(4,Temp);
- Rot23(3,Temp);
- Rot34(4,Temp);
- Zeichne;
- Sn := 1-Sn;
- END;
- END HyperKubus.
-
-
-