|
2D-программирование Вопросы, касающиеся двумерного программирования |
07.10.2013, 21:51
|
#1
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
некоторые изометрические демки
Зажать ЛМ кнопку мыши и поводить в прямоугольнике ... немного подождать секунд эдак 2-5 ... пятна постепенно начнут исчезать
maxX = 300 : maxY= 150
Dim c#(maxX ,maxY)
Graphics 800,600,32,2
SetBuffer BackBuffer()
c(90,10)= 20
While Not KeyHit(1)
Cls
mx = MouseX() : my=MouseY() : z= Abs(MouseZ () )+12
If KeyHit(2) Then q= Not q
If MouseDown(1) Then md=1 Else md=0
For y= 1 To maxY
For x=1 To maxX
If x<maxX And x>0 And y<maxY And y>0
If Int( ((mx - x)^2 + (my - y)^2)^.5 )<= z Then
If md=1
If q=0 Then c(x,y)= c(x,y)+1
If q=1 Then c(x,y)= c(x,y)-2
EndIf
If c(x,y)> 255 Then c(x,y)=255
Color 222,222,222
Plot x,y
EndIf
EndIf
Next
Next
Color 222,222,222
Rect 0,0,maxX ,maxY,0
;If md=0
For y= 1 To maxY
For x=1 To maxX
co = 10+c(x,y)
If co>255 Then co =255
Color co,co,co
If co<=0 Then co =0 :Color 0,0,255
;Plot 200+x-y,200+y-c(x,y)
;Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y+4-c(x,y)
;For z=1 To 20
; If Int( ((mx - x)^2 + (my - y)^2)^.5 )<= z And md=1
If x<maxX And x>0 And y<maxY And y>0
If c(x,y) > c(x-1,y-1) Then c(x,y)=( c(x,y)+ c(x-1,y-1))/2 :Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y-c(x-1,y-1)
If c(x,y) > c(x-1,y+1) Then c(x,y)=( c(x,y)+ c(x-1,y+1))/2 : Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y-c(x-1,y+1)
If c(x,y) > c(x+1,y-1) Then c(x,y)=( c(x,y)+c(x+1,y-1))/2 :Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y- c(x+1,y-1)
If c(x,y) > c(x+1,y+1) Then c(x,y)=( c(x,y) + c(x+1,y+1))/2 :Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y-c(x+1,y+1)
If c(x,y) > c(x,y-1) Then c(x,y)=( c(x,y)+c(x,y-1))/2 :Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y-c(x,y-1)
If c(x,y) > c(x,y+1) Then c(x,y)=( c(x,y)+ c(x,y+1))/2 :Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y-c(x,y+1)
If c(x,y) > c(x-1,y) Then c(x,y)=( c(x,y)+ c(x-1,y))/2 :Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y-c(x-1,y)
If c(x,y) > c(x+1,y) Then c(x,y)=( c(x,y)+c(x+1,y))/2 : Line 200+x-y,200+y-c(x,y) , 200+x-y,200+y- c(x+1,y)
; EndIf
EndIf
Next
Next
Color 222,222,222
Text 300,20,"Q "+q
Flip
Wend
End
__________________
Мой проект здесь
|
(Offline)
|
|
07.10.2013, 22:02
|
#2
|
Элита
Регистрация: 21.01.2010
Адрес: Россия, Рязанская область, г.Михайлов
Сообщений: 2,067
Написано 1,185 полезных сообщений (для 2,828 пользователей)
|
Ответ: некоторые изометрические демки
Мой настольный ПеКа чуть не погиб
__________________
Main PC:
Intel Core i5 4260U 1.44 GHz + LPDDR3 1x4096 1600 MHz + Intel HD Graphics 5000.
Asus Ёжик T101-MT:
Intel Atom N-570 1.66 Ghz + DDR2 2x1024 800 Mhz + Intel GMA 3150 128 Mb DDR2
Скачать Doom 2D: Remake v0.3.8a
|
(Offline)
|
|
08.10.2013, 12:42
|
#3
|
Быдлокодер
Регистрация: 05.07.2009
Адрес: Проспит
Сообщений: 5,024
Написано 2,312 полезных сообщений (для 5,349 пользователей)
|
Ответ: некоторые изометрические демки
Мой ПеКа конечно не загнулся, но код очень тормознутый.
|
(Offline)
|
|
08.10.2013, 16:10
|
#4
|
.
Регистрация: 05.08.2006
Сообщений: 10,429
Написано 3,454 полезных сообщений (для 6,863 пользователей)
|
Ответ: некоторые изометрические демки
А можно скрины хоть прикладывать?
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
08.10.2013, 16:49
|
#5
|
Быдлокодер
Регистрация: 05.07.2009
Адрес: Проспит
Сообщений: 5,024
Написано 2,312 полезных сообщений (для 5,349 пользователей)
|
Ответ: некоторые изометрические демки
|
(Offline)
|
|
Эти 2 пользователя(ей) сказали Спасибо Arton за это полезное сообщение:
|
|
08.10.2013, 21:08
|
#6
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: некоторые изометрические демки
Прокрутить колёсико мыши в прямоугольнике ... Зажать ЛМ кнопку мыши и держать некоторое время постепенно поводя по прямоугольнику ...
И увидеть как растут горы
Dim c(100 ,50) : Dim s(12 ,12 )
Global mx ,my , mz , mzz , md , q
Graphics 800,600,32,2
SetBuffer BackBuffer()
k=1
For b= 1 To 12
For a=1 To 12
c(a,b)= Rand(0,1)
s(a,b)= Rand(0,255)
Next
Next
ClsColor 222,222,222
While Not KeyHit(1)
mx = MouseX() : my=MouseY() : mz = Abs(MouseZ () )+1
Cls
If mx>1 And mx<100 And my>1 And my<50
Color 115,115,115
Line mx,0,mx,50
Line 0,my,100,my
Color 255,5,5
Oval mx-mz+0.5,my-mz+0.5 ,mz*2,mz*2,0
EndIf
If MouseDown(1) Then md=1 Else md=0
If KeyHit(2) Then q= Not q
module()
Draw()
Color 55,55,55
Rect 0,0,100,50,0
Text 100,20,"mz = "+mz +" q = "+q
Flip
Wend
End
Function module()
For y= 1 To 50
For x=1 To 100
For z=0 To mz
If Int( ((mx - x)^2 + (my - y)^2)^.5 ) = z Then
col1 = mz-z
If md=1 And q=0 Then c(x,y) =c(x,y)+ ((mz-z )*0.2)
If md=1 And q=1 Then c(x,y) =c(x,y)- ((mz-z )*0.2)
If col1>255 Then col1 =255
If c(x,y)<=1 Then c(x,y) =1
; Color col1,col1,col1
; Plot x,y-z1
EndIf
Next
Next
Next
End Function
Function Draw()
For y= 1 To 50
For x=1 To 100
col3=c(x,y)
If col3>255 Then col3=255
Color col3,col3,col3
If col3<=1 Then Color 0,0,100
; Plot 100+x+y,100+y-c(x,y)
Line 100+x+y,100+y-c(x,y) , 100+x+y,100+y+c(x,y)
For z=0 To mz
If Int( ((mx - x)^2 + (my - y)^2)^.5 ) = z Then
col2 = 20+z*4
If col2>255 Then col2 =255
Color col2,col2,col2
If col2<=1 Then Color 0,0,250
; Plot 100+x+y,100+y-c(x,y)
Line 100+x+y,100+y-c(x,y) , 100+x+y,100+y+c(x,y)
EndIf
Next
Next
Next
End Function
Function DistABS(ax,ay,bx,by)
Return (Abs(bx-ax)+Abs (by-ay))
End Function
__________________
Мой проект здесь
|
(Offline)
|
|
08.10.2013, 21:12
|
#7
|
Задрот
Регистрация: 24.07.2009
Адрес: Ивановская область, г. Кинешма
Сообщений: 1,574
Написано 407 полезных сообщений (для 863 пользователей)
|
Ответ: некоторые изометрические демки
Я медленно покрутил колёсиком мыши в прямоугольнике...
Сильно стиснув другой рукой ЛКМ, я поводил ею по прямоугольнику, оу..
Прямоугольник был доволен
|
(Offline)
|
|
08.10.2013, 21:28
|
#8
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: некоторые изометрические демки
Ага , я сам тащюсь .
всё тоже самое но по другому
Чур на чёрный кружочек не смотреть , он стесняется .
maxX = 100 : maxY= 100
Dim c#(maxX ,maxY)
Graphics 800,600,32,2
SetBuffer BackBuffer()
s=10
;c(90,10)= 20
ClsColor 152,251,152
While Not KeyHit(1)
Cls
mx = MouseX() : my=MouseY() : z= Abs(MouseZ () )+1
mmy= (2*my-mx)/2
mmx= mx+mmy
If KeyHit(2) Then q= Not q
If KeyHit(57) Then flips=Not flips
If MouseDown(1) Then md=1 Else md=0
Color 60,179,113
Rect s,s,maxX ,maxY,1
For y= 1 To maxY ;Step 2
For x=1 To maxX ;Step 2
If x+s<=maxX+s And x+s>=0 And y+s<=maxY+s And y+s>=0 Then
If Int( (((mx+s )-( x+s))^2 + ((my+s) -( y+s))^2)^.5 )= z ;And md=1
Color 222,222,222
Plot x+s,y+s
If md=1
If q=0 Then c(x,y)= c(x,y)+Rnd(3)
If q=1 Then c(x,y)= c(x,y)-Rnd(3)
If c(x,y)> 255 Then c(x,y)=255
If c(x,y)<=0 Then c(x,y)=0
EndIf
EndIf
EndIf
Next
Next
;If md=0
For y= 1 To maxY ;Step 2
For x=1 To maxX ;Step 2
If flips=0 Then frontX= 200+(x-y) : frontY= 300+((x+y)/2) Else frontX=(200+maxX)+ (-x-y) : frontY= (300+maxY /2)+((-x+y)/2)
co = 50+c(x,y)
If co>255 Then co =255
If co<=0 Then
co=0
Color 0,0,255
Plot 200+frontX,200+frontY-c(x,y)
Else
Color co,co,co
Line frontX,frontY-c(x,y) , frontX,frontY-c(x,y) +5
EndIf
If Int( ((mx - x)^2 + (my - y)^2)^.5 )<= z
If x+1<=maxX And x-1>=0 And y+1<=maxY And y-1>=0 And md=1
If c(x,y) > c(x-1,y-1) Then c(x-1,y-1)=c(x,y)- 2
If c(x,y) > c(x-1,y+1) Then c(x-1,y+1)=c(x,y)- 2
If c(x,y) > c(x+1,y-1) Then c(x+1,y-1)=c(x,y)-2
If c(x,y) > c(x+1,y+1) Then c(x+1,y+1)=c(x,y)-2
If c(x,y) > c(x,y-1) Then c(x,y-1)=c(x,y)- 1
If c(x,y) > c(x,y+1) Then c(x,y+1)=c(x,y)- 1
If c(x,y) > c(x-1,y) Then c(x-1,y)=c(x,y)- 1
If c(x,y) > c(x+1,y) Then c(x+1,y)=c(x,y)-1
EndIf
EndIf
Next
Next
Color 22,22,22
Oval 200+mmx-3,300+mmy-3,6,6,1
Text 300,20,"Q "+q+" flips = "+ flips
Flip
Wend
End
Function DistABS(ax,ay,bx,by)
Return (Abs(bx-ax)+Abs (by-ay))
End Function
__________________
Мой проект здесь
|
(Offline)
|
|
14.10.2013, 19:39
|
#9
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: некоторые изометрические демки
Думаю немного наглядных примеров действий с векторами под блитз ,не помешаеют.
Статья донор здесь и здесь , а так же там много разных примеров .
; наглядное изображение векторов
Type Vector
Field X# , Y# , L# , vX# , vY#
End Type
Graphics 800,600,32,2
SetBuffer BackBuffer()
ArialCyrFont = LoadFont ("Arial cyr",16)
SetFont ArialCyrFont
qx1# = 200 : qy1# = 200
qx2# = 220 : qy2# = 350
F.Vector= Vector(qx1,qy1,qx2,qy2)
VectorNormalize(F)
F1.Vector= VectorClone(F)
F2.Vector= VectorClone(F)
F3.Vector= VectorClone(F)
VectorLeft(F2)
VectorRight(F1)
VectorReverse(F3)
While Not KeyHit(1)
mx# = MouseX() : my# = MouseY()
Cls
Color 120,120,120
If Dist( qx1,qy1,mx,my)<10 And MouseDown(1)
qx1= mx : qy1=my
Oval mx-10,my-10, 20,20,0
Else
Rect qx1-5,qy1-5, 10,10,0
EndIf
If Dist( qx2,qy2,mx,my)<10 And MouseDown(1)
qx2= mx : qy2=my
Oval mx-10,my-10, 20,20,0
VectorReverseClone(F3,F)
Else
Rect qx2-5,qy2-5, 10,10,0
EndIf
VectorUpdata(F, qx1,qy1,qx2,qy2)
VectorCloneUpdata(F1 , F)
VectorCloneUpdata(F2 , F)
VectorCloneUpdata(F3 , F)
VectorLeft(F2)
VectorRight(F1)
VectorReverseClone(F3,F)
VectorDraw(F,qx1,qy1,255,0,0)
VectorDraw(F1,qx1,qy1,0,0,255)
VectorDraw(F2,qx1,qy1,0,255,0)
VectorDraw(F3,qx1,qy1,150,150,150)
Text 20,20,"Навести мышь на квадрат и удерживая нажатой левую кнопку мыши, затем "
Text 20,40,"переместить стрелку мыши в новую позицию"
Flip
Wend
Delete Each Vector
FreeFont ArialCyrFont
End
Function VectorDraw(a.Vector ,X1# , Y1# , R=255, G=255, B=255)
Color R,G,B
Line X1 ,Y1 , X1+ a\X*a\L , Y1+a\Y*a\L
Oval X1+a\X*a\L-2,Y1+ a\Y*a\L-2,3,3,1
Color 255,255,255
Line X1 ,Y1 , X1+ a\X*5 , Y1+a\Y*5
End Function
Function VectorClone.Vector(a.Vector)
Local v.Vector = New Vector
v\X = a\X
v\Y = a\Y
v\L = a\L
Return v
End Function
Function Vector.Vector(X1#=0,Y1#=0,X2#=0,Y2#=0)
Local v.Vector = New Vector
v\X = X2 -X1
v\Y = Y2 -Y1
v\vX = v\X
v\vY = v\Y
Return v
End Function
Function VectorUpdata(a.Vector , X1#=0,Y1#=0,X2#=0,Y2#=0)
a\X = X2 -X1
a\Y = Y2 -Y1
a\vX = a\X
a\vY = a\Y
a\L = VectorMagnitude#(a)
VectorNormalize(a)
End Function
Function VectorCloneUpdata(a.Vector , b.Vector)
a\X =b\X
a\Y = b\Y
a\vX = b\vX
a\vY = b\vY
a\L = b\L
End Function
Function VectorAdd(a.Vector,b.Vector)
a\X =a\X + b\X
a\Y =a\Y + b\Y
End Function
Function VectorRight(a.Vector)
Local cX# , cY#
cX= -a\X : cY = a\Y
a\X =cY
a\Y =cX
End Function
Function VectorLeft(a.Vector)
Local cX# , cY#
cX= a\X : cY = -a\Y
a\X =cY
a\Y =cX
End Function
Function VectorReverse(a.Vector)
Local cX# , cY#
cX= -a\X : cY = -a\Y
a\X =cX
a\Y =cY
End Function
Function VectorReverseClone(a.Vector,b.Vector)
a\X =-b\X
a\Y =-b\Y
End Function
Function VectorSubtract(a.Vector,b.Vector)
a\X =a\X - b\X
a\Y =a\Y - b\Y
End Function
Function VectorSum.Vector(a.Vector,b.Vector)
Return Vector(a\X+b\X,a\Y+b\Y)
End Function
Function VectorDifference.Vector(a.Vector,b.Vector)
Return Vector(a\X-b\X,a\Y-b\Y)
End Function
Function VectorMultiply(a.Vector,b.Vector)
a\X =a\X * b\X
a\Y =a\Y * b\Y
End Function
Function VectorDivide(a.Vector,b.Vector)
a\X =a\X / b\X
a\Y =a\Y / b\Y
End Function
Function VectorProduct.Vector(a.Vector,b.Vector)
Return Vector(a\X*b\X,a\Y*b\Y)
End Function
Function VectorQuotient.Vector(a.Vector,b.Vector)
Return Vector(a\X/b\X,a\Y/b\Y)
End Function
Function VectorCross(a.Vector,b.Vector)
Return (a\X*b\Y)-(a\Y*b\X)
End Function
Function VectorDot#(a.Vector,b.Vector)
Return (a\X*b\X) + (a\Y*b\Y)
End Function
Function VectorAngle#(a.Vector,b.Vector)
Local d# = VectorDot(a,b)
Local m# = VectorMagnitude(a)*VectorMagnitude(b)
Return ACos(d#/m#)
End Function
Function VectorNormalize(a.Vector)
Local m# = VectorMagnitude(a)
If m<= 0.0001Then m=1
a\X = a\X / m#
a\Y = a\Y / m#
End Function
Function VectorMagnitude#(a.Vector)
a\L = Sqr(a\X*a\X + a\Y*a\Y)
Return a\L
End Function
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
; наглядное изображение векторов
Type Vector
Field X# , Y# , L# , vX# , vY#
Field px# , py# ,px2# , py2#
End Type
Global qx1#,qy1#
Graphics 800,600,32,2
SetBuffer BackBuffer()
ArialCyrFont = LoadFont ("Arial cyr",16)
SetFont ArialCyrFont
qx1# = 300 :qx2# = 290
qy1# = 50 : qy2# = 120
F.Vector= Vector(qx1,qy1,qx2,qy2)
;VectorNormalize(F)
F1.Vector= Vector(250,250,400,200)
VectorNormalize(F1)
F2.Vector= Vector(qx1,qy1,250,250)
;VectorNormalize(F2)
While Not KeyHit(1)
mx# = MouseX() : my# = MouseY()
Cls
Color 120,120,120
If Dist( qx1,qy1,mx,my)<10 And MouseDown(1)
qx1= mx : qy1=my
Oval mx-10,my-10, 20,20,0
Else
Rect qx1-5,qy1-5, 10,10,0
EndIf
If Dist( qx2,qy2,mx,my)<10 And MouseDown(1)
qx2= mx : qy2=my
Oval mx-10,my-10, 20,20,0
Else
Rect qx2-5,qy2-5, 10,10,0
EndIf
VectorUpdata(F, qx1,qy1,qx2,qy2)
VectorUpdata(F2, qx1,qy1,250,250)
t# = FindIntersectionVectors#(F,F1, F2);
fx# = FindX#(F1,t#)
fy# = FindY#(F1,t#)
Rect fx-5,fy-5,10,10,1
Color 120,0,0
Rect fx-5,fy-5,10,10,0
VectorDraw(F,255,0,0)
VectorDraw(F1,0,0,255)
VectorDraw(F2,0,255,0)
Text 20,20,"Навести мышь на квадрат и удерживая нажатой левую кнопку мыши, затем "
Text 20,40,"переместить стрелку мыши в новую позицию"
Text 20,60,"VectorMagnitude : "+t
Flip
Wend
Delete Each Vector
FreeFont ArialCyrFont
End
Function VectorDraw(a.Vector , R=255, G=255, B=255)
Color R,G,B
Line a\px ,a\py , a\px+ a\X*a\L , a\py+a\Y*a\L
Oval a\px+a\X*a\L-2,a\py+ a\Y*a\L-2,3,3,1
Color 255,255,255
Line a\px,a\py , a\px+ a\X*5 , a\py+a\Y*5
Oval a\px+a\X*a\L-3,a\py+ a\Y*a\L-3,5,5,0
End Function
Function VectorClone.Vector(a.Vector)
Local v.Vector = New Vector
v\X = a\X
v\Y = a\Y
v\L = a\L
v\px = a\px
v\py = a\py
v\px2 = a\px2
v\py2 = a\py2
Return v
End Function
Function Vector.Vector(X1#=0,Y1#=0,X2#=0,Y2#=0)
Local v.Vector = New Vector
v\X = X2 -X1
v\Y = Y2 -Y1
v\vX = v\X
v\vY = v\Y
v\px =X1
v\py = Y1
v\px2 =X2
v\py2 = Y2
Return v
End Function
Function VectorUpdata(a.Vector , X1#=0,Y1#=0,X2#=0,Y2#=0)
a\X = X2 -X1
a\Y = Y2 -Y1
a\vX = X2 -X1
a\vY = Y2 -Y1
a\px = X1
a\py = Y1
a\L = VectorMagnitude#(a)
VectorNormalize(a)
End Function
Function FindIntersectionVectors#(a.Vector,b.Vector, c.Vector);
Local t#
VectorUpdata(c, a\px,a\py,b\px,b\py)
If ((a\x = b\x And a\y = b\y) Or (a\x = -a\x And a\y = -b\y))
t = 1000000
Else
t# =(c\vx*a\vy-c\vy*a\vx)/(a\vx*b\vy-a\vy*b\vx)
EndIf
Return t
End Function
Function FindX#(a.Vector,tt#)
Return a\px + a\vx*tt
End Function
Function FindY#(a.Vector,tt#)
Return a\py + a\vy*tt
End Function
Function VectorCloneUpdata(a.Vector , b.Vector)
a\X =b\X
a\Y = b\Y
a\vX = b\vX
a\vY = b\vY
a\L = b\L
End Function
Function VectorAdd(a.Vector,b.Vector)
a\X =a\X + b\X
a\Y =a\Y + b\Y
End Function
Function VectorRight(a.Vector)
Local cX# , cY#
cX= -a\X : cY = a\Y
a\X =cY
a\Y =cX
End Function
Function VectorLeft(a.Vector)
Local cX# , cY#
cX= a\X : cY = -a\Y
a\X =cY
a\Y =cX
End Function
Function VectorReverse(a.Vector)
Local cX# , cY#
cX= -a\X : cY = -a\Y
a\X =cX
a\Y =cY
End Function
Function VectorReverseClone(a.Vector,b.Vector)
a\X =-b\X
a\Y =-b\Y
End Function
Function VectorSubtract(a.Vector,b.Vector)
a\X =a\X - b\X
a\Y =a\Y - b\Y
End Function
Function VectorSum.Vector(a.Vector,b.Vector)
Return Vector(a\X+b\X,a\Y+b\Y)
End Function
Function VectorDifference.Vector(a.Vector,b.Vector)
Return Vector(a\X-b\X,a\Y-b\Y)
End Function
Function VectorMultiply(a.Vector,b.Vector)
a\X =a\X * b\X
a\Y =a\Y * b\Y
End Function
Function VectorDivide(a.Vector,b.Vector)
a\X =a\X / b\X
a\Y =a\Y / b\Y
End Function
Function VectorProduct.Vector(a.Vector,b.Vector)
Return Vector(a\X*b\X,a\Y*b\Y)
End Function
Function VectorQuotient.Vector(a.Vector,b.Vector)
Return Vector(a\X/b\X,a\Y/b\Y)
End Function
Function VectorCross#(a.Vector,b.Vector)
Return (a\X*b\Y)-(a\Y*b\X)
End Function
Function VectorDot#(a.Vector,b.Vector)
Return (a\X*b\X) + (a\Y*b\Y)
End Function
Function VectorAngle#(a.Vector,b.Vector)
Local d# = VectorDot(a,b)
Local m# = VectorMagnitude(a)*VectorMagnitude(b)
Return ACos(d#/m#)
End Function
Function VectorNormalize(a.Vector)
Local m# = VectorMagnitude(a)
If m<= 0.0001Then m=1
a\X = a\X / m#
a\Y = a\Y / m#
End Function
Function VectorMagnitude#(a.Vector)
a\L = Sqr(a\X*a\X + a\Y*a\Y)
Return a\L
End Function
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
Конечно ,лучше оформить отдельный ББ файл с функциями операций над векторами и просто присоединять его к основной программе.
__________________
Мой проект здесь
|
(Offline)
|
|
18.10.2013, 21:11
|
#10
|
[object Object]
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,361
Написано 2,473 полезных сообщений (для 6,856 пользователей)
|
Ответ: некоторые изометрические демки
Сообщение от polopok
Статья донор здесь и здесь , а так же там много разных примеров .
|
Рекомендую по теме:
http://habrahabr.ru/post/131931/
__________________
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
|
(Offline)
|
|
18.10.2013, 23:11
|
#11
|
ПроЭктировщик
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений (для 71 пользователей)
|
Ответ: некоторые изометрические демки
Спасибо ,давно лежит в закладках ...
продолжаем ...
проекция вектора на вектор .Статья донор Урок: базовые алгоритмы определения столкновений
код:
Type Vector
Field lenght# ,vx#,vy#, dx# , dy# , rx#,ry# ,lx#,ly#
Field px#[1] , py#[1] , selected = False , R ,G ,B
End Type
Global qx1#,qy1#
Graphics 800,600,32,2
SetBuffer BackBuffer()
ArialCyrFont = LoadFont ("Arial cyr",16)
SetFont ArialCyrFont
v1.Vector = NewVector(150,100,200,150,0,0,100)
v2.Vector = NewVector(150,100,150,50,88,88,88)
ClsColor 255,255,255
While Not KeyHit(1)
mx# = MouseX() : my# = MouseY()
Cls
For point.Vector = Each Vector
If point <>Null Then
For p = 0 To 1
Color 120,120,120
If Dist(point\px[p] ,point\py[p],mx,my)<10 And MouseDown(1)
point\px[p] = mx
point\py[p] = my
Oval mx-10,my-10, 20,20,0
Else
Rect point\px[p]-5,point\py[p]-5, 10,10,0
EndIf
Next
If point\px[0]=point\px[1] And point\py[0]=point\py[1] Then
point\px[1]= point\px[1] +15
point\py[1]= point\py[1] +15
EndIf
End If
Next
VectorUpdate(v1,v1\R ,v1\G ,v1\B)
VectorUpdate(v2,v2\R ,v2\G ,v2\B)
dp# = projectVector(v1,v2\dx,v2\dy)
For point.Vector = Each Vector
If point <>Null Then
VectorDraw(point )
End If
Next
Color 0,255,0
Line v2\px[0],v2\py[0] , v2\px[0] + v2\dx*dp ,v2\py[0]+ v2\dy*dp
Oval v2\px[0]+v2\dX*dp -3,v2\py[0]+ v2\dY*dp -3,5,5,0
Color 48,48,48
Line v1\px[1],v1\py[1] , v2\px[0] + v2\dx*dp ,v2\py[0]+ v2\dy*dp
Text 220,20,"Навести мышь на квадрат и удерживая нажатой левую кнопку мыши,"
Text 220,40,"переместить стрелку мыши в новую позицию"
Text 220,60,"VectorDot: "+dp#
Flip
Wend
Delete Each Vector
FreeFont ArialCyrFont
End
;[ end ]==============================================================================
Function projectVector#(a.Vector,dx#,dy#);
; find dot product
Local dp# = a\vx*dx+a\vy*dy;
Return dp#
End Function
Function FindXproject#(v.Vector,dp#)
Return v\vx = dp#*v\dx;
End Function
Function FindYproject#(v.Vector,dp#)
Return v\vy = dp#*v\dy;
End Function
Function VectorDraw(a.Vector )
Color 68,68,68
Line a\px[0]+(-a\dx*1000 ) ,a\py[0]+(-a\dy*1000) , a\px[0]+a\dx*1000 , a\py[0]+a\dy*1000
Color a\R,a\G,a\B
Line a\px[0] ,a\py[0] , a\px[0]+ a\dX*a\lenght , a\py[0]+a\dY*a\lenght
Oval a\px[0]+a\dX*a\lenght -2,a\py[0]+ a\dy*a\lenght -2,3,3,1
Color 205,205,205
Line a\px[0],a\py[0] , a\px[0]+ a\dX*5 , a\py[0]+a\dY*5
Oval a\px[0]+a\dX*a\lenght -3,a\py[0]+ a\dY*a\lenght -3,5,5,0
End Function
Function NewVector.Vector(X1#=0,Y1#=0,X2#=0,Y2#=0, R= 255,G= 255,B= 255)
Local v.Vector = New Vector
v\vx = X2 -X1
v\vy = Y2 -Y1
v\lenght = VectorMagnitude#(v)
; normalized
v\dx = v\vx / v\lenght
v\dy = v\vy / v\lenght
; Right hand normal
v\rx = -v\vy
v\ry = v\vx
; Left hand normal
v\lx = v\vy
v\ly = -v\vx
; Coordinate Points
v\px[0] =X1
v\py[0] = Y1
v\px[1] =X2
v\py[1] = Y2
; Vector colors
v\R = R
v\G = G
v\B = B
Return v
End Function
Function VectorUpdate(v.Vector, R= 255,G= 255,B= 255)
v\vx = v\px[1] -v\px[0]
v\vy = v\py[1] -v\py[0]
v\lenght = VectorMagnitude#(v)
; normalized
v\dx = v\vx / v\lenght
v\dy = v\vy / v\lenght
; Right hand normal
v\rx = -v\vy
v\ry = v\vx
; Left hand normal
v\lx = v\vy
v\ly = -v\vx
; Vector colors
v\R = R
v\G = G
v\B = B
End Function
Function VectorReverse(a.Vector)
a\vX = -a\vX
a\vY = -a\vY
End Function
Function VectorSubtract(a.Vector,b.Vector)
a\vX =a\vX - b\vX
a\vY =a\vY - b\vY
End Function
;Function VectorSum.Vector(a.Vector,b.Vector)
; Return (a\vX+b\vX,a\vY+b\vY)
;End Function
;Function VectorDifference.Vector(a.Vector,b.Vector)
; Return Vector(a\vX-b\vX,a\vY-b\vY)
;End Function
Function VectorMultiply(a.Vector,b.Vector)
a\vX =a\vX * b\vX
a\vY =a\vY * b\vY
End Function
Function VectorDivide(a.Vector,b.Vector)
a\vX =a\vX / b\vX
a\vY =a\vY / b\vY
End Function
Function VectorCross#(a.Vector,b.Vector)
Return (a\vX*b\vY)-(a\vY*b\vX)
End Function
Function VectorDot#(a.Vector,b.Vector)
Return (a\vX*b\vX) + (a\vY*b\vY)
End Function
Function VectorAngle#(a.Vector,b.Vector)
Local d# = VectorDot(a,b)
Local m# = VectorMagnitude(a)*VectorMagnitude(b)
Return ACos(d#/m#)
End Function
Function VectorNormalize(a.Vector)
Local m# = VectorMagnitude(a)
If m<= 0.0001Then m=1
a\vX = a\vX / m#
a\vY = a\vY / m#
End Function
Function VectorMagnitude#(a.Vector)
a\lenght = Sqr(a\vX*a\vX + a\vY*a\vY)
Return a\lenght
End Function
;Function VectorProduct.Vector(a.Vector,b.Vector)
; Return Vector(a\vX*b\vX,a\vY*b\vY)
;End Function
;Function VectorQuotient.Vector(a.Vector,b.Vector)
; Return Vector(a\vX/b\vX,a\vY/b\vY)
;End Function
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
__________________
Мой проект здесь
|
(Offline)
|
|
26.10.2013, 08:44
|
#12
|
[object Object]
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,361
Написано 2,473 полезных сообщений (для 6,856 пользователей)
|
Ответ: некоторые изометрические демки
Сообщение от polopok
Function Dist#( X1#, Y1#, X2#, Y2# )
Return Abs(( (X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2) )^0.5)
End Function
|
Ммм... Для такой записи есть причины? Суть то ясна, но не проще ли
Function Dist#(x1#, y1#, x2#, y2#)
Local nx# = x1 - x2
Local ny# = y1 - y2
Return Sqr( (nx * nx) + (ny * ny))
End Function
__________________
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
|
(Offline)
|
|
26.10.2013, 10:56
|
#13
|
Бывалый
Регистрация: 22.08.2006
Сообщений: 700
Написано 146 полезных сообщений (для 267 пользователей)
|
Ответ: некоторые изометрические демки
Брать корни для расстояния - плохой тон. Особенно в блитце
|
(Offline)
|
|
26.10.2013, 10:59
|
#14
|
[object Object]
Регистрация: 01.08.2008
Адрес: В России
Сообщений: 4,361
Написано 2,473 полезных сообщений (для 6,856 пользователей)
|
Ответ: некоторые изометрические демки
Сообщение от MiXaeL
Брать корни для расстояния - плохой тон. Особенно в блитце
|
Какие ваши доказательства?
__________________
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
|
(Offline)
|
|
26.10.2013, 12:11
|
#15
|
Бывалый
Регистрация: 22.08.2006
Сообщений: 700
Написано 146 полезных сообщений (для 267 пользователей)
|
Ответ: некоторые изометрические демки
На вычисление корня уходит порядка 15-20 тактов. Можно просто хранить квадрат расстояния в double имея в итоге расстояние с точностью до float. Т.е. если отношение максимального расстояния к минимальному не превышает 1 << 32, то вычислять корни бессмысленно.
А в блитце вообще с математикой беда какая-то, она в десятки раз медленнее сишной.
|
(Offline)
|
|
Сообщение было полезно следующим пользователям:
|
|
Ваши права в разделе
|
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
HTML код Выкл.
|
|
|
Часовой пояс GMT +4, время: 11:02.
|