Keskustelu: Koodit: QB: FLI-playeri

' 320x200x256 FLI-player (c) fawkz 2002
' if you encounter a FLI that doesn't work, mail
' me _____@luukku.com.

DECLARE SUB playfli (flifile AS STRING)

TYPE FLIHeader
  size    AS LONG
  magic   AS INTEGER
  frames  AS INTEGER
  widthi  AS INTEGER
  height  AS INTEGER
  depth   AS INTEGER
  flags   AS INTEGER
  speed   AS INTEGER
  nexti   AS LONG
  frit    AS LONG
  expand  AS STRING * 102
END TYPE

TYPE FrameHeader
  size    AS LONG
  magic   AS INTEGER
  chunks  AS INTEGER
  expand  AS STRING * 8
END TYPE

TYPE ChunkHeader
  size    AS LONG
  typei   AS INTEGER
END TYPE

playfli "fawkz.fli"		' simple to use..

SUB playfli (flifile AS STRING)
  CONST FLI.COLOR = 11
  CONST FLI.LC = 12
  CONST FLI.BLACK = 13
  CONST FLI.BRUN = 15
  CONST FLI.COPY = 16

  DIM f AS FLIHeader, g AS FrameHeader, h AS ChunkHeader
  DIM c AS INTEGER, d AS INTEGER, e AS LONG, n AS INTEGER
  DIM j AS STRING * 1, k AS INTEGER, l AS INTEGER, m AS INTEGER
  DIM o AS INTEGER, x AS INTEGER, y AS INTEGER, z AS INTEGER
  DIM i AS INTEGER

  SCREEN 13

  i = FREEFILE
  OPEN flifile FOR BINARY AS i
  GET #1, , f   ' read header in

  FOR z = 1 TO f.frames
    GET #1, , g   ' read frameheader
    FOR c = 1 TO g.chunks ' loop for chunks in this frame..
      GET #1, , h   ' get chunkheader..
      SELECT CASE h.typei
        CASE FLI.COLOR
          ' palette stuff
          GET #1, , d         ' number of packets
          FOR n = 1 TO d
            GET #1, , j       ' colors to skip
            OUT &H3C8, ASC(j)
            GET #1, , j       ' colors to change
            k = ASC(j)
            IF k = 0 THEN k = 256
            FOR l = 1 TO k
              GET #1, , j
              OUT &H3C9, ASC(j)
              GET #1, , j
              OUT &H3C9, ASC(j)
              GET #1, , j
              OUT &H3C9, ASC(j)
            NEXT l
          NEXT n

        CASE FLI.LC
          ' linecompression
          GET #1, , d         ' lines that are same as in last frame..
          GET #1, , m         ' number of lines that change

          FOR n = d TO d + m - 1
            ' start fetching lines..
            x = 0
            GET #1, , j       ' number of packets in this line
            k = ASC(j)
            FOR y = 1 TO k
              GET #1, , j     ' skip_count
              x = x + ASC(j)
              GET #1, , j     ' size_count
              l = ASC(j)
              IF l < &H80 THEN
                ' l bytes follow .. copy to scr
                FOR o = 0 TO l - 1
                  GET #1, , j
                  PSET (x, n - 1), ASC(j)
                  x = x + 1
                NEXT o
              ELSE
                GET #1, , j
                l = l - &H80
                FOR o = 1 TO l - 1
                  PSET (x, n - 1), ASC(j)
                  x = x + 1
                NEXT o
                ' copy l bytes of asc(j) to scr...
              END IF
            NEXT y
          NEXT n

        CASE FLI.BLACK
          ' black the screen, we could ignore this
          ' coz it only occurs for first frame
          CLS

        CASE FLI.BRUN
          ' only for the first frame..
          FOR n = 1 TO 200
            GET #1, , j       ' number of packets
            k = ASC(j)
            x = 0
            DO
              GET #1, , j       ' size_count
              l = ASC(j)
              IF l < &H80 THEN  ' positive
                GET #1, , j
                FOR o = 0 TO l - 1
                  PSET (x, n - 1), ASC(j)
                  x = x + 1
                NEXT o
              ELSE
                l = (0 - l) AND &HFF
                FOR o = 0 TO l - 1
                  GET #1, , j
                  PSET (x, n - 1), ASC(j)
                  x = x + 1
                NEXT o
              END IF
            LOOP UNTIL x >= 320
          NEXT n
        CASE FLI.COPY
          ' copy 64000 raw bytes..
          FOR y = 0 TO 199
            FOR x = 0 TO 319
              GET #1, , j
              PSET (x, y), ASC(j)
            NEXT x
          NEXT y
      END SELECT
    NEXT c
    FOR c = 1 TO f.speed
      ' you can put a delay here if you want...
      ' but qb is slow so you might not want to ;)
    NEXT c
  NEXT z
  CLOSE i
END SUB