DTP Toolbox/DTPToolbox.iso/utilities/propage_pdraw/donsgenies/adproscripts.lha/MassConversion.adpro

Text File | 1996-03-16 | 13.2 KB | 469 lines

/* Program to use ADPro to convert a whole directory of files, including subdirectories. If a file is an anim, the first frame is converted. Images can be scaled to a uniform size. If it jams up while trying to load in a binary file which it thinks (wrongly) is a Targa or PCX image, just click on Abort. */

/* Written by Don Cox, June 94. Debug Sept 94, Oct 94. Extensions, July 95. Black & White, Sept 95. Bug fix, Oct 95, March 96. Copyright, not Public Domain. */
/* $VER:MassConversion.adpro March 96 */


/*call open("STDERR","ram:traceMC","W")
trace r*/

options results
numeric digits 14

/* Screen type definitions - do not alter */
hires = 1
interlace = 2
pal = 4  /* NTSC if off */
hoverscan = 8
voverscan = 16
vga = 32
superhires = 64
super72 = 128
default = 256


/* ++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++++++ */

/* These presets can be edited by the user */

screentype = hires + interlace + pal
width = 640 /* default width & height for scaling or padding */
height = 512

/* +++++++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++ */

address "ADPro"
ADPRO_TO_FRONT

getdir '"Select source directory"'
if rc=10 then exit
directory = ADPro_Result
if upper(directory) = "RAM DISK:" then directory = "Ram:"

getdir '"Select directory for saving"'
if rc=10 then exit
sdirectory = ADPro_Result
if upper(sdirectory) = "RAM DISK:" then sdirectory = "Ram:"
if right(sdirectory,1) ~=":" then sdirectory = sdirectory||"/"

doexecute = 0 /* defaults */
rvalue = 16
dogray = 0
BlackWhite = 0

OKAYN '"Select format"' '"Convert images to ..."' '"GIF|TIFF|PCX|JPEG|IFF|Abort"'
retc = rc /* queries within the select can change rc */

select
    when retc = 0 then exit

    when retc = 1 then do
        Format = "GIF"
        rvalue = 256
        doexecute = 1
        saveline = IMAGE
        end

    when retc = 2 then do
        Format = "TIFF"
        saveline = RAW
        end

    when retc = 3 then do
        Format = "PCX"
        savetype = IMAGE
        OKAYN '"Select format"' '"Image type ..."' '24-bit|Grayscale|2-color|16-color|256color|Abort"'
        if rc = 0 then exit
        if rc = 1 then savetype = RAW
        if rc = 2 then do
            IMAGE_TYPE
            imagetype = ADPRO_RESULT
            if pos("COLOR",imagetype) ~=0 then dogray = 1
            savetype = "RAW"
            end
        if rc >2 then do
            doexecute = 1
            savetype = "IMAGE"
            end
        if rc = 3 then rvalue = 2
        if rc = 4 then rvalue = 16
        if rc = 5 then rvalue = 256 /* you can edit these options if you want something else */
        saveline = savetype||" "||VGA
        end

    when retc = 4 then do
        Format = "JPEG"
        savetype = "RAW"
        getnumber '"Set quality level"' 800 1 1000
        if rc= 10 then exit
        quality = ADPRO_RESULT
        saveline = RAW||" "||"QUALITY"||" "quality
        end

    when retc = 5 then do
        Format = "IFF"
        savetype = "IMAGE"
        OKAYN '"Select format"' '"Image type ..."' '24-bit|Grayscale|2-color|16-color|256color|Abort"'
        if rc = 0 then exit
        if rc = 1 then saveline = "RAW"
        if rc = 2 then do
            IMAGE_TYPE
            imagetype = ADPRO_RESULT
            if pos("COLOR",imagetype) ~=0 then dogray = 1
            saveline = RAW
            end
        if rc >2 then do
            doexecute = 1
            saveline = IMAGE
            end
        if rc = 3 then do
            rvalue = 2
            okayn '"Black & White"' '"Make the colours Black & White?"' '"No Change|Black & White|White & Black|Abort"'
            if rc = 0 then exit
            BlackWhite = rc
            end
        if rc = 4 then rvalue = 16
        if rc = 5 then rvalue = 256 /* you can edit these options if you want something else */
        end
    otherwise exit
    end

newextension = ""
extnprompt = "."||Format
if extnprompt = ".IFF" then extnprompt = ".IFF"||rvalue
getstring '"New filename extension"' extnprompt
if rc=0 then newextension = ADPro_Result

okayn '"Resizing"' '"Resize the frames?"' '"No Change|Resize|Pad|Resize+Pad|Abort"'
if rc = 0 then exit
resize = rc
paddit = 0
scaleit = 0

if (resize=2|resize=4) then do
    scaleit = 1
    getnumber '"New image width (pixels)"' width 16 1600
    if rc~=0 then do
        okay1 "User aborted program"
        exit
        end
    scaledwidth = ADPro_result

    getnumber '"New image height (pixels)"' height 16 1024
    if rc~=0 then do
        okay1 "User aborted program"
        exit
        end
    scaledheight = ADPro_result
    end


if (resize=3|resize=4) then do
    paddit = 1
    getnumber '"Background width (pixels)"' width 16 1600
    if rc~=0 then do
        okay1 "User aborted program"
        exit
        end
    backwidth = ADPro_result

    getnumber '"Background height (pixels)"' height 16 1024
    if rc~=0 then do
        okay1 "User aborted program"
        exit
        end
    backheight = ADPro_result


    getdir '"Select directory for temporary files"' '"ram:"'
    if rc=10 then exit
    tdirectory = ADPro_Result
    if right(tdirectory,1) ~=":" then tdirectory = tdirectory||"/"

    end


okayn '" "' '"Maximize Dynamic Range?"' '"Yes|No"'
dyrange = rc

lformat "UNIVERSAL"
sformat Format
pstatus "UNLOCKED"
load_type "REPLACE"

lockit = 0
if (doexecute = 1 & BlackWhite<2) then do
    okayn '" "' '"Use first image palette for all images?"' '"Yes|No"'
    lockit = rc
    end

if lockit = 1 then do
    okayn '" "' '"First image palette"' '"Computed|Current|Load|Abort"'
    if rc = 0 then exit
    if rc = 2 then PSTATUS "LOCKED"
    if rc = 3 then do
        PLOAD
        PSTATUS "LOCKED"
        end
    end


/* Convert files in one directory and its descendents */


address command
'list >ram:dirlist "'directory'" dirs all LFORMAT="%P%S"'
call open("dirinput","ram:dirlist","r")

/* First convert pics in root diectory */
'delete ram:filelist1'
'delete ram:filelist'
'list >ram:filelist1 "'directory'" files LFORMAT="%P%S"'
call open(input,"ram:filelist1","r") /* test in case it's empty */
listtest = readln(input)
call close input

if listtest~="" then do
    'sort from ram:filelist1 to ram:filelist'
    address "ADPro"
    call dirconvert
    end


/* Now do all the subdirectories */
do d = 1 to 700
    dirname = readln("dirinput")
    if dirname = "" then break
    address command
    'delete ram:filelist1'
    'delete ram:filelist'
    'list >ram:filelist1 'dirname' files LFORMAT="%P%S"'
    call open(input,"ram:filelist1","r") /* test in case it's empty */
    listtest = readln(input)
    call close input

    if listtest~="" then do
        'sort from ram:filelist1 to ram:filelist'
        address "ADPro"
        call dirconvert
        end
    end

address "ADPro"
ADPRO_TO_FRONT
OKAY1 "Finished..."
exit
end

/* ++++++++++++++++++++++++++++ ++++++++++++++++++++++++++++++++ */


getpath:
parse arg allname
pos1 = lastpos("/",allname)
if pos1 = 0 then pos1 = lastpos(":",allname)
filepath = left(allname,pos1)
return filepath

getname:
parse arg allname
pos1 = lastpos("/",allname)
if pos1 = 0 then pos1 = lastpos(":",allname)
justname = substr(allname,pos1+1)
return justname

/* +++++++++++++++++++++++++++++ +++++++++++++++++++++++++++++++ */


/* Convert all the pics in a directory */
dirconvert:
address "ADPro"

call open(input,"ram:filelist","r")
do i = 1 to 7000   /* safety limit of 7000 files  */
    filename = readln(input)
    if filename = "" then break

    slashpos = lastpos("/",filename)
    dotpos = lastpos(".",filename)
    if dotpos<slashpos then dotpos = 0 /* not dots in directory names */
    if dotpos~=0 then extension = upper(substr(filename,dotpos))
    else extension = ""

    if extension = ".INFO" then iterate
    if extension = ".PSFONT" then iterate
    if extension = ".FONT" then iterate
    if extension = ".PDFONT" then iterate
    if extension = ".PFB" then iterate
    if extension = ".AFM" then iterate
    if extension = ".METRIC" then iterate
    if extension = ".LIB" then iterate
    if extension = ".DEM" then iterate
    if extension = ".DOC" then iterate
    if extension = ".ZIP" then iterate
    if extension = ".LHA" then iterate
    if extension = ".ARC" then iterate
    if extension = ".ME" then iterate
    if extension = ".DAT" then iterate
    if extension = ".TF" then iterate
    if extension = ".DB" then iterate
    if extension = ".C" then iterate
    if extension = ".H" then iterate
    if extension = ".GF" then iterate
    if extension = ".PPRX" then iterate
    if extension = ".PDRX" then iterate
    if extension = ".REXX" then iterate
    if extension = ".ADPRO" then iterate
    if word(filename,2) = "files" then iterate /* This line not a file name */
    if word(filename,1) = "TOTAL:" then break  /* or this one */

    load_type "REPLACE"
    lformat "UNIVERSAL"

    call open("picinput",filename,"R")
    chunks = readch("picinput",1000)
    call close("picinput")

    if substr(chunks,9,4) = "ANIM" then do
        lformat "ANIM"
        load '"'filename'"' FRAME 1
        end
    else load '"'filename'"' /* Quotes allow file names with spaces */
    if rc ~=0 then iterate /* if load fails, try the next one */

    pos1 = lastpos("/",filename)
    if pos1 = 0 then pos1 = lastpos(":",filename)

    imagetype = 24bit /* if in doubt */
    IMAGE_TYPE
    itype = ADPRO_RESULT
    if left(itype,8)="BITPLANE" then imagetype = bitplane
    else if left(itype,5) = "COLOR" then imagetype = 24bit
    else if left(itype,4) = "GRAY" then imagetype = gray

    if imagetype = bitplane then iterate /* can't scale if no 24-bit or 8-bit data  - i.e. picture too big for memory */

/* Get size of loaded image, before scaling */
xsize
inputwidth = ADPro_result
ysize
inputheight = ADPro_result


if scaleit = 1 then do

    /* Adjusting proportions */
        CONTRAST "-1" /* Prevents ADPro's scaling artefacts, seen on 0 or 255 colours */
        OPERATOR "APPLY_MAP"
        prop = 1 /* for starters */

    /* If it's an IFF file, the CAMG chunk should tell us its proportions */
        CAMG = "null" /* just a dummy string */
        binCAMG = "null"
        filetype = left(chunks,4)
        if filetype = "FORM" then do
            CAMG = substr(chunks,pos("CAMG",chunks)+10,2)
            if pos("CAMG",chunks)=0 then break
            binCAMG = c2b(CAMG)
            binCAMG = overlay("000000000000",binCAMG,2) /* don't want these bits */

            picformat = "null"
    /* These comparisons only just work, with numeric digits at 14, as the last 2 digits don't matter */
            select
                when binCAMG = "0000000000000000" then do
                    picformat = "lores"
                    prop=1
                    end
                when binCAMG = "1000000000000000" then do
                    picformat = "medres"
                    prop=0.5
                    end
                when binCAMG = "0000000000000100" then do
                    picformat = "interlace"
                    prop=2
                    end
                when binCAMG = "1000000000000100" then do
                    picformat = "hires"
                    prop=1
                    end
                otherwise do
                    picformat = "unknown"
                    prop=1
                    end
                end

            end


        imageheight = scaledheight
        scalewidth.tn = scaledwidth
        proportion = (inputheight)/(inputwidth*prop)
        scaleheight.tn = trunc(scalewidth.tn * proportion ) /* keep proportions */
        if scaleheight.tn >imageheight then do  /* vertical pics */
            proportion = inputwidth*prop/inputheight
            scalewidth.tn = trunc(imageheight* proportion )
            scaleheight.tn = imageheight
            end
        ABS_SCALE scalewidth.tn scaleheight.tn
        end   /* of scaling */

    if scaleit = 0 then do
        scalewidth.tn = inputwidth
        scaleheight.tn = inputheight
        end

    if dyrange = 1 then OPERATOR "DYNAMIC_RANGE" 0 255

    if paddit = 1 then do
        savename = tdirectory||"tpic"
        sformat "IFF"
        SAVE savename "RAW"
        sformat Format
        lformat "BACKDROP"
        LOAD "XXX" backwidth backheight "COLOR"
        lformat "IFF"
        LOAD_TYPE "COMPOSE"
        loadname = tdirectory||"tpic"

        offsetX = (backwidth-scalewidth.tn)%2 /* integer division - no half pixels */
        offsetY = (backheight-scaleheight.tn)%2

        LOAD loadname offsetX offsetY
        lformat "UNIVERSAL"
        LOAD_TYPE "REPLACE"
        end

        if dogray = 1 then OPERATOR "COLOR_TO_GRAY"

        if doexecute = 1 then do
            render_type rvalue
            execute
            if BlackWhite>1 then do
                ppoke 0 0 0 0
                ppoke 1 255 255 255
                end
            end
        if lockit ~= 0 then pstatus "LOCKED"

        justname = getname(filename)
        justname2 = justname
        dotpos2 = lastpos(".",justname)
        if dotpos2~=0 then do
            justname2 = left(justname,dotpos2-1)
            extension2 = substr(filename,dotpos+1)
            if datatype(extension2, n) then justname2 = justname /* don't chop off frame numbers */
            end
        filename2 = sdirectory||justname2||newextension
        SAVER Format '"'filename2'"' saveline
        why = ""
        if rc~=0 then why = ADPRO_RESULT

    end    /* end of directory */

call close(input)

ADPRO_UNDISPLAY


return