home *** CD-ROM | disk | FTP | other *** search
- /*
- ** _SCULPTWithDimen
- **
- ** $VER: _SCULPTWithDimen 1.0.0 (4.11.93)
- **
- ** This program can be run from ADPro's savers list to store the current
- ** image data in SCULPT format, but it will also include the size of the
- ** image within the filename. This is so that you know exactly what to
- ** enter for width and height in the SCULPT loader's control panel.
- **
- ** Also, the filename extensions that will be used are ".red"/".grn"/".blu"
- ** for color image data, and ".gry" of grayscale image data.
- **
- ** This script required ADPro v2.5.0 (or higher).
- **
- ** Copyright © 1993 ASDG, Incorporated
- ** All Rights Reserved
- */
-
-
- 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
-
-
- /*
- ** See what type of data is loaded in ADPro/MorphPlus.
- */
-
- CALL "FREDSCRIPTS:FREDFunctions/CheckForRawImageData" TRUE
- IF (RESULT ~= 0) THEN
- CALL ErrorOut 10
-
- IMAGE_TYPE
- ImageType = WORD( ADPRO_RESULT, 1 )
- IF (ImageType = "COLOR") THEN
- FNameExt = ".red"
- ELSE IF (ImageType = "GRAY") THEN
- FNameExt = ".gry"
- ELSE
- FNameExt = ".sculpt"
-
-
- /*
- ** Ask for the basename to give the SCULPT file. We will add the dimension
- ** and proper filename extension.
- */
-
- CALL "FREDSCRIPTS:FREDFunctions/GetAFile" '"Select SCULPT Base Name"' '""""' '""""' TRUE
- BaseName = RESULT
- IF (BaseName = DQ||DQ) THEN
- CALL ErrorOut 10
-
- XSIZE
- ImageWidth = ADPRO_RESULT
-
- YSIZE
- ImageHeight = ADPRO_RESULT
-
- FName = BaseName || "_" || ImageWidth || "x" || ImageHeight || FNameExt
-
- SAVER "SCULPT" FName "RAW"
- IF (RC ~= 0) THEN DO
- ADPRO_TO_FRONT
- OKAY1 "Error saving SCULPT file:" || NL ||,
- FName
- CALL ErrorOut 10
- END
-
- CALL ErrorOut 0
-
-
- ErrorOut:
- PARSE ARG ExitCode
-
- 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
-