home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1998 November / PCO_1198.ISO / filesbbs / os2 / tspg202s.arj / TSPG202S.ZIP / Scripts / MANDEL.CWX < prev    next >
Encoding:
Text File  |  1997-05-04  |  6.4 KB  |  267 lines
  1. /*
  2.  
  3.   mandel.cwx
  4.  
  5.   Calculates and displays a subset of the Mandelbrot Set.
  6.   
  7.  Copyright 1997 by TrueSpectra Inc.                                  
  8.                                                                      
  9.  This code is provided purely for demonstration purposes and is not  
  10.  supported or under warranty.  Feel free to modify and examine this  
  11.  example script for your own purposes.                               
  12.  
  13. */
  14.  
  15.  
  16. /* *********Edit these values to edit new regions.************/
  17. /* Resolution: */
  18. resx=16; resy=16    /* High rez.*/
  19. /*resx=8; resy=8*/    /* Low rez.*/
  20.  
  21. cx=-0.782396718; cy=0.11763382; cw=0.012799782/resx; ch=0.012799782/resy
  22.  
  23. /* Alternate set:*/
  24. /*cx=-2; cy=-1.7; cw=3.4/resx; ch=3.4/resy*/
  25.  
  26.  
  27. /******************* Editable section ends.********************/
  28.  
  29.  
  30. realx=1; realy=1
  31.  
  32. call makerectangle realx*resx/2,realy*resy/2,realx*resx+realx/2,realy*resy+realy/2,0,0,0
  33.  
  34. do xx=0 to resx-1
  35.    do yy=0 to resy-1
  36.       call tesselate xx*realx,yy*realy,realx,realy,xx*cw+cx,yy*ch+cy,cw,ch
  37.    end /* do */
  38. end /* do */
  39.  
  40. return
  41.  
  42. /* subroutines */
  43. tesselate: procedure
  44.     parse arg x,y,w,h,mx,my,mw,mh
  45.  
  46.     r5o4r2 = /* sqrt(5)/(4*sqrt(2)) */ 0.3952847
  47.     r10 = /* sqrt(10) */ 3.1622777
  48.     n1or10 = 1 / r10
  49.     n3o4 = 3 / 4;
  50.     n5o4 = 5 / 4;
  51.     n3o4r10 = 0.2371708;
  52.     n1mr10o2 = (1 - r10) / 4;
  53.     n1pr10o3 = (1 + r10) / 3;
  54.     n1pr10o2 = (1 + r10) / 2;
  55.     q = 0.03
  56.  
  57.     /* A */
  58.     /* rectangle */
  59.     sx = x + 0.125 * w
  60.     sy = y + 0.875 * h
  61.     sw = (r5o4r2 - n5o4 * q) * w
  62.     sh = (n1or10 - q) * h
  63.     sa = 0.3217505
  64.     ss = 0.6435011
  65.     c = iterate( mx + 0.125 * mw, my + 0.875 * mh)
  66.     if c\=0 then call makerectangle sx,sy,sw,sh,sa,ss,c
  67.     
  68.     /* B */
  69.     /* triangle */
  70.     sx = x + 0.375 * w
  71.     sy = y + (0.9375 + n1mr10o2 * q) * h
  72.     sw = ( 0.25 - n1pr10o3 * q) * w
  73.     sh = ( 0.375 - n1pr10o2 * q) * h
  74.     sa = 0
  75.     ss = 0
  76.     c = iterate( mx + 0.375 * mw, my + 0.9375 * mh)
  77.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  78.  
  79.     /* C */
  80.     /* rectangle */
  81.     sx = x + 0.625 * w
  82.     sy = y + 0.875 * h
  83.     sw = ( r5o4r2 - n5o4 * q) * w
  84.     sh = ( n1or10 - q) * h
  85.     sa = 1.8925469
  86.     ss = 0.6435011
  87.     c = iterate( mx + 0.625 * mw, my + 0.875 * mh)
  88.     if c\=0 then call makerectangle sx,sy,sw,sh,sa,ss,c
  89.  
  90.     /* D */
  91.     /* triangle */
  92.     sx = x + 0.875 * w
  93.     sy = y + (0.8125 - n1mr10o2 * q) * h
  94.     sw = ( 0.25 - n1pr10o3 * q) * w
  95.     sh = ( 0.375 - n1pr10o2 * q) * h
  96.     sa = 3.1415927
  97.     ss = 0
  98.     c = iterate( mx + 0.875 * mw, my + 0.8125 * mh)
  99.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  100.  
  101.     /* E */
  102.     /* triangle */
  103.     sx = x + (0.0625 /*0.1875*/ - n1mr10o2 * q) * w
  104.     sy = y + 0.625 * h
  105.     sw = ( 0.25 - n1pr10o3 * q) * w
  106.     sh = ( 0.375 - n1pr10o2 * q) * h
  107.     sa = 1.5707963
  108.     ss = 0
  109.     c = iterate( mx + 0.1875 * mw, my + 0.625 * mh)
  110.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  111.     
  112.     /* F */
  113.     /* rectangle */
  114.     sx = x + 0.375 * w;
  115.     sy = y + 0.625 * h;
  116.     sw = ( 0.25 - q) * w;
  117.     sh = ( 0.25 - q) * h;
  118.     sa = 0;
  119.     ss = 0;
  120.     c = iterate( mx + 0.375 * mw, my + 0.625 * mh)
  121.     if c\=0 then call makerectangle sx,sy,sw,sh,sa,ss,c
  122.  
  123.     /* G */
  124.     /* triangle */
  125.     sx = x + (0.6875 + n1mr10o2 * q) * w
  126.     sy = y + 0.625 * h
  127.     sw = ( 0.25 - n1pr10o3 * q) * w
  128.     sh = ( 0.375 - n1pr10o2 * q) * h
  129.     sa = -1.5707963
  130.     ss = 0
  131.     c = iterate( mx + 0.6875 * mw, my + 0.625 * mh)
  132.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  133.  
  134.     /* H */
  135.     /* rectangle */
  136.     sx = x + 0.125 * w
  137.     sy = y + 0.375 * h
  138.     sw = ( r5o4r2 - n5o4 * q) * w
  139.     sh = ( n1or10 - q) * h
  140.     sa = 1.8925469
  141.     ss = 0.6435011
  142.     c = iterate( mx + 0.125 * mw, my + 0.375 * mh)
  143.     if c\=0 then call makerectangle sx,sy,sw,sh,sa,ss,c
  144.  
  145.     /* I */
  146.     /* triangle */
  147.     sx = x + 0.375 * w
  148.     sy = y + (0.3125 - n1mr10o2 * q) * h
  149.     sw = ( 0.25 - n1pr10o3 * q) * w
  150.     sh = ( 0.375 - n1pr10o2 * q) * h
  151.     sa = 3.1415927
  152.     ss = 0
  153.     c = iterate( mx + 0.375 * mw, my + 0.3125 * mh)
  154.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  155.  
  156.     /* J */
  157.     /* rectangle */
  158.     sx = x + 0.625 * w
  159.     sy = y + 0.375 * h
  160.     sw = ( r5o4r2 - n5o4 * q) * w
  161.     sh = ( n1or10 - q) * h
  162.     sa = 0.3217505
  163.     ss = 0.6435011
  164.     c = iterate( mx + 0.625 * mw, my + 0.375 * mh)
  165.     if c\=0 then call makerectangle sx,sy,sw,sh,sa,ss,c
  166.  
  167.     /* K */
  168.     /* triangle */
  169.     sx = x + 0.875 * w
  170.     sy = y + (0.4375 + n1mr10o2 * q) * h
  171.     sw = ( 0.25 - n1pr10o3 * q) * w
  172.     sh = ( 0.375 - n1pr10o2 * q) * h
  173.     sa = 0
  174.     ss = 0
  175.     c = iterate( mx + 0.875 * mw, my + 0.4375 * mh)
  176.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  177.  
  178.     /* L */
  179.     /* triangle */
  180.     sx = x + (0.1875 + n1mr10o2 * q) * w
  181.     sy = y + 0.125 * h
  182.     sw = ( 0.25 - n1pr10o3 * q) * w
  183.     sh = ( 0.375 - n1pr10o2 * q) * h
  184.     sa = -1.5707963
  185.     ss = 0
  186.     c = iterate( mx + 0.1875 * mw, my + 0.125 * mh)
  187.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  188.  
  189.     /* M */
  190.     /* triangle */
  191.     sx = x + (0.5625 - n1mr10o2 * q) * w
  192.     sy = y + 0.125 * h
  193.     sw = ( 0.25 - n1pr10o3 * q) * w
  194.     sh = ( 0.375 - n1pr10o2 * q) * h
  195.     sa = 1.5707963
  196.     ss = 0
  197.     c = iterate( mx + 0.5625 * mw, my + 0.125 * mh)
  198.     if c\=0 then call maketriangle sx,sy,sw,sh,sa,ss,c
  199.  
  200.     /* N */
  201.     /* rectangle */
  202.     sx = x + 0.875 * w;
  203.     sy = y + 0.125 * h;
  204.     sw = ( 0.25 - q) * w;
  205.     sh = ( 0.25 - q) * h;
  206.     sa = 0;
  207.     ss = 0;
  208.     c = iterate( mx + 0.875 * mw, my + 0.125 * mh)
  209.     if c\=0 then call makerectangle sx,sy,sw,sh,sa,ss,c
  210.  
  211.     return
  212.  
  213. iterate: procedure
  214.     parse arg a,b
  215.  
  216.     ca = a
  217.     cb = b
  218.  
  219.     do c = 1 to 250
  220.         a2 = a*a
  221.         b2 = b*b
  222.  
  223.         if a2+b2 > 4 then return c
  224.  
  225.         b = 2 * a * b + cb
  226.         a = a2 - b2 + ca
  227.     end
  228.  
  229.     return 0
  230.  
  231. makerectangle: procedure
  232.     parse arg x,y,w,h,r,s,c
  233.  
  234.     /* Make the object upright and set the Color */
  235.     call CwSetSelectionRectangle x,y,w,h
  236.     obj=CwCreateEffect("Rectangle","Solid Color")
  237.     if r\=0 then call CwSetProperty obj,"Position:Angle",r/3.14152659878*180
  238.     if s\=0 then call CwSetProperty obj,"Position:Skew",s/3.14152659878*180
  239.     handle=CwGetTool(obj)
  240.     call CwSetProperty handle,"Color",Colormap(c)
  241.     
  242.     return
  243.  
  244. maketriangle: procedure
  245.     parse arg x,y,w,h,r,s,c
  246.  
  247.     /* Make the object upright, and triangularm and set the Color */
  248.     call CwSetSelectionRectangle x,y,w,h
  249.     obj=CwCreateEffect("Shape","Solid Color")
  250.     if r\=0 then call CwSetProperty obj,"Position:Angle",r/3.14152659878*180
  251.     if s\=0 then call CwSetProperty obj,"Position:Skew",s/3.14152659878*180
  252.     handle=CwGetRegion(obj)
  253.     call CwSetProperty handle,"Shape","Triangle Cut-out"
  254.     handle=CwGetTool(obj)
  255.     call CwSetProperty handle,"Color",Colormap(c)
  256.  
  257.     return
  258.  
  259. Colormap: procedure
  260.     parse arg c
  261.  
  262.     if c=0 then return "#000000"
  263.     Colorfrom=x2d('ff0000')
  264.     Colorto=x2d('0080ff')
  265.     return '#'d2x(trunc(Colorfrom*(250-c)/249+Colorto*(c-1)/249),6)
  266.  
  267.