home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / spirals.pdrx < prev    next >
Encoding:
Text File  |  1994-05-08  |  6.3 KB  |  204 lines
  1.  
  2. /* Written by Don Cox,  May 94. Copyright. Not Public Domain.   */
  3. /* $VER: Spirals.pdrx May 94 */
  4.  
  5. trace n
  6.  
  7. units = pdm_GetUnits()
  8. if units = 3 then call pdm_SetUnits(1)
  9.  
  10. if show("l", "gdarexxsupport.library") then if ~remlib("gdarexxsupport.library") then call pdm_Inform(1,"Could not remove gdarexxsupport.library - curves may be faulty","Resume")
  11.  
  12. /* rexxmathlib.library is needed to work around the square root bug in gdarexxsupport.library  */
  13. if ~show("l", "rexxmathlib.library") then
  14.     if ~addlib("rexxmathlib.library", 0, -30,0) then do
  15.         call ppm_Inform(1,"Please install the rexxmathlib.library in your libs: directory before running this Genie.")
  16.     end
  17.  
  18. numeric digits 14
  19.  
  20. pi = 3.141593
  21. pi2 = 6.28318
  22. cr = '0a'x
  23. CurveRadius = 1.0
  24.  
  25. points = getclip(pduserpolypoints)
  26. radius = getclip(pduserpolyradius)
  27. outer = getclip(pduserpolyouter)
  28.  
  29.  
  30. if points = '' then points = 100
  31. if radius = '' then radius = 2
  32. if outer = '' then outer = 0.1
  33.  
  34.  
  35. spirallist = "Evolute"||cr||"Archimedean"||cr||"Logarithmic"||cr||"Spherical"
  36. spiraltype = pdm_SelectFromList("Select spiral type",19,4,0,spirallist)
  37. if spiraltype = "" then exit_msg("No spiral type selected")
  38.  
  39.  
  40. select
  41.     when spiraltype = "Evolute" then do
  42.         paramstring = "Circle radius:"radius ||cr|| "Points:"points
  43.         params = pdm_GetForm("Enter parameters",8, paramstring)
  44.         if params = '' then exit_msg("Aborted by User")
  45.         parse var params radius '0a'x npoints
  46.         npoints = strip(npoints)
  47.         radius = strip(radius)
  48.         if ~(datatype(radius, n) & datatype(npoints, n)) then exit_msg("Invalid Entry")
  49.         if npoints < 3 then exit_msg("A spiral must have at least 3 points")
  50.         npoints = abs(npoints)
  51.         radius = abs(radius)
  52.         diameter = radius*2
  53.         end
  54.  
  55.     when spiraltype = "Archimedean" then do
  56.         paramstring = "Start radius:"radius ||cr|| "Points:"points
  57.         params = pdm_GetForm("Enter parameters",8, paramstring)
  58.         if params = '' then exit_msg("Aborted by User")
  59.         parse var params radius '0a'x npoints
  60.         npoints = strip(npoints)
  61.         radius = strip(radius)
  62.         if ~(datatype(radius, n) & datatype(npoints, n)) then exit_msg("Invalid Entry")
  63.         if npoints < 3 then exit_msg("A spiral must have at least 3 points")
  64.         npoints = abs(npoints)
  65.         radius = abs(radius)
  66.         diameter = radius*2
  67.         end
  68.  
  69.  
  70.     when spiraltype = "Logarithmic" then do
  71.         paramstring = "Start radius:"radius ||cr|| "Points:"points ||cr|| "Growth factor:"outer
  72.         params = pdm_GetForm("Enter parameters",8, paramstring)
  73.         if params = '' then exit_msg("Aborted by User")
  74.         parse var params radius '0a'x npoints '0a'x outer
  75.         npoints = strip(npoints)
  76.         radius = strip(radius)
  77.         if ~(datatype(radius, n) & datatype(npoints, n) & datatype(outer,n)) then exit_msg("Invalid Entry")
  78.         if npoints < 3 then exit_msg("A spiral must have at least 3 points")
  79.         npoints = abs(npoints)
  80.         radius = abs(radius)
  81.         diameter = radius*2
  82.         outer = abs(outer)
  83.         end
  84.  
  85.  
  86.     when spiraltype = "Spherical" then do
  87.         paramstring = "Start radius:"radius ||cr|| "Slope factor:"outer ||cr|| "Points:"points
  88.         params = pdm_GetForm("Enter parameters",8, paramstring)
  89.         if params = '' then exit_msg("Aborted by User")
  90.         parse var params radius  '0a'x outer '0a'x npoints
  91.         npoints = strip(npoints)
  92.         radius = strip(radius)
  93.         if ~(datatype(radius, n) & datatype(npoints, n) & datatype(outer,n)) then exit_msg("Invalid Entry")
  94.         if npoints < 3 then exit_msg("A spiral must have at least 3 points")
  95.         npoints = abs(npoints)
  96.         radius = abs(radius)
  97.         diameter = radius*2
  98.         outer = abs(outer)
  99.         end
  100.  
  101.  
  102.     end
  103.  
  104.  
  105. call setclip(pduserpolypoints, npoints)
  106. call setclip(pduserpolyradius, radius)
  107. call setclip(pduserpolyouter, outer)
  108.  
  109.  
  110. posn = pdm_GetClickPosn("Click at position for spiral..")
  111. if posn = '' then exit_msg()
  112. xpos = word(posn,1)
  113. ypos = word(posn,2)
  114.  
  115. call pdm_ShowStatus("Working..")
  116.  
  117.  
  118. select
  119.     when spiraltype = "Evolute" then do 
  120.         circle = pdm_DrawEllipse(xpos, ypos, diameter, diameter)
  121.         call pdm_initplot(xpos+radius, ypos,1,1,0)
  122.         do N = 0 to npoints+1
  123.             T=2*pi*N/10
  124.             x = radius * (cos(T) + T*sin(T))
  125.             y = radius * (sin(T) - T*cos(T))
  126.             call pdm_PlotSmooth(x" "y)
  127.             end
  128.         object = pdm_endplot()
  129.         call pdm_RemovePoint(object,npoints+1) /* Tangents are wrong on last point drawn */
  130.         call pdm_SelectObj(circle,object)
  131.         end
  132.  
  133.     when spiraltype = "Archimedean" then do 
  134.         call pdm_initplot(xpos, ypos,1,1,0)
  135.         do N = 0 to npoints+1 
  136.             R = radius * N/4 /* divide by 4 to get closer spacing, smoother curves */
  137.             x = R * cos(N/4)
  138.             y = R * sin(N/4)
  139.             call pdm_PlotSmooth(x" "y)
  140.             end
  141.         object = pdm_endplot()
  142.         call pdm_RemovePoint(object,npoints+1)
  143.         call pdm_SelectObj(object)
  144.         end
  145.  
  146.  
  147.     when spiraltype = "Logarithmic" then do 
  148.         call pdm_initplot(xpos, ypos,1,1,0)
  149.         do N = 0 to npoints+1 
  150.             R = radius * exp(outer*N/4)
  151.             x = R * cos(N/4)
  152.             y = R * sin(N/4)
  153.             call pdm_PlotSmooth(x" "y)
  154.             end
  155.         object = pdm_endplot()
  156.         call pdm_RemovePoint(object,npoints+1)
  157.         call pdm_SelectObj(object)
  158.         end
  159.  
  160.     when spiraltype = "Spherical" then do 
  161.         call pdm_initplot(xpos, ypos,1,1,0)
  162.         P = 1/sqrt(2)
  163.         Q = P* sqrt(1-outer*outer) /* projection constants */
  164.  
  165.         do N = trunc(0-(npoints/2)) to (npoints/2)+1 
  166.             S = N*pi/20
  167.             T = atan(radius*S)
  168.             X = cos(S) * cos(T)
  169.             Y = sin(S) * cos(T)
  170.             Z = -sin(T)
  171.             U = P*(Y-X)*4
  172.             V = (outer*Z-Q*(X+Y))*4
  173.             
  174.             call pdm_PlotSmooth(U" "V)
  175.             end
  176.         object = pdm_endplot()
  177.         call pdm_RemovePoint(object,npoints+1)
  178.         call pdm_SelectObj(object)
  179.         end
  180.  
  181.  
  182.     otherwise exit_msg("Spiral type not supported")
  183.     end
  184.  
  185.  
  186. object = pdm_SelectObj(object)
  187. call pdm_UpdateScreen(1)
  188.  
  189. exit_msg()
  190.  
  191.  
  192.  
  193. exit_msg: procedure expose units
  194. do
  195.     parse arg message
  196.  
  197.     if message ~= '' then call pdm_Inform(1,message,)
  198.     call pdm_ClearStatus()
  199.     call pdm_SetUnits(units)
  200.     call pdm_AutoUpdate(1)
  201.     exit
  202. end
  203.  
  204.