home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format 58
/
af058b.adf
/
PV21.lha
/
REXX
/
BlendROT.pvx
< prev
next >
Wrap
Text File
|
1991-10-23
|
5KB
|
208 lines
/* Macro to 'blend' the shapes and colors of two objects
with a given # of steps between them.
Author: Ross Cunniff, May 18, 1991
Jeff Blume, July 6, 1991
(the color code, ie. the easy stuff)
Copyright © 1991 by Stylus, Inc.
*/
/* Make sure we get results back from ProVector */
options results
/* Make sure we have a math library */
if ~exists("LIBS:rexxmathlib.library") then call Error 'No math library'
else call addlib "rexxmathlib.library",0,-30,0
/* Make sure we're the only macro running */
'Lock'
if RC ~= 0 then exit
/* Check to see whether 2 and only 2 objects are selected */
'SelectList Sel'; NumObjs = Result
if NumObjs ~= 2 then call Error 'Must select 2 objects'
/* Check to see whether both objects are polygons */
Obj1 = Sel.0; Obj2 = Sel.1
'TypeOf Obj1'; Type1 = Result
'TypeOf Obj2'; Type2 = Result
if Type1 ~= 'Polygon' & Type1 ~= 'Polyline' then call Error 'Objs must be polygons'
if Type2 ~= 'Polygon' & Type2 ~= 'Polyline' then call Error 'Objs must be polygons'
if Type1 ~= Type2 then call Error 'Objs must be same type'
'GetPoints Obj1 Pts1'; Size1 = Result
'GetPoints Obj2 Pts2'; Size2 = Result
if Size1 ~= Size2 then call Error 'Must have same number points'
'GetBool "Blend Colors Also?" "Yes" "No"'
if RC ~= 0 then do
'GetStr "Enter # of steps:" "OK" "Cancel"'; N = Result
/* Get range of 0 to N+1 */
Steps = N + 1
if RC ~= 0 then do
'UnLock'
exit
end
else nop
end
else do
Spread = "T"
call Colors Obj1 Obj2
end
/* Push a new undo level */
'PushUndo'
/* Get center points of objects */
'ObjExtent Obj1 Ext1'
'ObjExtent Obj2 Ext2'
Cent1.X = (Ext1.X1 + Ext1.X2)/2
Cent1.Y = (Ext1.Y1 + Ext1.Y2)/2
Cent2.X = (Ext2.X1 + Ext2.X2)/2
Cent2.Y = (Ext2.Y1 + Ext2.Y2)/2
/* Transform points into angle, radius form */
do I = 0 to Size1-1
if Pts1.I.X ~= 'INDICATOR' then do
if Pts2.I.X ~= 'INDICATOR' then do
DX = Pts1.I.X - Cent1.X
DY = Pts1.I.Y - Cent1.Y
Pts1.I.X = 180*atan2( DY, DX ) / 3.141582653589
Pts1.I.Y = sqrt( DX*DX + DY*DY )
DX = Pts2.I.X - Cent2.X
DY = Pts2.I.Y - Cent2.Y
Pts2.I.X = 180*atan2( DY, DX ) / 3.141582653589
Pts2.I.Y = sqrt( DX*DX + DY*DY )
end
else do
call Error 'Must be same number curves, sub-polys'
end
end
else if Pts1.I.X = Pts2.I.X & Pts1.I.Y = Pts2.I.Y then do
Res.I.X = Pts1.I.X
Res.I.Y = Pts1.I.Y
end
else do
call Error 'Must be same number curves, sub-polys'
end
end
/* Get range of 0 to N+1 */
Steps = N + 1
/* Actually blend the objects */
if Spread = "T" then do
FillX = FillB - Fi
Attrs.EdgeType = 0 /* Speed up refresh w/ NOLINE */
end
do S = 1 to N
S1 = S / Steps
S2 = 1 - S1
do I = 0 to Size1-1
if Pts1.I.X ~= 'INDICATOR' then do
/*Angle = S1 * Pts1.I.X + S2 * Pts2.I.X*/
DA = Pts2.I.X - Pts1.I.X
if DA < 0 then DA = DA + 360
if DA >= 360 then DA = DA - 360
DA = DA * S2
Angle = Pts1.I.X + DA
Dist = S1 * Pts1.I.Y + S2 * Pts2.I.Y
DX = S1 * Cent1.X + S2 * Cent2.X
DY = S1 * Cent1.Y + S2 * Cent2.Y
Res.I.X = DX + Dist * cos( Angle * 3.141592653589 / 180 )
Res.I.Y = DY + Dist * sin( Angle * 3.141592653589 / 180 )
end
else do
Res.I.X = Pts1.I.X
Res.I.Y = Pts1.I.Y
end
end
if Spread = "T" then do
Attrs.FillVal = FillX
Attrs.EdgeVal = FillX /* PS doesn't know NOLINE */
'SetCurrAttrs Attrs'
FillX = FillX - Fi /* Increment FillX */
end
if Type1 = 'Polygon' then do
'Polygon Size1 Res'; Obj = Result
end
else do
'PolyLine Size1 Res'; Obj = Result
end
end
'Front' Obj1
'UnSelect' Obj1
'UnSelect' Obj2
/* Make sure original objs have borders that match fills */
if Spread = "T" then do
'SaveUndo' Obj1
'ChangeEdgeVal' Obj1 FillA
'ChangeEdgeType' Obj1 0
'SaveUndo' Obj2
'ChangeEdgeVal' Obj2 FillB
'ChangeEdgeVal' Obj2 0
end
'Repair'
'UnLock'
exit
COLORS:
arg Obj1 Obj2
FillVal Obj1; FillA = Result
FillVal Obj2; FillB = Result
Steps = abs(FillB-FillA)
if Steps = 0 then call Error "Need a color SPREAD!"
Range = Steps + 1 /* actual # of fills (& objs) in spread */
N = Range - 2 /* actual # intermediate objs and colors */
if FillB > FillA /* Check colors in ascending order */
then Fi = 1 /* Fill increments */
else Fi = -1
FillX = FillA + Fi
'GetBool "Calculate Intermediate Colors?" "Yes" "No"'
if rc ~= 0 then return /*Steps N Fi FillX*/
'Prompt "Calculating Palette!"'
/* Extract their RGB components */
'GetColor' FillA RGBa
'GetColor' FillB RGBb
/* RGB increments */
Ri = abs(RGBb.R-RGBa.R) / Range
Gi = abs(RGBb.G-RGBa.G) / Range
Bi = abs(RGBb.B-RGBa.B) / Range
if RGBb.R > RGBa.R
then Ri = Ri
else Ri = -Ri
if RGBb.G > RGBa.G
then Gi = Gi
else Gi = -Gi
if RGBb.B > RGBa.B
then Bi = Bi
else Bi = -Bi
do for N
RGBa.R = RGBa.R + Ri
RGBa.G = RGBa.G + Gi
RGBa.B = RGBa.B + Bi
'SetColor FillX RGBa'
FillX = FillX + Fi
end
'EndPrompt'
return /*Steps N Fi FillX*/
Error:
arg String
'GetBool String "OK" "Cancel"'
'UnLock'
exit