home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 58 / af058b.adf / PV21.lha / REXX / CutPath.pvrx < prev    next >
Text File  |  1991-10-23  |  4KB  |  164 lines
  1. /* CutPath.pvrx---Prompt user to select a point where a
  2.     path should be cut.
  3.  
  4.    Author: Jeff Blume
  5.    Copyright © 1991 by Stylus, Inc.
  6.  
  7.    Suggested "ProVector.pvrx" entries:
  8.  
  9.     'DefineKey C "CutPath MENU"'
  10.     'Define "CutPath  Ctrl-C" "CutPath MENU"'
  11.  
  12. */
  13.  
  14. /* Get the argument list to see whether this is a MENU, or an OK */
  15. arg arglist
  16. Cmd = word(arglist,1)
  17.  
  18. options results
  19.  
  20. /* Try to get exclusive lock on project window.
  21.     If can't get lock, not polite to interrupt. */
  22. 'Lock'
  23. if RC ~= 0 then exit
  24.  
  25. /* This loop is called from the menu */
  26. if Cmd = 'MENU' then
  27. DO
  28.     /* Test Selected list for magnetized? */
  29.     /* Magnetize Sel Objs for better coord identification.*/
  30.     'SelectList' Sel; SelN = Result
  31.     if SelN ~= 1 then do
  32.         RC = 100
  33.         call Error "MUST SELECT ONE OBJECT ONLY!"
  34.         end
  35.     else 'Magnetize' SelN Sel
  36.     'TypeOf Sel.0'; ObjType = Result
  37.     call setclip "RepairType",""    /* Zero out flag */
  38.     select
  39.         when ObjType = "Polyline" then do
  40.             'Prompt "Click One Point To Cut:"'
  41.             'GetUserData 0 1 1 "CutPath OK" ""'
  42.             end
  43.         when ObjType = "Polygon" then do
  44.             'ChangeType Sel.0 Polyline'
  45.             'Repair'
  46.             'Prompt "Click One Point To Cut:"'
  47.             'GetUserData 0 1 1 "CutPath OK" ""'
  48.             'ChangeType Sel.0 "Polygon"'
  49.             call setclip "RepairType","1"
  50.             end
  51.         otherwise do
  52.             RC = 100
  53.             call Error "CAN'T CUT TEXT OR GROUP"
  54.             end
  55.     end /* SELECT END */
  56. END
  57. /* end "MENU" loop */
  58.  
  59. /* This was called from GetUserData */
  60. if Cmd = 'OK' then
  61. DO
  62.     'EndPrompt'
  63.     'GetInputPoints Pts'; NumIn=Result /* 1 or 2 */
  64.     'PushUndo'
  65.  
  66.     'Prompt "Looking for cut."'
  67.     'SelectList' Sel; SelN = Result
  68.     'TypeOf Sel.0'; ObjType = Result
  69.     'GetPoints' Sel.0 ObjPts; NumPts=Result
  70.  
  71.     /* Find Cut and build first new obj (Point 1 to Cut) */
  72.     do j = 0 to NumPts-1
  73.         select
  74.             when ObjPts.j.X = Pts.0.X & ObjPts.j.Y = Pts.0.Y then
  75.                 do
  76.                     ObjPtsA.j.X = ObjPts.j.X
  77.                     ObjPtsA.j.Y = ObjPts.j.Y
  78.                     Cut = j + 1        /* Clicked point stays with first part */
  79.                     NumPtsB = NumPts - j - 1
  80.                     if NumPtsB = 1 then do
  81.                         RC = 100
  82.                         call Error "CAN'T CUT 2ND TO LAST!"
  83.                         end
  84.                     if Cut = NumPts then do
  85.                         RC = 100
  86.                         call Error "CAN'T CUT LAST POINT!"
  87.                         end
  88.                     if Cut = 1 then do
  89.                         RC = 100
  90.                         call Error "CAN'T CUT FIRST POINT!"
  91.                         end
  92.                     call NoBeziers ObjPts,Cut
  93.                     leave j
  94.                 end
  95.             when j = NumPts-1 & Cut = "Cut" then do
  96.                         RC = 100
  97.                         call Error "CAN'T FIND CUT!"
  98.                         end
  99.             otherwise do
  100.                 ObjPtsA.j.X = ObjPts.j.X
  101.                 ObjPtsA.j.Y = ObjPts.j.Y
  102.                 end
  103.         end /* SELECT END */
  104.     end /* "j" DO END */
  105.     if ObjType = "Polyline" then 'Polyline' Cut ObjPtsA
  106.     else 'Polygon' Cut ObjPtsA
  107.  
  108.     /* Build second new obj (Cut to Point N) */
  109.     do j = Cut to NumPts - 1
  110.         k = j - Cut
  111.         ObjPtsB.k.X = ObjPts.j.X
  112.         ObjPtsB.k.Y = ObjPts.j.Y
  113.     end
  114.     if ObjType = "Polyline" then 'Polyline' NumPtsB ObjPtsB
  115.     else 'Polygon' NumPtsB ObjPtsB
  116.  
  117.     /* De-Magnetize and otherwise cleanup */
  118.     SelN = 0
  119.     'Magnetize' SelN Sel
  120.     'Delete' Sel.0
  121.     'EndPrompt'
  122.     'Repair'
  123. END
  124. /* end "OK" loop */
  125.  
  126. 'UnLock'
  127. EXIT
  128.  
  129.  
  130. ERROR:
  131.     arg ErrTxt
  132.     if RC ~= 0 & ErrTxt ~= "" then 'GetBool ErrTxt "Cancel" "Cancel"'
  133.     SelN = 0
  134.     'Magnetize' SelN Sel
  135.     'EndPrompt'
  136.     if getclip("RepairType")=1 then 'Repair'
  137.     'UnLock'
  138.     exit
  139.  
  140. NOBEZIERS:        /* NO BEZIERS ON THIS BUS! (can't cut 'em) */
  141.     arg ObjPts,Cut
  142.     do t = Cut-2 to Cut-4 by -1    /* Cut OK at last pt of curve */
  143.         if ObjPts.t.X = "INDICATOR" then do
  144.             RC = 100
  145.             call Error "Can't Cut Curves!"
  146.         end
  147.     end
  148.     return
  149.  
  150. FINDCUT:
  151.     arg Point,ObjPts,NumPts
  152.     do j = 0 to NumPts-1
  153.         select
  154.             when ObjPts.j.X = Point.X & ObjPts.j.Y = Point.Y then
  155.                 do
  156.                     Idx.k = j
  157.                     NmPts.k = NumPts
  158.                     return ObjPts.j
  159.                 end
  160.             when j = NumPts-1 then return "NO POINT"
  161.             otherwise iterate
  162.         end /*SELECT END*/
  163.     end /* "j" DO END */
  164.