Amiga ISO Collection/AmigaUtilCD2.iso/MagicWB/TBICNS20.LHA/Tobi_Icons-2.0/ilbm2ascii.rexx

OS/2 REXX Batch file | 1994-06-15 | 4.9 KB | 181 lines

/*
 *  $VER: ILBM->ASCII.rexx (2.4.94)
 *
 *  Written by Tobias Ferber, [e-mail]
 */

ilbmfile  = ""
asciifile = ""
tempfile  = "T:ILBMASCII." || pragma('Id')
template  = "FROM/A,TO/K/A"
args      = ""

OPTIONS FAILAT 10

/* parse args */

IF ( ARG() < 1 ) | ( (ARG() = 1) & ARG(1)= '?' )  THEN DO
  OPTIONS PROMPT template': '
  PARSE PULL args
  END
ELSE DO n=1 FOR ARG() /* RXFB_TOKEN for RX ?! */
  args= args || ARG(n)
  END

DO WHILE WORDS(args) > 0
  av= next_arg()
  SELECT
    WHEN UPPER(av) = "FROM" THEN DO
      IF WORDS(args) > 0 THEN ilbmfile= next_arg()
      ELSE EXIT bad_args("Missing ILBM filename after FROM keyword")
      end /* FROM */

    WHEN UPPER(av) = "TO" THEN DO
      IF WORDS(args) > 0 THEN asciifile= next_arg()
      ELSE EXIT bad_args("Missing ASCII filename after FROM keyword")
      end /* TO */

    OTHERWISE DO
      IF av = '?' THEN EXIT bad_args("")
      ELSE ilbmfile= av
      END
    END
  END

CALL PRAGMA('W','N')


/* Try to get missing ILBM filename */

IF (WORDS(ilbmfile) < 1) & EXISTS('c:RequestFile') THEN DO
  cwd= PRAGMA('D')
  ADDRESS COMMAND 'RequestFile >' tempfile 'DRAWER "'cwd'" TITLE "Select an ILBM file..." NOICONS'
  IF OPEN('fp',tempfile,'R') THEN DO
    ilbmfile= STRIP(READLN('fp'),'B','"')
    CALL CLOSE('fp')
    ADDRESS COMMAND 'Delete QUIET FILE' tempfile
    END
  END

IF WORDS(ilbmfile) < 1 THEN EXIT bad_args("No ILBM input filename")

IF ~EXISTS(ilbmfile) THEN DO
  IF EXISTS('c:RequestChoice') THEN
      ADDRESS COMMAND 'RequestChoice >NIL:' 'TITLE   "ILBM->ASCII"',
                                            'BODY    "Failed to locate your ILBM file*n'ilbmfile'"',
                                        'GADGETS "Exit"'
  ELSE SAY 'Failed to locate your ILBM file "'ilbmfile'"'
  EXIT 10
  END


/* Try to get missing ASCII filename */

IF (WORDS(asciifile) < 1) & EXISTS('c:RequestFile') THEN DO
  cwd= PRAGMA('D')
  ADDRESS COMMAND 'RequestFile >' tempfile 'DRAWER "'cwd'" TITLE "Write ASCII output to..." SAVEMODE NOICONS'
  IF OPEN('fp',tempfile,'R') THEN DO
    asciifile= STRIP(READLN('fp'),'B','"')
    CALL CLOSE('fp')
    ADDRESS COMMAND 'Delete QUIET FILE' tempfile
    END
  END

IF WORDS(asciifile) < 1 THEN EXIT bad_args("No ASCII output filename")

IF EXISTS(asciifile) THEN DO
  IF EXISTS('c:RequestChoice') THEN DO
    ADDRESS COMMAND 'RequestChoice >' tempfile,
        'TITLE   "ILBM->ASCII"',
    'BODY    "'asciifile 'already exists.*nShall I replace it ?"',
    'GADGETS "YES" GADGETS "NO"'
    IF OPEN('fp',tempfile,'R') THEN DO
      yn= STRIP( READLN('fp') )
      CALL CLOSE('fp')
      ADDRESS COMMAND 'Delete QUIET FILE' tempfile
      END
    IF yn = '1' THEN ADDRESS COMMAND 'Delete QUIET FILE "'asciifile'"'
    END
  ELSE DO
    OPTIONS PROMPT asciifile 'already exists.  Shall I replace it ?  (Y/n) '
    PULL yn
    IF LEFT(yn) ~= 'N' THEN ADDRESS COMMAND 'Delete QUIET FILE "'asciifile'"'
    END
  END

IF EXISTS(asciifile) THEN DO
  IF EXISTS('c:RequestChoice') THEN
      ADDRESS COMMAND 'RequestChoice >NIL:' 'TITLE   "ILBM->ASCII"',
                                            'BODY    "Operation canceled"',
                                            'GADGETS "Exit"'
  ELSE SAY 'Operation canceled'
  EXIT
  END

ADDRESS COMMAND ilbm2ascii '"'ilbmfile'"' '>' '"'asciifile'"'

IF filesize(asciifile) = 0 THEN DO
  IF EXISTS('c:RequestChoice') THEN
      ADDRESS COMMAND 'RequestChoice >NIL:' 'TITLE   "ILBM->ASCII"',
                                            'BODY    "Failed to create' asciifile '*nfrom' ilbmfile '"',
                                            'GADGETS "Exit"'
  ELSE SAY 'Failed to create' asciifile 'from' ilbmfile
  END

EXIT

/*@*/

bad_args: PROCEDURE EXPOSE template
  PARSE ARG str
  IF WORDS(str) > 0 THEN DO
    IF EXISTS('c:RequestChoice') THEN
      ADDRESS COMMAND 'RequestChoice >NIL:' 'TITLE   "ILBM->ASCII"',
                                            'BODY'   transquote(str),
                                        'GADGETS "Exit"'
    ELSE SAY str
    END

  SAY "Template:" template
  SAY "Usage: rx ILBM2ASCII.rexx FROM <ilbm file> TO <ascii file>"
  RETURN 10


/* get the next command-line argument from global 'args' string */

next_arg: PROCEDURE EXPOSE args
  args= STRIP(args)
  IF LEFT(args,1) = '"' THEN PARSE VAR args '"' a '"' args
                        else parse var args     a     args
  RETURN STRIP(a,'b','"')


/* translate '"' into '*"' and '*' into '**' */

transquote: PROCEDURE
  PARSE ARG s
  t= s
  q= MAX( LASTPOS('*',s), LASTPOS('"',s) )
  DO WHILE q > 0
    t= INSERT('*',t,q-1,1)
    s= LEFT(s,q-1)
    q= MAX( LASTPOS('*',s), LASTPOS('"',s) )
    END
  RETURN '"' || t || '"'


/* return the size of a file or '-1' if rexxsupport.library was not available */

filesize: PROCEDURE
  PARSE ARG fname

  lib= SHOW('L',"rexxsupport.library")
  IF ~lib THEN lib= ADDLIB("rexxsupport.library",0,-30,0)

  IF lib THEN DO
    fsize= VALUE( WORD(STATEF(fname),2) )
    CALL REMLIB("rexxsupport.library")
    END
  ELSE fsize= -1
  RETURN fsize