home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 11 / apfelpro.pro < prev    next >
Encoding:
Prolog Source  |  1987-08-19  |  3.5 KB  |  93 lines
  1. /*------------------------------------------------------------*/
  2. /*                       APFELPRO.PRO                         */
  3. /*                Iterative Prozeße in Prolog                 */
  4. /*   veranschaulicht anhand des fraktalen "Apfelmännchens"    */
  5. /*      Dipl. Ing. B. Heimbrecht & PASCAL INTERNATIONAL       */
  6. /*------------------------------------------------------------*/
  7.  
  8. domains            
  9.    i = integer
  10.    r = real
  11.    
  12. database
  13.    xtable(r,i)     /* Die Koordinaten aller Punkte in */
  14.    ytable(r,i,i)   /* der Database ablegen.           */
  15.  
  16. predicates
  17.    init
  18.    apple(i)
  19.    constants(i,i,r,r,r,r,i)  create_all_xy(i,i,r,r,r,r)
  20.    create_x(i,r,r,r)  create_y(i,r,r,r)  reflect(r,i,r)
  21.    iteration(r,r,r,r,i,i)
  22.    clear_database  
  23.    ok
  24.    
  25. goal init.
  26.           
  27. clauses
  28.  
  29. /*------------------------------------------------------------*/
  30. /*          Koordinaten aller Punkte berechnen                */  
  31. init :- 
  32.    clear_database, graphics(1, 1, 0), nl,nl,
  33.    write("          APFELPRO \n\n",
  34.          "  Tabellen werden erstellt\n\n",
  35.          "  bitte ca.  25 sec warten"), 
  36.    constants(PXmax, PYmax, XCmin, XCmax, YCmin, YCmax, Imax),
  37.    create_all_xy(PXmax, PYmax, XCmin, XCmax, YCmin, YCmax),
  38.    clearwindow, apple(Imax), !.
  39.  
  40. /*--------------------------------------------------------------*/   
  41. /*   Koordinaten-Punkte berechnen und in Tabelle abspeichern    */
  42. create_all_xy(PXmax, PYmax, XCmin, XCmax, YCmin, YCmax) :-
  43.    FX =32000/PXMax, DX =(XCmax-XCmin)/PXmax, 
  44.    FY =32000/PYMax, DY =(YCmax-YCmin)/PYmax,
  45.    create_x(PXmax, XCmin, FX, DX), create_y(PYmax, YCmin, FY, DY).
  46.    
  47. create_x(X, XCmin, FX, DX) :- 
  48.    X >0, !, Xn =X-1, XC =XCmin+DX*Xn, XP =FX*Xn,
  49.    asserta(xtable(XC, XP)), create_x(Xn, XCmin, FX, DX)
  50.    ; ok.
  51.    
  52. create_y(Y, YCmin, FY, DY) :- 
  53.    Y > 0, !, Yn = Y-1, YC = YCmin+DY*Yn, YP = FY*Yn,
  54.    reflect(YC, YP, DY), create_y(Yn, YCmin, FY, DY)
  55.    ; ok.
  56.  
  57. /*-- Spiegelung --*/   
  58. reflect(YC, YP, DY) :-   
  59.    ytable(YCs, YPs, 0), 
  60.    YC+YCS = Diff, DY/2 = Tol, Diff < Tol, Diff > -Tol,
  61.    retract(ytable(YCs,_,_)), asserta(ytable(YC, YP, YPs)), !
  62.    ; asserta(ytable(YC, YP, 0)).
  63.  
  64. /*------------------------------------------------------------*/
  65. /*             Vereinbarung der Konstanten                    */
  66. constants(PXmax, PYmax, XCmin, XCmax, YCmin, YCmax, Imax) :-
  67.    XCmin = -0.75, XCmax = +2.25,  /* Darstellungsfenster für */
  68.    YCmin = -1.25, YCmax = +1.25,  /*   das Apfelmännchen     */
  69.    Imax  =  50,                   /* max. Zahl  Iterationen  */
  70.    PXmax =  320, PYmax = 200.     /* Bildauflösung in Pixel  */ 
  71.  
  72. /*------------------------------------------------------------*/
  73. /* Bildpunkte mit Backtracking durchlaufen, jeweils Iteration */
  74. /* starten und Punkt setzen.                                  */
  75. apple(Imax) :-   
  76.    xtable(XC, XP), ytable(YC, YP, YPs), /* Koordinate holen */  
  77.    iteration(XC,YC, 0,0, Imax, Color),  /* itrieren         */
  78.    dot(YP, XP, Color), YPs <> 0, dot(YPs, XP, Color), 
  79.    fail                 /* Zurück und neue Koordinate holen */
  80.    ; readchar(_), !.
  81.    
  82. /*-- Iterationsschleife, Abbruch bei Imax oder Z^2 < 100 --*/   
  83. iteration(XC, YC, XZ, YZ, I, Color) :- 
  84.    X2 = XZ*XZ, Y2 = YZ*YZ, X2+Y2 < 100, !, I > 1, 
  85.    Xn = X2-Y2-XC, Yn = 2*XZ*YZ-YC, In = I-1,
  86.    iteration(XC, YC, Xn, Yn, In, Color) /* rekursiv */
  87.    ; Color = I mod 3 + 1.  /* Wenn Ende, Farbe zurueckgeben */
  88.    
  89. clear_database :- retract(_), fail
  90.                   ; ok.
  91.  
  92. ok.
  93.