Modulographe

[Comtois]

Code updated for 5.20+

Code: Select all

;Code original par Atreides 
;http://forum.games-creators.org/showthread.php?t=290

Procedure Erreur(Message$)
  MessageRequester( "Erreur" , Message$ , 0 )
  End
EndProcedure

;-Initialisation
ScreenWidth = 640
ScreenHeight = 480
If InitSprite() = 0 Or InitKeyboard()=0
  Erreur("Impossible d'initialiser DirectX 7 Ou plus")
ElseIf OpenScreen(ScreenWidth, ScreenHeight, 32, "demo") = 0
  Erreur("Impossible de créer la fenêtre")
EndIf

Global milieux, milieuy
size = 80
Delta = 0  
milieux = ScreenWidth  / 2 - 2 * size
milieuy = ScreenHeight / 2 - 2 * size

CreateSprite(0, size * 4 + 1, size * 4 + 1)

Procedure affiche()
  DisplaySprite(0,milieux, milieuy)
  FlipBuffers()
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    End
  EndIf  
EndProcedure

Repeat
  
  a = 2 * size
  b = size * 0.6 + Random(a - (size * 0.6))
  c = size * Pow(0.6, 2) + Random(b - (size * Pow(0.6, 2)))
  d = size * Pow(0.6, 3) + Random(c - (size * Pow(0.6, 3)))
  e = size * Pow(0.6, 4) + Random(d - (size * Pow(0.6, 4)))
  
  Dim couleur(e)
  
  For t = 1 To e
    couleur(t) = RGB(Delta + Random(255 - Delta), Delta + Random(255 - Delta), Delta + Random(255 - Delta))
  Next t
  
  For x = a To 0 Step -1
    StartDrawing(SpriteOutput(0))
    For y = x To 0 Step -1
      var = (((((x*y % a) % b) % c) % d) % e)
      coul = couleur(var)
      FrontColor(RGB(Green(coul), Green(coul), Green(coul)))
      ;M=(Red(coul)+Green(coul)+Blue(coul))/3
      ;FrontColor(M,M,M)
      Plot(y, x)
      Plot(x, y)
      Plot(y, 2 * a - x)
      Plot(x, 2 * a - y)
      Plot(2 * a - y , 2 * a - x)
      Plot(2 * a - x , y)
      Plot(2 * a - x , 2 * a - y)
      Plot(2 * a - y , x)
    Next y
    StopDrawing()
    affiche()
  Next x
  
  ;Efface
  For x = 0 To a 
    StartDrawing(SpriteOutput(0)) 
    For y = 0 To x 
      Plot(y, x, 0)
      Plot(x, y, 0)
      Plot(y, 2 * a - x, 0)
      Plot(x, 2 * a - y, 0)
      Plot(2 * a - y , 2 * a - x, 0)
      Plot(2 * a - x , y, 0)
      Plot(2 * a - x , 2 * a - y, 0)
      Plot(2 * a - y , x, 0)
    Next y
    StopDrawing()
    affiche()
  Next x
ForEver

[Tommeh]

Very nice And in such little code, good job!

[MrMat]

That's a nice effect

[traumatic]

Nice!