Corrected Adpro CDXL Maker

[digita...@delphi.com]

/*
** Pic2CDXL
*/

ADDRESS "ADPro"
OPTIONS RESULTS

NL = '0A'X
SQ = '27'X
DQ = '22'X
TRUE = 1
FALSE = 0
TempDefaults = "T:TempADProDefaults"

/*
** Save the current environment.
*/

SAVE_DEFAULTS TempDefaults

PSTATUS "LOCKED"

/*
** Select the file to scale.
*/

CALL "FREDSCRIPTS:FREDFunctions/GetAFile" '"Enter FILE To Convert"' '"ADPRO:"' '""""' TRUE
IF (RESULT = DQ||DQ) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error, no source FILE specified."
CALL ErrorOut 10
END
SrcANIMFName = RESULT
d = LENGTH(SrcANIMFName)
SrcANIMFName = LEFT(SrcANIMFName,d-3)

CALL "FREDSCRIPTS:FREDFunctions/GetAFile" '"Enter name of CDXL file to create"' '"ADPRO:"' '""""' TRUE
IF (RESULT = DQ||DQ) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error, no dest CDXL specified."
CALL ErrorOut 10
END
DestANIMFName = RESULT

IF (EXISTS( DestANIMFName )) THEN DO
ADPRO_TO_FRONT

OKAYN '"CropANIM"' '"Truncate destination CDXL?"' '"Start New File|Append To File|Cancel"'
IF (RC = 0) THEN DO
CALL ErrorOut 10
END
ELSE IF (RC = 1) THEN DO
IMAGE_TYPE
ImageType = ADPRO_RESULT
IF (WORD( ImageType, 1 ) = "NONE") THEN DO
LOADER "BACKDROP" "XXX" "WIDTH" 10 "HEIGHT" 10 "COLOR"
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Unable to create temp image." || NL ||,
"Argument Information:" || NL||,
"Width = " || 10 || NL ||,
"Height = " || 10 || NL ||,
"Type = " || "COLOR"
CALL ErrorOut 10
END
END

IF (WORD( ImageType, 1 ) ~= "BITPLANE") THEN DO
EXECUTE
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Unable to create temp rendered data."
CALL ErrorOut 10
END
END

SAVER "CDXL" DestANIMFName "IMAGE" "QUIT"
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Could not close current ANIM file." || NL ||,
"Argument Information:" || NL ||,
"Filename = " || DestANIMFName || NL ||,
"Type = " || "IMAGE" || NL ||,
"Flags = " || "QUIT"
CALL ErrorOut 10
END

ADDRESS COMMAND "Delete >NIL:" DestANIMFName
END
END

/*
** Ask which frames to process.
*/

StartFrame = 1

EndFrame = 999

ADPRO_TO_FRONT

GET_SCREEN_MODE '"Select Render Screen"' "Amiga" "XXX" 0 0 16
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Could not select render screen."
SCREEN_TO_FRONT "FRED"
CALL ErrorOut 10
END

RenderScreen = ADPRO_RESULT

XSIZE
ImageWidth = ADPRO_RESULT

YSIZE
ImageHeight = ADPRO_RESULT

CALL "FREDSCRIPTS:FREDFunctions/FileOnly" SrcANIMFName
srcANIMNodeName = RESULT

str = "PICTURE:" srcANIMNodeName || NL || "(" || ImageWidth "x" ImageHeight || ")"

ADPRO_TO_FRONT

SCREEN_TYPE
oldSType = ADPRO_RESULT
SCREEN_TYPE ADPRO_RESULT

xRes = 176

yRes = 128

num = StartFrame
continue = FALSE

SET_RENDER_MODE RenderScreen
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Could not set render screen:" || NL || RenderScreen
SCREEN_TO_FRONT "FRED"
CALL ErrorOut 10
END

DO WHILE (continue = FALSE)

IF (num < 100) THEN DO
go = '0'||num
END

IF (num < 10) THEN DO
go = '00'||num
END

IF (num > 99) THEN DO
go = num
END

SAY go
SAY num

LOADER "UNIVERSAL" SrcANIMFName||go
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error during load" || NL ||,
"of frame " || num || "."
CALL ErrorOut 10
END

ABS_SCALE xRes yRes

IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error scaling image data" || NL ||,
"to" xRes "x" yRes
CALL ErrorOut 10
END

EXECUTE
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error creating rendered data."
CALL ErrorOut 10
END

IF (num == 1) THEN DO
PSTATUS "LOCKED"
END

SAVER "CDXL" DestANIMFName "FRAMENUM" num "IMAGE"
IF (RC ~= 0) THEN DO
END

num = num + 1
IF (num > EndFrame) THEN
continue = TRUE
END

SAVER "CDXL" dest "QUIT" "IMAGE"
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error closing dest anim."
CALL ErrorOut 10
END

CALL ErrorOut 0

ErrorOut:
PARSE ARG ExitCode

IF (EXISTS( SrcANIMFName )) & (ErrorCode ~= 0) THEN DO
LOADER "ANIM" SrcANIMFName "QUIT"
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error closing source ANIM:" || NL ||,
SrcANIMFName || NL || NL ||,
"You need to close it" || NL ||,
"manually."
END
END

IF (EXISTS( DestANIMFName )) & (ErrorCode ~= 0) THEN DO
SAVER "CDXL" DestANIMFName "IMAGE" "QUIT"
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error closing dest ANIM:" || NL ||,
DestANIMFName || NL || NL ||,
"You need to close it" || NL ||,
"manually."
END
END

IF (EXISTS( TempDefaults )) THEN DO
LOAD_DEFAULTS TempDefaults
IF (RC ~= 0) THEN DO
ADPRO_TO_FRONT
OKAY1 "Error restoring settings."
END

ADDRESS COMMAND "Delete >NIL:" TempDefaults
END

EXIT ExitCode