Un petit délire - Lotus Démo

[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   

[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

[Torp]

Super Jolie !

[kelebrindae]

Très beau, et en très peu de code; on reconnaît la patte d'un ancien demo-maker...

[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 !

[djes]

Le petit "i + 0.01" du bas

[Ar-S]

effectivement, avec i + 0.001 ça le fait bien mieux

[flaith]

C'est Thérèse au lit

[venom]

Sympa ton effet Djes
Bravo





@++

[Le Soldat Inconnu]

oui, très zoli

[djes]

Merci merci... Les nouvelles fonctions de remplissage sont du tonnerre

[Patrick88]

compatible mac, très zouli

pat

[SPH]

tres beau