[object Object]
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,361
Написано 2,473 полезных сообщений (для 6,856 пользователей)
|
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.
|