class Homer3Dengine
export load, moveobject, drawobject, centerx, centery, obj
const zoom := 100
var centerx, centery : int
type dot :
record
x, y, z : real
end record
proc assign3d (var d : dot, x, y, z : real)
d.x := x
d.y := y
d.z := z + 10
end assign3d
type object :
record
x, y, z, cx, cy, cz : real
maxpoly : int
poly : array 1 .. 1000, 1 .. 3 of dot
end record
var obj : object
proc load (filename : string, lines : int)
var file : int
var x1, y1, z1, x2, y2, z2, x3, y3, z3 : real
open : file, filename, get
obj.maxpoly := lines
for i : 1 .. lines
get : file, x1, y1, z1, x2, y2, z2, x3, y3, z3
assign3d (obj.poly (i, 1), x1, y1, z1)
assign3d (obj.poly (i, 2), x2, y2, z2)
assign3d (obj.poly (i, 3), x3, y3, z3)
end for
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
obj.poly (i, ii).z += 200
end for
end for
end load
proc rotate (OriginX, OriginY : real, var secondpartX, secondpartY : real, Rotaion : real)
var tempx := (((OriginX - secondpartX) * cosd (Rotaion)) + ((OriginY - secondpartY) * sind (Rotaion)))
var tempy := (((OriginY - secondpartY) * cosd (Rotaion)) - ((OriginX - secondpartX) * sind (Rotaion)))
secondpartY := OriginY - tempy
secondpartX := OriginX - tempx
end rotate
proc findcenter (var x, y, z : real)
x := 0.0
y := 0.0
z := 0.0
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
x += obj.poly (i, ii).x
y += obj.poly (i, ii).y
z += obj.poly (i, ii).z
end for
end for
x /= (obj.maxpoly * 3)
y /= (obj.maxpoly * 3)
z /= (obj.maxpoly * 3)
%drawfilloval (round (obj.cx / (obj.cz / zoom)) + 320, round (obj.cy / (obj.cz / zoom)) + 200, 10, 10, 12)
centerx := round (x / (z / zoom)) + 320
centery := round (y / (z / zoom)) + 200
end findcenter
proc draw3dpolygon (d1, d2, d3 : dot, c, c2 : int)
if d1.z not= 0 and d2.z not= 0 and d3.z not= 0 then
var xx : array 1 .. 3 of int
var yy : array 1 .. 3 of int
xx (1) := round (d1.x / (d1.z / zoom)) + 320
xx (2) := round (d2.x / (d2.z / zoom)) + 320
xx (3) := round (d3.x / (d3.z / zoom)) + 320
yy (1) := round (d1.y / (d1.z / zoom)) + 200
yy (2) := round (d2.y / (d2.z / zoom)) + 200
yy (3) := round (d3.y / (d3.z / zoom)) + 200
Draw.FillPolygon (xx, yy, 3, c)
Draw.Polygon (xx, yy, 3, c2)
end if
end draw3dpolygon
proc drawobject (col, col2 : int)
for i : 1 .. obj.maxpoly
draw3dpolygon (obj.poly (i, 1), obj.poly (i, 2), obj.poly (i, 3), col, col2)
end for
end drawobject
proc moveobject (s : string, d : real)
findcenter (obj.cx, obj.cy, obj.cz)
case s of
label "xy" :
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
rotate (obj.cx, obj.cy, obj.poly (i, ii).x, obj.poly (i, ii).y, d)
end for
end for
label "xz" :
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
rotate (obj.cx, obj.cz, obj.poly (i, ii).x, obj.poly (i, ii).z, d)
end for
end for
label "yz" :
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
rotate (obj.cy, obj.cz, obj.poly (i, ii).y, obj.poly (i, ii).z, d)
end for
end for
label "x" :
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
obj.poly (i, ii).x += d
end for
end for
label "y" :
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
obj.poly (i, ii).y += d
end for
end for
label "z" :
for i : 1 .. obj.maxpoly
for ii : 1 .. 3
obj.poly (i, ii).z += d
end for
end for
label :
end case
end moveobject
end Homer3Dengine
class Vector3D
export Scale, SetAngleXY, SetAngleXZ, SetAngleYZ, x, y, z, x2d, y2d, conv2d
var relX, relY, relZ : real
var norm : real
var x2d, y2d : int
var x, y, z : real
proc Normalize
norm := (x ** 2 + y ** 2) ** 0.5
x /= norm
y /= norm
end Normalize
proc SetAngleXY (a : real)
x := cosd (a)
y := sind (a)
end SetAngleXY
proc SetAngleXZ (a : real)
x := cosd (a)
z := sind (a)
end SetAngleXZ
proc SetAngleYZ (a : real)
y := cosd (a)
z := sind (a)
end SetAngleYZ
proc Scale (X, Y, Z : real)
x *= X
y *= Y
z *= Z
end Scale
proc conv2d (xx, yy, zz, sc : real)
var xxx := x * sc
var yyy := y * sc
var zzz := z * sc
x2d := round ((xxx + xx) / ((zzz + zz) / 100)) + 320
y2d := round ((yyy + yy) / ((zzz + zz) / 100)) + 200
end conv2d
end Vector3D
var vector : ^Vector3D
new Vector3D, vector
var spike : ^Homer3Dengine
new Homer3Dengine, spike
spike -> load ("engine.raw", 140)
colorback (black)
cls
View.Set ("offscreenonly")
spike -> moveobject ("z", 10)
vector -> SetAngleXY (0)
vector -> SetAngleXZ (0)
vector -> SetAngleYZ (0)
var ang1, ang2, ang3 : real := 1
var chars : array char of boolean
ang2 := 90
ang3 := 90
const movement := 1
spike -> moveobject ("xz", 180)
var scz := 1
loop
% drawline (xx (1), xx (2),
Input.KeyDown (chars)
%ang1 -= movement
if chars ('a') then
ang2 += movement
%spike -> moveobject ("xz", -movement)
end if
if chars ('d') then
ang2 -= movement
%spike -> moveobject ("xz", movement)
end if
if chars ('w') then
ang3 -= movement
%spike -> moveobject ("yz", movement)
end if
if chars ('s') then
ang3 += movement
%spike -> moveobject ("yz", -movement)
end if
if chars (' ') then
scz += 1
end if
spike -> moveobject ("x", vector -> x)
spike -> moveobject ("y", vector -> y)
spike -> moveobject ("z", vector -> z)
spike -> drawobject (2, 10)
vector -> SetAngleXZ (ang2)
vector -> SetAngleYZ (ang3)
vector -> Scale (10, 10, scz)
vector -> conv2d (spike -> obj.cx, spike -> obj.cy, spike -> obj.cz, 100)
drawline (vector -> x2d, vector -> y2d, spike -> centerx, spike -> centery, 12)
View.Update
delay (5)
cls
end loop |