Dark Bit Factory & Gravity
PROGRAMMING => Purebasic => Topic started by: padman on July 29, 2011
-
Maybe someone will find this useful some day... ;)
;***************************************************************
;* *
;* 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
-
Cool!
I'm finishing mine soon!
-
Okay, here is my version... a bit quicker ;D
;***************************************************************
;* *
;* 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
-
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...)
-
What can i say well done both of you :updance:
-
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
;***************************************************************
;* *
;* 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
-
Pretty cool :goodpost:
-
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.
-
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
-
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...
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.
-
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?
-
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.
-
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.
;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..... ;)
-
It worked so well and very good :)
-
simple but effective :)