Un site de programmation PB orienté Demo

[Ar-S]

Voilà voilà, je ne sais plus si on en a déjà parlé mais voilà un forum avec de nombreux codes et exemples d'effets 2D/3D oldschool ici :
http://www.dbfinteractive.com/forum/ind ... board=33.0

Exemple (excellent ^^)
Les amateurs de demo 16bits reconnaitront cette imitation d'effet lors du depacking (decrunsh) des anciennes chiptro/cractro/demo

Code : Tout sélectionner

;***************************************************************
;*                                                             *
;*                 Amiga Depacking Effect                      *
;*                                                             *
;*                  by Jace / ST Knights                       *
;*                                                             *
;*                     29 / 07 / 2011                          *
;*                                                             *
;*   use  : depackRemake(<effect>,<duration in second>)        *
;*                                                             *
;*          Effect 1 is using direct buffer writing, so use 2  *
;*          for boxes (and slowest) effect                     *
;***************************************************************

Procedure depackRemake(version,duree)
  Protected x_res,y_res,depth,base,y,x,i,j,xold,timeDepack,coul.q,oldcoul.q
  #vsize = 10
  StartDrawing (ScreenOutput())
    *ecran = DrawingBuffer()
    ligne = DrawingBufferPitch() 
    x_res = OutputWidth()
    y_res = OutputHeight()
    depth = OutputDepth()
  StopDrawing()
  If depth <>32 
    ProcedureReturn
  EndIf
  endTime = ElapsedMilliseconds() + duree * 1000
  Repeat
    base = 0
    y = 0
    xold = 0
    Select version
      Case 1
        Repeat
          h = 1+Random(#vsize) : x = Random(x_res/2) : coul = ((Random(32)*8) & $FF) + (((Random(32)*8) & $FF)<<8 ) + (((Random(32)*8) & $FF)<<16 ) : coul =  coul <<32 + coul
          For j = 0 To h-1
            For i=0 To ligne/8-1
              PokeQ(*ecran+base+i*4*2,coul) : PokeQ(*ecran+base+ligne+i*4*2,coul) 
            Next
            If xold<>0 And j = 0
              For i = 0 To xold-1
                PokeQ(*ecran+base+i*4*2,oldcoul) : PokeQ(*ecran+base+ligne+i*4*2,oldcoul)
              Next
            EndIf
            base = base + ligne*2 : y = y +1
          Next
          xold = x : oldcoul = coul
        Until y > (y_res / 2)-(#vsize+1)
        coul = ((Random(255)& $FF)<<8 ) + ((Random(255)& $FF)<<16 ) + ((Random(255)& $FF)<<24 ) : coul = coul <<32 + coul
        For j = 0 To ((y_res/2)-y)-1
          For i=0 To ligne/8-1
            PokeQ(*ecran+base+i*4*2,coul) : PokeQ(*ecran+base+ligne+i*4*2,coul)
          Next
          If xold<>0 And j = 0
            For i = 0 To xold-1
              PokeQ(*ecran+base+i*4*2,oldcoul) : PokeQ(*ecran+base+ligne+i*4*2,oldcoul)
            Next
          EndIf
          base = base + ligne*2
        Next
        
      Case 2 ;box display of the 1rst model, for "academical" coders!
        Repeat
          h = 1+Random(#vsize) : x = Random(x_res-1) : coul = RGB(Random(32)*8,Random(32)*8,Random(32)*8) ; use of 32 levels for Amiga and Atari like palette
          StartDrawing(ScreenOutput()) : Box(0,y,x_res,h,coul) :  : StopDrawing()
          If xold<>0 
            StartDrawing(ScreenOutput()) : Box(0,y,xold,2,oldcoul) : StopDrawing()
          EndIf
          xold = x : oldcoul = coul : y = y + h
        Until y > y_res
        
      Case 3 ; other version of depack..
        ClearScreen(RGB(255,255,255))
        Repeat
          h = 1+Random(5) : x = Random(x_res-10)
          StartDrawing(ScreenOutput()) : Line(x,y+h,10,1,0) : Line(x,y+h+1,10,1,0) : StopDrawing()
          y = y + h
        Until y > y_res-10
    EndSelect
    FlipBuffers()
    ExamineKeyboard()
  Until KeyboardPushed (#PB_Key_Escape) Or ElapsedMilliseconds() > endTime              
  
EndProcedure

InitSprite() : InitKeyboard() 

If OpenWindow(0,0,0,800,600, "Depacking Effect",#PB_Window_BorderLess | #PB_Window_ScreenCentered   ) 
  If OpenWindowedScreen(WindowID(0), 0, 0,  800 , 600,false,0,0,#PB_Screen_SmartSynchronization) =0    
    MessageRequester("Error", "This is fucked up, I can't open the window", 0)       
    End                                                    
  EndIf
Else
  MessageRequester("Error", "This is fucked up, I can't create the window", 0)       
EndIf

depackRemake(1,5) ; <effect>,<duration>

CloseScreen()

End