home *** CD-ROM | disk | FTP | other *** search
/ DTP Toolbox / DTPToolbox.iso / propage4.0 / arexx / _pd_tools_rect.pdrx < prev    next >
Encoding:
Text File  |  1995-10-23  |  4.7 KB  |  176 lines
  1. /*
  2. RECTANGLE TOOL
  3.  
  4. Modifiers:
  5.     ALT will constrain the rectangle to a square
  6.     Double Clicking will bring up a requester which allows you to set
  7.     the dimensions and radius of curvature of the rectangle
  8.  
  9. */
  10. /* enhanced by Don Cox, Oct '95 */
  11. /* $VER: RectangleTool Oct 95 */
  12.  
  13. call open("STDERR","ram:traceRect","W")
  14. trace r
  15.  
  16.  
  17. msg = PDSetup.rexx(2,0)
  18. units = getclip(pds_units)
  19. if msg ~= 1 then exit_msg(msg)
  20.  
  21. magic = 0.55228479
  22.  
  23. /* Get centre of page for defaults */
  24. psize = pdm_GetPageSize()
  25. pcentreX = word(psize,1)/2
  26. pcentreY = word(psize,2)/2
  27.  
  28. cr = '0a'x
  29. width = getclip(pduserrectwidth)
  30. height = getclip(pduserrectheight)
  31. radius = getclip(pduserrectradius)
  32. xcorner = getclip(pduserrectxcorner) /* for corners */
  33. xcentre = getclip(pduserrectxcentre) /* for centres */
  34. ycorner = getclip(pduserrectycorner) /* for corners */
  35. ycentre = getclip(pduserrectycentre) /* for centres */
  36. cc = upper(getclip(pduserrectcc)) /* set centre or corner */
  37. rotation = getclip(pduserrectrotation)
  38.  
  39. if units > 2 then
  40. do
  41.     width = pdm_ConvertUnits(1,units, width)
  42.     height = pdm_ConvertUnits(1,units, height)
  43.     radius = pdm_ConvertUnits(1,units, radius)
  44.     xcorner = pdm_ConvertUnits(1,units, xcorner)
  45.     xcentre = pdm_ConvertUnits(1,units, xcentre)
  46.     ycorner = pdm_ConvertUnits(1,units, ycorner)
  47.     ycentre = pdm_ConvertUnits(1,units, ycentre)
  48. end
  49.  
  50. if pos('O',cc)=0 then cc='E'
  51. xpos = xcorner
  52. ypos = ycorner
  53. if cc= 'E' then do
  54.     xpos = xcentre
  55.     ypos = ycentre
  56.     end
  57.  
  58. size = pdm_GetForm("Enter size of Rect", 8, "Width:"width || cr"Height:"height ||cr"radius:"radius ||cr||"Centre/Corner (E/O):"CC ||cr|| "X position:"xpos ||cr|| "Y position:"ypos ||cr|| "Angle (degrees):"rotation)
  59. if size = '' then exit_msg()
  60.  
  61. parse var size width '0a'x height '0a'x radius '0a'x cc '0a'x xpos '0a'x ypos '0a'x rotation
  62. if radius = '' then radius = 0
  63. click = 0
  64. if (xpos = ''| ypos= '') then click = 1 /* use click if no position given */
  65. if ~datatype(rotation,n) then rotation = 0
  66.  
  67. if ~(datatype(width, n) & datatype(height,n) & datatype(radius,n)) then
  68.     exit_msg("Invalid Entry")
  69. if ~(datatype(xpos,n) & datatype(ypos,n)) then click = 1
  70.  
  71. if width <= 0 | height <= 0 then
  72.     exit_msg("Invalid Entry")
  73.  
  74. if units > 2 then
  75. do
  76.     width = pdm_ConvertUnits(units,1, width)
  77.     height = pdm_ConvertUnits(units,1, height)
  78.     radius = pdm_ConvertUnits(units,1, radius)
  79.     if datatype(xpos,n) then xpos = pdm_ConvertUnits(1,units, xpos)
  80.     if datatype(ypos,n) then ypos = pdm_ConvertUnits(1,units, ypos)
  81. end
  82.  
  83. if click = 1 then do
  84.     xpos = pcentreX
  85.     ypos = pcentreY
  86.     end
  87.  
  88. if click = 0 then do
  89.     if pos('O',upper(cc)) = 0 then do /* position by centre */
  90.         xcorner = xpos-(width/2)
  91.         ycorner = ypos-(height/2)
  92.         xcentre = xpos
  93.         ycentre = ypos
  94.         end
  95.     else do
  96.         xcorner = xpos
  97.         ycorner = ypos
  98.         xcentre = xpos+(width/2)
  99.         ycentre = ypos+(width/2)
  100.         end
  101.     end
  102.  
  103. call setclip(pduserrectwidth, width)
  104. call setclip(pduserrectheight, height)
  105. call setclip(pduserrectradius, radius)
  106. call setclip(pduserrectxcorner, xcorner)
  107. call setclip(pduserrectxcentre, xcentre)
  108. call setclip(pduserrectycorner, ycorner)
  109. call setclip(pduserrectycentre, ycentre)
  110. call setclip(pduserrectcc, cc)
  111. call setclip(pduserrectrotation, rotation)
  112.  
  113. if click = 1 then do
  114.     rect = pdm_ClickRectangle("Click", width, height)
  115.     if rect = '' then exit_msg()
  116.     xpos = word(rect,1)
  117.     ypos = word(rect,2)
  118.     left = xpos - (width / 2)
  119.     top = ypos - (height / 2)
  120.     right = left + width
  121.     bottom = top + height
  122.     end
  123.  
  124. else do
  125.     left = xcorner
  126.     top = ycorner
  127.     right = xcorner+width
  128.     bottom = ycorner+height
  129.     end
  130.  
  131.  
  132.  
  133. if radius = 0 then
  134.     object = pdm_DrawRectangle(left, top, right, bottom)
  135. else
  136. do
  137.  
  138.     call pdm_InitPlot()
  139.  
  140.     lxpos = left + radius
  141.     rxpos = right - radius
  142.     typos = top + radius
  143.     bypos = bottom - radius
  144.  
  145.     radlen = radius * magic
  146.     nradlen = -radlen
  147.  
  148.     call pdm_PlotBezier(lxpos" "top" "nradlen" 0 0 0")
  149.     call pdm_PlotBezier(rxpos" "top" 0 0 "radlen" 0")
  150.     call pdm_PlotBezier(right" "typos" 0 "nradlen" 0 0")
  151.     call pdm_PlotBezier(right" "bypos" 0 0 0 "radlen)
  152.     call pdm_PlotBezier(rxpos" "bottom" "radlen" 0 0 0")
  153.     call pdm_PlotBezier(lxpos" "bottom" 0 0 "nradlen" 0")
  154.     call pdm_PlotBezier(left" "bypos" 0 "radlen" 0 0")
  155.     call pdm_PlotBezier(left" "typos" 0 0 0 "nradlen)
  156.     call pdm_PlotBezier(lxpos" "top" "nradlen" 0 0 0")
  157.  
  158.     object = pdm_ClosePlot()
  159. end
  160.  
  161. call pdm_UnselectObj()
  162. call pdm_SelectObj(object)
  163. if rotation ~=0 then call pdm_RotateObj(object, rotation, xpos, ypos)
  164.  
  165. exit_msg()
  166.  
  167. exit_msg: procedure expose units
  168. do
  169.     parse arg message
  170.  
  171.     if message ~= '' then call pdm_Inform(1,message,)
  172.     call pdm_SetUnits(units)
  173.     call pdm_AutoUpdate(1)
  174.     exit
  175. end
  176.