09-25-2025, 10:30 PM
I had fun noodling around with this little proggie. It's an open and shut case... Thanks again to @bplus for cracking circle aspects for me a while back.
I included the .bas and 3 sound files in the attached zip to make it more Halloweeny - and easy to load.
I included the .bas and 3 sound files in the attached zip to make it more Halloweeny - and easy to load.
Code: (Select All)
Option _Explicit
Screen _NewImage(1280, 720, 32)
_Delay .25: _ScreenMove _Middle
_PrintMode _KeepBackground
$Color:32
' ------------------------------
Const DoorColor = LightSeaGreen
' ------------------------------
Type point: x As Integer: y As Integer: End Type
' ------------------------------
Dim Shared Points(1 To 4) As point
Dim Shared As Integer i, angle, num
Dim Shared As Integer semi_maj, semi_min, doorFarX
Dim As _Byte opening, closing
Dim As Long S(2)
' ------------------------------
Dim Shared asp(1 To 90) ' thanks again, b+
i = 1: asp(1) = 1 ' make an array of aspect values, Note: asp(i) = Cos(_D2R(i)) will spin on the other axis
While i < 90: i = i + 1: asp(i) = 1 / Cos(_D2R(i)): Wend
' ------------------------------ a doorway formed with the hinge side first then other points fall along ellipses
Points(1).x = 600: Points(1).y = 300 ' assign points 1 & 2
Points(2).x = 600: Points(2).y = 600
semi_maj = 150: semi_min = 16 ' ellipse dimensions for door to follow
doorFarX = semi_maj * Cos(_D2R(angle)) + Points(2).x ' door width
' ------------------------------
S(0) = _SndOpen("creakyDoor.mp3") ' a few sound effects
S(1) = _SndOpen("shuttingDoor.mp3")
S(2) = _SndOpen("swingBack.mp3")
' ------------------------------
Do: Cls , MediumTurquoise
Points(3).x = semi_maj * Cos(_D2R(angle)) + Points(1).x ' assign points 3 & 4
Points(3).y = semi_min * Sin(_D2R(angle)) + Points(1).y ' using ellipse dims & points 1 & 2
Points(4).x = semi_maj * Cos(_D2R(angle)) + Points(2).x
Points(4).y = semi_min * Sin(_D2R(angle)) + Points(2).y
ShowDoor
If angle = 1 _AndAlso opening Then _SndPlay S(0) ' sound FX triggers
If angle = 6 _AndAlso closing Then _SndPlay S(1)
If angle = 135 _AndAlso closing Then _SndPlay S(2)
If closing _AndAlso _SndPlaying(S(0)) Then _SndStop S(0)
' * user input *
If _KeyDown(111) Then opening = _TRUE: closing = _FALSE ' "o" to open
If _KeyDown(99) Then closing = _TRUE: opening = _FALSE ' "c" to close
If opening And angle = 168 Then opening = _FALSE ' door swing limits
If closing And angle = 0 Then closing = _FALSE
If opening Then angle = angle + 1 ' auto-open/close
If closing Then angle = angle - 1
If angle > 359 Then angle = 0 ' control spin angle
If angle < 0 Then angle = 360 + angle
If angle > 0 _AndAlso angle < 90 Then ' black rectangle for black room inside
Line (Points(3).x + (angle \ 12), Points(1).y)-(doorFarX, Points(2).y), _RGB32(0), BF
ElseIf angle = 90 _OrElse angle = 91 Then
Line (Points(1).x + (angle \ 12), Points(1).y)-(doorFarX, Points(2).y), _RGB32(0), BF
ElseIf angle >= 92 Then
Line (Points(1).x, Points(1).y)-(doorFarX, Points(2).y), _RGB32(0), BF
End If
' ---------------
If angle > 18 _AndAlso angle <= 90 Then ' door edge box
Line (Points(3).x, Points(1).y)-(Points(3).x + (angle \ 12), Points(4).y), Black, B
Paint (Points(3).x + 1, Points(1).y + 5), DoorColor, Black
End If
If angle > 90 Then
num = 180 - angle ' 90 back to zero
Line (Points(3).x, Points(1).y)-(Points(3).x + (num \ 10), Points(4).y), Black, B
Paint (Points(3).x + 1, Points(1).y + 5), DoorColor, Black
End If
' ---------------
_UPrintString (550, _Height - 80), "Press 'o' to open, 'c' to close."
_Display
_Limit 45
Loop Until _KeyDown(27)
For i = 0 To UBound(S): _SndClose S(i): Next ' release the sounds, Smithers.
System
' -----------------------------------------
Sub ShowDoor ()
Dim As Integer knobX, knobY
Line (Points(1).x, Points(1).y)-(Points(3).x, Points(1).y), Black ' door frame
Line -(Points(4).x, Points(4).y), Black
Line -(Points(2).x, Points(2).y), Black
Line -(Points(1).x, Points(1).y), Black
If angle > 90 Then Paint (Points(1).x - 2, Points(1).y + 10), Peru, Black ' paint different door sides
If angle < 90 Then Paint (Points(1).x + 2, Points(1).y + 10), DoorColor, Black
knobX = (semi_maj - 20) * Cos(_D2R(angle)) + Points(2).x ' door knob code
knobY = semi_min * Sin(_D2R(angle)) + Points(2).y - 130
If angle >= 0 _AndAlso angle <= 80 Then
Circle (knobX, knobY), 7, Black, , , asp(angle + 1)
Paint (knobX, knobY), Green, Black
End If
If angle > 109 Then
Circle (knobX, knobY), 7, Black, , , asp(num)
Paint (knobX, knobY), Green, Black
End If
End Sub
' -----------------------------------------
