Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   forum.boolean.name > Программирование игр для компьютеров > BlitzMax > FAQ и уроки

Ответ
 
Опции темы
Старый 23.09.2010, 01:34   #1
Randomize
[object Object]
 
Аватар для Randomize
 
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,354
Написано 2,470 полезных сообщений
(для 6,850 пользователей)
Gif файл с интернета.

Сегодня мне понадобилась простая программа, скачивающая изображения с интернета. Выбор пал именно на BlitzMax (быстро, мощно, надёжно, удобно)
Для экспериментов я выбрал наш логотип. И меня сразу же ждал фейл.
BlitzMax не дружит с Gif. Ну что за напасть. В итоге я нашёл таки решение этой проблемы.

Исходник для загрузки Gif файлов GifLoader.bmx
* код большой и по этому под спойлер его.

Да, я понимаю, что код очень хреновый и "по хорошему" нужно было написать полноценный загрузчик аля brl.xxxloader, но цель была поставлена иная.

Strict

Global CODEMASK[] = [0, $0001, $0003, $0007, $000F, $001F, $003F, $007F, $00FF, $01FF, $03FF, $07FF, $0FFF]
Const 
MAXCODES 4096
Const HASALPHA 1

Global stack:Short[MAXCODES]
Global 
suffix:Short[MAXCODES]
Global 
prefix:Short[MAXCODES]

Global 
lzhbuffer:Byte[256]
Global 
bbptrbitsbytesbval

Function ReadGifPixmaps:TList(stream:TStream)
    
Local pixmaps:TList = New TList
    Local pal
:Int Ptr
    Local bgcol
    Local aspect
    Local i
rgbwhfnt
    Local _delay
_start_end_loop_flags

    Local hdr
:Byte[6]

    If 
stream.Read(hdr6) <> Return
    If 
hdr[0] <> Asc("G") Or hdr[1] <> Asc("I") Or hdr[2] <> Asc("F") Return

    
stream.ReadShort()
    
stream.ReadShort()
    
stream.ReadByte()
    
bgcol stream.ReadByte()
    
aspect stream.ReadByte()
    If 
128
        n 
2Shl(7)
        
pal = New Int[n]
        For 
0 Until n
            r 
stream.ReadByte()
            
stream.ReadByte()
            
stream.ReadByte()
            
pal[i] = $ff000000 | (r Shl 16) | (g Shl 8) | (b)
        
Next
    
EndIf
    
_delay = -1
    
While True
        n 
stream.ReadByte()
        
Select n
            
Case - 1
                
Return pixmaps
            
Case $2c
                parsegif
(pixmapsstreampal0)
                
DebugLog "gif $2c complete pixmaps.count()=" pixmaps.Count()
                Return 
pixmaps
            
'            DebugStop
            Case $21
                n = stream.ReadByte()
                Select n
                    Case $f9'
graphic control block
                        n 
stream.ReadByte()
                        
stream.ReadByte()
                        
_delay stream.ReadShort()
                        
stream.ReadByte()
                        If 
1
                            pal
[t]:&$ffffff
                            _flags 
HASALPHA
                        
EndIf
                        
stream.Seek(stream.Pos() + 4)
                        While 
True
                            n 
stream.ReadByte()
                            If 
Exit
                            
stream.Seek(stream.Pos() + n)
                        
Wend
                        
Default
                        
stream.ReadByte()
                        
stream.Seek stream.Pos() + n
                        
While True
                            n 
stream.ReadByte()
                            If 
Exit
                            
stream.Seek(stream.Pos() + n)
                        
Wend
                End Select
        End Select
    Wend
End 
Function

Function 
lzhread(stream:TStreamcurrsize)
    
Local ir
    
If bits 0
        
If bytes <= 0
            bbptr 
0
            bytes 
stream.ReadByte()
            For 
0 Until bytes
                lzhbuffer
[i] = stream.ReadByte()
            
Next
        
EndIf
        
bval lzhbuffer[bbptr]
        
bbptr:+1
        bits 
8
        bytes
:-1
    
EndIf
    
bval Shr(bits)
    While 
bits currsize
        
If bytes <= 0
            bbptr 
0
            bytes 
stream.ReadByte()
            For 
0 Until bytes
                lzhbuffer
[i] = stream.ReadByte()
            
Next
        
EndIf
        
bval lzhbuffer[bbptr]
        
bbptr:+1
        r
:|(bval Shl bits)
        
bits:+8
        bytes
:-1
    Wend
    bits
:-currsize
    
Return CODEMASK[currsize]
End Function

Function 
parsegif(pixmaps:TListstream:TStreampal:Int Ptrflagssquash False)
    
Local xywhf    'i,r,g,b,n
    Local Size, csize, topslot, Clear
    Local ending, slot, newcodes, avail, bitsleft
    Local c, code, oc, fc, sp, bptr
    Local yinc, lpass
    Local pix:TPixmap

    x = stream.ReadShort()
    y = stream.ReadShort()
    w = stream.ReadShort()
    h = stream.ReadShort()
    f = stream.ReadByte()

    yinc = 1
    If (f & 64) yinc = 8

    DebugLog "createpixmap(" + w + "," + h + ")"
    
    If flags & HASALPHA
        pix = CreatePixmap(w, h, PF_BGRA8888)
    Else
        pix = CreatePixmap(w, h, PF_BGR888)
    EndIf
    pixmaps.AddLast pix
    '    
can->SetHandle(-x,-y)
    
'    If (squash)
    '        
can->resize(w,(h+1)>>1,canflags,False)
    
'    Else
    '        
can->resize(w,h,canflags,False)
    
' image data

    Size = stream.ReadByte()'
system.debug("size="+size)
    
csize Size 1
    topslot 
1 Shl csize
    Clear 
1 Shl Size
    ending 
Clear 1
    slot 
ending 1
    newcodes 
ending 1
    bbptr 
0
    bits 
0
    bytes 
0
    bval 
0
    
    
While True
        c 
lzhread(streamcsize)
        If 
ending Exit
        If 
Clear
            csize 
Size 1
            slot 
newcodes
            topslot 
1 Shl csize
            
While True
                c 
lzhread(streamcsize)
                If 
<> Clear Exit
            
Wend
            
If ending Exit
            If 
>= slot c 0
            oc 
c
            fc 
c
            
'            If (squash)
            '                
If ((x&1)=(y&1)) WritePixel(x,y Shr 1,pal[c])
            
'            Else
            WritePixel(pix, x, y, pal[c])
            '            
EndIf
            
x:+1
            
If w
                x 
0
                y
:+yinc
                
If >= h
                    y 
4 Shr lpass
                    yinc 
2
                    lpass
:+1
                
EndIf
            EndIf
        Else
            
code c
            
If code >= slot
                code 
oc
                stack
[sp] = Short(fc)    'simon was here
                sp:+1
            EndIf
            While code >= newcodes
                stack[sp] = suffix[code]
                sp:+1
                code = prefix[code]
            Wend
            stack[sp] = Short(code)    '
simon was here
            sp
:+1
            
If slot topslot
                fc 
code
                suffix
[slot] = Short(fc)
                
prefix[slot] = Short(oc)
                
slot:+1
                oc 
c
            
EndIf
            If 
slot >= topslot And csize 12
                topslot 
topslot Shl 1
                csize
:+1
            
EndIf
            While 
sp 0
                sp
:-1
                c 
stack[sp]
                If 
squash
                    
If (1) Or (1) = (1)
                        
WritePixel(pixxy Shr 1pal[c])
                    EndIf
                Else
                    
WritePixel(pixxypal[c])
                EndIf
                
x:+1
                
If w
                    x 
0
                    y
:+yinc
                    
If >= h
                        y 
4 Shr lpass
                        yinc 
2
                        lpass
:+1
                    
EndIf
                EndIf
            
Wend
        
EndIf
    
Wend
End 
Function

Function 
LoadGif:TImage(url:Object)
    
Local stream:TStream
    Local pixmaps
:TList
    Local pix
:TPixmap
    stream 
ReadFile(url)
    If 
stream
        pixmaps 
ReadGifPixmaps(stream)
        
CloseFile stream
        
If pixmaps
            pix 
TPixmap(pixmaps.ValueAtIndex(0))
            Return 
LoadImage(pix)
        EndIf
    EndIf
End Function 


Отсюда нужна только одна ф-ция LoadGif(url:Object)
Также как и LoadImage она в качестве url может принимать стримы, пути, банки.

Ну и сам тестовый код:
SuperStrict
Import 
"gifloader.bmx"

Graphics(800600)
SetClsColor(234232211)
Cls()
AutoMidHandle(False)
SetBlend(ALPHABLEND)

Local image:TImage LoadGif(LoadBank("http::forum.boolean.name/images/chestnut/misc/logo.gif"))
Local x:Inty:Int

Repeat
    x 
0
    y 
BounceValue(0GraphicsHeight() - image.Height30)
    
DrawImage(imagexy)
    
Flip()
Until KeyHit(KEY_ESCAPE)
End

Function BounceValue:Float(_min:Float_max:Float_interval:Float 10.0)
    
Local ang:Float = (MilliSecs() / _intervalMod 360
    _max
:+1
    
Return ((_max _min) * ((Sin(ang) + 1) / 2) + _min)
EndFunction 
P.s. Отдельное спасибо Jimon`у за отличную консультацию по математике, и неоцинимую помощь при создании ф-ции BounceValue.
Вложения
Тип файла: 7z WebGif.src.7z (2.2 Кб, 678 просмотров)
Тип файла: 7z WebGif.exe.7z (622.7 Кб, 670 просмотров)
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 3070
AMD Ryzen 7 3800X 4.3Ghz; 64Gb; Nvidia 1070Ti
AMD Ryzen 7 1700X 3.4Ghz; 8Gb; AMD RX 570
AMD Athlon II 2.6Ghz; 8Gb; Nvidia GTX 750 Ti

Последний раз редактировалось Randomize, 23.09.2010 в 05:23.
(Offline)
 
Ответить с цитированием
Эти 6 пользователя(ей) сказали Спасибо Randomize за это полезное сообщение:
baton4ik (23.09.2010), Glauberov (04.08.2011), impersonalis (25.09.2010), Nex (07.02.2012), Reks888 (23.09.2010), Жека (23.09.2010)
Старый 23.09.2010, 21:00   #2
Черный крыс
 
Сообщений: n/a
Ответ: Gif файл с интернета.

ага. А все потогму, что структура хранения данных в гифах несколько отличаеться. Поэтому Марк не стал на этом заморачиватся. А формат - реально нужный, в определенных ситуациях...
 
Ответить с цитированием
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 17:11.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com