home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format 58
/
af058b.adf
/
PV21.lha
/
REXX
/
CutPath.pvrx
< prev
next >
Wrap
Text File
|
1991-10-23
|
4KB
|
164 lines
/* CutPath.pvrx---Prompt user to select a point where a
path should be cut.
Author: Jeff Blume
Copyright © 1991 by Stylus, Inc.
Suggested "ProVector.pvrx" entries:
'DefineKey C "CutPath MENU"'
'Define "CutPath Ctrl-C" "CutPath MENU"'
*/
/* Get the argument list to see whether this is a MENU, or an OK */
arg arglist
Cmd = word(arglist,1)
options results
/* Try to get exclusive lock on project window.
If can't get lock, not polite to interrupt. */
'Lock'
if RC ~= 0 then exit
/* This loop is called from the menu */
if Cmd = 'MENU' then
DO
/* Test Selected list for magnetized? */
/* Magnetize Sel Objs for better coord identification.*/
'SelectList' Sel; SelN = Result
if SelN ~= 1 then do
RC = 100
call Error "MUST SELECT ONE OBJECT ONLY!"
end
else 'Magnetize' SelN Sel
'TypeOf Sel.0'; ObjType = Result
call setclip "RepairType","" /* Zero out flag */
select
when ObjType = "Polyline" then do
'Prompt "Click One Point To Cut:"'
'GetUserData 0 1 1 "CutPath OK" ""'
end
when ObjType = "Polygon" then do
'ChangeType Sel.0 Polyline'
'Repair'
'Prompt "Click One Point To Cut:"'
'GetUserData 0 1 1 "CutPath OK" ""'
'ChangeType Sel.0 "Polygon"'
call setclip "RepairType","1"
end
otherwise do
RC = 100
call Error "CAN'T CUT TEXT OR GROUP"
end
end /* SELECT END */
END
/* end "MENU" loop */
/* This was called from GetUserData */
if Cmd = 'OK' then
DO
'EndPrompt'
'GetInputPoints Pts'; NumIn=Result /* 1 or 2 */
'PushUndo'
'Prompt "Looking for cut."'
'SelectList' Sel; SelN = Result
'TypeOf Sel.0'; ObjType = Result
'GetPoints' Sel.0 ObjPts; NumPts=Result
/* Find Cut and build first new obj (Point 1 to Cut) */
do j = 0 to NumPts-1
select
when ObjPts.j.X = Pts.0.X & ObjPts.j.Y = Pts.0.Y then
do
ObjPtsA.j.X = ObjPts.j.X
ObjPtsA.j.Y = ObjPts.j.Y
Cut = j + 1 /* Clicked point stays with first part */
NumPtsB = NumPts - j - 1
if NumPtsB = 1 then do
RC = 100
call Error "CAN'T CUT 2ND TO LAST!"
end
if Cut = NumPts then do
RC = 100
call Error "CAN'T CUT LAST POINT!"
end
if Cut = 1 then do
RC = 100
call Error "CAN'T CUT FIRST POINT!"
end
call NoBeziers ObjPts,Cut
leave j
end
when j = NumPts-1 & Cut = "Cut" then do
RC = 100
call Error "CAN'T FIND CUT!"
end
otherwise do
ObjPtsA.j.X = ObjPts.j.X
ObjPtsA.j.Y = ObjPts.j.Y
end
end /* SELECT END */
end /* "j" DO END */
if ObjType = "Polyline" then 'Polyline' Cut ObjPtsA
else 'Polygon' Cut ObjPtsA
/* Build second new obj (Cut to Point N) */
do j = Cut to NumPts - 1
k = j - Cut
ObjPtsB.k.X = ObjPts.j.X
ObjPtsB.k.Y = ObjPts.j.Y
end
if ObjType = "Polyline" then 'Polyline' NumPtsB ObjPtsB
else 'Polygon' NumPtsB ObjPtsB
/* De-Magnetize and otherwise cleanup */
SelN = 0
'Magnetize' SelN Sel
'Delete' Sel.0
'EndPrompt'
'Repair'
END
/* end "OK" loop */
'UnLock'
EXIT
ERROR:
arg ErrTxt
if RC ~= 0 & ErrTxt ~= "" then 'GetBool ErrTxt "Cancel" "Cancel"'
SelN = 0
'Magnetize' SelN Sel
'EndPrompt'
if getclip("RepairType")=1 then 'Repair'
'UnLock'
exit
NOBEZIERS: /* NO BEZIERS ON THIS BUS! (can't cut 'em) */
arg ObjPts,Cut
do t = Cut-2 to Cut-4 by -1 /* Cut OK at last pt of curve */
if ObjPts.t.X = "INDICATOR" then do
RC = 100
call Error "Can't Cut Curves!"
end
end
return
FINDCUT:
arg Point,ObjPts,NumPts
do j = 0 to NumPts-1
select
when ObjPts.j.X = Point.X & ObjPts.j.Y = Point.Y then
do
Idx.k = j
NmPts.k = NumPts
return ObjPts.j
end
when j = NumPts-1 then return "NO POINT"
otherwise iterate
end /*SELECT END*/
end /* "j" DO END */