The Omni Group Forums - Arrowed arcs

A very rough first draft of a script which links up a set of selected shapes into a cycle, automatically drawing well-formed arc arrows.
[LIST][*]Select a few shapes,[*]and run the script ...[/LIST]
I'll try to add a basic user interface at some point, to allow for interactive adjustment and add some options (arrow width, gaps, block arrow versus line arrow, automatically arrange the shapes evenly around the circle etc etc).

[CODE]property pTitle : "Arc Cycle"
property pVer : "0.08"

property pblnBlockArrow : true
property pArrowWidth : 30
property pArcAnglePoints : 0.25

property pHeadArrow : true
property pTailArrow : false

property pblnSpreadEvenly : true

property pstrLineArrowHead : "FilledArrow"
property plstLineArrowColor : {1.0, 0.0, 0.0}
property prLineArrowThickness : 2
property pblnLineArrowShadow : true

property pGap : 1 / 400

property pDeg : 180 / pi

-- FUNCTION:
-- CREATES A CYCLE DIAGRAM, IN WHICH A SET OF SHAPES ARE LINKED IN A CIRCLE
-- BY ARC ARROWS

-- USAGE:
-- SELECT A FEW SHAPES ARRANGED IN A ROUGH CIRCLE
-- RUN THE SCRIPT
-- ADJUST THE PROPERTIES ABOVE

-- NEXT:
-- I'LL ADD A BASIC USER INTERFACE (AT SOME POINT) TO ALLOW INTERACTIVE ADJUSTMENTS

on run
tell application id "OGfl"
tell front window

-- CHOOSE A SET OF SHAPES (CIRCLES PROBABLY) TO BE JOINED UP BY ARC ARROWS
-- NO NEED FOR THEM TO BE NEATLY ARRANGED
set lstSeln to my ShapesOnly(selection as list)
if length of lstSeln < 2 then
display alert "Select shapes which will form circle"
return
end if

set oCanvas to its canvas
set automatic layout of layout info of oCanvas to false

-- GET THE CENTROID OF THE CLUSTER OF SHAPES
set lstCenter to my GetCentroid(lstSeln)

-- AND MOVE THEM A LITTLE TO EQUALIZE THEIR RADII FROM A CENTRAL POINT
-- (TO DO - OFFER A CHOICE OF DISTRIBUTING THEM EVENLY AROUND THE CIRCLE)
set rRadius to my EqualizeRadius(lstCenter, lstSeln)

-- GET A LIST OF THE SHAPES SORTED IN THE ORDER OF THEIR ANGLES AROUND THE CENTER

set lstShapeRecs to my ReadShapes(lstCenter, lstSeln, oCanvas)
if pblnSpreadEvenly then my SpreadEvenly(lstShapeRecs, lstCenter, rRadius)
end tell
end tell

--READ THE FIRST SHAPE AND THE AMOUNT OF ARC ABSORBED BY ITS RADIUS
set {rStartAngle, oLastShape} to item -1 of lstShapeRecs
set rPreGap to my ShapeGap(oLastShape, rRadius)

-- ALLOW FOR SOME ADDITIONAL SPACE BETWEEN ARROWS AND THE LINKED NODES
set rExtraGap to (pGap * 360)

-- DRAW A CURVED ARC (ARROW) BETWEEN EACH SUCCESSIVE PAIR OF SHAPES
repeat with oRec in lstShapeRecs
set {rAngle, oShape} to oRec
set rPostGap to my ShapeGap(oShape, rRadius)
set oNewShape to MakeArc(pblnBlockArrow, lstCenter, rRadius, rStartAngle + rPreGap + rExtraGap, rAngle - rPostGap - rExtraGap, ¬
pArrowWidth, pArcAnglePoints, pHeadArrow, pTailArrow, oCanvas)
set {rStartAngle, oLastShape, rPreGap} to {rAngle, oShape, rPostGap}
end repeat
end run

on SpreadEvenly(lstShapeRecs, {oX, oY}, rRadius)
set lngShapes to length of lstShapeRecs
set rDelta to 360 / lngShapes
set rTheta to 0
repeat with recShape in lstShapeRecs
set item 1 of recShape to rTheta
my RadialPlaceShape(item 2 of recShape, {oX, oY}, rTheta, rRadius)
set rTheta to rTheta + rDelta
end repeat
end SpreadEvenly

-- HOW MUCH ARC IS TAKEN UP BY THIS SHAPE (ASSUMES A CIRCLE)
on ShapeGap(oShape, rRadius)
tell application id "OGfl"
tell oShape
set {rWidth, rHeight} to size
end tell
set rShapeRad to (rWidth + rHeight) / 4
end tell
return (rShapeRad / (pi * rRadius)) * 180
end ShapeGap

-- CENTER, RADIUS, FROM DEGREES, TO DEGREES, WIDTH,
-- BEZIER POINTS PER DEGREE OF ARC, HEAD ARROW, TAIL ARROW
on MakeArc(pblnBlockArrow, {rX, rY}, rRadius, rFrom, rTo, rWidth, rPointsPerDegree, blnHeadArrow, blnTailArrow, oCanvas)
-- (CURRENTLY A SIMPLE FUNCTION OF THE ARROW WIDTH)
set {rStart, rEnd} to {rFrom, rTo}

if pblnBlockArrow then
-- CALCULATE THE LENGTH OF ANY ARROWS
if (blnHeadArrow or blnTailArrow) then
set rArrow to (rWidth / (pi * rRadius)) * 180
if blnHeadArrow then set rEnd to rTo - rArrow
if blnTailArrow then set rStart to rFrom + rArrow
end if
end if

-- AND THE AMOUNT OF ARC WHICH IT TRAVELS
set rArc to rEnd - rStart
if rArc < 0 then set rArc to (rEnd + 360) - rStart

-- HOW MANY POINTS WILL WE USE TO DRAW THE SHAFT ?
set lngPoints to (rArc * rPointsPerDegree) as integer
set rDelta to rArc / lngPoints

if pblnBlockArrow then
set oGraphic to BlockArrow(oCanvas, {rX, rY}, rFrom, rTo, rStart, rEnd, rDelta, lngPoints, rWidth, blnHeadArrow, blnTailArrow, rRadius)
else
set oGraphic to ArcArrow(oCanvas, {rX, rY}, rFrom, rTo, rDelta, lngPoints, blnHeadArrow, blnTailArrow, rRadius)
end if

return oGraphic
end MakeArc

on ArcArrow(oCanvas, {rX, rY}, rFrom, rTo, rDelta, lngPoints, blnHeadArrow, blnTailArrow, rRadius)
set rTheta to rFrom
set lstPoints to {}
repeat with i from 1 to lngPoints
set end of lstPoints to {rX + (rRadius * (sin(rTheta))), rY - rRadius * (cos(rTheta))}
set rTheta to rTheta + rDelta
end repeat
set end of lstPoints to {rX + (rRadius * (sin(rTheta))), rY - rRadius * (cos(rTheta))}

-- property pstrLineArrowHead : "FilledArrow"
-- property plstLineArrowColor : {1.0, 0.0, 0.0}
-- property plngLineArrowThickness : 2
-- property pblnLineArrowShadow : true

tell application id "OGfl"
tell oCanvas
set recStyle to {draws stroke:true, thickness:prLineArrowThickness, draws shadow:pblnLineArrowShadow, stroke color:plstLineArrowColor}
if blnHeadArrow then set recStyle to recStyle & {head type:pstrLineArrowHead}
if blnTailArrow then set recStyle to recStyle & {tail type:pstrLineArrowHead}
set oLine to (make new line with properties {point list:lstPoints, line type:curved} & recStyle)
end tell
end tell
return oLine
end ArcArrow

on BlockArrow(oCanvas, {rX, rY}, rFrom, rTo, rStart, rEnd, rDelta, lngPoints, rWidth, blnHeadArrow, blnTailArrow, rRadius)

-- GET THE INNER AND OUTER RADII OF THE BLOCK ARROW
set rW to rWidth / 2
set {rRadOut, rRadin} to {rRadius + rW, rRadius - rW}

-- COLLECT THE POINTS FOR THE OUTER AND INNER FLANKS OF THE ARROW
set {lstOuter, lstInner} to {{}, {}}
set rTheta to rStart
repeat with i from 1 to lngPoints
set {dX, dY} to {sin(rTheta), cos(rTheta)}
set end of lstOuter to {rX + (rRadOut * dX), rY - rRadOut * dY}
set end of lstInner to {rX + (rRadin * dX), rY - rRadin * dY}
set rTheta to rTheta + rDelta
end repeat
set {dX, dY} to {sin(rTheta), cos(rTheta)}
set end of lstOuter to {rX + (rRadOut * dX), rY - rRadOut * dY}
set end of lstInner to {rX + (rRadin * dX), rY - rRadin * dY}

-- MAKE HEAD AND/OR TAIL ARROWS IF REQUIRED
set {lstHead, lstTail} to {{}, {}}
set {rInnerBarb, rOuterBarb} to {rRadius - rWidth, rRadius + rWidth}
-- TAIL ARROW ?
if blnTailArrow then
-- inner barb, tip, outer barb
set lstTail to {{rX + (rInnerBarb * (sin(rStart))), rY - rInnerBarb * (cos(rStart))}, ¬
{rX + (rRadius * (sin(rFrom))), rY - rRadius * (cos(rFrom))}, ¬
{rX + (rOuterBarb * (sin(rStart))), rY - rOuterBarb * (cos(rStart))}}
end if
-- HEAD ARROW ?
if blnHeadArrow then
set lstHead to {{rX + (rOuterBarb * (sin(rEnd))), rY - rOuterBarb * (cos(rEnd))}, ¬
{rX + (rRadius * (sin(rTo))), rY - rRadius * (cos(rTo))}, ¬
{rX + (rInnerBarb * (sin(rEnd))), rY - rInnerBarb * (cos(rEnd))}}
end if

-- JOIN THE SHAFT TO ANY ARROW TIPS
set lstPoints to (lstOuter & lstHead & reverse of lstInner & lstTail)

-- GATHER THE POINTS IN THE TRIPLET FORMAT EXPECTED FOR CUSTOM SHAPES
set oFirstPoint to item 1 of lstPoints
set lstBezier to {oFirstPoint, oFirstPoint}
repeat with i from 2 to length of lstPoints
set oPoint to item i of lstPoints
set lstBezier to lstBezier & {oPoint, oPoint, oPoint}
end repeat
set end of lstBezier to oFirstPoint

-- AND RETURN A CUSTOM SHAPE
tell application id "OGfl"
tell oCanvas to set oShape to make new shape with properties {point list:lstBezier}
end tell
return oShape
end BlockArrow

-- PRUNE OUT ANY SELECTED LINES
on ShapesOnly(lstSeln)
set lstClean to {}
tell application id "OGfl"
repeat with oGraphic in lstSeln
if class of oGraphic is shape then set end of lstClean to oGraphic
end repeat
end tell
lstClean
end ShapesOnly

-- FIND THE CENTER OF A SHAPE
on GetCenter(oShape)
tell application id "OGfl"
tell oShape to set {{oX, oY}, {rWidth, rHeight}} to {origin, size}
{oX + rWidth / 2, oY + rHeight / 2}
end tell
end GetCenter

-- READ THE SHAPES INTO A LIST SORTED BY THEIR ANGLE AROUND THE CENTRE
on ReadShapes({rX, rY}, lstShapes, oCanvas)
set lngShapes to length of lstShapes
if lngShapes < 1 then return

-- GET THE RADIUS FROM THE FIRST SHAPE
tell application id "OGfl"
set shpFirst to first item of lstShapes
tell shpFirst to set {{oX, oY}, {rWidth, rHeight}} to {origin, size}
set {cX, cY} to {oX + rWidth / 2, oY + rHeight / 2}
set {dX, dY} to {cX - rX, cY - rY}
set rRadius to (dX ^ 2 + dY ^ 2) ^ 0.5

-- loop through the remaining shapes
-- getting the angles
-- arcsin(dx/rRadius
set strCmd to "echo 'echo "
set lstAngle to {}
set strWatch to ""
repeat with i from 1 to lngShapes
set oShape to item i of lstShapes
tell oShape to set {{oX, oY}, {rWidth, rHeight}} to {origin, size}
set {cX, cY} to {oX + rWidth / 2, oY + rHeight / 2}

set {dX, dY} to {cX - rX, rY - cY}
if dX > rRadius then
set strSinTheta to "1"
else if dX < -rRadius then
set strSinTheta to "-1"
else
set strSinTheta to (dX / rRadius) as string
end if

if dY > rRadius then
set strCosTheta to "1"
else if dY < -rRadius then
set strCosTheta to "-1"
else
set strCosTheta to (dY / rRadius) as string
end if

set strCmd to (strCmd & "$((asin(" & strSinTheta & "))) $((acos(" & strCosTheta as string) & "))) "
end repeat

set strCmd to strCmd & "' | ksh"
set my text item delimiters to space
set lstData to text items of (do shell script strCmd)
set lstAngles to {}
set str to ""
set j to 1
repeat with i from 1 to (lngShapes * 2) by 2
set {sX, sY} to {(item i of lstData) as number, (item (i + 1) of lstData) as number}
set oShape to item j of lstShapes
set str to str & my GetDegrees(sX, sY) & tab & id of oShape & tab & text of oShape & linefeed
set j to j + 1
end repeat
set lst to paragraphs of (do shell script "echo " & quoted form of texts 1 thru -2 of str & " | sort -n | cut -f 1,2")
set my text item delimiters to tab
tell oCanvas
repeat with i from 1 to length of lst
set lstParts to text items of item i of lst
set item 2 of lstParts to shape id ((item 2 of lstParts) as integer)
set item i of lst to lstParts
end repeat
end tell
set my text item delimiters to space
return lst
end tell
end ReadShapes

-- REWRITE RADIANS AS DEGREES
on GetDegrees(sX, sY)
if sX > 0 then
sY * pDeg
else
360 - (sY * pDeg)
end if
end GetDegrees

-- PULL/PUSH SHAPES TO A NORMALIZED RADIUS AROUND A POINT
on EqualizeRadius({rX, rY}, lstSeln)
-- first get the average radius
set lngShapes to length of lstSeln
if lngShapes < 1 then return

set lstRads to {}
repeat with oShape in lstSeln
set {dX, dY} to (my Point2Shape({rX, rY}, oShape))
set end of lstRads to {(dX ^ 2 + dY ^ 2) ^ 0.5, {dX, dY}}
end repeat

set rSum to 0
repeat with oRad in lstRads
set rSum to rSum + (item 1 of oRad)
end repeat
set rAvgRad to rSum / lngShapes

-- then move each shape to that radius
-- rescale the dx and dy from the centre in proportion to the radius change
tell application id "OGfl"
repeat with i from 1 to lngShapes
set {rRad, {dX, dY}} to item i of lstRads
if rRad ≠ rAvgRad then
set rPropn to rAvgRad / rRad
set {dX, dY} to {dX * rPropn - dX, dY * rPropn - dY}

set oShape to item i of lstSeln
set {xOld, yOld} to origin of oShape
set origin of oShape to {xOld + dX, yOld + dY}
end if
end repeat
end tell
return rAvgRad
end EqualizeRadius

on RadialPlaceShape(oShape, {oX, oY}, rTheta, rRadius)
tell application id "OGfl"
-- Rewrite the Theta and Radius to a DX, DY
set {dX, dY} to {rRadius * (my sin(rTheta)), rRadius * (my cos(rTheta))}

-- Apply that to the origin
set {X1, Y1} to {oX + dX, oY - dY}

-- Place the shape by its top-left corner, allowing for its height and width
set {rWidth, rHeight} to size of oShape
set origin of oShape to {X1 - rWidth / 2, Y1 - rHeight / 2}
end tell
end RadialPlaceShape

on Point2Shape({rX, rY}, shp)
tell application id "OGfl"
tell shp to set {{rX1, rY1}, {rWidth1, rHeight1}} to {its origin, its size}
end tell
set dX to (rX1 + rWidth1 / 2) - rX
set dY to (rY1 + rHeight1 / 2) - rY
{dX, dY}
end Point2Shape

-- FIND A POINT WHOSE COORDINATES ARE AT THE MEAN OF A SET OF CENTRES
on GetCentroid(lstShapes)
set lngShapes to length of lstShapes
if lngShapes < 1 then return missing value
set {rXSum, rYSum} to {0, 0}
tell application id "OGfl"
repeat with oShape in lstShapes
tell oShape to set {{rX, rY}, {rWidth, rHeight}} to {origin, size}
set rXSum to rXSum + rX + (rWidth / 2)
set rYSum to rYSum + rY + (rHeight / 2)
end repeat
end tell
{rXSum / lngShapes, rYSum / lngShapes}
end GetCentroid

-- BASIC TRIG FUNCTIONS PUBLISHED BY OTHERS
-- COULD USE THE KSH SHELL, BUT THESE ARE PROBABLY FASTER ...

-- Trig functions from:
-- http://lists.apple.com/archives/applescript-users/2004/Feb/msg00939.html

on cos(x) -- degrees
local myCos, numerator, denominator, factor

set myCos to 0
if (x = 90) or (x = 270) then
set myCos to 0
else
set x to (x - (((x / 360) div 1) * 360)) * (pi / 180)
set {myCos, numerator, denominator, factor} to {0, 1, 1, -(x ^ 2)}
repeat with i from 2 to 40 by 2
set myCos to myCos + numerator / denominator
set numerator to numerator * factor
set denominator to denominator * i * (i - 1)
end repeat
end if
return myCos
end cos

----------------------------
on sin(x) -- degrees
local mySin, numerator, denomintator, factor

set mySin to 0
if (x = 180) or (x = 360) then
set mySin to 0
else
set x to (x - (((x / 360) div 1) * 360)) * (pi / 180)
set {mySin, numerator, denominator, factor} to {0, x, 1, -(x ^ 2)}
repeat with i from 3 to 40 by 2
set mySin to mySin + numerator / denominator
set numerator to numerator * factor
set denominator to denominator * i * (i - 1)
end repeat
end if
return mySin
end sin
[/CODE]