home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Merciful 3
/
Merciful_Release_3.bin
/
software
/
f
/
finalwriter
/
finalwriterv5.04ukver.lha
/
FinalWriter_B
/
FWMacros
/
GfxClip
< prev
next >
Wrap
Text File
|
1994-09-21
|
11KB
|
353 lines
/* ================================ */
/* FINAL WRITER AREXX MACRO */
/* Graphics Clip Macro Generator. */
/* $VER: GfxMacroGen 3.1 (21.9.94) */
/* ================================ */
Options Results
SetMeasure MICROPOINTS
/* Get a list of all the selected objects. */
i = 0
FirstObject SELECTED
IF ( Result = 0 ) THEN DO
ShowMessage 1 1 '"No graphic objects are selected." "The graphic clip macro will not be generated." "" "OK" "" ""'
EXIT
END
DO WHILE ( Result ~= 0 )
i = I + 1
Object.i = Result
NextObject Object.i SELECTED
END
/* Get a filename to use */
RequestText '"Graphic Clip" "Enter Graphic Clip Macro filename:" ""'
IF ( RC ~= 0 ) THEN EXIT
/* Make sure a filename is entered */
filename = Result
IF ( LENGTH(filename) = 0 ) THEN DO
ShowMessage 1 1 '"You did not enter a filename." "The graphic clip macro will not be generated." "" "OK" "" ""'
EXIT
END
/* Does the file already exist? */
IF ( EXISTS(filename) ) THEN DO
firstLine = '"The file <' || filename || '> already exists."'
secondLine = '"Do you want to replace it?"'
ShowMessage 2 1 firstLine secondLine '"" "Yes" "No" ""'
IF ( Result = 2 ) THEN EXIT
END
/* What is the page height we are working with? */
GetPageSetup HEIGHT
pageHt = Result
/* Open the file. */
IF ( OPEN('GfxClipFile', filename, 'Write') ) THEN DO
/* File is opened. */
/* Write the file header stuff */
CALL LineOut('GfxClipFile', '/* ------------------------ */')
CALL LineOut('GfxClipFile', '/* Final Writer Arexx Macro */')
CALL LineOut('GfxClipFile', '/* Graphics Clip Macro */')
CALL LineOut('GfxClipFile', '/* ------------------------ */')
CALL LineOut('GfxClipFile', '')
CALL LineOut('GfxClipFile', 'Options Results')
CALL LineOut('GfxClipFile', 'SetMeasure MICROPOINTS')
CALL LineOut('GfxClipFile', 'page = 1')
CALL LineOut('GfxClipFile', 'numobjs = 0')
CALL LineOut('GfxClipFile', 'Status SCROLLPOS')
CALL LineOut('GfxClipFile', 'PARSE VAR Result XPos YPos')
CALL LineOut('GfxClipFile', '')
/* ----------------------------------------------- */
/* For each object, determine the coordinates and */
/* find the minimum x and y values to use to */
/* normalize the coordinatess. */
/* ----------------------------------------------- */
x = 0
DO WHILE ( x < i )
x = x + 1
GetObjectType Object.x
objtype.x = Result
/* Before getting the coordinates un-rotate the object */
GetObjectRotation Object.x
objRotate.x = Result
IF ( objRotate.x ~= 0 ) THEN
SetObjectRotation Object.x 0
/* Get the coordinates */
GetObjectCoords Object.x
PARSE VAR Result page.x x1.x y1.x x2.x y2.x
/* If we un-rotated the object, rotate it back. */
IF ( objRotate.x ~= 0 ) THEN
SetObjectRotation Object.x objRotate.x
/* Convert page and y value to a value from top of first page */
y1.x = ((page.x - 1) * pageHt) + y1.x
IF ( x = 1 ) THEN DO
XNormalizer = x1.x
YNormalizer = y1.x
END
IF ( x1.x < XNormalizer ) THEN
XNormalizer = x1.x
IF ( y1.x < YNormalizer ) THEN
YNormalizer = y1.x
IF ( objtype.x = 2 | objtype.x = 3 ) THEN DO
y2.x = ((page.x - 1) * pageHt) + y2.x
IF ( x2.x < XNormalizer ) THEN
XNormalizer = x2.x
IF ( y2.x < YNormalizer ) THEN
YNormalizer = y2.x
END
END
/* Now normalize the coordinates */
x = 0
DO WHILE ( x < i )
x = x + 1
x1.x = x1.x - XNormalizer
y1.x = y1.x - YNormalizer
IF ( objtype.x = 2 | objtype.x = 3 ) THEN DO
x2.x = x2.x - XNormalizer
y2.x = y2.x - YNormalizer
END
END
/* For each one of the graphic objects in our list */
/* create AREXX code to redraw the object. */
x = 0
DO WHILE ( x < i )
x = x + 1
SELECT
WHEN (objtype.x = 2 | objtype.x = 3) THEN DO
/* -------------- */
/* We have a Line */
/* -------------- */
modifier = ""
if ( objtype.x = 3 ) THEN
modifier = 'ARROW'
/* Output the commands to calculate line's position. */
commandLine = 'fromX =' x1.x '+ XPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'toX =' x2.x '+ XPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'fromY =' y1.x '+ YPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'toY =' y2.x '+ YPos'
CALL LineOut('GfxClipFile', commandline)
/* Output the commands to draw the line. */
commandLine = 'DrawLine page fromX fromY toX toY' modifier
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result')
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the line's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT
PARSE VAR Result tf fd lw
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw
CALL LineOut('GfxClipFile', commandLine)
/* The line color may contain spaces, so treat it separately. */
GetObjectParams Object.x LINECOLOR
commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
END
WHEN (objtype.x = 4 | objtype.x = 5) THEN DO
/* ------------- */
/* We have a Box */
/* ------------- */
modifier = ""
if (objtype.x = 5) THEN
modifier = 'BEVEL'
/* Output the command to draw the box. */
commandLine = 'newX =' x1.x '+ XPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'newY =' y1.x '+ YPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'DrawBox page newX newY' x2.x y2.x modifier
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the box's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
PARSE VAR Result tf fd lw fl
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
CALL LineOut('GfxClipFile', commandLine)
/* The line and fill colors may contain spaces, so treat them separately. */
GetObjectParams Object.x LINECOLOR
commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
GetObjectParams Object.x FILLCOLOR
commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
END
WHEN (objtype.x = 6 | objtype.x = 9) THEN DO
/* ------------------------- */
/* We have an Oval or an Arc */
/* ------------------------- */
modifier = ""
if (objtype.x = 9) THEN
modifier = 'ARC'
/* Output the command to draw the oval. */
commandLine = 'newX =' x1.x '+ XPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'newY =' y1.x '+ YPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'DrawOval page newX newY' x2.x y2.x modifier
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the oval's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST LINEWT FILL
PARSE VAR Result tf fd lw fl
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd 'LINEWT' lw 'FILL' fl
CALL LineOut('GfxClipFile', commandLine)
/* The line and fill colors may contain spaces, so treat them separately. */
GetObjectParams Object.x LINECOLOR
commandLine = 'SetObjectParams 0' 'LINECOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
GetObjectParams Object.x FILLCOLOR
commandLine = 'SetObjectParams 0' 'FILLCOLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
END
WHEN (objtype.x = 7) THEN DO
/* ------------------- */
/* We have a TextBlock */
/* ------------------- */
/* Output the command to draw the textblock. */
commandLine = 'newX =' x1.x '+ XPos'
CALL LineOut('GfxClipFile', commandline)
commandLine = 'newY =' y1.x '+ YPos'
CALL LineOut('GfxClipFile', commandline)
GetTextBlockText Object.x
text = Result
commandLine = 'DrawTextBlock page newX newY' '"' || text || '"'
CALL LineOut('GfxClipFile', commandLine)
CALL LineOut('GfxClipFile', 'objectid.numobjs = Result');
CALL LineOut('GfxClipFile', 'numobjs = numobjs + 1');
/* Output the commands to set the textblock's parameters. */
GetObjectParams Object.x TEXTFLOW FLOWDIST
PARSE VAR Result tf fd
commandLine = 'SetObjectParams 0' 'TEXTFLOW' tf 'FLOWDIST' fd
CALL LineOut('GfxClipFile', commandLine)
/* Output the commands to set the textblock's typespecs. */
GetObjectTypeSpecs Object.x SIZE LEADING WIDTH OBLIQUE
PARSE VAR Result sz ld wd ob
commandLine = 'SetObjectTypeSpecs 0' 'SIZE' sz 'LEADING' ld 'WIDTH' wd 'OBLIQUE' ob
CALL LineOut('GfxClipFile', commandLine)
/* The color and font may contain spaces, so treat them separately. */
GetObjectTypeSpecs Object.x COLOR
commandLine = 'SetObjectTypeSpecs 0' 'COLOR' "'" || '"' || Result || '"' || "'"
CALL LineOut('GfxClipFile', commandLine)
GetObjectTypeSpecs Object.x FONT
commandLine = 'SetObjectTypeSpecs 0' 'FONT' '"' || Result || '"'
CALL LineOut('GfxClipFile', commandLine)
END
OTHERWISE ITERATE /* Ignore images (objtype.x = 1), groups (objtype.x = 8),*/
/* draw class objects (objtype = 10) */
/* and anything else we don't recognize. */
END /* End select */
/* Output command to rotate the object if needed */
IF ( objRotate.x ~= 0 ) THEN DO
commandLine = 'SetObjectRotation 0' objRotate.x
CALL LineOut('GfxClipFile', commandLine)
END
/* Output the command to set the objects title. */
GetObjectTitle object.x
commandLine = 'SetObjectTitle 0' '"' || Result || '"'
CALL LineOut('GfxClipFile', commandLine)
/* Output a blank line */
CALL LineOut('GfxClipFile', '')
END /* End while */
/* Output commands to select all the new objects. */
CALL LineOut('GfxClipFile', 'i = 0')
CALL LineOut('GfxClipFile', 'DO WHILE (i < numobjs)')
CALL LineOut('GfxClipFile', 'SelectObject objectid.i MULTIPLE')
CALL LineOut('GfxClipFile', 'i = i + 1')
CALL LineOut('GfxClipFile', 'END')
CALL LineOut('GfxClipFile', '')
/* Output the command to redraw everything. */
CALL LineOut('GfxClipFile', 'Redraw')
CALL LineOUt('GfxClipFile', 'GraphicTool')
CALL LineOut('GfxClipFile', '')
/* Close the file */
CALL CLOSE('GfxClipFile');
/* Reselect all of our objects */
x = 0
DO WHILE ( x < i )
X = X + 1
SelectObject Object.x MULTIPLE
END
END /* End if */
ELSE DO
/* File could not be opened. */
firstLine = '"Cannot open file <' || filename || '>."'
ShowMessage 1 1 firstLine '"" "" "OK" "" ""'
EXIT
END
EXIT
/* ============================================ */
/* LineOut */
/* Procedure to write a line out to the file */
/* checking for errors and exiting if any found */
/* ============================================ */
LineOut: PROCEDURE
PARSE ARG filehandle, str
len = WRITELN( filehandle, str )
IF (len ~= LENGTH(str) + 1) THEN DO
ShowMessage 1 1 '"Error writing file!" "" "" "OK" "" ""'
CALL CLOSE(filehandle);
EXIT
END
RETURN