Oldschool Decrunch Effect

[padman]

Maybe someone will find this useful some day... 

Code: [Select]

;***************************************************************
;*                                                             *
;*  Converted from a Blitz Basic Source by Einar Wedøe (2001)  *
;*                                                             *
;*          PureBasic 4.x Version by Padman (2011)             *
;*                                                             *
;*                                                             *
;***************************************************************

InitSprite()
InitKeyboard()


OpenScreen(640,480,32,"Oldschool Decrunch Effect")


Procedure Decrunch()                              
y=0
Repeat
    Color=RGB(Random(255),Random(255),Random(255)) 
       Height=Random(10)            
          StartDrawing(ScreenOutput())
             Box(0,y,640,Height,Color)  
          StopDrawing()
       y=y+Height                    
    If y > 480 : Break : EndIf                    
ForEver                                

EndProcedure

Repeat
 
     ClearScreen(0)
       Decrunch()
     FlipBuffers()             
     ExamineKeyboard()
     
Until KeyboardReleased(1)


  CloseScreen()
End

[jace_stknights]

Cool!

I'm finishing mine soon!

[jace_stknights]

Okay, here is my version... a bit quicker 

Code: [Select]

;***************************************************************
;*                                                             *
;*                 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.l
  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(10) : x = Random(x_res/2) : coul = ((Random(32)*8) & $ff) + (((Random(32)*8) & $ff)<<8 ) + (((Random(32)*8) & $ff)<<16 )
          For j = 0 To h-1
            For i=0 To ligne/8-1
              PokeL(*ecran+base+i*4*2,coul) : PokeL(*ecran+base+i*4*2+4,coul) : PokeL(*ecran+base+ligne+i*4*2,coul) : PokeL(*ecran+base+ligne+i*4*2+4,coul)
            Next
            If xold<>0 And j = 0
              For i = 0 To xold-1
                PokeL(*ecran+base+i*4*2,oldcoul) : PokeL(*ecran+base+i*4*2+4,oldcoul) : PokeL(*ecran+base+ligne+i*4*2,oldcoul) : PokeL(*ecran+base+ligne+i*4*2+4,oldcoul)
              Next
            EndIf
            base = base + ligne*2 : y = y +1
          Next
          xold = x : oldcoul = coul
        Until y > (y_res / 2)-9
        coul.l = ((Random(255)& $ff)<<8 ) + ((Random(255)& $ff)<<16 ) + ((Random(255)& $ff)<<24 )
        For j = 0 To ((y_res/2)-y)-1
          For i=0 To ligne/8-1
            PokeL(*ecran+base+i*4*2,coul) : PokeL(*ecran+base+i*4*2+4,coul) : PokeL(*ecran+base+ligne+i*4*2,coul) : PokeL(*ecran+base+ligne+i*4*2+4,coul)
          Next
          If xold<>0 And j = 0
            For i = 0 To xold-1
              PokeL(*ecran+base+i*4*2,oldcoul) : PokeL(*ecran+base+i*4*2+4,oldcoul) : PokeL(*ecran+base+ligne+i*4*2,oldcoul) : PokeL(*ecran+base+ligne+i*4*2+4,oldcoul)
            Next
          EndIf
          base = base + ligne*2
        Next
       
      Case 2 ;box display of the 1rst model, for "academical" coders!
        Repeat
          h = 1+Random(10) : 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-9
    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,3) ; <effect>,<duration>

CloseScreen()

End



[padman]

Very nice!  Have some Karma for sharing and for Peek'n'Poke. 

(For all who don't know what this is all about I attached a screenshot of my lame version. It's visual effects done by Packers from the old days (on Amiga, Atari etc.) to show you that data is decrunched...)

[Dr.Death]

What can i say well done both of you 

[jace_stknights]

Here it is: debugged and more improved: use of PokeQ instead of PokeL
The capture-1 is option 1 & 2
The capture-2 is option 3

Code: [Select]

;***************************************************************
;*                                                             *
;*                 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



[Pot Noodle]

Pretty cool 

[Dad1916]

Thanks for sharing.
jace_stknights: I tried both of yours using PureBasic 5.21 LTS (MacOS X - x64). All I get is a empty window.

padman, Yours works but it's super slow.I must try debugging and seeing what is slowing it.

[jace_stknights]

Thanks for sharing.
jace_stknights: I tried both of yours using PureBasic 5.21 LTS (MacOS X - x64). All I get is a empty window.

padman, Yours works but it's super slow.I must try debugging and seeing what is slowing it.

? okay I will try at home... and paste the source working

[Teddy Rogers]

I was just looking at this topic and thought there must be an easier and quicker method to get the effect right so here is my offering...

Code: [Select]

InitSprite()

If OpenWindow(0, 0, 0, 820, 620, "Old School Decrunch Effect...", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
  If OpenWindowedScreen(WindowID(0), 10, 10, 800, 600, #True, 10, 10, #PB_Screen_NoSynchronization) ; x, y position, width, height, autostretch
    If CreateSprite(0, 800, 600) ; sprite, width, height
     
      Repeat
        MyEvent = WindowEvent()
       
        If StartDrawing(SpriteOutput(0))
          Box(0, Random(600), 800, 10, RGB((Random(255)), (Random(255)), (Random(255)))) ; Entire field x, y radius, width, height, colour
          StopDrawing()
        EndIf
       
        FlipBuffers()
        DisplaySprite(0, 0, Random(600))
       
      Until MyEvent = #PB_Event_CloseWindow
     
    EndIf
  EndIf
EndIf
Ted.

[Dr.Death]

Wow Ted that is really good for such a small bit of code.

I remember your old group too mate.

Do you code in Pure Basic then?

[Teddy Rogers]

I looked at PB a few years back but didn't spend too much time with it. Then a couple of months back I took another look at it out of curiosity and liked it that much I purchased a licence. It has a large command list, full API support and allows for inlined ASM. Compiled binaries looked to be nicely optimised. There is a lot to like about it!

Ted.

[KrazyK]

Here's the library I've been using for my remakes.  It only has 6 effects so far but they are the common ones used.
Just unzip the kk_depacker library into your ..PureLibraries\UserLibraries folder and restart the compiler.
Written using Purebasic 5.22 so may not work with earlier versions.

Code: [Select]

;Atari ST depacker library
;PureBasic 5.22

InitSprite()
#scrx=640
#scry=400

#AUTOMATION1=1
#AUTOMATION2=2
#POMPEY1=3
#POMPEY2=4
#ATOMIK35=5
#JAM40=6

OpenWindow(1,0,0,#scrx,#scry,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered|#PB_Window_WindowCentered)
OpenWindowedScreen(WindowID(1),0,0,#scrx,#scry,0,0,0)
StickyWindow(1,1)
ShowCursor_(0)

KK_DepackerInit(#scrx,#scry) ;width,height

Repeat
       ClearScreen(0)
       KK_Depacker(#AUTOMATION1)
       FlipBuffers()
Until GetAsyncKeyState_(#VK_ESCAPE)


Hope someone finds a use for it.....

[Hotshot]

It worked so well and very good 

[a01]

simple but effective