The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

Respond to this messageReturn to Index
Original Message
  • Prototype GIF loader
    • (Premier Login iorr5t)
      Forum Owner
      Posted Dec 12, 2007 8:20 PM

      DECLARE SUB GIF.Info (G AS ANY)
      DECLARE SUB GIF.TBI (G AS ANY)
      DECLARE FUNCTION GIF.GetBits% (FileNo AS INTEGER, bits AS INTEGER, NextBlock AS INTEGER)

      TYPE GIFinfo
        FileNo AS INTEGER
        Ver AS STRING * 3
        Width AS INTEGER
        Height AS INTEGER
        SourcePalette AS INTEGER
        PaletteSize AS INTEGER
        GlobalPaletteFlag AS INTEGER
        Sorted AS INTEGER
        Background AS INTEGER
        Aspect AS INTEGER
      END TYPE

      TYPE GIFimdesc
        Left AS INTEGER
        Top AS INTEGER
        Width AS INTEGER
        Height AS INTEGER
      END TYPE
      DIM G AS GIFinfo
      G.FileNo = 1
      ' PATH GOES HERE
      OPEN "C:\path\to\gif.gif" FOR BINARY AS G.FileNo
      ' --------------
      GIF.Info G
      IF G.GlobalPaletteFlag THEN
        DIM Pal(0 TO G.PaletteSize * 3 - 1) AS STRING * 1
        GIF.GlobalPalette G, Pal()
        SCREEN 12
        ' <------------------------------------>
        ' This section is for use with SCREEN 12
        Dummy% = INP(&H3DA)
        FOR I = 0 TO G.PaletteSize - 1
          OUT &H3C0, I
          OUT &H3C0, I
        NEXT
        OUT &H3C0, 32
        ' <------------------------------------>
        OUT &H3C8, 0
        FOR I = 0 TO G.PaletteSize - 1
          OUT &H3C9, ASC(Pal(I * 3))
          OUT &H3C9, ASC(Pal(I * 3 + 1))
          OUT &H3C9, ASC(Pal(I * 3 + 2))
        NEXT
      END IF
      DIM byte AS STRING * 1
      DO
        IF EOF(1) THEN EXIT DO
        GET G.FileNo, , byte
        SELECT CASE byte
        CASE ","
          GIF.TBI G
        CASE "!"
          GET G.FileNo, , byte
          IF ASC(byte) = &HF9 THEN
            FOR I = 0 TO 5
              GET G.FileNo, , byte
            NEXT
          ELSE
            PRINT "Unknown extension: 0x" + HEX$(ASC(byte))
          END IF
        CASE ";"
          'END OF GIF
          EXIT DO
        CASE ELSE
          PRINT "Unknown magic byte: 0x" + HEX$(ASC(byte))
        END SELECT
      LOOP
      CLOSE

      SUB GIF.GlobalPalette (G AS GIFinfo, Pal() AS STRING * 1)
      DIM I AS INTEGER
      FOR I = 0 TO G.PaletteSize * 3 - 1
        GET G.FileNo, , Pal(I)
        Pal(I) = CHR$(ASC(Pal(I)) \ 4)
      NEXT
      END SUB

      FUNCTION GIF.GetBits% (FileNo AS INTEGER, bits AS INTEGER, NextBlock AS INTEGER)
      STATIC position AS INTEGER, byte AS STRING * 1
      IF bits = 0 THEN GET FileNo, , byte: EXIT FUNCTION
      DIM I AS INTEGER, X AS INTEGER
      X = 2 ^ (position)
      I = ASC(byte) \ X
      X = 2 ^ (8 - position)
      position = position + bits
      IF position >= 8 THEN
        DO
          GET FileNo, , byte
          IF LOC(FileNo) = NextBlock THEN
            NextBlock = NextBlock + 1 + ASC(byte)
            IF ASC(byte) = 0 THEN
              PRINT "Bad format!"
              SYSTEM
            END IF
            GET FileNo, , byte
          END IF
          position = position - 8
          I = I OR ((ASC(byte) AND (2 ^ position - 1)) * X)
          IF position < 8 THEN EXIT DO
          X = X * 256
        LOOP
      END IF
      I = I AND (2 ^ bits - 1)
      GIF.GetBits = I
      END FUNCTION

      SUB GIF.Info (G AS GIFinfo)
      DIM byte AS STRING * 1
      GET G.FileNo, , G.Ver
      IF G.Ver <> "GIF" THEN
        PRINT "Magic Number Wrong! Press Enter to continue or anything else to exit."
        DO
          K$ = INKEY$
        LOOP UNTIL LEN(K$)
        IF K$ <> CHR$(13) THEN SYSTEM
      END IF
      GET G.FileNo, , G.Ver
      GET G.FileNo, , G.Width
      GET G.FileNo, , G.Height
      GET G.FileNo, , byte
      IF ASC(byte) AND 128 THEN G.GlobalPaletteFlag = -1 ELSE G.GlobalPaletteFlag = 0
      G.SourcePalette = 2 ^ (((ASC(byte) AND 64 + 32 + 16) \ 16) + 1)
      G.PaletteSize = 2 ^ ((ASC(byte) AND 7) + 1)
      G.Sorted = ASC(byte) AND 8
      GET G.FileNo, , byte
      G.Background = ASC(byte)
      GET G.FileNo, , byte
      G.Aspect = ASC(byte)
      END SUB

      SUB GIF.TBI (G AS GIFinfo)
      DIM M AS GIFimdesc, byte AS STRING * 1
      DIM I AS INTEGER
      GET G.FileNo, , M
      GET G.FileNo, , byte
      DIM LocalPaletteFlag AS INTEGER, InterlaceFlag AS INTEGER, SortFlag AS INTEGER, LocalPaletteSize AS INTEGER
      IF ASC(byte) AND 128 THEN LocalPaletteFlag = -1
      IF ASC(byte) AND 64 THEN InterlaceFlag = -1: PRINT "INTERLACED!!!!!!!!!!!!!!": STOP
      IF ASC(byte) AND 32 THEN SortFlag = -1
      LocalPaletteSize = 2 ^ ((ASC(byte) AND 7) + 1)
      IF LocalPaletteFlag THEN
        OUT &H3C8, 0
        FOR I = 0 TO LocalPaletteSize * 3 - 1
          GET G.FileNo, , byte
          OUT &H3C9, ASC(byte) \ 4
        NEXT
      END IF
      DIM X AS INTEGER, Y AS INTEGER
      DIM MinCodeSize AS INTEGER
      GET G.FileNo, , byte
      MinCodeSize = ASC(byte)
      DIM Dic((2 ^ MinCodeSize) + 2 TO 4095) AS STRING
      DIM CCS AS INTEGER, DS AS INTEGER, RS AS INTEGER, US AS INTEGER
      DIM K AS INTEGER, W AS STRING, E AS STRING
      CCS = MinCodeSize + 1
      US = 2 ^ MinCodeSize - 1
      RS = US + 2
      DS = RS
      DIM FileOffset AS INTEGER
      GET G.FileNo, , byte
      FileOffset = LOC(G.FileNo) + 1 + ASC(byte)
      Dummy = GIF.GetBits(G.FileNo, 0, 0)
      X = 0: Y = 0
      E = ""
      W = ""
      DO
        K = GIF.GetBits(G.FileNo, CCS, FileOffset)
        IF K <= US THEN
          E = CHR$(K)
        ELSEIF K > RS THEN
          IF K <= DS THEN
            E = Dic(K)
          ELSE
            E = W + LEFT$(W, 1)
          END IF
        ELSEIF K = RS - 1 THEN
          DS = RS
          CCS = MinCodeSize + 1
          E = ""
          W = ""
        ELSEIF K = RS THEN
          'PRINT "End of file stream"
          EXIT SUB
        END IF
        FOR I = 1 TO LEN(E)
          PSET (X, Y), ASC(MID$(E, I, 1))
          X = X + 1
          IF X >= M.Width THEN X = 0: Y = Y + 1
        NEXT
        IF LEN(W) THEN
          IF DS < 4095 THEN
            DS = DS + 1
            IF DS >= 2 ^ CCS - 1 THEN CCS = CCS + 1
            Dic(DS) = W + LEFT$(E, 1)
          END IF
        END IF
        W = E
      LOOP
      END SUB

    Login Status
  • You are not logged in
    • Login
      Password
       

      Optional
      Provides additional benefits such as notifications, signatures, and user authentication.


      Create Account
    Your Name
    Message Title
    Message Text
    Options