Well I did not comment much but take it as it is !
I think it is running good and could give readers any more ideas on how to use sprites, screens and so on.
Code: Select all
;
; 3D rose
;
; The following code is an update from original Cederavic code posted on french forum formerly
;
; I don't give much more comments except best possible naming so that readers should understand quite easy what is there.
;
; Note that CreateSpriteObject has been changed since a previous post I made and makes now more things.
;
; FWeil 20050515
;
; 20050519
;
; - added a Letter type sprite object
; - added a mouse escape to release the mouse capture when trying to go outside the windowed screen from top left and a mouse capture back when pointing the windowed screen
; - added a small "X" sprite when the pointer is near to the top right of the windowed screen to let the user qui the program.
; - updated some code for better writing
; - updated the left / right mouse buttons management to interact on worm's parameter only when the pointer is the red cross
; - Enhanced the #BubbleMax constant because feedback about performances seem to be good enough
; - Added an advertising wink to PureBasic for fun.
;
#BubbleMax = 400
#Window_Main = 0
#FullScreen = #FALSE
Enumeration #BubbleMax + 1
#Pointer1
#Pointer2
#Pointer3
#Pointer4
#SplashPanel
#Advertising
EndEnumeration
#BackgroundColor = #Black
Structure TEXTPANEL
FontName.s
FontSize.l
Text.s
TextColor.l
EndStructure
Structure LetterSprite
ForegroundColor.l
BackgroundColor.l
Text.s
FontName.s
FontSize.l
FontAttributes.l
EndStructure
Procedure CreateSpriteObject(SpriteNumber.l, Width.l, Height.l, ObjectName.s, Param1.l, Param2.l)
;
; CreateSpriteObject allows to create parameterized sprites
;
If CreateSprite(SpriteNumber, Width, Height, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(SpriteNumber))
Select ObjectName
Case "Cross"
DrawingMode(0)
Box(0, 0, Width, Height, Param2)
LineXY(0, Height / 2, Width, Height / 2, Param1)
LineXY(Width / 2, 0, Width / 2, Height, Param1)
Case "Arrow"
DrawingMode(0)
Box(0, 0, Width, Height, Param2)
LineXY(0, 0, 4, 13, Param1)
LineXY(4, 13, 5, 8, Param1)
LineXY(5, 8, 29, 32, Param1)
LineXY(29, 32, 32, 29, Param1)
LineXY(32, 29, 9, 6, Param1)
LineXY(9, 6, 13, 5, Param1)
LineXY(13, 5, 0, 0, Param1)
FillArea(2, 2, Param1, Param1)
Case "Letter"
*SpriteLetter.LetterSprite = Param1
DrawingMode(0)
Box(0, 0, Width, Height, *SpriteLetter\BackgroundColor)
DrawingFont(LoadFont(23, *SpriteLetter\FontName, *SpriteLetter\FontSize, *SpriteLetter\FontAttributes))
DrawingMode(1)
Locate((Width - TextLength(*SpriteLetter\Text)) / 2, (Width - TextLength(*SpriteLetter\Text)) / 2)
FrontColor(Red(*SpriteLetter\ForegroundColor), Green(*SpriteLetter\ForegroundColor), Blue(*SpriteLetter\ForegroundColor))
DrawText(*SpriteLetter\Text)
Case "TextPanel"
*TextPanel.TEXTPANEL = Param1
DrawingFont(LoadFont(0, *TextPanel\FontName, *TextPanel\FontSize, #PB_Font_HighQuality))
DrawingMode(0)
For x = 0 To Width
Fading.f = x / Width - 0.5
If Fading < 0
Fading = 0
EndIf
If Fading > 0.5
Fading * 2
EndIf
LineXY(x, 0, 0, x, RGB(Red(Param2) * Fading, Green(Param2) * Fading, Blue(Param2) * Fading))
LineXY(Width - x, Height, Width, Width - x, RGB(Red(Param2) * Fading, Green(Param2) * Fading, Blue(Param2) * Fading))
Next
DrawingMode(1)
If FindString(*TextPanel\Text, " ", 1)
FieldNumber = 1
While StringField(*TextPanel\Text, FieldNumber, " ") <> ""
FieldNumber + 1
Wend
FieldNumber - 1
For h = 1 To FieldNumber
For i = 1 To 4
Locate((Width - TextLength(StringField(*TextPanel\Text, h, " "))) / 2 + i, (Height + 3 * (h - 1) * *TextPanel\FontSize) / 2 - i)
FrontColor(Red(*TextPanel\TextColor) >> (4 - i), Green(*TextPanel\TextColor) >> (4 - i), Blue(*TextPanel\TextColor) >> (4 - i))
DrawText(StringField(*TextPanel\Text, h, " "))
Next
Next
Else
For i = 1 To 4
Locate((Width - TextLength(*TextPanel\Text)) / 2 + i, Height / 2 - i)
FrontColor(64 * i - 1, 64 * i - 1, 50 * i - 1)
DrawText(*TextPanel\Text)
Next
EndIf
Default
DrawingMode(0)
Box(0, 0, Width, Height, Param1)
DrawingMode(1)
Box(0, 0, Width, Height, Param2)
DrawingMode(1)
Label.s = "?"
DrawingFont(LoadFont(0, "Verdana", 12, #PB_Font_Bold | #PB_Font_HighQuality))
Locate((Width - TextLength(Label)) / 2, (Height - 3 * FontSize / 2) / 2)
FrontColor(Red(255), Green(0), Blue(0))
DrawText(Label)
EndSelect
StopDrawing()
EndIf
EndProcedure
;
;
;
If InitSprite() And InitSprite3D() And InitKeyboard() And InitMouse()
If #FullScreen
WindowXSize = GetSystemMetrics_(#SM_CXSCREEN)
WindowYSize = GetSystemMetrics_(#SM_CYSCREEN)
ScreenXSize = WindowXSize
ScreenYSize = WindowYSize
OpenScreen(WindowXSize, WindowYSize, 32, "Rosace3D")
Initialized = #TRUE
Else
WindowXSize = 480
WindowYSize = 360
ScreenXSize = WindowXSize
ScreenYSize = WindowYSize
If OpenWindow(#Window_Main, 0, 0, WindowXSize, WindowYSize, #PB_Window_Borderless | #PB_Window_ScreenCentered, "Rosace3D")
AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
If OpenWindowedScreen(WindowID(), 0, 0, ScreenXSize, ScreenYSize, #TRUE, 0, 0)
Initialized = #TRUE
EndIf
EndIf
EndIf
If Initialized
BackgroundImageID = CreateImage(0, ScreenXSize, ScreenYSize)
StartDrawing(ImageOutput())
For i = 0 To 31
Box(i, i, ScreenXSize - 2 * i, ScreenYSize - 2 * i, RGB(0, 0, 255 - 8 * i))
Next
Box(32, 32, ScreenXSize - 64, ScreenYSize - 64, #Black)
StopDrawing()
Sprite3DQuality(1)
CX = 3 * ScreenXSize / 7
CY = ScreenYSize / 2
CXZ = (1 + #FullScreen ) * ScreenXSize / 3
CYZ = (1 + #FullScreen ) * ScreenYSize / 3
s.l = 1
s2.l = 1
sk.l = 1
j.f = 0.0
j2.f = 50.0
k.l = 0
SpriteLightX.f = 0.5
SpriteLightY.f = 0.5
For t = 0 To #BubbleMax
CreateSprite(t, 32, 32, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(t))
ColorMask.l = Random(7) + 1
Red = 32 * Random(4) * ((ColorMask & 4) >> 2)
Green = 32 * Random(4) * ((ColorMask & 2) >> 1)
Blue = 32 * Random(4) * ((ColorMask & 1))
SpriteCX.f = 16.0
SpriteCY.f = 16.0
SpriteRadius = 10
Circle(SpriteCX, SpriteCY, SpriteRadius, RGB(0, 0, 0))
For SpriteRadius = 9 To 2 Step - 1
Circle(SpriteCX, SpriteCY, SpriteRadius, RGB(Red, Green, Blue))
SpriteCX + SpriteLightX
SpriteCY + SpriteLightY
Red + 16
If Red > 255
Red = 255
EndIf
Green + 32
If Green > 255
Green = 255
EndIf
Blue + 32
If Blue > 255
Blue = 255
EndIf
Next
StopDrawing()
CreateSprite3D(t, t)
Next
PointerXSize = 8
PointerYSize = 8
CreateSpriteObject(#Pointer1, PointerXSize, PointerYSize, "Cross", #White, #BackgroundColor)
CreateSpriteObject(#Pointer2, PointerXSize, PointerYSize, "Cross", $8080FF, #BackgroundColor)
SplashPanel.TEXTPANEL
SplashPanel\FontName = "Verdana"
SplashPanel\FontSize = 8 * (#FullScreen + 1)
SPlashPanel\Text = "Visit www.francoisweil.com or email fweil@internext.fr"
SPlashPanel\TextColor = $C0FFFF
CreateSpriteObject(#Pointer3, 256, 256, "TextPanel", @SplashPanel, #Blue)
SplashPanel\FontName = "Verdana"
SplashPanel\FontSize = 8 * (#FullScreen + 1)
SPlashPanel\Text = "Designed by fweil"
SPlashPanel\TextColor = $C0FFFF
CreateSpriteObject(#SplashPanel, 128 * (#FullScreen + 1), 128 * (#FullScreen + 1), "TextPanel", @SplashPanel, #White)
Sprite4.LetterSprite
Sprite4\ForegroundColor = #Red
Sprite4\BackgroundColor = #Blue
Sprite4\Text = "X"
Sprite4\FontName = "Verdana"
Sprite4\FontSize = 12
Sprite4\FontAttributes = #PB_Font_Bold | #PB_Font_HighQuality
CreateSpriteObject(#Pointer4, 2 * PointerXSize, 2 * PointerYSize, "Letter", @Sprite4, 0)
Sprite4\ForegroundColor = $4020B0
Sprite4\BackgroundColor = $300000
Sprite4\FontAttributes = #PB_Font_HighQuality
Sprite4\FontSize = 16
AdvertisingString.s = "PureBasic will puzzle you !"
lAdvertisingString.l = Len(AdvertisingString)
For i = 1 To lAdvertisingString
Sprite4\Text = Mid(AdvertisingString, i, 1)
CreateSpriteObject(#Advertising + i, 2 * PointerXSize, 4 * PointerYSize, "Letter", @Sprite4, 0)
Next
CreateSprite3D(#SplashPanel, #SplashPanel)
SplashPanelXSize = 0
SplashPanelYSize = Random(256)
sSplashPanelX = 1
sSplashPanelY = 1
Start3D()
Repeat
ExamineKeyboard()
If KeyboardPushed(#PB_Key_Escape)
Quit = #TRUE
EndIf
If KeyboardPushed(#PB_Key_F1)
Delay(50)
RefreshRateFlag = 1 - RefreshRateFlag
Refresh = 0
EndIf
FlipBuffers()
ClearScreen(0, 0, 0)
If #FullScreen = #FALSE
If WindowEvent() = #PB_Event_CloseWindow Or EventMenuID() = #PB_Shortcut_Escape
Quit = #TRUE
EndIf
StartDrawing(ScreenOutput())
DrawImage(BackgroundImageID, 0, 0)
StopDrawing()
EndIf
For t = 0 To #BubbleMax
j + s * 0.00025
j2 + s2 * 0.00025
If j <= 5
s = 1
EndIf
If j => 35
s = -1
EndIf
If j2 <= 5
s2 = 1
EndIf
If j2 => 35
s2 = -1
EndIf
Angle1.f = t / j / 2
Alpha = Sin(Angle1) * 32
If Alpha < 40
Alpha = 128 - 3 * Alpha
Else
Alpha = 128 - Alpha / 3
EndIf
If Alpha > 255
Alpha = 255
ElseIf Alpha < 0
Alpha = 0
EndIf
ZoomSprite3D(t, 32, 32)
Angle1.f = 2 * Angle1
Angle2.f = 2 * t / j2 + j2 / 2
DisplaySprite3D(t, CX + CXZ * (Sin(Angle1) + Cos(Angle2)) * k / (ScreenXSize + Alpha), CY + CYZ * (Cos(Angle1) + Sin(Angle2)) * k / (ScreenYSize + Alpha), Alpha)
Next
If RefreshRateFlag
Refresh + 1
If ElapsedMilliseconds() - tz => 1000
tz = ElapsedMilliseconds()
RefreshRate = Refresh
Refresh = 0
EndIf
StartDrawing(ScreenOutput())
DrawingMode(1)
For i = 1 To 4
Locate(10 + i, 10 - i)
FrontColor(64 * i - 1, 64 * i - 1, 50 * i - 1)
DrawText("Refresh rate : " + Str(RefreshRate))
Next
StopDrawing()
EndIf
If StartCounter < 1200
StartCounter + 1
If StartCounter < 950
ThisFading = 255
Else
ThisFading = 1200 - StartCounter
EndIf
SplashPanelXSize + sSplashPanelX
SplashPanelYSize + sSplashPanelY
If SplashPanelXSize <= -128
sSplashPanelX = 1
EndIf
If SplashPanelXSize > 128
sSplashPanelX = -1
EndIf
If SplashPanelYSize <= -128
sSplashPanelY = 1
EndIf
If SplashPanelYSize > 128
sSplashPanelY = -1
EndIf
ZoomSprite3D(#SplashPanel, SplashPanelXSize, SplashPanelYSize)
RotateSprite3D(#SplashPanel, SplashPanelAngle, 0)
DisplaySprite3D(#SplashPanel, ScreenXSize - 100, ScreenYSize - 100, ThisFading)
SplashPanelAngle + 1
If StartCounter < 1000
StartDrawing(ScreenOutput())
DrawingMode(1)
If StartCounter < 500
ThisColor = 255 * StartCounter / 500
Else
ThisColor = 255 * (1000 - StartCounter) / 500
EndIf
FrontColor(ThisColor, ThisColor, ThisColor)
Text.s = "Use left / right mouse buttons at screen center to change parameters"
Locate((ScreenXSize - TextLength(Text)) / 2, ScreenYSize - 40)
DrawText(Text)
Text.s = "Escape to exit - F1 to see frame refresh rate"
Locate((ScreenXSize - TextLength(Text)) / 2, ScreenYSize - 20)
DrawText(Text)
StopDrawing()
EndIf
EndIf
If MouseReleased
GetCursorPos_(@Point.POINT)
If WindowFromPoint_(Point\x, Point\y) = WindowID()
ReleaseMouse(0)
MouseLocate(ScreenXSize / 2, ScreenYSize / 2)
MouseReleased = #FALSE
AdvertisingFlag = #FALSE
EndIf
EndIf
ExamineMouse()
If MouseButton(1)
If CursorType = 2
j = Random(100) - 50
j2 = Random(100) - 50
ElseIf CursorType = 4
Quit = #TRUE
EndIf
ElseIf MouseButton(2) And k > 0 And CursorType = 2
k = -k
Else
MouseX = MouseX()
MouseY = MouseY()
If MouseX > ScreenXSize / 4 And MouseX < 3 * ScreenXSize / 4 And MouseY > ScreenYSize / 4 And MouseY < 3 * ScreenYSize / 4
DisplayTransparentSprite(#Pointer2, MouseX() - PointerXSize / 2, MouseY() - PointerYSize / 2)
CursorType = 2
ElseIf MouseX > ScreenXSize - 40 And MouseY < 30
DisplayTransparentSprite(#Pointer4, MouseX() - PointerXSize / 2, MouseY() - PointerYSize / 2)
MouseLocate(ScreenXSize - 2 * PointerXSize, PointerYSize)
CursorType = 4
ElseIf MouseY > 3 * ScreenYSize / 4
DisplayTransparentSprite(#Pointer3, MouseX() - 256 / 2, MouseY() - 256 / 2)
CursorType = 3
ElseIf (MouseX <= 0 Or MouseX => ScreenXSize) And (MouseY <= 0 Or MouseY => ScreenYSize) And MouseReleased = #FALSE And #FullScreen = #FALSE
ReleaseMouse(1)
MouseReleased = #TRUE
AdvertisingFlag = #TRUE
Else
DisplayTransparentSprite(#Pointer1, MouseX() - PointerXSize / 2, MouseY() - PointerYSize / 2)
CursorType = 1
EndIf
EndIf
k + sk
If k <= 50
sk = 1
EndIf
If k => 250
sk = -1
EndIf
If AdvertisingFlag
x = 0.8 * ScreenXSize / lAdvertisingString
For i = 1 To lAdvertisingString
Bend = lAdvertisingString - 2 * Abs(i - lAdvertisingString / 2)
DisplayTransparentSprite(#Advertising + i, i * x + 30 + Random(2) - 1, 40 + y + Random(2) - 1 + Bend)
Next
EndIf
Until Quit
Stop3D()
If #FullScreen
CloseScreen()
Else
CloseWindow(#Window_Main)
EndIf
EndIf
EndIf
TerminateProcess_(GetCurrentProcess_(), 0)
End
