09-20-2024, 08:51 PM
Nobody seems to have tried to do his problem, so I did. Here's mine:
A copy is attached so it may be downloaded.
Code: (Select All)
Option _Explicit
'$Let SINGLECOLOR = 1
$Let COLOR = 0
_Title "Time Tunnel Demo - Press ESC to exit."
' Simulation of the "Time Tunnel" visual effect from the 1960s show of the same name
' Paul Robinson 2024-09-20
Dim s&, centerW&, centerH&, mode&
Dim As Double T1, T2
Dim As _Unsigned _Byte Red, Gray, Yellow, Pink, Green, Blue, Black, White, Brown, Teal, Purple, Violet
Dim As _Unsigned _Byte Color1, Color2, OnColor, OffColor, LoopCount
Dim As Long I, J, K, sw, sh
sw = 1024
sh = 768
'Red = _RGB(255, 0, 0)
'Pink = _RGB(255, 127, 127)
'Yellow = _RGB(255, 255, 0)
'Green = _RGB(0, 255, 0)
'Blue = _RGB(0, 0, 255)
'Black = 0
'White = _RGB(255, 255, 255)
'Brown = _RGB(128, 64, 64)
Dim Shared ColorTable(20, 3) As _Unsigned _Byte
Red = 1: Call InitColortable(Red, 255, 0, 0)
Pink = 2: Call InitColortable(Pink, 255, 127, 127)
Yellow = 3: Call InitColortable(Yellow, 255, 255, 0)
Green = 4: Call InitColortable(Green, 0, 255, 0)
Blue = 5: Call InitColortable(Blue, 0, 0, 255)
Black = 6 ' It's already 0,0,0
Gray = 7: Call InitColortable(Gray, 127, 127, 127)
Teal = 8: Call InitColortable(Teal, 6, 127, 127)
Red = 9: Call InitColortable(Red, 255, 0, 0)
Pink = 10: Call InitColortable(Pink, 255, 127, 127)
Yellow = 11: Call InitColortable(Yellow, 255, 255, 0)
Green = 12: Call InitColortable(Green, 0, 255, 0)
Blue = 13: Call InitColortable(Blue, 0, 0, 255)
Purple = 14: Call InitColortable(Purple, 255, 0, 255)
Violet = 15: Call InitColortable(Violet, 128, 32, 255)
White = 16: Call InitColortable(White, 255, 255, 255)
Brown = 17: Call InitColortable(Brown, 255, 128, 64)
' On color is the band started
OnColor = Black 'Green
' Off color is the contrast
OffColor = White 'Yellow
s& = _NewImage(sw, sh, 32)
Screen s&
centerW& = _Width(mode&) \ 2 'returns pixels in graphic modes
centerH& = _Height(mode&) \ 2 'returns pixels in graphic modes
K = 1
Do
If K Mod 2 Then
$If COLOR = DEFINED Then
Color1 = OnColor
Color2 = OffColor
$Else
Color1 = 255 ' Black & White
Color2 = 0
$End If
Else
$If COLOR = DEFINED Then
Color1 = OffColor
Color2 = OnColor
$Else
Color1 = 0
Color2 = 255
$End If
End If
For I = 1 To 12
If I Mod 2 Then
For J = 1 To 50
$If COLOR = DEFINED Then
Circle (centerW&, centerH&), I * 50 + J, _RGB(ColorTable(Color1, 1), ColorTable(Color1, 2), ColorTable(Color1, 3)), , , 1
$Else
Circle (centerW&, centerH&), I * 50 + J, _RGB(Color1, Color1, Color1), , , 1
$End If
' Circle (centerW&, centerH&), I * 50 + J - 1, _RGB(255, 0, 0), , , 1
Next J
Else
For J = 1 To 50
$If COLOR = DEFINED Then
Circle (centerW&, centerH&), I * 50 + J + 1, _RGB(ColorTable(Color1, 1), ColorTable(Color1, 2), ColorTable(Color1, 3)), , , 1
$Else
Circle (centerW&, centerH&), I * 50 + J + 1, _RGB(Color2, Color2, Color2), , , 1
$End If
T2 = 0
T1 = Timer(.001)
Do While T2 < T1 + .01
T2 = Timer(.001)
Loop
$If COLOR = DEFINED Then
Circle (centerW&, centerH&), I * 50 + J, _RGB(ColorTable(Color2, 1), ColorTable(Color2, 2), ColorTable(Color2, 3)), , , 1
$Else
Circle (centerW&, centerH&), I * 50 + J, _RGB(Color2, Color2, Color2), , , 1
$End If
Next
End If
Next I
T2 = 0
T1 = Timer(.001)
Do While T2 < T1 + .3 ' Short delay
T2 = Timer(.001)
Loop
If InKey$ = Chr$(27) Then End
K = K + 1
Loop
Sub InitColortable (Colorindex%, RedValue%, BlueValue%, GreenValue%)
ColorTable(Colorindex%, 1) = RedValue%
ColorTable(Colorindex%, 2) = BlueValue%
ColorTable(Colorindex%, 3) = GreenValue%
End SubA copy is attached so it may be downloaded.
While 1
Fix Bugs
report all bugs fixed
receive bug report
end while
Fix Bugs
report all bugs fixed
receive bug report
end while