Data commit

Task/Musical-scale/FreeBASIC/musical-scale.basic

@@ -0,0 +1,73 @@
+REM FreeBASIC no tiene la capacidad de emitir sonido de forma nativa.
+REM La función Sound no es mía, incluyo los créditos correspondientes.
+' Sound Function v0.3 For DOS/Linux/Win by yetifoot
+' Credits:
+'    http://www.frontiernet.net/~fys/snd.htm
+'    http://delphi.about.com/cs/adptips2003/a/bltip0303_3.htm
+#ifdef __FB_WIN32__
+#include Once "windows.bi"
+#endif
+Sub Sound_DOS_LIN(Byval freq As Uinteger, dur As Uinteger)
+    Dim t As Double
+    Dim As Ushort fixed_freq = 1193181 \ freq
+
+    Asm
+        mov  dx, &H61                  ' turn speaker on
+        in   al, dx
+        or   al, &H03
+        out  dx, al
+        mov  dx, &H43                  ' get the timer ready
+        mov  al, &HB6
+        out  dx, al
+        mov  ax, word Ptr [fixed_freq] ' move freq to ax
+        mov  dx, &H42                  ' port to out
+        out  dx, al                    ' out low order
+        xchg ah, al
+        out  dx, al                    ' out high order
+    End Asm
+
+    t = Timer
+    While ((Timer - t) * 1000) < dur ' wait for out specified duration
+        Sleep(1)
+    Wend
+
+    Asm
+        mov  dx, &H61                  ' turn speaker off
+        in   al, dx
+        and  al, &HFC
+        out  dx, al
+    End Asm
+End Sub
+
+Sub Sound(Byval freq As Uinteger, dur As Uinteger)
+    #ifndef __fb_win32__
+    ' If not windows Then call the asm version.
+    Sound_DOS_LIN(freq, dur)
+    #Else
+    ' If Windows
+    Dim osv As OSVERSIONINFO
+
+    osv.dwOSVersionInfoSize = Sizeof(OSVERSIONINFO)
+    GetVersionEx(@osv)
+
+    Select Case osv.dwPlatformId
+    Case VER_PLATFORM_WIN32_NT
+        ' If NT then use Beep from API
+        Beep_(freq, dur)
+    Case Else
+        ' If not on NT then use the same as DOS/Linux
+        Sound_DOS_LIN(freq, dur)
+    End Select
+    #endif
+End Sub
+
+'----------
+Sound(262, 250)  'C4
+Sound(294, 250)  'D4
+Sound(330, 250)  'E4
+Sound(349, 250)  'F4
+Sound(392, 250)  'G4
+Sound(440, 250)  'A4
+Sound(494, 250)  'B4
+Sound(523, 250)  'C5
+Sleep