|
[object Object]
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,374
Написано 2,478 полезных сообщений
(для 6,866 пользователей)
|
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 bbptr, bits, bytes, bval
Function ReadGifPixmaps:TList(stream:TStream)
Local pixmaps:TList = New TList
Local pal:Int Ptr
Local bgcol
Local aspect
Local i, r, g, b, w, h, f, n, t
Local _delay, _start, _end, _loop, _flags
Local hdr:Byte[6]
If stream.Read(hdr, 6) <> 6 Return
If hdr[0] <> Asc("G") Or hdr[1] <> Asc("I") Or hdr[2] <> Asc("F") Return
w = stream.ReadShort()
h = stream.ReadShort()
f = stream.ReadByte()
bgcol = stream.ReadByte()
aspect = stream.ReadByte()
If f & 128
n = 2Shl(f & 7)
pal = New Int[n]
For i = 0 Until n
r = stream.ReadByte()
g = stream.ReadByte()
b = 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(pixmaps, stream, pal, 0)
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()
f = stream.ReadByte()
_delay = stream.ReadShort()
t = stream.ReadByte()
If f & 1
pal[t]:&$ffffff
_flags = HASALPHA
EndIf
stream.Seek(stream.Pos() + n - 4)
While True
n = stream.ReadByte()
If n = 0 Exit
stream.Seek(stream.Pos() + n)
Wend
Default
n = stream.ReadByte()
stream.Seek stream.Pos() + n
While True
n = stream.ReadByte()
If n = 0 Exit
stream.Seek(stream.Pos() + n)
Wend
End Select
End Select
Wend
End Function
Function lzhread(stream:TStream, currsize)
Local i, r
If bits = 0
If bytes <= 0
bbptr = 0
bytes = stream.ReadByte()
For i = 0 Until bytes
lzhbuffer[i] = stream.ReadByte()
Next
EndIf
bval = lzhbuffer[bbptr]
bbptr:+1
bits = 8
bytes:-1
EndIf
r = bval Shr(8 - bits)
While bits < currsize
If bytes <= 0
bbptr = 0
bytes = stream.ReadByte()
For i = 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 r & CODEMASK[currsize]
End Function
Function parsegif(pixmaps:TList, stream:TStream, pal:Int Ptr, flags, squash = False)
Local x, y, w, h, f '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(stream, csize)
If c = ending Exit
If c = Clear
csize = Size + 1
slot = newcodes
topslot = 1 Shl csize
While True
c = lzhread(stream, csize)
If c <> Clear Exit
Wend
If c = ending Exit
If c >= 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 x = w
x = 0
y:+yinc
If y >= h
y = 4 Shr lpass
yinc = y * 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 (y = h - 1) Or (x & 1) = (y & 1)
WritePixel(pix, x, y Shr 1, pal[c])
EndIf
Else
WritePixel(pix, x, y, pal[c])
EndIf
x:+1
If x = w
x = 0
y:+yinc
If y >= h
y = 4 Shr lpass
yinc = y * 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(800, 600)
SetClsColor(234, 232, 211)
Cls()
AutoMidHandle(False)
SetBlend(ALPHABLEND)
Local image:TImage = LoadGif(LoadBank("http::forum.boolean.name/images/chestnut/misc/logo.gif"))
Local x:Int, y:Int
Repeat
x = 0
y = BounceValue(0, GraphicsHeight() - image.Height, 30)
DrawImage(image, x, y)
Flip()
Until KeyHit(KEY_ESCAPE)
End
Function BounceValue:Float(_min:Float, _max:Float, _interval:Float = 10.0)
Local ang:Float = (MilliSecs() / _interval) Mod 360
_max:+1
Return ((_max - _min) * ((Sin(ang) + 1) / 2) + _min)
EndFunction
P.s. Отдельное спасибо Jimon`у за отличную консультацию по математике, и неоцинимую помощь при создании ф-ции BounceValue.
__________________
Retry, Abort, Ignore? █
Intel Core i7-9700 4.70 Ghz; 64Gb; Nvidia RTX 4090 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.
|
23.09.2010, 01:34
