commit 3f46e7dd82a67b0778beb1e669a0a02d191d30bb Author: Brooke Vibber Date: Wed Apr 8 20:43:13 2026 -0700 Initial commit of 1992 raytracing code diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e43b0f9 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +.DS_Store diff --git a/screenshots/.DS_Store b/screenshots/.DS_Store new file mode 100644 index 0000000..5008ddf Binary files /dev/null and b/screenshots/.DS_Store differ diff --git a/screenshots/brion1.tga b/screenshots/brion1.tga new file mode 100644 index 0000000..41b4771 Binary files /dev/null and b/screenshots/brion1.tga differ diff --git a/screenshots/brion10.tga b/screenshots/brion10.tga new file mode 100644 index 0000000..e491296 Binary files /dev/null and b/screenshots/brion10.tga differ diff --git a/screenshots/brion2.tga b/screenshots/brion2.tga new file mode 100644 index 0000000..ec6c81b Binary files /dev/null and b/screenshots/brion2.tga differ diff --git a/screenshots/brion4.tga b/screenshots/brion4.tga new file mode 100644 index 0000000..a38cf44 Binary files /dev/null and b/screenshots/brion4.tga differ diff --git a/screenshots/brion5.tga b/screenshots/brion5.tga new file mode 100644 index 0000000..352770a Binary files /dev/null and b/screenshots/brion5.tga differ diff --git a/screenshots/brion6.tga b/screenshots/brion6.tga new file mode 100644 index 0000000..4fdb65a Binary files /dev/null and b/screenshots/brion6.tga differ diff --git a/screenshots/brion7.tga b/screenshots/brion7.tga new file mode 100644 index 0000000..595a33b Binary files /dev/null and b/screenshots/brion7.tga differ diff --git a/screenshots/brion8.tga b/screenshots/brion8.tga new file mode 100644 index 0000000..1fffa83 Binary files /dev/null and b/screenshots/brion8.tga differ diff --git a/screenshots/brion9.tga b/screenshots/brion9.tga new file mode 100644 index 0000000..ba1061d Binary files /dev/null and b/screenshots/brion9.tga differ diff --git a/textures/earth2.pcx b/textures/earth2.pcx new file mode 100644 index 0000000..0f98a8a Binary files /dev/null and b/textures/earth2.pcx differ diff --git a/textures/mimas2.pcx b/textures/mimas2.pcx new file mode 100644 index 0000000..c1e7cd2 Binary files /dev/null and b/textures/mimas2.pcx differ diff --git a/textures/wood2.pcx b/textures/wood2.pcx new file mode 100644 index 0000000..6b64fec Binary files /dev/null and b/textures/wood2.pcx differ diff --git a/turbo-pascal/ray.pas b/turbo-pascal/ray.pas new file mode 100644 index 0000000..3348e65 --- /dev/null +++ b/turbo-pascal/ray.pas @@ -0,0 +1,259 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +procedure TraceIt; +var + u: Universe; + p: Pplane; + pp,p1: Plane; + r,g,b,w: ColorSphere; +begin + u.Init(320,200); + p.Init (-8.0, 0.0, 0.0, 0.0, 1.0, 0.001); + pp.Init (8.0, 0.0, 0.0, 1.0, 1.0, 0.001); + p1.Init (8.0, 30.0, 0.0, -1.0, 1.0, 0.001); + r.Init(-15,-3,50,5, 128,0,0); + g.Init(-10,-3,45,5, 0,128,0); + b.Init(-5,-3,50,5, 0,0,128); + w.Init(-10,2,47.5,5, 128,128,128); + u.Insert(@p); + u.Insert(@pp); + u.Insert(@p1); + u.Insert(@r); + u.Insert(@g); + u.Insert(@b); + u.Insert(@w); + {Save(u,'brion2.tga');} + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray10.pas b/turbo-pascal/ray10.pas new file mode 100644 index 0000000..94dd53b --- /dev/null +++ b/turbo-pascal/ray10.pas @@ -0,0 +1,271 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + PlanePnt = object(Obj3d) + nx,ny,nz,xb,yb,zb,xc,yc,zc: Real; + constructor Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real); + function Intersect(aray: Ray): Real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +constructor PlanePnt.Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real); +var + a,b,c,d: Real; +begin + a := y1*(z2-z3)+y2*(z3-z1)+y3*(z1-z2); + b := z1*(x2-x3)+z2*(x3-x1)+z3*(x1-x2); + c := x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2); + d := -x1*(y2*z3-y3*z2)-x2*(y3*z1-y1*z3)-x3*(y1*z2-y2*z1); + Obj3d.Init(x1,y1,z1); + xb := x2; yb := y2; zb := z2; + xc := x3; yc := y3; zc := z3; + nx := a; ny := b; nz := c; +end; + +function PlanePnt.Intersect(aray: Ray): Real; +var + p1, p2, p3: real; +begin + p1 := xp * nx + yp * ny + zp * nz; + p2 := aray.ox * nx + aray.oy * ny + aray.oz * nz; + p3 := aray.dx * nx + aray.dy * ny + aray.dz * nz; + if p3 = 0 then p3 := 0.001; + Intersect := (p1-p2)/p3; +end; + +procedure PlanePnt.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + oray.dx := nx; oray.dy := ny; oray.dz := nz; +end; + +function PlanePnt.GetColor(aray: Ray; time: Real): LongInt; +var + d: Real; + c: Integer; +begin + d := Sqrt( + Sqr(time * aray.dx + aray.ox - xp) + + Sqr(time * aray.dy + aray.oy - yp) + + Sqr(time * aray.dz + aray.oz - zp)); + if d > 255.0 then d := 255.0; + c := 255-Round(d); + if c < 96 then c := 96; + GetColor := GetRgb(c,c,c); +end; + +procedure TraceIt; +const + MaxS = 7; MaxP = 3; +var + u: Universe; + i: Integer; + s: array[1..MaxS] of Sphere; + p: array[1..MaxP] of PlanePnt; +begin + u.Init(320,200); + s[1].Init(-5,-5,50,1); + s[2].Init(-6,-5,45,1); + s[3].Init(5,-8,50,1); + s[4].Init(-7,0,50,1); + s[5].Init(20,0,50,1); + s[6].Init(18,0,55,1); + s[7].Init(18,10,55,1); + p[1].Init(-5,-5,50, -6,-5,45, 5,-8,50); + p[2].Init(-5,-5,50, -6,-5,45, -7,0,50); + p[3].Init(20,0,50, 18,0,55, 18,10,55); + for i := 1 to MaxS do + u.Insert(@s[i]); + for i := 1 to MaxP do + u.Insert(@p[i]); + Draw(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray11.pas b/turbo-pascal/ray11.pas new file mode 100644 index 0000000..9475e19 --- /dev/null +++ b/turbo-pascal/ray11.pas @@ -0,0 +1,262 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + BlankSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +const + AmbientInt = 10; + PointInt = 100; + LightX = 15; + LightY = 5; + LightZ = 100; + CoeffReflect = 0.85; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + costheta,d,x,y,z,I: Real; + N,L: Ray; + c: Integer; +begin + SurfNormal(aray,time,N); + d := Sqrt(Sqr(n.dx)+Sqr(n.dy)+Sqr(n.dz)); + if d <> 0 then begin + n.dx := n.dx / d; + n.dy := n.dy / d; + n.dz := n.dz / d; + end; + x := LightX - (time * aray.dx + aray.ox); + y := LightY - (time * aray.dy + aray.oy); + z := LightZ - (time * aray.dz + aray.oz); + d := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)); + if d <> 0 then begin + x := x / d; + y := y / d; + z := z / d; + end; + costheta := + (n.dx*x+n.dx*y+n.dx*z+ + n.dy*x+n.dy*y+n.dy*z+ + n.dz*x+n.dz*y+n.dz*z); + if costheta < 0 then costheta := 0; + I := (CoeffReflect * AmbientInt) + + ((CoeffReflect * PointInt) / (d + 0.001)) * costheta; + c := Round(I*15); + GetColor := GetRgb(c,c,c); +end; + +function BlankSphere.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := $ffffff; +end; + +procedure TraceIt; +var + u: Universe; + p,p2,p3: Pplane; + s: BlankSphere; +begin + u.Init(320,200); + s.Init(LightX,LightY,LightZ,1); {15,5,100} + p.Init(0,-8,0, 0.25,1,0); + p2.Init(0,0,150, 0,0,-1); + p3.Init(-20,0,0, 1,0,0); + u.Insert(@p); + u.Insert(@p2); + u.Insert(@p3); + u.Insert(@s); + Zoom(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray12.pas b/turbo-pascal/ray12.pas new file mode 100644 index 0000000..4c2a78a --- /dev/null +++ b/turbo-pascal/ray12.pas @@ -0,0 +1,291 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayShade; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + Plane1 = object(Plane) + cr,cg,cb: Integer; + constructor Init(x, y, z, vx, vy, vz: real; r,g,b: Integer); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Sphere1 = object(Sphere) + cr,cg,cb: Integer; + constructor Init(x, y, z, r: real; rr,g,b: Integer); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Sphere2 = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + +function Sphere2.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c,c2: LongInt; + cc: record b,g,r: Byte end absolute c; + cc2: record b,g,r: Byte end absolute c2; +begin + ReflectRay(aray,time,r); + c := Owner^.RayColor(r); + c2 := Shade(aray,time,GetRgb(64,64,64)); + GetColor := GetRgb(cc.r-64+cc2.r,cc.g-64+cc2.g,cc.b-64+cc2.b); +end; + +constructor Sphere1.Init(x, y, z, r: real; rr,g,b: Integer); +begin + Sphere.Init(x,y,z,r); + cr := rr; cg := g; cb := b; +end; + +function Sphere1.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := Shade(aray,time,GetRgb(cr,cg,cb)); +end; + +constructor Plane1.Init(x, y, z, vx, vy, vz: real; r,g,b: Integer); +begin + Plane.Init(x,y,z,vx,vy,vz); + cr := r; cg := g; cb := b; +end; + +function Plane1.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := Shade(aray,time,GetRgb(cr,cg,cb)); +end; + +procedure TraceIt; +var + u: Universe; + l1,l2,l3,l4,l5,l6: LightSource; + p1,p2,p3,p4,p5,p6: Plane1; + s1,s2,s3,s4,s5,s6: Sphere1; + ss1,ss2: Sphere2; +begin + u.Init(320,200, 32,32,32); + l1.Init(14.9,7.9,49.9, 1024,1024,1024); + l2.Init(-14.9,7.9,49.9, 1024,1024,1024); + l3.Init(0,7.9,49.9, 1024,1024,1024); + l4.Init(-14.9,7.9,35, 1024,1024,1024); + l5.Init(14.9,7.9,35, 1024,1024,1024); + l6.Init(0,7.9,35, 1024,1024,1024); + p1.Init(0,-8,0, 0,1,0, 192,192,192); + p2.Init(0,8,0, 0,-1,0, 192,192,192); + p3.Init(0,0,50, 0,0,-1, 192,0,0); + p4.Init(0,0,-10, 0,0,1, 192,0,0); + p5.Init(-15,0,0, 1,0,0, 0,192,0); + p6.Init(15,0,0, -1,0,0, 0,192,0); + s1.Init(-8,-6,40,2, 192,0,0); + s2.Init(-4,-6,40,2, 0,192,0); + s3.Init(-6,-6,36.4,2, 0,0,192); + s4.Init(-6,-2.8,38.8,2, 192,192,192); + ss1.Init(-15,-8,50,5); + ss2.Init(15,-8,50,5); + u.Insert(@ss1); + u.Insert(@ss2); + u.Insert(@s1); + u.Insert(@s2); + u.Insert(@s3); + u.Insert(@s4); + u.Insert(@p1); + u.Insert(@p2); + u.Insert(@p3); + u.Insert(@p4); + u.Insert(@p5); + u.Insert(@p6); + u.InsertLight(@l1); + u.InsertLight(@l2); + u.InsertLight(@l3); + u.InsertLight(@l4); + u.InsertLight(@l5); + u.InsertLight(@l6); + {Zoom(u);} + Save(u,'brion6.tga'); + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray13.pas b/turbo-pascal/ray13.pas new file mode 100644 index 0000000..80c8bf8 --- /dev/null +++ b/turbo-pascal/ray13.pas @@ -0,0 +1,254 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayShade; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + Sky = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Sea = object(Plane) + constructor Init(x,y,z,vx,vy,vz: Real); + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function Sky.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := GetRgb(64,128,192); +end; + +constructor Sea.Init(x,y,z,vx,vy,vz: Real); +begin + Plane.Init(x,y,z,vx,vy,vz); + Refl := 1; +end; + +procedure Sea.SurfNormal(aray: Ray; time: Real; var oray: Ray); +const + Waves = 3; + WavePnt: array[1..Waves] of record x,y: Real end = ( + (x: 10; y: 30), + (x: -15; y: 21), + (x: 3; y: 89)); +var + x,y,d,s: Real; + i: Integer; +begin + x := aray.dx*time+aray.ox; + y := aray.dz*time+aray.oz; + d := 0; + for i := 1 to Waves do + d := d + Sqrt(Sqr(WavePnt[i].x-x)+Sqr(WavePnt[i].y-y)); + s := sin(d); + oray.dx := s; oray.dy := ny; oray.dz := s; +end; + +function Sea.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := Shade(aray,time,GetRgb(0,128,255)); +end; + +procedure TraceIt; +var + u: Universe; + TheSun: LightSource; + TheSea: Sea; + TheSky: Sky; +begin + u.Init(320,200, 32,32,32); + TheSun.Init(100,500,-1000, 30000,30000,30000); + TheSea.Init(0,-10,0, 0,1,0); + TheSky.Init(0,501,0, 0,-1,0); + u.InsertLight(@TheSun); + u.Insert(@TheSea); + u.Insert(@TheSky); + Zoom(u); + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray2.pas b/turbo-pascal/ray2.pas new file mode 100644 index 0000000..8476f8b --- /dev/null +++ b/turbo-pascal/ray2.pas @@ -0,0 +1,204 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Modex,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + GreenSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + RedSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WhiteSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function GreenSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function RedSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function WhiteSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < 320) and (not KeyPressed) do begin + for y := 0 to 239 do begin + c := u.TracePoint(x,239-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Quick(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < 160) and (not KeyPressed) do begin + for y := 0 to 119 do begin + c := u.TracePoint(x*2,239-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < 80) and (not KeyPressed) do begin + for y := 0 to 59 do begin + c := u.TracePoint(x*4,239-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + p: Plane; + s: Sphere; + rs: RedSphere; + gs: GreenSphere; + ws: WhiteSphere; +begin + u.Init(320,240); + p.Init (0.0, -8.0, 0.0, 0.0, 1.0, 0.0); + {rs.Init(-2,0,6, 1); + gs.Init(0,-0.5,5, 1); + s.Init(2,0,6, 1);} + s.Init(0,-8,30, 5); + rs.Init(-10,-8,40, 5); + gs.Init(10,-8,40, 5); + ws.Init(-3,2,50, 6); + u.Insert(@p); + u.Insert(@s); + u.Insert(@rs); + u.Insert(@gs); + u.Insert(@ws); + Zoom(u); + Beep; + u.Done; +end; + +begin + SetModeX; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray3.pas b/turbo-pascal/ray3.pas new file mode 100644 index 0000000..32f6ad3 --- /dev/null +++ b/turbo-pascal/ray3.pas @@ -0,0 +1,205 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Modex,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + GreenSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + RedSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WhiteSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function GreenSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function RedSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function WhiteSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < 320) and (not KeyPressed) do begin + for y := 0 to 239 do begin + c := u.TracePoint(x,239-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Quick(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < 160) and (not KeyPressed) do begin + for y := 0 to 119 do begin + c := u.TracePoint(x*2,239-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < 80) and (not KeyPressed) do begin + for y := 0 to 59 do begin + c := u.TracePoint(x*4,239-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + p: {Plane}WhiteSphere; + s: Sphere; + rs: RedSphere; + gs: GreenSphere; + ws: WhiteSphere; +begin + u.Init(320,240); + {p.Init (-8.0, 0.0, 0.0, 0.0, 1.0, 0.001);} + p.Init(0,-1008,0, 1000); + {rs.Init(-2,0,6, 1); + gs.Init(0,-0.5,5, 1); + s.Init(2,0,6, 1);} + s.Init(0,-8,30, 5); + rs.Init(-10,-8,40, 5); + gs.Init(10,-8,40, 5); + ws.Init(-3,2,50, 6); + u.Insert(@p); + u.Insert(@s); + u.Insert(@rs); + u.Insert(@gs); + u.Insert(@ws); + Draw(u); + Beep; + u.Done; +end; + +begin + SetModeX; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray4.pas b/turbo-pascal/ray4.pas new file mode 100644 index 0000000..0a91633 --- /dev/null +++ b/turbo-pascal/ray4.pas @@ -0,0 +1,269 @@ +(* Update! *) +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Modex,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + GreenSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + RedSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WhiteSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Floor = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WallA = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WallB = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Ceiling = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function Floor.GetColor(aray: RAY; time: real): LongInt; +var + x,y: Word; +begin + x := Word(Round(time * aray.dz + aray.oz)); + y := Word(Round(time * aray.dx + aray.ox)); + GetColor := GetRgb(0,128+((x mod 2)+(y mod 2))*42,0); +end; + +function Ceiling.GetColor(aray: RAY; time: real): LongInt; +var + x,y: Word; + c: Byte; +begin + x := Word(Round(time * aray.dz + aray.oz)); + y := Word(Round(time * aray.dx + aray.ox)); + c := 128+((x mod 2)+(y mod 2))*42; + GetColor := GetRgb(c,c,c); +end; + +function WallA.GetColor(aray: RAY; time: real): LongInt; +var + y: Word; + c: Byte; +begin + y := Word(Round(time * aray.dx + aray.ox)); + c := 128+(y mod 2)*42; + GetColor := GetRgb(c,c div 2,0); +end; + +function WallB.GetColor(aray: RAY; time: real): LongInt; +var + x: Word; + c: Byte; +begin + x := Word(Round(time * aray.dz + aray.oz)); + c := 128+(x mod 2)*42; + GetColor := GetRgb(c,c div 2,0); +end; + +function GreenSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function RedSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function WhiteSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,239-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,239-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,239-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + s: Sphere; + rs: RedSphere; + gs: GreenSphere; + ws: WhiteSphere; + fl: Floor; + cl: Ceiling; + w1,w4: WallA; + w2,w3: WallB; +begin + u.Init(320,240); + + s.Init(0,-8,30, 5); + rs.Init(-10,-8,40, 5); + gs.Init(10,-8,40, 5); + ws.Init(-3,2,50, 6); + + fl.Init(-8,0,0, 0,1,0.001); + cl.Init(8,0,0, 0,-1,0.001); + w1.Init(0,0,50, 0,0,-1); + w4.Init(0,0,-5, 0,0,1); + w2.Init(0,-100,0, 2,0.25,0.001); + w3.Init(0,-100,0, 2,-0.25,0.001); + u.Insert(@fl); + u.Insert(@cl); + u.Insert(@w1); + u.Insert(@w2); + u.Insert(@w3); + u.Insert(@w4); + u.Insert(@s); + u.Insert(@rs); + u.Insert(@gs); + u.Insert(@ws); + Zoom(u); + Beep; + u.Done; +end; + +begin + SetModeX; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray4b.pas b/turbo-pascal/ray4b.pas new file mode 100644 index 0000000..7883131 --- /dev/null +++ b/turbo-pascal/ray4b.pas @@ -0,0 +1,268 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + GreenSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + RedSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WhiteSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Floor = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WallA = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WallB = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Ceiling = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function Floor.GetColor(aray: RAY; time: real): LongInt; +var + x,y: Word; +begin + x := Word(Round(time * aray.dz + aray.oz)); + y := Word(Round(time * aray.dx + aray.ox)); + GetColor := GetRgb(0,128+((x mod 2)+(y mod 2))*42,0); +end; + +function Ceiling.GetColor(aray: RAY; time: real): LongInt; +var + x,y: Word; + c: Byte; +begin + x := Word(Round(time * aray.dz + aray.oz)); + y := Word(Round(time * aray.dx + aray.ox)); + c := 128+((x mod 2)+(y mod 2))*42; + GetColor := GetRgb(c,c,c); +end; + +function WallA.GetColor(aray: RAY; time: real): LongInt; +var + y: Word; + c: Byte; +begin + y := Word(Round(time * aray.dx + aray.ox)); + c := 128+(y mod 2)*42; + GetColor := GetRgb(c,c div 2,0); +end; + +function WallB.GetColor(aray: RAY; time: real): LongInt; +var + x: Word; + c: Byte; +begin + x := Word(Round(time * aray.dz + aray.oz)); + c := 128+(x mod 2)*42; + GetColor := GetRgb(c,c div 2,0); +end; + +function GreenSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function RedSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function WhiteSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + s: Sphere; + rs: RedSphere; + gs: GreenSphere; + ws: WhiteSphere; + fl: Floor; + cl: Ceiling; + w1,w4: WallA; + w2,w3: WallB; +begin + u.Init(320,200); + + s.Init(0,-8,30, 5); + rs.Init(-10,-8,40, 5); + gs.Init(10,-8,40, 5); + ws.Init(-3,2,50, 6); + + fl.Init(-8,0,0, 0,1,0.001); + cl.Init(8,0,0, 0,-1,0.001); + w1.Init(0,0,50, 0,0,-1); + w4.Init(0,0,-5, 0,0,1); + w2.Init(0,-100,0, 2,0.25,0.001); + w3.Init(0,-100,0, 2,-0.25,0.001); + u.Insert(@fl); + u.Insert(@cl); + u.Insert(@w1); + u.Insert(@w2); + u.Insert(@w3); + u.Insert(@w4); + u.Insert(@s); + u.Insert(@rs); + u.Insert(@gs); + u.Insert(@ws); + Draw(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray5.pas b/turbo-pascal/ray5.pas new file mode 100644 index 0000000..8b05319 --- /dev/null +++ b/turbo-pascal/ray5.pas @@ -0,0 +1,187 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Sky = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function Sky.GetColor(aray: Ray; time: Real): LongInt; +var + x,y: Real; + r,g,b: Integer; +begin + x := (time * aray.dz + aray.oz); + y := (time * aray.dx + aray.ox); + + GetColor := GetRgb(r,g,b); +end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + cs: array[0..7] of ColorSphere; + s: Sky; + i,j,k: Integer; +begin + u.Init(320,200); + s.Init(0,8,0, 0,1,0); + u.Insert(@s); + for i := 0 to 1 do + for j := 0 to 3 do begin + k := i*4+j; + cs[k].Init(j*2-3,i*2-1,10,1, + (k and 1) * 128,((k and 2) shr 1) * 128, + ((k and 4) shr 2) * 128); + u.Insert(@cs[k]); + end; + Zoom(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray6.pas b/turbo-pascal/ray6.pas new file mode 100644 index 0000000..d84d1b7 --- /dev/null +++ b/turbo-pascal/ray6.pas @@ -0,0 +1,194 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Modex,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < 320) and (not KeyPressed) do begin + for y := 0 to 239 do begin + c := u.TracePoint(x,239-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Quick(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < 160) and (not KeyPressed) do begin + for y := 0 to 119 do begin + c := u.TracePoint(x*2,239-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < 80) and (not KeyPressed) do begin + for y := 0 to 59 do begin + c := u.TracePoint(x*4,239-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + p: Pplane; + pp,p1: Plane; + r,g,b,w: ColorSphere; +begin + u.Init(320,240); + p.Init (0.0, -8.0, 0.0, 0.0, 1.0, 0.0); + pp.Init (8.0, 0.0, 0.0, 1.0, 1.0, 0.0); + p1.Init (8.0, 30.0, 0.0, -1.0, 1.0, 0.0); + r.Init(-15,-3,50,5, 128,0,0); + g.Init(-10,-3,45,5, 0,128,0); + b.Init(-5,-3,50,5, 0,0,128); + w.Init(-10,2,47.5,5, 128,128,128); + u.Insert(@p); + u.Insert(@pp); + u.Insert(@p1); + u.Insert(@r); + u.Insert(@g); + u.Insert(@b); + u.Insert(@w); + Zoom(u); + Beep; + u.Done; +end; + +begin + SetModeX; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray6b.pas b/turbo-pascal/ray6b.pas new file mode 100644 index 0000000..ddffaa4 --- /dev/null +++ b/turbo-pascal/ray6b.pas @@ -0,0 +1,194 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + p: Pplane; + pp,p1: Plane; + r,g,b,w: ColorSphere; +begin + u.Init(320,200); + p.Init (-8.0, 0.0, 0.0, 0.0, 1.0, 0.001); + pp.Init (8.0, 0.0, 0.0, 1.0, 1.0, 0.001); + p1.Init (8.0, 30.0, 0.0, -1.0, 1.0, 0.001); + r.Init(-15,-3,50,5, 128,0,0); + g.Init(-10,-3,45,5, 0,128,0); + b.Init(-5,-3,50,5, 0,0,128); + w.Init(-10,2,47.5,5, 128,128,128); + u.Insert(@p); + u.Insert(@pp); + u.Insert(@p1); + u.Insert(@r); + u.Insert(@g); + u.Insert(@b); + u.Insert(@w); + Zoom(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray6p.pas b/turbo-pascal/ray6p.pas new file mode 100644 index 0000000..5fc9240 --- /dev/null +++ b/turbo-pascal/ray6p.pas @@ -0,0 +1,259 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +procedure TraceIt; +var + u: Universe; + p: Pplane; + pp,p1: Plane; + r,g,b,w: ColorSphere; +begin + u.Init(320,200); + p.Init (-8.0, 0.0, 0.0, 0.0, 1.0, 0.001); + pp.Init (8.0, 0.0, 0.0, 1.0, 1.0, 0.001); + p1.Init (8.0, 30.0, 0.0, -1.0, 1.0, 0.001); + r.Init(-15,-3,50,5, 128,0,0); + g.Init(-10,-3,45,5, 0,128,0); + b.Init(-5,-3,50,5, 0,0,128); + w.Init(-10,2,47.5,5, 128,128,128); + u.Insert(@p); + u.Insert(@pp); + u.Insert(@p1); + u.Insert(@r); + u.Insert(@g); + u.Insert(@b); + u.Insert(@w); + Save(u,'brion2.tga'); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray7.pas b/turbo-pascal/ray7.pas new file mode 100644 index 0000000..81204fb --- /dev/null +++ b/turbo-pascal/ray7.pas @@ -0,0 +1,265 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Mandel = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function Mandel.GetColor(aray: Ray; time: Real): LongInt; +const + k = 200; +var + x,y,cRe,cIm: Real; + zRe,zIm,zx: Real; + Zsize: Real; + Count: integer; +begin + y := (time * aray.dz + aray.oz)-50; + x := (time * aray.dx + aray.ox); + cRe := x/10; cIm := y/10; + zRe := 0; zIm := 0; zSize := 0; + Count := 0; + while (Count < k) and (Zsize < 2.0) do begin + zx := zRe * zRe - zIm * zIm; + zIm := zRe * zIm - zIm * zRe; + zRe := zx; + zRe := zRe + cRe; + zIm := zIm + cIm; + Zsize := sqr(ZRe) + sqr(ZIm); + Inc(Count); + end; + if Count = k then + GetColor := $404040 + else begin + Count := LongInt(Count)*360 div (k div 2); + GetColor := GetHsv(Count,100,100); + end; +end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +procedure TraceIt; +var + u: Universe; + m: Mandel; + p: Plane; +begin + u.Init(320,200); + m.Init(0,-8,0, 0,1,0); + p.Init(0,-8,0, 0,1,0); + u.Insert(@m); + {Save(u,'brion3.tga');} + Qwik(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray8.pas b/turbo-pascal/ray8.pas new file mode 100644 index 0000000..c9ff01e --- /dev/null +++ b/turbo-pascal/ray8.pas @@ -0,0 +1,280 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WeirdSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +function WeirdSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; +begin + r.ox := (aray.dx * time + aray.ox - xp - ra) / (ra*2); + r.oy := (aray.dy * time + aray.oy - yp - ra) / (ra*2); + r.oz := (aray.dz * time + aray.oz - zp - ra) / (ra*2); + (*GetColor := GetHsv(Round(r.oy*359),Round(r.ox*100),100{Round(r.oz*100)});*) + GetColor := GetHsv(Round(r.oy*359),100,100); +end; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +procedure TraceIt; +var + u: Universe; + p: ColorSphere; + r,g,b,w: ColorSphere; + ws: WeirdSphere; + ss: array[0..17] of ColorSphere; + i,j,k,l,m: Integer; +begin + u.Init(320,200); + p.Init(100,-1004,0, 1000, 128,128,0); + r.Init(-15,-3,50,5, 128,0,0); + g.Init(-10,-3,41,5, 0,128,0); + b.Init(-5,-3,50,5, 0,0,128); + w.Init(-10,4,47,5, 128,128,128); + ws.Init(15,6,100, 15); + for i := 0 to 17 do begin + Hsv2Rgb(i*20,100,100,j,k,l); + ss[i].Init(15+(sin(i*pi/9)*20),6,100+(cos(i*pi/9)*20),2, j div 2,k div 2,l div 2); + end; + u.Insert(@ws); + u.Insert(@p); + u.Insert(@r); + u.Insert(@g); + u.Insert(@b); + u.Insert(@w); + for i := 0 to 17 do + u.Insert(@ss[i]); + Save(u,'brion4.tga'); + {Zoom(u);} + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/ray9.pas b/turbo-pascal/ray9.pas new file mode 100644 index 0000000..d50e3e3 --- /dev/null +++ b/turbo-pascal/ray9.pas @@ -0,0 +1,451 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace,Dos; +{$I BufrFile.Inc} + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + { Definition of the PCX file header } + PCX_header = record + pcx_id : byte; { Always $0A for PCX files } + version : byte; { Version of the PCX format } + encoding : byte; { 1 = RLE (RLL) compression } + bpp : byte; { Number of bits per pixel } + upleftx, uplefty : word; { position of upper left corner } + lorightx, lorighty : word; { lower right corner (inclusive) } + display_xres, display_yres : word; { resolution in dpi of display } + palette : array [0..47] of byte; { palette data if it fits } + reserved : byte; + nplanes : byte; { number of bit planes of data } + bytesperline : word; { # bytes in an uncompressed line } + palletteinfo : word; + reserved2 : array [0..57] of byte; + end; + pplane = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + ColorSphere = object(Sphere) + rc,gc,bc: Byte; + constructor Init(x,y,z,r: Real; cr,cg,cb: Byte); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + arr_byte = array[0..65520] of byte; + parr_byte = ^arr_byte; + WoodSphere = object(Sphere) + IsLoaded: Boolean; + Width,Height: Integer; + Buf: parr_byte; + function GetPixel(x,y: Integer): Byte; + constructor Init(x,y,z,r: Real; s: String); + destructor Done; virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + GraySphere = object(WoodSphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +const + { These two definitions are used to decompress data in the PCX file. + (The compressed count byte has the top two bits set). } + + PCX_COMPRESSED = $C0; + PCX_MASK = $3F; + + Bits : array [0..7] of byte = (1, 2, 4, 8, 16, 32, 64, 128); + +{ Read header of indicated PCX file. Returns TRUE if OK, FALSE if error } + +function pcx_read_header (var hdr : PCX_header; var f : buffered_file) : boolean; +var + count : word; + hdr_array : array [0..1] of char absolute hdr; +begin + count := 0; + while count < SizeOf(PCX_header) do + begin + hdr_array [count] := NextCharRead (f); + Inc (count) + end; + pcx_read_header := (f.more_data) and (hdr.pcx_id = $0A); +end {pcx_read_header}; + +{ Read next line from PCX file into indicated array, up to indicated limit. + Returns TRUE if data acquired, FALSE if error occurred. + Note: call pcx_read_header () first to begin reading file. } + +function pcx_next_line (var hdr : PCX_header; var f : buffered_file; + var line1; linesize : integer; var count : word) : boolean; +var + line : array [0..1] of byte absolute line1; + c : byte; + len, len1 : integer; + i, linebytes, b : word; +begin + { initialize return value } + pcx_next_line := FALSE; + { determine number of bytes to acquire } + linebytes := hdr.nplanes * hdr.bytesperline; + { point to start of return data } + count := 0; + i := 0; + while i < linebytes do + begin + { acquire next block of data } + c := Ord (NextCharRead (f)); + if Not f.more_data + then Exit; + if (c AND PCX_COMPRESSED) = PCX_COMPRESSED + then { acquire run-length encoded data } + begin + len := c AND PCX_MASK; + c := Ord (NextCharRead (f)); + if Not f.more_data + then Exit; + end + else { acquire single byte } + len := 1; + { store block of data in array } + len1 := len; + if count + len1 > linesize + then len1 := linesize - count; + if count < linesize + then begin + FillChar (line [count], len1, c); + Inc (count, len1); + end; + Inc (i, len); + end; + pcx_next_line := TRUE; +end {pcx_next_line}; + +constructor WoodSphere.Init(x,y,z,r: Real; s: String); +var + PCXFile : buffered_file; + PCXBuf : DiskFileBuffer; + PCXLine : array [0..2048] of byte; + PCXHdr : PCX_header; + PCXWidth : word; + pixel_width: word; + I, J : integer; + X1, Y1 : integer; + found : boolean; + line_count : integer; + clr : byte; + numlines: integer; +begin + Sphere.Init(x,y,z,r); + + IsLoaded := False; + if length(s) = 0 then Exit; + { attempt to open file } + AssignBufferedFile(PCXFile, s, @PCXBuf); + OpenForBufferedRead(PCXFile, I); + if I <> 0 then Exit; + { read descriptive header } + found := pcx_read_header (PCXHdr, PCXFile); + if Not found then begin + CloseForBufferedRead (PCXFile, I); + Exit; + end; + IsLoaded := True; + { display data } + numlines := PCXHdr.lorighty - PCXHdr.uplefty + 1; + pixel_width := PCXHdr.lorightx - PCXHdr.upleftx + 1; + Width := pixel_width; + Height := numlines; + GetMem(Buf,Width*Height); + line_count := 0; + repeat + found := pcx_next_line (PCXHdr, PCXFile, + PCXLine, SizeOf(PCXLine), PCXWidth); + if found then begin + for X1 := 0 to PCXWidth-1 do + Buf^[(Height-1-line_count)*Width+X1] := PCXLine[X1]; + Inc (line_count); + end; + until (Not found) or (line_count = numlines); + CloseForBufferedRead (PCXFile, I); +end; + +destructor WoodSphere.Done; +begin + if IsLoaded then + FreeMem(Buf,Width*Height); + Sphere.Done; +end; + +function WoodSphere.GetPixel(x,y: Integer): Byte; +begin + if IsLoaded and (x > 0) and (y > 0) and + (x < Width) and (y < Height) then + GetPixel := Buf^[y*Width+x] + else + GetPixel := 0; +end; + +function WoodSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: Integer; +begin + r.ox := (aray.dx * time + aray.ox - xp + ra) / (ra*2); + r.oy := (aray.dy * time + aray.oy - yp + ra) / (ra*2); + r.oz := (aray.dz * time + aray.oz - zp + ra) / (ra*2); + c := GetPixel(Round(r.ox*(Width-1)),Round(r.oy*(Height-1))); + GetColor := GetRgb(c,c * 5 div 8,0); +end; + +function GraySphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: Byte; +begin + r.ox := (aray.dx * time + aray.ox - xp + ra) / (ra*2); + r.oy := (aray.dy * time + aray.oy - yp + ra) / (ra*2); + r.oz := (aray.dz * time + aray.oz - zp + ra) / (ra*2); + c := GetPixel(Round(r.ox*(Width-1)),Round(r.oy*(Height-1))); + GetColor := GetRgb(c,c,c); +end; + +constructor ColorSphere.Init(x,y,z,r: Real; cr,cg,cb: Byte); +begin + Sphere.Init(x,y,z,r); + rc := cr; gc := cg; bc := cb; +end; + +function ColorSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + rc; + cc.g := Integer(cc.g) div 2 + gc; + cc.b := Integer(cc.b) div 2 + bc; + GetColor := c; +end; + +function pplane.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +procedure TraceIt; +var + u: Universe; + p: Pplane; + wood: WoodSphere; + mimas,earth: GraySphere; +begin + u.Init(320,200); + p.Init (0,-8,0, 0,1,0); + wood.Init(-16,0,54,8, 'c:\brion\vga\wood2.pcx'); + mimas.Init(0,0,50,8, 'c:\brion\vga\mimas2.pcx'); + Earth.Init(16,0,54,8, 'c:\brion\vga\earth2.pcx'); + u.Insert(@wood); + u.Insert(@mimas); + u.Insert(@Earth); + u.Insert(@p); + Save(u,'brion5.tga'); + {Zoom(u);} + Beep; + wood.Done; + Mimas.Done; + Earth.Done; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/raypic.pas b/turbo-pascal/raypic.pas new file mode 100644 index 0000000..a43323c --- /dev/null +++ b/turbo-pascal/raypic.pas @@ -0,0 +1,272 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayTrace; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +type + GreenSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + RedSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WhiteSphere = object(Sphere) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Floor = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WallA = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + WallB = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + Ceiling = object(Plane) + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + +function Floor.GetColor(aray: RAY; time: real): LongInt; +var + x,y: Word; +begin + x := Word(Round(time * aray.dz + aray.oz)); + y := Word(Round(time * aray.dx + aray.ox)); + GetColor := GetRgb(0,128+((x mod 2)+(y mod 2))*42,0); +end; + +function Ceiling.GetColor(aray: RAY; time: real): LongInt; +var + x,y: Word; + c: Byte; +begin + x := Word(Round(time * aray.dz + aray.oz)); + y := Word(Round(time * aray.dx + aray.ox)); + c := 128+((x mod 2)+(y mod 2))*42; + GetColor := GetRgb(c,c,c); +end; + +function WallA.GetColor(aray: RAY; time: real): LongInt; +var + y: Word; + c: Byte; +begin + y := Word(Round(time * aray.dx + aray.ox)); + c := 128+(y mod 2)*42; + GetColor := GetRgb(c,c div 2,0); +end; + +function WallB.GetColor(aray: RAY; time: real): LongInt; +var + x: Word; + c: Byte; +begin + x := Word(Round(time * aray.dz + aray.oz)); + c := 128+(x mod 2)*42; + GetColor := GetRgb(c,c div 2,0); +end; + +function GreenSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function RedSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2; + cc.b := Integer(cc.b) div 2; + GetColor := c; +end; + +function WhiteSphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2 + 128; + cc.g := Integer(cc.g) div 2 + 128; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +procedure TraceIt; +var + u: Universe; + s: Sphere; + rs: RedSphere; + gs: GreenSphere; + ws: WhiteSphere; + fl: Floor; + cl: Ceiling; + w1,w4: WallA; + w2,w3: WallB; +begin + u.Init(320,200); + + s.Init(0,-8,30, 5); + rs.Init(-10,-8,40, 5); + gs.Init(10,-8,40, 5); + ws.Init(-3,2,50, 6); + + fl.Init(-8,0,0, 0,1,0.001); + cl.Init(8,0,0, 0,-1,0.001); + w1.Init(0,0,50, 0,0,-1); + w4.Init(0,0,-5, 0,0,1); + w2.Init(0,-100,0, 2,0.25,0.001); + w3.Init(0,-100,0, 2,-0.25,0.001); + u.Insert(@fl); + u.Insert(@cl); + u.Insert(@w1); + u.Insert(@w2); + u.Insert(@w3); + u.Insert(@w4); + u.Insert(@s); + u.Insert(@rs); + u.Insert(@gs); + u.Insert(@ws); + Draw(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + StartTga('brion1.tga'); + TraceIt; + EndTga; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rays.pas b/turbo-pascal/rays.pas new file mode 100644 index 0000000..95344fe --- /dev/null +++ b/turbo-pascal/rays.pas @@ -0,0 +1,201 @@ +program mmmmmmmmmmmmm; +{$X+} +uses Crt,Vga13h,RayShade; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of Byte; + tff: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(tff,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: Universe; st: String); +var + x,y: Integer; + c: LongInt; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.Height-1 do + for x := 0 to u.Width-1 do begin + c := u.TracePoint(x,y); + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x,u.Height-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: Universe); +var + x,y: Integer; + c: LongInt; +begin + x := 0; + while (x < u.Width) and (not KeyPressed) do begin + for y := 0 to u.Height-1 do begin + c := u.TracePoint(x,u.Height-1-y); + if c <> 0 then + RgbDot(x,y,(c and $ff0000) shr 16,(c and $ff00) shr 8,c and $ff); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: Universe); +var + x,y: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 2)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 2)-1 do begin + c := u.TracePoint(x*2,u.Height-1-(y*2)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Zoom(var u: Universe); +var + x,y,i,j: Integer; + c: LongInt; + r,g,b: Byte; +begin + x := 0; + while (x < (u.Width div 4)) and (not KeyPressed) do begin + for y := 0 to (u.Height div 4)-1 do begin + c := u.TracePoint(x*4,u.Height-1-(y*4)); + if c <> 0 then begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + + + +procedure TraceIt; +var + u: Universe; +begin + u.Init(320,200, 32,32,32); + Zoom(u); + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rayshade.pas b/turbo-pascal/rayshade.pas new file mode 100644 index 0000000..9d08f49 --- /dev/null +++ b/turbo-pascal/rayshade.pas @@ -0,0 +1,535 @@ +{ RAYTRACE.PAS } +{ Ray-tracing unit, generic. (with shading) } + +unit RayShade; + +interface +uses Objects; +{ Base objects on Turbo Vision's TObject to make them useable on + Turbo Vision streams. } + +type + VECTOR = object + dx, dy, dz: real; { Three dimensional vector } + end; + RAY = object + dx, dy, dz: real; { Direction vector } + ox, oy, oz: real; { Origin } + constructor Init (x, y, z, vx, vy, vz: real); + end; + + PObj3d = ^Obj3d; + PLightSource = ^LightSource; + PUniverse = ^Universe; + + LightSource = object(TObject) + Owner: PUniverse; + xp,yp,zp: Real; + br,bg,bb: Real; + constructor Init(x,y,z,r,g,b: Real); + end; + + Obj3d = object(TObject) + Owner: PUniverse; + xp,yp,zp: Real; + refl: Real; + constructor Init(x,y,z,r: Real); + function Intersect(aray: RAY): Real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + procedure ReflectRay(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + function Shade(aray: Ray; time: Real; c: LongInt): LongInt; virtual; + end; + PLANE = object(Obj3d) + nx, ny, nz: real; { Vector normal (perpendicular) to plane } + constructor Init(x, y, z, vx, vy, vz: real); + function Intersect(aray: RAY): real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: RAY; time: Real): LongInt; virtual; + end; + SPHERE = object(Obj3d) + ra,r2: real; { Radius squared } + constructor Init(x, y, z, r: real); + function Intersect(aray: RAY): real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + Cylinder = object(Obj3d) + { xp,yp,zp = center of bottom circle + x2,y2,z2 = center of top circle + ra = radius } + x2,y2,z2,ra,r2: Real; + constructor Init(x,y,z,xb,yb,zb,r: Real); + function Intersect(aray: RAY): real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + PlanePnt = object(Plane) + xb,yb,zb,xc,yc,zc: Real; + constructor Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + Universe = object(TObject) + Width,Height: Integer; + ar,ag,ab: Real; { Ambient lighting } + Items,Lights: TCollection; + constructor Init(aWidth,aHeight: Integer; r,g,b: Real); + destructor Done; virtual; + procedure Insert(o: PObj3d); + procedure Delete(o: PObj3d); + procedure InsertLight(l: PLightSource); + procedure DeleteLight(l: PLightSource); + procedure DeleteAll; + function RayColor(aray: Ray): LongInt; + function TraceRay(aray: Ray; var ob: PObj3d): Real; + function TracePoint(x,y: Integer): LongInt; + end; + + +{ LongInt: $00rrggbb } +procedure SepLong(c: LongInt; var r,g,b: Integer); +function GetRgb(r,g,b: Integer): LongInt; +function GetHsv(h,s,v: Integer): LongInt; +procedure Hsv2Rgb(h,s,v: Integer; var r,g,b: Integer); + +implementation + +procedure SepLong(c: LongInt; var r,g,b: Integer); +begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; +end; + +procedure Hsv2Rgb(h,s,v: Integer; var r,g,b: Integer); +var + rr,gg,bb,f,p1,p2,p3: Integer; +begin + while h > 359 do Dec(h,360); + while h < 0 do Inc(h,360); + if s < 0 then s := 0; + if s > 100 then s := 100; + if v < 0 then v := 0; + if v > 100 then v := 100; + + f := (h mod 60) * 5 div 3; + h := h div 60; + p1 := v*(100-s) div 625 * 16; + p2 := v*(100-(s*f div 100)) div 625 * 16; + p3 := v*(100-(s*(100-f) div 100)) div 625 * 16; + v := v * 64 div 25; + case h of + 0: begin r := v; g := p3; b := p1; end; + 1: begin r := p2; g := v; b := p1; end; + 2: begin r := p1; g := v; b := p3; end; + 3: begin r := p1; g := p2; b := v; end; + 4: begin r := p3; g := p1; b := v; end; + 5: begin r := v; g := p1; b := p2; end; + end; +end; + +function GetHsv(h,s,v: Integer): LongInt; +var r,g,b: Integer; +begin + Hsv2Rgb(h,s,v,r,g,b); + asm + mov al,byte ptr [b] + mov byte ptr [@Result],al + mov al,byte ptr [g] + mov byte ptr [@Result+1],al + mov al,byte ptr [r] + mov byte ptr [@Result+2],al + mov byte ptr [@Result+3],0 + end; +end; + +function GetRgb(r,g,b: Integer): LongInt; +begin + if r > 255 then r := 255; + if r < 0 then r := 0; + if g > 255 then g := 255; + if g < 0 then g := 0; + if b > 255 then b := 255; + if b < 0 then b := 0; + asm + mov al,byte ptr [b] + mov byte ptr [@Result],al + mov al,byte ptr [g] + mov byte ptr [@Result+1],al + mov al,byte ptr [r] + mov byte ptr [@Result+2],al + mov byte ptr [@Result+3],0 + end; +end; + +constructor LightSource.Init(x,y,z,r,g,b: Real); +begin + TObject.Init; + xp := x; yp := y; zp := z; + br := r; bg := g; bb := b; +end; + +constructor Obj3d.Init(x,y,z,r: Real); +begin + TObject.Init; + xp := x; yp := y; zp := z; refl := r; +end; + +function Obj3d.Intersect(aray: RAY): Real; +begin + { 0 or neg = no intersect } + Intersect := 0; +end; + +procedure Obj3d.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + { No intersect, will never get called here } +end; + +procedure Obj3d.ReflectRay(aray: RAY; time: real; var oray: RAY); +var + normal: Ray; { Used for readability } + ndotn: real; { Used for readability } + idotn: real; { Used for readability } + idotn_div_ndotn_x2: real; { Used for optimization } +begin + oray.ox := aray.dx * time + aray.ox; { Find the point of } + oray.oy := aray.dy * time + aray.oy; { intersection between } + oray.oz := aray.dz * time + aray.oz; { iray and sphere. } + SurfNormal(aray,time,normal); + + ndotn := (normal.dx * normal.dx + + normal.dy * normal.dy + + normal.dz * normal.dz); + idotn := (normal.dx * aray.dx + + normal.dy * aray.dy + + normal.dz * aray.dz); + idotn_div_ndotn_x2 := (2.0 * (idotn) / ndotn); + + oray.dx := aray.dx - idotn_div_ndotn_x2 * normal.dx; + oray.dy := aray.dy - idotn_div_ndotn_x2 * normal.dy; + oray.dz := aray.dz - idotn_div_ndotn_x2 * normal.dz; +end; + +function Obj3d.GetColor(aray: Ray; time: Real): LongInt; +begin + { See SurfNormal } +end; + +function Obj3d.Shade(aray: Ray; time: Real; c: LongInt): LongInt; +var + pl: PLightSource; + ob: PObj3d; + costheta,t,d,Ir,Ig,Ib: Real; + l,n: Ray; + i: Integer; + cc: record b,g,r: Byte end absolute c; +begin + l.ox := aray.dx*time+aray.ox; + l.oy := aray.dy*time+aray.oy; + l.oz := aray.dz*time+aray.oz; + SurfNormal(aray,time,n); + d := Sqrt(Sqr(n.dx)+Sqr(n.dy)+Sqr(n.dz)); + if d <> 0 then begin + n.dx := n.dx / d; + n.dy := n.dy / d; + n.dz := n.dz / d; + end; + Ir := refl * Owner^.ar; + Ig := refl * Owner^.ag; + Ib := refl * Owner^.ab; + for i := 0 to Owner^.Lights.Count-1 do begin + pl := PLightSource(Owner^.Lights.At(i)); + l.dx := pl^.xp-(time*aray.dx+aray.ox); + l.dy := pl^.yp-(time*aray.dy+aray.oy); + l.dz := pl^.zp-(time*aray.dz+aray.oz); + d := Sqrt(Sqr(l.dx)+Sqr(l.dy)+Sqr(l.dz)); + if d <> 0 then begin + l.dx := l.dx / d; + l.dy := l.dy / d; + l.dz := l.dz / d; + end; + costheta := (n.dx*l.dx + n.dy*l.dy + n.dz*l.dz); + t := Owner^.TraceRay(l,ob); + if (costheta > 0) and ((t >= d) or (t < 0.001)) then begin + Ir := Ir + ((refl * pl^.br) / (d + 0.001)) * costheta; + Ig := Ig + ((refl * pl^.bg) / (d + 0.001)) * costheta; + Ib := Ib + ((refl * pl^.bb) / (d + 0.001)) * costheta; + end; + end; + Shade := GetRgb( + Integer(cc.r)-128+Round(Ir), + Integer(cc.g)-128+Round(Ig), + Integer(cc.b)-128+Round(Ib)); +end; + + +constructor RAY.Init(x, y, z, vx, vy, vz: real); +begin + ox := x; + oy := y; + oz := z; + dx := vx; + dy := vy; + dz := vz; +end; { ----- End: RAY::RAY() ----- } + +constructor SPHERE.Init(x, y, z, r: real); +begin + Obj3d.Init(x,y,z,1); + ra := r; + r2 := r * r; +end; { ----- End: SPHERE::SPHERE() ----- } + +function SPHERE.Intersect(aray: RAY): real; +var + a, b, c, t1, t2, t3, close, farther: real; +begin + a := aray.dx * aray.dx + aray.dy * aray.dy + aray.dz * aray.dz; + close := -1.0; + farther := -1.0; + if a <> 0 then + begin + b := 2.0 * ((aray.ox - xp) * aray.dx + + (aray.oy - yp) * aray.dy + + (aray.oz - zp) * aray.dz); + c := (aray.ox - xp) * (aray.ox - xp) + + (aray.oy - yp) * (aray.oy - yp) + + (aray.oz - zp) * (aray.oz - zp) - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then + begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close := -(b + t2) / t3; + farther := -(b - t2) / t3; + end; + end; + if close < farther then Intersect := close else Intersect := farther; +{ Intersect := (double)((close < farther) ? close : farther);} +end; { ---- End: SPHERE::Intersect() ----- } + +procedure Sphere.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + oray.ox := aray.dx * time + aray.ox; { Find the point of } + oray.oy := aray.dy * time + aray.oy; { intersection between } + oray.oz := aray.dz * time + aray.oz; { aray and sphere. } + oray.dx := oray.ox - xp; { Find the ray normal } + oray.dy := oray.oy - yp; { to the sphere at the } + oray.dz := oray.oz - zp; { intersection point. } +end; + +function Sphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c,c2: LongInt; + cc: record b,g,r: Byte end absolute c; + cc2: record b,g,r: Byte end absolute c2; +begin + ReflectRay(aray,time,r); + c := Owner^.RayColor(r); + c2 := Shade(aray,time,GetRgb(0,0,128)); + cc.r := cc.r div 2 + cc2.r; + cc.g := cc.g div 2 + cc2.g; + cc.b := cc.b div 2 + cc2.b; + GetColor := c; +end; + +constructor PLANE.Init(x, y, z, vx, vy, vz: real); +begin + Obj3d.Init(x,y,z,0.9); + nx := vx; + ny := vy; + nz := vz; +end; { ----- End: PLANE::PLANE() ----- } + +function PlanePattern(x, y: word): LongInt; +var + r,g,b: Integer; +begin + r := (((x+y) mod 8))*32; + g := ((x mod 8) xor (y mod 8))*32; + b := (((x * x + y * y) mod 8))*32; + PlanePattern := GetRgb(r,g,b); +end; { ----- End: PlanePattern() ----- } + + +function PLANE.GetColor(aray: RAY; time: real): LongInt; +begin + GetColor := Shade(aray,time, + PlanePattern(Round(time * aray.dz + aray.oz), + Round(time * aray.dx + aray.ox))); +end; { ----- End: PLANE::Pattern() ----- } + +function PLANE.Intersect(aray: RAY): real; +var + p1, p2, p3: real; +begin + p1 := xp * nx + yp * ny + zp * nz; + p2 := aray.ox * nx + aray.oy * ny + aray.oz * nz; + p3 := aray.dx * nx + aray.dy * ny + aray.dz * nz; + if p3 = 0 then p3 := 0.001; + Intersect := (p1-p2)/p3; +end; { ----- End: PLANE::Intersect() ----- } + +procedure Plane.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + oray.dx := nx; oray.dy := ny; oray.dz := nz; +end; + +constructor Cylinder.Init(x,y,z,xb,yb,zb,r: Real); +begin + Obj3d.Init(x,y,z,0.9); + x2 := xb; y2 := yb; z2 := zb; + ra := r; r2 := Sqr(r); +end; + +function Cylinder.Intersect(aray: RAY): real; +begin + Intersect := 0; +end; + +procedure Cylinder.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin +end; + +function Cylinder.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := Shade(aray,time,$c0c0c0); +end; + +constructor PlanePnt.Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real); +var + a,b,c,d: Real; +begin + a := y1*(z2-z3)+y2*(z3-z1)+y3*(z1-z2); + b := z1*(x2-x3)+z2*(x3-x1)+z3*(x1-x2); + c := x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2); + d := -x1*(y2*z3-y3*z2)-x2*(y3*z1-y1*z3)-x3*(y1*z2-y2*z1); + Plane.Init(x1,y1,z1,a,b,c); + xb := x2; yb := y2; zb := z2; + xc := x3; yc := y3; zc := z3; +end; + +function PlanePnt.GetColor(aray: Ray; time: Real): LongInt; +var + d: Real; + c: Integer; +begin + {d := Sqrt( + Sqr(time * aray.dx + aray.ox - xp) + + Sqr(time * aray.dy + aray.oy - yp) + + Sqr(time * aray.dz + aray.oz - zp)); + if d > 255.0 then d := 255.0; + c := 255-Round(d); + if c < 96 then c := 96;} + GetColor := Shade(aray,time,$c0c0c0);{GetRgb(c,c,c)}; +end; + + +constructor Universe.Init(aWidth,aHeight: Integer; r,g,b: Real); +begin + TObject.Init; + Width := aWidth; Height := aHeight; + ar := r; ag := g; ab := b; + Items.Init(5,5); + Lights.Init(3,3); +end; + +destructor Universe.Done; +begin + Items.Done; + Lights.Done; + TObject.Done; +end; + +procedure Universe.Insert(o: PObj3d); +begin + Items.Insert(o); + o^.Owner := @Self; +end; + +procedure Universe.Delete(o: PObj3d); +begin + Items.Delete(o); + o^.Owner := nil; +end; + +procedure Universe.InsertLight(l: PLightSource); +begin + Lights.Insert(l); + l^.Owner := @Self; +end; + +procedure Universe.DeleteLight(l: PLightSource); +begin + Lights.Delete(l); + l^.Owner := nil; +end; + +procedure Universe.DeleteAll; +begin + Items.DeleteAll; + Lights.DeleteAll; +end; + +function Universe.RayColor(aray: Ray): LongInt; +var + t: Real; + o: PObj3d; +begin + t := TraceRay(aray,o); + if o = nil then + RayColor := 0 + else + RayColor := o^.GetColor(aray,t); +end; + +function Universe.TraceRay(aray: Ray; var ob: PObj3d): Real; +type + arr = array[0..1000] of Real; + parr = ^arr; +var + times: parr; + i,j: Integer; + max: Real; + procedure TraceOne(o: PObj3d); far; + begin + times^[i] := o^.Intersect(aray); + Inc(i); + end; +begin + GetMem(times,Items.Count*SizeOf(Real)); + i := 0; + Items.ForEach(@TraceOne); + max := 1.7e38; { darn big } + j := -1; + for i := 0 to Items.Count-1 do + if (times^[i] < max) and (times^[i] > 0.001) then begin + max := times^[i]; j := i; + end; + if j <> -1 then begin + ob := Items.At(j); + TraceRay := max; + end else begin + ob := nil; + TraceRay := 0; + end; + FreeMem(Times,Items.Count*SizeOf(Real)); +end; + +function Universe.TracePoint(x,y: Integer): LongInt; +var + r: Ray; +begin + r.ox := 0; r.oy := 0; r.oz := 0; + r.dx := (x - (Width / 2)) / Width; + r.dy := (y - (Height / 2)) / Height * 0.75; + r.dz := 1; + TracePoint := RayColor(r); +end; + +end. \ No newline at end of file diff --git a/turbo-pascal/rayt.pas b/turbo-pascal/rayt.pas new file mode 100644 index 0000000..756be22 --- /dev/null +++ b/turbo-pascal/rayt.pas @@ -0,0 +1,203 @@ +program RayTracingWithUltraRayTr; +{$X+} +uses Crt,Vga13h,RayTr; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of byte; + ttf: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(ttf,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: TUniverse; st: String); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.ScrHeight-1 do + for x := 0 to u.ScrWidth-1 do begin + u.TracePoint(x,y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,u.ScrHeight-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < u.ScrWidth) and (not KeyPressed) do begin + for y := 0 to u.ScrHeight-1 do begin + u.TracePoint(x,u.ScrHeight-1-y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,y,r,g,b); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 2)-1 do begin + u.TracePoint(x*2,u.ScrHeight-1-(y*2),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + Inc(x); + end; +end; + +procedure Zoom(var u: TUniverse); +var + x,y,i,j: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 4)-1 do begin + u.TracePoint(x*4,u.ScrHeight-1-(y*4),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + + + +procedure TraceIt; +var + u: TUniverse; +begin + u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0); + + Zoom(u); + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rayt1.pas b/turbo-pascal/rayt1.pas new file mode 100644 index 0000000..98f0106 --- /dev/null +++ b/turbo-pascal/rayt1.pas @@ -0,0 +1,240 @@ +program RayTracingWithUltraRayTr; +{$X+,N+} +uses Crt,Vga13h,RayTr; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of byte; + ttf: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(ttf,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: TUniverse; st: String); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.ScrHeight-1 do + for x := 0 to u.ScrWidth-1 do begin + u.TracePoint(x,y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,u.ScrHeight-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < u.ScrWidth) and (not KeyPressed) do begin + for y := 0 to u.ScrHeight-1 do begin + u.TracePoint(x,u.ScrHeight-1-y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,y,r,g,b); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 2)-1 do begin + u.TracePoint(x*2,u.ScrHeight-1-(y*2),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + Inc(x); + end; +end; + +procedure Zoom(var u: TUniverse); +var + x,y,i,j: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 4)-1 do begin + u.TracePoint(x*4,u.ScrHeight-1-(y*4),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + TSphere2 = object(TSphere) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + +procedure TSphere2.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TSphere.GetInfo(Ray,Inf); + MakeTrip(0.5,0.5,0.5,Inf.Opacity); + if not Inf.GoingIn then + MakeTrip(0,0,0,Inf.Reflectivity) + else + MakeTrip(0.05,0.05,0.05,Inf.Reflectivity); +end; + +procedure TraceIt; +var + u: TUniverse; + l1,l2,l3,l4: TLightSource; + s1,s3: TSphere; + s2: TSphere2; + p1: TPlane; +begin + u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0); + u.Specular := False; + u.ScaleBase := True; + + l1.Init(20,20,-200, 100,100,100); + l2.Init(-20,10,-150, 100,100,100); + l3.Init(3,100,60, 100,100,100); + u.InsertLight(@l1); + u.InsertLight(@l2); + u.InsertLight(@l3); + + s1.Init(-5,3,20,5); + s2.Init(5,1,25,4); + s3.Init(9.5,1.5,30,3); + p1.Init(0,-8,0, 0,1,0); + u.Insert(@s1); + u.Insert(@s2); + u.Insert(@s3); + u.Insert(@p1); + + {Save(u,'brion7.tga');} + Zoom(u); + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rayt2.pas b/turbo-pascal/rayt2.pas new file mode 100644 index 0000000..b94a2df --- /dev/null +++ b/turbo-pascal/rayt2.pas @@ -0,0 +1,255 @@ +program RayTracingWithUltraRayTr; +{$X+} +uses Crt,Vga13h,RayTr; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of byte; + ttf: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(ttf,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: TUniverse; st: String); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.ScrHeight-1 do + for x := 0 to u.ScrWidth-1 do begin + u.TracePoint(x,y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,u.ScrHeight-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < u.ScrWidth) and (not KeyPressed) do begin + for y := 0 to u.ScrHeight-1 do begin + u.TracePoint(x,u.ScrHeight-1-y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,y,r,g,b); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 2)-1 do begin + u.TracePoint(x*2,u.ScrHeight-1-(y*2),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + Inc(x); + end; +end; + +procedure Zoom(var u: TUniverse); +var + x,y,i,j: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 4)-1 do begin + u.TracePoint(x*4,u.ScrHeight-1-(y*4),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + TPlane1 = object(TPlane) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + + TransSphere = object(TSphere) + Col: RgbTriple; + constructor Init(x,y,z,rr,cr,cg,cb: Real); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + +procedure TPlane1.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TPlane.GetInfo(Ray,Inf); + MakeTrip(0,0,0,Inf.Reflectivity); +end; + +constructor TransSphere.Init(x,y,z,rr,cr,cg,cb: Real); +begin + TSphere.Init(x,y,z,rr); + MakeTrip(cr,cg,cb,Col); +end; + +procedure TransSphere.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TSphere.GetInfo(Ray,Inf); + MakeTrip(0,0,0,Inf.Reflectivity); + MakeTrip(1-Col.r,1-Col.g,1-Col.b,Inf.Opacity); + Inf.Color := Col; +end; + +procedure TraceIt; +var + u: TUniverse; + p1,p2: TPlane1; + l1,l2,l3: TLightSource; + s1,s2,s3: TransSphere; +begin + u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.5,0.5,0.5, 0,0,0); + + l1.Init(-8.5,3,50, 20,20,20); + l2.Init(0,3,65, 20,20,20); + l3.Init(8.5,3,50, 20,20,20); + u.InsertLight(@l1); + u.InsertLight(@l2); + u.InsertLight(@l3); + + s1.Init(-8.5,3,50,2, 1,0,0); + s2.Init(0,3,65,2, 0,1,0); + s3.Init(8.5,3,50,2, 0,0,1); + p1.Init(0,-8,0, 0,1,0); + p2.Init(0,15,0, 0,-1,0); + u.Insert(@p1); + u.Insert(@p2); + u.Insert(@s1); + u.Insert(@s2); + u.Insert(@s3); + + Save(u,'brion8.tga'); + {Zoom(u);} + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rayt3.pas b/turbo-pascal/rayt3.pas new file mode 100644 index 0000000..96b2378 --- /dev/null +++ b/turbo-pascal/rayt3.pas @@ -0,0 +1,350 @@ +program RayTracingWithUltraRayTr; +{$X+} +uses Crt,Vga13h,RayTr; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of byte; + ttf: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(ttf,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: TUniverse; st: String); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.ScrHeight-1 do + for x := 0 to u.ScrWidth-1 do begin + u.TracePoint(x,y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,u.ScrHeight-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < u.ScrWidth) and (not KeyPressed) do begin + for y := 0 to u.ScrHeight-1 do begin + u.TracePoint(x,u.ScrHeight-1-y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,y,r,g,b); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 2)-1 do begin + u.TracePoint(x*2,u.ScrHeight-1-(y*2),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + Inc(x); + end; +end; + +procedure Zoom(var u: TUniverse); +var + x,y,i,j: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 4)-1 do begin + u.TracePoint(x*4,u.ScrHeight-1-(y*4),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + TStraw = object(TCylinder) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TOrange = object(TSphere) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TJuiceBox = object(TObject3d) + Pos,Normal,Size: TPoint3d; + constructor Init(xa,ya,za,vx,vy,vz,sx,sy,sz: Real); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + +constructor TJuiceBox.Init(xa,ya,za,vx,vy,vz,sx,sy,sz: Real); +begin + TObject3d.Init; + Pos.SetTo(xa,ya,za); + Normal.SetTo(vx,vy,vz); + Normal.MakeUnit; + Size.SetTo(sx,sy,sz); +end; + +procedure TJuiceBox.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + r1: TRay; + times: array[1..8] of Real; { 6 more later } + ps: array[1..8] of TPoint3d; + p1,p2,p3: Real; + i,j: Integer; +begin + r1 := Ray; + r1.o.Sub(Pos); + r1.o.RotateFrom(Normal); + r1.d.RotateFrom(Normal); + { + p1 := Pos.x * Normal.x + Pos.y * Normal.y + Pos.z * Normal.z; + p2 := ray.o.x * Normal.x + ray.o.y * Normal.y + ray.o.z * Normal.z; + p3 := ray.d.x * Normal.x + ray.d.y * Normal.y + ray.d.z * Normal.z; + if p3 = 0 then p3 := 0.001; + Inf.Time := (p1-p2)/p3; + } + if r1.d.x = 0 then r1.d.x := 0.001; + times[1] := -r1.o.x/r1.d.x; + times[2] := -r1.o.y/r1.d.y; + times[3] := (Size.x-r1.o.x)/r1.d.x; + times[4] := (Size.y-r1.o.y)/r1.d.y; + times[5] := -r1.o.z/r1.d.z; + times[6] := -1; + times[7] := -1; + times[8] := ((Size.x/2)-r1.o.x)/r1.d.x; + for i := 1 to 8 do + ps[i].SetTo( + r1.o.x+r1.d.x*times[i], + r1.o.y+r1.d.y*times[i], + r1.o.z+r1.d.z*times[i]); + if (ps[1].y < 0) or (ps[1].y > Size.y) or + (ps[1].z < 0) or (ps[1].z > Size.z) then times[1] := -1; + if (ps[2].x < 0) or (ps[2].x > Size.x) or + (ps[2].z < 0) or (ps[2].z > Size.z) then times[2] := -1; + if (ps[3].y < 0) or (ps[1].y > Size.y) or + (ps[3].z < 0) or (ps[3].z > Size.z) then times[3] := -1; + if (ps[4].x < 0) or (ps[4].y > Size.x) or + (ps[4].z < 0) or (ps[4].z > Size.z) then times[4] := -1; + if (ps[5].x < 0) or (ps[5].x > Size.x) or + (ps[5].y < 0) or (ps[5].y > Size.y) then times[5] := -1; + if (ps[8].y < 0) or (ps[8].y > Size.y) or + (ps[8].z < (Size.z*0.95)) or (ps[8].z > Size.z) then times[8] := -1; + Inf.Time := MaxReal; + j := -1; + for i := 1 to 8 do + if (times[i] < Inf.Time) and (times[i] > 0.001) then begin + Inf.Time := times[i]; + j := i; + end; + Inf.Hit := (j <> -1); + if not Inf.Hit then Exit; + Inf.Pos.SetTo( + Ray.o.x+Ray.d.x*Inf.Time, + Ray.o.y+Ray.d.y*Inf.Time, + Ray.o.z+Ray.d.z*Inf.Time); + case j of + 1: Inf.Normal.SetTo(-1,0,0); + 2: Inf.Normal.SetTo(0,-1,0); + 3: Inf.Normal.SetTo(1,0,0); + 4: Inf.Normal.SetTo(0,1,0); + 5: Inf.Normal.SetTo(0,0,-1); + 6: ; + 7: ; + 8: if r1.d.x > 0 then + Inf.Normal.SetTo(-1,0,0) + else + Inf.Normal.SetTo(1,0,0); + end; + Inf.Normal.RotateTo(Normal); + MakeTrip(0.6,0.6,0.6,Inf.Color); + MakeTrip(1,1,1,Inf.Opacity); + MakeTrip(0,0,0,Inf.Reflectivity); + Inf.SpecularN := 50; + Inf.Brightness := 1; + Inf.GoingIn := True; + Inf.IndexRefraction := 0.95; +end; + +procedure TStraw.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TCylinder.GetInfo(Ray,Inf); + if not Inf.Hit then Exit; + MakeTrip(0.9,0.9,0.9,Inf.Color); +end; + +procedure TOrange.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + p1: TPoint3d; +begin + TSphere.GetInfo(Ray,Inf); + if not Inf.Hit then Exit; + MakeTrip(0,0,0,Inf.Reflectivity); + MakeTrip(0.9,0.6,0,Inf.Color); + p1 := Inf.Pos; p1.Sub(Pos); + RandSeed := + (Word(Round(ArcTan(p1.x/p1.y)*255/pi)) shl 8) or + Round(ArcTan(p1.z/p1.y)*255/pi); + with Inf.Normal do begin + x := x + ((Random(200)-100)/100000); + y := y + ((Random(200)-100)/100000); + z := z + ((Random(200)-100)/100000); + end; +end; + +procedure TraceIt; +var + u: TUniverse; + l1: TLightSource; + p1: TPlane; + c1: TStraw; + s1: TOrange; + b1: TJuiceBox; +begin + u.Init(320,200,10, 0,0,0, 0,0,1, 0,1,0, 1, 40,30, 0.5,0.5,0.5, 0,0,0); + u.Reflection := False; + u.Shading := False; + + l1.Init(20,20,-50, 50,50,50); + u.InsertLight(@l1); + + p1.Init(0,-8,0, 0,1,0); + s1.Init(4,-1,30, 7); + c1.Init(4,-1,30, 0.75,1,-1.25, 0.75,12,0); + b1.Init(-20,-8,40, 0,1,0, 10,10,20); + u.Insert(@p1); + u.Insert(@s1); + u.Insert(@c1); + u.Insert(@b1); + + Zoom(u); + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rayt4.pas b/turbo-pascal/rayt4.pas new file mode 100644 index 0000000..a94974d --- /dev/null +++ b/turbo-pascal/rayt4.pas @@ -0,0 +1,302 @@ +program RayTracingWithUltraRayTr; +{$X+} +uses Crt,Vga13h,RayTr; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of byte; + ttf: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(ttf,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: TUniverse; st: String); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.ScrHeight-1 do + for x := 0 to u.ScrWidth-1 do begin + u.TracePoint(x,y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,u.ScrHeight-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < u.ScrWidth) and (not KeyPressed) do begin + for y := 0 to u.ScrHeight-1 do begin + u.TracePoint(x,u.ScrHeight-1-y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,y,r,g,b); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 2)-1 do begin + u.TracePoint(x*2,u.ScrHeight-1-(y*2),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + Inc(x); + end; +end; + +procedure Zoom(var u: TUniverse); +var + x,y,i,j: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 4)-1 do begin + u.TracePoint(x*4,u.ScrHeight-1-(y*4),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +type + TSphere2 = object(TSphere) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TPlane2 = object(TPlane) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + +procedure TSphere2.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + a, b, c, t1, t2, t3, close, farther: real; + p1,p2: TPoint3d; +begin + a := ray.d.x * ray.d.x + ray.d.y * ray.d.y + ray.d.z * ray.d.z; + close := -1.0; + farther := -1.0; + if a <> 0 then begin + b := 2.0 * ((ray.o.x - Pos.x) * ray.d.x + + (ray.o.y - Pos.y) * ray.d.y + + (ray.o.z - Pos.z) * ray.d.z); + c := (ray.o.x - Pos.x) * (ray.o.x - Pos.x) + + (ray.o.y - Pos.y) * (ray.o.y - Pos.y) + + (ray.o.z - Pos.z) * (ray.o.z - Pos.z) - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close := -(b + t2) / t3; + farther := -(b - t2) / t3; + end; + end; + p1.SetTo( + ray.o.x+ray.d.x*close, + ray.o.y+ray.d.y*close, + ray.o.z+ray.d.z*close); + p2.SetTo( + ray.o.x+ray.d.x*farther, + ray.o.y+ray.d.y*farther, + ray.o.z+ray.d.z*farther); + if (p1.z-Pos.z) < -(r * 0.85) then close := -1; + if (p2.z-Pos.z) < -(r * 0.85) then farther := -1; + if (close <= 0.001) and (farther > 0.001) then begin + Inf.Time := farther; Inf.GoingIn := False; + end else + if (close > 0.001) and (farther <= 0.001) then begin + Inf.Time := close; Inf.GoingIn := False; + end else begin + Inf.GoingIn := True; + if close < farther then + Inf.Time := close + else + Inf.Time := farther; + end; + Inf.Hit := (Inf.Time > 0.001); + if not Inf.Hit then Exit; + Inf.Pos.SetTo( + ray.o.x+ray.d.x*Inf.Time, + ray.o.y+ray.d.y*Inf.Time, + ray.o.z+ray.d.z*Inf.Time); + Inf.Normal := Inf.Pos; + Inf.Normal.Sub(Pos); + if not Inf.GoingIn then Inf.Normal.Scale(-1); + Inf.Brightness := 1; + Inf.IndexRefraction := 0.95; + MakeTrip(1,1,1,Inf.Opacity); + MakeTrip(0,0,0,Inf.Reflectivity); + Inf.SpecularN := 200; + MakeTrip(0.8,0.8,0.8,Inf.Color); +end; + +procedure TPlane2.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TPlane.GetInfo(Ray,Inf); + MakeTrip(0,0,0,Inf.Reflectivity); + Inf.SpecularN := 1; + MakeTrip(0.9,0.9,0.9,Inf.Color); +end; + +procedure TraceIt; +var + u: TUniverse; + l1,l2: TLightSource; + p1: TPlane2; + s1: TSphere2; + s2,s3,s4: TSphere; +begin + u.Init(320,200,10, 0,1,0, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0); + u.Specular := False; + + l1.Init(0,-1.7,25, 500,500,500); + l2.Init(20,60,20, 30,30,30); + u.InsertLight(@l1); + u.InsertLight(@l2); + + p1.Init(0,-2,0, 0,1,0); + s1.Init(0,2,25,10); + s2.Init(0,-1,15,1); + s3.Init(-2.25,-1,15.5,1); + s4.Init(2.25,-1,15.5,1); + u.Insert(@p1); + u.Insert(@s1); + u.Insert(@s2); + u.Insert(@s3); + u.Insert(@s4); + + {Zoom(u);} + Save(u,'brion9.tga'); + Beep; + u.DeleteAll; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); +end. \ No newline at end of file diff --git a/turbo-pascal/rayt5.pas b/turbo-pascal/rayt5.pas new file mode 100644 index 0000000..01594ee --- /dev/null +++ b/turbo-pascal/rayt5.pas @@ -0,0 +1,413 @@ +program RayTracingWithUltraRayTr; +{$X+} +uses Crt,Vga13h,RayTr,Dos; + +type + TgaHeader = record { 18 bytes total } + who_knows: array[1..12] of Byte; + Width: Word; + Height: Word; + BitsPerPixel: Byte; + who_knows2: Byte; + end; + +const + DefaultHeader: TgaHeader = ( + who_knows: (0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0); + Width: 320; + Height: 200; + BitsPerPixel: 24; + who_knows2: 32 + ); + +var + tf: File of byte; + ttf: File absolute tf; + +procedure StartTga(s: String); +begin + Assign(tf,s); + Rewrite(tf); + BlockWrite(ttf,DefaultHeader,18); +end; + +procedure EndTga; +begin + Close(tf); +end; + +procedure TgaDot(r,g,b: Integer); +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Write(tf,Byte(b),Byte(g),Byte(r)); +end; + +{ r,g,b:0-255 } +function Rgb(r,g,b: Integer): Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + Rgb := (b shr 6) or ((g shr 3) and $1c) or (r and $e0); +end; + +procedure RgbDot(x,y,r,g,b: Integer); +var + r1,g1,b1,r2,g2,b2,c1,c2: Integer; +begin + if r > 255 then r := 255; + if g > 255 then g := 255; + if b > 255 then b := 255; + if r < 0 then r := 0; + if g < 0 then g := 0; + if b < 0 then b := 0; + r1 := r and $e0; g1 := g and $e0; b1 := b and $c0; + r2 := r1 + (r mod 32)+16; + g2 := g1 + (g mod 32)+16; + b2 := b1 + (b mod 64)+32; + c1 := Rgb(r1,g1,b1); c2 := Rgb(r2,g2,b2); + if (x mod 2) = (y mod 2) then PutPixel(x,y,c1) else PutPixel(x,y,c2); +end; + +procedure SetUpRgb; +var + Clrs: array[0..255,0..2] of Byte; + i: Integer; +begin + for i := 0 to 255 do begin + Clrs[i,0] := (i and $e0) shr 2; + Clrs[i,1] := (i and $1c) shl 1; + Clrs[i,2] := (i and 3) shl 4; + case Clrs[i,2] of + 15..31: Inc(Clrs[i,2],4); + 32..63: Inc(Clrs[i,2],8); + end; + end; + SetColorBlock(0,256,Clrs); +end; + +procedure Save(var u: TUniverse; st: String); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + StartTga(st); + x := 0; + for y := 0 to u.ScrHeight-1 do + for x := 0 to u.ScrWidth-1 do begin + u.TracePoint(x,y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,u.ScrHeight-1-y,r,g,b); + TgaDot(r,g,b); + end; + EndTga; +end; + +procedure Draw(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < u.ScrWidth) and (not KeyPressed) do begin + for y := 0 to u.ScrHeight-1 do begin + u.TracePoint(x,u.ScrHeight-1-y,c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x,y,r,g,b); + end; + Inc(x); + end; +end; + +procedure Qwik(var u: TUniverse); +var + x,y: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 2)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 2)-1 do begin + u.TracePoint(x*2,u.ScrHeight-1-(y*2),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + RgbDot(x*2,y*2,r,g,b); RgbDot(x*2+1,y*2,r,g,b); + RgbDot(x*2+1,y*2+1,r,g,b); RgbDot(x*2,y*2+1,r,g,b); + end; + Inc(x); + end; +end; + +procedure Zoom(var u: TUniverse); +var + x,y,i,j: Integer; + c: RgbTriple; + r,g,b: Integer; +begin + x := 0; + while (x < (u.ScrWidth div 4)) and (not KeyPressed) do begin + for y := 0 to (u.ScrHeight div 4)-1 do begin + u.TracePoint(x*4,u.ScrHeight-1-(y*4),c); + r := Trunc(c.r*255); + g := Trunc(c.g*255); + b := Trunc(c.b*255); + for i := 0 to 3 do + for j := 0 to 3 do + RgbDot(x*4+i,y*4+j,r,g,b); + end; + Inc(x); + end; +end; + +procedure Beep; +begin + Sound(220); { Beep } + Delay(200); { For 200 ms } + NoSound; { Relief! } +end; + +var + Hour1,Minute1,Second1,Sec1001, + Hour2,Minute2,Second2,Sec1002: Word; + +procedure StartTime; +begin + GetTime(Hour1, Minute1, Second1, Sec1001); +end; + +procedure EndTime; +begin + GetTime(Hour2, Minute2, Second2, Sec1002); +end; + +function LeadingZero(w : Word) : String; +var + s : String; +begin + Str(w:0,s); + if Length(s) = 1 then + s := '0' + s; + LeadingZero := s; +end; + +procedure ShowTime; +var + time1,time2,time3: Word; +begin + Writeln('Starting time: ',Hour1,':',LeadingZero(Minute1)); + Writeln('Ending time: ',Hour2,':',LeadingZero(Minute2)); + time1 := Hour1*60+Minute1; + time2 := Hour2*60+Minute2; + time3 := time2-time1; + Writeln('Total time: ',time3 div 60,':',LeadingZero(time3 mod 60)); +end; + +type + PPillar = ^TCylinder; + PFloor = ^TFloor; + PCeiling = ^TCeiling; + PMirrorSphere = ^TMirrorSphere; + PPitInside = ^TPitInside; + PBonfire = ^TBonfire; + PFireCyl = ^TFireCyl; + + TPitInside = object(TCylinder) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TFloor = object(TPlane) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TCeiling = object(TPlane) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TMirrorSphere = object(TObject3d) + Pos: TPoint3d; + r: Float; + constructor Init(x,y,z,ra: Float); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TBonfire = object(TSphere) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TFireCyl = object(TCylinder) + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + +procedure TFloor.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + d1,d2,d3: Float; +begin + TPlane.GetInfo(Ray,Inf); + if not Inf.Hit then Exit; + d1 := Sqrt(Sqr(Inf.Pos.x)+Sqr(Inf.Pos.y)+Sqr(Inf.Pos.z-4)); + d2 := Sqrt(Sqr(Inf.Pos.x-3)+Sqr(Inf.Pos.y)+Sqr(Inf.Pos.z+7)); + d3 := Sqrt(Sqr(Inf.Pos.x+3)+Sqr(Inf.Pos.y)+Sqr(Inf.Pos.z+7)); + if ((d1 > 3) and (d1 < 5) and + ((Inf.Pos.z > 4) or ((Inf.Pos.x < -1) or (Inf.Pos.x > 1)))) or + (d2 < 2) or (d3 < 2) then + Inf.Hit := False; + MakeTrip(0,0,0,Inf.Reflectivity); +end; + +procedure TCeiling.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TPlane.GetInfo(Ray,Inf); + MakeTrip(0,0,0,Inf.Reflectivity); + if (Inf.Pos.x < -9) or (Inf.Pos.x > 9) or + (Inf.Pos.z < -10) or (Inf.Pos.z > 10) then + Inf.Hit := False; +end; + +constructor TMirrorSphere.Init(x,y,z,ra: Float); +begin + TObject3d.Init; + Pos.SetTo(x,y,z); + r := ra; +end; + +procedure TMirrorSphere.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + c,f: Float; + p1,p2: TPoint3d; +begin + GetSphereInfo(Ray,Pos,r,c,f); + p1.SetTo( + Ray.o.x+Ray.d.x*c, + Ray.o.y+Ray.d.y*c, + Ray.o.z+Ray.d.z*c); + p2.SetTo( + Ray.o.x+Ray.d.x*f, + Ray.o.y+Ray.d.y*f, + Ray.o.z+Ray.d.z*f); + if (p1.z < Pos.z) or (p1.y < Pos.y) then c := -1; + if (p2.z < Pos.z) or (p2.y < Pos.y) then f := -1; + Inf.Hit := (c > 0.001) or (f > 0.001); + if not Inf.Hit then Exit; + Inf.Time := MaxReal; + if c > 0.001 then Inf.Time := c; + if (f < Inf.Time) and (f > 0.001) then Inf.Time := f; + if Inf.Time = c then Inf.Pos := p1 else Inf.Pos := p2; + Inf.Normal := Inf.Pos; + Inf.Normal.Sub(Pos); + Inf.GoingIn := (Inf.Normal.Dot(Ray.d)) < 0; + if not Inf.GoingIn then begin + Inf.Normal.Scale(-1); + MakeTrip(0.75,0.75,0.75,Inf.Reflectivity); + MakeTrip(0.25,0.25,0.25,Inf.Color); + Inf.SpecularN := 200; + end else begin + MakeTrip(0,0,0,Inf.Reflectivity); + MakeTrip(0.5,0.5,0.5,Inf.Color); + Inf.SpecularN := 1; + end; + Inf.Brightness := 1; + MakeTrip(1,1,1,Inf.Opacity); +end; + +procedure TBonfire.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + z: Float; +begin + TSphere.GetInfo(Ray,Inf); + if not Inf.Hit then Exit; + MakeTrip(0,0,0,Inf.Reflectivity); + Inf.SpecularN := 50; + if Inf.Pos.y < Pos.y then begin + MakeTrip(1,1,1,Inf.Opacity); + MakeTrip(0.8,0.8,0.8,Inf.Color); + Inf.Brightness := 1; + end else begin + MakeTrip(0,0,0,Inf.Opacity); + z := 1-((Inf.Pos.y-Pos.y)/r); + MakeTrip(z,z*0.667,0,Inf.Color); + Inf.Brightness := 0.3; + end; + Inf.IndexRefraction := 1; +end; + +procedure TFireCyl.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + t,z: Float; + r1: TRay; +begin + TCylinder.GetInfo(Ray,Inf); + if not Inf.Hit then Exit; + Inf.Hit := ((Inf.Pos.z > 4) or ((Inf.Pos.x < -1) or (Inf.Pos.x > 1))); + if not Inf.Hit then begin + r1.o := Inf.Pos; + r1.d := Ray.d; + t := Inf.Time; + GetInfo(r1,Inf); + Inf.Time := Inf.Time + t; + end else begin + MakeTrip(0,0,0,Inf.Opacity); + z := 1-((Inf.Pos.y-Pos.y)/h); + MakeTrip(z,z*0.667,0,Inf.Color); + Inf.Brightness := 0.5; + Inf.IndexRefraction := 1; + end; +end; + +procedure TPitInside.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + TCylinder.GetInfo(Ray,Inf); + MakeTrip(0.8,0.8,0.8,Inf.Opacity); +end; + +procedure TraceIt; +var + u: TUniverse; + l: PLightSource; + o: PObject3d; + i,j: Integer; +begin + u.Init(320,200,10, 0,5,-20, 0,0,1, 0,1,0, 1, 40,30, 0.2,0.2,0.2, 0,0,0); + u.Specular := False; + + u.InsertLight(New(PLightSource,Init(-3,0,-7, 6,4,0))); + u.InsertLight(New(PLightSource,Init(3,0,-7, 6,4,0))); + u.InsertLight(New(PLightSource,Init(75,50,100, 100,100,100))); + u.InsertLight(New(PLightSource,Init(0,-20,4, 600,400,0))); + u.Insert(New(PFloor,Init(0,0,0, 0,1,0))); + u.Insert(New(PCeiling,Init(0,10,0, 0,1,0))); + u.Insert(New(PMirrorSphere,Init(0,0,4, 3))); + u.Insert(New(PBonfire,Init(-3,0,-7, 2))); + u.Insert(New(PBonfire,Init(3,0,-7, 2))); + u.Insert(New(PPitInside,Init(0,0,4, 0,-1,0, 3,10,0))); + u.Insert(New(PPitInside,Init(0,0,4, 0,-1,0, 5,10,0))); + u.Insert(New(PFireCyl,Init(0,-2,4, 0,1,0, 4,12,0))); + for i := -2 to 2 do begin + u.Insert(New(PPillar,Init(-7,0,i*4, 0,1,0, 1,10,0))); + u.Insert(New(PPillar,Init(7,0,i*4, 0,1,0, 1,10,0))); + end; + Draw(u); + {StartTime; + Save(u,'brion10.tga'); + EndTime;} + Beep; + u.Done; +end; + +begin + Set13h; + SetUpRgb; + TraceIt; + ReadKey; + BiosMode(3); + ShowTime; +end. \ No newline at end of file diff --git a/turbo-pascal/raytr.pas b/turbo-pascal/raytr.pas new file mode 100644 index 0000000..538e617 --- /dev/null +++ b/turbo-pascal/raytr.pas @@ -0,0 +1,980 @@ +unit RayTr; +{ Everything-independent super ultra ray-tracing + by Brion Vibber, 12-13-92, based on lots of stuff + last revised 12-25-92, unless I forget to change this line. + 12-25-92: set for Floats +} +interface + +{$N+} + +uses Objects; { For TCollection, a super-useful thingy } + +type + Float = Double; +const + MinReal = 5.0e-324; + MaxReal = 1.7e308; + +type + PUniverse = ^TUniverse; + PObject3d = ^TObject3d; + PLightSource = ^TLightSource; + PPoint3d = ^TPoint3d; + PRayInfo = ^TRayInfo; + {PPolygon3d = ^TPolygon3d;} + {PPolygonList = ^TPolygonList;} + + TPoint3d = object + x,y,z: Float; + procedure SetTo(ax,ay,az: Float); + procedure MakeUnit; + procedure Cross(v: TPoint3d); + function Dot(v: TPoint3d): Float; + procedure Add(v: TPoint3d); + procedure Sub(v: TPoint3d); + procedure Scale(s: Float); + function Length: Float; + procedure RotateFrom(v: TPoint3d); + procedure RotateTo(v: TPoint3d); + end; + TRay = record + case Integer of + 0: (Origin, Direction: TPoint3d); + 1: (o,d: TPoint3d); { Shorthand versions } + 2: (a,b: TPoint3d); { " " " " } + end; + RgbTriple = record + r,g,b: Float; { 0 - 1 } + end; + TRayInfo = record + Hit: Boolean; + Time: Float; + GoingIn: Boolean; + Pos,Normal: TPoint3d; + Reflectivity,Opacity,Color: RgbTriple; + Brightness: Float; { 0 - 1 } + SpecularN,IndexRefraction: Float; + end; + + TObject3d = object(TObject) + Owner: PUniverse; + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + function SpecularW(Angle: Float): Float; virtual; + end; + TLightSource = object(TObject) + Pos: TPoint3d; + Color: RgbTriple; + constructor Init(x,y,z,r,g,b: Float); + end; + + TUniverse = object(TObject) + Shading,Shadows,Specular,Transparency,Reflection,ScaleBase: Boolean; + ScrWidth,ScrHeight: Integer; + Eye,Gaze,Up,vX,vY,vU,vV,vH,vM: TPoint3d; + DistScreen,AngleHoriz,AngleVert: Float; { Use degrees } + BackColor,Ambient: RgbTriple; + ReflectCount,MaxReflect: Integer; + Items,Lights: TCollection; + constructor Init(aScrWidth,aScrHeight,aMaxReflect: Integer; + anEyeX,anEyeY,anEyeZ, + aGazeX,aGazeY,aGazeZ,anUpX,anUpY,anUpZ,aDistScreen, + anAngleHoriz,anAngleVert,anAmbientR,anAmbientG,anAmbientB, + aBackR,aBackG,aBackB: Float); + destructor Done; virtual; + procedure TraceRay(Ray: TRay; var Col: RgbTriple); + procedure TracePoint(x,y: Integer; var Col: RgbTriple); + procedure Insert(Item: PObject3d); + procedure Delete(Item: PObject3d); + procedure InsertLight(Item: PLightSource); + procedure DeleteLight(Item: PLightSource); + procedure DeleteAllObjects; + procedure DeleteAllLights; + procedure DeleteAll; + procedure FreeAllObjects; + procedure FreeAllLights; + procedure FreeAll; + end; + + PSphere = ^TSphere; + PPlane = ^TPlane; + PPlanePts = ^TPlanePts; + PCylinder = ^TCylinder; + PCone = ^TCone; + + TSphere = object(TObject3d) + Pos: TPoint3d; + r,r2: Float; + constructor Init(xa,ya,za,ra: Float); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TPlane = object(TObject3d) + Pos,Normal: TPoint3d; + constructor Init(xa,ya,za,vx,vy,vz: Float); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TPlanePts = object(TPlane) + constructor Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Float); + end; + TCylinder = object(TObject3d) + Pos,Normal: TPoint3d; + r,r2,h: Float; + Ends: ShortInt; { 0 = no, 1 = bottom, 2 = top, 3 = both } + constructor Init(xa,ya,za,vx,vy,vz,ra,ha: Float; aends: ShortInt); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + TCone = object(TObject3d) + Pos,Normal: TPoint3d; + ra,rb,ra2,rb2,h,th: Float; + Ends: ShortInt; { 0 = no, 1 = bottom, 2 = top, 3 = both } + constructor Init(xa,ya,za,vx,vy,vz,ra1,rb1,ha: Float; aends: ShortInt); + procedure GetInfo(Ray: TRay; var Inf: TRayInfo); virtual; + end; + +procedure GetSphereInfo(Ray: TRay; Pos: TPoint3d; r: Float; var close,farther: Float); +procedure GetCylinderInfo(Ray: TRay; Pos,Normal: TPoint3d; r,h: Float; ends: ShortInt; + var close,farther,end1,end2: Float); +procedure GetConeInfo(Ray: TRay; Pos,Normal: TPoint3d; ra,rb,h: Float; ends: ShortInt; + var close,farther,end1,end2: Float); +procedure GetPlaneInfo(Ray: TRay; Pos,Normal: TPoint3d; var time: Float); + +procedure MakeTrip(r,g,b: Float; var c: RgbTriple); +function Power(x,y: Float): Float; +function Log(x,y: Float): Float; +function ArcSin(x: Float): Float; +function ArcCos(x: Float): Float; +function Tan(x: Float): Float; + +implementation + +procedure MakeTrip(r,g,b: Float; var c: RgbTriple); +begin + c.r := r; c.g := g; c.b := b; +end; + +function Power(x,y: Float): Float; +var + i: Integer; + x1: Float; +begin + {Power := Exp(y * Ln(x));} + x1 := x; + for i := 1 to Trunc(y)-1 do + x1 := x1 * x; + Power := x; +end; + +function Log(x,y: Float): Float; +begin + Log := Ln(x) / Ln(y); +end; + +function ArcSin(x: Float): Float; +begin + ArcSin := ArcTan(x / Sqrt(1 - (x*x))); +end; + +function ArcCos(x: Float): Float; +begin + ArcCos := ArcTan(Sqrt(1 - Sqr(x)) / x); +end; + +function Tan(x: Float): Float; +begin + Tan := Sin(x) / Cos(x); +end; + +procedure TPoint3d.SetTo(ax,ay,az: Float); +begin + x := ax; y := ay; z := az; +end; + +procedure TPoint3d.MakeUnit; +var + d: Float; +begin + d := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)); + if d <> 0 then begin + x := x / d; + y := y / d; + z := z / d; + end; +end; + +procedure TPoint3d.Cross(v: TPoint3d); +var + xa,ya: Float; +begin + xa := y*v.z - z*v.y; + ya := z*v.x - x*v.z; + z := x*v.y - y*v.x; + x := xa; y := ya; +end; + +function TPoint3d.Dot(v: TPoint3d): Float; +begin + Dot := x*v.x + y*v.y + z*v.z; +end; + +procedure TPoint3d.Add(v: TPoint3d); +begin + x := x + v.x; + y := y + v.y; + z := z + v.z; +end; + +procedure TPoint3d.Sub(v: TPoint3d); +begin + x := x - v.x; + y := y - v.y; + z := z - v.z; +end; + +procedure TPoint3d.Scale(s: Float); +begin + x := x * s; + y := y * s; + z := z * s; +end; + +function TPoint3d.Length: Float; +begin + Length := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)); +end; + +procedure TPoint3d.RotateFrom(v: TPoint3d); +var + d,xa,ya,za,cos1,sin1: Float; +begin + v.MakeUnit; + d := Sqrt(Sqr(v.y)+Sqr(v.z)); + cos1 := v.z/d; sin1 := v.y/d; + ya := y*cos1-z*sin1; z := y*sin1+z*cos1; y := ya; + cos1 := d; sin1 := -v.x; + za := z*cos1-x*sin1; x := z*sin1+x*cos1; z := za; +end; + +procedure TPoint3d.RotateTo(v: TPoint3d); +var + d,xa,ya,za,cos1,sin1: Float; +begin + v.MakeUnit; + d := Sqrt(Sqr(v.y)+Sqr(v.z)); + cos1 := -v.z/d; sin1 := -v.y/d; + ya := y*cos1-z*sin1; z := y*sin1+z*cos1; y := ya; + cos1 := -d; sin1 := v.x; + za := z*cos1-x*sin1; x := z*sin1+x*cos1; z := za; +end; + + +procedure TObject3d.GetInfo(Ray: TRay; var Inf: TRayInfo); +begin + Inf.Hit := False; +end; + +function TObject3d.SpecularW(Angle: Float): Float; +begin + SpecularW := Angle / 90; +end; + + +constructor TLightSource.Init(x,y,z,r,g,b: Float); +begin + TObject.Init; + Pos.x := x; Pos.y := y; Pos.z := z; + Color.r := r; Color.g := g; Color.b := b; +end; + +constructor TUniverse.Init(aScrWidth,aScrHeight,aMaxReflect: Integer; + anEyeX,anEyeY,anEyeZ, + aGazeX,aGazeY,aGazeZ,anUpX,anUpY,anUpZ,aDistScreen, + anAngleHoriz,anAngleVert,anAmbientR,anAmbientG,anAmbientB, + aBackR,aBackG,aBackB: Float); +begin + TObject.Init; + Items.Init(5,5); + Lights.Init(5,5); + Shading := True; Shadows := True; Specular := True; + Transparency := True; Reflection := True; ScaleBase := False; + ScrWidth := aScrWidth; ScrHeight := aScrHeight; + MaxReflect := aMaxReflect; + Eye.x := anEyeX; Eye.y := anEyeY; Eye.z := anEyeZ; + Gaze.x := aGazeX; Gaze.y := aGazeY; Gaze.z := aGazeZ; + Up.x := anUpX; Up.y := anUpY; Up.z := anUpZ; + DistScreen := aDistScreen; + AngleHoriz := anAngleHoriz; AngleVert := anAngleVert; + Ambient.r := anAmbientR; Ambient.g := anAmbientG; Ambient.b := anAmbientB; + MakeTrip(aBackR,aBackG,aBackB,BackColor); + Gaze.MakeUnit; + Up.MakeUnit; + vX := Gaze; vX.Cross(Up); vX.MakeUnit; + vY := vX; vY.Cross(Gaze); vY.MakeUnit; + vM := Gaze; vM.Scale(DistScreen); vM.Add(Eye); + vH := vX; vH.Scale(DistScreen*Tan(AngleHoriz*pi/180)); + vV := vY; vV.Scale(DistScreen*Tan(AngleVert*pi/180)); +end; + +destructor TUniverse.Done; +begin + Items.Done; + Lights.Done; + TObject.Done; +end; + +procedure TUniverse.TraceRay(Ray: TRay; var Col: RgbTriple); +type + InfAr = array[0..(65520 div SizeOf(TRayInfo))-1] of TRayInfo; +var + Inf: ^InfAr; + Info: TRayInfo; + i,j,k,l: Integer; + c,lc: RgbTriple; + ra,Min,cosTheta,ir,ig,ib,d: Float; + ndotn, idotn, idotn_div_ndotn_x2: Float; + li,v1,v2: TPoint3d; + r: TRay; +begin + GetMem(Inf,Items.Count * SizeOf(TRayInfo)); + Ray.d.MakeUnit; + for i := 0 to Items.Count-1 do + PObject3d(Items.At(i))^.GetInfo(Ray,Inf^[i]); + Min := MaxReal; j := -1; + for i := 0 to Items.Count-1 do + with Inf^[i] do + if Hit and (Time < Min) and (Time > 0.001) then begin + Min := Time; j := i; + end; + if j = -1 then begin + Col := BackColor + end else begin + Info := Inf^[j]; + with Info do begin + Normal.MakeUnit; + c := Color; + if Shading then begin + ir := Brightness * Ambient.r; + ig := Brightness * Ambient.g; + ib := Brightness * Ambient.b; + for i := 0 to Lights.Count-1 do begin + li := PLightSource(Lights.At(i))^.Pos; + lc := PLightSource(Lights.At(i))^.Color; + Li.Sub(Pos); + with li do + d := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)); + li.MakeUnit; + costheta := (Normal.x*Li.x + Normal.y*Li.y + Normal.z*Li.z); + if Shadows then begin + r.Origin := Pos; + r.Direction := li; + repeat + for k := 0 to Items.Count-1 do + PObject3d(Items.At(k))^.GetInfo(r,Inf^[k]); + Min := MaxReal; l := -1; + for k := 0 to Items.Count-1 do + with Inf^[k] do + if Hit and (Time < Min) and (Time < d) and + (Time > 0.001) and ((Opacity.r+Opacity.g+Opacity.b) > 0) + then begin + Min := Time; l := k; + end; + if l <> -1 then + with Inf^[l] do begin + lc.r := lc.r * (1-Opacity.r); + lc.g := lc.g * (1-Opacity.g); + lc.b := lc.b * (1-Opacity.b); + r.o := Pos; + end; + until l = -1; + end; + if Specular and (costheta > 0) then begin + { Don't bother if light is behind } + v1 := Ray.d; + ndotn := (normal.x * normal.x + + normal.y * normal.y + + normal.z * normal.z); + idotn := (normal.x * li.x + + normal.y * li.y + + normal.z * li.z); + idotn_div_ndotn_x2 := (2.0 * (idotn) / ndotn); + v2.x := li.x - idotn_div_ndotn_x2 * Normal.x; + v2.y := li.y - idotn_div_ndotn_x2 * Normal.y; + v2.z := li.z - idotn_div_ndotn_x2 * Normal.z; + v2.MakeUnit; + ra := v1.Dot(v2); + if ra > 0 then costheta := costheta + ( + PObject3d(Items.At(j))^.SpecularW(ArcCos(costheta)*180/pi) * + Power(ra,SpecularN)); + end; + if (costheta < 0) then begin + costheta := -costheta; + lc.r := lc.r * (1-Opacity.r); + lc.g := lc.g * (1-Opacity.g); + lc.b := lc.b * (1-Opacity.b); + end; + Ir := Ir + ((Brightness * lc.r) / (d + 0.001)) * costheta; + Ig := Ig + ((Brightness * lc.g) / (d + 0.001)) * costheta; + Ib := Ib + ((Brightness * lc.b) / (d + 0.001)) * costheta; + end; + c.r := c.r - 1 + Ir; + c.g := c.g - 1 + Ig; + c.b := c.b - 1 + Ib; + end; + if Reflection and (ReflectCount < MaxReflect) and + ((Reflectivity.r+Reflectivity.g+Reflectivity.b) > 0) then begin + ndotn := (normal.x * normal.x + + normal.y * normal.y + + normal.z * normal.z); + idotn := (normal.x * ray.d.x + + normal.y * ray.d.y + + normal.z * ray.d.z); + idotn_div_ndotn_x2 := (2.0 * (idotn) / ndotn); + r.Origin := Pos; + r.d.x := Ray.d.x - idotn_div_ndotn_x2 * Normal.x; + r.d.y := Ray.d.y - idotn_div_ndotn_x2 * Normal.y; + r.d.z := Ray.d.z - idotn_div_ndotn_x2 * Normal.z; + Inc(ReflectCount); + TraceRay(r,lc); + Dec(ReflectCount); + if ScaleBase then begin + c.r := (c.r*(1-Reflectivity.r)) + (Reflectivity.r * lc.r); + c.g := (c.g*(1-Reflectivity.g)) + (Reflectivity.g * lc.g); + c.b := (c.b*(1-Reflectivity.b)) + (Reflectivity.b * lc.b); + end else begin + c.r := c.r + (Reflectivity.r * lc.r); + c.g := c.g + (Reflectivity.g * lc.g); + c.b := c.b + (Reflectivity.b * lc.b); + end; + end; + if Transparency and (ReflectCount < MaxReflect) and + (Opacity.r < 1) and (Opacity.g < 1) and (Opacity.b < 1) then begin + if GoingIn then + ra := 1 / IndexRefraction + else + ra := IndexRefraction; + idotn := -(Normal.x*Ray.d.x + + Normal.y*Ray.d.y + + Normal.z*Ray.d.z); + d := 1 + Sqr(ra)*(Sqr(idotn)-1); + r.o := Pos; + if d >= 0 then begin + Min := ra*idotn - Sqrt(d); + r.d.x := Ray.d.x*ra + Normal.x*Min; + r.d.y := Ray.d.y*ra + Normal.y*Min; + r.d.z := Ray.d.z*ra + Normal.z*Min; + end else begin + ndotn := (normal.x * normal.x + + normal.y * normal.y + + normal.z * normal.z); + idotn := (normal.x * ray.d.x + + normal.y * ray.d.y + + normal.z * ray.d.z); + idotn_div_ndotn_x2 := (2.0 * (idotn) / ndotn); + r.d.x := Ray.d.x - idotn_div_ndotn_x2 * Normal.x; + r.d.y := Ray.d.y - idotn_div_ndotn_x2 * Normal.y; + r.d.z := Ray.d.z - idotn_div_ndotn_x2 * Normal.z; + end; + Inc(ReflectCount); + TraceRay(r,lc); + Dec(ReflectCount); + if ScaleBase then begin + c.r := (c.r*Opacity.r) + ((1-Opacity.r) * lc.r); + c.g := (c.g*Opacity.g) + ((1-Opacity.g) * lc.g); + c.b := (c.b*Opacity.b) + ((1-Opacity.b) * lc.b); + end else begin + c.r := c.r + ((1-Opacity.r) * lc.r); + c.g := c.g + ((1-Opacity.g) * lc.g); + c.b := c.b + ((1-Opacity.b) * lc.b); + end; + end; + Col := c; + end; + end; + FreeMem(Inf,Items.Count * SizeOf(TRayInfo)); +end; + +procedure TUniverse.TracePoint(x,y: Integer; var Col: RgbTriple); +var + Ray: TRay; + v,h: TPoint3d; +begin + Ray.Origin := Eye; + Ray.d := vM; Ray.d.Sub(Eye); + h := vH; v := vV; + h.Scale(-(2*(x/ScrWidth)-1)); + v.Scale(2*(y/ScrHeight)-1); + Ray.d.Add(h); + Ray.d.Add(v); + TraceRay(Ray,Col); +end; + +procedure TUniverse.Insert(Item: PObject3d); +begin + Items.Insert(Item); + Item^.Owner := @Self; +end; + +procedure TUniverse.Delete(Item: PObject3d); +begin + Items.Delete(Item); + Item^.Owner := nil; +end; + +procedure TUniverse.InsertLight(Item: PLightSource); +begin + Lights.Insert(Item); +end; + +procedure TUniverse.DeleteLight(Item: PLightSource); +begin + Lights.Delete(Item); +end; + +procedure TUniverse.DeleteAllObjects; +var i: Integer; +begin + Items.DeleteAll; +end; + +procedure TUniverse.DeleteAllLights; +begin + Lights.DeleteAll; +end; + +procedure TUniverse.DeleteAll; +begin + Items.DeleteAll; + Lights.DeleteAll; +end; + +procedure TUniverse.FreeAllObjects; +begin + Items.FreeAll; +end; + +procedure TUniverse.FreeAllLights; +begin + Lights.FreeAll; +end; + +procedure TUniverse.FreeAll; +begin + Items.FreeAll; + Lights.FreeAll; +end; + +constructor TSphere.Init(xa,ya,za,ra: Float); +begin + TObject3d.Init; + Pos.SetTo(xa,ya,za); + r := ra; r2 := Sqr(ra); +end; + +procedure TSphere.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + a, b, c, t1, t2, t3, close, farther: Float; +begin + a := ray.d.x * ray.d.x + ray.d.y * ray.d.y + ray.d.z * ray.d.z; + close := -1.0; + farther := -1.0; + if a <> 0 then begin + b := 2.0 * ((ray.o.x - Pos.x) * ray.d.x + + (ray.o.y - Pos.y) * ray.d.y + + (ray.o.z - Pos.z) * ray.d.z); + c := (ray.o.x - Pos.x) * (ray.o.x - Pos.x) + + (ray.o.y - Pos.y) * (ray.o.y - Pos.y) + + (ray.o.z - Pos.z) * (ray.o.z - Pos.z) - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close := -(b + t2) / t3; + farther := -(b - t2) / t3; + end; + end; + if (close <= 0.001) and (farther > 0.001) then begin + Inf.Time := farther; Inf.GoingIn := False; + end else + if (close > 0.001) and (farther <= 0.001) then begin + Inf.Time := close; Inf.GoingIn := False; + end else begin + Inf.GoingIn := True; + if close < farther then + Inf.Time := close + else + Inf.Time := farther; + end; + Inf.Hit := (Inf.Time > 0.001); + if not Inf.Hit then Exit; + Inf.Pos.SetTo( + ray.o.x+ray.d.x*Inf.Time, + ray.o.y+ray.d.y*Inf.Time, + ray.o.z+ray.d.z*Inf.Time); + Inf.Normal := Inf.Pos; + Inf.Normal.Sub(Pos); + if not Inf.GoingIn then Inf.Normal.Scale(-1); + MakeTrip(0.9,0.8,0.7,Inf.Color); + Inf.Brightness := 1; + MakeTrip(0.3,0.3,0.3,Inf.Reflectivity); + MakeTrip(1,1,1,Inf.Opacity); + Inf.SpecularN := 100; + Inf.IndexRefraction := 0.95; +end; + +constructor TPlane.Init(xa,ya,za,vx,vy,vz: Float); +begin + TObject3d.Init; + Pos.SetTo(xa,ya,za); + Normal.SetTo(vx,vy,vz); + Normal.MakeUnit; +end; + +procedure TPlane.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + p1, p2, p3: Float; +begin + p1 := Pos.x * Normal.x + Pos.y * Normal.y + Pos.z * Normal.z; + p2 := ray.o.x * Normal.x + ray.o.y * Normal.y + ray.o.z * Normal.z; + p3 := ray.d.x * Normal.x + ray.d.y * Normal.y + ray.d.z * Normal.z; + if p3 = 0 then p3 := 0.001; + Inf.Time := (p1-p2)/p3; + Inf.Hit := (Inf.Time > 0.001); + if not Inf.Hit then Exit; + Inf.Normal := Normal; + if Ray.d.Dot(Inf.Normal) > 0 then Inf.Normal.Scale(-1); + Inf.Pos.SetTo( + ray.o.x+ray.d.x*Inf.Time, + ray.o.y+ray.d.y*Inf.Time, + ray.o.z+ray.d.z*Inf.Time); + MakeTrip(0.75,0.75,0.75,Inf.Color); + Inf.GoingIn := True; + Inf.Brightness := 1; + MakeTrip(0.1,0.1,0.1,Inf.Reflectivity); + MakeTrip(1,1,1,Inf.Opacity); + Inf.SpecularN := 50; + Inf.IndexRefraction := 0.99; +end; + +constructor TPlanePts.Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Float); +begin + TPlane.Init(x1,y1,z1, + y1*(z2-z3)+y2*(z3-z1)+y3*(z1-z2), + z1*(x2-x3)+z2*(x3-x1)+z3*(x1-x2), + x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2)); +end; + +constructor TCylinder.Init(xa,ya,za,vx,vy,vz,ra,ha: Float; aends: ShortInt); +begin + TObject3d.Init; + Pos.SetTo(xa,ya,za); + Normal.SetTo(vx,vy,vz); + Normal.MakeUnit; + r := ra; r2 := Sqr(ra); + h := ha; + ends := aends; +end; + +procedure TCylinder.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + r1: TRay; + a,b,c,t1,t2,t3,close1,farther1,close,farther,end1,end2: Float; + p1,p2: TPoint3d; +begin + Inf.Hit := False; + r1 := Ray; + r1.o.Sub(Pos); + r1.o.RotateFrom(Normal); + r1.d.RotateFrom(Normal); + if (ends and 1) <> 0 then begin + t3 := r1.d.z; + if t3 = 0 then t3 := 0.001; + end1 := (-r1.o.z)/t3; + if (Sqr(r1.o.x+r1.d.x*end1)+ + Sqr(r1.o.y+r1.d.y*end1)+ + Sqr(r1.o.z+r1.d.z*end1)) > r2 then end1 := -1; + end else + end1 := -1; + if (ends and 2) <> 0 then begin + t3 := r1.d.z; + if t3 = 0 then t3 := 0.001; + end2 := (h-r1.o.z)/t3; + if (Sqr(r1.o.x+r1.d.x*end2)+ + Sqr(r1.o.y+r1.d.y*end2)+ + Sqr(r1.o.z+r1.d.z*end2-h)) > r2 then end2 := -1; + end else + end2 := -1; + a := r1.d.x * r1.d.x + r1.d.y * r1.d.y; + close := -1.0; + farther := -1.0; + if a <> 0 then begin + b := 2.0 * (r1.o.x * r1.d.x + + r1.o.y * r1.d.y); + c := r1.o.x * r1.o.x + + r1.o.y * r1.o.y - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close1 := -(b + t2) / t3; + farther1 := -(b - t2) / t3; + if close1 > 0 then begin + p1 := r1.d; + p1.Scale(close1); + close := p1.Length; + p1.Add(r1.o); + if (p1.z < 0) or (p1.z > h) then close := -1; + end; + if farther1 > 0 then begin + p2 := r1.d; + p2.Scale(farther1); + farther := p2.Length; + p2.Add(r1.o); + if (p2.z < 0) or (p2.z > h) then farther := -1; + end; + end; + end; + Inf.Time := MaxReal; + if (close < Inf.Time) and (close > 0.001) then Inf.Time := close; + if (farther < Inf.Time) and (farther > 0.001) then Inf.Time := farther; + if (end1 < Inf.Time) and (end1 > 0.001) then Inf.Time := end1; + if (end2 < Inf.Time) and (end2 > 0.001) then Inf.Time := end2; + Inf.Hit := Inf.Time < MaxReal; + if not Inf.Hit then Exit; + Inf.Pos := Ray.d; + Inf.Pos.Scale(Inf.Time); + Inf.Pos.Add(Ray.o); + Inf.Normal := Normal; + if (Inf.Time = close) or (Inf.Time = farther) then begin + if Inf.Time = close then + Inf.Normal.Scale(p1.z) + else + Inf.Normal.Scale(p2.z); + Inf.Normal.Add(Pos); + Inf.Normal.Sub(Inf.Pos); + end else begin + if Inf.Time = end2 then Inf.Normal.Scale(-1); + end; + Inf.GoingIn := Ray.d.Dot(Inf.Normal) > 0; + if Inf.GoingIn then Inf.Normal.Scale(-1); + MakeTrip(0.7,0.8,0.9,Inf.Color); + Inf.Brightness := 1; + MakeTrip(0,0,0,Inf.Reflectivity); + MakeTrip(1,1,1,Inf.Opacity); + Inf.SpecularN := 100; + Inf.IndexRefraction := 0.95; +end; + +constructor TCone.Init(xa,ya,za,vx,vy,vz,ra1,rb1,ha: Float; aends: ShortInt); +begin + TObject3d.Init; + Pos.SetTo(xa,ya,za); + Normal.SetTo(vx,vy,vz); + Normal.MakeUnit; + ra := ra1; ra2 := Sqr(ra); + rb := rb1; rb2 := Sqr(rb); + h := ha; + th := h+((rb*h)/(ra-rb)); + ends := aends; +end; + +procedure TCone.GetInfo(Ray: TRay; var Inf: TRayInfo); +var + r1: TRay; + v1,v2,a,b,c,t1,t2,t3,close1,farther1,close,farther,end1,end2: Float; + p1,p2: TPoint3d; +begin + Inf.Hit := False; + r1 := Ray; + r1.o.Sub(Pos); + r1.o.RotateFrom(Normal); + r1.d.RotateFrom(Normal); + if (ends and 1) <> 0 then begin + t3 := r1.d.z; + if t3 = 0 then t3 := 0.001; + end1 := (-r1.o.z)/t3; + if (Sqr(r1.o.x+r1.d.x*end1)+ + Sqr(r1.o.y+r1.d.y*end1)+ + Sqr(r1.o.z+r1.d.z*end1)) > ra2 then end1 := -1; + end else + end1 := -1; + if (ends and 2) <> 0 then begin + t3 := r1.d.z; + if t3 = 0 then t3 := 0.001; + end2 := (h-r1.o.z)/t3; + if (Sqr(r1.o.x+r1.d.x*end2)+ + Sqr(r1.o.y+r1.d.y*end2)+ + Sqr(r1.o.z+r1.d.z*end2-h)) > rb2 then end2 := -1; + end else + end2 := -1; + a := r1.d.x * r1.d.x + r1.d.y * r1.d.y; + (* + xý+yý=(1-(z/th))rý + take (1-(z/th))*ra2 and use as r2 in cyl stuff + *) + { get p1.z, p2.z } + v1 := (1-(p1.z/th))*ra2; + v2 := (1-(p2.z/th))*ra2; + a := r1.d.x * r1.d.x + r1.d.y * r1.d.y; + close := -1.0; + farther := -1.0; + if a <> 0 then begin + b := 2.0 * (r1.o.x * r1.d.x + + r1.o.y * r1.d.y); + c := r1.o.x * r1.o.x + + r1.o.y * r1.o.y - ra2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close1 := -(b + t2) / t3; + farther1 := -(b - t2) / t3; + if close1 > 0 then begin + p1 := r1.d; + p1.Scale(close1); + close := p1.Length; + p1.Add(r1.o); + if (p1.z < 0) or (p1.z > h) then close := -1; + end; + if farther1 > 0 then begin + p2 := r1.d; + p2.Scale(farther1); + farther := p2.Length; + p2.Add(r1.o); + if (p2.z < 0) or (p2.z > h) then farther := -1; + end; + end; + end; + Inf.Time := MaxReal; + if (close < Inf.Time) and (close > 0.001) then Inf.Time := close; + if (farther < Inf.Time) and (farther > 0.001) then Inf.Time := farther; + if (end1 < Inf.Time) and (end1 > 0.001) then Inf.Time := end1; + if (end2 < Inf.Time) and (end2 > 0.001) then Inf.Time := end2; + Inf.Hit := Inf.Time < MaxReal; + if not Inf.Hit then Exit; + Inf.Pos := Ray.d; + Inf.Pos.Scale(Inf.Time); + Inf.Pos.Add(Ray.o); + Inf.Normal := Normal; + if (Inf.Time = close) or (Inf.Time = farther) then begin + if Inf.Time = close then + Inf.Normal.Scale(p1.z) + else + Inf.Normal.Scale(p2.z); + Inf.Normal.Add(Pos); + Inf.Normal.Sub(Inf.Pos); + end else begin + if Inf.Time = end2 then Inf.Normal.Scale(-1); + end; + Inf.GoingIn := Ray.d.Dot(Inf.Normal) > 0; + if Inf.GoingIn then Inf.Normal.Scale(-1); + MakeTrip(0.7,0.8,0.9,Inf.Color); + Inf.Brightness := 1; + MakeTrip(0,0,0,Inf.Reflectivity); + MakeTrip(1,1,1,Inf.Opacity); + Inf.SpecularN := 100; + Inf.IndexRefraction := 0.95; +end; + +procedure GetSphereInfo(Ray: TRay; Pos: TPoint3d; r: Float; var close,farther: Float); +var + r2, a, b, c, t1, t2, t3: Float; +begin + r2 := Sqr(r); + a := ray.d.x * ray.d.x + ray.d.y * ray.d.y + ray.d.z * ray.d.z; + close := -1.0; + farther := -1.0; + if a <> 0 then begin + b := 2.0 * ((ray.o.x - Pos.x) * ray.d.x + + (ray.o.y - Pos.y) * ray.d.y + + (ray.o.z - Pos.z) * ray.d.z); + c := (ray.o.x - Pos.x) * (ray.o.x - Pos.x) + + (ray.o.y - Pos.y) * (ray.o.y - Pos.y) + + (ray.o.z - Pos.z) * (ray.o.z - Pos.z) - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close := -(b + t2) / t3; + farther := -(b - t2) / t3; + end; + end; +end; + +procedure GetCylinderInfo(Ray: TRay; Pos,Normal: TPoint3d; r,h: Float; ends: ShortInt; + var close,farther,end1,end2: Float); +var + r1: TRay; + r2,a,b,c,t1,t2,t3,close1,farther1: Float; + p1,p2: TPoint3d; +begin + r2 := Sqr(r); + r1 := Ray; + r1.o.Sub(Pos); + r1.o.RotateFrom(Normal); + r1.d.RotateFrom(Normal); + if (ends and 1) <> 0 then begin + t3 := r1.d.z; + if t3 = 0 then t3 := 0.001; + end1 := (-r1.o.z)/t3; + if (Sqr(r1.o.x+r1.d.x*end1)+ + Sqr(r1.o.y+r1.d.y*end1)+ + Sqr(r1.o.z+r1.d.z*end1)) > r2 then end1 := -1; + end else + end1 := -1; + if (ends and 2) <> 0 then begin + t3 := r1.d.z; + if t3 = 0 then t3 := 0.001; + end2 := (h-r1.o.z)/t3; + if (Sqr(r1.o.x+r1.d.x*end2)+ + Sqr(r1.o.y+r1.d.y*end2)+ + Sqr(r1.o.z+r1.d.z*end2-h)) > r2 then end2 := -1; + end else + end2 := -1; + a := r1.d.x * r1.d.x + r1.d.y * r1.d.y; + close := -1.0; + farther := -1.0; + if a <> 0 then begin + b := 2.0 * (r1.o.x * r1.d.x + + r1.o.y * r1.d.y); + c := r1.o.x * r1.o.x + + r1.o.y * r1.o.y - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close1 := -(b + t2) / t3; + farther1 := -(b - t2) / t3; + if close1 > 0 then begin + p1 := r1.d; + p1.Scale(close1); + close := p1.Length; + p1.Add(r1.o); + if (p1.z < 0) or (p1.z > h) then close := -1; + end; + if farther1 > 0 then begin + p2 := r1.d; + p2.Scale(farther1); + farther := p2.Length; + p2.Add(r1.o); + if (p2.z < 0) or (p2.z > h) then farther := -1; + end; + end; + end; +end; + +procedure GetConeInfo(Ray: TRay; Pos,Normal: TPoint3d; ra,rb,h: Float; ends: ShortInt; + var close,farther,end1,end2: Float); +begin +end; + +procedure GetPlaneInfo(Ray: TRay; Pos,Normal: TPoint3d; var time: Float); +var + p1, p2, p3: Float; +begin + p1 := Pos.x * Normal.x + Pos.y * Normal.y + Pos.z * Normal.z; + p2 := ray.o.x * Normal.x + ray.o.y * Normal.y + ray.o.z * Normal.z; + p3 := ray.d.x * Normal.x + ray.d.y * Normal.y + ray.d.z * Normal.z; + if p3 = 0 then p3 := 0.001; + Time := (p1-p2)/p3; +end; + +end. \ No newline at end of file diff --git a/turbo-pascal/raytr2.pas b/turbo-pascal/raytr2.pas new file mode 100644 index 0000000..c6c3217 --- /dev/null +++ b/turbo-pascal/raytr2.pas @@ -0,0 +1,183 @@ +unit RayTr; +{ Everything-independent super ultra ray-tracing + by Brion Vibber, 12-13-92, based on lots of stuff + last revised 12-31-92, unless I forget to change this line. + 12-25-92: set for Doubles + 12-31-92: Totally changed to compete with POV-Ray +} +interface + +{$N+,E-,G+,X+} { Heck, I'm only going to use it here } + +uses Objects; { For TCollection, a super-useful thingy } + +const + MinReal = 5.0e-324; + MaxReal = 1.7e308; + DarnSmall = 0.0001; + +type + PUniverse = ^TUniverse; + PObject3d = ^TObject3d; + PLightSource = ^TLightSource; + PPoint3d = ^TPoint3d; + PRayInfo = ^TRayInfo; + PTexture = ^TTexture; + {PPolygon3d = ^TPolygon3d; + PPolygonList = ^TPolygonList;} + + TPoint3d = object + x,y,z: Double; + procedure SetTo(ax,ay,az: Double); + procedure MakeUnit; + procedure Cross(v: TPoint3d); + function Dot(v: TPoint3d): Double; + procedure Add(v: TPoint3d); + procedure Sub(v: TPoint3d); + procedure Scale(s: Double); + function Length: Double; + procedure RotateFrom(v: TPoint3d); + procedure RotateTo(v: TPoint3d); + procedure RotateX(d: Double); + procedure RotateY(d: Double); + procedure RotateZ(d: Double); + procedure Rotate(x,y,z: Double); + end; + TRay = object + o,d: TPoint3d; + end; + TColor = object + r,g,b,a: Double; { 0 - 1 } { a[lpha] is transparency } + end; + TTexture = object(TObject) + + end; + +function Power(x,y: Double): Double; +function Log(x,y: Double): Double; +function ArcSin(x: Double): Double; +function ArcCos(x: Double): Double; +function Tan(x: Double): Double; + +implementation + +procedure MakeTrip(r,g,b: Double; var c: RgbTriple); +begin + c.r := r; c.g := g; c.b := b; +end; + +function Power(x,y: Double): Double; +var + i: Integer; + x1: Double; +begin + {Power := Exp(y * Ln(x));} + x1 := x; + for i := 1 to Trunc(y)-1 do + x1 := x1 * x; + Power := x; +end; + +function Log(x,y: Double): Double; +begin + Log := Ln(x) / Ln(y); +end; + +function ArcSin(x: Double): Double; +begin + ArcSin := ArcTan(x / Sqrt(1 - (x*x))); +end; + +function ArcCos(x: Double): Double; +begin + ArcCos := ArcTan(Sqrt(1 - Sqr(x)) / x); +end; + +function Tan(x: Double): Double; +begin + Tan := Sin(x) / Cos(x); +end; + +procedure TPoint3d.SetTo(ax,ay,az: Double); +begin + x := ax; y := ay; z := az; +end; + +procedure TPoint3d.MakeUnit; +var + d: Double; +begin + d := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)); + if d <> 0 then begin + x := x / d; + y := y / d; + z := z / d; + end; +end; + +procedure TPoint3d.Cross(v: TPoint3d); +var + xa,ya: Double; +begin + xa := y*v.z - z*v.y; + ya := z*v.x - x*v.z; + z := x*v.y - y*v.x; + x := xa; y := ya; +end; + +function TPoint3d.Dot(v: TPoint3d): Double; +begin + Dot := x*v.x + y*v.y + z*v.z; +end; + +procedure TPoint3d.Add(v: TPoint3d); +begin + x := x + v.x; + y := y + v.y; + z := z + v.z; +end; + +procedure TPoint3d.Sub(v: TPoint3d); +begin + x := x - v.x; + y := y - v.y; + z := z - v.z; +end; + +procedure TPoint3d.Scale(s: Double); +begin + x := x * s; + y := y * s; + z := z * s; +end; + +function TPoint3d.Length: Double; +begin + Length := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)); +end; + +procedure TPoint3d.RotateFrom(v: TPoint3d); +var + d,xa,ya,za,cos1,sin1: Double; +begin + v.MakeUnit; + d := Sqrt(Sqr(v.y)+Sqr(v.z)); + cos1 := v.z/d; sin1 := v.y/d; + ya := y*cos1-z*sin1; z := y*sin1+z*cos1; y := ya; + cos1 := d; sin1 := -v.x; + za := z*cos1-x*sin1; x := z*sin1+x*cos1; z := za; +end; + +procedure TPoint3d.RotateTo(v: TPoint3d); +var + d,xa,ya,za,cos1,sin1: Double; +begin + v.MakeUnit; + d := Sqrt(Sqr(v.y)+Sqr(v.z)); + cos1 := -v.z/d; sin1 := -v.y/d; + ya := y*cos1-z*sin1; z := y*sin1+z*cos1; y := ya; + cos1 := -d; sin1 := v.x; + za := z*cos1-x*sin1; x := z*sin1+x*cos1; z := za; +end; + +end. \ No newline at end of file diff --git a/turbo-pascal/raytrace.pas b/turbo-pascal/raytrace.pas new file mode 100644 index 0000000..eac3f30 --- /dev/null +++ b/turbo-pascal/raytrace.pas @@ -0,0 +1,435 @@ +{ RAYTRACE.PAS } +{ Ray-tracing unit, generic. } + +unit RayTrace; + +interface +uses Objects; +{ Base objects on Turbo Vision's TObject to make them useable on + Turbo Vision streams. } + +type + VECTOR = object + dx, dy, dz: real; { Three dimensional vector } + end; + RAY = object + dx, dy, dz: real; { Direction vector } + ox, oy, oz: real; { Origin } + constructor Init (x, y, z, vx, vy, vz: real); + end; + + PObj3d = ^Obj3d; + PUniverse = ^Universe; + + Obj3d = object(TObject) + Owner: PUniverse; + xp,yp,zp: Real; + constructor Init(x,y,z: Real); + function Intersect(aray: RAY): Real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + procedure ReflectRay(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + PLANE = object(Obj3d) + nx, ny, nz: real; { Vector normal (perpendicular) to plane } + constructor Init(x, y, z, vx, vy, vz: real); + function Intersect(aray: RAY): real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: RAY; time: Real): LongInt; virtual; + end; + SPHERE = object(Obj3d) + ra,r2: real; { Radius squared } + constructor Init(x, y, z, r: real); + function Intersect(aray: RAY): real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + Cylinder = object(Obj3d) + { xp,yp,zp = center of bottom circle + x2,y2,z2 = center of top circle + ra = radius } + x2,y2,z2,ra,r2: Real; + constructor Init(x,y,z,xb,yb,zb,r: Real); + function Intersect(aray: RAY): real; virtual; + procedure SurfNormal(aray: Ray; time: Real; var oray: Ray); virtual; + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + PlanePnt = object(Plane) + xb,yb,zb,xc,yc,zc: Real; + constructor Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real); + function GetColor(aray: Ray; time: Real): LongInt; virtual; + end; + + Obj3dCollection = object(TCollection) + destructor Done; virtual; + end; + + Universe = object(TObject) + Width,Height: Integer; + Items: Obj3dCollection; + constructor Init(aWidth,aHeight: Integer); + destructor Done; virtual; + procedure Insert(o: PObj3d); + procedure Delete(o: PObj3d); + function TraceRay(aray: Ray): LongInt; + function TracePoint(x,y: Integer): LongInt; + end; + + +{ LongInt: $00rrggbb } +procedure SepLong(c: LongInt; var r,g,b: Integer); +function GetRgb(r,g,b: Integer): LongInt; +function GetHsv(h,s,v: Integer): LongInt; +procedure Hsv2Rgb(h,s,v: Integer; var r,g,b: Integer); + +implementation + +procedure SepLong(c: LongInt; var r,g,b: Integer); +begin + r := (c and $ff0000) shr 16; + g := (c and $ff00) shr 8; + b := c and $ff; +end; + +procedure Hsv2Rgb(h,s,v: Integer; var r,g,b: Integer); +var + rr,gg,bb,f,p1,p2,p3: Integer; +begin + while h > 359 do Dec(h,360); + while h < 0 do Inc(h,360); + if s < 0 then s := 0; + if s > 100 then s := 100; + if v < 0 then v := 0; + if v > 100 then v := 100; + + f := (h mod 60) * 5 div 3; + h := h div 60; + p1 := v*(100-s) div 625 * 16; + p2 := v*(100-(s*f div 100)) div 625 * 16; + p3 := v*(100-(s*(100-f) div 100)) div 625 * 16; + v := v * 64 div 25; + case h of + 0: begin r := v; g := p3; b := p1; end; + 1: begin r := p2; g := v; b := p1; end; + 2: begin r := p1; g := v; b := p3; end; + 3: begin r := p1; g := p2; b := v; end; + 4: begin r := p3; g := p1; b := v; end; + 5: begin r := v; g := p1; b := p2; end; + end; +end; + +function GetHsv(h,s,v: Integer): LongInt; +var r,g,b: Integer; +begin + Hsv2Rgb(h,s,v,r,g,b); + asm + mov al,byte ptr [b] + mov byte ptr [@Result],al + mov al,byte ptr [g] + mov byte ptr [@Result+1],al + mov al,byte ptr [r] + mov byte ptr [@Result+2],al + mov byte ptr [@Result+3],0 + end; +end; + +function GetRgb(r,g,b: Integer): LongInt; +begin + if r > 255 then r := 255; + if r < 0 then r := 0; + if g > 255 then g := 255; + if g < 0 then g := 0; + if b > 255 then b := 255; + if b < 0 then b := 0; + asm + mov al,byte ptr [b] + mov byte ptr [@Result],al + mov al,byte ptr [g] + mov byte ptr [@Result+1],al + mov al,byte ptr [r] + mov byte ptr [@Result+2],al + mov byte ptr [@Result+3],0 + end; +end; + +constructor Obj3d.Init(x,y,z: Real); +begin + TObject.Init; + xp := x; yp := y; zp := z; +end; + +function Obj3d.Intersect(aray: RAY): Real; +begin + { 0 or neg = no intersect } + Intersect := 0; +end; + +procedure Obj3d.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + { No intersect, will never get called here } +end; + +procedure Obj3d.ReflectRay(aray: RAY; time: real; var oray: RAY); +var + normal: Ray; { Used for readability } + ndotn: real; { Used for readability } + idotn: real; { Used for readability } + idotn_div_ndotn_x2: real; { Used for optimization } +begin + oray.ox := aray.dx * time + aray.ox; { Find the point of } + oray.oy := aray.dy * time + aray.oy; { intersection between } + oray.oz := aray.dz * time + aray.oz; { iray and sphere. } + SurfNormal(aray,time,normal); + + ndotn := (normal.dx * normal.dx + + normal.dy * normal.dy + + normal.dz * normal.dz); + idotn := (normal.dx * aray.dx + + normal.dy * aray.dy + + normal.dz * aray.dz); + idotn_div_ndotn_x2 := (2.0 * (idotn) / ndotn); + + oray.dx := aray.dx - idotn_div_ndotn_x2 * normal.dx; + oray.dy := aray.dy - idotn_div_ndotn_x2 * normal.dy; + oray.dz := aray.dz - idotn_div_ndotn_x2 * normal.dz; +end; + +function Obj3d.GetColor(aray: Ray; time: Real): LongInt; +begin + { See SurfNormal } +end; + + +constructor RAY.Init(x, y, z, vx, vy, vz: real); +begin + ox := x; + oy := y; + oz := z; + dx := vx; + dy := vy; + dz := vz; +end; { ----- End: RAY::RAY() ----- } + +constructor SPHERE.Init(x, y, z, r: real); +begin + Obj3d.Init(x,y,z); + ra := r; + r2 := r * r; +end; { ----- End: SPHERE::SPHERE() ----- } + +function SPHERE.Intersect(aray: RAY): real; +var + a, b, c, t1, t2, t3, close, farther: real; +begin + a := aray.dx * aray.dx + aray.dy * aray.dy + aray.dz * aray.dz; + close := -1.0; + farther := -1.0; + if a <> 0 then + begin + b := 2.0 * ((aray.ox - xp) * aray.dx + + (aray.oy - yp) * aray.dy + + (aray.oz - zp) * aray.dz); + c := (aray.ox - xp) * (aray.ox - xp) + + (aray.oy - yp) * (aray.oy - yp) + + (aray.oz - zp) * (aray.oz - zp) - r2; + t1 := b * b - 4.0 * a * c; + if t1 > 0 then + begin + t2 := sqrt(t1); + t3 := 2.0 * a; + close := -(b + t2) / t3; + farther := -(b - t2) / t3; + end; + end; + if close < farther then Intersect := close else Intersect := farther; +{ Intersect := (double)((close < farther) ? close : farther);} +end; { ---- End: SPHERE::Intersect() ----- } + +procedure Sphere.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + oray.ox := aray.dx * time + aray.ox; { Find the point of } + oray.oy := aray.dy * time + aray.oy; { intersection between } + oray.oz := aray.dz * time + aray.oz; { aray and sphere. } + oray.dx := oray.ox - xp; { Find the ray normal } + oray.dy := oray.oy - yp; { to the sphere at the } + oray.dz := oray.oz - zp; { intersection point. } +end; + +function Sphere.GetColor(aray: Ray; time: Real): LongInt; +var + r: Ray; + c: LongInt; + cc: record b,g,r: Byte end absolute c; +begin + ReflectRay(aray,time,r); + c := Owner^.TraceRay(r); + cc.r := Integer(cc.r) div 2; + cc.g := Integer(cc.g) div 2; + cc.b := Integer(cc.b) div 2 + 128; + GetColor := c; +end; + +constructor PLANE.Init(x, y, z, vx, vy, vz: real); +begin + Obj3d.Init(x,y,z); + nx := vx; + ny := vy; + nz := vz; +end; { ----- End: PLANE::PLANE() ----- } + +function PlanePattern(x, y: word): LongInt; +var + r,g,b: Integer; +begin + r := (((x+y) mod 8))*32; + g := ((x mod 8) xor (y mod 8))*32; + b := (((x * x + y * y) mod 8))*32; + PlanePattern := GetRgb(r,g,b); +end; { ----- End: PlanePattern() ----- } + + +function PLANE.GetColor(aray: RAY; time: real): LongInt; +begin + GetColor := PlanePattern(Round(time * aray.dz + aray.oz), + Round(time * aray.dx + aray.ox)); +end; { ----- End: PLANE::Pattern() ----- } + +function PLANE.Intersect(aray: RAY): real; +var + p1, p2, p3: real; +begin + p1 := xp * nx + yp * ny + zp * nz; + p2 := aray.ox * nx + aray.oy * ny + aray.oz * nz; + p3 := aray.dx * nx + aray.dy * ny + aray.dz * nz; + if p3 = 0 then p3 := 0.001; + Intersect := (p1-p2)/p3; +end; { ----- End: PLANE::Intersect() ----- } + +procedure Plane.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin + oray.dx := nx; oray.dy := ny; oray.dz := nz; +end; + +constructor Cylinder.Init(x,y,z,xb,yb,zb,r: Real); +begin + Obj3d.Init(x,y,z); + x2 := xb; y2 := yb; z2 := zb; + ra := r; r2 := Sqr(r); +end; + +function Cylinder.Intersect(aray: RAY): real; +begin + Intersect := 0; +end; + +procedure Cylinder.SurfNormal(aray: Ray; time: Real; var oray: Ray); +begin +end; + +function Cylinder.GetColor(aray: Ray; time: Real): LongInt; +begin + GetColor := $c0c0c0; +end; + +constructor PlanePnt.Init(x1,y1,z1,x2,y2,z2,x3,y3,z3: Real); +var + a,b,c,d: Real; +begin + a := y1*(z2-z3)+y2*(z3-z1)+y3*(z1-z2); + b := z1*(x2-x3)+z2*(x3-x1)+z3*(x1-x2); + c := x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2); + d := -x1*(y2*z3-y3*z2)-x2*(y3*z1-y1*z3)-x3*(y1*z2-y2*z1); + Plane.Init(x1,y1,z1,a,b,c); + xb := x2; yb := y2; zb := z2; + xc := x3; yc := y3; zc := z3; +end; + +function PlanePnt.GetColor(aray: Ray; time: Real): LongInt; +var + d: Real; + c: Integer; +begin + d := Sqrt( + Sqr(time * aray.dx + aray.ox - xp) + + Sqr(time * aray.dy + aray.oy - yp) + + Sqr(time * aray.dz + aray.oz - zp)); + if d > 255.0 then d := 255.0; + c := 255-Round(d); + if c < 96 then c := 96; + GetColor := GetRgb(c,c,c); +end; + + +constructor Universe.Init(aWidth,aHeight: Integer); +begin + TObject.Init; + Width := aWidth; Height := aHeight; + Items.Init(5,5); +end; + +destructor Universe.Done; +begin + Items.Done; +end; + +procedure Universe.Insert(o: PObj3d); +begin + Items.Insert(o); + o^.Owner := @Self; +end; + +procedure Universe.Delete(o: PObj3d); +begin + Items.Delete(o); + o^.Owner := nil; +end; + +function Universe.TraceRay(aray: Ray): LongInt; +type + arr = array[0..1000] of Real; + parr = ^arr; +var + times: parr; + i,j: Integer; + max: Real; + procedure TraceOne(o: PObj3d); far; + begin + times^[i] := o^.Intersect(aray); + Inc(i); + end; +begin + GetMem(times,Items.Count*SizeOf(Real)); + i := 0; + Items.ForEach(@TraceOne); + max := 1.7e38; { darn big } + j := -1; + for i := 0 to Items.Count-1 do + if (times^[i] < max) and (times^[i] > 0.001) then begin + max := times^[i]; j := i; + end; + if j <> -1 then + TraceRay := PObj3d(Items.At(j))^.GetColor(aray,max) + else + TraceRay := 0; + FreeMem(Times,Items.Count*SizeOf(Real)); +end; + +function Universe.TracePoint(x,y: Integer): LongInt; +var + r: Ray; +begin + r.ox := 0; r.oy := 0; r.oz := 0; + r.dx := (x - (Width / 2)) / Width; + r.dy := (y - (Height / 2)) / Height * 0.75; + r.dz := 1; + TracePoint := TraceRay(r); +end; + +destructor Obj3dCollection.Done; +begin + TObject.Done; +end; + +end. \ No newline at end of file