This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/CLPQR/clpqr/examples/monash/toolpath
vsc e5f4633c39 This commit was generated by cvs2svn to compensate for changes in r4,
which included commits to RCS files with non-trunk default branches.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@5 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2001-04-09 19:54:03 +00:00

117 lines
2.1 KiB
Plaintext

/*
**********************************************************************
*
* CLP(R) Version 2.0 (Example Programs Release)
* (C) Copyright, March 1986, Monash University
*
**********************************************************************
*/
%
% Program to translate declarative machine tool path descriptions into
% code for a programmable controller.
%
move_p(p(_,X,Y)):-
printf("G00 X%-.3f Y%-.3f\n",[X,Y]).
draw_p(p(_,X,Y)):-
printf("G01 X%-.3f Y%-.3f\n",[X,Y]).
lookup(X,[X|T]).
lookup(X,[H|T]):-
lookup(X,T).
path([p(N)|T],DB):-
lookup(p(N,X,Y),DB),
move_p(p(N,X,Y)),
rest_path(T,DB).
rest_path([p(N)|T],DB):-
lookup(p(N,X,Y),DB),
draw_p(p(N,X,Y)),
rest_path(T,DB).
rest_path([],_).
make_vars([H|T],V,[NV|EV]):-
get_vars(H,NV),
make_vars(T,V,EV).
make_vars([],V,V).
get_vars(p(N,xy(X,Y)),p(N,X,Y)).
get_vars(p(N,l(A),l(B)),p(N,X,Y)).
get_vars(l(N,mc(M,C)),l(N,M,C)).
get_vars(l(N,p(A),p(B)),l(N,M,C)).
make_constraints([H|T],V):-
get_constraint(H,V),
make_constraints(T,V).
make_constraints([],_).
get_constraint(p(N,l(A),l(B)),V):-
Y = M1 * X + C1,
Y = M2 * X + C2,
lookup(p(N,X,Y),V),
lookup(l(A,M1,C1),V),
lookup(l(B,M2,C2),V).
get_constraint(l(N,p(A),p(B)),V):-
X1 = X2,
M = 10000000,
Y1 = M * X1 + C,
lookup(l(N,M,C),V),
lookup(p(A,X1,Y1),V),
lookup(p(B,X2,Y2),V).
get_constraint(l(N,p(A),p(B)),V):-
Y1 = M * X1 + C,
Y2 = M * X2 + C,
neq_r(X1,X2),
lookup(l(N,M,C),V),
lookup(p(A,X1,Y1),V),
lookup(p(B,X2,Y2),V).
get_constraint(p(_,xy(_,_)),_).
get_constraint(l(_,mc(_,_)),_).
neq_r(X,Y):- Y > X .
neq_r(X,Y):- X > Y .
make_db([p(N,X,Y)|T],DB,[p(N,X,Y)|EDB]):-
make_db(T,DB,EDB).
make_db([l(N,M,C)|T],DB,EDB):-
make_db(T,DB,EDB).
make_db([],DB,DB).
geometry(X,DB):-
make_vars(X,[],V),
make_db(V,[],DB),
make_constraints(X,V).
go:- geometry(
[
p(1,xy(10,10)),
p(2,xy(10,20)),
p(3,xy(20,10)),
p(4,xy(20,20)),
l(1,p(1),p(4)),
l(2,p(2),p(3)),
p(5,l(1),l(2))
],
DB
),
path(
[
p(1),
p(2),
p(5),
p(1)
],
DB
).
% Output:
% G00 X10.000 Y10.000
% G01 X10.000 Y20.000
% G01 X15.000 Y15.000
% G01 X10.000 Y10.000
?- printf("\n>>> Sample goal: go/0\n", []).