Basic Univers
#Titre = "Antigrave"
#Info1 = "Clic gauche : place le centre de gravité"
#Info2 = "Clic droit : augmente/diminue la gravité"
#Info3 = "Barre espace : inverse l'effet du clic droit"
#Info=#Info1+#LF$ +#Info2+#LF$ +#Info3
MessageRequester(#Titre, #Info)
Procedure.f Deg2Rad(a.l)
ProcedureReturn a*180/#PI
EndProcedure
Enumeration
#Bob_Boule
#Bob_Souris_B
#Bob_Souris_R
EndEnumeration
Global RBowl, GBowl, BBowl
Procedure BowlDot(X, Y, Lum.f)
Dist.f = Sqr(Pow(X - 3.5, 2)+ Pow(Y - 3.5, 2))/13.5
If Dist>1 : Dist = 1 : EndIf
CC = 240*(1 - Dist)*Lum
Dist*Lum
Plot(X, Y, RGB(CC + RBowl*Dist, CC + GBowl*Dist, CC + BBowl*Dist))
EndProcedure
Procedure DrawBowl(Coul.l)
RBowl = Red(Coul)
GBowl = Green(Coul)
BBowl = Blue(Coul)
For X = 0 To 7
For Y = 0 To 7
If X*X + Y*Y<= 50
If(X + 1)*(X + 1)+ Y*Y>50 Or X*X +(Y + 1)*(Y + 1)>50
Lum.f = 0.5
Else
Lum.f = 1
EndIf
BowlDot(7 - X, 7 - Y, Lum)
BowlDot(7 - X, 8 + Y, Lum)
BowlDot(8 + X, 7 - Y, Lum)
BowlDot(8 + X, 8 + Y, Lum)
EndIf
Next
Next
EndProcedure
Procedure.l CreeSouris()
If CreateSprite(#Bob_Souris_B, 32, 32) And StartDrawing(SpriteOutput(#Bob_Souris_B))
FrontColor(RGB(0, 0, 120))
LineXY(0, 0, 31, 0)
LineXY(0, 0, 0, 31)
LineXY(10, 6, 31, 0)
LineXY(10, 6, 31, 31)
LineXY(6, 10, 0, 31)
LineXY(6, 10, 31, 31)
FillArea(1, 1, RGB(0, 0, 120), RGB(0, 0, 180))
StopDrawing()
If CreateSprite(#Bob_Souris_R, 32, 32) And StartDrawing(SpriteOutput(#Bob_Souris_R))
FrontColor(RGB(120, 0, 0))
LineXY(0, 0, 31, 0)
LineXY(0, 0, 0, 31)
LineXY(10, 6, 31, 0)
LineXY(10, 6, 31, 31)
LineXY(6, 10, 0, 31)
LineXY(6, 10, 31, 31)
FillArea(1, 1, RGB(120, 0, 0), RGB(180, 0, 0))
StopDrawing()
ProcedureReturn 1
EndIf
EndIf
EndProcedure
#ScrW = 640
#ScrH = 480
#ScrDepth = 16
#AutoStretch = 0
#WinStyle=#PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_MinimizeGadget|((#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)*#AutoStretch)
Global PleinEcran.l
Procedure.l Initiale()
Select MessageRequester(#Titre, "Plein écran ?", #PB_MessageRequester_YesNo)
Case 6
PleinEcran = 1
If InitSprite() And InitKeyboard() And InitMouse() And OpenScreen(#ScrW, #ScrH, #ScrDepth, #Titre)
OK = 1
EndIf
Case 7
If InitSprite() And OpenWindow(0, 0, 0, #ScrW, #ScrH, #Titre, #WinStyle) And OpenWindowedScreen(WindowID(0), 0, 0, #ScrW, #ScrH, #AutoStretch, 0, 0)
OK = 1
EndIf
EndSelect
If OK And CreateSprite(#Bob_Boule, 16, 16) And StartDrawing(SpriteOutput(#Bob_Boule))
Box(0, 0, 16, 16, $FF00FF)
DrawBowl(0)
StopDrawing()
TransparentSpriteColor(#Bob_Boule, RGB(255, 0, 255))
If PleinEcran
If CreeSouris()= 0 : ProcedureReturn 0 : EndIf
MouseLocate(#ScrW/2, #ScrH/2)
EndIf
ProcedureReturn 1
EndIf
EndProcedure
Structure Souris
X.l : Y.l
BtG.l : BtD.l
PtrBob.l
EndStructure
Global Souris.Souris , Quitt.l , Barresp.l
Procedure Flippon()
If PleinEcran
ExamineMouse()
Souris\X = MouseX()
Souris\Y = MouseY()
Souris\BtG = MouseButton(1)
Souris\BtD = MouseButton(2)
ExamineKeyboard()
Quitt = KeyboardPushed(#PB_Key_Escape)
Barresp = KeyboardReleased(#PB_Key_Space)
DisplayTransparentSprite(Souris\PtrBob, Souris\X, Souris\Y)
FlipBuffers()
While IsScreenActive()= 0
Delay(20)
FlipBuffers()
Wend
Else
While Quitt = 0 And IsIconic_(WindowID(0))
If WaitWindowEvent()=#PB_Event_CloseWindow : Quitt = 1 : EndIf
Wend
Barresp = 0
Repeat
Select WindowEvent()
Case 0 : Break
Case #WM_LBUTTONDOWN : Souris\BtG = 1
Case #WM_LBUTTONUP : Souris\BtG = 0
Case #WM_RBUTTONDOWN : Souris\BtD = 1
Case #WM_RBUTTONUP : Souris\BtD = 0
Case #PB_Event_CloseWindow : Quitt = 1
Case #WM_CHAR
Select EventwParam()
Case 27 : Quitt = 1
Case 32 : Barresp = 1
EndSelect
EndSelect
ForEver
m = WindowMouseX(0)
If m<= 0
Souris\X = 0
ElseIf m>=#ScrW
Souris\X =#ScrW - 1
Else
Souris\X = m
EndIf
m = WindowMouseY(0)
If m<= 0
Souris\Y = 0
ElseIf m>=#ScrH
Souris\Y =#ScrH - 1
Else
Souris\Y = m
EndIf
FlipBuffers()
EndIf
ClearScreen(0)
EndProcedure
Procedure ActuPtr(Mode)
Static OldMode.l
If Mode<>OldMode
OldMode = Mode
If PleinEcran
If Mode>0
Souris\PtrBob =#Bob_Souris_R
Else
Souris\PtrBob =#Bob_Souris_B
EndIf
Else
If Mode>0
SetWindowTitle(0, "Augmenter la gravité")
Else
SetWindowTitle(0, "Diminuer la gravité")
EndIf
EndIf
EndIf
EndProcedure
Structure Bouboule
X.f : Y.f : VX.f : VY.f
EndStructure
#nbBoules = 300
Global Dim Boules.Bouboule(#nbBoules - 1)
For b = 0 To #nbBoules - 1
Ang.f = Deg2Rad(Random(359))
Vit.f = Random(3000)/1000
Boules(b)\VX = Vit*Sin(Ang)
Boules(b)\VY = Vit*Cos(Ang)
Next
Global CenterX.f , CenterY.f , Pulse.f
Procedure TraiteBoules()
For b = 0 To #nbBoules - 1
VX.f = Boules(b)\VX
VY.f = Boules(b)\VY
X.f = Boules(b)\X + VX
If X<0
X = 0
VX =- VX
ElseIf X>#ScrW - 16
X =#ScrW - 16
VX =- VX
EndIf
Y.f = Boules(b)\Y + VY
If Y<0
Y = 0
VY =- VY
ElseIf Y>#ScrH - 16
Y =#ScrH - 16
VY =- VY
EndIf
For b2 = b - 1 To 0 Step - 1
X2.f = X - Boules(b2)\X
Y2.f = Y - Boules(b2)\Y
sX2 = X2/Abs(X2) : sY2 = Y2/Abs(Y2)
X2*X2 : Y2*Y2
SXY.f = X2 + Y2
Dist.f = Sqr(SXY)
If Dist>0.00001
X2/SXY : Y2/SXY
Accel.f = 1/Dist
VX +(Accel*Sqr(X2)*sX2)
VY +(Accel*Sqr(Y2)*sY2)
EndIf
Next
For b2 = b + 1 To #nbBoules - 1
X2.f = X - Boules(b2)\X
Y2.f = Y - Boules(b2)\Y
sX2 = X2/Abs(X2) : sY2 = Y2/Abs(Y2)
X2*X2 : Y2*Y2
SXY.f = X2 + Y2
Dist.f = Sqr(SXY)
If Dist>0.00001
X2/SXY : Y2/SXY
Accel.f = 1/Dist
VX +(Accel*Sqr(X2)*sX2)
VY +(Accel*Sqr(Y2)*sY2)
EndIf
Next
Boules(b)\X = X +(CenterX - X)*Pulse
Boules(b)\Y = Y +(CenterY - Y)*Pulse
Boules(b)\VX = VX*0.85
Boules(b)\VY = VY*0.85
DisplayTransparentSprite(#Bob_Boule, X, Y)
Next
EndProcedure
PulseM = 1
If Initiale()
Repeat
If Souris\BtD
PulseI =(PulseI + PulseM)&1023
If PulseI = 0 : PulseM =- PulseM : EndIf
Pulse = PulseI*0.001
EndIf
If Souris\BtG
CenterX = Souris\X
CenterY = Souris\Y
EndIf
If Barresp
PulseM =- PulseM
EndIf
ActuPtr(PulseM)
TraiteBoules()
Flippon()
Until Quitt
EndIf
