PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Interactiving masses

https://www.purebasic.fr/english/viewtopic.php?t=8880

Page 1 of 1

Interactiving masses

Posted: Fri Dec 26, 2003 12:11 am
by Psychophanta
Code updated For 5.20+

Ohh! some Xmas i have Amiga BlitzBasic2 melancholy.
So i've translated to PB a very old code i made:

Code: Select all

;************************************
;Interactiving masses:
;************************************

Procedure.f InputNum(inum.f,x.l,y.l)
  s.b=1:num.f=0
  StartDrawing(ScreenOutput()):BackColor(RGB(0,0,0)):FrontColor(RGB(200,200,240))
  DrawText(x,y,"input mass:"):BackColor(RGB(160,170,0)):FrontColor(RGB(230,230,240))
  DrawText(x+TextWidth("input mass:"),y,Space(10))
  DrawText(x+TextWidth("input mass:"),y,Str(inum))
  StopDrawing()
  FlipBuffers()
  While MouseButton(1):ExamineMouse():Wend;<-wait until LMB is released
  Repeat
    ExamineKeyboard():ExamineMouse()
    If KeyboardReleased(#PB_Key_PadEnter) Or KeyboardReleased(#PB_Key_Return) Or MouseButton(1):While MouseButton(1):ExamineMouse():Wend:Break
    ElseIf KeyboardReleased(#PB_Key_Subtract) Or KeyboardReleased(#PB_Key_Minus):num.f=-num.f:s.b=-s.b:key.b=1
    ElseIf KeyboardReleased(#PB_Key_PadComma) Or KeyboardReleased(#PB_Key_Comma):key.b=1 ;punto flotante?
    ElseIf KeyboardReleased(#PB_Key_Pad0) Or KeyboardReleased(#PB_Key_0):num*10:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad1) Or KeyboardReleased(#PB_Key_1):num*10+1*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad2) Or KeyboardReleased(#PB_Key_2):num*10+2*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad3) Or KeyboardReleased(#PB_Key_3):num*10+3*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad4) Or KeyboardReleased(#PB_Key_4):num*10+4*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad5) Or KeyboardReleased(#PB_Key_5):num*10+5*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad6) Or KeyboardReleased(#PB_Key_6):num*10+6*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad7) Or KeyboardReleased(#PB_Key_7):num*10+7*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad8) Or KeyboardReleased(#PB_Key_8):num*10+8*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Pad9) Or KeyboardReleased(#PB_Key_9):num*10+9*s:key.b=1
    ElseIf KeyboardReleased(#PB_Key_Back):num=Int(num/10):key.b=1
    ElseIf KeyboardReleased(#PB_Key_Escape):ProcedureReturn 10000000;<-ESCAPE; no add item.
    Else:key=0
    EndIf
    If key.b:inum=num
      If num>=10000 Or num<=-10000:num=Int(num/10):EndIf
      StartDrawing(ScreenOutput()):BackColor(RGB(0,0,0)):FrontColor(RGB(200,200,240))
      DrawText(x,y,"input mass:"):BackColor(RGB(160,170,0)):FrontColor(RGB(230,230,240))
      DrawText(x+TextWidth("input mass:"),y,Space(10))
      DrawText(x+TextWidth("input mass:"),y,Str(inum))
      StopDrawing()
      FlipBuffers()
    EndIf
  ForEver
  ProcedureReturn inum
EndProcedure

;-INITS:
If InitMouse()=0 Or InitSprite()=0 Or InitKeyboard()=0
  MessageRequester("Error", "Can't open DirectX. Ahhh! Se siente!", 0)
  End
EndIf
DefType .f
Structure MasaPuntual
  x.f:y.f;<-current position coords
  mx.f:my.f;<-movement vector
  mass.f;<-mass
EndStructure
NewList p.MasaPuntual()

#bitplanes=32:#RX=800:#RY=600
If OpenScreen(#RX,#RY,#bitplanes,"")=0:End:EndIf

CreateSprite(0,16,16);<-The mouse cursor
StartDrawing(SpriteOutput(0)):BackColor(RGB(0,0,0))
Line(0,0,15,10,$CABE2A)
Line(0,0,5,15,$CABE2A)
LineXY(5,15,15,10,$CABE2A)
FillArea(2,2,$CABE2A,$C0C1D0)
StopDrawing()
CreateSprite(1,4,4);<-the masses objects
StartDrawing(SpriteOutput(1)):BackColor(RGB(0,0,0))
Circle(2,2,2,$50F0CA)
StopDrawing()
MouseLocate(#RX/2,#RY/2)
#K=10000
routine.b=1:num.f=500
;-MAIN:
Repeat
  ExamineKeyboard():ExamineMouse()
  x=MouseX():y=MouseY()
  If MouseButton(1)
    Gosub addnewone
  EndIf
  ClearScreen(RGB(0,0,0))
  Gosub displaymaintext
  Gosub SelectRoutine
  Gosub displaymasses
  DisplayTransparentSprite(0,x,y);draw our mouse pointer sprite just here
  FlipBuffers();<--swap buffers
Until KeyboardPushed(#PB_Key_Escape)
ReleaseMouse(1):CloseScreen():End
;-Subroutines:
displaymaintext:
If hidetext.b=0
  StartDrawing(ScreenOutput()):BackColor(RGB(0,0,0)):FrontColor(RGB(120,170,160))
  DrawText(0,0,"Push LMB to add a mass")
  DrawText(0,20,"ESC key to exit")
  DrawText(0,120,"F11 => Show/Hide Text")
  DrawText(0,140,"F12 => RESTART")
  FrontColor(RGB(120,198,160)):DrawText(0+TextWidth("F12 => RESTART"),140,"  (now "+Str(ListSize(p()))+" objects)")
  StopDrawing()
EndIf
Return
SelectRoutine:
If KeyboardReleased(#PB_Key_F1):If routine.b<>1:Gosub resetmovements:routine.b=1:EndIf
  ElseIf KeyboardReleased(#PB_Key_F2):If routine.b<>2:Gosub resetmovements:routine.b=2:EndIf
  ElseIf KeyboardReleased(#PB_Key_F3):If routine.b<>3:Gosub resetmovements:routine.b=3:EndIf
  ElseIf KeyboardReleased(#PB_Key_F4):If routine.b<>4:Gosub resetmovements:routine.b=4:EndIf
ElseIf KeyboardReleased(#PB_Key_F11):hidetext.b!1
ElseIf KeyboardReleased(#PB_Key_F12):ClearList(p())
EndIf
StartDrawing(ScreenOutput()):BackColor(RGB(0,0,0)):FrontColor(RGB(220,210,160))
Select routine
  Case 1
    If hidetext.b=0
      DrawText(0,40,"Now processing Simple Harmonic Motion consecutives dependant systems")
      FrontColor(RGB(120,170,160))
      DrawText(0,60,"F2 => process (all on all) interactive dependant Simple Harmonic Motion systems")
      DrawText(0,80,"F3 => process gravity simulation consecutive dependant systems")
      DrawText(0,100,"F4 => process gravity simulation, this is (all on all)")
    EndIf
    Gosub process1
  Case 2
    If hidetext.b=0
      DrawText(0,60,"Now processing (all on all) interactive dependant Simple Harmonic Motion systems")
      FrontColor(RGB(120,170,160))
      DrawText(0,40,"F1 => process Simple Harmonic Motion consecutives dependant systems")
      DrawText(0,80,"F3 => process gravity simulation consecutive dependant systems")
      DrawText(0,100,"F4 => process gravity simulation, this is (all on all)")
    EndIf
    Gosub process2
  Case 3
    If hidetext.b=0
      DrawText(0,80,"Now processing gravity simulation consecutive dependant systems")
      FrontColor(RGB(120,170,160))
      DrawText(0,40,"F1 => process Simple Harmonic Motion consecutives dependant systems")
      DrawText(0,60,"F2 => process (all on all) interactive dependant Simple Harmonic Motion systems")
      DrawText(0,100,"F4 => process gravity simulation, this is (all on all)")
    EndIf
    Gosub process3
  Case 4
    If hidetext.b=0
      DrawText(0,100,"Now processing gravity simulation, this is (all on all)")
      FrontColor(RGB(120,170,160))
      DrawText(0,40,"F1 => process Simple Harmonic Motion consecutives dependant systems")
      DrawText(0,60,"F2 => process (all on all) interactive dependant Simple Harmonic Motion systems")
      DrawText(0,80,"F3 => process gravity simulation consecutive dependant systems")
    EndIf
    Gosub process4
  Default
    If hidetext.b=0
      FrontColor(RGB(120,170,160))
      DrawText(0,40,"F1 => process Simple Harmonic Motion consecutives dependant systems")
      DrawText(0,60,"F2 => process (all on all) interactive dependant Simple Harmonic Motion systems")
      DrawText(0,80,"F3 => process gravity simulation consecutive dependant systems")
      DrawText(0,100,"F4 => process gravity simulation, this is (all on all)")
    EndIf
EndSelect
StopDrawing()
Return
addnewone:
num=InputNum(num,x,y)
If num<1000000;<-if no ESC key pushed:
  AddElement(p())
  p()\x=x:p()\y=y
  p()\mass=num/#K
Else:num=0
EndIf
Return
displaymasses:
ForEach p()
  p()\x+p()\mx:p()\y+p()\my
  DisplayTransparentSprite(1,p()\x,p()\y)
Next
Return
resetmovements:
ForEach p()
  p()\mx=0:p()\my=0
Next
Return
process1:;<-process consecutives dependant systems of "Simple Harmonic Motion"
ForEach p()
  *p.MasaPuntual=@p() ;<-pushItem
  While NextElement(p())
    dx=p()\x-*p\x:dy=p()\y-*p\y;<-(dx,dy) is the *p->p() vector
    af=p()\mass/100
    *p\mx+dx*af:*p\my+dy*af
  Wend
  ChangeCurrentElement(p(),*p);<-popItem
Next
Return
process2:;<-process "all on all" interactive consecutives dependant systems of "Simple Harmonic Motion"
ForEach p()
  *p.MasaPuntual=@p();<-pushItem
  While NextElement(p())
    If @p()=*p:Continue:EndIf
    dx=(p()\x-*p\x):dy=(p()\y-*p\y);<-(dx,dy) is the *p->p() vector
    af1=p()\mass/100
    af2=*p\mass/100
    *p\mx+dx*af1:*p\my+dy*af1
    p()\mx-dx*af2:p()\my-dy*af2
  Wend
  ChangeCurrentElement(p(),*p);<-popItem
Next
Return
process3:;<-process gravity simulation consecutive dependant systems
ForEach p()
  *p.MasaPuntual=@p() ;<-pushItem
  While NextElement(p())
    dx=p()\x-*p\x:dy=p()\y-*p\y;<-(dx,dy) is the *p->p() vector
    af=p()\mass/Sqr(dx*dx+dy*dy);<-mass/distance
    *p\mx+dx*af:*p\my+dy*af
  Wend
  ChangeCurrentElement(p(),*p);<-popItem
Next
Return
process4:;<-process gravity simulation (interactiving all masses on all masses).
ForEach p()
  *p.MasaPuntual=@p();<-pushItem
  While NextElement(p())
    If @p()=*p:Continue:EndIf
    dx=(p()\x-*p\x):dy=(p()\y-*p\y);<-(dx,dy) is the *p->p() vector
    af1=p()\mass/Sqr(dx*dx+dy*dy);<-mass/distance
    af2=*p\mass/Sqr(dx*dx+dy*dy);<-mass/distance
    *p\mx+dx*af1:*p\my+dy*af1
    p()\mx-dx*af2:p()\my-dy*af2
  Wend
  ChangeCurrentElement(p(),*p);<-popItem
Next
Return

Posted: Fri Dec 26, 2003 12:51 am
by tinman
Excellent! I could sit and watch those things fly around all day (or at least, while I'm in this JD induced haze ;)

What was your nick during your Blitz2 days? Did you ever submit to the BUM or post much to the mailing list? I always enjoy finding out what people are up to nowadays :)

Posted: Fri Dec 26, 2003 3:10 pm
by Psychophanta
What was your nick during your Blitz2 days? Did you ever submit to the BUM or post much to the mailing list? I always enjoy finding out what people are up to nowadays :)
My nick was "Fenotipo" or AL, but i didn't submit my codes. I used BUM examples codes to learn. As well said Fred: "Functional examples is the best way to learn"; ...and the faster and pleasant way; and i am absolutely in accordance.
I have some things made with amiga BB2, and i am waiting that Fred include single-buffer for Sprite-Screen lib to translate it to PB, because to translate it to double-buffering is hard.
I finished a program to edit files in HEX, with Search by ASC, HEX, and DEC functions with wildcards, ability to insert a file in the wanted location, delete a marked block, insert bytes, delete bytes, etc. I use it sometimes with WinUAE instead UltraEdit, because it is powerful. I made it because in those times there was no HEX-Edit program to insert nor delete bytes inside a file; NOTHING, neither for amiga nor for PC.
I really found easy programming with BB2, and i know PB thanks to BlitzBasic for PC.
I enjoy PB now, because its incredible power, its ability to include ASM, its easy programming, etc, etc.
But for me it's very very difficult to understand why PB for windows is not more extended all over the world. 8O

Posted: Fri Dec 26, 2003 5:03 pm
by Danilo
Psychophanta wrote:and i am waiting that Fred include single-buffer for Sprite-Screen
lib to translate it to PB, because to translate it to double-buffering
is hard.
If you dont want to wait a long time, take a look at the
SpriteEx addon library from Stefan Moebius.

The command DisplayDirect() allows you to draw directly on
the front buffer without flipping.

Posted: Fri Dec 26, 2003 8:18 pm
by Psychophanta
I like that lib. It is fast.
CopyScreenPart() is about 3.5 times faster than GrabSprite() (in default mode) PB function. :o
This is a nice lib to translate my codes to PB easely. Thanx Danilo.

It emulates a single-buffer perfectly with DisplayDirect() function.
Some of my BB2 tips, need real time drawing.

A question: Do you know why Moebious doesn't participate in this forum?

Thanks again :)

Posted: Fri Dec 26, 2003 9:42 pm
by Danilo
Psychophanta wrote:A question: Do you know why Moebious doesn't participate in
this forum?
German community needs some secrets... :lol:

Maybe he wanted to translate the documentation to english
before putting it here, dont know.

Posted: Sat Dec 27, 2003 1:23 am
by Psychophanta
Maybe he wanted to translate the documentation to english
before putting it here
Not needed documentation, that's not an american merchant product for plebs, the functions included in the examples is more than enought documentation :wink:
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited