home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / sunflower.pdrx < prev    next >
Encoding:
Text File  |  1994-04-11  |  3.1 KB  |  120 lines
  1. /*
  2. @N
  3.  
  4. This Genie will draw a Fibonacci spiral pattern resembling Sunflower seeds. Algorithm from Barrett & Mackay, "Spatial Structure & the Microcomputer". Written by Don Cox.
  5. */
  6. /* $VER: SunFlower Apr 94 */
  7.  
  8. msg = PDSetup.rexx(2,0)
  9. units = getclip(pds_units)
  10. if msg ~= 1 then exit_msg(msg)
  11.  
  12. numeric digits 8
  13.  
  14. call PDM_setbatchmode(0)
  15. call PDM_autoupdate(0)
  16.  
  17. pi = 3.14159
  18. pi2 = 6.28318
  19. cr = '0a'x
  20. psize = pdm_GetPageSize()
  21. pageX = word(psize,1)
  22. pageY = word(psize,2)
  23.  
  24. scale = getclip(pduserscale)
  25. numberofseeds = getclip(pdusernumberofseeds)
  26.  
  27. if scale = '' then scale = 0.5
  28. if numberofseeds = '' then numberofseeds = 160
  29.  
  30. call pdm_unselectobj()
  31. man = pdm_getform("SunFlower Specifications",4,"Seeds:"numberofseeds ||cr|| "Scale Factor:"scale )
  32. if man = '' then exit_msg()
  33. parse var man numberofseeds '0a'x scale 
  34.  
  35. if ~(datatype(numberofseeds,n) & datatype(scale, n)) then exit_msg("Invalid Entry")
  36.  
  37. call setclip(pduserscale, scale)
  38. call setclip(pdusernumberofseeds, numberofseeds)
  39.  
  40. curcolor = pdm_GetFillPattern()
  41. parse var curcolor type '0a'x curcolor
  42.  
  43. color = pdm_SetFillPattern(,1,"Yellow")
  44. color = pdm_SetFillPattern(,1)
  45.  
  46. parse var color filler '0a'x color '0a'x filler
  47. if color = '' then exit_msg("No colour selected")
  48. call pdm_setfillpattern(,1,color,)
  49.  
  50. color = pdm_getcolordata(color)
  51. red = word(color,1)
  52. green = word(color,2)
  53. blue = word(color,3)
  54.  
  55. b = pdm_getclickposn("Where do you want the center?")
  56.  
  57. posx = word(b,1)
  58. posy = word(b,2)
  59. call pdm_ShowStatus("  Working...")
  60.  
  61. t = (1+squareroot(5))/2
  62. th = 2*pi/t
  63. radius2 = scale*t/2
  64. call pdm_UnselectObj()
  65.  
  66. identity = 1
  67. do i=1 to numberofseeds
  68.     r =scale* squareroot(i)
  69.     theta = th*i
  70.     x = (r * sin(theta))+posx
  71.     y = (r * cos(theta))+posy
  72.     if (x<0 | y<0 | x>pageX | y>pageY) then iterate /* don't draw off edge of page */
  73.     object = pdm_DrawEllipse(x, y, radius2, radius2)
  74.     curves.identity = object
  75.     identity = identity+1
  76.     end
  77.  
  78. identity = identity-1
  79. call pdm_SelectObj(curves.1,curves.identity)
  80. call pdm_GroupObj()
  81.  
  82. exit_msg("Done")
  83.  
  84.  
  85. exit_msg: procedure expose units
  86. do
  87.     parse arg message
  88.     call pdm_ClearStatus()
  89.     if message ~= '' then call pdm_Inform(1,message,)
  90.     call pdm_AutoUpdate(1)
  91.     call pdm_SetUnits(units)
  92.     call pdm_SetBatchMode(0)
  93.     exit
  94. end
  95.  
  96. /* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */
  97.  
  98. squareroot: /* to avoid bug in gdarexxsupport.library sqrt function */
  99. parse arg number
  100.  
  101. removed = remlib("gdarexxsupport.library")
  102. if removed~=1 then call ppm_Inform(1,"Could not remove gdarexxsupport.library calculations may be faulty","Resume")
  103.  
  104. /* rexxmathlib.library is needed instead  */
  105. if ~show("l", "rexxmathlib.library") then
  106.     if ~addlib("rexxmathlib.library", 0, -30,0) then do
  107.         call ppm_Inform(1,"Please install the rexxmathlib.library in your libs: directory before running this Genie.")
  108.     end
  109.  
  110. number = sqrt(number)
  111.  
  112. if ~show("l", "gdarexxsupport.library") then
  113.     if ~addlib("gdarexxsupport.library", 0, -30,0) then do
  114.         call ppm_Inform(1,"Please install the gdarexxsupport.library in your libs: directory before running this Genie.")
  115.     end
  116.  
  117.  
  118. return number
  119.  
  120. /* +++++++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++++++ */