home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / MAC_PRGS.M2 / REALTEST.M < prev    next >
Encoding:
Text File  |  1995-07-16  |  8.3 KB  |  3 lines
  1. ⓪ MODULE RealTest;⓪ (*$F* *)⓪ ⓪ (*⓪!* Testprogramm für Reals.⓪!* Jeweils mit/ohne FPU und mit beiden Real-Typen (s.u.: "Real"-Type) testen⓪!*)⓪ ⓪ (*⓪ IMPORT TOSIO; (*$E MOS*)⓪ *)⓪ ⓪ FROM SYSTEM IMPORT ASSEMBLER;⓪ ⓪ FROM GEMEnv IMPORT DeviceHandle,InitGem,RC;⓪ FROM GrafBase IMPORT Point;⓪ FROM InOut IMPORT FlushKbd,KeyPressed,WriteLn,WriteReal,WriteString,⓪"WriteEng, WriteLHex,OpenOutput;⓪ FROM MathLib0 IMPORT arcsin,cos,pi,sin,sqrt;⓪ FROM VDIControls IMPORT ClearWorkstation;⓪ FROM VDIOutputs IMPORT PolyLine;⓪ ⓪ TYPE Real = LONGREAL;⓪ ⓪ CONST⓪"Punkt_Anzahl    = 16;⓪"Steps           = 10;⓪"⓪ TYPE⓪"DreiD_Koord     = RECORD⓪6x,y,z : Real⓪4END;⓪"DreiD_Koord_Arr = ARRAY [0..Punkt_Anzahl - 1] OF DreiD_Koord;⓪"ZweiD_Koord_Arr = ARRAY [0..Punkt_Anzahl - 1] OF Point;⓪"Matrix          = ARRAY [0..3],[0..3] OF Real;⓪"⓪ VAR⓪"a,b    : DreiD_Koord;⓪"xyz,⓪"xyz_I  : DreiD_Koord_Arr;⓪"xy     : ZweiD_Koord_Arr;⓪"handle : DeviceHandle;⓪"ch     : CHAR;⓪"ok     : BOOLEAN;⓪"mats   : ARRAY [0..6] OF Matrix;⓪"t      : Matrix;⓪"d,e,⓪"step   : Real;⓪"i,j,k  : CARDINAL;⓪ ⓪ ⓪ PROCEDURE writeMat (VAR t: Matrix);⓪"VAR i,j: CARDINAL; p: POINTER TO RECORD n1,n2: LONGCARD END;⓪"BEGIN⓪$WriteLn;⓪$FOR i := 0 TO 3 DO⓪&FOR j := 0 TO 3 DO⓪(WriteEng (t[i,j],18,6);⓪&END;⓪&WriteLn⓪$END;⓪$FlushKbd; REPEAT UNTIL KeyPressed(); FlushKbd;⓪"END writeMat;⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenEinheitsMat ( VAR m : Matrix );⓪"VAR⓪$i,j : CARDINAL;⓪"BEGIN⓪$FOR i := 0 TO 3 DO⓪&FOR j := 0 TO 3 DO⓪(IF i = j THEN⓪*m[i,j] := 1.0⓪(ELSE⓪*m[i,j] := 0.0⓪(END⓪&END⓪$END⓪"END GenEinheitsMat;⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenTranslMat ( a,b,c : Real; VAR m : Matrix );⓪"BEGIN⓪$GenEinheitsMat(m);⓪ ⓪$m[0,3] := a;⓪$m[1,3] := b;⓪$m[2,3] := c⓪"END GenTranslMat;⓪"⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenSkalMat ( a,b,c : Real; VAR m : Matrix );⓪"BEGIN⓪$GenEinheitsMat(m);⓪$⓪$m[0,0] := a;⓪$m[1,1] := b;⓪$m[2,2] := c;⓪"END GenSkalMat;⓪"⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenXRotMat ( w : Real; VAR m : Matrix );⓪"BEGIN⓪$GenEinheitsMat(m);⓪$⓪$m[1,1] := cos(w);⓪$m[1,2] := sin(w);⓪$m[2,1] := -sin(w);⓪$m[2,2] := cos(w)⓪"END GenXRotMat;⓪"⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenYRotMat ( w : Real; VAR m : Matrix );⓪"BEGIN⓪$GenEinheitsMat(m);⓪$⓪$m[0,0] := cos(w);⓪$m[0,2] := -sin(w);⓪$m[2,0] := sin(w);⓪$m[2,2] := cos(w)⓪"END GenYRotMat;⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenZRotMat ( w : Real; VAR m : Matrix );⓪"BEGIN⓪$GenEinheitsMat(m);⓪$⓪$m[0,0] := cos(w);⓪$m[0,1] := sin(w);⓪$m[1,1] := cos(w);⓪$m[1,0] := -sin(w)⓪"END GenZRotMat;⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE GenWuerfelArr ( a, b, c, d : Real; VAR xyz : DreiD_Koord_Arr );⓪"(*$D-*)⓪"BEGIN⓪$WITH xyz[0]  DO x := a;   y := b;   z := c   END;⓪$WITH xyz[1]  DO x := a;   y := b+d; z := c   END;⓪$WITH xyz[2]  DO x := a+d; y := b+d; z := c   END;⓪$WITH xyz[3]  DO x := a+d; y := b;   z := c   END;⓪$WITH xyz[4]  DO x := a;   y := b;   z := c   END;⓪$WITH xyz[5]  DO x := a;   y := b;   z := c+d END;⓪$WITH xyz[6]  DO x := a;   y := b+d; z := c+d END;⓪$WITH xyz[7]  DO x := a+d; y := b+d; z := c+d END;⓪$WITH xyz[8]  DO x := a+d; y := b;   z := c+d END;⓪$WITH xyz[9]  DO x := a;   y := b;   z := c+d END;⓪$WITH xyz[10] DO x := a;   y := b+d; z := c+d END;⓪$WITH xyz[11] DO x := a;   y := b+d; z := c   END;⓪$WITH xyz[12] DO x := a+d; y := b+d; z := c   END;⓪$WITH xyz[13] DO x := a+d; y := b+d; z := c+d END;⓪$WITH xyz[14] DO x := a+d; y := b;   z := c+d END;⓪$WITH xyz[15] DO x := a+d; y := b;   z := c   END⓪"(*$D-*)⓪"END GenWuerfelArr;⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE Perspektive (     xyz : DreiD_Koord_Arr;⓪8VAR xy  : ZweiD_Koord_Arr );⓪"CONST⓪$xfakt = 0.8660254038/2.0;⓪$yfakt = 0.5000000000/2.0;⓪$⓪"TYPE⓪$RealPoint = RECORD⓪2x,y : Real⓪0END;⓪"VAR⓪$i     : CARDINAL;⓪$(*$Reg*) y: Real;⓪$xyz_h : ARRAY [0..Punkt_Anzahl - 1] OF RealPoint;⓪$⓪"BEGIN⓪$(*$D-*)⓪$FOR i := 0 TO Punkt_Anzahl - 1 DO⓪&xyz_h[i].x := (xyz[i].x + xyz[i].y*xfakt)*400.0;⓪&xyz_h[i].y := (xyz[i].z + xyz[i].y*yfakt)*400.0⓪$END;⓪$FOR i := 0 TO Punkt_Anzahl - 1 DO⓪&IF (xyz_h[i].x > 0.0) AND (xyz_h[i].x < 399.0) THEN⓪(xy[i].x := SHORT(TRUNC(xyz_h[i].x))⓪&ELSE⓪(xy[i].x := 639⓪&END;⓪&y:= xyz_h[i].y;⓪&IF (y > 0.0) AND (y < 399.0) THEN⓪(xy[i].y := 400 - SHORT(TRUNC(xyz_h[i].y))⓪&ELSE⓪(xy[i].y := 399⓪&END⓪$END⓪$(*$D-*)⓪"END Perspektive;⓪"⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE Mats_Mult ( VAR mats : ARRAY OF Matrix; VAR erg : Matrix );⓪ ⓪"VAR⓪$i    : CARDINAL;⓪$help : Matrix;⓪$⓪"PROCEDURE mat_mult ( a,b : Matrix; VAR c : Matrix );⓪$VAR⓪&i,j,k : CARDINAL;⓪&(*$Reg*) sum: Real;⓪$BEGIN⓪&FOR i := 0 TO 3 DO⓪(FOR j := 0 TO 3 DO⓪*sum := 0.0;⓪*FOR k := 0 TO 3 DO⓪,(*⓪,WriteReal (a[i,k], 18, 6);⓪,WriteReal (b[k,j], 18, 6);⓪,WriteReal (a[i,k]*b[k,j], 18, 6);⓪,WriteReal (sum, 18, 6);⓪,WriteLn;⓪,*)⓪,sum := sum + a[i,k] * b[k,j];⓪*END;⓪*c[i,j] := sum⓪(END;⓪&END;⓪$END mat_mult;⓪$⓪"BEGIN⓪$mat_mult(mats[6],mats[5],erg);⓪$(*writeMat (erg);*)⓪$FOR i := 4 TO 0 BY -1 DO⓪&help := erg;⓪&mat_mult(help,mats[i],erg);⓪&(*writeMat (erg)*)⓪$END⓪"END Mats_Mult;⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ PROCEDURE Mat_Vec_Mult (     m   : Matrix;⓪=v   : DreiD_Koord_Arr;⓪9VAR erg : DreiD_Koord_Arr );⓪"VAR⓪$i : CARDINAL;⓪$⓪"BEGIN⓪$(*$D-*)⓪$FOR i := 0 TO Punkt_Anzahl - 1 DO⓪&erg[i].x := m[0,0]*v[i].x + m[0,1]*v[i].y + m[0,2]*v[i].z;⓪&erg[i].y := m[1,0]*v[i].x + m[1,1]*v[i].y + m[1,2]*v[i].z;⓪&erg[i].z := m[2,0]*v[i].x + m[2,1]*v[i].y + m[2,2]*v[i].z;⓪&(*⓪&WriteEng (erg[i].x,18,7);⓪&WriteEng (erg[i].y,18,7);⓪&WriteEng (erg[i].z,18,7);⓪&WriteLn;⓪&*)⓪$END;⓪$(*$D-*)⓪"END Mat_Vec_Mult;⓪ ⓪ ⓪ (*----------------------------------------------------------------------------*)⓪ ⓪ VAR r: Real;⓪ ⓪ BEGIN⓪ ⓪"(*⓪"OpenOutput ('TXT');⓪"*)⓪"⓪"GenWuerfelArr(0.4,0.4,0.2,0.2,xyz);⓪"⓪"(*⓪"FOR i := 0 TO Punkt_Anzahl - 1 DO⓪$WriteReal(xyz[i].x,18,7);⓪$WriteReal(xyz[i].y,18,7);⓪$WriteReal(xyz[i].z,18,7);⓪$WriteLn;⓪"END;⓪"RETURN;⓪"FlushKbd; REPEAT UNTIL KeyPressed(); FlushKbd;⓪"*)⓪"⓪"WITH a DO x := 0.0; y := 0.0; z := 0.0 END;⓪"WITH b DO x := 1.0; y := 1.0; z := 1.0 END;⓪"⓪"InitGem(RC,handle,ok);⓪"IF NOT ok THEN HALT END;⓪"⓪"ClearWorkstation(handle);⓪"Perspektive(xyz,xy);⓪"(*$D-*)⓪"PolyLine(handle,xy,Punkt_Anzahl-1);⓪"⓪"FlushKbd; REPEAT UNTIL KeyPressed(); FlushKbd;⓪"⓪"d:= b.x*b.x + b.y*b.y;⓪"d := sqrt (d);⓪"e := sqrt (b.x*b.x + b.y*b.y + b.z*b.z);⓪"step := VAL(Real,Steps)*3.1415/180.0;⓪"⓪"GenTranslMat (-a.x, -a.y, -a.z, mats[0]);⓪"GenZRotMat (arcsin (b.y/d), mats[1]);⓪"GenYRotMat (arcsin (d/e), mats[2]);⓪"GenZRotMat (step, mats[3]);⓪"GenYRotMat (-arcsin (d/e), mats[4]);⓪"GenZRotMat (-arcsin (b.y/d), mats[5]);⓪"GenTranslMat (a.x, a.y, a.z, mats[6]);⓪"Mats_Mult (mats, t);⓪"⓪"(*⓪"FOR i:= 0 TO 6 DO⓪$writeMat (mats[i])⓪"END;⓪"*)⓪"⓪"WriteString ("Transformationsmatrix: ");⓪"WriteLn;⓪"writeMat (t);⓪"⓪"ClearWorkstation(handle);⓪"WriteString ('Start!');⓪"FOR i := 1 TO 360 BY Steps DO⓪$ClearWorkstation(handle);⓪$Mat_Vec_Mult(t,xyz,xyz_I);⓪$Perspektive(xyz_I,xy);⓪$PolyLine(handle,xy,Punkt_Anzahl-1);⓪$xyz := xyz_I;⓪"END;⓪"PolyLine(handle,xy,Punkt_Anzahl-1);⓪"⓪"(*⓪"FlushKbd;⓪"REPEAT UNTIL KeyPressed()⓪"*)⓪ END RealTest.⓪ ə
  2. (* $FFF6A412$000006FA$000007EE$000008DF$000009EF$00000AFF$00001024$0000138D$000016B2$FFF6A412$FFF6A412$0000022B$FFF6A412$00001EF5$FFF6A412$00000662$FFF6A412$00001919$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$00000226$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412$FFF6A412Ç$0000022BT.......T.......T.......T.......T.......T.......TT......T.......T.......T.......$0000097D$00000BB2$00001E81$00000020$000005EE$0000022B$00000012$0000009F$000000BF$00001EB6$00001E81$00001E7E$00001E4B$00001E15$000001B7$00000992ÿÇé*)
  3.