Oldschool Decrunch Effect

[padman]

Maybe someone will find this useful some day... 

Code Select Expand


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


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


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

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 Expand


;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