Page 1 sur 1
Un petit délire - Lotus Démo
Publié : lun. 28/mars/2011 21:27
par djes
Code : Tout sélectionner
;********************************
;*
;* LOTUS DEMO
;* djes 28/03/2011
;*
;********************************
Procedure FilterCallback(x, y, SourceColor, TargetColor)
r.l = (0.5 * Sqr((x - 64) * (x - 256) + (y - 256) * (y - 256) ))
v.l = (0.5 * Sqr((x - 256) * (x - 64) + (y - 256) * (y - 64) ))
b.l = (0.5 * Sqr((x - 256) * (x - 256) + (y - 64) * (y - 256) ))
a.l = (256 * (512 - Sqr((x - 256) * (x - 256) + (y - 256) * (y - 256) )))
u%255
ProcedureReturn RGBA(r, v, b, a)
EndProcedure
If InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester("Error", "Sprite system can't be initialized", 0)
End
EndIf
If InitSprite3D() = 0
MessageRequester("Error", "Sprite3D system can't be initialized correctly", 0)
End
EndIf
If OpenWindow(0, 0, 0, 512, 512, "Un écran dans une fenêtre...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0), 0, 0, 512, 512, 0, 0, 0)
If CreateImage(0, 512, 512, 32) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0, 0, 512, 512, $00000000)
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@FilterCallback())
Circle( 256, 256, 256 )
StopDrawing()
EndIf
If StartDrawing(ScreenOutput())
DrawImage(ImageID(0), 0, 0)
StopDrawing()
EndIf
GrabSprite(0, 0, 0, 512, 512, #PB_Sprite_Texture|#PB_Sprite_AlphaBlending)
For u = 0 To 31
CreateSprite3D(u, 0)
Next u
Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)
i.f = 0
bl_src = 2
bl_dst = 6
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_Gadget
If EventGadget() = 0
End
EndIf
Case #PB_Event_CloseWindow
End
EndSelect
FlipBuffers()
ClearScreen(RGB(0,50,128))
If Start3D()
Sprite3DBlendingMode(bl_src, bl_dst)
For u = 0 To 31
w = 512 * Sin(i + u * 5)
h = 512 * Sin(i + u * 5)
ZoomSprite3D(u, w, h)
RotateSprite3D(u, i * 100 + u * 5, 0)
DisplaySprite3D(u, 256 - w / 2 - 8 * Sin(i * u), 256 - h / 2 - 8 * Cos(i * u), 127)
Next u
Stop3D()
EndIf
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Up)
bl_src + 1
EndIf
If KeyboardReleased(#PB_Key_Down)
bl_src - 1
EndIf
If KeyboardReleased(#PB_Key_Left)
bl_dst + 1
EndIf
If KeyboardReleased(#PB_Key_Right)
bl_dst - 1
EndIf
i+0.01
Until KeyboardPushed(#PB_Key_Escape)
Else
MessageRequester("Erreur", "Can't open a screen !", 0)
End
EndIf
Else
MessageRequester("Error", "Can't open a window !", 0)
EndIf
End
Re: Un petit délire - Lotus Démo
Publié : lun. 28/mars/2011 21:29
par TazNormand
Superbe, reste plus qu'à en faire un économiseur d'écran.
Bravo Djes !!!
Edit : Juste pour voir, j'ai changé 2/3 valeur pour une résolution de 1280*1024 :
Code : Tout sélectionner
;********************************
;*
;* LOTUS DEMO
;* djes 28/03/2011
;*
;********************************
Procedure FilterCallback(x, y, SourceColor, TargetColor)
r.l = (0.5 * Sqr((x - 64) * (x - 256) + (y - 256) * (y - 256) ))
v.l = (0.5 * Sqr((x - 256) * (x - 64) + (y - 256) * (y - 64) ))
b.l = (0.5 * Sqr((x - 256) * (x - 256) + (y - 64) * (y - 256) ))
a.l = (256 * (512 - Sqr((x - 256) * (x - 256) + (y - 256) * (y - 256) )))
u%255
ProcedureReturn RGBA(r, v, b, a)
EndProcedure
If InitSprite() = 0 Or InitKeyboard() = 0
MessageRequester("Error", "Sprite system can't be initialized", 0)
End
EndIf
If InitSprite3D() = 0
MessageRequester("Error", "Sprite3D system can't be initialized correctly", 0)
End
EndIf
If OpenWindow(0, 0, 0, 1280, 1024, "Un écran dans une fenêtre...", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If OpenWindowedScreen(WindowID(0), 0, 0, 1280, 1024, 0, 0, 0)
If CreateImage(0, 1024,1024, 32) And StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_AlphaChannel)
Box(0, 0, 1024,1024, $00000000)
DrawingMode(#PB_2DDrawing_CustomFilter)
CustomFilterCallback(@FilterCallback())
Circle( 256, 256, 256 )
StopDrawing()
EndIf
If StartDrawing(ScreenOutput())
DrawImage(ImageID(0), 0, 0)
StopDrawing()
EndIf
GrabSprite(0, 0, 0, 1024,1024, #PB_Sprite_Texture|#PB_Sprite_AlphaBlending)
For u = 0 To 31
CreateSprite3D(u, 0)
Next u
Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)
i.f = 0
bl_src = 2
bl_dst = 6
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_Gadget
If EventGadget() = 0
End
EndIf
Case #PB_Event_CloseWindow
End
EndSelect
FlipBuffers()
ClearScreen(RGB(0,50,128))
If Start3D()
Sprite3DBlendingMode(bl_src, bl_dst)
For u = 0 To 31
w = 1024 * Sin(i + u * 5)
h = 1024 * Sin(i + u * 5)
ZoomSprite3D(u, w, h)
RotateSprite3D(u, i * 100 + u * 5, 0)
DisplaySprite3D(u, 640 - w / 2 - 8 * Sin(i * u), 512 - h / 2 - 8 * Cos(i * u), 127)
Next u
Stop3D()
EndIf
ExamineKeyboard()
If KeyboardReleased(#PB_Key_Up)
bl_src + 1
EndIf
If KeyboardReleased(#PB_Key_Down)
bl_src - 1
EndIf
If KeyboardReleased(#PB_Key_Left)
bl_dst + 1
EndIf
If KeyboardReleased(#PB_Key_Right)
bl_dst - 1
EndIf
i + 0.01
Until KeyboardPushed(#PB_Key_Escape)
Else
MessageRequester("Erreur", "Can't open a screen!", 0)
End
EndIf
Else
MessageRequester("Error", "Can't open a window!", 0)
EndIf
End
Re: Un petit délire - Lotus Démo
Publié : lun. 28/mars/2011 22:49
par Torp
Super Jolie !
Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 9:06
par kelebrindae
Très beau, et en très peu de code; on reconnaît la patte d'un ancien demo-maker...
Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 10:19
par Ar-S
Ah c'est chouette, par contre ou changer la vitesse ? J'ai viré l'openwindowscreen et la windows pour les remplacer par un openscreen et du coup, ça marche bien mais ça bombarde trop !
Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 10:27
par djes
Le petit "i + 0.01" du bas

Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 11:30
par Ar-S
effectivement, avec i + 0.001 ça le fait bien mieux

Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 11:36
par flaith
C'est Thérèse au lit

Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 17:03
par venom
Sympa ton effet Djes
Bravo
@++
Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 17:45
par Le Soldat Inconnu
oui, très zoli

Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 17:58
par djes
Merci merci... Les nouvelles fonctions de remplissage sont du tonnerre

Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 18:49
par Patrick88
compatible mac, très zouli
pat
Re: Un petit délire - Lotus Démo
Publié : mar. 29/mars/2011 19:56
par SPH
tres beau
