На этом примере мультяшный медведь ходит по картинке с лесом.
Код библиотеки image.yab
Основной код программы:
Результат работы:
Дополнительный файлы:
Код библиотеки image.yab
Код: Выделить всё
doc Library image.yab, routines for handling images in several formats
doc programmed by Hermang Hialino Mansilla Mattos, hh_mm@yahoo.com
doc last modified on May 30, 2006
doc graphic formats supported: 8bit pcx, bmp and 24bit bmp
doc it detects the format based on the filename extension or file's header
doc Useful routines:
doc err=GetImage( index , filename$ )
doc DrawImage( index , dx,dy )
doc from the main program you can change the variable image.Path$
rem import gif
rem ==========================================
Path$ = "" : rem path from where to load images
Error$ = ""
ValidExt$ = "bmp,pcx,lss,gif,bin" : rem soon gif, jpg, xbm, xpm
mp = 32
Dim Filename$(mp), Ext$(mp)
Dim Widths(mp), Heights(mp), bpps(mp)
Dim Offsets(mp)
Offset = 0
Width = 0
Height = 0
bpp = 0
Dim Palette(256*4)
export sub Width()
return Width
end sub
export sub Height()
return Height
end sub
sub GetExt$(filename$)
local i
i = rinstr(filename$, ".")
if i > 0 then
i = len(filename$) - i
return(lower$(right$(filename$, i)))
else
return ""
end if
end sub
Export sub GetImage(index, filename$)
local fp, ext$
if index < 0 and index > mp then
Error$ = "invalid index"
return -1
end if
ext$ = GetExt$(filename$)
if instr(ValidExt$, ext$) then
fp = open( Path$+filename$ , "rb" )
if fp < 1 then
Error$ = "File "+filename$+" Does not Exist in path "+Path$
return -1
end if
Filename$(index) = Path$+filename$
Ext$(index) = ext$
close(fp)
else
Error$ = "La extensión '"+ext$+"' no es válida."
return -1
end if
return 1
end sub
Export sub DisplayImage(index, dx , dy)
rem only bmps for now
if Ext$(index) = "bmp" DrawBMP(Filename$(index),dx,dy)
if Ext$(index) = "pcx" DrawPCX(Filename$(index),dx,dy)
rem Work in Progress :
if Ext$(index) = "lss" DrawLSS(Filename$(index),dx,dy)
if Ext$(index) = "gif" DrawGIF(Filename$(index),dx,dy)
end sub
Export sub DrawImage(fn$, dx, dy)
tmp = GetImage(0, fn$)
DisplayImage(0, dx, dy)
end sub
Sub Report()
? "ImageWidth = " , Width
? "ImageHeight = " , Height
? "BitsPerPixel=" , bpp
? "ImageOffset = " , Offset
rem ? "FileSize = " , FileSize
? "Last Error = ", Error$
End Sub
export sub DrawBMP( bmpfile$, dx,dy )
local fp, k, row, col, byte, blue, green
Error$=""
fp = open(bmpfile$,"rb")
if fp < 1 then
Error$ = "File "+bmpfile$+" Does not Exist"
return -1
end if
rem seek #fp,2
rem FileSize=peek(fp)+256*peek(fp)+65536*(peek(fp)+256*peek(fp))
seek #fp,10 : Offset = peek(fp)+256*peek(fp)
seek #fp,18 : Width = peek(fp)+256*peek(fp)
seek #fp,22 : Height = peek(fp)+256*peek(fp)
seek #fp,28
bpp = peek(fp)
IF bpp = 8 THEN
rem Read the Color Palette of 8bit BMP file already opened
rem loads color values and stores them in Palette()
rem values start at byte 55 in the file. Four bytes are stored
rem for each color, three for the blue, green and red values
rem and one which is not used.
seek #fp,55-1
for c = 0 to 1023
Palette(c) = peek(fp)
next c
seek #fp,Offset
for row = 1 to Height
FOR col = 1 to Width
byte = 4*peek(fp)
color Palette(byte+2),Palette(byte+1),Palette(byte)
dot dx+col,dy+Height+1-row
NEXT col
rem adjust extra bytes
c = Width
while(mod(c,4)<>0)
tmp = peek(fp)
c = c+1
wend
next row
ELSIF bpp = 24 THEN
seek #fp,54
for row = 1 to Height
FOR col = 1 to Width
blue = peek(fp)
green = peek(fp)
color peek(fp),green,blue
dot dx+col,dy+Height+1-row
NEXT col
rem adjust extra bytes
c = Width*3
while(mod(c,4)<>0)
tmp = peek(fp)
c = c+1
wend
next row
END IF
close fp
end sub
Export Sub DrawPCX(pcxfile$, dx, dy )
local fp, i, flength
local x, y, idx, pix, rle, debug
fp = open(pcxfile$,"rb")
seek #fp, 8
Width = peek(fp)+256*peek(fp)
Height = peek(fp)+256*peek(fp)
REM ************ GO TO END TO CHECK FILESIZE AND READ PALETTE *******
seek #fp, 0, "end"
flength = tell(#fp)
seek #fp, -768 ,"end"
for i = 0 to 767
Palette(i) = peek(#fp)
next i
REM ************ READ Run Length Encoded Pixel Data ********
seek #fp, 128
rem for i = 0 to flength-128-768
rem rle(i) = peek(#fp)
rem next i
idx = 0
for y = 0 to Height
x = 0
while(x <= Width)
pix = peek(#fp)
if pix > 192 then
rle = pix-192
pix = 3*peek(#fp)
color Palette(pix), Palette(pix+1), Palette(pix+2)
if x+rle > Width+1 then
line dx+x,dy+y to dx+Width, dy+y
y = y+1
x = x+rle-Width-1
line dx,dy+y to dx+x,dy+y
else
line dx+x,dy+y to dx+x+rle,dy+y
x = x+rle
end if
else
color Palette(3*pix), Palette(3*pix+1), Palette(3*pix+2)
dot dx+x,dy+y
x = x+1
end if
wend
next y
close(fp)
End Sub : rem DrawPCX()
rem ========================================
sub DrawGIF()
rem not ready yet !
end subPulsar las teclas de cursor izquierda y derecha para mover a Yogui.
sub DrawLSS()
rem not ready yet !
end sub
Код: Выделить всё
#!/usr/bin/yabasic
rem Program Name: Animación.yab
rem Author: Galileo, 8/2010
rem
rem Purpose: Ejemplo de animación, tipo "sprite"
rem TODO: Add Code!
dim foto$(2,8)
let R=1 : let L=2
import image
clear screen
open window 352, 288
backcolor 255,0,0
open "yogui" for reading as #1
for n = 0 to 8
line input #1 foto$(1,n)
line input #1 foto$(2,n)
next n
close #1
GetImage(1,"Yellowstone.bmp")
DisplayImage(1,0,0)
let altura = 220
let i=0: let n=40: let direc=R: paso = 5: pie=1
fondo$ = getbit$(n,altura to n+36,altura+36)
putbit foto$(direc,1) to n,altura,"transparent"
print "Pulsar las teclas de cursor izquierda y derecha para mover a Yogui."
bucle()
close window
exit
sub bucle()
repeat
let i = i + 1
if i > 8 then i = 1 end if
tecla$ = inkey$
switch tecla$
case "left": let direc = L : paso = -5 : camina() : break
case "right": let direc = R : paso = 5 : camina() : break
end switch
until(tecla$ = "esc")
end sub
sub camina()
dapaso(pie) : if pie > 1 then pie = 1 else pie = 2 end if
end sub
sub dapaso(pie)
putbit fondo$ to n,altura,"solid"
if pie = 1 then
restore pierna1
else
restore pierna2
end if
for x=1 to 5
n = n + paso
if n > 335 then
n = 0
elseif n < 0 then
n = 335
end if
read foto
fondo$ = getbit$(n,altura to n+36,altura+36)
putbit foto$(direc,foto) to n,altura,"transparent"
pause .1
if x < 5 then putbit fondo$ to n,altura,"solid" end if
next x
end sub
label pierna1
data 1,2,3,4,1
label pierna2
data 1,6,7,8,1