home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fish 'n' More 2
/
fishmore-publicdomainlibraryvol.ii1991xetec.iso
/
dirs
/
oberon_380.lzh
/
Oberon
/
Demos
/
Cube.mod
< prev
next >
Wrap
Text File
|
1990-10-11
|
7KB
|
320 lines
(*---------------------------------------------------------------------------
Kleines 3D-Demo
An einem Sonntag Vor(!)mittag geschrieben.
(Es ist doch etwas aus meiner 3D-Grafik-Zeit hängengeblieben)
--- Fridtjof.
:Program. Cube
:Contents. Kleines 3D-Demo
:Version. V1.0, Dezember 89, Fridtjof Siebert
:Version. V1.1, Juni 90, Fridtjof Siebert, Now uses Array-Constants
:Author. Fridtjof Siebert
:Address. Nobileweg 67, D-7000 Suttgart 40
:CopyRight. PD
:Language. OBERON
:Compiler. AMOK OBORON Compiler, V0.2 beta
---------------------------------------------------------------------------*)
MODULE Cube;
(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
IMPORT g: Graphics,
I: Intuition,
e: Exec,
sys:SYSTEM;
CONST
PointCnt = 8;
LineCnt = 12;
Auge = 200;
TYPE
Point = ARRAY 3 OF LONGINT; (* x, y und z Koordinate *)
Point2D= STRUCT x,y: INTEGER; (* Koordinaten auf Bildschirm *)
in: BOOLEAN; (* innerhalb des Schirms? *)
dummy: INTEGER; (* nur, damit size=2^3 (speed)*)
END;
SPoint = ARRAY 3 OF INTEGER;
Line = ARRAY 2 OF INTEGER; (* Start- und Endpunkt *)
Matrix = ARRAY 3, 3 OF LONGINT; (* Abbildematrix (Festpunktintegers) *)
PArray = ARRAY PointCnt OF Point;
SPArray = ARRAY PointCnt OF SPoint;
LArray = ARRAY LineCnt OF Line;
FourMatrices = ARRAY 4 OF Matrix;
VAR
CurMat: Matrix;
Points: PArray;
AbbPoints: ARRAY PointCnt OF Point2D; (* Abgebildete Punkte *)
count, c2: INTEGER; (* Zählt Abbildungen *)
ns: I.NewScreen;
nw: I.NewWindow;
screen: I.ScreenPtr;
window: I.WindowPtr;
rp1,rp2: g.RastPortPtr;
Width : INTEGER;
Height : INTEGER;
MitteX : INTEGER;
MitteY : INTEGER;
BitMap: ARRAY 3 OF g.BitMap; (* 3-Fach gepuffert (Troublebuffering) *)
bmsize: LONGINT; (* bm.bytesPerRow*bm.rows *)
troubleBuf: INTEGER; (* aktive BitMap *)
AugeX: INTEGER; (* Augenposition *)
AugeY: INTEGER;
CONST
SPoints = SPArray( -70,-70,-70, 70,-70,-70,
70, 70,-70, -70, 70,-70,
-70,-70, 70, 70,-70, 70,
70, 70, 70, -70, 70, 70);
Lines = LArray(0,1, 1,2, 2,3, 3,0,
4,5, 5,6, 6,7, 7,4,
0,4, 1,5, 2,6, 3,7);
mats = FourMatrices(7FFFH, 0, 0, (* Einheitsmatrix *)
0,7FFFH, 0,
0, 0,7FFFH,
32642, 0, 2856, (* Drehung um Y (5°) *)
0,7FFFH, 0,
-2856, 0,32642,
32642, 2856, 0, (* Drehung um Z (5°) *)
-2856,32642, 0,
0, 0,7FFFH,
7FFFH, 0, 0, (* Drehung um X (5°) *)
0,32642, 2856,
0,-2856,32642);
(*-------------------------------------------------------------------------*)
PROCEDURE MulVecMat(VAR E,V: Point; VAR M: Matrix);
(* E := V * M *)
VAR
i: INTEGER;
BEGIN
i := 0;
REPEAT
E[i] := ASH( M[i,0]*V[0] + M[i,1]*V[1] + M[i,2]*V[2], -15);
INC(i);
UNTIL i=3;
END MulVecMat;
PROCEDURE MulMat(VAR M0,M1: Matrix);
(* M0 := M0 * M1 *)
VAR
i,j: INTEGER;
M,N: Matrix;
BEGIN
M := M1; N := M0; i := 0;
REPEAT
j := 0;
REPEAT
M0[i,j] := ASH( M[0,j]*N[i,0] + M[1,j]*N[i,1] + M[2,j]*N[i,2] ,-15);
INC(j);
UNTIL j=3;
INC(i);
UNTIL i=3;
END MulMat;
(*-------------------------------------------------------------------------*)
PROCEDURE Abbilden;
VAR
c: INTEGER;
a: Point2D;
AbbPnt: Point;
PROCEDURE GetAuge(c,mc: INTEGER): INTEGER;
VAR Auge: INTEGER;
BEGIN
Auge := c-mc;
IF Auge<-mc THEN RETURN -mc
ELSIF Auge> mc THEN RETURN mc
ELSE RETURN Auge END;
END GetAuge;
BEGIN
AugeX := GetAuge(screen.mouseX,MitteX);
AugeY := GetAuge(screen.mouseY,MitteY);
c := 0;
WHILE c<PointCnt DO
MulVecMat(AbbPnt,Points[c],CurMat);
a.x := SHORT(Auge*(AbbPnt[0]-AugeX) DIV (Auge - AbbPnt[2])) + MitteX + AugeX;
a.y := SHORT(Auge*(AbbPnt[1]-AugeY) DIV (Auge - AbbPnt[2])) + MitteY + AugeY;
a.in := (a.x>=0) AND (a.x<Width) AND (a.y>=0) AND (a.y<Height);
AbbPoints[c] := a;
INC(c);
END;
END Abbilden;
PROCEDURE Zeichnen;
VAR
c,i: INTEGER;
a,b: Point2D;
rp: g.RastPortPtr;
BEGIN
screen.viewPort.rasInfo.bitMap := sys.ADR(BitMap[troubleBuf]);
INC(troubleBuf); IF troubleBuf=3 THEN troubleBuf := 0 END;
rp1.bitMap := sys.ADR(BitMap[troubleBuf]);
rp2.bitMap := sys.ADR(BitMap[troubleBuf]);
I.MakeScreen(screen);
(* Achtung: Graphics.MrgCop() stürzt, wenn es von verschiedenen Tasks
gleichzeitig gerufen wird. Deshalb mach ich das so: *)
e.Forbid();
g.MrgCop(I.ViewAddress());
e.Permit();
g.SetAPen(rp1,0);
g.RectFill(rp1,0,0,Width-1,Height-1);
g.SetAPen(rp1,1);
g.SetAPen(rp2,1);
c := 0;
WHILE c<LineCnt DO
a := AbbPoints[Lines[c,0]];
b := AbbPoints[Lines[c,1]];
rp := rp2;
IF a.in AND b.in THEN rp := rp1 END;
g.Move(rp,a.x,a.y);
g.Draw(rp,b.x,b.y);
INC(c);
END;
END Zeichnen;
(*-------------------------------------------------------------------------*)
PROCEDURE OpenScreen;
VAR c: INTEGER;
BEGIN
Width := sys.VAL(INTEGER,sys.VAL(SET,g.gfx.normalDisplayColumns DIV 2)*{4..15});
Height := g.gfx.normalDisplayRows;
MitteX := Width DIV 2;
MitteY := Height DIV 2;
bmsize := Width DIV 8 * Height;
c := 0;
WHILE c<3 DO
g.InitBitMap(BitMap[c],1,Width,Height);
BitMap[c].planes[0] := e.AllocMem(bmsize,LONGSET{e.chip});
IF BitMap[c].planes[0]=NIL THEN HALT(0) END;
INC(c);
END;
troubleBuf := 0;
ns.width := Width;
ns.height := Height;
ns.depth := 1;
ns.type := I.customScreen + {I.customBitMap};
ns.customBitMap:= sys.ADR(BitMap[0]);
screen := I.OpenScreen(ns);
IF screen=NIL THEN HALT(0) END;
nw.width := screen.width;
nw.height := screen.height;
nw.idcmpFlags := LONGSET{I.closeWindow};
nw.flags := LONGSET{I.windowClose};
nw.screen := screen;
nw.type := I.customScreen;
window := I.OpenWindow(nw);
IF window=NIL THEN HALT(0) END;
rp1 := sys.ADR(screen.rastPort);
rp2 := window.rPort;
END OpenScreen;
(*-------------------------------------------------------------------------*)
BEGIN
OpenScreen;
count := 0;
REPEAT
c2 := 0;
REPEAT
Points[count,c2] := SPoints[count,c2];
INC(c2);
UNTIL c2=3;
INC(count);
UNTIL count=PointCnt;
count := 143; c2 := 0;
REPEAT
INC(count);
IF count=144 THEN count := 0;
CurMat := mats[0];
INC(c2); IF c2=4 THEN c2 := 0 END;
ELSE MulMat(CurMat,mats[c2]) END;
Abbilden;
Zeichnen;
UNTIL e.GetMsg(window.userPort)#NIL;
CLOSE
IF window#NIL THEN I.CloseWindow(window) END;
IF screen#NIL THEN I.CloseScreen(screen) END;
g.WaitBlit;
count := 0;
REPEAT
IF BitMap[count].planes[0]#NIL THEN e.FreeMem(BitMap[count].planes[0],bmsize) END;
INC(count);
UNTIL count=3;
END Cube.