Author Topic: Oldschool Decrunch Effect  (Read 5225 times)

0 Members and 1 Guest are viewing this topic.

Offline padman

  • Senior Member
  • Pentium
  • ********
  • Posts: 977
  • Karma: 258
    • View Profile
Oldschool Decrunch Effect
« on: July 29, 2011 »
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
Challenge Trophies Won:

Offline jace_stknights

  • Amiga 1200
  • ****
  • Posts: 399
  • Karma: 32
  • PEEK & POKE are not MOVEM!
    • View Profile
    • ST Knights WebSite
Re: Oldschool Decrunch Effect
« Reply #1 on: July 29, 2011 »
Cool!

I'm finishing mine soon!
Challenge Trophies Won:

Offline jace_stknights

  • Amiga 1200
  • ****
  • Posts: 399
  • Karma: 32
  • PEEK & POKE are not MOVEM!
    • View Profile
    • ST Knights WebSite
Re: Oldschool Decrunch Effect
« Reply #2 on: July 29, 2011 »
Okay, here is my version... a bit quicker  ;D

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

Challenge Trophies Won:

Offline padman

  • Senior Member
  • Pentium
  • ********
  • Posts: 977
  • Karma: 258
    • View Profile
Re: Oldschool Decrunch Effect
« Reply #3 on: July 29, 2011 »
Very nice!  Have some Karma for sharing and for Peek'n'Poke.  ;D

(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...)
Challenge Trophies Won:

Offline Dr.Death

  • Senior Member
  • Amiga 1200
  • ********
  • Posts: 432
  • Karma: 8
    • View Profile
Re: Oldschool Decrunch Effect
« Reply #4 on: July 29, 2011 »
What can i say well done both of you  :updance:
Proud member of DAWN

Offline jace_stknights

  • Amiga 1200
  • ****
  • Posts: 399
  • Karma: 32
  • PEEK & POKE are not MOVEM!
    • View Profile
    • ST Knights WebSite
Re: Oldschool Decrunch Effect
« Reply #5 on: August 01, 2011 »
Here it is: debugged and more improved: use of PokeQ instead of PokeL :D :D :D
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

Challenge Trophies Won:

Offline Pot Noodle

  • Sponsor
  • Amiga 1200
  • *******
  • Posts: 271
  • Karma: 15
  • Computers have lots of memory but no imagination
    • View Profile
Re: Oldschool Decrunch Effect
« Reply #6 on: August 04, 2011 »
Pretty cool  :goodpost:

Offline Dad1916

  • Atari ST
  • ***
  • Posts: 110
  • Karma: 3
    • View Profile
    • Quadriga demo group
Re: Oldschool Decrunch Effect
« Reply #7 on: November 23, 2013 »
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.

Offline jace_stknights

  • Amiga 1200
  • ****
  • Posts: 399
  • Karma: 32
  • PEEK & POKE are not MOVEM!
    • View Profile
    • ST Knights WebSite
Re: Oldschool Decrunch Effect
« Reply #8 on: December 13, 2013 »
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 :D
Challenge Trophies Won:

Offline Teddy Rogers

  • ZX 81
  • *
  • Posts: 6
  • Karma: 0
    • View Profile
    • Tuts 4 You
Re: Oldschool Decrunch Effect
« Reply #9 on: May 04, 2014 »
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.
Reverse code engineering... https://tuts4you.com

Offline Dr.Death

  • Senior Member
  • Amiga 1200
  • ********
  • Posts: 432
  • Karma: 8
    • View Profile
Re: Oldschool Decrunch Effect
« Reply #10 on: May 05, 2014 »
Wow Ted that is really good for such a small bit of code. :clap:

I remember your old group too mate.

Do you code in Pure Basic then?
Proud member of DAWN

Offline Teddy Rogers

  • ZX 81
  • *
  • Posts: 6
  • Karma: 0
    • View Profile
    • Tuts 4 You
Re: Oldschool Decrunch Effect
« Reply #11 on: May 06, 2014 »
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.
Reverse code engineering... https://tuts4you.com

Offline KrazyK

  • Amiga 1200
  • ****
  • Posts: 255
  • Karma: 97
    • View Profile
    • KrazyK Remakes
Re: Oldschool Decrunch Effect
« Reply #12 on: May 06, 2014 »
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..... ;)
Challenge Trophies Won:

Offline Hotshot

  • DBF Aficionado
  • ******
  • Posts: 2114
  • Karma: 91
    • View Profile
Re: Oldschool Decrunch Effect
« Reply #13 on: May 06, 2014 »
It worked so well and very good  :)

Offline a01

  • ZX 81
  • *
  • Posts: 1
  • Karma: 0
    • View Profile
Re: Oldschool Decrunch Effect
« Reply #14 on: September 27, 2014 »
simple but effective :)