type point :
record
x, y, z, w : real
end record
type plane :
record
a, b, c, d, e : real
end record
type line :
record
p1, p2 : point
end record
fcn new_point (x, y, z, w : real) : point
var hold_point : point
hold_point.x := x
hold_point.y := y
hold_point.z := z
hold_point.w := w
result hold_point
end new_point
fcn rotate_point (o, p : point, angle : point) : point
var rel, hold : point
hold := o
rel.z := (((hold.z - p.z) * cosd (angle.x)) + ((hold.y - p.y) * sind (angle.x)))
rel.y := (((hold.y - p.y) * cosd (angle.x)) - ((hold.z - p.z) * sind (angle.x)))
hold.y := p.y - rel.y
hold.z := p.z - rel.z
rel.z := (((hold.z - p.z) * cosd (angle.y)) + ((hold.x - p.x) * sind (angle.y)))
rel.x := (((hold.x - p.x) * cosd (angle.y)) - ((hold.z - p.z) * sind (angle.y)))
hold.x := p.x - rel.x
hold.z := p.z - rel.z
rel.x := (((hold.x - p.x) * cosd (angle.z)) + ((hold.y - p.y) * sind (angle.z)))
rel.y := (((hold.y - p.y) * cosd (angle.z)) - ((hold.x - p.x) * sind (angle.z)))
hold.y := p.y - rel.y
hold.x := p.x - rel.x
result hold
end rotate_point
fcn rotate_point_4d (o, p : point, angle, angle_4 : point) : point
var rel, hold : point
hold := o
rel.z := (((hold.z - p.z) * cosd (angle.x)) + ((hold.y - p.y) * sind (angle.x)))
rel.y := (((hold.y - p.y) * cosd (angle.x)) - ((hold.z - p.z) * sind (angle.x)))
hold.y := p.y - rel.y
hold.z := p.z - rel.z
rel.z := (((hold.z - p.z) * cosd (angle.y)) + ((hold.x - p.x) * sind (angle.y)))
rel.x := (((hold.x - p.x) * cosd (angle.y)) - ((hold.z - p.z) * sind (angle.y)))
hold.x := p.x - rel.x
hold.z := p.z - rel.z
rel.x := (((hold.x - p.x) * cosd (angle.z)) + ((hold.y - p.y) * sind (angle.z)))
rel.y := (((hold.y - p.y) * cosd (angle.z)) - ((hold.x - p.x) * sind (angle.z)))
hold.y := p.y - rel.y
hold.x := p.x - rel.x
rel.w := (((hold.w - p.w) * cosd (angle_4.x)) + ((hold.y - p.y) * sind (angle_4.x)))
rel.y := (((hold.y - p.y) * cosd (angle_4.x)) - ((hold.w - p.w) * sind (angle_4.x)))
hold.y := p.y - rel.y
hold.w := p.w - rel.w
rel.w := (((hold.w - p.w) * cosd (angle_4.y)) + ((hold.x - p.x) * sind (angle_4.y)))
rel.x := (((hold.x - p.x) * cosd (angle_4.y)) - ((hold.w - p.w) * sind (angle_4.y)))
hold.x := p.x - rel.x
hold.w := p.w - rel.w
rel.w := (((hold.w - p.w) * cosd (angle_4.z)) + ((hold.y - p.y) * sind (angle_4.z)))
rel.y := (((hold.y - p.y) * cosd (angle_4.z)) - ((hold.w - p.w) * sind (angle_4.z)))
hold.y := p.y - rel.y
hold.w := p.w - rel.w
result hold
end rotate_point_4d
fcn new_line (p1, p2 : point) : line
var hold_line : line
hold_line.p1 := p1
hold_line.p2 := p2
result hold_line
end new_line
fcn new_plane (a, b, c, d, e : real) : plane
var hold_plane : plane
hold_plane.a := a
hold_plane.b := b
hold_plane.c := c
hold_plane.d := d
hold_plane.e := e
result hold_plane
end new_plane
fcn intersect_plane_line (p : plane, l : line) : point
var numerator, denominator, u, n_x, n_y, n_z, n_w : real
numerator := p.a * l.p1.x + p.b * l.p1.y + p.c * l.p1.z + p.d * l.p1.w + p.e
denominator := p.a * (l.p1.x - l.p2.x) + p.b * (l.p1.y - l.p2.y) + p.c * (l.p1.z - l.p2.z) + p.d * (l.p1.w - l.p2.w)
if (denominator = 0) then
result new_point (0, 0, 0, 0)
else
u := numerator / denominator
end if
n_x := l.p1.x + u * (l.p2.x - l.p1.x)
n_y := l.p1.y + u * (l.p2.y - l.p1.y)
n_z := l.p1.z + u * (l.p2.z - l.p1.z)
n_w := l.p1.w + u * (l.p2.w - l.p1.w)
result new_point (n_x, n_y, n_z, n_w)
end intersect_plane_line
fcn project_point (p : point, view_plane : plane, view_point : point) : point
var hold_line : line
hold_line := new_line (p, view_point)
result intersect_plane_line (view_plane, hold_line)
end project_point
fcn generate_hyper_cube (size : real) : array 0 .. 15 of point
var point_list : array 0 .. 15 of point
var count : int := 0
for x : 0 .. 1
for y : 0 .. 1
for z : 0 .. 1
for w : 0 .. 1
point_list (count) := new_point (size * x, size * y, size * z, size * w)
count += 1
end for
end for
end for
end for
result point_list
end generate_hyper_cube
proc scale_hyper_cube (var cube : array 0 .. 15 of point, scale : point)
for i : 0 .. 15
cube (i).x *= scale.x
cube (i).y *= scale.y
cube (i).z *= scale.z
cube (i).w *= scale.w
end for
end scale_hyper_cube
proc translate_hyper_cube (var cube : array 0 .. 15 of point, trans : point)
for i : 0 .. 15
cube (i).x += trans.x
cube (i).y += trans.y
cube (i).z += trans.z
cube (i).w += trans.w
end for
end translate_hyper_cube
fcn get_center_of_cube (var cube : array 0 .. 15 of point) : point
var center : point := new_point (0, 0, 0, 0)
for i : 0 .. 15
center.x += cube (i).x
center.y += cube (i).y
center.z += cube (i).z
center.w += cube (i).w
end for
center.x /= 16
center.y /= 16
center.z /= 16
center.w /= 16
result center
end get_center_of_cube
proc rotate_hyper_cube (var cube : array 0 .. 15 of point, angle : point)
var center : point := get_center_of_cube (cube)
for i : 0 .. 15
cube (i) := rotate_point (cube (i), center, angle)
end for
end rotate_hyper_cube
proc rotate_hyper_cube_4d (var cube : array 0 .. 15 of point, angle, angle4 : point)
var center : point := get_center_of_cube (cube)
for i : 0 .. 15
cube (i) := rotate_point_4d (cube (i), center, angle, angle4)
end for
end rotate_hyper_cube_4d
proc print_point (p : point)
put "[", p.x, ",", p.y, ",", p.z, ",", p.w, "]"
end print_point
proc project_hyper_cube_4d (var cube : array 0 .. 15 of point, view_plane_4d : plane, view_point_4d : point)
for i : 0 .. 15
cube (i) := project_point (cube (i), view_plane_4d, view_point_4d)
end for
end project_hyper_cube_4d
proc project_hyper_cube_3d (var cube : array 0 .. 15 of point, view_plane_3d : plane, view_point_3d : point)
for i : 0 .. 15
cube (i) := project_point (cube (i), view_plane_3d, view_point_3d)
end for
end project_hyper_cube_3d
fcn distance_4d (p1, p2 : point) : real
result sqrt ((p2.x - p1.x) * (p2.x - p1.x) + (p2.y - p1.y) * (p2.y - p1.y) + (p2.z - p1.z) * (p2.z - p1.z) + (p2.w - p1.w) * (p2.w - p1.w))
end distance_4d
proc draw_hyper_cube (cube, cube_3d, orig : array 0 .. 15 of point, size : real)
var max_z, min_z, col_i, col_k, col, col1 : real
var origin : point := new_point (0, 0, 0, -10)
max_z := -1000
min_z := 1000000
for i : 0 .. 15
if (distance_4d (cube_3d (i), origin) > max_z) then
max_z := distance_4d (cube_3d (i), origin)
end if
if (distance_4d (cube_3d (i), origin) < min_z) then
min_z := distance_4d (cube_3d (i), origin)
end if
end for
for i : 0 .. 15
col_i := (distance_4d (cube_3d (i), origin) - min_z) / (max_z - min_z) * 7 + 22
col := col_i
drawfilloval (round (cube (i).x), round (cube (i).y), 3, 3, round (col))
end for
for i : 0 .. 15
for k : 0 .. 15
if (distance_4d (orig (i), orig (k)) = size) then
col_i := (distance_4d (cube_3d (i), origin) - min_z) / (max_z - min_z) * 10 + 20
col_k := (distance_4d (cube_3d (i), origin) - min_z) / (max_z - min_z) * 10 + 20
col := (col_i + col_k) - 2
col1 := (col_i + col_k) * 2
drawfillmapleleaf (round (cube (i).x), round (cube (i).y), round (cube (k).x), round (cube (k).y), round (col))
drawfillbox (round (cube (i).x) - 100, round (cube (i).y) - 100, round (cube (k).x) - 100, round (cube (k).y) - 100, round (col))
drawfillstar (round (cube (i).x), round (cube (i).y) - 100, round (cube (k).x), round (cube (k).y) - 100, round (col1))
drawfillstar (round (cube (i).x) - 100, round (cube (i).y), round (cube (k).x), round (cube (k).y), round (col1))
end if
end for
end for
end draw_hyper_cube
const cube_size := 1
var hyper_cube, hyper_cube_orig, hyper_3d_hold : array 0 .. 15 of point
hyper_cube_orig := generate_hyper_cube (cube_size)
var view_point_4d : point := new_point (0, 0, 0, -3)
var view_plane_4d : plane := new_plane (0, 0, 0, 3, 0)
var view_point_3d : point := new_point (0, 0, 300, 0)
var view_plane_3d : plane := new_plane (0, 0, -300, 0, 0)
View.Set ("offscreenonly,nobuttonbar,graphics:512;512")
module MouseInfo
export GetInfo, Left, Right, Middle, X, Y, OldX, OldY, DiffX, DiffY
buttonchoose ("multibutton")
var mX, mY : int := 0
var oldX, oldY : int := 0
var diffX, diffY : int
var button : int
var left, right, middle : int := 0
proc GetInfo
oldX := mX
oldY := mY
mousewhere (mX, mY, button)
diffX := oldX - mX
diffY := oldY - mY
left := (button mod 10)
middle := ((button - left) mod 100)
right := (button - middle - left)
end GetInfo
function Left : boolean
result left = 1
end Left
function Right : boolean
result right = 100
end Right
function Middle : boolean
result middle = 10
end Middle
function X : int
result mX
end X
function Y : int
result mY
end Y
function OldX : int
result oldX
end OldX
function OldY : int
result oldY
end OldY
function DiffX : int
result diffX
end DiffX
function DiffY : int
result diffY
end DiffY
end MouseInfo
var theta, tot_x, tot_y, tot_x_3d, tot_y_3d : real := 0
loop
hyper_cube := generate_hyper_cube (cube_size)
theta += 0.5
MouseInfo.GetInfo
if (MouseInfo.Left) then
tot_x -= MouseInfo.DiffX
tot_y += MouseInfo.DiffY
end if
if (MouseInfo.Right) then
tot_x_3d -= MouseInfo.DiffX
tot_y_3d += MouseInfo.DiffY
end if
rotate_hyper_cube_4d (hyper_cube, new_point (0, 0, 0, 0), new_point (0, tot_x, tot_y, 0))
project_hyper_cube_4d (hyper_cube, view_plane_4d, view_point_4d)
rotate_hyper_cube (hyper_cube, new_point (tot_y_3d, tot_x_3d, 0, 0))
scale_hyper_cube (hyper_cube, new_point (100, 100, 100, 100))
hyper_3d_hold := hyper_cube
project_hyper_cube_3d (hyper_cube, view_plane_3d, view_point_3d)
translate_hyper_cube (hyper_cube, new_point (maxx div 2.5, maxy div 2.5, 0, 0))
draw_hyper_cube (hyper_cube, hyper_3d_hold, hyper_cube_orig, cube_size)
View.Update
drawfillbox (0, 0, maxx, maxy, black)
end loop
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
