home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / WordProcessors / FINALWRITER1.DMS / in.adf / FWMacros.lha / GfxClip next >
Encoding:
Text File  |  1993-08-14  |  10.9 KB  |  349 lines
  1. /* ================================    */
  2. /*  FINAL WRITER AREXX MACRO            */
  3. /*  Graphics Clip Macro Generator.    */
  4. /* $VER: GfxMacroGen 3.0 (14.8.93)    */
  5. /* ================================    */
  6. Options Results
  7.  
  8. SetMeasure MICROPOINTS
  9.  
  10. /* Get a list of all the selected objects. */
  11. i = 0
  12. FirstObject SELECTED
  13. IF ( Result = 0 ) THEN DO
  14.     ShowMessage 1 1 '"No graphic objects are selected." "The graphic clip macro will not be generated." "" "OK" "" ""'
  15.     EXIT
  16.     END
  17.  
  18. DO WHILE ( Result ~= 0 )
  19.     i = I + 1
  20.     Object.i = Result
  21.     NextObject Object.i SELECTED
  22.     END
  23.  
  24. /* Get a filename to use */
  25. RequestText '"Graphic Clip" "Enter Graphic Clip Macro filename:" ""'
  26. IF    ( RC ~= 0 ) THEN EXIT
  27.  
  28. /* Make sure a filename is entered */
  29. filename = Result
  30. IF ( LENGTH(filename) = 0 ) THEN DO
  31.     ShowMessage 1 1 '"You did not enter a filename." "The graphic clip macro will not be generated." "" "OK" "" ""'
  32.     EXIT
  33.     END
  34.  
  35. /* Does the file already exist? */
  36. IF    ( EXISTS(filename) ) THEN DO
  37.     firstLine = '"The file <' || filename || '> already exists."'
  38.     secondLine = '"Do you want to replace it?"'
  39.     ShowMessage 2 1 firstLine secondLine '"" "Yes" "No" ""'
  40.     IF ( Result = 2 ) THEN EXIT
  41.     END
  42.  
  43. /* What is the page height we are working with? */
  44. GetPageSetup HEIGHT
  45. pageHt = Result
  46.  
  47. /* Open the file. */
  48. IF ( OPEN('GfxClipFile', filename, 'Write') ) THEN DO
  49.     /* File is opened. */
  50.  
  51.     /* Write the file header stuff */
  52.     CALL LineOut('GfxClipFile', '/* ------------------------ */')
  53.     CALL LineOut('GfxClipFile', '/* Final Writer Arexx Macro */')
  54.     CALL LineOut('GfxClipFile', '/* Graphics Clip Macro      */')
  55.     CALL LineOut('GfxClipFile', '/* ------------------------ */')
  56.     CALL LineOut('GfxClipFile', '')
  57.     CALL LineOut('GfxClipFile', 'Options Results')
  58.     CALL LineOut('GfxClipFile', 'SetMeasure MICROPOINTS')
  59.     CALL LineOut('GfxClipFile', 'page = 1')
  60.     CALL LineOut('GfxClipFile', 'numobjs = 0')
  61.     CALL LineOut('GfxClipFile', 'Status SCROLLPOS')
  62.     CALL LineOut('GfxClipFile', 'PARSE VAR Result XPos YPos')
  63.     CALL LineOut('GfxClipFile', '')
  64.  
  65.  
  66.     /* -----------------------------------------------    */
  67.     /* For each object, determine the coordinates and    */
  68.     /* find the minimum x and y values to use to            */
  69.     /* normalize the coordinatess.                            */
  70.     /* -----------------------------------------------    */
  71.     x = 0
  72.     DO WHILE ( x < i )
  73.         x = x + 1
  74.  
  75.         GetObjectType Object.x
  76.         objtype.x = Result
  77.  
  78.         /* Before getting the coordinates un-rotate the object */
  79.         GetObjectRotation Object.x
  80.         objRotate.x = Result
  81.         IF ( objRotate.x ~= 0 ) THEN
  82.             SetObjectRotation Object.x 0
  83.  
  84.         /* Get the coordinates */
  85.         GetObjectCoords Object.x
  86.         PARSE VAR Result page.x x1.x y1.x x2.x y2.x
  87.  
  88.         /* If we un-rotated the object, rotate it back. */
  89.         IF    ( objRotate.x ~= 0 ) THEN
  90.             SetObjectRotation Object.x objRotate.x
  91.  
  92.         /* Convert page and y value to a value from top of first page */
  93.         y1.x = ((page.x - 1) * pageHt) + y1.x
  94.  
  95.         IF    ( x = 1 ) THEN DO
  96.             XNormalizer = x1.x
  97.             YNormalizer = y1.x
  98.             END
  99.  
  100.         IF ( x1.x < XNormalizer ) THEN
  101.             XNormalizer = x1.x
  102.         IF ( y1.x < YNormalizer ) THEN
  103.             YNormalizer = y1.x
  104.  
  105.         IF    ( objtype.x = 2 | objtype.x = 3 ) THEN DO
  106.             y2.x = ((page.x - 1) * pageHt) + y2.x
  107.  
  108.             IF ( x2.x < XNormalizer ) THEN
  109.                 XNormalizer = x2.x
  110.  
  111.             IF ( y2.x < YNormalizer ) THEN
  112.                 YNormalizer = y2.x
  113.             END
  114.         END
  115.  
  116.     /* Now normalize the coordinates */
  117.     x = 0
  118.     DO WHILE ( x < i )
  119.         x = x + 1
  120.         x1.x = x1.x - XNormalizer
  121.         y1.x = y1.x - YNormalizer
  122.         IF ( objtype.x = 2 | objtype.x = 3 ) THEN DO
  123.             x2.x = x2.x - XNormalizer
  124.             y2.x = y2.x - YNormalizer
  125.             END
  126.         END
  127.  
  128.     /* For each one of the graphic objects in our list */
  129.     /* create AREXX code to redraw the object.            */
  130.     x = 0
  131.     DO WHILE ( x < i )
  132.         x = x + 1
  133.  
  134.         SELECT
  135.             WHEN (objtype.x = 2 | objtype.x = 3) THEN DO
  136.                 /* -------------- */
  137.                 /* We have a Line */
  138.                 /* -------------- */
  139.                 modifier = ""
  140.                 if    ( objtype.x = 3 ) THEN
  141.                     modifier = 'ARROW'
  142.  
  143.                 /* Output the commands to calculate line's position. */
  144.                 commandLine = 'fromX =' x1.x '+ XPos' 
  145.                 CALL LineOut('GfxClipFile', commandline)
  146.                 commandLine = 'toX =' x2.x '+ XPos'
  147.                 CALL LineOut('GfxClipFile', commandline)
  148.  
  149.                 commandLine = 'fromY =' y1.x '+ YPos' 
  150.                 CALL LineOut('GfxClipFile', commandline)
  151.                 commandLine = 'toY =' y2.x '+ YPos'
  152.                 CALL LineOut('GfxClipFile', commandline)
  153.  
  154.                 /* Output the commands to draw the line. */
  155.                 commandLine = 'DrawLine page fromX fromY toX toY' modifier
  156.                 CALL LineOut('GfxClipFile', commandLine)
  157.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result')
  158.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  159.  
  160.                 /* Output the commands to set the line's parameters. */
  161.                 GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT
  162.                 PARSE VAR Result tf fd lw
  163.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw
  164.                 CALL LineOut('GfxClipFile', commandLine)
  165.  
  166.                 /* The line color may contain spaces, so treat it separately. */
  167.                 GetObjectParams Object.x LINECOLOR
  168.                 commandLine = 'SetObjectParams 0'  'LINECOLOR' "'" || '"' || Result || '"' || "'"
  169.                 CALL LineOut('GfxClipFile', commandLine)
  170.                 END
  171.  
  172.             WHEN (objtype.x = 4 | objtype.x = 5) THEN DO
  173.                 /* ------------- */
  174.                 /* We have a Box */
  175.                 /* ------------- */
  176.                 modifier = ""
  177.                 if (objtype.x = 5) THEN
  178.                     modifier = 'BEVEL'
  179.  
  180.                 /* Output the command to draw the box. */
  181.                 commandLine = 'newX =' x1.x '+ XPos' 
  182.                 CALL LineOut('GfxClipFile', commandline)
  183.                 commandLine = 'newY =' y1.x '+ YPos' 
  184.                 CALL LineOut('GfxClipFile', commandline)
  185.  
  186.                 commandLine = 'DrawBox page newX newY' x2.x y2.x modifier
  187.                 CALL LineOut('GfxClipFile', commandLine)
  188.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  189.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  190.  
  191.                 /* Output the commands to set the box's parameters. */
  192.                 GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
  193.                 PARSE VAR Result tf fd lw fl
  194.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
  195.                 CALL LineOut('GfxClipFile', commandLine)
  196.  
  197.                 /* The line and fill colors may contain spaces, so treat them separately. */
  198.                 GetObjectParams Object.x LINECOLOR
  199.                 commandLine = 'SetObjectParams 0'  'LINECOLOR' "'" || '"' || Result || '"' || "'"
  200.                 CALL LineOut('GfxClipFile', commandLine)
  201.  
  202.                 GetObjectParams Object.x FILLCOLOR
  203.                 commandLine = 'SetObjectParams 0'  'FILLCOLOR' "'" || '"' || Result || '"' || "'"
  204.                 CALL LineOut('GfxClipFile', commandLine)
  205.                 END
  206.  
  207.             WHEN (objtype.x = 6) THEN DO
  208.                 /* --------------- */
  209.                 /* We have an Oval */
  210.                 /* --------------- */
  211.  
  212.                 /* Output the command to draw the oval. */
  213.                 commandLine = 'newX =' x1.x '+ XPos'
  214.                 CALL LineOut('GfxClipFile', commandline)
  215.                 commandLine = 'newY =' y1.x '+ YPos'
  216.                 CALL LineOut('GfxClipFile', commandline)
  217.  
  218.                 commandLine = 'DrawOval page newX newY' x2.x y2.x
  219.                 CALL LineOut('GfxClipFile', commandLine)
  220.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  221.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  222.  
  223.                 /* Output the commands to set the oval's parameters. */
  224.                 GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
  225.                 PARSE VAR Result tf fd lw fl
  226.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
  227.                 CALL LineOut('GfxClipFile', commandLine)
  228.  
  229.                 /* The line and fill colors may contain spaces, so treat them separately. */
  230.                 GetObjectParams Object.x LINECOLOR
  231.                 commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
  232.                 CALL LineOut('GfxClipFile', commandLine)
  233.  
  234.                 GetObjectParams Object.x FILLCOLOR
  235.                 commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
  236.                 CALL LineOut('GfxClipFile', commandLine)
  237.                 END
  238.  
  239.             WHEN (objtype.x = 7) THEN DO
  240.                 /* ------------------- */
  241.                 /* We have a TextBlock */
  242.                 /* ------------------- */
  243.  
  244.                 /* Output the command to draw the textblock. */
  245.                 commandLine = 'newX =' x1.x '+ XPos'
  246.                 CALL LineOut('GfxClipFile', commandline)
  247.                 commandLine = 'newY =' y1.x '+ YPos'
  248.                 CALL LineOut('GfxClipFile', commandline)
  249.  
  250.                 GetTextBlockText Object.x
  251.                 text = Result
  252.                 commandLine = 'DrawTextBlock page newX newY' '"' || text || '"'
  253.                 CALL LineOut('GfxClipFile', commandLine)
  254.                 CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
  255.                 CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
  256.  
  257.                 /* Output the commands to set the textblock's parameters. */
  258.                 GetObjectParams Object.x TEXTFLOW FLOWDIST
  259.                 PARSE VAR Result tf fd
  260.                 commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd
  261.                 CALL LineOut('GfxClipFile', commandLine)
  262.  
  263.                 /* Output the commands to set the textblock's typespecs. */
  264.                 GetObjectTypeSpecs Object.x SIZE LEADING WIDTH OBLIQUE
  265.                 PARSE VAR Result sz ld wd ob
  266.                 commandLine = 'SetObjectTypeSpecs 0' 'SIZE' sz 'LEADING' ld 'WIDTH' wd 'OBLIQUE' ob
  267.                 CALL LineOut('GfxClipFile', commandLine)
  268.  
  269.                 /* The color and font may contain spaces, so treat them separately. */
  270.                 GetObjectTypeSpecs Object.x COLOR
  271.                 commandLine = 'SetObjectTypeSpecs 0' 'COLOR' "'" || '"' || Result || '"' || "'"
  272.                 CALL LineOut('GfxClipFile', commandLine)
  273.  
  274.                 GetObjectTypeSpecs Object.x FONT
  275.                 commandLine = 'SetObjectTypeSpecs 0' 'FONT' '"' || Result || '"'
  276.                 CALL LineOut('GfxClipFile', commandLine)
  277.                 END
  278.  
  279.             OTHERWISE ITERATE        /* Ignore images (objtype.x = 1), groups (objtype.x = 8) */
  280.                                         /* and anything else we don't recognize.                 */
  281.             END /* End select */
  282.  
  283.         /* Output command to rotate the object if needed */
  284.         IF    ( objRotate.x ~= 0 ) THEN DO
  285.             commandLine = 'SetObjectRotation 0' objRotate.x
  286.             CALL LineOut('GfxClipFile', commandLine)
  287.             END
  288.  
  289.         /* Output the command to set the objects title. */
  290.         GetObjectTitle object.x
  291.         commandLine = 'SetObjectTitle 0' '"' || Result || '"'
  292.         CALL LineOut('GfxClipFile', commandLine)
  293.  
  294.         /* Output a blank line */
  295.         CALL LineOut('GfxClipFile', '')
  296.  
  297.         END /* End while */
  298.  
  299.     /* Output commands to select all the new objects. */
  300.     CALL LineOut('GfxClipFile', 'i = 0')
  301.     CALL LineOut('GfxClipFile', 'DO WHILE (i < numobjs)')
  302.     CALL LineOut('GfxClipFile', 'SelectObject objectid.i MULTIPLE')
  303.     CALL LineOut('GfxClipFile', 'i = i + 1')
  304.     CALL LineOut('GfxClipFile', 'END')
  305.     CALL LineOut('GfxClipFile', '')
  306.  
  307.     /* Output the command to redraw everything. */
  308.     CALL LineOut('GfxClipFile', 'Redraw')
  309.     CALL LineOUt('GfxClipFile', 'GraphicTool')
  310.     CALL LineOut('GfxClipFile', '')
  311.  
  312.     /* Close the file */
  313.     CALL CLOSE('GfxClipFile');
  314.  
  315.     /* Reselect all of our objects */
  316.     x = 0
  317.     DO WHILE ( x < i )
  318.         X = X + 1
  319.        SelectObject Object.x MULTIPLE
  320.        END
  321.  
  322.     END /* End if */
  323. ELSE DO
  324.     /* File could not be opened. */
  325.     firstLine = '"Cannot open file <' || filename || '>."'
  326.     ShowMessage 1 1 firstLine '"" "" "OK" "" ""'
  327.     EXIT
  328.     END
  329.  
  330. EXIT
  331.  
  332.  
  333. /* ============================================ */
  334. /* LineOut                                      */
  335. /* Procedure to write a line out to the file    */
  336. /* checking for errors and exiting if any found */
  337. /* ============================================ */
  338. LineOut: PROCEDURE
  339. PARSE ARG filehandle, str
  340.  
  341.     len = WRITELN( filehandle, str )
  342.     IF (len ~= LENGTH(str) + 1) THEN DO
  343.         ShowMessage 1 1 '"Error writing file!" "" "" "OK" "" ""'
  344.         CALL CLOSE(filehandle);
  345.         EXIT
  346.         END
  347.  
  348. RETURN
  349.