/* Paste_Spread.rexx  */

/* Pastes a pre-saved color spread to the FACE top & bottom colors, */
/* or to the BORDER top & bottom colors. */
/* Before invoking 'Paste_Spread', select text, boxes, etc. to paste to. */
/* Use 'Copy_Spread.rexx' to save spreads to the 'ColorSpreads' directory. */
/* A default spread file called 'PasteSpread' can be */
/* used for quick copying and pasting of color spreads. */
/* Note: At this time, it is not possible to detect the selection status of */
/* single characters in a line.  If you need to paste a spread to individual */
/* characters, a provision has been made in 'Paste_Spread' to accomplish */
/* this, however, you must select characters from a single line only. */

/* Requires Toaster_CG v4.03 */
/* By Ross Fenmore © 1995 Light Source Video & Graphics */

SIGNAL ON ERROR
SIGNAL ON SYNTAX

CALL addlib(CG_AREXX,0)

pastedir='Toaster:Arexx/CG/ColorSpreads'
version='CopySpread v1.0'

CALL req_bar("Paste a Color Spread...")

testdir=pragma('D',pastedir)
IF testdir="" THEN DO
	CALL req_tell(pastedir,"Directory not found")
	CALL OUTAHERE
END

defaultfile="PasteSpread"
pastefile=req_file("Enter Name for Color Spread",defaultfile,pastedir)
IF pastefile="" THEN DO
	CALL OUTAHERE
END


path=FilenameExtract('"'pastefile'"','P')
file=FilenameExtract('"'pastefile'"','F')

IF file="" THEN DO
	CALL req_tell("You must enter a filename")
	CALL OUTAHERE
END

IF ~(exists(pastefile)) THEN SIGNAL PASTENOT
IF (~open(infile, pastefile, 'R')) THEN SIGNAL PASTENOT
IF (readln(infile) ~= version) THEN SIGNAL PASTENOT
topcolor=readln(infile)
botcolor=readln(infile)
olditem=readln(infile)
CALL CLOSE infile

ok1=checkcolor(topcolor)
ok2=checkcolor(botcolor)
IF ~(ok1) | ~(ok2) THEN DO
	CALL req_tell("Error: Invalid color information in pastefile")
	CALL remlib(CG_AREXX)
	EXIT
 END

CALL req_bar("Paste "||file||" to...")

RestoreCursorString=RememberCursor()

SL_Total=DetermineSelected()

item=req_string("1- Face    2- Border    0- Cancel",olditem)
IF item="" THEN item=olditem

IF ~datatype(item,'N') THEN DO
	CALL req_tell("You must enter a number for color spread destination.")
	CALL OUTAHERE
END

IF (SL_Total<2) THEN DO
	CALL SetNewColor(item)
	CALL OUTAHERE
END

CALL pickpage(not)

total_lines=get_page(size)
current_line=1
DO WHILE current_line <= total_lines
   CALL set_line(current_line)
	IF line.current_line THEN DO
		CALL pickline()
		CALL GetAttribs()
		CALL SetAttribs()
		CALL SetNewColor(item)
		CALL pickline(not)
	END

   current_line=current_line+1
END

current_line=1
DO WHILE current_line <= total_lines
   CALL set_line(current_line)
	IF line.current_line THEN DO
		CALL pickline()
	END
   current_line=current_line+1
END

CALL OUTAHERE

EXIT

/* Check an rgba color */
/* RETURN 0 if invalid color found */

CheckColor:
PARSE arg color
PARSE var color r "," g "," b "," a
IF (~datatype(r,'N'))|(r<0)|(r>255) THEN RETURN 0
IF (~datatype(g,'N'))|(r<0)|(r>255) THEN RETURN 0
IF (~datatype(b,'N'))|(r<0)|(r>255) THEN RETURN 0
IF (~datatype(a,'N'))|(r<0)|(r>255) THEN RETURN 0
RETURN 1

/* Remember cursor position */
/* Returns space separated argument string to be PARSEd. */

/* RETURN: "text" = text on original line retrieved from get_line() */
/*        charnum = original cursor position from get_char(spot)    */
/*        x and y = original line coordinates from get_line(spot)   */
/*         noline = If cursor was on a new blank line (0 if not)    */
/* Note: text is surrounded by quotes in string */

RememberCursor:

charnum=get_char(spot)
coords=get_line(spot)
PARSE var coords x y
text=get_line()

noline=0
type=get_line(type)
IF (type='Text')&(text="") THEN noline=1

RETURN '"'text'"'||" "||charnum||" "||strip(x)||" "||strip(y)||" "||noline

/* Restore cursor position */
/* ARGS: text = text on original line retrieved from get_line() */
/*    charnum = original cursor position from get_char(spot)    */
/*    x and y = original line coordinates from get_line(spot)   */
/*     noline = If cursor was on a new blank line (0 if not)    */

RestoreCursor: PROCEDURE

PARSE arg '"'text'"' charnum x y noline .
coords=x||" "||y

total_lines=get_page(size)

IF noline=0 THEN DO

	current_line=1
	cx=0; cy=0

	DO WHILE current_line <= total_lines
   	CALL set_line(current_line)

		comparetext=get_line()
		IF comparetext=text THEN DO
	   	comparecoords=GET_LINE(SPOT)
			PARSE var comparecoords cx cy
		END

		IF (cx=x)&(cy=y) THEN LEAVE

	   current_line=current_line+1

	END

call set_char(spot,charnum+1)
END

IF noline=1 THEN DO
	CALL set_line(FIRST)
	testcoords=get_line(SPOT)
	PARSE var testcoords testx testy
	testh=get_line(TALL)

	IF (testy+testh)<390 THEN DO
		CALL makeline()
		CALL set_line(spot,x,y)
		CALL makechar(".")
		CALL set_char(spot,1)
		CALL killchar()
	END
END

RETURN

/* Determine which lines on page are selected */
/* line. array will hold values of 1 for lines selected */
/* RETURN: # of lines selected */
/* Example: If line.3 = 1 then line#3 is selected. (0 if not) */

DetermineSelected: PROCEDURE EXPOSE line.

line. = 0
current_line=1
total_lines=get_page(size)
SelectTotal=0

DO WHILE current_line <= total_lines
   CALL set_line(current_line)
	selected=get_char(STAT)
	IF selected THEN SelectTotal = SelectTotal+1
	line.current_line = selected
   current_line=current_line+1
END

RETURN SelectTotal

SetNewColor:
PARSE arg item

	SELECT
		WHEN item=1 THEN DO
			CALL set_char(FILL,1)
			command="CALL set_char(TOPR,"||topcolor||")"
			INTERPRET command
			command="CALL set_char(BOTR,"||botcolor||")"
			INTERPRET command
		END

		WHEN item=2 THEN DO
			CALL set_bord(FILL,1)
			command="CALL set_bord(TOPR,"||topcolor||")"
			INTERPRET command
			command="CALL set_bord(BOTR,"||botcolor||")"
			INTERPRET command
		END

		WHEN item=0 THEN DO
			CALL req_tell("Paste Spread Cancelled")
		CALL OUTAHERE
		END

		OTHERWISE DO
			CALL req_tell("You must enter 1 or 2")
			CALL OUTAHERE
		END
	END

RETURN


/* Copy face, border, and shadow attributes to a temp file */
/* Use SetAttribs.rexx subroutine to retrieve and set attributes */
/* for currently selected items */

GetAttribs: PROCEDURE

outfile="RAM:PasteAttribs.Rexx"

stype=0

IF (~open(outfd,outfile,'W')) THEN DO
	CALL REQ_TELL("Can't open output:",outfile)
	CALL remlib(CG_AREXX)
	EXIT
END

   bb=translate(get_bord(BOTR),","," ")
   ft=translate(get_char(TOPR),","," ")
   fb=translate(get_char(BOTR),","," ")
   sh=translate(get_shad(TOPR),","," ")
   bt=translate(get_bord(TOPR),","," ")
   bp=get_bord(PRIO)
   IF get_shad('type')="None" then stype=0
   IF get_shad('type')="Cast" then stype=2
   IF get_shad('type')="Drop" then stype=1

   CALL writeln outfd, "CALL SET_CHAR(TOPR,"||ft||")"
   CALL writeln outfd, "CALL SET_CHAR(BOTR,"||fb||")"
   CALL writeln outfd, "CALL SET_CHAR(FILL,'"||get_char(fill)||"')"
   CALL writeln outfd, "CALL SET_BORD(TOPR,"||bt||")"
   CALL writeln outfd, "CALL SET_BORD(BOTR,"||bb||")"
   CALL writeln outfd, "CALL SET_BORD(SIZE,"||left(get_bord(SIZE),1)||")"
   CALL writeln outfd, "CALL SET_BORD(FILL,'"||get_bord(fill)||"')"
   CALL writeln outfd, "CALL SET_BORD(PRIO,"||bp||")"
   CALL writeln outfd, "CALL SET_SHAD(TOPR,"||sh||")"
   CALL writeln outfd, "CALL SET_SHAD(TYPE,"||stype||")"
   CALL writeln outfd, "CALL SET_SHAD(SPOT,"||get_shad(SPOT)||")"
   CALL writeln outfd, "CALL SET_SHAD(SIZE,"||get_shad(SIZE)||")"

   CALL close(outfd)


RETURN

/* Subroutine for retrieving and setting the attributes of currently */
/* selected items from temp file created by 'GetAttribs.rexx' subroutine */

SetAttribs: PROCEDURE

infile="RAM:PasteAttribs.Rexx"

stype=0

IF (~open(infd,infile,'R')) THEN DO
	CALL REQ_TELL("Can't open input:",infile)
	CALL remlib(CG_AREXX)
	EXIT
END

DO i=1 to 12
	command=readln(infd)
	IF command=0 THEN LEAVE
	INTERPRET command
END

call close(infd)

RETURN

/* Return the path or filename portion of a full path filename */
/* ARGS: '"'fullfilename'"' (surrounded by quotes) */
/*       key = 'F' for file; 'P' for path */

FilenameExtract: PROCEDURE

PARSE arg '"'fullname'"',key .
 
if lastpos('/',fullname,length(fullname)-1)~=0 then do
   filename=right(fullname,(length(fullname)-lastpos('/',fullname,length(fullname)-1)))
   path=left(fullname,(lastpos('/',fullname,length(fullname))-1))
   end
else do
   filename=right(fullname,(length(fullname)-lastpos(':',fullname,length(fullname)-1)))
   path=left(fullname,(lastpos(':',fullname,length(fullname))))
   end

IF upper(left(key,1)) = 'F' THEN RETURN filename
IF upper(left(key,1)) = 'P' THEN RETURN path

RETURN ""


PASTENOT:
CALL req_tell("PasteSpread file error","Create spread with CopySpread v1.0")
CALL req_bar("Toaster CG")
CALL remlib(CG_AREXX)

EXIT

OUTAHERE:
CALL RestoreCursor(RestoreCursorString)
CALL req_bar("Toaster CG")
CALL remlib(CG_AREXX)
EXIT


ERROR:
SYNTAX:
errorcode = rc
line=SIGL
text='"'errortext(errorcode)'"'
call req_tell("ERROR= "||errorcode,"On line# "||line,text)
exit