Create gifdataload.bas

RetroNick2020 · Nov 17, 2023 · 9fe746e · 9fe746e
1 parent 8cac672
commit 9fe746e
Showing 1 changed file with 348 additions and 0 deletions.
diff --git a/QuickBASIC/GifDataLoad/gifdataload.bas b/QuickBASIC/GifDataLoad/gifdataload.bas
@@ -0,0 +1,348 @@
+'Original Code by Rich Geldreich to read actual GIF files
+'Modified by RetroNick to read GIF from data statement
+'Removed direct hardware access and other requirements like
+'image having to be 320x200x256. Images can be smaller now
+
+DECLARE SUB GifDataLoad ()
+
+DEFINT A-Z
+SCREEN 13
+RESTORE TestImageLabel
+GifDataLoad
+
+
+SUB GifDataLoad
+DEFINT A-Z
+DIM powersof2(11) AS LONG, WorkCode AS LONG
+DIM Prefix(4095) AS INTEGER, Suffix(4095) AS INTEGER, OutStack(4095) AS INTEGER
+DIM ColPal(768) AS INTEGER
+DIM shiftout(8) AS INTEGER
+
+FOR a% = 0 TO 7
+ shiftout(8 - a%) = 2 ^ a%
+NEXT a%
+
+FOR a% = 0 TO 11
+  powersof2(a%) = 2 ^ a%
+NEXT a%
+
+'read the 6 byte GIF87a or GIF89a header
+a$ = ""
+FOR ii = 1 TO 6
+  GOSUB GetByte
+  a$ = a$ + CHR$(a%)
+NEXT ii
+
+IF a$ <> "GIF87a" AND a$ <> "GIF89a" THEN PRINT "Not a GIF87a file.": END
+GOSUB GetInteger
+TotalX = a%
+
+GOSUB GetInteger
+TotalY = a%
+
+GOSUB GetByte
+NumColors = 2 ^ ((a% AND 7) + 1): NoPalette = (a% AND 128) = 0
+GOSUB GetByte: Background = a%
+GOSUB GetByte: IF a% <> 0 THEN PRINT "Bad screen descriptor.": END
+
+IF NoPalette = 0 THEN
+  c = NumColors * 3 - 1
+  FOR ii = 0 TO c
+    GOSUB GetByte
+    ColPal(ii) = a% \ 4
+  NEXT ii
+END IF
+
+DO
+    GOSUB GetByte
+    IF a% = 44 THEN
+        GOTO exitdo
+    ELSEIF a% <> 33 THEN
+        PRINT "Unknown extension type.": END
+    END IF
+    GOSUB GetByte
+    DO
+      GOSUB GetByte
+      a$ = SPACE$(a%)
+      endloop = a%
+      FOR i = 1 TO a%
+        GOSUB GetByte
+      NEXT i
+    LOOP UNTIL endloop = 0
+LOOP
+exitdo:
+
+GOSUB GetInteger
+XStart = a%
+GOSUB GetInteger
+YStart = a%
+GOSUB GetInteger
+XLength = a%
+GOSUB GetInteger
+YLength = a%
+
+XEnd = XStart + XLength: YEnd = YStart + YLength: GOSUB GetByte
+IF a% AND 128 THEN PRINT "Can't handle local colormaps.": END
+Interlaced = a% AND 64: PassNumber = 0: PassStep = 8
+GOSUB GetByte
+ClearCode = 2 ^ a%
+EOSCode = ClearCode + 1
+FirstCode = ClearCode + 2: NextCode = FirstCode
+StartCodeSize = a% + 1: CodeSize = StartCodeSize
+StartMaxCode = 2 ^ (a% + 1) - 1: MaxCode = StartMaxCode
+
+BitsIn = 0: BlockSize = 0: BlockPointer = 1
+x% = XStart: y% = YStart
+
+IF NoPalette = 0 THEN
+    c% = NumColors - 1
+    FOR nn% = 0 TO c%
+        r = ColPal(nn% * 3)
+        g = ColPal(nn% * 3 + 1)
+        b = ColPal(nn% * 3 + 2)
+        value& = 65536 * b + 256 * g + r
+        PALETTE nn%, value&
+    NEXT nn%
+END IF
+
+LINE (0, 0)-(319, 199), Background, BF
+DO
+    GOSUB GetCode
+    IF Code <> EOSCode THEN
+        IF Code = ClearCode THEN
+            NextCode = FirstCode
+            CodeSize = StartCodeSize
+            MaxCode = StartMaxCode
+            GOSUB GetCode
+            CurCode = Code: LastCode = Code: LastPixel = Code
+            PSET (x%, y%), LastPixel
+            x% = x% + 1
+            IF x% = XEnd THEN GOSUB NextScanLine
+        ELSE
+            CurCode = Code: StackPointer = 0
+            IF Code > NextCode THEN GOTO exitdo2
+            IF Code = NextCode THEN
+                CurCode = LastCode
+                OutStack(StackPointer) = LastPixel
+                StackPointer = StackPointer + 1
+            END IF
+
+            WHILE (CurCode >= FirstCode)
+                OutStack(StackPointer) = Suffix(CurCode)
+                StackPointer = StackPointer + 1
+                CurCode = Prefix(CurCode)
+            WEND
+
+            LastPixel = CurCode
+            PSET (x%, y%), LastPixel
+            x% = x% + 1
+            IF x% = XEnd THEN GOSUB NextScanLine
+            StartLoop = StackPointer - 1
+            FOR a% = StartLoop TO 0 STEP -1
+                PSET (x%, y%), OutStack(a%)
+                x% = x% + 1
+                IF x% = XEnd THEN GOSUB NextScanLine
+            NEXT a%
+
+            IF NextCode < 4096 THEN
+                Prefix(NextCode) = LastCode
+                Suffix(NextCode) = LastPixel
+                NextCode = NextCode + 1
+                IF NextCode > MaxCode AND CodeSize < 12 THEN
+                    CodeSize = CodeSize + 1
+                    MaxCode = MaxCode * 2 + 1
+                END IF
+            END IF
+            LastCode = Code
+        END IF
+    END IF
+LOOP UNTIL DoneFlag OR Code = EOSCode
+exitdo2:
+EXIT SUB
+
+GetByte: READ a%: RETURN
+GetInteger: READ t1%, t2%: a% = t2% * 256 + t1%: RETURN
+
+NextScanLine:
+    IF Interlaced THEN
+        y% = y% + PassStep
+        IF y% >= YEnd THEN
+            PassNumber = PassNumber + 1
+            SELECT CASE PassNumber
+            CASE 1: y% = 4: PassStep = 8
+            CASE 2: y% = 2: PassStep = 4
+            CASE 3: y% = 1: PassStep = 2
+            END SELECT
+        END IF
+    ELSE
+        y% = y% + 1
+    END IF
+    x% = XStart: DoneFlag = y% > 199
+RETURN
+GetCode:
+    IF BitsIn = 0 THEN
+        GOSUB ReadBufferedByte
+        LastChar = a%
+        BitsIn = 8
+    END IF
+
+    WorkCode = LastChar \ shiftout(BitsIn)
+    DO WHILE CodeSize > BitsIn
+        GOSUB ReadBufferedByte: LastChar = a%
+        WorkCode = WorkCode OR LastChar * powersof2(BitsIn)
+        BitsIn = BitsIn + 8
+    LOOP
+    BitsIn = BitsIn - CodeSize
+    Code = WorkCode AND MaxCode
+RETURN
+
+ReadBufferedByte:
+    IF BlockPointer > BlockSize THEN
+       GOSUB GetByte: BlockSize = a%
+       aa$ = ""
+       FOR n = 1 TO BlockSize
+          GOSUB GetByte
+          aa$ = aa$ + CHR$(a%)
+       NEXT n
+       a$ = aa$
+       BlockPointer = 1
+    END IF
+    a% = ASC(MID$(a$, BlockPointer, 1)): BlockPointer = BlockPointer + 1
+RETURN
+END SUB
+
+TestImageLabel:
+' test Size=1312
+DATA 71,73,70,56,57,97,64,0,64,0
+DATA 247,0,0,0,0,0,0,0,170,232
+DATA 170,0,0,170,170,170,0,0,170,123
+DATA 170,80,85,0,170,170,170,85,85,85
+DATA 85,85,255,85,255,85,85,255,255,255
+DATA 85,85,255,85,255,255,255,85,255,255
+DATA 255,0,0,0,20,20,20,32,32,32
+DATA 44,44,44,56,56,56,68,68,68,80
+DATA 80,80,96,96,96,112,112,112,128,128
+DATA 128,144,144,144,160,160,160,180,180,180
+DATA 200,200,200,224,224,224,252,252,252,0
+DATA 0,252,64,0,252,124,0,252,188,0
+DATA 252,252,0,252,252,0,188,252,0,124
+DATA 252,0,64,252,0,0,252,64,0,252
+DATA 124,0,252,188,0,252,252,0,188,252
+DATA 0,124,252,0,64,252,0,0,252,0
+DATA 0,252,64,0,252,124,0,252,188,0
+DATA 252,252,0,188,252,0,124,252,0,64
+DATA 252,124,124,252,156,124,252,188,124,252
+DATA 220,124,252,252,124,252,252,124,220,252
+DATA 124,188,252,124,156,252,124,124,252,156
+DATA 124,252,188,124,252,220,124,252,252,124
+DATA 220,252,124,188,252,124,156,252,124,124
+DATA 252,124,124,252,156,124,252,188,124,252
+DATA 220,124,252,252,124,220,252,124,188,252
+DATA 124,156,252,180,180,252,196,180,252,216
+DATA 180,252,232,180,252,252,180,252,252,180
+DATA 232,252,180,216,252,180,196,252,180,180
+DATA 252,196,180,252,216,180,252,232,180,252
+DATA 252,180,232,252,180,216,252,180,196,252
+DATA 180,180,252,180,180,252,196,180,252,216
+DATA 180,252,232,180,252,252,180,232,252,180
+DATA 216,252,180,196,252,0,0,112,28,0
+DATA 112,56,0,112,84,0,112,112,0,112
+DATA 112,0,84,112,0,56,112,0,28,112
+DATA 0,0,112,28,0,112,56,0,112,84
+DATA 0,112,112,0,84,112,0,56,112,0
+DATA 28,112,0,0,112,0,0,112,28,0
+DATA 112,56,0,112,84,0,112,112,0,84
+DATA 112,0,56,112,0,28,112,56,56,112
+DATA 68,56,112,84,56,112,96,56,112,112
+DATA 56,112,112,56,96,112,56,84,112,56
+DATA 68,112,56,56,112,68,56,112,84,56
+DATA 112,96,56,112,112,56,96,112,56,84
+DATA 112,56,68,112,56,56,112,56,56,112
+DATA 68,56,112,84,56,112,96,56,112,112
+DATA 56,96,112,56,84,112,56,68,112,80
+DATA 80,112,88,80,112,96,80,112,104,80
+DATA 112,112,80,112,112,80,104,112,80,96
+DATA 112,80,88,112,80,80,112,88,80,112
+DATA 96,80,112,104,80,112,112,80,104,112
+DATA 80,96,112,80,88,112,80,80,112,80
+DATA 80,112,88,80,112,96,80,112,104,80
+DATA 112,112,80,104,112,80,96,112,80,88
+DATA 112,0,0,64,16,0,64,32,0,64
+DATA 48,0,64,64,0,64,64,0,48,64
+DATA 0,32,64,0,16,64,0,0,64,16
+DATA 0,64,32,0,64,48,0,64,64,0
+DATA 48,64,0,32,64,0,16,64,0,0
+DATA 64,0,0,64,16,0,64,32,0,64
+DATA 48,0,64,64,0,48,64,0,32,64
+DATA 0,16,64,32,32,64,40,32,64,48
+DATA 32,64,56,32,64,64,32,64,64,32
+DATA 56,64,32,48,64,32,40,64,32,32
+DATA 64,40,32,64,48,32,64,56,32,64
+DATA 64,32,56,64,32,48,64,32,40,64
+DATA 32,32,64,32,32,64,40,32,64,48
+DATA 32,64,56,32,64,64,32,56,64,32
+DATA 48,64,32,40,64,44,44,64,48,44
+DATA 64,52,44,64,60,44,64,64,44,64
+DATA 64,44,60,64,44,52,64,44,48,64
+DATA 44,44,64,48,44,64,52,44,64,60
+DATA 44,64,64,44,60,64,44,52,64,44
+DATA 48,64,44,44,64,44,44,64,48,44
+DATA 64,52,44,64,60,44,64,64,44,60
+DATA 64,44,52,64,44,48,64,0,0,0
+DATA 0,0,0,0,0,0,0,0,0,0
+DATA 0,0,0,0,0,0,0,0,109,109
+DATA 109,33,249,4,4,255,255,0,0,44
+DATA 0,0,0,0,64,0,64,0,7,8
+DATA 255,0,1,8,28,72,176,160,193,131
+DATA 8,19,42,92,200,176,161,195,135,16
+DATA 35,74,156,72,177,162,197,139,24,51
+DATA 106,220,200,177,163,199,143,32,67,138
+DATA 28,73,178,164,201,147,40,83,170,76
+DATA 200,161,67,134,149,12,15,108,32,248
+DATA 224,129,7,134,26,8,230,36,89,147
+DATA 195,192,154,55,21,106,120,224,19,192
+DATA 208,162,34,123,254,180,185,240,168,64
+DATA 167,35,149,10,4,218,148,232,83,171
+DATA 81,177,2,160,170,240,0,86,175,72
+DATA 67,74,221,202,84,33,7,172,103,195
+DATA 130,28,203,149,37,90,173,98,31,116
+DATA 208,160,225,108,89,129,25,60,120,64
+DATA 154,86,96,95,129,29,108,170,197,88
+DATA 179,112,225,160,2,63,200,149,235,247
+DATA 109,209,127,134,59,112,52,108,24,241
+DATA 6,166,30,30,52,46,250,55,240,135
+DATA 161,31,38,219,212,240,178,109,96,159
+DATA 153,27,31,80,157,216,170,226,157,25
+DATA 217,222,205,124,224,128,226,198,59,207
+DATA 238,172,249,15,0,237,141,178,17,83
+DATA 254,240,82,55,238,169,154,125,195,189
+DATA 24,252,231,135,3,176,1,24,151,254
+DATA 32,231,208,228,138,7,87,108,62,21
+DATA 241,103,234,185,171,3,253,200,80,182
+DATA 102,116,230,90,219,50,253,151,185,184
+DATA 120,240,137,67,123,77,174,145,59,128
+DATA 192,29,20,7,157,62,253,116,102,196
+DATA 25,157,54,80,126,0,218,101,217,119
+DATA 0,108,128,160,116,138,125,208,27,76
+DATA 16,157,7,225,132,20,86,104,225,133
+DATA 27,185,160,225,134,28,186,48,145,0
+DATA 32,134,24,226,69,29,150,200,33,68
+DATA 34,166,8,98,69,38,182,168,161,67
+DATA 42,198,56,145,139,52,50,20,227,141
+DATA 17,209,168,163,66,55,246,8,145,142
+DATA 53,38,212,35,142,3,169,96,228,145
+DATA 42,16,4,228,142,8,13,41,35,0
+DATA 72,70,105,164,64,75,6,121,144,147
+DATA 42,66,41,165,148,0,84,233,162,144
+DATA 88,138,184,229,152,94,182,8,102,152
+DATA 32,142,185,101,153,38,158,25,166,154
+DATA 107,178,217,161,155,88,194,41,165,156
+DATA 115,54,137,166,0,118,222,137,167,135
+DATA 60,162,217,103,148,127,2,26,168,147
+DATA 90,14,58,37,158,48,14,41,144,162
+DATA 71,82,89,38,138,68,38,170,232,64
+DATA 94,118,4,233,148,74,90,201,209,166
+DATA 73,82,8,169,133,163,146,218,39,134
+DATA 150,110,137,106,145,92,174,186,82,64
+DATA 0,59
+