Не работает стирание изображения шара
Основная программа:
Библиотека чтения изображения:
Основная программа:
Код: Выделить всё
// ==================================================================
// Bonker.
//
// I'm not quite sure what this is supposed to be.
//
// Adaptado por Galileo en 3/2011 de un programa en NaaLaa
// ==================================================================
clear screen
import image
open window 640,480
backcolor 0,0,0
clear window
fondo$ = getbit$(0,0,32,32)
GetImage(1,"ball.bmp")
DisplayImage(1,0,0)
bola$ = getbit$(0,0,32,32)
clear window
// Global variables =================================================
// Objects.
OBJ_X = 0
OBJ_Y = 1
OBJ_DX = 2
OBJ_DY = 3
vObjCount = 3
dim vObjects(vObjCount,4)
dim vObjCol(vObjCount,vObjCount)
dim vObjColors(vObjCount,3)
// Images.
BALL_IMAGE = 0
// Init =============================================================
InitObjects()
print "Click anywhere to make nearby balls move!"
// Main loop ========================================================
repeat
pulsa$ = inkey$(.001)
xMouse = mousex(pulsa$)
yMouse = mousey(pulsa$)
if antxMouse <> xMouse or antyMouse <> antyMouse then
// Bonk when user clicks.
if mouseb(pulsa$) = 1 then
Bonk(xMouse, yMouse, 100.0)
endif
antxMouse = xMouse
antyMouse = yMouse
end if
// Update objects.
// DeleteObjects()
UpdateObjects()
// Draw.
// clear window
DrawObjects()
until(pulsa$ = "esc")
end
// ==================================================================
// Init objects.
// ==================================================================
sub InitObjects()
local i
for i = 0 to vObjCount - 1
vObjects(i,OBJ_X) = 16 + ran(640 - 32)
vObjects(i,OBJ_Y) = 16 + ran(480 - 32)
vObjects(i,OBJ_DX) = 0.0
vObjects(i,OBJ_DY) = 0.0
vObjColors(i,0) = 64 + ran(255 - 64)
vObjColors(i,1) = 64 + ran(255 - 64)
vObjColors(i,2) = 64 + ran(255 - 64)
next
end sub
// ==================================================================
// Bonk.
// ==================================================================
sub Bonk(x, y, strength)
local i, dx, dy, d, k
for i = 0 to vObjCount - 1
dx = vObjects(i,OBJ_X) - x
dy = vObjects(i,OBJ_Y) - y
d = sqrt(dx*dx + dy*dy)
if d < strength then
force = strength - d
k = 1.0/d
dx = dx*k*force*0.1
dy = dy*k*force*0.1
vObjects(i,OBJ_DX) = vObjects(i,OBJ_DX) + dx
vObjects(i,OBJ_DY) = vObjects(i,OBJ_DY) + dy
endif
next i
end sub
// ==================================================================
// Update objects.
//
// Most of the things in this sub are very simplified and some
// times completely wrong.
// ==================================================================
sub UpdateObjects()
local i, j, m(2), n(2), vi(2), vj(2)
// Update positions and speeds.
for i = 0 to vObjCount - 1
vObjects(i,OBJ_X) = vObjects(i,OBJ_X) + vObjects(i,OBJ_DX)
vObjects(i,OBJ_Y) = vObjects(i,OBJ_Y) + vObjects(i,OBJ_DY)
if vObjects(i,OBJ_X) < 16.0 then
vObjects(i,OBJ_X) = 16.0
vObjects(i,OBJ_DX) = abs(vObjects(i,OBJ_DX))*0.8
elseif vObjects(i,OBJ_X) > 624.0 then
vObjects(i,OBJ_X) = 624.0
vObjects(i,OBJ_DX) = -abs(vObjects(i,OBJ_DX))*0.8
endif
if vObjects(i,OBJ_Y) < 16.0 then
vObjects(i,OBJ_Y) = 16.0
vObjects(i,OBJ_DY) = abs(vObjects(i,OBJ_DY))*0.8
elseif vObjects(i,OBJ_Y) > 464.0 then
vObjects(i,OBJ_Y) = 464.0
vObjects(i,OBJ_DY) = -abs(vObjects(i,OBJ_DY))*0.8
endif
vObjects(i,OBJ_DX) = vObjects(i,OBJ_DX)*0.99
vObjects(i,OBJ_DY) = vObjects(i,OBJ_DY)*0.99
next
// Deal with collisions.
for i = 0 to vObjCount - 2
for j = i + 1 to vObjCount - 1
dx = vObjects(i,OBJ_X) - vObjects(j,OBJ_X)
dy = vObjects(i,OBJ_Y) - vObjects(j,OBJ_Y)
if abs(dx) < 32.0 and abs(dy) < 32.0 then
d = sqrt(dx*dx + dy*dy)
if d < 32.0 and d > 0.0 then
if vObjCol(i,j) = false then
m(0) = dx : m(1) = dy
vNormalize(m(), n())
m(0) = vObjects(j,OBJ_DX)
m(1) = vObjects(j,OBJ_DY)
reflectedVector(vObjects(i,OBJ_DX), vObjects(i,OBJ_DY), n(0), n(1), vSize(m()), vi())
vScale(n(), -1.0, n())
m(0) = vObjects(i,OBJ_DX)
m(1) = vObjects(i,OBJ_DY)
reflectedVector(vObjects(j,OBJ_DX), vObjects(j,OBJ_DY), n(0), n(1), vSize(m()),vj())
vObjects(i,OBJ_DX) = vi(0)
vObjects(i,OBJ_DY) = vi(1)
vObjects(j,OBJ_DX) = vj(0)
vObjects(j,OBJ_DY) = vj(1)
vObjCol(i,j) = true
endif
else
vObjCol(i,j) = false
endif
else
vObjCol(i,j) = false
endif
next j
next i
end sub
// ==================================================================
// Delete objects.
// ==================================================================
sub DeleteObjects()
local i
// Balls.
for i = 0 to vObjCount - 1
putbit fondo$ to int(vObjects(i,OBJ_X)) - 16, int(vObjects(i,OBJ_Y)) - 16,"solid"
next i
end sub
// ==================================================================
// Draw objects.
// ==================================================================
sub DrawObjects()
local i
// Remove Balls.
for i = 0 to vObjCount - 1
putbit bola$ to int(vObjects(i,OBJ_X)) - 16, int(vObjects(i,OBJ_Y)) - 16,"transparent"
next i
end sub
// ==================================================================
// Some subs for 2D vectors.
// ==================================================================
sub vAdd(a(), b(), r())
r(0) = a(0) + b(0)
r(1) = a(1) + b(1)
end sub
sub vSub(a(), b(), r())
r(0) = a(0) - b(0)
r(1) = a(1) - b(1)
end sub
sub vNormalize(a(),r())
local k
k = 1.0/sqrt(a(0)*a(0) + a(1)*a(1))
r(0) = a(0)*k
r(1) = a(1)*k
end sub
sub vDot(a(), b())
return a(0)*b(0) + a(1)*b(1)
end sub
sub vScale(a(), k, r())
r(0) = a(0)*k
r(1) = a(1)*k
end sub
sub vSize(a())
return sqrt(a(0)*a(0) + a(1)*a(1))
end sub
sub reflectedVector(x, y, nx, ny, force, r())
local s, pra(2), prb(2), p(2), b(2), d1(2), d2(2), d3(2)
pra(0) = x
pra(1) = y
prb(0) = nx
prb(1) = ny
s = vDot(pra(), prb())
if s < 0.0 then
x = -x
y = -y
pra(0) = x
pra(1) = y
s = vDot(pra(), prb())
endif
vScale(prb(), s, p())
vSub(p(), pra(), b())
vAdd(p(), b(), d1())
vScale(prb(), force*0.75, d2())
vScale(d1(), 0.25, d3())
vAdd(d2(),d3(),r())
end sub
Код: Выделить всё
# Library image.yab, routines for handling images in several formats
# programmed by Hermang Hialino Mansilla Mattos, hh_mm@yahoo.com
# last modified on May 30, 2006
# graphic formats supported: 8bit pcx, bmp and 24bit bmp
# it detects the format based on the filename extension or file's header
# Useful routines:
# err=GetImage( index , filename$ )
# DrawImage( index , dx,dy )
# from the main program you can change the variable image.Path$
// import gif
// ==========================================
Path$ = "" : // path from where to load images
Error$ = ""
ValidExt$ = "bmp,pcx,lss,gif,bin" : // 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)
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)
// only bmps for now
if Ext$(index) = "bmp" DrawBMP(Filename$(index),dx,dy)
if Ext$(index) = "pcx" DrawPCX(Filename$(index),dx,dy)
// 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
// ? "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
// seek #fp,2
// 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
// Read the Color Palette of 8bit BMP file already opened
// loads color values and stores them in Palette()
// values start at byte 55 in the file. Four bytes are stored
// for each color, three for the blue, green and red values
// 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
// 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
// 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)
// ************ 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
// ************ READ Run Length Encoded Pixel Data ********
seek #fp, 128
// for i = 0 to flength-128-768
// rle(i) = peek(#fp)
// 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 : // DrawPCX()
// ========================================
sub DrawGIF()
// not ready yet !
end sub
sub DrawLSS()
// not ready yet !
end sub