/*************************************************************************
 **                                                                     **
 ** Import XLife into VideoEasel... ARexx Script using VideoEasel-Port  **
 ** Version 2.00 - 05 Nov 1996   © THOR-Software                        **
 **                                                                     **
 *************************************************************************/

'LOCKGUI'
'REQUESTFILE' 'XLife/' '"XLife Source"' 'FALSE' 'source'
if source~='' then; do
  success=ImportXLife(source)
end; else
   success=1

'UNLOCKGUI'

if success then
      exit 0
else  exit 20

/*************************************************
 **     PlotPixel: Set point at (x,y)           **
 **     Check range                             **
 *************************************************/
PlotPixel:     Procedure
   parse arg x,y
   'INSIDE' x y 'in'
   if in='TRUE' then
      'CLICK' x y 'LEFT'
   else; do
      Call PostError("The brush is too big !")
      return 0
   end
return 1

/*************************************************
 ** PostError(failstring)                       **
 ** Display a requester                         **
 *************************************************/
PostError:     Procedure
   parse arg failstring
   'REQUESTFAULT' '"' || failstring || '"'
return

/*************************************************
 ** ReadLine                                    **
 ** read a line from the given file             **
 *************************************************/
ReadLine:      Procedure
   parse arg file
   do until (line~='' & left(line,2)~='#O' & left(line,2)~='#C' & left(line,2)~='#N') | eof(file)
      line=readln(file)
      line=space(line,1)
   end
   if eof(file) then
      line='#^'         /* generate EOF condition */
return line

/*************************************************
 ** ParseInclude                                **
 ** parse a include command                     **
 *************************************************/
ParseInclude:   Procedure       expose x_min y_min x_max y_max pass xoffset yoffset filecount
        parse arg line myname

        line=substr(line,3)

        name=word(line,1)
        xo=word(line,2)
        yo=word(line,3)         /* Get offsets, if present */
        rot=word(line,4)        /* Get rotation */
        flip=word(line,5)       /* Get flip */
        del=word(line,6)        /* Get delay */


        if xoffset='' then
                xo=0

        if yoffset='' then
                yo=0

        if (~datatype(xo,'W') | ~datatype(yo,'W')) then; do
                Call PostError('Found invalid offsets in include.')
                return '#!';
        end;

        if rot='' then
                rot=0

        if flip='' then
                flip=0

        if del='' then
                del=0

        if (~datatype(rot,'W') | ~datatype(flip,'W') | ~datatype(del,'W')) then; do
                Call PostError('Found invalid parameters in include.')
                return '#!';
        end;

        ppos=pos(':',name)
        if ppos=0 then
                pattern=''
        else; do
                pattern=substr(name,ppos+1)
                if ppos>0 then
                        name=left(name,ppos-1)
                else    name=myname
        end

        if ParseFile(name,pass,xo+xoffset,yo+yoffset) then
                return '#C'

return '#!'

/*************************************************
 ** ParseRunLengthLine                          **
 ** parse lines of a RLE pattern                **
 *************************************************/
ParseRunLengthLine:  Procedure      expose x_min y_min x_max y_max pass
        parse arg file,line,xoffset,yoffset

        ypos=yoffset
        if ypos<y_min then
                y_min=ypos
        xpos=xoffset
        if xpos<x_min then
                x_min=xpos
        rc=1                            /* number of repeats */

        do while left(line,1)~='#'      /* until new command */
                line=compress(line)     /* remove all spaces */
                do i=1 to length(line)
                        mc=substr(line,i)
                        vd=verify(mc,'0123456789')
                        if vd~=1 then; do
                                if vd=0 then
                                        rc=mc
                                else    rc=left(mc,vd-1)
                                i=i+length(rc)-1
                        end; else; do
                                mc=left(mc,1)
                                if mc='!' then; do
                                        if ypos>y_max then
                                                y_max=ypos

                                        return '#C'     /* return comment line, flush this line */
                                end
                                if mc='$' then; do
                                        if ypos>y_max then
                                                y_max=ypos

                                        xpos=xoffset    /* next line */
                                        ypos=ypos+rc
                                        rc=1
                                end; else; do
                                        if pass=0 then; do
                                                xpos=xpos+rc-1
                                                if xpos>x_max then
                                                        x_max=xpos

                                                xpos=xpos+1
                                        end; else; do
                                                if mc='b' then
                                                        xpos=xpos+rc
                                                else; do
                                                        if mc~='o' then; do
                                                                Call PostError('Found illegal RLE entry.')
                                                                return '#!'
                                                        end

                                                        do k=1 to rc
                                                                if ~PlotPixel(xpos-x_min,ypos-y_min) then
                                                                        return '#!'

                                                                xpos=xpos+1
                                                        end
                                                end     /* of if not background */
                                        end             /* of pass=1 */
                                        rc=1            /* reset run length to default */
                                end     /* of no new line */
                        end /* of no run length control */
                end /* of for characters in command line */

                line=ReadLine(file)
        end /* of valid line found */

return line

/*************************************************
 ** ParsePictureLine                            **
 ** parse lines of a picture file               **
 *************************************************/
ParsePictureLine:  Procedure       expose x_min y_min x_max y_max pass
        parse arg file,line,xoffset,yoffset

        ypos=yoffset
        if ypos<y_min then
                y_min=ypos

        do while left(line,1)~='#'       /* until new command */
                line=strip(line)
                xpos=xoffset
                if pass=0 then; do
                        if xpos<x_min then
                                x_min=xpos
                        xpos=xpos+length(line)-1
                        if xpos>x_max then
                                x_max=xpos

                end; else; do
                        do i=1 to length(line)
                                mc=substr(line,i,1)
                                if mc='*' | mc='+' then
                                        if ~PlotPixel(xpos-x_min,ypos-y_min) then
                                                return '#!'
                                xpos=xpos+1
                        end
                end
                if ypos>y_max then
                        y_max=ypos
                ypos=ypos+1
                line=ReadLine(file)
        end

return line

/*************************************************
 ** ParseListLine                               **
 ** parse lines of a coordinate list            **
 *************************************************/
ParseListLine:  Procedure       expose x_min y_min x_max y_max pass
        parse arg file,line,xoffset,yoffset


        do while left(line,1)~='#'       /* until new command */
                xpos=word(line,1)
                ypos=word(line,2)

                if xpos='' | ypos='' | ~datatype(xpos,W) | ~datatype(ypos,W) then; do
                        Call PostError('Found illegal coordinate entry.')
                        return '#!'
                end

                xpos=xpos+xoffset
                ypos=ypos+yoffset
                if pass=0 then; do
                        if xpos<x_min then
                                x_min=xpos
                        if ypos<y_min then
                                y_min=ypos
                        if xpos>x_max then
                                x_max=xpos
                        if ypos>y_max then
                                y_max=ypos
                end; else; do
                        if ~PlotPixel(xpos-x_min,ypos-y_min) then
                                return '#!'
                end;
                line=ReadLine(file)
        end

return line

/*************************************************
 ** ParseRLE                                    **
 ** RunLengthEncoded                            **
 *************************************************/
ParseRunLength: Procedure       expose x_min y_min x_max y_max pass xoffset yoffset
        parse arg file,line

        line=substr(line,3)     /* Get extra coordinates */

        xo=word(line,1)
        yo=word(line,2)    /* Get offsets, if present */

        if xo='' then
                xo=0

        if yo='' then
                yo=0

        if (~datatype(xo,'W') | ~datatype(yo,'W')) then; do
                Call PostError('Found invalid offsets in RunLengthEncoding.')
                return '#!';
        end;

        line=ReadLine(file)
        if line~='#^' then; do
                chck=compress(line,' ')
                if left(chck,2)='x=' then
                        ps=index(chck,',')
                        if ps>0 then
                                if substr(chck,ps+1,2)='y=' then
                                        line=ReadLine(file)
                /* Ignore size */
                return ParseRunLengthLine(file,line,xo+xoffset,yo+yoffset)
        end

return line


/*************************************************
 ** ParsePicture                                **
 ** parse a picture command (w. given offset)   **
 *************************************************/
ParsePicture:   Procedure       expose x_min y_min x_max y_max pass xoffset yoffset
        parse arg file,line

        line=substr(line,3)     /* Get extra coordinates */

        xo=word(line,1)
        yo=word(line,2)    /* Get offsets, if present */

        if xo='' then
                xo=0

        if yo='' then
                yo=0

        if (~datatype(xo,'W') | ~datatype(yo,'W')) then; do
                Call PostError('Found invalid offsets in picture.')
                return '#!';
        end;

        re=ParsePictureLine(file,ReadLine(file),xo+xoffset,yo+yoffset)

return re

/*************************************************
 ** ParseList                                   **
 ** parse a list command (w. given offset)      **
 *************************************************/
ParseList:      Procedure       expose x_min y_min x_max y_max pass
        parse arg file,line,xoffset,yoffset

        line=substr(line,3)     /* Get extra coordinates */

        xo=word(line,1)
        yo=word(line,2)    /* Get offsets, if present */

        if xo='' then
                xo=0

        if yo='' then
                yo=0

        if (~datatype(xoffset,'W') | ~datatype(yoffset,'W')) then; do
                Call PostError('Found invalid offsets in list.')
                return '#!';
        end;

        re=ParseListLine(file,ReadLine(file),xo+xoffset,yo+yoffset)

return re

/*************************************************
 ** ParseBlock                                  **
 ** ignore a block                              **
 ** (not yet supported)                         **
 *************************************************/
ParseBlock:     Procedure
        parse arg file,line

        line=ReadLine(file)
        do while left(line,1)~='#'       /* until new command */
                line=ReadLine(file)
        end

return line

/*************************************************
 ** ParseFile                                   **
 ** Parse the given file, pass numbers the pass **
 ** (first pass gets dimension)                 **
 *************************************************/
ParseFile:      Procedure       expose x_min y_min x_max y_max filecount
        parse arg name,pass,xoffset,yoffset

        format=0                /* Default to old XLife */
        lf=d2c(10)
        sq=d2c(39)
        filecount=filecount+1   /* Construct a unique name */
        if ~open(filecount,name,'R') then; do
                Call PostError('Error while opening source' || lf || name || ' .')
                return 0
        end


        line=ReadLine(filecount)
        do until eof(filecount)
                if left(line,1)='#' then; do
                        format=1        /* It is now XLife 2 ! */
                        cmd=substr(line,2,1)
                        select          /* Quiet a lot of them are simply ingored */
                                when cmd='R' then
                                        line=ParseList(filecount,line,0,0)
                                when cmd='A' then
                                        line=ParseList(filecount,line,xoffset,yoffset)
                                when cmd='P' then
                                        line=ParsePicture(filecount,line)
                                when cmd='I' then
                                        line=ParseInclude(line,name)
                                when cmd='E' then
                                        line=ParseRunLength(filecount,line)
                                when cmd='B' then
                                        line=ParseBlock(filecount,line)
                                when cmd='!' then;do    /* Error condition generated by code above */
                                        Call close(filecount)
                                        return 0
                                end
                                when cmd='^' then;do    /* End of file condition generated by line parser */
                                        Call close(filecount)
                                        return 1
                                end
                                otherwise
                                        line=ReadLine(filecount)
                        end
                end; else; do
                        /* Oops! We got something unexpected ! Let's see what we can make out of it !*/
                        if format=1 then; do
                                Call PostError('Found unexpected line while parsing' || lf || name || ' .')
                                Call close(filecount)
                                return 0
                        end
                        select
                                when verify(line,'0123456789 +-')=0 then
                                        line=ParseListLine(filecount,line,0,0)
                                when verify(line,'.* +-')=0 then
                                        line=ParsePictureLine(filecount,line,0,0)
                                otherwise; do
                                        Call PostError('Can' || sq || 't identify a line while parsing' || lf || name || ' .')
                                        Call close(filecount)
                                        return 0
                                end
                        end
                end
        end

        Call close(filecount)
return 1


/*************************************************
 ** ReOpen                                      **
 ** Open given file                             **
 *************************************************/
ReOpen:


return 1

/*************************************************
 ** ImportXLife(filename)                       **
 ** main procedure                              **
 *************************************************/
ImportXLife:   Procedure
   parse arg name
   lf=d2c(10)

   x_min=65536
   y_min=65536
   x_max=-x_min
   y_max=-y_min
   filecount=0

   if ~ParseFile(name,0,0,0) then
        return 0

   if x_max<x_min | y_max<y_min then; do
        Call PostError('The file contains no data.')
        return 0
   end

   xof=-x_min
   yof=-y_min
   width=x_max-x_min+1
   height=y_max-y_min+1

   'GETBORDER' 'border'
   if width>border.xmax+1 | height>border.ymax+1 then; do
      Call PostError('The brush is too big.' || lf || 'I need at least' width || 'x' || height 'pixels.')
      return 0
   end

   'PUSHTOOL' 'CELL_WINDOW' 'DRAW_DOTS' 'LEFT' 'LEFT'
   'PUSHTOOL' 'CELL_WINDOW' 'DOTS' 'LEFT' 'LEFT'
   'PUSHTOOL' 'CELL_WINDOW' 'SWAP' 'LEFT' 'LEFT'
   'LOCKUNDO'
   'FETCHUNDO'
   'PUSHTOOL' 'CELL_WINDOW' 'CLEAR' 'LEFT' 'LEFT'

   if ~ParseFile(name,1,0,0) then
        return 0

   'PUSHTOOL' 'CELL_WINDOW' 'CUT' 'LEFT' 'LEFT'
   'DRAG' 0 0 width-1 height-1 'LEFT'
   'PUSHTOOL' 'CELL_WINDOW' 'UNDO' 'LEFT' 'LEFT'
   'PUSHTOOL' 'CELL_WINDOW' 'SWAP' 'LEFT' 'LEFT'

return 1