[Challenge] Bump mapping 2D

Sujets variés concernant le développement en PureBasic
Répondre
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

Très abouti ton programme ^^
Dommage qu'il rame (comme les autres lol)

Dri :10:
Haut
Anonyme

Message par Anonyme »

Tu as fait en sorte que l'on puisse choisir une Envmap, ou si tu préfères une forme de lumière, mais lorsque que j'en choisie une, la lumière déconne, à prioris, lors du passage Fichier image -> Tableau Envmap()
tu lui attribue certainement les valeurs RGB de 0 a 255.
Or, l'envmap() de base (modèle lambert) que tu utilise a des valeurs allant de 0 a 6 ou 7 maxi.
Haut
Anonyme

Message par Anonyme »

Voila , on est samedi (d'ailleur le forum à une heure de retard), voici ma source d'un Bump tout simple.
j'ai tout mis sous formes de procédures pour que cela soit réutilisable.

Code : Tout sélectionner

;BUMP MAPPING BASIC
;PAR CPL.BATOR


Procedure CreationLumiere(Size.l,LightIntensity.l)
Protected NormalX.f,NormalY.f,NormalZ.f
Global EnvMapSize.l

EnvMapSize = Size

Global Dim Light(Size,Size) ; Tableau qui va contenir l'intensité de la lumière
                             ; Pour cette exemple c'est une lumière circulaire (omnidirectionnel)
                             ; La lumière peut etre fabriquer à partir d'un Bitmap , mais attention
                             ; Les calculs de l'intensité de vont pas de 0 à 255 , il vont dans cette
                             ; exemple de 0 à 5 ou 6 "1-Sqr((Pow(NormalX,2)) + (Pow(NormalY,2)))"
For y = 0 To Size
For x = 0 To Size

 NormalX = (x-(Size/2))/(Size/4)
 NormalY = (y-(Size/2))/(Size/4)
 NormalZ = 1-Sqr((Pow(NormalX,2)) + (Pow(NormalY,2)))
 
If NormalZ<=0 : NormalZ=0 : EndIf
Light(x,y) = (LightIntensity * NormalZ)

Next x
Next y

EndProcedure



Procedure LoadBumpImage(ImageID.l,File$)
Protected Color.l

LoadImage(ImageID,File$)

Global Dim BumpImage(ImageWidth(ImageID),ImageHeight(ImageID)) ; Ici va etre ranger l'image qui va servir de bump
                                                                 ; Les valeurs qui vont etre stockés vont etre additionnée 
StartDrawing(ImageOutput(ImageID))                               ; à Light afin d'obtenir une "pertubation" qui simule le relief
 For  y = 0 To ImageHeight(ImageID)-1
  For  x = 0 To ImageWidth(ImageID)-1
   Color.l = Point(x,y) ; peut etre optimiser avec DrawingBuffer()
    BumpImage(x,y)=  (Red(Color) + Blue(Color) + Green(Color) ) / 3 ; Calcul simple pour convertir une image en niveau de gris
   Next                                                             
  Next
 StopDrawing()
 
EndProcedure





Procedure Bumping(ImageID.l,Light_X.l,Light_Y.l)

Shared LightX.l,LightY.l
Shared NLightX.l,NLightY.l
Shared Normal_X.l,Normal_Y.l
Shared Color.l



LightX = Light_X 
LightY = Light_Y


StartDrawing(ScreenOutput())

 For  y = 0 To ImageHeight(ImageID)-1
  For  x = 0 To ImageWidth(ImageID)-1

If x > 0 And x < ImageWidth(ImageID)-2 And y > 0 And y < ImageHeight(ImageID)-2 ; on controle bien que X & Y 
                                                                                 ; ne sort pas du tableau 
                                                                                 ; de cette manière les lignes aux extrémités ne sont pas pris en compte 
   Normal_X = (BumpImage(x+1,y)-BumpImage(x-1,y))                                ; il faudrait d'autre if-endif pour les prendres en comptes 
   Normal_Y = (BumpImage(x,y+1)-BumpImage(x,y-1))


   NLightX = X-LightX 
   NLightY = Y-LightY
   Normal_X=Normal_X + NLightX   
   Normal_Y=Normal_Y + NLightY  
   Normal_X=Normal_X + (EnvMapSize/2) ; on postionne la lumiere au centre de LigthX & Y  
   Normal_Y=Normal_Y + (EnvMapSize/2)


 If Normal_X<=0                 :  Normal_X=0                : EndIf
 If Normal_Y<=0                 :  Normal_Y=0                : EndIf
 If Normal_X=>EnvMapSize        :  Normal_X=EnvMapSize       : EndIf
 If Normal_Y=>EnvMapSize        :  Normal_Y=EnvMapSize       : EndIf
   


Color  = RGB(Light(Normal_X,Normal_Y),Light(Normal_X,Normal_Y),Light(Normal_X,Normal_Y)) ; On recupere la valeur de la lumière suivant la normal
                                                                                         ; on peut aussi modifier la couleur de la lumière  
Plot(x,y,Color) ; on l'affiche
 
 
EndIf

  Next x
Next y

StopDrawing()


EndProcedure


InitSprite()
InitKeyboard() : InitMouse()

OpenScreen(640,480,32,"Bump")
 CreationLumiere(512,200)
  LoadBumpImage(1,"Bump.bmp")


;-Boucle Principale
Repeat
 ExamineKeyboard() : ExamineMouse()
  Bumping(1,MouseX(),MouseY())
   FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape)
Haut
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

Voila mon code ^^

Code : Tout sélectionner

Structure BumpRGBA
  r.b
  g.b
  b.b
  a.b
EndStructure

Structure BumpColor
  StructureUnion
    Color.l
    RGBA.BumpRGBA
  EndStructureUnion
EndStructure

Procedure BumpMin(a, b)
  If a > b : a = b : EndIf
  ProcedureReturn a
EndProcedure

Procedure BumpMax(a, b)
  If a < b : a = b : EndIf
  ProcedureReturn a
EndProcedure

Macro BumpClamp(Value, Min, Max)
  BumpMin(BumpMax(Value, Min), Max)
EndMacro

Dim BumpNormals.b(0, 0)
Dim BumpPixels.b(0, 0)
Define.l BumpWidth, BumpHeight

Procedure BumpInit()
  Protected i, j, x.f, y.f, z.f
  Shared BumpNormals()
  
  Dim BumpNormals.b($FF, $FF)
  
  For j = $00 To $FF
    For i = $00 To $FF
      x = (i - 128) / 128.0
      y = (j - 128) / 128.0
      z = 1 - Sqr(x*x + y*y)
      
      If z >= 0
        BumpNormals(i, j) = Int(z * 256)
      EndIf
    Next i
  Next j
  
  BumpNormals(128, 128) = $FF
EndProcedure

Procedure BumpPrepare(Sprite)
  Protected x, y
  Shared BumpPixels(), BumpWidth, BumpHeight
  
  If StartDrawing( SpriteOutput(Sprite) )
    BumpWidth  = SpriteWidth (Sprite)
    BumpHeight = SpriteHeight(Sprite)
    Dim BumpPixels.b(BumpWidth+1, BumpHeight+1)
    
    For y = 1 To BumpHeight
      For x = 1 To BumpWidth
        Temp.BumpColor\Color = Point(x-1, y-1)
        BumpPixels(x, y) = ((Temp\RGBA\r & $FF) + (Temp\RGBA\g & $FF) + (Temp\RGBA\b & $FF)) / 3
      Next x
    Next y
    
    StopDrawing()
  EndIf
EndProcedure

Procedure Bump(Sprite, LightX = 0, LightY = 0, Color = #White)
  Protected Light.BumpColor, x, y, Source.b, Target.BumpColor
  Protected DeltaX.b, DeltaY.b, Normal, Drawing
  Shared BumpNormals(), BumpPixels(), BumpWidth, BumpHeight
  
  If SpriteWidth(Sprite) = BumpWidth And SpriteHeight(Sprite) = BumpHeight
    Drawing = StartDrawing( SpriteOutput(Sprite) )
  EndIf
  
  If Drawing
    LightX + 127
    LightY + 127
    Light\Color = Color
    
    For y = 1 To BumpHeight
      For x = 1 To BumpWidth
        DeltaX = BumpPixels(x+1, y)
        Source = BumpPixels(x-1, y)
        DeltaX - Source
        
        DeltaY = BumpPixels(x, y+1)
        Source = BumpPixels(x, y-1)
        DeltaY - Source
        
        DeltaX = BumpClamp(DeltaX + LightX - x, $00, $FF)
        DeltaY = BumpClamp(DeltaY + LightY - y, $00, $FF)
        
        Normal = BumpNormals(DeltaX & $FF, DeltaY & $FF) & $FF
        
        Target\RGBA\r = Normal * (Light\RGBA\r & $FF) / $FF
        Target\RGBA\g = Normal * (Light\RGBA\g & $FF) / $FF
        Target\RGBA\b = Normal * (Light\RGBA\b & $FF) / $FF
        
        Plot(x-1, y-1, Target\Color)
      Next x
    Next y
    
    StopDrawing()
  EndIf
EndProcedure

BumpInit()

Enumeration
  #Sprite_Base
  #Sprite_Bump
  #Sprite_Load
EndEnumeration

If InitSprite() = 0
  MessageRequester("Error", "Can't open screen & sprite enviroment!", #MB_ICONERROR)
  End
EndIf

If OpenWindow(0, 0, 0, 640, 480, "Bump", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If OpenWindowedScreen(WindowID(0), 0, 0, 640, 480, 0, 0, 0)
  Else
    MessageRequester("Error", "Can't open windowed screen!", #MB_ICONERROR)
    End
  EndIf
EndIf

w = 640
h = 480
If Not (CreateSprite(#Sprite_Base, w, h) And CreateSprite(#Sprite_Bump, w, h))
  MessageRequester("Error", "Can't create the sprite!", #MB_ICONERROR)
  End
EndIf

UsePNGImageDecoder()
If Not LoadSprite(#Sprite_Load, "bump.png")
  MessageRequester("Error", "Can't load the sprite bump.png!", #MB_ICONERROR)
  End
EndIf

If UseBuffer(#Sprite_Base)
  w - SpriteWidth (#Sprite_Load)
  h - SpriteHeight(#Sprite_Load)
  DisplaySprite(#Sprite_Load, w/2, h/2)
  w + SpriteWidth (#Sprite_Load)
  h + SpriteHeight(#Sprite_Load)
  FreeSprite(#Sprite_Load)
  UseBuffer(#PB_Default)
EndIf

BumpPrepare(#Sprite_Base)

r = 192
g = 192
b = 192

While rdir = 0 Or gdir = 0 Or bdir = 0
  If Not rdir : rdir = Random(2) - 1 : EndIf
  If Not gdir : gdir = Random(2) - 1 : EndIf
  If Not bdir : bdir = Random(2) - 1 : EndIf
Wend

Repeat
  Repeat
    Event = WindowEvent()
    
    If Event = #PB_Event_CloseWindow
      End
    EndIf
  Until Not Event
  
  x = WindowMouseX(0)
  y = WindowMouseY(0)
  
  If x = #PB_Any
    x = Cos(tick / 5) * w / 3 + w / 2
    y = Sin(tick / 8) * h / 3 + h / 2
  EndIf
  
  tick + 1
  
  r + rdir * Random(3)
  g + gdir * Random(3)
  b + bdir * Random(3)
  
  If r <> BumpClamp(r, $80, $FF) : rdir = -rdir : EndIf
  If g <> BumpClamp(g, $80, $FF) : gdir = -gdir : EndIf
  If b <> BumpClamp(b, $80, $FF) : bdir = -bdir : EndIf
  
  r = BumpClamp(r, $80, $FF)
  g = BumpClamp(g, $80, $FF)
  b = BumpClamp(b, $80, $FF)
  
  Bump(#Sprite_Bump, x, y, RGB(r, g, b))
  DisplaySprite(#Sprite_Bump, 0, 0)
  
  If StartDrawing( ScreenOutput() )
    StopDrawing()
  EndIf
  
  FlipBuffers()
ForEver
Dri
Haut
AWEAR
Messages : 264
Inscription : ven. 28/oct./2005 8:20
Localisation : Mayotte ( 976 ), Océan Indien, France

Message par AWEAR »

Bon ben je doit vraiement pas être doué parce que je n'ai réussi qu'a faire ca :

Code : Tout sélectionner

UsePNGImageDecoder()
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()

image = LoadImage(#PB_Any, OpenFileRequester("", "", "", 0))

If image = 0 Or ImageOutput() = 0
MessageRequester("Erreur lors du chargement de l'image", "Fin du programme", 16)
End
EndIf

w = ImageWidth() - 1
h = ImageHeight() - 1
w2 = w/2
h2 = h/2
w3 = w/4
h3 = h/4
dist.f = Sqr((w2-w3)*(w2-w3)+(h2-h3)*(h2-h3))

Dim Lumiere(w, h)

For x = 0 To w
For y = 0 To h
c = 255 - 255 * Sqr((w2-x)*(w2-x)+(h2-y)*(h2-y)) / dist
If c < 0
c = 0
EndIf
Lumiere(x, y) = c<<16 + c<<8 + c
Next
Next

Dim Map(w, h, 1)

StartDrawing(ImageOutput())
For x = 0 To w
For y = 0 To h
If x = 0
Map(x, y, 0) = Point(x + 1, y)
ElseIf x = w
Map(x, y, 0) = -Point(x - 1, y)
Else
Map(x, y, 0) = Point(x + 1, y) - Point(x - 1, y)
EndIf
If y = 0
Map(x, y, 1) = Point(x, y + 1)
ElseIf y = h
Map(x, y, 1) = -Point(x, y - 1)
Else
Map(x, y, 1) = Point(x, y + 1) - Point(x, y - 1)
EndIf
Next
Next
StopDrawing()

InitSprite()
InitKeyboard()
InitMouse()
OpenWindow(0, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Bump Mapping")
OpenWindowedScreen(WindowID(), 0, 0, w + 1, h + 1, 0, 0, 0)

Repeat
FlipBuffers()
ClearScreen(0, 0, 0)
ExamineKeyboard()
ExamineMouse()
lx + MouseDeltaX()
ly + MouseDeltaY()
StartDrawing(ScreenOutput())
*buffer = DrawingBuffer()
pitch = DrawingBufferPitch()
For x = 0 To w
For y = 0 To h
dx = Map(x, y, 0)
dy = Map(x, y, 1)
ddx = lx - x
ddy = ly - y
dd.f = Sqr(ddx*ddx+ddy*ddy)
d.f = (Sqr(dx*dx+dy*dy)*dd)
If dd =< dist
If d
a.f = -(ddx*dx+ddy*dy) / d
Else
a = 1
EndIf
xx = w2 + ddx
yy = h2 + ddy
If xx >= 0 And xx <= w And yy >=0 And yy <= h And a >=0
g = ((Lumiere(xx, yy) & $FF00) >> 8)*a
b = ((Lumiere(xx, yy) & $FF0000) >> 16)*a
*buff.long = *buffer + pitch * y + x * 4
*buff\l = b<<16 + g<<8 + (Lumiere(xx, yy) & $FF)*a
EndIf
EndIf
Next
Next
StopDrawing()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
Attention, codé en PB 3.94.

J'ai commencé a regadré les 2 autres codes mais j'ai encore un peu de mal (je crois qu'il est plus facile de comprendre son code plutôt que celui des autre)
La vie est une rose dont il faut accepter les épines, mais la mienne est fannée, arrosée par le goût de mes larmes. (Soprano)
Haut
AWEAR
Messages : 264
Inscription : ven. 28/oct./2005 8:20
Localisation : Mayotte ( 976 ), Océan Indien, France

Message par AWEAR »

Version assembleur :

Code : Tout sélectionner

UsePNGImageDecoder()
UseJPEGImageDecoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()


Global y.l, lx.l, dx.l, dy.l, dd.f, d.f, a.f, dist.f, g.l, b.l, c.l, xx.l, yy.l

image = LoadImage(#PB_Any, OpenFileRequester("", "", "", 0))

If image = 0 Or ImageOutput() = 0
MessageRequester("Erreur lors du chargement de l'image", "Fin du programme", 16)
End
EndIf

w = ImageWidth() - 1
h = ImageHeight() - 1
w2 = w/2
h2 = h/2
w3 = w/4
h3 = h/4
dist.f = Sqr((w2-w3)*(w2-w3)+(h2-h3)*(h2-h3))

Dim Lumiere(w, h)

For x = 0 To w
For y = 0 To h
c = 255 - 255 * Sqr((w2-x)*(w2-x)+(h2-y)*(h2-y)) / dist
If c < 0
c = 0
EndIf
Lumiere(x, y) = c<<16 + c<<8 + c
Next
Next

Dim Map(w, h, 1)

StartDrawing(ImageOutput())
For x = 0 To w
For y = 0 To h
If x = 0
Map(x, y, 0) = Point(x + 1, y)
ElseIf x = w
Map(x, y, 0) = -Point(x - 1, y)
Else
Map(x, y, 0) = Point(x + 1, y) - Point(x - 1, y)
EndIf
If y = 0
Map(x, y, 1) = Point(x, y + 1)
ElseIf y = h
Map(x, y, 1) = -Point(x, y - 1)
Else
Map(x, y, 1) = Point(x, y + 1) - Point(x, y - 1)
EndIf
Next
Next
StopDrawing()

InitSprite()
InitKeyboard()
InitMouse()
OpenWindow(0, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Bump Mapping")
OpenWindowedScreen(WindowID(), 0, 0, w + 1, h + 1, 0, 0, 0)

;temps = ElapsedMilliseconds()

Repeat
;!inc [v_cc]
FlipBuffers()
ClearScreen(0, 0, 0)
ExamineKeyboard()
ExamineMouse()
StartDrawing(ScreenOutput())
*buffer = DrawingBuffer()
pitch = DrawingBufferPitch()
lx.l + MouseDeltaX()
ly + MouseDeltaY()
!mov [v_x], 0
!push [v_w]
!inc dword[esp]
!dboucle1:
!mov eax, [v_x]
!cmp eax, [esp]
!jz fboucle1
!mov [v_y], 0
!push [v_h]
!inc dword[esp]
!dboucle2:
!mov eax, [v_y]
!cmp eax, [esp]
!jz fboucle2
!mov ecx, [a_Map]
!mov eax, [v_x]
!mov esi, [v_h]
!inc esi
!mul esi
!rol eax, 1
!mov ebx, [v_y]
!rol ebx, 1
!add ebx, eax
!rol ebx, 2
!add ebx, ecx
!push dword[ebx]
!add ebx, 4
!push dword[ebx]
!mov ebx, [v_lx]
!sub ebx, [v_x]
!push ebx
!mov ebx, [v_ly]
!sub ebx, [v_y]
!push ebx
!fild dword[esp+4]
!fmul st0, st0
!fstp st1
!fild dword[esp]
!fmul st0, st0
!fadd st0, st1
!fsqrt
!fstp [v_dd]
!fild dword[esp+12]
!fmul st0, st0
!fstp st1
!fild dword[esp+8]
!fmul st0, st0
!fadd st0, st1
!fsqrt
!fstp st1
!fld [v_dd]
!fmul st0, st1
!fstp [v_d]
!mov ebx, [v_dd]
!cmp ebx, dword[v_dist]
!jg ifdd
!mov eax, [v_d]
!xor ebx, ebx
!cmp eax, ebx
!jz elsed
!fld [v_d]
!fstp st2
!fild dword[esp+4]
!fimul dword[esp+12]
!fstp st1
!fild dword[esp]
!fimul dword[esp+8]
!fadd st0, st1
!fdiv st0, st2
!fchs
!fstp [v_a]
!jmp find
!elsed:
!mov [v_a], 1
!find:
!mov ebx, [v_w2]
!add ebx, dword[esp+4]
!mov [v_xx], ebx
!mov ebx, [v_h2]
!add ebx, dword[esp]
!mov [v_yy], ebx
!mov eax, [v_xx]
!cmp eax, 0
!jl iflong
!cmp eax, [v_w]
!jg iflong
!mov eax, [v_yy]
!cmp eax, 0
!jl iflong
!cmp eax, [v_h]
!jg iflong
!cmp [v_a], 0
!jl iflong
!push [v_a]
!mov esi, [a_Lumiere]
!mov ebx, [v_h]
!inc ebx
!mov eax, [v_xx]
!mul ebx
!add eax, [v_yy]
!mov ebx, 4
!mul ebx
!add eax, esi
!xor ebx, ebx
!mov bl, byte[eax+1]
!push ebx
!fld dword[esp+4]
!fimul dword[esp]
!fistp [v_g]
!pop ebx
!xor ebx, ebx
!mov bl, byte[eax+2]
!push ebx
!fld dword[esp+4]
!fimul dword[esp]
!fistp [v_b]
!pop ebx
!xor ebx, ebx
!mov bl, byte[eax]
!push ebx
!fld dword[esp+4]
!fimul dword[esp]
!fistp [v_c]
!pop ebx
!mov eax, 65536
!mul [v_b]
!add [v_c], eax
!mov eax, 256
!mul [v_g]
!add [v_c], eax
!mov eax, [v_y]
!mul [v_pitch]
!mov ebx, [v_x]
!rol ebx, 2
!add eax, ebx
!add eax, [p_buffer]
!mov ebx, [v_c]
!mov dword[eax], ebx
!pop eax
!iflong:
!ifdd:
!pop eax
!pop eax
!pop eax
!pop eax
!inc [v_y]
!jmp dboucle2
!fboucle2:
!pop eax
!inc [v_x]
!jmp dboucle1
!fboucle1:
!pop eax
StopDrawing()
Until WindowEvent() = #PB_Event_CloseWindow Or KeyboardPushed(#PB_Key_Escape)
;Debug 1000.0 * cc / (ElapsedMilliseconds() - temps)
Dernière modification par AWEAR le lun. 01/mai/2006 9:36, modifié 2 fois.
La vie est une rose dont il faut accepter les épines, mais la mienne est fannée, arrosée par le goût de mes larmes. (Soprano)
Haut
Anonyme

Message par Anonyme »

tu comprends pas nos codes, mais tu programmes en ASM un bump :D
Haut
AWEAR
Messages : 264
Inscription : ven. 28/oct./2005 8:20
Localisation : Mayotte ( 976 ), Océan Indien, France

Message par AWEAR »

Disons que pour vos codes je n'ai pas fait énormement d'effort (j'étais fatigué, et je n'ai plus regardé depuis), et pour l'assembleur ben c'était pour m'aider à comprendre un peu, et surtout pour avoir des gains de performances (4 à 6 fois plus rapide).
La vie est une rose dont il faut accepter les épines, mais la mienne est fannée, arrosée par le goût de mes larmes. (Soprano)
Haut
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

J'ai modifié mon code pour ajouter la possibilité de changer la taille de la lumière (avec la molette) mais du coup ca crée des problèmes avec l'éclairage...
(Et pis j'attend toujours la source de cederavic ^^)

Code : Tout sélectionner

Structure BumpRGBA
  r.b
  g.b
  b.b
  a.b
EndStructure

Structure BumpColor
  StructureUnion
    Color.l
    RGBA.BumpRGBA
  EndStructureUnion
EndStructure

Procedure BumpMin(a, b)
  If a > b : a = b : EndIf
  ProcedureReturn a
EndProcedure

Procedure BumpMax(a, b)
  If a < b : a = b : EndIf
  ProcedureReturn a
EndProcedure

Macro BumpClamp(Value, Min, Max)
  BumpMin(BumpMax(Value, Min), Max)
EndMacro

Dim BumpNormals.b(0, 0)
Dim BumpPixels.b(0, 0)
Define.l BumpWidth, BumpHeight

Procedure BumpInit()
  Protected i, j, x.f, y.f, z.f
  Shared BumpNormals()
 
  Dim BumpNormals.b($FF, $FF)
 
  For j = $00 To $FF
    For i = $00 To $FF
      x = (i - 128) / 128.0
      y = (j - 128) / 128.0
      z = 1 - Sqr(x*x + y*y)
     
      If z >= 0
        BumpNormals(i, j) = Int(z * 256)
      EndIf
    Next i
  Next j
 
  BumpNormals(128, 128) = $FF
EndProcedure

Procedure BumpPrepare(Sprite)
  Protected x, y
  Shared BumpPixels(), BumpWidth, BumpHeight
 
  If StartDrawing( SpriteOutput(Sprite) )
    BumpWidth  = SpriteWidth (Sprite)
    BumpHeight = SpriteHeight(Sprite)
    Dim BumpPixels.b(BumpWidth+1, BumpHeight+1)
   
    For y = 1 To BumpHeight
      For x = 1 To BumpWidth
        Temp.BumpColor\Color = Point(x-1, y-1)
        BumpPixels(x, y) = ((Temp\RGBA\r & $FF) + (Temp\RGBA\g & $FF) + (Temp\RGBA\b & $FF)) / 3
      Next x
    Next y
   
    StopDrawing()
  EndIf
EndProcedure

Procedure Bump(Sprite, LightX = 0, LightY = 0, LightRadius = 128, Color = #White)
  Protected Light.BumpColor, x, y, Source.b, Target.BumpColor
  Protected DeltaX.l, DeltaY.l, Normal, Drawing
  Shared BumpNormals(), BumpPixels(), BumpWidth, BumpHeight
  
  If SpriteWidth(Sprite) = BumpWidth And SpriteHeight(Sprite) = BumpHeight
    Drawing = StartDrawing( SpriteOutput(Sprite) )
  EndIf
  
  If Drawing
    LightX + LightRadius
    LightY + LightRadius
    Light\Color = Color
    LightRadius * 2
    
    For y = 1 To BumpHeight
      For x = 1 To BumpWidth
        DeltaX = BumpPixels(x+1, y)
        Source = BumpPixels(x-1, y)
        DeltaX - Source
        
        DeltaY = BumpPixels(x, y+1)
        Source = BumpPixels(x, y-1)
        DeltaY - Source
        
        DeltaX = BumpClamp(DeltaX + LightX - x, $00, LightRadius)
        DeltaY = BumpClamp(DeltaY + LightY - y, $00, LightRadius)
        
        DeltaX = (DeltaX * $FF) / LightRadius
        DeltaY = (DeltaY * $FF) / LightRadius
        
        Normal = BumpNormals(DeltaX, DeltaY) & $FF
        
        Target\RGBA\r = Normal * (Light\RGBA\r & $FF) / $FF
        Target\RGBA\g = Normal * (Light\RGBA\g & $FF) / $FF
        Target\RGBA\b = Normal * (Light\RGBA\b & $FF) / $FF
        
        Plot(x-1, y-1, Target\Color)
      Next x
    Next y
    
    StopDrawing()
  EndIf
EndProcedure

BumpInit()

Enumeration
  #Sprite_Base
  #Sprite_Bump
  #Sprite_Load
EndEnumeration

If InitSprite() = 0
  MessageRequester("Error", "Can't open screen & sprite enviroment!", #MB_ICONERROR)
  End
EndIf

If OpenWindow(0, 0, 0, 640, 480, "Bump", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  If OpenWindowedScreen(WindowID(0), 0, 0, 640, 480, 0, 0, 0)
  Else
    MessageRequester("Error", "Can't open windowed screen!", #MB_ICONERROR)
    End
  EndIf
EndIf

w = 640
h = 480
If Not (CreateSprite(#Sprite_Base, w, h) And CreateSprite(#Sprite_Bump, w, h))
  MessageRequester("Error", "Can't create the sprite!", #MB_ICONERROR)
  End
EndIf

UsePNGImageDecoder()
If Not LoadSprite(#Sprite_Load, "bump.png")
  MessageRequester("Error", "Can't load the sprite bump.png!", #MB_ICONERROR)
  End
EndIf

If UseBuffer(#Sprite_Base)
  w - SpriteWidth (#Sprite_Load)
  h - SpriteHeight(#Sprite_Load)
  DisplaySprite(#Sprite_Load, w/2, h/2)
  w + SpriteWidth (#Sprite_Load)
  h + SpriteHeight(#Sprite_Load)
  FreeSprite(#Sprite_Load)
  UseBuffer(#PB_Default)
EndIf

BumpPrepare(#Sprite_Base)

r = 192
g = 192
b = 192
rayon = 255

While rdir = 0 Or gdir = 0 Or bdir = 0
  If Not rdir : rdir = Random(2) - 1 : EndIf
  If Not gdir : gdir = Random(2) - 1 : EndIf
  If Not bdir : bdir = Random(2) - 1 : EndIf
Wend

Repeat
  Repeat
    Event = WindowEvent()
    
    Select Event
      Case #WM_MOUSEWHEEL
        delta.w = EventwParam() >> 16
        rayon = BumpClamp(rayon + delta / 30, 50, 350)
        
      Case #PB_Event_CloseWindow
        End
    EndSelect
  Until Not Event
  
  x = WindowMouseX(0)
  y = WindowMouseY(0)
  
  If x = #PB_Any
    x = Cos(tick / 5) * w / 3 + w / 2
    y = Sin(tick / 8) * h / 3 + h / 2
  EndIf
  
  tick + 1
  
  r + rdir * Random(3)
  g + gdir * Random(3)
  b + bdir * Random(3)
  
  If r <> BumpClamp(r, $80, $FF) : rdir = -rdir : EndIf
  If g <> BumpClamp(g, $80, $FF) : gdir = -gdir : EndIf
  If b <> BumpClamp(b, $80, $FF) : bdir = -bdir : EndIf
  
  r = BumpClamp(r, $80, $FF)
  g = BumpClamp(g, $80, $FF)
  b = BumpClamp(b, $80, $FF)
  
  Bump(#Sprite_Bump, x, y, rayon, RGB(r, g, b))
  DisplaySprite(#Sprite_Bump, 0, 0)
  
  If StartDrawing( ScreenOutput() )
    StopDrawing()
  EndIf
  
  FlipBuffers()
ForEver
Dri :)
Haut
Anonyme

Message par Anonyme »

Ca rame pas mal ^^
Haut
AWEAR
Messages : 264
Inscription : ven. 28/oct./2005 8:20
Localisation : Mayotte ( 976 ), Océan Indien, France

Message par AWEAR »

Oula oui ca rame vraiment et puis niveau éclairage c'est pas génial non plus (bon ok c'est vrai j'ai rien à dire moi, c'est pas génial ce que j'ai fais :D)
La vie est une rose dont il faut accepter les épines, mais la mienne est fannée, arrosée par le goût de mes larmes. (Soprano)
Haut
AWEAR
Messages : 264
Inscription : ven. 28/oct./2005 8:20
Localisation : Mayotte ( 976 ), Océan Indien, France

Message par AWEAR »

...
Dernière modification par AWEAR le mar. 02/mai/2006 20:10, modifié 2 fois.
La vie est une rose dont il faut accepter les épines, mais la mienne est fannée, arrosée par le goût de mes larmes. (Soprano)
Haut
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

chez moi ca ne change rien (ca ne rame pas plus lol)

Dri
Haut
Répondre

Revenir à « Discussion générale »