Извините, ничего не найдено.

Не расстраивайся! Лучше выпей чайку!
Регистрация
Справка
Календарь

Вернуться   www.boolean.name > Программирование игр для компьютеров > Blitz3D > 2D-программирование

2D-программирование Вопросы, касающиеся двумерного программирования

Ответ
 
Опции темы
Старый 29.09.2015, 13:45   #1
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
RagDoll physic. Физика взаимодействия

Заинтересовала меня тема физического взаимодействия , вот решил попробывать. Естественно код надо допиливать и тд. и тп.
ссылка демонстрация http://subprotocol.com/system/spider.html

Код под спойлером :
;
Const gravity# = 0.99 
Global NumberOfPoints ,NumberOfSticks ,mouseClick ,create ,joint ,numberJoint ,show ,render 
Global offsetX# ,offsetY#, tension# = 0.5

Type Stick 
Field one.Point , two.Point 
Field lenght#
End Type 

Type point Field x# , y# , selecte= False , lock = False End Type 
Global CurentPoint.Point ,OldPoint.Point

Global grx,gry
Global mx#,my#,mz#

Graphics 800,600,32,2
SetBuffer BackBuffer()
grx = GraphicsWidth()/2 : gry = GraphicsHeight()/2

ClsColor 128,128,130
While Not KeyHit(1)
Cls 
mx = MouseX() : my = MouseY() : tension= (MouseZ() +50)*0.01  
If KeyHit (20) create = -1 ;T  перемещение с изменением длинны
If KeyHit (46) create = 0 ;C откидывание до основного взаимодействия
If KeyHit (25) create = 1 ;P создать точку
If KeyHit (31) create = 2 ;S создать линию
If KeyHit (36) create = 3 ;J объединить точки
If KeyHit (38) create = 4 ;L блокировать\разблокировать точку
If KeyHit (18) ClearPoints( ) :ClearSticks( ) ;E стереть всё
If KeyHit (2) show = Not show ; 1 
If KeyHit (19) render = Not render ;R начать\приостановить симуляцию

MouseActions()
If render VerletMath( )
DrawPoint(2)
DrawStick( )

Text 20,20,"Number of Points "+NumberOfPoints+" , Number of Sticks "+NumberOfSticks  
Text 20,40,"create "+create+" , render "+render +" , numberJoint  "+numberJoint+" , tension "+tension 

Flip 
Wend
ClearPoints( )
ClearSticks( )
End 

Function MouseSelectPoint( )
    For this.Point = Each Point
        If NumberOfPoints >0
            If Distance (MouseX(),MouseY(),this\x,this\y )<5 And this\selecte = False
                this\selecte = True
                numberJoint =numberJoint + 1
                If numberJoint =1 OldPoint = this
                If numberJoint =2 
                    JointPoints(OldPoint ,this) : numberJoint = 0 : this\selecte = False : OldPoint\selecte = False  
                EndIf    
            EndIf
        EndIf
    Next
End Function


Function MouseActions()
    If MouseDown(1) And mouseClick = False 
        mouseClick = True
        Select create 
            Case -1 
                For this.Point = Each Point
                    If NumberOfPoints >0
                        If Distance (MouseX(),MouseY(),this\x,this\y )<5
                            OldPoint = this : OldPoint\selecte = True
                                
                        EndIf
                    EndIf
                Next                
            Case 0
                For this.Point = Each Point
                    If NumberOfPoints >0
                        If Distance (MouseX(),MouseY(),this\x,this\y )<5
                            OldPoint = this : OldPoint\selecte = True
                                
                        EndIf
                    EndIf
                Next
            Case 2
                OldPoint= NewPoint(MouseX(),MouseY())
            Case 3
                MouseSelectPoint( )        
            Case 4
                For this.Point = Each Point
                    If NumberOfPoints >0
                        If Distance (MouseX(),MouseY(),this\x,this\y )<5
                            OldPoint = this :  OldPoint\lock = Not OldPoint\lock 
                                
                        EndIf
                    EndIf
                Next                
        End Select 
    EndIf 
    
        If MouseDown(1) And mouseClick = True 
            Select create 
            Case -1
                If OldPoint\selecte = True OldPoint\x = MouseX()  : OldPoint\y = MouseY()
                For this2.Stick = Each Stick
                    If NumberOfSticks >0
                        If this2\one = OldPoint Or  this2\two = OldPoint 
                            this2\lenght = Distance (this2\one\x,this2\one\y ,this2\two\x,this2\two\y)        
                        EndIf
                    EndIf
                Next                    
            Case 0
                If OldPoint\selecte = True OldPoint\x = MouseX()  : OldPoint\y = MouseY()            
            Case 2
                Line OldPoint\x ,OldPoint\y,MouseX(),MouseY()
                Oval OldPoint\x-2,OldPoint\y-2,4,4,1
                Oval MouseX()-2,MouseY()-2,4,4,1
            End Select 
        EndIf 
        
            If MouseDown(1) = False And mouseClick = True
                mouseClick = False
                Select create 
                    Case -1
                        OldPoint\selecte = False : create = 0
                    Case 0
                        OldPoint\selecte = False 
                    Case 1
                        NewPoint(MouseX(),MouseY())
                        create = 0
                    Case 2
                        CurentPoint= NewPoint(MouseX(),MouseY())
                        JointPoints(OldPoint,CurentPoint)
                        create = 0
                    Case 3
                        If numberJoint =0 create = 0
                    Case 4    
                        create = 0
                End Select     
            EndIf
End Function

; ==[ Point Functions ]==
; ===============

Function NewPoint.point(pointX,pointY )
    this.point = New point
    this\x =pointX
    this\y =pointY 
    NumberOfPoints = NumberOfPoints +1
    Return this
End Function

Function DeletePoint(this.Point )
    If this <> Null Delete this 
    NumberOfPoints = NumberOfPoints -1
End Function

Function ClearPoints( )
    Delete Each point 
    NumberOfPoints = 0
End Function

Function DrawPoint(radius# = 1 , solid = True )
    
    For this.Point = Each Point
        If NumberOfPoints >0
            If this\lock = True Color 255,0,0 Else Color 255,255,255
            If this\Selecte = 0
                Oval this\x - radius , this\y -radius , radius*2,radius*2 , solid
            Else
                Oval this\x - radius , this\y -radius , radius*2,radius*2 , solid
                radius2 =radius +2
                Oval this\x - radius2 , this\y -radius2 , radius2*2,radius2*2 , 0
            EndIf
        EndIf
    Next
End Function



; ==[ Stick Functions ]==
; ===============

Function JointPoints.Stick(onePoint.Point,twoPoint.Point )
    this.stick = New stick
    this\one = onePoint
    this\two = twoPoint
    this\lenght = Distance (onePoint\x,onePoint\y ,twoPoint\x,twoPoint\y)
    NumberOfSticks = NumberOfSticks +1
    Return this
End Function

Function DeleteStick(this.Stick )
    If this <> Null Delete this
    NumberOfSticks = NumberOfSticks -1
End Function

Function ClearSticks( )
    Delete Each stick
    NumberOfSticks = 0
End Function

Function DrawStick( )
    For this.Stick = Each Stick
        If NumberOfSticks >0
            Line  this\one\x , this\one\y , this\two\x , this\two\y 
            
            If show Text (this\two\x+ this\one\x)/2-2,(this\two\y+ this\one\y)/2-2,this\lenght
        EndIf
    Next
End Function

; ==[ Verlet Functions ]==
; ===============

Function VerletMath( )
    For this.Stick = Each Stick
        If NumberOfSticks >0
            dx# = this\two\x -this\one\x
            dy# = this\two\y -this\one\y
            MathPoint(dx#,dy#,this\lenght )
            If this\one\lock = False    
                this\one\x = this\one\x - offsetX *tension;
                this\one\y = this\one\y - offsetY*tension +gravity
            EndIf    
            If this\two\lock = False    
                this\two\x = this\two\x + offsetX*tension
                this\two\y = this\two\y + offsetY*tension+gravity    
            EndIf
            
            If this\one\y > GraphicsHeight()-10        this\one\y = GraphicsHeight()-10    
            If this\two\y > GraphicsHeight()-10        this\two\y = GraphicsHeight()-10        
        EndIf
    Next
End Function


Function MathPoint#(dx#,dy#,length# )
    dis# =Distance2(dx#, dy#)
    diff# =Different( length#, dis )
    offsetX# = Offset(diff , dx, dis) 
    offsetY# = Offset(diff , dy, dis) 
End Function

Function Different#( length#, distance# )
    Return  length - distance
End Function

Function Offset#(differente#,diffs # ,distance# )
    Return   (differente* diffs / distance) /2
End Function

; ==[ Other Functions ]==
; ===============

Function Distance#( X1#, Y1#, X2#, Y2# )
    Return ((X1 - X2)*(X1 - X2) + (Y1 - Y2)*(Y1 - Y2))^0.5 
End Function

Function Distance2#(dx#, dy#)
    Return  (dx * dx + dy * dy)^0.5
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо polopok за это полезное сообщение:
impersonalis (30.09.2015), St_AnGer (15.10.2015)
Старый 29.09.2015, 14:14   #2
St_AnGer
Элита
 
Аватар для St_AnGer
 
Регистрация: 21.01.2010
Адрес: Россия, Рязанская область, г.Михайлов
Сообщений: 2,003
Написано 1,143 полезных сообщений
(для 2,754 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

Скачал блиц (СПЕЦИАЛЬНО!!!), скопировал код, запустил - хрен знает чего делать. По коду понял что можно нажать некоторые клавиши и меняются циферки. При нажатии на мышку сначала циферка обнуляется, потом происходит МАВ. А если кнопочки не нажимать - МАВ происходит сразу. На экране кроме текста ничего не отображается (на R пробовал нажимать, пофиг). Что должно происходить на экране? Покажи скрины

АПД. А вот пример понравился.
АПД2. Блин, требил паутину во все стороны и нечаянно убил паукана
Нажмите на изображение для увеличения
Название: Снимок.PNG
Просмотров: 100
Размер:	11.0 Кб
ID:	21961
__________________
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)
 
Ответить с цитированием
Старый 29.09.2015, 14:28   #3
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

Да! А вначале пустота . самому надо делать .

нажимаешь S кликаешь левой кнопкой мыши и тянешь отпускаешь = линия
нажимаешь P кликаешь левой кнопкой мыши = точка
нажимаешь J кликаешь левой кнопкой мыши любую точку потом кликаешь другую = линия между точками
нажимаешь L кликаешь левой кнопкой мыши любую точку = блокировать\разблокировать
нажимаешь R = симуляция ( если до этого ничего не создал , то и нечего симулировать )
нажимаешь Т кликаешь левой кнопкой мыши любую точку удерживаешь перемещая
а так если создано хоть что-то можешь смещать точки мышью
в коде просто безумие
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
St_AnGer (30.09.2015)
Старый 29.09.2015, 14:37   #4
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Смущение Ответ: RagDoll physic. Физика взаимодействия

В другой раз как код поправлю и нормальный интерфейс сделаю обязательно выложу
всё достаточно сырое
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 29.09.2015, 14:57   #5
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

у кого нет Blitz3d скомпилил приложение Verlet.exe
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 29.09.2015, 16:55   #6
Arton
Быдлокодер
 
Аватар для Arton
 
Регистрация: 05.07.2009
Адрес: Проспит
Сообщений: 4,439
Написано 1,927 полезных сообщений
(для 4,636 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

А откуда паук берётся, я только линии рисовал и они падали?
(Offline)
 
Ответить с цитированием
Старый 29.09.2015, 17:44   #7
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

паук , ну там относительно линии вектор или раст трансформируется (типа трансформация http://forum.boolean.name/showthread.php?t=20010)
или я чего-то не до понял ?
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Старый 30.09.2015, 06:12   #8
St_AnGer
Элита
 
Аватар для St_AnGer
 
Регистрация: 21.01.2010
Адрес: Россия, Рязанская область, г.Михайлов
Сообщений: 2,003
Написано 1,143 полезных сообщений
(для 2,754 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

Сообщение от polopok Посмотреть сообщение
паук , ну там относительно линии вектор или раст трансформируется (типа трансформация http://forum.boolean.name/showthread.php?t=20010)
или я чего-то не до понял ?
Arton просто спросил где взять паукана в твоём приложении Нигде, паукан был из приложенной в первом посте ссылки.

Сообщение от polopok Посмотреть сообщение
Да! А вначале пустота . самому надо делать .

нажимаешь S кликаешь левой кнопкой мыши и тянешь отпускаешь = линия
нажимаешь P кликаешь левой кнопкой мыши = точка
нажимаешь J кликаешь левой кнопкой мыши любую точку потом кликаешь другую = линия между точками
нажимаешь L кликаешь левой кнопкой мыши любую точку = блокировать\разблокировать
нажимаешь R = симуляция ( если до этого ничего не создал , то и нечего симулировать )
нажимаешь Т кликаешь левой кнопкой мыши любую точку удерживаешь перемещая
а так если создано хоть что-то можешь смещать точки мышью
в коде просто безумие
У меня просто IDE стандартное блицевское, там все коменты (кроме латиницы) превратились в ???????. От сюда я и не понял управление

Потыкался в точки и линии, прикольно! Хочу упругость линий увидеть, тогда можно будет повторить ту шнягу с пауком (да и паукана сбацать тоже можно будет). А ещё из упругости вытечет одна приятная фишка - изделие будет перемещаться полностью, а не по точкам. Ну и ещё что бы не обнулялось действие, а то точку поставил - опять буковку жать надо, а я ленииииивый
И губу раскатал я тоже недурственно
__________________
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)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Arton (30.09.2015)
Старый 30.09.2015, 09:11   #9
impersonalis
Зануда с интернетом
 
Аватар для impersonalis
 
Регистрация: 03.09.2005
Сообщений: 14,014
Написано 6,795 полезных сообщений
(для 20,914 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

шикарно
__________________
http://nabatchikov.com
Мир нужно делать лучше и чище. Иначе, зачем мы живем? tormoz
А я растила сына на преданьях
о принцах, троллях, потайных свиданьях,
погонях, похищениях невест.
Да кто же знал, что сказка душу съест?
(Offline)
 
Ответить с цитированием
Старый 30.09.2015, 13:10   #10
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

Сообщение от St_AnGer Посмотреть сообщение
Arton просто спросил где взять паукана в твоём приложении Нигде, паукан был из приложенной в первом посте ссылки.



У меня просто IDE стандартное блицевское, там все коменты (кроме латиницы) превратились в ???????. От сюда я и не понял управление

Потыкался в точки и линии, прикольно! Хочу упругость линий увидеть, тогда можно будет повторить ту шнягу с пауком (да и паукана сбацать тоже можно будет). А ещё из упругости вытечет одна приятная фишка - изделие будет перемещаться полностью, а не по точкам. Ну и ещё что бы не обнулялось действие, а то точку поставил - опять буковку жать надо, а я ленииииивый
И губу раскатал я тоже недурственно
так и я ленивый , это просто прототип , я ж писал. Всё допиливать и избавляться от избыточного кода нужно.
Ещё инверсную кинематику освоить желаю и вроде понимаю что к чему ,а в целом глуховато . Времени не хватает ...
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
St_AnGer (30.09.2015)
Старый 04.10.2015, 14:40   #11
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Сообщение Ответ: RagDoll physic. Физика взаимодействия

Пример Инверсной кинематики ( система костей ) на основе ragdoll
inverseKinematic.exe

параметр lenght лучше объявить в Типе
Код под спойлером :
;


Const lenght  = 100
Global NumberOfPoints 

.points
Type Point 
Field  id% ,x# , y# , z# , w# , lock ; lenght  
Field AP.Point , BP.Point ; After point = AP ,Before point = BP
End Type 

Global CP.Point ; Curet point = CP

Function NewPoint.Point ()
    this.Point = New Point 
    this\bp= Null 
    this\ap= Null
    this\x = 0.0
    this\y = 0.0
    this\z = 0.0
    this\w = 1.0
    this\lock = False
    NumberOfPoints= NumberOfPoints+1
    this\id = NumberOfPoints
    Return this
End Function 

Function SetLockPoint(this.Point , lock)
    this\lock = lock
End Function

Function SetPositionPoint(this.Point ,Point_X# ,Point_Y#   ); object ,radius  
     this\x = Point_X : this\y = Point_Y 
End Function

Function DeletePoint(this.Point )
    If this <> Null Delete this 
    NumberOfPoints = NumberOfPoints -1
End Function

Function ClearPoints( )
    Delete Each point 
    NumberOfPoints = 0
End Function

Global grx,gry
Global mx#,my#,mz%  , offsetX# ,offsetY#

Graphics 800,600,32,2
SetBuffer BackBuffer()
grx = GraphicsWidth()/2 : gry = GraphicsHeight()/2

cp = newpoint()
setpositionpoint (cp,200,200)
setlockpoint(cp,true)
cp\ap = After cp : cp\bp = Before cp
cp = newpoint()
setpositionpoint (cp,200+lenght  ,200)
cp\ap = After cp : cp\bp = Before cp
cp = newpoint()
setpositionpoint (cp,200+lenght  *2,200)
cp\ap = After cp : cp\bp = Before cp
cp = newpoint()
setpositionpoint (cp,200+lenght  *3,200)
cp\ap = After cp : cp\bp = Before cp

For p.point = Each point
    If p <> Null
        DebugLog " Point : " + p\id
        DebugLog "        L___ Position : X =  "+p\x+"  , Y =  "+p\y+"  , Z =  "+p\z+"  , W =  "+p\w
        DebugLog "        L___ Lock =  "+ p\lock
        DebugLog ""
    EndIf
Next

While Not KeyHit(1)
Cls 
mx = MouseX() : my = MouseY() : mz = MouseZ()

If MouseDown(1) mouseClick = True Else mouseClick = False

For p.point = Each point
    If p <> Null
        If mouseClick = True
            cp = Last point
            cp\x = mx : cp\y = my
        EndIf 
        
        cp = p\bp
        If cp <> Null        
            dx# = p\x - cp\x
            dy# = p\y - cp\y
            MathPoint(dx#,dy#,lenght ) ; p\lenght  !!!
            If p\lock = False    
                p\x = p\x + offsetX 
                p\y = p\y + offsetY
            EndIf    
            If cp\lock = False    
                cp\x = cp\x - offsetX
                cp\y = cp\y - offsetY
            EndIf        
        

            
        EndIf
    EndIf
Next

For pp.point = Each point
    If pp <> Null
        cp = pp\bp
        If cp <> Null    
            Line pp\x,pp\y,cp\x,cp\y
        EndIf

        if pp\lock 
color 255,0,0
Oval pp\x -2 , pp\y - 2 ,4 ,4 ,1
else
color 255,255,255
Oval pp\x -2 , pp\y - 2 ,4 ,4 ,1
endif

    EndIf
Next    
Flip 
Wend
ClearPoints()
End 

Function Distance2#(dx#, dy#)
    Return  (dx * dx + dy * dy)^0.5
End Function

Function MathPoint#(dx#,dy#,length# )
    dis# =Distance2(dx#, dy#)
    diff# =Different( length#, dis )
    offsetX# = Offset(diff , dx, dis) 
    offsetY# = Offset(diff , dy, dis) 
End Function

Function Different#( length#, distance# )
    Return  length - distance
End Function

Function Offset#(differente#,diffs # ,distance# )
    Return   (differente* diffs / distance) ;
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Эти 2 пользователя(ей) сказали Спасибо polopok за это полезное сообщение:
Arton (04.10.2015), St_AnGer (05.10.2015)
Старый 15.10.2015, 16:18   #12
polopok
ПроЭктировщик
 
Регистрация: 17.07.2009
Сообщений: 182
Написано 51 полезных сообщений
(для 71 пользователей)
Ответ: RagDoll physic. Физика взаимодействия

Несколько иной вариант реализации ,на основе пружин. Минимальный
Оригинал статьи http://pmg.org.ru/nehe/nehe40.htm
Код под спойлером :
;
Global ptx#[150], pty#[150] 
; создаются пружины
    For x = 1 To 15 
        ptx[x] = x * 40
        pty[x] = 200
        po = po + 1
    Next 


Global mx#,my#

Graphics 800,600,32,2
SetBuffer BackBuffer()

k# = 0.05 ; упругость пружины
f# = 0.8 ; внешняя сила трения
m1# = 1 : m2# = 0.5 ; массы ! ни в коим случае не должны быть равны нулю !!!
d# = 40 ; длина пружины

While Not KeyHit(1)
ClsColor 128,128,128
Cls 
; если расстояние от стрелки курсора до точки < 5
; запоминаем точку
mx = MouseX() : my = MouseY() 
For n = 1 To po - 1
    If Distance(mx, my, ptx[n], pty[n] ) < 5 
    num = n 
    EndIf 
Next 

; если левая кнопка мыши нажата перемещаем точку в координаты мыши
; а нулевой точки , то нету :)   
If MouseDown(1) ptx[num] = mx : pty[num] = my

For n = 1 To po - 2
; вычисление вектора
    vx# = (ptx[n] - ptx[n + 1]) : vy# = (pty[n ] - pty[n +1])
; длинна вектора (расстояние)
    r# = Sqr(vx * vx + vy * vy) : If r = 0 r = 0.00001
    
;    { вектор силы = вектор пружины * упругость пружины * длину пружины 

    fx# = (vx/r) * -k * (r - d) 
    fy# = (vy/r) * -k * (r - d)

;    }
    ; если точки совпадают ,то будут расходиться
    If ptx[n] = ptx[n + 1] And pty[n] = pty[n + 1]
        ptx[n] = ptx[n]  - (fx * m1 * f) 
        pty[n] = pty[n]  - (fy * m1* f)
        
        ptx[n + 1] = ptx[n + 1] + (fx * m2 * f) 
        pty[n + 1] = pty[n + 1] + (fy * m2 * f)
    EndIf 
    
    ;  будут сходиться пока не достигнут длины пружины
    ptx[n] = ptx[n]  + (fx * m1 * f) 
    pty[n] = pty[n]  + (fy * m1* f)
                                         ; сила * массу * на трение
    ptx[n + 1] = ptx[n + 1] - (fx * m2 * f) 
    pty[n + 1] = pty[n + 1] - (fy * m2 * f)
Next 

; рисуем пружины
For n = 1 To po - 2
;    DrawSpring#(ptx[n], pty[n], ptx[n + 1], pty[n + 1], d, 4)
    
    Color 255, 255, 255
    Line ptx[n], pty[n], ptx[n + 1], pty[n + 1]
    
    Color 255, 0, 0
    Oval ptx[n] - 2, pty[n] - 2, 4, 4, 1
    
;Text ptx[n], pty[n] - 15,"m1 "+m1
;Text ptx[n + 1], pty[n + 1] - 15,"m2 "+m2    
Next 


Flip 
Wend
End 

; графический примитив Пружина
Function DrawSpring#(ox#, oy#, px#, py#, lenght#, psr = 2)
    Local tt#, t#, cx#, cy#, dx# = ox, dy# = oy
    Local vx# = (px - ox), vy# = (py - oy), r# = Sqr(vx * vx + vy * vy)
    
    If r = 0 r = 0.00001
    vx = vx / r  :  vy = vy / r
    tt# = 1.0 /( lenght * (psr * 0.25)) ; 0.5
    t# = tt    
        dx = (1 - t) * ox + px * t
        dy = (1 - t) * oy + py * t    

        Color 255, 255, 255
        Line ox + vy , oy + -vx , dx + vy * -psr, dy + -vx * -psr
    t = t + tt
    While t <= 1
        cx = (1 - t) * ox + px * t
        cy = (1 - t) * oy + py * t

        Color 55, 55, 55
        Line dx + vy * psr, dy + -vx * psr, dx + vy * -psr, dy + -vx * -psr        
        Color 255, 255, 255
        Line dx + vy * psr, dy + -vx * psr, cx + vy * -psr, cy + -vx * -psr
        
        dx = cx : dy = cy
        t = t + tt
    Wend
        Color 55, 55, 55
        Line cx + vy * psr, cy + -vx * psr, cx + vy * -psr, cy + -vx * -psr
        Color 255, 255, 255
        
        Text (ox + px) / 2 + vy * (psr + 12), (oy + py) / 2 + -vx * (psr + 12), r Shr 0
End Function

Function Distance#( Point_X1#,Point_Y1#,Point_X2#,Point_Y2# )
    Return ((Point_X1 - Point_X2)*(Point_X1 - Point_X2) + (Point_Y1 - Point_Y2)*(Point_Y1 - Point_Y2))^0.5 
End Function
__________________
Мой проект здесь
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
St_AnGer (16.10.2015)
Ответ


Опции темы

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +1, время: 02:59.


vBulletin® Version 3.6.5.
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Перевод: zCarot
Style crйe par Allan - vBulletin-Ressources.com