home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / snowflake.pdrx < prev    next >
Encoding:
Text File  |  1994-09-01  |  5.1 KB  |  241 lines
  1. /*
  2. This Genie will draw a Snowflake curve. Algorithm from Delahaye. Written by Don Cox.
  3. */
  4. /* $VER: Snowflake Apr 94 */
  5.  
  6. /* call open('STDERR', "ram:SnowTrace", "W")
  7. trace r */
  8.  
  9. msg = PDSetup.rexx(2,0)
  10. units = getclip(pds_units)
  11. if msg ~= 1 then exit_msg(msg)
  12.  
  13. numeric digits 8
  14. cr = "0a"x
  15.  
  16. call PDM_setbatchmode(0)
  17. call PDM_autoupdate(0)
  18.  
  19. flakelist = "Koch Snowflake"||cr||"Anti-snowflake"||cr|| "Thicket"||cr|| "Forest"
  20. flaketype = pdm_SelectFromList("Select line type",19,11,0,flakelist)
  21. if flaketype = "" then exit_msg("No line type selected")
  22. flaketype = space(flaketype,0)
  23.  
  24. pi = 3.14159
  25. pi2 = 6.28318
  26. cr = '0a'x
  27. psize = pdm_GetPageSize()
  28. pageX = word(psize,1)
  29. pageY = word(psize,2)
  30.  
  31. order = getclip(pduserorder) /* how many repeats */
  32.  
  33. if order = "" then order = 3
  34.  
  35. call pdm_unselectobj()
  36. form = "Repeat process:"order  
  37. setup = pdm_getform("Pattern Settings",7,form)
  38. if setup = '' then exit_msg()
  39. parse var setup  order
  40.  
  41. if ~(datatype(order, n)) then exit_msg("Invalid Entry")
  42.  
  43. call setclip(pduserorder, order)
  44.  
  45. b = pdm_getclickposn("Click top left corner position")
  46. posx = word(b,1)
  47. posy = word(b,2)
  48. call pdm_ShowStatus("  Working...")
  49. call pdm_UnselectObj()
  50. call pdm_initplot(posx,posy, 1,1,0)
  51.  
  52. select
  53.     when flaketype = "KochSnowflake" then do
  54.         mainsides = 3 /* start with triangle */
  55.         segments = 4 /* break each side into 4 */
  56.         np = pageX*0.8
  57.         x.0 = 0
  58.         x.1 = np
  59.         x.2 = np*0.5
  60.         x.3 = 0
  61.  
  62.         y.0 = squareroot(3)/2*np
  63.         y.1 = y.0
  64.         y.2 = 0
  65.         y.3 = y.0
  66.  
  67.         L. = 1/3
  68.  
  69.         a.0 = 0
  70.         a.1 = pi/3
  71.         a.2 = 0-a.1
  72.         a.3 = 0
  73.         end
  74.  
  75.     when flaketype = "Anti-snowflake" then do
  76.         mainsides = 3
  77.         segments = 4
  78.         np = pageX*0.8
  79.         x.0 = np
  80.         x.1 = 0
  81.         x.2 = np*0.5
  82.         x.3 = np
  83.  
  84.         y.0 = squareroot(3)/2*np
  85.         y.1 = y.0
  86.         y.2 = 0
  87.         y.3 = y.0
  88.  
  89.         L. = 1/3
  90.  
  91.         a.0 = 0
  92.         a.1 = pi/3
  93.         a.2 = 0-a.1
  94.         a.3 = 0
  95.         end
  96.  
  97.     when flaketype = "Thicket" then do
  98.         mainsides = 4
  99.         segments = 4
  100.         np = pageX*0.8
  101.         x.0 = 0
  102.         x.1 = np
  103.         x.2 = np
  104.         x.3 = 0
  105.         x.4 = 0
  106.  
  107.         y.0 = 0
  108.         y.1 = 0
  109.         y.2 = np
  110.         y.3 = np
  111.         y.4 = 0
  112.  
  113.         L. = 1/(2+2*cos(0.45*pi))
  114.  
  115.         a.0 = 0
  116.         a.1 = 0.45*pi
  117.         a.2 = 0-a.1
  118.         a.3 = 0
  119.         end
  120.  
  121.     when flaketype = "Forest" then do
  122.         mainsides = 1
  123.         segments = 4
  124.         np = pageX*0.8
  125.         x. = 0
  126.  
  127.         y.0 = np
  128.         y.1 = 0-np
  129.  
  130.         L.0 = 1/3
  131.         L.1 = L.0
  132.         L.2 = squareroot(10)/9
  133.         L.3 = 5/9
  134.  
  135.         a.0 = 0
  136.         a.1 = pi/2
  137.         a.2 = -(atan(3))
  138.         a.3 = 0
  139.         end
  140.     
  141.     otherwise NOP
  142.     end
  143.  
  144. points = 1
  145. identity = 1
  146.  
  147. do k=0 to mainsides-1
  148.     xd = x.k
  149.     yd = y.k
  150.     kk = k+1
  151.     xa = x.kk
  152.     ya = y.kk
  153.     x0 = xd
  154.     y0 = yd
  155.     call plotpoint(x0,y0)
  156.     if xa~=xd then a0 = atan((ya-yd)/(xa-xd))
  157.     else a0 = pi/2 * sign(ya-yd)
  158.     if (xa-xd)<0 then a0=a0+pi
  159.     L0 = squareroot((xa-xd)**2 + (ya-yd)**2)
  160.     do i=0 to segments**order -1
  161.         LL=L0
  162.         aa=a0
  163.         t1 = i
  164.         if order~= 0 then do j = (order-1) to 0 by -1
  165.             r = segments**j
  166.             t2 = trunc(t1/r)
  167.             aa = aa+a.t2
  168.             LL = LL*L.t2
  169.             t1 = t1-t2*r
  170.             end
  171.         x0 = x0+LL*cos(aa)
  172.         y0 = y0+LL*sin(aa)
  173.         call plotpoint(x0,y0)
  174.         end
  175.     end
  176.  
  177. object = pdm_EndPlot()
  178. curves.identity = object
  179.  
  180. call pdm_SelectObj(curves.1,curves.identity)
  181. call pdm_GroupObj()
  182.  
  183.  
  184. exit_msg("Done")
  185.  
  186.  
  187. exit_msg: procedure expose units
  188. do
  189.     parse arg message
  190.     call pdm_ClearStatus()
  191.     if message ~= '' then call pdm_Inform(1,message,)
  192.     call pdm_AutoUpdate(1)
  193.     call pdm_SetUnits(units)
  194.     call pdm_SetBatchMode(0)
  195.     exit
  196. end
  197.  
  198.  
  199.  
  200. /* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */
  201.  
  202. squareroot: /* to avoid bug in gdarexxsupport.library sqrt function */
  203. parse arg number
  204.  
  205. removed = remlib("gdarexxsupport.library")
  206. if removed~=1 then call ppm_Inform(1,"Could not remove gdarexxsupport.library calculations may be faulty","Resume")
  207.  
  208. /* rexxmathlib.library is needed instead  */
  209. if ~show("l", "rexxmathlib.library") then
  210.     if ~addlib("rexxmathlib.library", 0, -30,0) then do
  211.         call ppm_Inform(1,"Please install the rexxmathlib.library in your libs: directory before running this Genie.")
  212.     end
  213.  
  214. number = sqrt(number)
  215.  
  216. if ~show("l", "gdarexxsupport.library") then
  217.     if ~addlib("gdarexxsupport.library", 0, -30,0) then do
  218.         call ppm_Inform(1,"Please install the gdarexxsupport.library in your libs: directory before running this Genie.")
  219.     end
  220.  
  221.  
  222. return number
  223.  
  224. /* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */
  225.  
  226. plotpoint:
  227. arg plotX,plotY
  228. call pdm_PlotLine(plotX" "plotY)
  229. points = points + 1
  230. if points>250 then do /* not too many points on curve */
  231.     object = pdm_EndPlot()
  232.     curves.identity = object
  233.     identity = identity+1
  234.     call pdm_initplot(posx,posy, 1,1,0)
  235.     call pdm_PlotLine(plotX" "plotY)
  236.     points = 1
  237.     end
  238.  
  239. return
  240.  
  241. /* +++++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */