MODULE srFRep;
IMPORT Math, srBase,srVoxel,Raster, Graphics:=WMGraphics;

TYPE
PT=srBase.PT;
COLOR=srBase.COLOR;
Voxel=srBase.Voxel;
Name = srBase.Name;
FR=srBase.FR;

(* Cubes first, then spheres *)
(*Rectangular prisms?*)

TYPE MSV*= OBJECT(Voxel); (* Base type for all mspace cell types. *)

PROCEDURE FRasterrec*(f: FR; resolution: LONGINT; origin: PT; scale: LONGINT);
END FRasterrec;

END MSV;

TYPE rprism= OBJECT(FR)

PROCEDURE&init(c1,c2:PT);
BEGIN
IF c1.x<c2.x THEN bbc1.x:=c1.x; bbc2.x:=c2.x ELSE bbc1.x:=c2.x; bbc2.x:=c1.x END;
IF c1.y<c2.y THEN bbc1.y:=c1.y; bbc2.y:=c2.y ELSE bbc1.y:=c2.y; bbc2.y:=c1.y END;
IF c1.z<c2.z THEN bbc1.z:=c1.z; bbc2.z:=c2.z ELSE bbc1.z:=c2.z; bbc2.z:=c1.z END;
END init;

PROCEDURE in*(p:PT):BOOLEAN;
VAR
a,b,c: BOOLEAN;
BEGIN
a:= ((bbc1.x<p.x)&(p.x<bbc2.x))OR((bbc1.x>p.x)&(p.x>bbc2.x)) ;
b:= ((bbc1.y<p.y)&(p.y<bbc2.y))OR((bbc1.y>p.y)&(p.y>bbc2.y)) ;
c:= ((bbc1.x<p.z)&(p.z<bbc2.z))OR((bbc1.z>p.z)&(p.z>bbc2.z)) ;
RETURN(a&b&c);
END in;

END rprism;

TYPE sphere= OBJECT(FR)
VAR
radius*, rsquared*: REAL;
center*:PT;

PROCEDURE &init(c:PT; r: REAL);
BEGIN
radius:=ABS(r);
rsquared:=r*r;
r:=r*1.00001; (* don't want the sphere to quite touch the box *);
bbc1.x:=c.x-r;
bbc1.y:=c.y-r;
bbc1.z:=c.z-r;
bbc2.x:=c.x+r;
bbc2.y:=c.y+r;
bbc2.z:=c.z+r;
center:=c;
END init;

PROCEDURE reset*(c:PT; r: REAL);
BEGIN
radius:=ABS(r);
rsquared:=r*r;
r:=r*1.00001; (* don't want the sphere to quite touch the box *);
bbc1.x:=c.x-r;
bbc1.y:=c.y-r;
bbc1.z:=c.z-r;
bbc2.x:=c.x+r;
bbc2.y:=c.y+r;
bbc2.z:=c.z+r;
center:=c;
END reset;

PROCEDURE setcenter*(x,y,z: REAL);
BEGIN
center.x:=x; center.y:=y; center.z:=z
END setcenter;

PROCEDURE d2s*(p:PT):REAL;  (* distance to surface *)
BEGIN
norml.x:= center.x-p.x;
norml.y:= center.y-p.y;
norml.z:= center.z-p.z;
RETURN((norml.x*norml.x+norml.y*norml.y+norml.z*norml.z)-rsquared)
END d2s;

END sphere;

TYPE ellipsoid*= OBJECT(FR)
VAR
radius: REAL;
center0,center1,norml0,norml1:PT;

PROCEDURE &init(a,b:PT; m: REAL);

BEGIN
center0:=a;
center1:=b;
radius:=m;
END init;

PROCEDURE setcenter*(x,y,z,a,b,c: REAL);
BEGIN
center0.x:=x; center0.y:=y; center0.z:=z;
center1.x:=x; center1.y:=y; center1.z:=z
END setcenter;

PROCEDURE d2s*(p:PT):REAL;  (* distance to surface *)
VAR
d,e:REAL;
BEGIN
norml0.x:= center0.x-p.x;
norml0.y:= center0.y-p.y;
norml0.z:= center0.z-p.z;
norml1.x:= center1.x-p.x;
norml1.y:= center1.y-p.y;
norml1.z:= center1.z-p.z;
d:= Math.sqrt(norml0.x*norml0.x+norml0.y*norml0.y+norml0.z*norml0.z);
e:= Math.sqrt(norml1.x*norml1.x+norml1.y*norml1.y+norml1.z*norml1.z);
norml.x:=(norml0.x+norml1.x)/2;
norml.y:=(norml0.y+norml1.y)/2;
norml.y:=(norml0.z+norml1.z)/2;
RETURN((d+e)-radius)
END d2s;
END ellipsoid;

TYPE cyl*= OBJECT(FR)
VAR
rsquared,lensq: REAL;
p1,p2,d:PT;

PROCEDURE &init(a,b:PT; r: REAL);

BEGIN
rsquared:=r*r;
p1:=a; p2:=b;
d.x:=p2.x-p1.x;
d.y:=p2.y-p1.y;
d.z:=p2.z-p1.z;
lensq:=d.x*d.x+d.y*d.y+d.z*d.z;
srBase.setPT(norml,1,0,0)
END init;

PROCEDURE d2s*(p:PT):REAL;  (* distance to surface *)
VAR
dot,dsq,a,b,c: REAL;
pd:PT;
BEGIN
pd.x:=p.x-p1.x;
pd.y:=p.y-p1.y;
pd.z:=p.z-p1.z;
dot:=pd.x*d.x+pd.y*d.y+pd.z*d.z;
dsq:=(pd.x*pd.x+pd.y*pd.y+pd.z*pd.z)-dot*dot/lensq;
RETURN(dsq-rsquared);
END d2s;

END cyl;

TYPE texturedcone*= OBJECT(FR)
VAR
rsquared,r2squared,lensq: REAL;
p1,p2,d:PT;
img: Raster.Image;
fmt: Raster.Format;
copy : Raster.Mode;
W,H, bpr,adr: LONGINT;

PROCEDURE &init(a,b:PT; r,r2: REAL; n: Name);
BEGIN
rsquared:=r*r;
r2squared:=r2*r2;
p1:=a; p2:=b;
d.x:=p2.x-p1.x;
d.y:=p2.y-p1.y;
d.z:=p2.z-p1.z;
lensq:=d.x*d.x+d.y*d.y+d.z*d.z;
srBase.setPT(norml,1,0,0);
Raster.InitMode(copy, Raster.srcCopy);
img :=Graphics.LoadImage(n, TRUE);
IF img#NIL THEN W := img.width-1; H:= img.height-1; END;
END init;

PROCEDURE color*(p:PT):COLOR;
VAR
a:COLOR;
r,b,g: REAL;
tx,ty: LONGINT;
pixel:Raster.Pixel;
BEGIN
IF img#NIL THEN
tx:=ENTIER(p.z*W);
ty:=ENTIER(p.y*H);
Raster.Get(img,tx,ty,pixel,copy);
r := ORD(pixel[2])/255; g := ORD(pixel[1])/255; b := ORD(pixel[0])/255;
a.red:=r;
a.green:=g;
a.blue:=b;
ELSE
a.red:=c.red;
a.green:=c.green;
a.blue:=c.blue;
END;
RETURN a
END color;

PROCEDURE d2s*(p:PT):REAL;  (* distance to surface *)
VAR
dot,dsq,a,b,c: REAL;
pd:PT;
BEGIN
pd.x:=p.x-p1.x;
pd.y:=p.y-p1.y;
pd.z:=p.z-p1.z;
dot:=pd.x*d.x+pd.y*d.y+pd.z*d.z;
dsq:=(pd.x*pd.x+pd.y*pd.y+pd.z*pd.z)-dot*dot/lensq;
RETURN(dsq-rsquared);
END d2s;

END texturedcone;

TYPE plane*= OBJECT(FR)
VAR
d: REAL;
p:PT;

PROCEDURE &init(a,b:PT);
BEGIN
p:=a;   norml:=b;
norml.x:= norml.x + (srBase.rand.Uniform()-1/2)/20;
norml.y:= norml.y + (srBase.rand.Uniform()-1/2)/20;
norml.z:= norml.z + (srBase.rand.Uniform()-1/2)/20;
srBase.normalizePT(norml);
d:= -norml.x*p.x - norml.y*p.y - norml.z*p.z;
END init;

PROCEDURE color*(p:PT):COLOR;
VAR
a:COLOR;
BEGIN
a.red:=p.x;
a.green:=p.y;
a.blue:=p.z;
RETURN a
END color;

PROCEDURE mirror*(p:PT):REAL;
BEGIN
IF srBase.rand.Uniform()>0.9 THEN
RETURN(1/2)
ELSE
RETURN(0)
END
END mirror;

PROCEDURE d2s*(m:PT):REAL;  (* distance to surface *)
VAR
BEGIN
RETURN ABS(m.x*norml.x+m.y*norml.y+m.z*norml.z+d);
END d2s;

PROCEDURE normal*(p:PT):PT;
BEGIN
RETURN norml
END normal;

END plane;

TYPE texturedplane*= OBJECT(FR)
VAR
d: REAL;
p*:PT;
img: Raster.Image;
fmt: Raster.Format;
copy : Raster.Mode;
W,H, bpr,adr: LONGINT;

PROCEDURE &init(a,b:PT; n: Name);
BEGIN
p:=a;   norml:=b;
srBase.normalizePT(norml);
d:= -norml.x*p.x - norml.y*p.y - norml.z*p.z;
Raster.InitMode(copy, Raster.srcCopy);
img :=Graphics.LoadImage(n, TRUE);
IF img#NIL THEN W := img.width-1; H:= img.height-1; END;
END init;

PROCEDURE color*(p:PT):COLOR;
VAR
a:COLOR;
r,b,g: REAL;
tx,ty: LONGINT;
pixel:Raster.Pixel;
BEGIN
IF img#NIL THEN
tx:=ENTIER(p.z*W);
ty:=ENTIER(p.y*H);
Raster.Get(img,tx,ty,pixel,copy);
r := ORD(pixel[2])/255; g := ORD(pixel[1])/255; b := ORD(pixel[0])/255;
a.red:=r;
a.green:=g;
a.blue:=b;
ELSE
a.red:=c.red;
a.green:=c.green;
a.blue:=c.blue;
END;
RETURN a
END color;

PROCEDURE d2s*(m:PT):REAL;  (* distance to surface *)
VAR
BEGIN
RETURN ABS(m.x*norml.x+m.y*norml.y+m.z*norml.z+d);
END d2s;

PROCEDURE normal*(p:PT):PT;
BEGIN
RETURN norml
END normal;

END texturedplane;

TYPE cube*= OBJECT(FR)
VAR
white:srVoxel.DiffuseVox;

PROCEDURE color*(p:PT):COLOR;
VAR
c:COLOR;
BEGIN
c.red:=p.x; c.blue:=p.y; c.red:=p.z;
RETURN c
END color;

BEGIN
NEW(white);
white.setcolor(1,1,1);
vox:=white;
END cube;

TYPE cursor* = OBJECT(FR)


END cursor;

TYPE hexgrid = OBJECT(FR)  (*accidentally created from cyl *)
VAR
radius, rsquared,lensq: REAL;
p1,p2,d:PT;

PROCEDURE &init(a,b:PT; r: REAL);

BEGIN
rsquared:=r*r;
p1:=a; p2:=b;
d.x:=p2.x-p1.x;
d.y:=p2.y-p1.y;
d.z:=p2.z-p1.z;
lensq:=d.x*d.x+d.y*d.y+d.z*d.z;
END init;

PROCEDURE d2s*(p:PT):REAL;  (* distance to surface *)
VAR
dot,dsq,a,b,c: REAL;
pd:PT;
BEGIN
pd.x:=p.x-p1.x;
pd.y:=p.y-p1.y;
pd.z:=p.z-p1.z;
dot:=pd.x*p.x+pd.y*p.y+pd.z*p.z;
srBase.normalizePT(pd);
norml:=pd;
(* IF dot<0 THEN
norml.x:= p1.x-p.x;
norml.y:= p1.y-p.y;
norml.z:= p1.z-p.z;
RETURN((norml.x*norml.x+norml.y*norml.y+norml.z*norml.z)-rsquared)
ELSIF dot>lensq THEN
norml.x:= p2.x-p.x;
norml.y:= p2.y-p.y;
norml.z:= p2.z-p.z;
RETURN((norml.x*norml.x+norml.y*norml.y+norml.z*norml.z)-rsquared)
ELSE
dsq:=(pd.x*pd.x+pd.y*pd.y+pd.z*pd.z)-dot*dot/lensq;
RETURN(dsq-rsquared);
END *)
dsq:=(pd.x*pd.x+pd.y*pd.y+pd.z*pd.z)-dot*dot/lensq;
RETURN(dsq-rsquared);
END d2s;

END hexgrid;

TYPE coloredball*=OBJECT(sphere)

PROCEDURE color*(p:PT):COLOR;
BEGIN
RETURN c
END color;

END coloredball;

TYPE blueball*=OBJECT(sphere)
VAR
c,d:COLOR;

PROCEDURE color*(p:PT):COLOR;
BEGIN
RETURN c
END color;

PROCEDURE mirror*(p:PT):REAL;
BEGIN
RETURN 0
END mirror;

BEGIN
c.red:=0.49;
c.green:=0.5;
c.blue:=0.99;
d.red:=0.59;
d.green:=0.5;
d.blue:=0.09;
END blueball;

TYPE yellowball*=OBJECT(sphere)
VAR
c,d:COLOR;

PROCEDURE color*(p:PT):COLOR;
BEGIN
IF ODD(ENTIER(p.x*734)) THEN RETURN c ELSE RETURN d END
END color;

BEGIN
c.red:=0.99;
c.green:=0.89;
c.blue:=0.5;
d.red:=0.79;
d.green:=0.99;
d.blue:=0.5;
END yellowball;

TYPE skyball*=OBJECT(sphere)
VAR
c,d:COLOR;

PROCEDURE color*(p:PT):COLOR;
VAR
b:REAL;
BEGIN
b:=center.z-p.z;
IF b<0 THEN RETURN c ELSE RETURN d END
END color;

BEGIN
c.red:=0.01;
c.green:=0.19;
c.blue:=0.99;
d.red:=0.01;
d.green:=0.09;
d.blue:=0.5;
END skyball;

TYPE yellowcyl*=OBJECT(cyl)
VAR
c,d:COLOR;

PROCEDURE color*(p:PT):COLOR;
BEGIN
RETURN c
END color;

BEGIN
c.red:=0.99;
c.green:=0.89;
c.blue:=0.09;
d.red:=0.89;
d.green:=0.99;
d.blue:=0.5;
END yellowcyl;

TYPE whiteball*=OBJECT(sphere)
VAR
white: srVoxel.DiffuseVox;
c:COLOR;

PROCEDURE color*(p:PT):COLOR;
BEGIN
RETURN c
END color;

BEGIN
c.red:=0.99;
c.green:=0.89;
c.blue:=0.99;
END whiteball;

END srFRep.