home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 58 / af058b.adf / PV21.lha / REXX / BlendROT.pvx < prev    next >
Text File  |  1991-10-23  |  5KB  |  208 lines
  1. /* Macro to 'blend' the shapes and colors of two objects
  2.     with a given # of steps  between them.
  3.    Author: Ross Cunniff, May 18, 1991
  4.            Jeff Blume, July 6, 1991
  5.        (the color code, ie. the easy stuff)
  6.    Copyright © 1991 by Stylus, Inc.
  7. */
  8.  
  9. /* Make sure we get results back from ProVector */
  10. options results
  11.  
  12. /* Make sure we have a math library */
  13. if ~exists("LIBS:rexxmathlib.library") then call Error 'No math library'
  14. else call addlib "rexxmathlib.library",0,-30,0
  15.  
  16. /* Make sure we're the only macro running */
  17. 'Lock'
  18. if RC ~= 0 then exit
  19.  
  20. /* Check to see whether 2 and only 2 objects are selected */
  21. 'SelectList Sel'; NumObjs = Result
  22. if NumObjs ~= 2 then call Error 'Must select 2 objects'
  23.  
  24. /* Check to see whether both objects are polygons */
  25. Obj1 = Sel.0;    Obj2 = Sel.1
  26. 'TypeOf Obj1';    Type1 = Result
  27. 'TypeOf Obj2';    Type2 = Result
  28.  
  29. if Type1 ~= 'Polygon' & Type1 ~= 'Polyline' then call Error 'Objs must be polygons'
  30. if Type2 ~= 'Polygon' & Type2 ~= 'Polyline' then call Error 'Objs must be polygons'
  31. if Type1 ~= Type2 then call Error 'Objs must be same type'
  32.  
  33. 'GetPoints Obj1 Pts1';    Size1 = Result
  34. 'GetPoints Obj2 Pts2';    Size2 = Result
  35. if Size1 ~= Size2 then call Error 'Must have same number points'
  36.  
  37. 'GetBool "Blend Colors Also?" "Yes" "No"'
  38. if RC ~= 0 then do
  39.     'GetStr "Enter # of steps:" "OK" "Cancel"'; N = Result
  40.     /* Get range of 0 to N+1 */
  41.     Steps = N + 1
  42.     if RC ~= 0 then do
  43.         'UnLock'
  44.         exit
  45.     end
  46.     else nop
  47. end
  48. else do
  49.     Spread = "T"
  50.     call Colors Obj1 Obj2
  51. end
  52.  
  53. /* Push a new undo level */
  54. 'PushUndo'
  55.  
  56. /* Get center points of objects */
  57. 'ObjExtent Obj1 Ext1'
  58. 'ObjExtent Obj2 Ext2'
  59. Cent1.X = (Ext1.X1 + Ext1.X2)/2
  60. Cent1.Y = (Ext1.Y1 + Ext1.Y2)/2
  61. Cent2.X = (Ext2.X1 + Ext2.X2)/2
  62. Cent2.Y = (Ext2.Y1 + Ext2.Y2)/2
  63.  
  64. /* Transform points into angle, radius form */
  65. do I = 0 to Size1-1
  66.     if Pts1.I.X ~= 'INDICATOR' then do
  67.         if Pts2.I.X ~= 'INDICATOR' then do
  68.             DX = Pts1.I.X - Cent1.X
  69.             DY = Pts1.I.Y - Cent1.Y
  70.             Pts1.I.X = 180*atan2( DY, DX ) / 3.141582653589
  71.             Pts1.I.Y = sqrt( DX*DX + DY*DY )
  72.             DX = Pts2.I.X - Cent2.X
  73.             DY = Pts2.I.Y - Cent2.Y
  74.             Pts2.I.X = 180*atan2( DY, DX ) / 3.141582653589
  75.             Pts2.I.Y = sqrt( DX*DX + DY*DY )
  76.         end
  77.         else do
  78.             call Error 'Must be same number curves, sub-polys'
  79.         end
  80.     end
  81.     else if Pts1.I.X = Pts2.I.X & Pts1.I.Y = Pts2.I.Y then do
  82.         Res.I.X = Pts1.I.X
  83.         Res.I.Y = Pts1.I.Y
  84.     end
  85.     else do
  86.         call Error 'Must be same number curves, sub-polys'
  87.     end
  88. end
  89.  
  90.  
  91. /* Get range of 0 to N+1 */
  92. Steps = N + 1
  93.  
  94. /* Actually blend the objects */
  95. if Spread = "T" then do
  96.     FillX = FillB - Fi
  97.     Attrs.EdgeType = 0    /* Speed up refresh w/ NOLINE */
  98. end
  99. do S = 1 to N
  100.     S1 = S / Steps
  101.     S2 = 1 - S1
  102.     do I = 0 to Size1-1
  103.         if Pts1.I.X ~= 'INDICATOR' then do
  104.             /*Angle = S1 * Pts1.I.X + S2 * Pts2.I.X*/
  105.             DA = Pts2.I.X - Pts1.I.X
  106.             if DA < 0 then DA = DA + 360
  107.             if DA >= 360 then DA = DA - 360
  108.             DA = DA * S2
  109.             Angle = Pts1.I.X + DA
  110.  
  111.             Dist = S1 * Pts1.I.Y + S2 * Pts2.I.Y
  112.             DX = S1 * Cent1.X + S2 * Cent2.X
  113.             DY = S1 * Cent1.Y + S2 * Cent2.Y
  114.             Res.I.X = DX + Dist * cos( Angle * 3.141592653589 / 180 )
  115.             Res.I.Y = DY + Dist * sin( Angle * 3.141592653589 / 180 )
  116.         end
  117.         else do
  118.             Res.I.X = Pts1.I.X
  119.             Res.I.Y = Pts1.I.Y
  120.         end
  121.     end
  122.     if Spread = "T" then do
  123.         Attrs.FillVal = FillX
  124.         Attrs.EdgeVal = FillX    /* PS doesn't know NOLINE */
  125.         'SetCurrAttrs Attrs'
  126.         FillX = FillX - Fi    /* Increment FillX */
  127.     end
  128.     if Type1 = 'Polygon' then do
  129.         'Polygon Size1 Res'; Obj = Result
  130.     end
  131.     else do
  132.         'PolyLine Size1 Res'; Obj = Result
  133.     end
  134. end
  135. 'Front' Obj1
  136. 'UnSelect' Obj1
  137. 'UnSelect' Obj2
  138.  
  139.  
  140. /* Make sure original objs have borders that match fills */
  141. if Spread = "T" then do
  142.     'SaveUndo' Obj1
  143.     'ChangeEdgeVal' Obj1 FillA
  144.     'ChangeEdgeType' Obj1 0
  145.     'SaveUndo' Obj2
  146.     'ChangeEdgeVal' Obj2 FillB
  147.     'ChangeEdgeVal' Obj2 0
  148. end
  149.  
  150. 'Repair'
  151. 'UnLock'
  152. exit
  153.  
  154. COLORS:
  155.     arg Obj1 Obj2
  156.     FillVal Obj1;    FillA = Result
  157.     FillVal Obj2;    FillB = Result
  158.     Steps = abs(FillB-FillA)
  159.     if Steps = 0 then call Error "Need a color SPREAD!"
  160.     Range = Steps + 1    /* actual # of fills (& objs) in spread */
  161.     N = Range - 2        /* actual # intermediate objs and colors */
  162.  
  163.     if FillB > FillA    /* Check colors in ascending order */
  164.         then Fi = 1    /* Fill increments */
  165.         else Fi = -1
  166.     FillX = FillA + Fi
  167.  
  168.     'GetBool "Calculate Intermediate Colors?" "Yes" "No"'
  169.     if rc ~= 0 then return /*Steps N Fi FillX*/
  170.     'Prompt "Calculating Palette!"'
  171.  
  172.     /* Extract their RGB components */
  173.     'GetColor' FillA RGBa
  174.     'GetColor' FillB RGBb
  175.  
  176.     /* RGB increments */
  177.     Ri = abs(RGBb.R-RGBa.R) / Range
  178.     Gi = abs(RGBb.G-RGBa.G) / Range
  179.     Bi = abs(RGBb.B-RGBa.B) / Range
  180.  
  181.     if RGBb.R > RGBa.R
  182.         then Ri = Ri
  183.         else Ri = -Ri
  184.  
  185.     if RGBb.G > RGBa.G
  186.         then Gi = Gi
  187.         else Gi = -Gi
  188.  
  189.     if RGBb.B > RGBa.B
  190.         then Bi = Bi
  191.         else Bi = -Bi
  192.  
  193.     do for N
  194.         RGBa.R = RGBa.R + Ri
  195.         RGBa.G = RGBa.G + Gi
  196.         RGBa.B = RGBa.B + Bi
  197.         'SetColor FillX RGBa'
  198.         FillX = FillX + Fi
  199.     end
  200.     'EndPrompt'
  201.     return /*Steps N Fi FillX*/
  202.  
  203. Error:
  204.     arg String
  205.     'GetBool String "OK" "Cancel"'
  206.     'UnLock'
  207.     exit
  208.