home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 58 / af058b.adf / PV21.lha / REXX / Blend.pvrx < prev    next >
Text File  |  1991-09-13  |  4KB  |  156 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're the only macro running */
  13. 'Lock'
  14. if RC ~= 0 then exit
  15.  
  16. /* Check to see whether 2 and only 2 objects are selected */
  17. 'SelectList Sel'; NumObjs = Result
  18. if NumObjs ~= 2 then call Error 'Must select 2 objects'
  19.  
  20. /* Check to see whether both objects are polygons */
  21. Obj1 = Sel.0;    Obj2 = Sel.1
  22. 'TypeOf Obj1';    Type1 = Result
  23. 'TypeOf Obj2';    Type2 = Result
  24.  
  25. if Type1 ~= 'Polygon' & Type1 ~= 'Polyline' then call Error 'Objs must be polygons'
  26. if Type2 ~= 'Polygon' & Type2 ~= 'Polyline' then call Error 'Objs must be polygons'
  27. if Type1 ~= Type2 then call Error 'Objs must be same type'
  28.  
  29. 'GetPoints Obj1 Pts1';    Size1 = Result
  30. 'GetPoints Obj2 Pts2';    Size2 = Result
  31. if Size1 ~= Size2 then     call Error 'Must have same number points'
  32.  
  33. 'GetBool "Blend Colors Also?" "Yes" "No"'
  34. if RC ~= 0 then do
  35.     'GetStr "Enter # of steps:" "OK" "Cancel"'; N = Result
  36.     /* Get range of 0 to N+1 */
  37.     Steps = N + 1
  38.     if RC ~= 0 then do
  39.         'UnLock'
  40.         exit
  41.     end
  42. end
  43. else do
  44.     Spread = "T"
  45.     call Colors Obj1 Obj2
  46. end
  47.  
  48. /* Push a new undo level */
  49. 'PushUndo'
  50.  
  51. /* Actually blend the objects */
  52. if Spread = "T" then do
  53.     FillX = FillB - Fi
  54.     Attrs.EdgeType = 0    /* Speed up refresh w/ NOLINE */
  55. end
  56. do S = 1 to N
  57.     S1 = S / Steps
  58.     S2 = 1 - S1
  59.     do I = 0 to Size1-1
  60.         if Pts1.I.X ~= 'INDICATOR' then do
  61.             if Pts2.I.X ~= 'INDICATOR' then do
  62.                 Res.I.X = S1 * Pts1.I.X + S2 * Pts2.I.X
  63.                 Res.I.Y = S1 * Pts1.I.Y + S2 * Pts2.I.Y
  64.             end
  65.             else call Error 'Must be same number curves, sub-polys'
  66.         end
  67.         else if Pts1.I.X = Pts2.I.X & Pts1.I.Y = Pts2.I.Y then do
  68.             Res.I.X = Pts1.I.X
  69.             Res.I.Y = Pts1.I.Y
  70.         end
  71.         else call Error 'Must be same number curves, sub-polys'
  72.     end
  73.     if Spread = "T" then do
  74.         Attrs.FillVal = FillX
  75.         Attrs.EdgeVal = FillX    /* PS doesn't know NOLINE */
  76.         'SetCurrAttrs Attrs'
  77.         FillX = FillX - Fi    /* Increment FillX */
  78.     end
  79.     if Type1 = 'Polygon' then do
  80.         'Polygon Size1 Res'; Obj = Result
  81.     end
  82.     else 'PolyLine Size1 Res'; Obj = Result
  83. end
  84. 'Front' Obj1
  85. 'UnSelect' Obj1
  86. 'UnSelect' Obj2
  87.  
  88. /* Make sure original objs have borders that match fills */
  89. if Spread = "T" then do
  90.     'SaveUndo' Obj1
  91.     'ChangeEdgeVal' Obj1 FillA
  92.     'ChangeEdgeType' Obj1 0
  93.     'SaveUndo' Obj2
  94.     'ChangeEdgeVal' Obj2 FillB
  95.     'ChangeEdgeVal' Obj2 0
  96. end
  97.  
  98. 'Repair'
  99. 'UnLock'
  100. exit
  101.  
  102. COLORS:
  103.     arg Obj1 Obj2
  104.     FillVal Obj1;    FillA = Result
  105.     FillVal Obj2;    FillB = Result
  106.     Steps = abs(FillB-FillA)
  107.     if Steps = 0 then call Error "Need a color SPREAD!"
  108.     Range = Steps + 1    /* actual # of fills (& objs) in spread */
  109.     N = Range - 2        /* actual # intermediate objs and colors */
  110.  
  111.     if FillB > FillA    /* Check colors in ascending order */
  112.         then Fi = 1    /* Fill increments */
  113.         else Fi = -1
  114.     FillX = FillA + Fi
  115.  
  116.     'GetBool "Calculate Intermediate Colors?" "Yes" "No"'
  117.     if rc ~= 0 then return /*Steps N Fi FillX*/
  118.     'Prompt "Calculating Palette!"'
  119.  
  120.     /* Extract their RGB components */
  121.     'GetColor' FillA RGBa
  122.     'GetColor' FillB RGBb
  123.  
  124.     /* RGB increments */
  125.     Ri = abs(RGBb.R-RGBa.R) / Range
  126.     Gi = abs(RGBb.G-RGBa.G) / Range
  127.     Bi = abs(RGBb.B-RGBa.B) / Range
  128.  
  129.     if RGBb.R > RGBa.R
  130.         then Ri = Ri
  131.         else Ri = -Ri
  132.  
  133.     if RGBb.G > RGBa.G
  134.         then Gi = Gi
  135.         else Gi = -Gi
  136.  
  137.     if RGBb.B > RGBa.B
  138.         then Bi = Bi
  139.         else Bi = -Bi
  140.  
  141.     do for N
  142.         RGBa.R = RGBa.R + Ri
  143.         RGBa.G = RGBa.G + Gi
  144.         RGBa.B = RGBa.B + Bi
  145.         'SetColor FillX RGBa'
  146.         FillX = FillX + Fi
  147.     end
  148.     'EndPrompt'
  149.     return /*Steps N Fi FillX*/
  150.  
  151. Error:
  152.     arg String
  153.     'GetBool String "OK" "Cancel"'
  154.     'UnLock'
  155.     exit
  156.