Files
mercury/extras/monte/geom.m
Zoltan Somogyi 9b6390b17e Bring the programming style of extras up to date.
extras/curs/curs.m:
extras/curs/curs.panel.m:
    Make panel a separate submodule of curs, not a nested submodule.

extras/base64/base64.m:
extras/curses/mcurses.basics.m:
extras/curses/mcurses.m:
extras/curses/mcurses.misc.m:
extras/curses/mcurses.user.m:
extras/gator/evolve.m:
extras/gator/genotype.m:
extras/gator/phenotype.m:
extras/gator/tausworthe3.m:
extras/monte/dots.m:
extras/monte/geom.m:
extras/monte/hg.m:
extras/monte/monte.m:
extras/monte/rnd.m:
extras/moose/grammar.m:
extras/moose/moose.m:
extras/mopenssl/mopenssl.m:
extras/net/echo.m:
extras/net/errno.m:
extras/net/getaddrinfo.m:
extras/net/net.m:
extras/net/netdb.m:
extras/net/sockets.m:
extras/net/streams.m:
extras/net/tcp.m:
extras/net/test_lookups.m:
extras/net/types.m:
extras/odbc/odbc.m:
extras/odbc/odbc_test.m:
extras/references/README:
extras/references/reference.m:
extras/references/scoped_update.m:
extras/solver_types/library/any.m:
extras/solver_types/library/any_array.m:
extras/solver_types/library/any_assoc_list.m:
extras/solver_types/library/any_list.m:
extras/solver_types/library/any_map.m:
extras/solver_types/library/any_tree234.m:
extras/solver_types/library/any_util.m:
extras/trail/trail.m:
extras/trailed_update/samples/interpreter.m:
extras/trailed_update/samples/vqueens.m:
extras/trailed_update/tests/var_test.m:
extras/trailed_update/tr_array.m:
extras/trailed_update/tr_store.m:
extras/trailed_update/trailed_update.m:
extras/trailed_update/unsafe.m:
extras/trailed_update/var.m:
    Bring programming style up to date.
2023-03-30 21:48:10 +11:00

133 lines
3.4 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2010 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
:- module geom.
:- interface.
:- import_module float.
:- type shape == pred(float, float, float).
:- inst shape == (pred(in, in, in) is semidet).
:- pred sphere(float::in, float::in, float::in) is semidet.
:- pred cylinder(float::in, float::in, float::in) is semidet.
:- pred cube(float::in, float::in, float::in) is semidet.
:- pred cone(float::in, float::in, float::in) is semidet.
:- pred torus(float::in, float::in, float::in, float::in) is semidet.
:- pred planeX(float::in, float::in, float::in) is semidet.
:- pred planeY(float::in, float::in, float::in) is semidet.
:- pred planeZ(float::in, float::in, float::in) is semidet.
:- pred union(shape::in(shape), shape::in(shape),
float::in, float::in, float::in) is semidet.
:- pred intersection(shape::in(shape), shape::in(shape),
float::in, float::in, float::in) is semidet.
:- pred difference(shape::in(shape), shape::in(shape),
float::in, float::in, float::in) is semidet.
:- pred translate(shape::in(shape), float::in, float::in, float::in,
float::in, float::in, float::in) is semidet.
:- pred scale(shape::in(shape), float::in, float::in, float::in,
float::in, float::in, float::in) is semidet.
:- pred rotateX(shape::in(shape), float::in,
float::in, float::in, float::in) is semidet.
:- pred rotateY(shape::in(shape), float::in,
float::in, float::in, float::in) is semidet.
:- pred rotateZ(shape::in(shape), float::in,
float::in, float::in, float::in) is semidet.
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module math.
%-----------------------------------------------------------------------------%
sphere(X, Y, Z) :-
sqr(X) + sqr(Y) + sqr(Z) =< 1.0.
cylinder(X, Y, Z) :-
sqr(X) + sqr(Y) =< 1.0,
0.0 =< Z, Z =< 1.0.
cube(X, Y, Z) :-
0.0 =< X, X =< 1.0,
0.0 =< Y, Y =< 1.0,
0.0 =< Z, Z =< 1.0.
cone(X, Y, Z) :-
0.0 =< Z, Z =< 1.0,
sqr(X) + sqr(Y) =< 1.0 - Z.
torus(R, X, Y, Z) :-
sqr(sqrt(sqr(X) + sqr(Z)) - 1.0) + sqr(Y) =< sqr(R).
planeX(X, _, _) :-
X >= 0.0.
planeY(_, Y, _) :-
Y >= 0.0.
planeZ(_, _, Z) :-
Z >= 0.0.
union(A, B, X, Y, Z) :-
(
call(A, X, Y, Z)
;
call(B, X, Y, Z)
).
intersection(A, B, X, Y, Z) :-
call(A, X, Y, Z),
call(B, X, Y, Z).
difference(A, B, X, Y, Z) :-
call(A, X, Y, Z),
not call(B, X, Y, Z).
translate(Shape, Dx, Dy, Dz, X, Y, Z) :-
call(Shape, X - Dx, Y - Dy, Z - Dz).
scale(Shape, Sx, Sy, Sz, X, Y, Z) :-
call(Shape, X / Sx, Y / Sy, Z / Sz).
rotateX(Shape, Th, X, Y, Z) :-
Sth = sin(-Th),
Cth = cos(-Th),
call(Shape, X, Cth * Y - Sth * Z, Sth * Y + Cth * Z).
rotateY(Shape, Th, X, Y, Z) :-
Sth = sin(-Th),
Cth = cos(-Th),
call(Shape, Cth * X + Sth * Z, Y, -Sth * X + Cth * Z).
rotateZ(Shape, Th, X, Y, Z) :-
Sth = sin(-Th),
Cth = cos(-Th),
call(Shape, Cth * X - Sth * Y, Sth * X + Sth * Y, Z).
:- func sqr(float) = float.
sqr(X) = X * X.