Posts: 19
Threads: 2
Joined: Mar 2025
Reputation:
1
05-07-2025, 11:03 AM
(This post was last modified: 05-07-2025, 11:30 AM by SMcNeill.)
Code: (Select All)
' QB64 Phoenix Edition Cassette Recorder Simulator with Proper Alpha and Case-Sensitive Variables
DECLARE SUB DrawTapePlayer (LeftReel AS INTEGER, RightReel AS INTEGER, TapeWobble AS INTEGER, TapeType AS INTEGER, Angle AS SINGLE)
' Create high-resolution graphics window
DIM ScreenID AS LONG
ScreenID = _NEWIMAGE(800, 600, 32) ' 800x600 resolution, 32-bit color mode
SCREEN ScreenID
_AUTODISPLAY ' Enables graphics rendering
' Define colors with Alpha Channel (fully opaque)
DIM PlayerColor AS _UNSIGNED LONG
DIM TapeColor AS _UNSIGNED LONG
DIM OxideTapeColor AS _UNSIGNED LONG
DIM RollerColor AS _UNSIGNED LONG
PlayerColor = _RGBA32(50, 50, 50, 255) ' Dark gray for the player casing
TapeColor = _RGBA32(139, 69, 19, 255) ' Standard brown tape
OxideTapeColor = _RGBA32(160, 82, 45, 255) ' Reddish-brown oxide tape
RollerColor = _RGBA32(245, 245, 220, 255) ' Off-white rollers
DIM TapeLength AS INTEGER
DIM SpeedMode AS STRING
DIM TapeType AS INTEGER
DIM LeftReel AS INTEGER
DIM RightReel AS INTEGER
DIM TapeWobble AS INTEGER
DIM KeyPress AS STRING
DIM Angle AS SINGLE
CLS
_PRINTSTRING (50, 50), "Welcome to the QB64 Cassette Recorder Simulator!"
_PRINTSTRING (50, 70), "Press any key to continue..."
DO
KeyPress = INKEY$
LOOP UNTIL KeyPress <> ""
CLS
_PRINTSTRING (50, 50), "Select Tape Length (10, 15, 30, 45, 60, 90, 120 minutes): "
DO
KeyPress = INKEY$
IF KeyPress >= "0" AND KeyPress <= "9" THEN TapeLength = VAL(KeyPress) * 10
LOOP UNTIL TapeLength > 0
_PRINTSTRING (50, 70), "Select Speed Mode (N: Normal, F: Fast, S: Slow, L: Long Play, E: Extra Long Play): "
DO
KeyPress = INKEY$
SELECT CASE KeyPress
CASE "N": SpeedMode = "Normal"
CASE "F": SpeedMode = "Fast"
CASE "S": SpeedMode = "Slow"
CASE "L": SpeedMode = "Long Play"
CASE "E": SpeedMode = "Extra Long Play"
END SELECT
LOOP UNTIL SpeedMode <> ""
_PRINTSTRING (50, 90), "Choose Tape Type (1: Standard Brown, 2: Metal Oxide Red-Brown): "
DO
KeyPress = INKEY$
IF KeyPress = "1" THEN TapeType = 1
IF KeyPress = "2" THEN TapeType = 2
LOOP UNTIL TapeType > 0
CLS
_PRINTSTRING (50, 50), "Loading Tape..."
SLEEP 2
' Initial reel sizes
LeftReel = 80
RightReel = 20
TapeWobble = 0
Angle = 0
FOR i = 1 TO TapeLength * 5
CLS
DrawTapePlayer LeftReel, RightReel, TapeWobble, TapeType, Angle
SLEEP 1
' Simulate tape winding: left reel shrinks, right reel grows
IF LeftReel > 20 THEN
LeftReel = LeftReel - 1
RightReel = RightReel + 1
END IF
' Simulate slight tape wobble
TapeWobble = INT(RND * 4) - 2
' Increase rotation angle
Angle = Angle + 5
IF Angle >= 360 THEN Angle = 0
NEXT
_PRINTSTRING (50, 550), "Playback Complete!"
SUB DrawTapePlayer (LeftReel AS INTEGER, RightReel AS INTEGER, TapeWobble AS INTEGER, TapeType AS INTEGER, Angle AS SINGLE)
' Select tape color
DIM CurrentTapeColor AS _UNSIGNED LONG
IF TapeType = 1 THEN
CurrentTapeColor = TapeColor
ELSE
CurrentTapeColor = OxideTapeColor
END IF
' ? **Layer Rendering: Back-to-Front**
' 1️⃣ Draw **player frame (boxy shape)**
LINE (100, 100)-(700, 500), PlayerColor, BF
' 2️⃣ Draw **rollers (off-white)**, dividing player into thirds
CIRCLE (250, 150), 10, RollerColor
PAINT (250, 150), RollerColor, RollerColor
CIRCLE (550, 150), 10, RollerColor
PAINT (550, 150), RollerColor, RollerColor
' 3️⃣ **Convert polar coordinates to rectilinear** for rotation effect
DIM X1 AS INTEGER, Y1 AS INTEGER, X2 AS INTEGER, Y2 AS INTEGER
X1 = 300 + COS(Angle * 3.14159 / 180) * LeftReel
Y1 = 300 + SIN(Angle * 3.14159 / 180) * LeftReel
X2 = 500 + COS(Angle * 3.14159 / 180) * RightReel
Y2 = 300 + SIN(Angle * 3.14159 / 180) * RightReel
' 4️⃣ Draw **reels (shrinking/growing with playback)**
CIRCLE (300, 300), LeftReel, CurrentTapeColor
PAINT (300, 300), CurrentTapeColor, CurrentTapeColor
CIRCLE (500, 300), RightReel, CurrentTapeColor
PAINT (500, 300), CurrentTapeColor, CurrentTapeColor
' 5️⃣ Draw **animated tape strip moving through rollers**
LINE (300, 300)-(250, 150 + TapeWobble), CurrentTapeColor
LINE (250, 150 + TapeWobble)-(550, 150 + TapeWobble), CurrentTapeColor
LINE (550, 150 + TapeWobble)-(500, 300), CurrentTapeColor
' 6️⃣ **Graphical text overlay at the end** (to avoid interference)
_PRINTSTRING (50, 520), "Left Reel Size: " + LTRIM$(STR$(LeftReel))
_PRINTSTRING (450, 520), "Right Reel Size: " + LTRIM$(STR$(RightReel))
END SUB
Posts: 3,001
Threads: 356
Joined: Apr 2022
Reputation:
279
You're not sharing your colors to the SUB so they're all blank:
' Define colors with Alpha Channel (fully opaque)
Dim Shared PlayerColor As _Unsigned Long
Dim Shared TapeColor As _Unsigned Long
Dim Shared OxideTapeColor As _Unsigned Long
Dim Shared RollerColor As _Unsigned Long
Posts: 3,001
Threads: 356
Joined: Apr 2022
Reputation:
279
Suggested changes/tweaks to the code below. Be certain to read over the comments for the reasons for everything.
Code: (Select All)
' QB64 Phoenix Edition Cassette Recorder Simulator with Proper Alpha and Case-Sensitive Variables
'DECLARE SUB DrawTapePlayer (LeftReel AS INTEGER, RightReel AS INTEGER, TapeWobble AS INTEGER, TapeType AS INTEGER, Angle AS SINGLE)
'Note that DECLARE SUB as above isn't needed for QB64 programs
' Create high-resolution graphics window
Dim ScreenID As Long
ScreenID = _NewImage(800, 600, 32) ' 800x600 resolution, 32-bit color mode
Screen ScreenID
_AutoDisplay ' Enables graphics rendering
' Define colors with Alpha Channel (fully opaque)
'Note: Change these to SHARED so the colors carry though the SUB
Dim Shared As _Unsigned Long PlayerColor, TapeColor, OxideTapeColor, RollerColor
PlayerColor = _RGBA32(50, 50, 50, 255) ' Dark gray for the player casing
TapeColor = _RGBA32(139, 69, 19, 255) ' Standard brown tape
OxideTapeColor = _RGBA32(160, 82, 45, 255) ' Reddish-brown oxide tape
RollerColor = _RGBA32(245, 245, 220, 255) ' Off-white rollers
Dim TapeLength As Integer
Dim SpeedMode As String
Dim TapeType As Integer
Dim LeftReel As Integer
Dim RightReel As Integer
Dim TapeWobble As Integer
Dim KeyPress As String
Dim Angle As Single
Cls
_PrintString (50, 50), "Welcome to the QB64 Cassette Recorder Simulator!"
_PrintString (50, 70), "Press any key to continue..."
Do
KeyPress = Input$(1) 'use of input$(1) stops endless loop and reduces CPU usage
Loop Until KeyPress <> ""
Cls
Print "Select Tape Length:"
Print "1) 10 minutes."
Print "2) 15 minutes."
Print "3) 30 minutes."
Print "4) 60 minutes."
Print "5) 90 minutes."
Print "6) 120 minutes."
Do
KeyPress = Input$(1) 'use of input$(1) stops endless loop and reduces CPU usage
Select Case KeyPress 'have length match actual input type length
Case "1": TapeLength = 10
Case "2": TapeLength = 15
Case "3": TapeLength = 30
Case "4": TapeLength = 60
Case "5": TapeLength = 90
Case "6": TapeLength = 120
End Select
Loop Until TapeLength > 0
Cls
Print "Select Speed Mode (N: Normal, F: Fast, S: Slow, L: Long Play, E: Extra Long Play): "
Do
KeyPress = Input$(1) 'again, swap to input$(1) to reduce loop CPU usage
Select Case KeyPress 'add the lower case input values
Case "N", "n": SpeedMode = "Normal"
Case "F", "f": SpeedMode = "Fast"
Case "S", "s": SpeedMode = "Slow"
Case "L", "l": SpeedMode = "Long Play"
Case "E", "e": SpeedMode = "Extra Long Play"
End Select
Loop Until SpeedMode <> ""
Cls
Print "Choose Tape Type (1: Standard Brown, 2: Metal Oxide Red-Brown): "
Do
KeyPress = Input$(1) 'you get the drill here by now
If KeyPress = "1" Then TapeType = 1
If KeyPress = "2" Then TapeType = 2
Loop Until TapeType > 0
Cls
_PrintString (50, 50), "Loading Tape..."
Sleep 2
' Initial reel sizes
LeftReel = 80
RightReel = 20
TapeWobble = 0
Angle = 0
For i = 1 To TapeLength * 5
Cls
DrawTapePlayer LeftReel, RightReel, TapeWobble, TapeType, Angle
Sleep 1
' Simulate tape winding: left reel shrinks, right reel grows
If LeftReel > 20 Then
LeftReel = LeftReel - 1
RightReel = RightReel + 1
End If
' Simulate slight tape wobble
TapeWobble = Int(Rnd * 4) - 2
' Increase rotation angle
Angle = Angle + 5
If Angle >= 360 Then Angle = 0
Next
_PrintString (50, 550), "Playback Complete!"
Sub DrawTapePlayer (LeftReel As Integer, RightReel As Integer, _
TapeWobble As Integer, TapeType As Integer, Angle As Single)
' Select tape color
Dim CurrentTapeColor As _Unsigned Long
If TapeType = 1 Then
CurrentTapeColor = TapeColor
Else
CurrentTapeColor = OxideTapeColor
End If
' ? **Layer Rendering: Back-to-Front**
' 1?? Draw **player frame (boxy shape)**
Line (100, 100)-(700, 500), PlayerColor, BF
' 2?? Draw **rollers (off-white)**, dividing player into thirds
Circle (250, 150), 10, RollerColor
Paint (250, 150), RollerColor, RollerColor
Circle (550, 150), 10, RollerColor
Paint (550, 150), RollerColor, RollerColor
' 3?? **Convert polar coordinates to rectilinear** for rotation effect
Dim X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer
X1 = 300 + Cos(Angle * 3.14159 / 180) * LeftReel
Y1 = 300 + Sin(Angle * 3.14159 / 180) * LeftReel
X2 = 500 + Cos(Angle * 3.14159 / 180) * RightReel
Y2 = 300 + Sin(Angle * 3.14159 / 180) * RightReel
' 4?? Draw **reels (shrinking/growing with playback)**
Circle (300, 300), LeftReel, CurrentTapeColor
Paint (300, 300), CurrentTapeColor, CurrentTapeColor
Circle (500, 300), RightReel, CurrentTapeColor
Paint (500, 300), CurrentTapeColor, CurrentTapeColor
' 5?? Draw **animated tape strip moving through rollers**
Line (300, 300)-(250, 150 + TapeWobble), CurrentTapeColor
Line (250, 150 + TapeWobble)-(550, 150 + TapeWobble), CurrentTapeColor
Line (550, 150 + TapeWobble)-(500, 300), CurrentTapeColor
' 6?? **Graphical text overlay at the end** (to avoid interference)
_PrintString (50, 520), "Left Reel Size: " + LTrim$(Str$(LeftReel))
_PrintString (450, 520), "Right Reel Size: " + LTrim$(Str$(RightReel))
End Sub
Posts: 4,123
Threads: 190
Joined: Apr 2022
Reputation:
258
05-07-2025, 12:17 PM
(This post was last modified: 05-07-2025, 01:22 PM by bplus.)
Here is my fix:
Code: (Select All) ' QB64 Phoenix Edition Cassette Recorder Simulator with Proper Alpha and Case-Sensitive Variables
DECLARE SUB DrawTapePlayer (LeftReel AS INTEGER, RightReel AS INTEGER, TapeWobble AS INTEGER, TapeType AS INTEGER, Angle AS SINGLE)
' Create high-resolution graphics window
Dim ScreenID As Long
ScreenID = _NewImage(800, 600, 32) ' 800x600 resolution, 32-bit color mode
Screen ScreenID
_AutoDisplay ' Enables graphics rendering
' Define colors with Alpha Channel (fully opaque)
Dim Shared PlayerColor As _Unsigned Long
Dim Shared TapeColor As _Unsigned Long
Dim Shared OxideTapeColor As _Unsigned Long
Dim Shared RollerColor As _Unsigned Long
PlayerColor = _RGBA32(50, 50, 50, 255) ' Dark gray for the player casing
TapeColor = _RGBA32(139, 69, 19, 255) ' Standard brown tape
OxideTapeColor = _RGBA32(160, 82, 45, 255) ' Reddish-brown oxide tape
RollerColor = _RGBA32(245, 245, 220, 255) ' Off-white rollers
Dim TapeLength As Integer
Dim SpeedMode As String
Dim TapeType As Integer
Dim LeftReel As Integer
Dim RightReel As Integer
Dim TapeWobble As Integer
Dim KeyPress As String
Dim Angle As Single
Cls
_PrintString (50, 50), "Welcome to the QB64 Cassette Recorder Simulator!"
_PrintString (50, 70), "Press any key to continue..."
Do
KeyPress = InKey$
Loop Until KeyPress <> ""
Cls
_PrintString (50, 50), "Select Tape Length press 1-9 for 10 X's tape length: " ' fixed for user
Do
KeyPress = InKey$
If KeyPress >= "0" And KeyPress <= "9" Then TapeLength = Val(KeyPress) * 10
Loop Until TapeLength > 0
_PrintString (50, 70), "Select Speed Mode (N: Normal, F: Fast, S: Slow, L: Long Play, E: Extra Long Play): "
Do
KeyPress = UCase$(InKey$) ' add ucase$
Select Case KeyPress
Case "N": SpeedMode = "Normal"
Case "F": SpeedMode = "Fast"
Case "S": SpeedMode = "Slow"
Case "L": SpeedMode = "Long Play"
Case "E": SpeedMode = "Extra Long Play"
End Select
Loop Until SpeedMode <> ""
_PrintString (50, 90), "Choose Tape Type (1: Standard Brown, 2: Metal Oxide Red-Brown): "
Do
KeyPress = InKey$
If KeyPress = "1" Then TapeType = 1
If KeyPress = "2" Then TapeType = 2
Loop Until TapeType > 0
Cls
_PrintString (50, 50), "Loading Tape..."
Sleep 2
' Initial reel sizes
LeftReel = 80
RightReel = 20
TapeWobble = 0
Angle = 0
For i = 1 To TapeLength * 5
Cls
DrawTapePlayer LeftReel, RightReel, TapeWobble, TapeType, Angle
'Sleep 1 ' why????
' Simulate tape winding: left reel shrinks, right reel grows
If LeftReel > 20 Then
LeftReel = LeftReel - 1
RightReel = RightReel + 1
End If
' Simulate slight tape wobble
TapeWobble = Int(Rnd * 4) - 2
' Increase rotation angle
Angle = Angle + 5
If Angle >= 360 Then Angle = 0
_Display ' no blinking from CLS
_Limit 10 ' smoother than sleep 1
Next
_PrintString (50, 550), "Playback Complete!"
Sub DrawTapePlayer (LeftReel As Integer, RightReel As Integer, TapeWobble As Integer, TapeType As Integer, Angle As Single)
' Select tape color
Dim CurrentTapeColor As _Unsigned Long
If TapeType = 1 Then
CurrentTapeColor = TapeColor
Else
CurrentTapeColor = OxideTapeColor
End If
' ? **Layer Rendering: Back-to-Front**
' 1?? Draw **player frame (boxy shape)**
Line (100, 100)-(700, 500), PlayerColor, BF
' 5?? Draw **animated tape strip moving through rollers**
Line (300 - LeftReel, 300)-(240, 150 + TapeWobble), CurrentTapeColor
Line (250, 140 + TapeWobble)-(555, 140 + TapeWobble), CurrentTapeColor
Line (560, 150 + TapeWobble)-(500 + RightReel, 300), CurrentTapeColor
' 3?? **Convert polar coordinates to rectilinear** for rotation effect
Dim X1 As Integer, Y1 As Integer, X2 As Integer, Y2 As Integer
X1 = 300 + Cos(Angle * 3.14159 / 180) * LeftReel
Y1 = 300 + Sin(Angle * 3.14159 / 180) * LeftReel
X2 = 500 + Cos(Angle * 3.14159 / 180) * RightReel
Y2 = 300 + Sin(Angle * 3.14159 / 180) * RightReel
' 4?? Draw **reels (shrinking/growing with playback)**
Circle (300, 300), LeftReel, CurrentTapeColor
Paint (300, 310), CurrentTapeColor, CurrentTapeColor
Circle (500, 300), RightReel, CurrentTapeColor
Paint (500, 310), CurrentTapeColor, CurrentTapeColor
' 2?? Draw **rollers (off-white)**, dividing player into thirds
Circle (250, 150), 10, RollerColor
Paint (250, 150), RollerColor, RollerColor
Circle (550, 150), 10, RollerColor
Paint (550, 150), RollerColor, RollerColor
' 6?? **Graphical text overlay at the end** (to avoid interference)
_PrintString (50, 520), "Left Reel Size: " + LTrim$(Str$(LeftReel))
_PrintString (450, 520), "Right Reel Size: " + LTrim$(Str$(RightReel))
End Sub
So tape reels look more realistic!
update, not quite something needs to be fixed with length of tape and how long it runs as reels max out before sim ends.
b = b + ...
|
