'===========================================================================
' Subject: PLAY .FLI FILES                   Date: 06-20-97 (15:39)       
' Author:  Denis Boyles                      Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: GRAPHICS.ABC
'===========================================================================
'[VIEWFLI2.BAS] - Public Domain 1997 by Denis Boyles. All Rights Reserved.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' * UPDATE * - added Page Buffering to scene changes.
'
'Intrigued by Carl Gorringe's FLIPLAY2 program, I thought it'd be a fun
'project to work on. Armed with the PC Game Programmer's Encyclopedia and
'Carl's program for reference I set forth.

'To my surprise, viewing the .FLI was pretty straightforward. However I've
'tried to make it a bit faster then Carls'. Using a little bit of assembly
'code, I think I've managed that, slightly. On my 386-20, I'd say for now,
'that mine is about twice as fast. (though it's still slooow)

'However, my player is only limited to .FLI files and not the newer .FLC
'ones. Mainly, the PCGPE seemed to only outline the .FLI format and not the
'.FLC. (plus I couldn't seem to find any .FLC to test with anyway) Also, like
'Carl's there is a 320x200x256 color image limit on the animation.

DECLARE SUB ReadMLXData ()
DECLARE SUB DoLC (FileHandle%)
DECLARE SUB DoCOPY (FileHandle%)
DECLARE SUB DoCOLOR (FileHandle%)
DECLARE SUB DoBRUN (FileHandle%)
DECLARE SUB DoChunk (FileHandle%)
DECLARE SUB DoFrame (FileHandle%)
DECLARE SUB PlayFLI (FileName$)
DECLARE FUNCTION FixFileName$ (FileName$, Ext$)

CONST FLIID = &HAF11
CONST FRMID = &HF1FA

CONST FLICOLOR = 11
CONST FLILC = 12
CONST FLIBLACK = 13
CONST FLIBRUN = 15
CONST FLICOPY = 16

TYPE FLIHEADER
  FileSize  AS LONG
  ID        AS INTEGER
  NumFrames AS INTEGER
  across    AS INTEGER
  down      AS INTEGER
  PelDepth  AS INTEGER
  flags     AS INTEGER
  speed     AS INTEGER
  expand    AS STRING * 110
END TYPE

TYPE FRMHEADER
  size      AS LONG
  ID        AS INTEGER
  NumChunks AS INTEGER
  expand    AS STRING * 8
END TYPE

TYPE CHNKHEADER
  size      AS LONG
  ID        AS INTEGER
END TYPE

TYPE RGB
  red       AS STRING * 1
  green     AS STRING * 1
  blue      AS STRING * 1
END TYPE

DIM SHARED memcpy%(18), memset%(15), pg%(32000)

ReadMLXData
INPUT "[drive:][path]filename[.FLI]"; FileName$
PlayFLI FixFileName(FileName$, "FLI")
BEEP

'36 bytes of MLX data for the MEMCPY procedure
DATA &H55,&H8B,&HEC,&H1E,&H8B,&H5E,&H0E,&H8E
DATA &H07,&H8B,&H5E,&H0C,&H8B,&H3F,&H8B,&H5E
DATA &H06,&H8B,&H0F,&H8B,&H5E,&H08,&H8B,&H37
3 DATA &H8B,&H5E,&H0A,&H8E,&H1F,&HF3,&HA4,&H1F
DATA &H5D,&HCA,&H0A,&H00

'29 bytes of MLX data for the MEMSET procedure
DATA &H55,&H8B,&HEC,&H8B,&H5E,&H0C,&H8E,&H07
DATA &H8B,&H5E,&H0A,&H8B,&H3F,&H8B,&H5E,&H06
DATA &H8B,&H07,&H8B,&H5E,&H08,&H8B,&H0F,&HF3
DATA &HAA,&H5D,&HCA,&H08,&H00

SUB DoBRUN (FileHandle%)
  offset& = 0

  FOR y% = 1 TO 200
    NumPackets% = ASC(INPUT$(1, FileHandle%))
    x% = 0

    FOR packet% = 1 TO NumPackets%
      SizeCount% = ASC(INPUT$(1, FileHandle%))

      IF SizeCount% < 128 THEN
        DataByte% = ASC(INPUT$(1, FileHandle%))

        DEF SEG = VARSEG(memset%(0))
        CALL absolute(VARSEG(pg%(0)), offset& + x%, SizeCount%, DataByte%, 0)
      ELSE
        SizeCount% = -(SizeCount% OR &HFF00)
        buffer$ = INPUT$(SizeCount%, FileHandle%)

        DEF SEG = VARSEG(memcpy%(0))
        CALL absolute(VARSEG(pg%(0)), offset& + x%, VARSEG(buffer$), SADD(buffer$), SizeCount%, 0)
      END IF

      x% = x% + SizeCount%
    NEXT

    offset& = offset& + 320
  NEXT
END SUB

SUB DoChunk (FileHandle%)
  DIM CHUNK AS CHNKHEADER

  FilePos& = SEEK(FileHandle%)
  GET FileHandle%, , CHUNK

  SELECT CASE CHUNK.ID
    CASE FLICOLOR
      DoCOLOR FileHandle%

    CASE FLILC
      DoLC FileHandle%
      DEF SEG = VARSEG(memcpy%(0))
      CALL absolute(&HA000, 0, VARSEG(pg%(0)), 0, &HFA00, 0)

    CASE FLIBLACK
      CLS

    CASE FLIBRUN
      DoBRUN FileHandle%
      DEF SEG = VARSEG(memcpy%(0))
      CALL absolute(&HA000, 0, VARSEG(pg%(0)), 0, &HFA00, 0)

    CASE FLICOPY
      DoCOPY FileHandle%
      CALL absolute(&HA000, 0, VARSEG(pg%(0)), 0, &HFA00, 0)
  END SELECT

  SEEK FileHandle%, FilePos& + CHUNK.size
END SUB

SUB DoCOLOR (FileHandle%)
  DIM RGB AS RGB

  GET FileHandle%, , NumPackets%
  index% = 0

  FOR pack% = 1 TO NumPackets%
    index% = index% + ASC(INPUT$(1, FileHandle%))

    change% = ASC(INPUT$(1, FileHandle%))
    IF change% = 0 THEN change% = 256

    OUT &H3C8, index%
    FOR ct% = 1 TO change%
      GET #1, , RGB
      OUT &H3C9, ASC(RGB.red)
      OUT &H3C9, ASC(RGB.green)
      OUT &H3C9, ASC(RGB.blue)
      index% = index% + 1
    NEXT
  NEXT
END SUB

SUB DoCOPY (FileHandle%)
  DEF SEG = VARSEG(memcpy%(0))
  offset& = 0

  FOR ct% = 1 TO 200
    buffer$ = INPUT$(320, FileHandle%)
    CALL absolute(VARSEG(pg%(0)), offset&, VARSEG(buffer$), SADD(buffer$), 320, 0)
    offset& = offset& + 320
  NEXT
END SUB

SUB DoFrame (FileHandle%)
  DIM FRAME AS FRMHEADER

  FilePos& = SEEK(FileHandle%)
  GET FileHandle%, , FRAME

  IF FRAME.ID = FRMID THEN
    FOR ct% = 1 TO FRAME.NumChunks
      DoChunk FileHandle%
    NEXT
  END IF

  SEEK FileHandle%, FilePos& + FRAME.size
END SUB

SUB DoLC (FileHandle%)
  GET FileHandle%, , StartY%
  GET FileHandle%, , NumLines%
  offset& = StartY% * 320&

  FOR y% = StartY% TO StartY% + NumLines% - 1
    NumPackets% = ASC(INPUT$(1, FileHandle%))

    IF NumPackets% > 0 THEN
      x% = 0

      FOR packet% = 1 TO NumPackets%
        x% = x% + ASC(INPUT$(1, FileHandle%))
        SizeCount% = ASC(INPUT$(1, FileHandle%))

        IF SizeCount% < 128 THEN
          buffer$ = INPUT$(SizeCount%, FileHandle%)

          DEF SEG = VARSEG(memcpy%(0))
          CALL absolute(VARSEG(pg%(0)), offset& + x%, VARSEG(buffer$), SADD(buffer$), SizeCount%, 0)
        ELSE
          SizeCount% = -(SizeCount% OR &HFF00)
          DataByte% = ASC(INPUT$(1, FileHandle%))

          DEF SEG = VARSEG(memset%(0))
          CALL absolute(VARSEG(pg%(0)), offset& + x%, SizeCount%, DataByte%, 0)
        END IF

        x% = x% + SizeCount%
      NEXT
    END IF

    offset& = offset& + 320
  NEXT
END SUB

FUNCTION FixFileName$ (FileName$, Ext$)
  FOR ct% = 1 TO LEN(FileName$)
    IF MID$(FileName$, ct%, 1) = "." THEN EXIT FOR
  NEXT
  FixFileName$ = UCASE$(LEFT$(FileName$, ct% - 1) + "." + Ext$)
END FUNCTION

SUB PlayFLI (FileName$)
  DIM FLI AS FLIHEADER

  FileHandle% = FREEFILE

  OPEN FileName$ FOR BINARY AS FileHandle%
    GET FileHandle%, , FLI

    IF FLI.ID <> FLIID THEN
      CLOSE FileHandle%
      PRINT "ERROR: "; FileName$; " isn't a true FLI!?"
      EXIT SUB
    END IF

    IF FLI.across <> 320 AND FLI.down <> 200 THEN
      CLOSE FileHandle%
      PRINT "ERROR: FLI does not conform to 320x200 dimensions!?"
      EXIT SUB
    END IF

    IF FLI.PelDepth <> 8 THEN
      CLOSE FileHandle%
      PRINT "ERROR: FLI isn't 256 colors!?"
      EXIT SUB
    END IF

    SCREEN 13
    FOR ct% = 1 TO FLI.NumFrames
      DoFrame FileHandle%
    NEXT

  CLOSE FileHandle%
END SUB

SUB ReadMLXData
  DEF SEG = VARSEG(memcpy%(0))
  FOR ct% = 0 TO 35
    READ byte%
    POKE ct%, byte%
  NEXT

  DEF SEG = VARSEG(memset%(0))
  FOR ct% = 0 TO 28
    READ byte%
    POKE ct%, byte%
  NEXT
END SUB