home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / lifeos2.zip / LIFE-1.02 / EXAMPLES / FLO_GRAM.LF < prev    next >
Text File  |  1996-06-04  |  18KB  |  597 lines
  1. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3. %
  4. %                      LINDENMAYER SYSTEMS TRANSLATOR
  5. %
  6. %
  7. % The syntax of the rules is the following:
  8. %
  9. % Axiom ::> List of Symbols ?
  10. % Head ** Conditions ==>   List of Symbols 
  11. %
  12. % Applying one derivation step to a sequence of symbols results in replacing in
  13. % the sequence each symbol by the left hand side of a rule, provided that the
  14. % head of the rule and the symbol match. 
  15. % If a condition is attached to a rule, and if it is not satisfied, then the
  16. % rule cannot be used, and the system looks for another matching rule.
  17. % A set of rules with the same head may be declared as equi-probabilistic;
  18. % Symbols may have arguments; 
  19. %
  20. % A fixed number of derivations (see the complexity field in the interface) 
  21. % is applied to a sequence of symbols declared as the axiom of the L-system;
  22. % This results in a long sequence of symbols which are interpreted graphically.
  23. %
  24. % In this program, the interpretation is done on the fly, using the standard
  25. % derivation mechanism of Life. The interpretation of a symbol is specified by
  26. % declaring a predicate whose head is the symbol.
  27. %
  28. % This file provides a library of symbols (turtle symbols), that perform the
  29. % basic drawing operations.
  30. %
  31. % The method used to translate L-systems into Life code is not the most naive
  32. % one. We have tried to generate a code that, as far as possible, recovers
  33. % memory automatically, and is quite efficient. Each rule of the system is in
  34. % fact translated into three clauses (a naive implementation would generate
  35. % only one clause).
  36. %
  37. % This file is loaded automatically by the main file of the demo.
  38. % 
  39. % Author: Bruno Dumant
  40. %
  41. % Copyright 1992 Digital Equipment Corporation                                
  42. % All Rights Reserved                                                         
  43. %
  44. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  45. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  46.  
  47. module("rewrite_trans") ?
  48.  
  49. open("utils") ?
  50.  
  51. public( ==>,::>,**) ?
  52. op(1200,xfy,==>)?
  53. op(1200,xfy,::>)?
  54. op(1100,xfy,**)?
  55.  
  56. non_strict(**)?
  57.  
  58. %
  59. %  translation of axioms and rules 
  60. %
  61.  
  62. (Lhs ** Chs ==> Rhs) :-  !,
  63.     NewLhs = transSymb(Lhs,position=>head),
  64.     NewRhs = transSymb(Rhs,position=>body),!,
  65.     (prob_symb(root_sort(Lhs),_), !, T=true ; T=false ),
  66.     ( 
  67.           R1 = oneLevel(NewLhs,NewRhs,Chs,T),
  68.            assert(R1),
  69.            fail ;
  70.       R2 = twoLevel(NewLhs,NewRhs,Chs),
  71.                assert(R2),
  72.            fail ;
  73.       RN = nLevel(NewLhs,NewRhs,Chs,T),
  74.            assert(RN),
  75.            fail ;
  76.       succeed ).
  77.  
  78. (Lhs ==> Rhs) :-  
  79.     NewLhs = transSymb(Lhs,position=>head),
  80.     NewRhs = transSymb(Rhs,position=>body),!,
  81.     (prob_symb(root_sort(Lhs),_), !, T=true ; T=false ),
  82.     ( R1 = oneLevel(NewLhs,NewRhs,1,T),
  83.            assert(R1),
  84.            fail ;
  85.       R2 = twoLevel(NewLhs,NewRhs,1),
  86.                assert(R2),
  87.            fail ;
  88.       RN = nLevel(NewLhs,NewRhs,1,T),
  89.            assert(RN),
  90.            fail ;
  91.       succeed ).
  92.  
  93.  
  94. (Axiome ::> Rhs ) :-
  95.     Axiome.1 = N, 
  96.         R=newn(Rhs,N,_,_,_,_),
  97.     assert(( Axiome :- N>=2, R )).
  98.  
  99.                     
  100. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  101. %
  102. %  symbol translation
  103. %
  104. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  105.  
  106. %%% transSymb takes care of probabilistic rules: transSymb adds the appropriate
  107. %%% arguments to the symbols declared by probSymbol.
  108.  
  109. public(proba) ?
  110.  
  111. transSymb((Symbol,Others),position=>P) -> 
  112.     Symbol , transSymb(Others,position=>P)
  113.                         | Others :< @, !,
  114.               (prob_symb(Symbol,NumRules),!,     
  115.                Symbol.proba = `(random(NumRules)) ;
  116.                succeed ) .
  117. transSymb( Symbol,position=>P) -> 
  118.     Symbol | (prob_symb(Symbol,NumRules),!,
  119.               cond(P:==head,
  120.                (
  121.                I = index(Symbol),
  122.                I:@(Index),
  123.                Symbol.proba = Index, 
  124.                setPred(I,Index+1)
  125.                ),
  126.                Symbol.proba = `(random(NumRules))
  127.            );
  128.            succeed ) .
  129.  
  130. public(probSymbol) ?
  131. dynamic(prob_symb)?
  132.  
  133. probSymbol(Symbol,N) :- F=index(Symbol),
  134.                         setPred(F,0),
  135.                         M = N-1, 
  136.                         assert(prob_symb(X,M):- X :== Symbol ).
  137.  
  138. index(Symbol) -> str2psi(strcon("index",psi2str(Symbol))).
  139.  
  140. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  141.  
  142. %%% oneLevel rewrites (a ** cond ==> b,c) into (a1 :- cond, !, b, c) 
  143. %%% and adds the appropriate arguments.
  144.  
  145. oneLevel(Lhs ,Rhs, 1,true) -> 
  146.       ( new1h(Lhs,X,Y) :- !, new1b(Rhs,X,Y,[],S,[],S2) ).
  147. oneLevel(Lhs ,Rhs, 1,false) -> 
  148.       ( new1h(Lhs,X,Y) :- new1b(Rhs,X,Y,[],S,[],S2) ).
  149.  
  150. oneLevel(Lhs ,Rhs, Chs,B) -> 
  151.     ( new1h(Lhs,X,Y) :- Chs, !, new1b(Rhs,X,Y,[],S,[],S2) ).
  152.  
  153. public(oldState,newState) ?
  154. new1h(Symbol,X,Y) -> NS | NS=suffixRoot(Symbol,"1"),
  155.                           NS=strip(Symbol),
  156.                           NS.oldState = X,
  157.                           NS.newState = Y.
  158.  
  159. new1b((Symbol,Others),X,Y,S1,S3,SP1,SP3) -> 
  160.     new1b(Symbol,X,Z,S1,S2,SP1,SP2), 
  161.     new1b(Others,Z,Y,S2,S3,SP2,SP3).
  162.                          
  163. public(push,pop,startPol,endPol,dot) ?
  164.  
  165. new1b(push,X,Y,S1,S2,SP1,SP2) -> succeed | S2=[X|S1],Y=X,SP1=SP2.
  166. new1b(pop,X,Y,S1,S2,SP1,SP2) ->  succeed | S1=[Y|S2],SP1=SP2.
  167.  
  168. new1b(startPol,X,Y,S1,S2,SP1,SP2) -> 
  169.     succeed | S2=S1, Y=X, [[(X.coord.1,X.coord.2)]|SP1]=SP2.
  170. new1b(endPol,X,Y,S1,S2,SP1,SP2) -> 
  171.     endPol(L) | S2=S1, Y=X, SP1=[L|SP2].
  172. new1b(dot,X,Y,S1,S2,SP1,SP2) -> 
  173.     succeed | S2=S1, Y=X, SP1=[L|SP3], 
  174.                   SP2=[[(X.coord.1,X.coord.2)|L]|SP3].                                        
  175. new1b(Symbol,X,Y,S1,S2,SP1,SP2) -> NS | NS=root_sort(Symbol),
  176.                           NS=stripNoProba(Symbol),
  177.               NS.oldState = X,
  178.                           NS.newState = Y,
  179.                           S1=S2, 
  180.               SP1=SP2.
  181.  
  182. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  183.  
  184. %%% twoLevel rewrites (a ** cond ==> b,c) into 
  185. %%%                   (aN :- cond, !, ( b1, c1, fail ; succeed )),
  186. %%% and adds the appropriate arguments, and performing the right state
  187. %%% assignments (otherwise the turtle state would be lost on backtracking). The
  188. %%% reason for this is mainly memory recovery.
  189.  
  190. twoLevel(Lhs ,Rhs, 1) -> 
  191.     ( 
  192.         new2h(Lhs) :- !,
  193.         ( 
  194.         new2b(Rhs,`state,Y,[],S,[],S2), setq(`state,Y),
  195.         fail ; succeed 
  196.         )
  197.     ).
  198. twoLevel(Lhs ,Rhs, Chs) -> 
  199.     ( 
  200.         new2h(Lhs) :- Chs, !,
  201.         ( 
  202.         new2b(Rhs,`state,Y,[],S,[],S2), setq(`state,Y),
  203.         fail ; succeed 
  204.         )
  205.     ).
  206.                              
  207.  
  208. new2h(Symbol) -> NS | NS=suffixRoot(Symbol,"N"),
  209.                       NS=strip(Symbol),
  210.                       NS.rank=2.
  211.  
  212. new2b((Symbol,Others),X,Y,S1,S3,SP1,SP3) -> 
  213.     new2b(Symbol,X,Z,S1,S2,SP1,SP2), 
  214.     new2b(Others,Z,Y,S2,S3,SP2,SP3). 
  215.         
  216. new2b(push,X,Y,S1,S2,SP1,SP2) -> succeed | S2=[X|S1],Y=X,SP1=SP2.
  217. new2b(pop,X,Y,S1,S2,SP1,SP2) ->  succeed | S1=[Y|S2],SP1=SP2.
  218.  
  219. new2b(startPol,X,Y,S1,S2,SP1,SP2) -> 
  220.     succeed | S2=S1, Y=X, [[(X.coord.1,X.coord.2)]|SP1]=SP2.
  221. new2b(endPol,X,Y,S1,S2,SP1,SP2) -> 
  222.     endPol(L) | S2=S1, Y=X, SP1=[L|SP2].
  223. new2b(dot,X,Y,S1,S2,SP1,SP2) -> 
  224.     succeed | S2=S1, Y=X, SP1=[L|SP3], 
  225.                   SP2=[[(X.coord.1,X.coord.2)|L]|SP3].
  226.  
  227. new2b(Symbol,X,Y,S1,S2,SP1,SP2) -> NS 
  228.         | R=root_sort(Symbol),
  229.           ( turtleSymb(R), !, NS=R ; NS=suffixRoot(R,"1")),
  230.           NS=strip(Symbol),
  231.           NS.oldState = `(X),
  232.           NS.newState = Y,
  233.           S1=S2,
  234.           SP1=SP2.
  235.  
  236. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  237.  
  238. %%% twoLevel rewrites (a ** cond  ==> b,c) into 
  239. %%%             (aN(N) :- cond, !, ( M = N-1, bN(M), cN(M), fail ; succeed )) 
  240.  
  241.  
  242. nLevel(Lhs ,Rhs, 1,true) -> 
  243.     ( newn(Lhs,N,_,_,_,_) :- !,
  244.           ( `(M=N-1),newn(Rhs,M,[],_,[],_), fail ; succeed )).
  245. nLevel(Lhs ,Rhs, 1,false) -> 
  246.     ( newn(Lhs,N,_,_,_,_) :-
  247.           ( `(M=N-1),newn(Rhs,M,[],_,[],_), fail ; succeed )).
  248. nLevel(Lhs ,Rhs, Chs) -> 
  249.     ( newn(Lhs,N,_,_,_,_) :- Chs, !,
  250.           ( `(M=N-1),newn(Rhs,M,[],_,[],_), fail ; succeed )).
  251.  
  252.  
  253. newn((Symbol,Others),N,S1,S3,SP1,SP3) -> 
  254.     newn(Symbol,N,S1,S2,SP1,SP2), 
  255.     newn(Others,N,S2,S3,SP2,SP3).
  256.  
  257. newn(push,N,S1,S2,SP1,SP2) -> S2=[`state|S1],SP1=SP2.
  258. newn(pop,N,S1,S2,SP1,SP2) ->  S1=[Y|S2],setq(`state,Y),SP1=SP2.
  259.  
  260. newn(startPol,N,S1,S2,SP1,SP2) -> 
  261.     startPol(SP1,SP2) | S2=S1, Y=X. 
  262. newn(endPol,N,S1,S2,SP1,SP2) -> 
  263.     endPol(L) | S2=S1, Y=X, SP1=[L|SP2].
  264. newn(dot,N,S1,S2,SP1,SP2) -> 
  265.     dot(SP1,SP2)| S2=S1, Y=X.
  266.  
  267. newn(Symbol,N,S1,S2,SP1,SP2) -> NS 
  268.         | NS=suffixRoot(Symbol,"N"),
  269.           NS=strip(Symbol),
  270.           NS.rank=N,
  271.           S1=S2,
  272.           SP1=SP2.
  273.  
  274.  
  275. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  276.  
  277. %%% utility: get rid of the proba feature in a term
  278.  
  279. stripNoProba(Symbol) -> X | strNP(X,features(Symbol),Symbol).
  280.  
  281.  
  282. strNP(X,[],Symbol) :- !.
  283. strNP(X,[proba|L],Symbol) :- !.
  284. strNP(X,[A|L],Symbol) :- X.A = Symbol.A.
  285.  
  286.  
  287. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  288. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  289. %
  290. % L-Grammars : definition of "turtle" symbols
  291. %
  292. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  293. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  294.  
  295. %%% We implement here a 3D turtle:
  296. %%% fd(A) means translating the turtle of length d, and drawing the line;
  297. %%% fu(A) means translating the turtle of length d, and without drawing the
  298. %%%       line; 
  299. %%% u,l,h in the rp... and rm... symbols designate the three axes of the
  300. %%% turtle. rpX(A) means that a positive rotation of angle A is performed
  301. %%% around the X axe. rmX means that a fixed negative rotation of angle A is
  302. %%% performed around the X axe.
  303. %%%
  304. %%% turn means that the turtle goes in the opposite direction.
  305. %%%
  306. %%% decThick and setThick are not actually turtle symbols, but are used to
  307. %%% decrement or set the thickness of the lines drawn. setDefault is used to
  308. %%% reset the default color.
  309.  
  310. public(rpu,rmu,rpl,rml,rph,rmh,turn,fd,fu,decThick,setThick,setDefault) ?
  311. public(rpuN,rmuN,rplN,rmlN,rphN,rmhN,turnN,fdN,fuN,
  312.         decThickN,setThickN,setDefaultN) ?
  313. turtleSymb({rpu(A);rmu;rpl(A);rml;rph(A);rmh;turn;fd(A);fu(A);
  314.             decThick;setThick(A);setDefault}).
  315.  
  316. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  317. %
  318. % generation of the n-level definitions.
  319. %
  320. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  321.  
  322. genTurtleDefs :-  
  323.     turtleSymb(Symb), 
  324.     T = copy_pointer(Symb),
  325.     T.oldState=`state,
  326.     T.newState=NS,
  327.     NT=suffixRoot(Symb,"N"),
  328.         NT=strip(Symb),
  329.     NT.rank=N,
  330.     assert((NT :- ( T,
  331.                 setq(state,NS),fail ; succeed )) 
  332.                ),
  333.     fail .
  334.  
  335. genTurtleDefs.
  336.  
  337. genTurtleDefs ?
  338.  
  339. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  340. %
  341. % Basic definitions
  342. %
  343. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  344.  
  345. %
  346. %
  347. %  Rotations
  348. %
  349. %
  350.  
  351. rpu(A,oldState => turtleState(coord => C,
  352.                             direc => D:@(TH,TL,TU),
  353.                 thick => T ),
  354.     newState => NS) :- 
  355.         ( A:==@,!,Cos=cosDelta,Sin=sinDelta ;
  356.                   Cos=cos(A),Sin=sin(A)),
  357.     NS = turtleState(coord => C,
  358.                          direc => @(xmat(TH,TL,Cos,-Sin),
  359.                                     xmat(TH,TL,Sin,Cos),
  360.                     TU ),
  361.                          thick => T). 
  362.  
  363.  
  364. rmu(oldState => turtleState(coord => C,
  365.                             direc => D:@(TH,TL,TU),
  366.                 thick => T),
  367.     newState => NS ) :- 
  368.         @=@(Cos:cosDelta,Sin:sinDelta),
  369.     NS = turtleState(coord => C,
  370.                          direc => @(xmat(TH,TL,Cos,Sin),
  371.                                     xmat(TH,TL,-Sin,Cos),
  372.                     TU ),
  373.                          thick => T). 
  374.  
  375.  
  376.  
  377.  
  378. rpl(A,oldState => turtleState(coord => C,
  379.                             direc => D:@(TH,TL,TU),
  380.                 thick => T ),
  381.     newState => NS ) :- 
  382.     ( A:==@,!,Cos=cosDelta,Sin=sinDelta ;
  383.                   Cos=cos(A),Sin=sin(A)),
  384.             NS =turtleState(coord => C,
  385.                             direc => @(xmat(TH,TU,Cos,Sin),
  386.                                        TL,
  387.                        xmat(TH,TU,-Sin,Cos)),
  388.                 thick => T).               
  389.  
  390. rml(oldState => turtleState(coord => C,
  391.                                direc => D:@(TH,TL,TU),
  392.                    thick => T ),
  393.     newState => NS ) :- 
  394.     @=@(Cos:cosDelta,Sin:sinDelta),
  395.     NS =turtleState(coord => C,
  396.                     direc => @(xmat(TH,TU,Cos,-Sin),
  397.                                TL,
  398.                    xmat(TH,TU,Sin,Cos)),
  399.                     thick => T).                             
  400.  
  401.  
  402.  
  403.  
  404. rph(A,oldState => turtleState(coord => C,
  405.                                direc => D:@(TH,TL,TU),
  406.                    thick => T ),
  407.     newState => NS ) :- 
  408.     ( A:==@,!,Cos=cosDelta,Sin=sinDelta ;
  409.                   Cos=cos(A),Sin=sin(A)),
  410.     NS =turtleState(coord => C,
  411.                     direc => @(TH,
  412.                                    xmat(TL,TU,Cos,Sin),
  413.                    xmat(TL,TU,-Sin,Cos)),
  414.             thick => T).                       
  415.  
  416.  
  417.  
  418. rmh(oldState => turtleState(coord => C,
  419.                                direc => D:@(TH,TL,TU),
  420.                    thick => T,
  421.                                stack => S ),
  422.     newState => NS ) :- 
  423.     @=@(Cos:cosDelta,Sin:sinDelta),
  424.     NS =turtleState(coord => C,
  425.                     direc => @(TH,
  426.                                xmat(TL,TU,Cos,-Sin),
  427.                    xmat(TL,TU,Sin,Cos)),
  428.                     thick => T).              
  429.  
  430.  
  431.  
  432.  
  433. turn(oldState => turtleState(coord => C,
  434.                                direc => D:@(TH,TL,TU),
  435.                    thick => T ),
  436.      newState => NS ) :- 
  437.     NS =turtleState(coord => C,
  438.                         direc => @(xmat(TH,TL,-1,0),
  439.                                    xmat(TH,TL,0,-1),
  440.                    TU ),
  441.             thick => T).              
  442.  
  443. %
  444. % drawing
  445. %
  446.  
  447. public(draw_window,drFunc,drColor,realDistance) ?
  448. fd(R,
  449.    oldState => OS:turtleState(coord => @(X, Y, Z),
  450.                               direc => D:@(@(XH,YH,ZH),TL,TU),
  451.                   thick => T),
  452.    newState => NS ) :- 
  453.         cond( R:== @, R = realDistance ),
  454.     NS = turtleState( coord => @( X1: (X+R*XH),
  455.                                       Y1: (Y-R*YH),
  456.                       Z
  457.                                    ),
  458.               direc => D,
  459.               thick => T),
  460.     @ = @( DW:draw_window, DF:drFunc, DC:drColor),
  461.     xDrawLine(DW,X,Y,X1,Y1,color=>DC,function=>DF,linewidth=>floor(T)).
  462.  
  463.  
  464. fu(oldState => turtleState(coord => @(X, Y, Z),
  465.                            direc => D:@(@(XH,YH,ZH),TL,TU),
  466.                thick => T),
  467.    newState => NS ) :- 
  468.         (R:==@,!,R=realDistance ; succeed),
  469.     NS =turtleState( coord =>@(X1:(X+R*XH),
  470.                                    Y1:(Y-R*YH),
  471.                     %  Z1:(Z+R*ZH)
  472.                                    Z
  473.                            ),
  474.                          direc => D,
  475.              thick => T).
  476.  
  477.  
  478. %
  479. % decremente thick
  480. %
  481.  
  482. decThick(oldState => turtleState(coord => C,
  483.                                  direc => D,
  484.                      thick => T),
  485.          newState => NS ) :- 
  486.      NS =turtleState( coord => C,
  487.                           direc => D,
  488.               thick => T*0.702).
  489.  
  490. %
  491. % set Thick
  492. %
  493.  
  494. setThick(A,oldState => turtleState(coord => C,
  495.                                    direc => D,
  496.                        thick => T),
  497.            newState => NS ) :- 
  498.     NS =turtleState( coord => C,
  499.                          direc => D,
  500.              thick => A).
  501.  
  502.  
  503. %
  504. % Back to default values
  505. %
  506.  
  507. public(defaultColor) ?
  508.  
  509. setDefault( oldState => S , newState => S) :- 
  510.     setq(drColor,defaultColor).
  511.  
  512.  
  513.  
  514. %%% Symbols used to draw polygons.
  515.  
  516.  
  517. startPol(SP1,[[(X:(state.coord).1,X.2)]|SP1]).
  518.  
  519. endPol(L) :- xFillPolygon(draw_window,L,color=>drColor).
  520.  
  521. dot([L1|L2],[[(X:(state.coord).1,X.2)|L1]|L2]).
  522.  
  523.  
  524. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  525. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  526. %
  527. % L-Grammars : initialization predicates, and default values
  528. %
  529. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  530. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  531.  
  532. %%% Turtle's initial position
  533.  
  534. public(initPosition) ?
  535. initPosition(X,Y,Z:{0;real}) :- 
  536.     !,
  537.     S = state,
  538.     S.coord <- @(X,Y,Z),
  539.     setq(state,S).
  540.  
  541.  
  542. %%% Turtle's initial orientation
  543.  
  544. public(initDirection) ?
  545. initDirection(AH,AL,AU) :- 
  546.     S = state,
  547.     S.direc <- 
  548.        turnU(AU,turnH(AH,turnL(AL,@(@(0,1,0),@(-1,0,0),@(0,0,1))))),
  549.     setq(state,S).
  550.  
  551. turnU(AU,@(TH,TL,TU)) ->  @(xmat(TH,TL,Cos:cos(AU),-(Sin:sin(AU))),
  552.                           xmat(TH,TL,Sin,Cos),
  553.                           TU ).
  554. turnH(AH,@(TH,TL,TU)) ->  @(TH,
  555.                           xmat(TL,TU,Cos:cos(AH),Sin:sin(AH)),
  556.                           xmat(TL,TU,-Sin,Cos)).
  557. turnL(AL,@(TH,TL,TU)) ->  @(xmat(TH,TU,Cos:cos(AL),Sin:sin(AL)),
  558.                           TL,
  559.               xmat(TH,TU,-Sin,Cos)).
  560.  
  561.  
  562. %%% Turtle's initial color
  563.  
  564. public(initColor) ?
  565. initColor(C) :- setq(defaultColor,C),
  566.                 setq(drColor,C).
  567.  
  568.  
  569.  
  570. %%% Turtle's initial thickness
  571.  
  572. public(initThick) ?
  573. initThick(T) :- (X:state).thick <- T,
  574.                 setq(state,X).
  575.  
  576.  
  577. %%% Pre-Computing of cosinus and sinus
  578.  
  579. public(initAngle) ?
  580. public(delta) ?
  581. initAngle(Delta) :- setq(cosDelta,cos(Delta)),
  582.                     setq(sinDelta,sin(Delta)),
  583.                     setq(delta,Delta).
  584.  
  585.  
  586. %%% default values
  587.  
  588. initColor(xBlack)?
  589.  
  590. setq(cosDelta,0)?
  591. setq(sinDelta,1)?
  592. setq(realDistance,20)?
  593. setq(drFunc,xCopy) ?
  594. setq(state,turtleState( coord => @(0,0,0),
  595.                         direc => @(@(0,1,0),@(-1,0,0),@(0,0,1)),
  596.                         thick => 0 )) ?
  597.