Tired of the dice? Do you feel like you're in the construction industry yet in this thread? Always cube in this thread? With the dice forever and never otherwise? 
So here is something nice and actually also useful. The stars rotate around the center and fall in the middle of the screen (first program). What is useful about it? Rotate a 2D texture so that the user cannot see its side. If it wasn't, to use the W and S keys to tilt the scene, you'd see the stars as a single pixel object. However, thanks to the tilting, they always remain tilted towards the viewer.
Use the A and D keys to zoom in and out, and use the T key to turn the twinkle effect on and off.
The second program follows. It is a modification of the previous program, it creates a different, also nice effect, and I will not put it here on the photo, so you can try it too.
Both this source code need attached JPG file as texture (other images returns not so nice effects) it is free downloaded image.
Source Code A:
Source code B: (better effects )
Both need file Star.jpg (it is used as texture)
![[Image: star.jpg]](https://i.ibb.co/2dJPFTg/star.jpg)
First program output:
![[Image: OGL8.png]](https://i.ibb.co/wMBD3PJ/OGL8.png)
Second - try yourself....
So here is something nice and actually also useful. The stars rotate around the center and fall in the middle of the screen (first program). What is useful about it? Rotate a 2D texture so that the user cannot see its side. If it wasn't, to use the W and S keys to tilt the scene, you'd see the stars as a single pixel object. However, thanks to the tilting, they always remain tilted towards the viewer.
Use the A and D keys to zoom in and out, and use the T key to turn the twinkle effect on and off.
The second program follows. It is a modification of the previous program, it creates a different, also nice effect, and I will not put it here on the photo, so you can try it too.
Both this source code need attached JPG file as texture (other images returns not so nice effects) it is free downloaded image.
Source Code A:
Code: (Select All)
Declare CustomType Library
Sub gluBuild2DMipmaps ( BYVAL Target As _Unsigned Long, BYVAL iFormat As Long, BYVAL Wdth As Long, BYVAL Hght As Long, BYVAL format As _Unsigned Long, BYVAL typ As _Unsigned Long, BYVAL dat As _Offset)
End Declare
Type GL_Loader
PointerGL As Long
TextureName As String
Filtering As _Unsigned _Byte
End Type
ReDim Shared GLL(0) As GL_Loader, t As Long
Dim Shared GL_InitInfo As _Byte
Dim Shared ExitSignal As _Byte
_Title "Stars in space"
Screen _NewImage(1024, 768, 32)
Const num = 50
Type Stars
As _Unsigned _Byte R, G, B
As Double Dist
As Single Angle
End Type
Dim Shared Star(num) As Stars
Dim Shared Zoom, Tilt, Twinkle
Zoom = -15
Tilt = 90F
Twinkle = 0
Do
i$ = InKey$
Select Case UCase$(i$)
Case "T"
If TwinkleTimer < Timer Then
Twinkle = Not Twinkle
LightTimer = Timer + .5
End If
Case "W"
Tilt = Tilt - 0.5
Case "S"
Tilt = Tilt + 0.5
Case "A"
Zoom = Zoom - .2
Case "D"
Zoom = Zoom + .2
End Select
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
Static L
Texture = LoadTexture("Star.jpg", 0)
_PrintString (20, 20), "Use: A/D for zoom, W/S for shift, T for Twinkle effect."
Init2
GL_Init
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer
_glMatrixMode _GL_PROJECTION ' Set projection matrix - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
_glLoadIdentity '();// Reset matice
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glBindTexture _GL_TEXTURE_2D, Texture
For L = 1 To num
_glLoadIdentity
_glTranslatef 0.0, 0.0, Zoom 'shift to srreen by zoom
_glRotatef Tilt, 1.0F, 0.0F, 0.0F 'tilted view
'ted pohneme hvezdou
_glRotatef Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotation by angle this star
_glTranslatef Star(L).Dist, 0.0F, 0.0F 'shift forward in X axis
'rotate it back for case you see to it from side (this process can be used in 3D World for roating 2D characters to player - as in first Wolfenstein3D)
_glRotatef -Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotating back
_glRotatef -Tilt, 1.0F, 0.0F, 0.0F 'tilt back - first we turn around on each star, perform an action and then turn back, because otherwise it will very easily happen that the X axis will become the Z axis and so on.
If Twinkle Then 'if is enabled twinkle effect, use also color previous star
_glColor4ub Star(L - 1).R, Star(L - 1).G, Star(L - 1).B, 255 'this color function has value from to 255, it is R,G,B,A
_glBegin _GL_QUADS
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F
_glEnd
End If
'Now we will draw the main star. The only difference from the previous code is that this star is rotated around the z-axis and has a different color (see indexes)
_glRotatef spin, 0.0F, 0.0F, 1.0F
_glColor4ub Star(L).R, Star(L).G, Star(L).B, 255
_glBegin _GL_QUADS
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F
_glEnd
'We rotate the star by increasing the value of the spin variable. Then we change the angle of each star by loop/num. This means that more distant stars rotate faster.
'Finally, we reduce the distance of the star from the center, so it looks like they are being sucked into the center.
spin = spin + 0.01F 'rotation of the stars
Star(L).Angle = Star(L).Angle + (L / num) 'Star angle increase
Star(L).Dist = Star(L).Dist - 0.01F 'Change the distance of the star from the center
'We check if the star has reached the center. If it does, it gets a new color and is moved 5 units from the center, so it can start its journey again as a new star.
If Star(L).Dist < 0.0F Then 'star is in middle
Star(L).Dist = Star(L).Dist + 5.0F 'new position
Star(L).R = Rnd * 255 'new color
Star(L).G = Rnd * 255 'new color
Star(L).B = Rnd * 255 'new color
End If
Next
If _Exit Then
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glClearColor 0.0, 0.0, 0.0, 0.5 'Black background
_glClearDepth 1.0F ' depth buffer settings
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE 'blending type for transparency
_glEnable _GL_BLEND 'enable blending
If GL_InitInfo = 0 Then
For L = 1 To num
Star(L).Angle = 360 / num * L
Star(L).Dist = (L / num) * 5
Star(L).R = 1 + Rnd * 255
Star(L).G = 1 + Rnd * 255
Star(L).B = 1 + Rnd * 255
Next L
End If
End Sub
Sub DeleteTexture (nr As Long)
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL = nr Then
Dim DEL As Long
DEL = GLL(P).PointerGL
_glDeleteTextures 1, _Offset(DEL)
Exit Sub
End If
Next
End Sub
Function LoadTexture (image As String, Filter As _Unsigned _Byte)
If GL_InitInfo = 0 Then GL_Init
If _FileExists(image) Then
TT = 0
Do Until TT = UBound(GLL)
If GLL(TT).TextureName = image$ And GLL(TT).Filtering = Filter Then
LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
Exit Function
End If
TT = TT + 1
Loop
tex& = _LoadImage(image$, 32)
_ClearColor _RGB32(255, 255, 0), tex&
texinv& = _NewImage(_Width(tex&), _Height(tex&), 32)
_PutImage (0, _Height(tex&))-(_Width(tex&), 0), tex&, texinv&
ni& = _CopyImage(texinv&, 32)
Dim Texture As _Unsigned Long
_glGenTextures 1, _Offset(Texture) 'generate our texture handle (reserve place in memory for new texture)
_glBindTexture _GL_TEXTURE_2D, Texture 'select our texture handle (set this texture for use)
Dim m As _MEM
m = _MemImage(texinv&)
Dim n As _MEM
n = _MemImage(ni&)
Select Case Filter
Case -1
'set our texture wrapping
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
Case 0
'set out texture filtering
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
Case 1
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
Case 2 'works....not sure, if this output is correct
'gluBuild2DMipmaps(GL_TEXTURE_2D, pic->bpp/8, pic->width, pic->height, textureType, GL_UNSIGNED_BYTE, pic->data);
gluBuild2DMipmaps _GL_TEXTURE_2D, 4, _Width(ni&), _Height(ni&), _GL_RGB, _GL_UNSIGNED_BYTE, _Offset(Texture)
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' IF IS USED _GL_LINEAR_MIMAP_NEAREST here, program crash. Is it correct? -?-
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
'gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TextureImage[0]->sizeX, TextureImage[0]->sizeY, GL_RGB, GL_UNSIGNED_BYTE, TextureImage[0]->data);
End Select
_FreeImage tex&
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
saveit:
U = UBound(GLL)
GLL(U).PointerGL = Texture
GLL(U).TextureName = image
GLL(U).Filtering = Filter
ReDim _Preserve GLL(U + 1) As GL_Loader
_MemFree m
Else
Print "LoadTexture Error: "; image$; " - file not found."
End If
LoadTexture = Texture
End FunctionSource code B: (better effects
)Code: (Select All)
Declare CustomType Library
Sub gluBuild2DMipmaps (BYVAL Target As _Unsigned Long, BYVAL iFormat As Long, BYVAL Wdth As Long, BYVAL Hght As Long, BYVAL format As _Unsigned Long, BYVAL typ As _Unsigned Long, BYVAL dat As _Offset)
End Declare
Type GL_Loader
PointerGL As Long
TextureName As String
Filtering As _Unsigned _Byte
End Type
ReDim Shared GLL(0) As GL_Loader, t As Long
Dim Shared GL_InitInfo As _Byte
Dim Shared ExitSignal As _Byte
_Title "Stars in space"
Screen _NewImage(1024, 768, 32)
Const num = 50
Type Stars
As _Unsigned _Byte R, G, B
As Double Dist
As Single Angle
End Type
Dim Shared Star(num) As Stars
Dim Shared Zoom, Tilt, Twinkle
Zoom = -15
Tilt = 90F
Twinkle = 0
'pod timto je puvodni--
Do
i$ = InKey$
Select Case UCase$(i$)
Case "T"
If TwinkleTimer < Timer Then
Twinkle = Not Twinkle
LightTimer = Timer + .5
End If
Case "W"
Tilt = Tilt - 0.5
Case "S"
Tilt = Tilt + 0.5
Case "A"
Zoom = Zoom - .2
Case "D"
Zoom = Zoom + .2
End Select
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
Static L
Texture = LoadTexture("Star.jpg", 0)
_PrintString (20, 20), "Use: A/D for zoom, W/S for shift, T for Twinkle effect."
Init2
GL_Init
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer
_glMatrixMode _GL_PROJECTION ' Set projection matrix - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
_glLoadIdentity '();// Reset matice
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glBindTexture _GL_TEXTURE_2D, Texture
For L = 1 To num
_glLoadIdentity
_glTranslatef 0.0, 0.0, Zoom 'shift to srreen by zoom
_glRotatef Tilt, 1.0F, 0.0F, 0.0F 'tilted view
'ted pohneme hvezdou
_glRotatef Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotation by angle this star
_glTranslatef Star(L).Dist, 0.0F, 0.0F 'shift forward in X axis
'rotate it back for case you see to it from side (this process can be used in 3D World for roating 2D characters to player - as in first Wolfenstein3D)
_glRotatef -Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotating back
_glRotatef -Tilt, 1.0F, 0.0F, 0.0F 'tilt back - first we turn around on each star, perform an action and then turn back, because otherwise it will very easily happen that the X axis will become the Z axis and so on.
If Twinkle Then 'if is enabled twinkle effect, use also color previous star
_glColor4ub Star(L - 1).R, Star(L - 1).G, Star(L - 1).B, 255 'this color function has value from to 255, it is R,G,B,A
_glBegin _GL_QUADS
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F
_glEnd
End If
'Now we will draw the main star. The only difference from the previous code is that this star is rotated around the z-axis and has a different color (see indexes)
_glRotatef spin, 0.0F, 0.0F, 1.0F
_glColor4ub Star(L).R, Star(L).G, Star(L).B, 255
_glBegin _GL_QUADS
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F
_glEnd
'We rotate the star by increasing the value of the spin variable. Then we change the angle of each star by loop/num. This means that more distant stars rotate faster.
'Finally, we reduce the distance of the star from the center, so it looks like they are being sucked into the center.
spin = spin + 0.001F 'rotation of the stars
Star(L).Angle = Star(L).Angle + (L / num) 'Star angle increase
Star(L).Dist = Star(L).Dist - spin '0.01F 'Change the distance of the star from the center
'We check if the star has reached the center. If it does, it gets a new color and is moved 5 units from the center, so it can start its journey again as a new star.
If Star(L).Dist < 0.0F Then 'star is in middle
Star(L).Dist = Star(L).Dist + 5.0F 'new position
Star(L).R = Rnd * 255 'new color
Star(L).G = Rnd * 255 'new color
Star(L).B = Rnd * 255 'new color
End If
Next
If _Exit Then
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glClearColor 0.0, 0.0, 0.0, 0.5 'Black background
_glClearDepth 1.0F ' depth buffer settings
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE ');// Typ blendingu pro průhlednost
_glEnable _GL_BLEND ');// Zapne blending
If GL_InitInfo = 0 Then
For L = 1 To num
Star(L).Angle = 360 / num * L
Star(L).Dist = (L / num) * 5
Star(L).R = 1 + Rnd * 255
Star(L).G = 1 + Rnd * 255
Star(L).B = 1 + Rnd * 255
Next L
End If
End Sub
Sub DeleteTexture (nr As Long)
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL = nr Then
Dim DEL As Long
DEL = GLL(P).PointerGL
_glDeleteTextures 1, _Offset(DEL)
Exit Sub
End If
Next
End Sub
Function LoadTexture (image As String, Filter As _Unsigned _Byte)
If GL_InitInfo = 0 Then GL_Init
If _FileExists(image) Then
TT = 0
Do Until TT = UBound(GLL)
If GLL(TT).TextureName = image$ And GLL(TT).Filtering = Filter Then
LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
Exit Function
End If
TT = TT + 1
Loop
tex& = _LoadImage(image$, 32)
_ClearColor _RGB32(255, 255, 0), tex&
texinv& = _NewImage(_Width(tex&), _Height(tex&), 32)
_PutImage (0, _Height(tex&))-(_Width(tex&), 0), tex&, texinv&
ni& = _CopyImage(texinv&, 32) '_NewImage(32, 32, 32)
Dim Texture As _Unsigned Long
_glGenTextures 1, _Offset(Texture) 'generate our texture handle (reserve place in memory for new texture)
_glBindTexture _GL_TEXTURE_2D, Texture 'select our texture handle (set this texture for use)
Dim m As _MEM
m = _MemImage(texinv&)
Dim n As _MEM
n = _MemImage(ni&)
Select Case Filter
Case -1
'set our texture wrapping
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
Case 0
'set out texture filtering
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
Case 1
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
Case 2 'works....not sure, if this output is correct
'gluBuild2DMipmaps(GL_TEXTURE_2D, pic->bpp/8, pic->width, pic->height, textureType, GL_UNSIGNED_BYTE, pic->data);
gluBuild2DMipmaps _GL_TEXTURE_2D, 4, _Width(ni&), _Height(ni&), _GL_RGB, _GL_UNSIGNED_BYTE, _Offset(Texture)
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' IF IS USED _GL_LINEAR_MIMAP_NEAREST here, program crash. Is it correct? -?-
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
'gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TextureImage[0]->sizeX, TextureImage[0]->sizeY, GL_RGB, GL_UNSIGNED_BYTE, TextureImage[0]->data);
End Select
_FreeImage tex&
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
saveit:
U = UBound(GLL)
GLL(U).PointerGL = Texture
GLL(U).TextureName = image
GLL(U).Filtering = Filter
ReDim _Preserve GLL(U + 1) As GL_Loader
_MemFree m
Else
Print "LoadTexture Error: "; image$; " - file not found."
End If
LoadTexture = Texture
End FunctionBoth need file Star.jpg (it is used as texture)
First program output:
Second - try yourself....