Last night, I tried to figure out how to create swinging copperbars, those like in many oldskool intros.
I found a way. Here is the source.
Regards & have fun
Wolf
Code: Select all
; 2009 by Hroudtwolf
; PureBasic 4.x
; Windows, Linux, OS X
#TITLE = "Swinging copperbars"
#SWINGSPEED = 0.5 ; (0.00...x - 1)
#AMPLITUDE = 15 ; (1 - x)
#GRADCOLOR0 = $4AB5ED
#GRADCOLOR1 = $169AE0
#GRADCOLOR2 = $1276D7
#GRADCOLOR3 = $0E5AA3
#UPDATEDELAY = 80; ms
#SCREENWIDTH = 640
#SCREENHEIGHT = 480
Macro DoOrDie ( _COND_ , _MSG_ )
If Not ( _COND_ )
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
MessageBox_( #Null , _MSG_ , "Error" , #MB_ICONERROR )
CompilerElse
MessageRequester ( "Error" , _MSG_ )
CompilerEndIf
End 1
EndIf
EndMacro
Declare.i DisplayCopperbarElement ( nX.i , nY.i , nWidth.i , Array nPalette.i ( 1 ) )
Define.i idWindow
Define.i iblFullScreen = #False
Dim nPalette.i ( 4 )
nPalette.i ( 0 ) = #GRADCOLOR0
nPalette.i ( 1 ) = #GRADCOLOR1
nPalette.i ( 2 ) = #GRADCOLOR2
nPalette.i ( 3 ) = #GRADCOLOR3
DoOrDie ( InitSprite () , "Initializing DirectX failed." )
If MessageRequester ( "Display mode" , "2009(c) By Hroudtwolf" + #LF$ + #LF$ + "Fullscreen mode?" , #PB_MessageRequester_YesNo ) = #PB_MessageRequester_Yes
DoOrDie ( OpenScreen ( #SCREENWIDTH , #SCREENHEIGHT , 32 , #TITLE ) , "Can't open screen." )
blFullScreen = #True
Else
idWindow = OpenWindow ( #PB_Any , #PB_Ignore , #PB_Ignore , #SCREENWIDTH , #SCREENHEIGHT , #TITLE , #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_MinimizeGadget )
DoOrDie ( idWindow , "Not enough RAM available." )
DoOrDie ( OpenWindowedScreen ( WindowID ( idWindow ) , 0 , 0 , #SCREENWIDTH , #SCREENHEIGHT , #True , 0 , 0 ) , "Can't open DirectX screen." )
EndIf
Repeat
If Not blFullScreen
Repeat
Select WindowEvent ()
Case #Null
Break
Case #PB_Event_CloseWindow
End
EndSelect
ForEver
EndIf
FlipBuffers ()
ClearScreen ( $0)
DisplayCopperbarElement ( 0 , 80 , #SCREENWIDTH , nPalette () )
DisplayCopperbarElement ( 0 , #SCREENHEIGHT - 80 , #SCREENWIDTH , nPalette () )
Delay ( 0 )
If GetAsyncKeyState_ ( #VK_ESCAPE ) & $1
Break
EndIf
ForEver
End
Procedure.i DisplayCopperbarElement ( nX.i , nY.i , nWidth.i , Array nPalette.i ( 1 ) )
Protected nI .i
Protected nCurY .i
Static Dim idCopperBarSprite .i ( 4 )
Static nCurrentFrame .i
Static tmNextUpdate .i
Static nWave .f
If Not idCopperBarSprite ( 0 )
For nCurrentFrame = 0 To 3
idCopperBarSprite ( nCurrentFrame ) = CreateSprite ( #PB_Any , 5 , 16 )
StartDrawing ( SpriteOutput ( idCopperBarSprite ( nCurrentFrame ) ) )
For nI = 0 To 3
Box ( 0 , nI * 2 , 5 , 2 , nPalette ( ( nI + nCurrentFrame ) % 4 ) )
Next
For nI = 0 To 3
Box ( 0 , ( 7 - nI ) * 2 , 5 , 2 , nPalette ( ( nI + nCurrentFrame ) % 4 ) )
Next
StopDrawing ()
Next nCurrentFrame
EndIf
If tmNextUpdate < ElapsedMilliseconds ()
tmNextUpdate = ElapsedMilliseconds () + #UPDATEDELAY
nCurrentFrame = ( nCurrentFrame + 1 ) % 4
nWave + #SWINGSPEED
If nWave > 6 : nWave = 0 : EndIf
EndIf
nI = nX
While nI < nWidth
nCurY = Sin ( ( nI / ( nWidth / 4 ) ) + nWave ) * #AMPLITUDE
DisplaySprite ( idCopperBarSprite ( nCurrentFrame ) , nI , nCurY + nY )
nCurY = Cos ( ( nI / ( nWidth / 4 ) ) + nWave ) * #AMPLITUDE
DisplaySprite ( idCopperBarSprite ( nCurrentFrame ) , nI , nCurY + nY )
nI + 5
Wend
ProcedureReturn #Null
EndProcedure
