'Programs modified by Russ Campbell
'parts of programs taken from
'Pete at qb64.org
'Mini MP3 Player by Ken G.
'This program was made on August 23, 2019 by Ken G. with lots of help by B+, SMcneill, and Petr from the QB64.org forum.
'This program makes 2 temporary files called MyMusicFiles.temp and DIR$INF0.INF in your default temp directory.
'If for some reason these files exist after this program is shut down, you are free to delete them.
'The Digital Music Player created and modified freom existing code by Russ C.


_Title "Digital Music Player"

Dim Shared tmpDir As String '  establish a permanent spot for temp files
If Environ$("TEMP") <> "" Then 'Thanks to Steve McNeill use user temp files directory
    tmpDir = Environ$("TEMP")
ElseIf Environ$("TMP") <> "" Then
    tmpDir = Environ$("TMP")
Else 'Thanks to Steve McNeill this should be very unlikely
    If _DirExists("C:\temp") Then Else MkDir "C:\temp"
    tmpDir = "C:\temp"
End If



'files/directories list using Steve library (u.s. chars only)

'CHDIR "x:" tested on network drive, ok work correctly
_FullScreen

Declare CustomType Library "./direntry"
    Function load_dir& (s As String)
    Function has_next_entry& ()
    Sub close_dir ()
    Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare
Declare Dynamic Library "WINMM"
    Function mciSendStringA% (lpstrCommand As String, lpstrReturnString As String, Byval uReturnLength As Integer, Byval hwndCallback As Integer)
    ' mciSendStringA function plays media files and returns the following:
    ' 0 = command sucessful
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ' lpstrCommand is the MCI command string (and optional flags) to send.
    ' lpstrReturnString is a string that holds any return information.
    ' uReturnLength is the length of the lpstrReturnString string passed.
    ' NOTE: If lpstrCommand given doesn't retun a value then lpstrReturnString
    '       can be empty and uReturnLength can be set to 0.
    ' hwndCallback contains a callback window handle (only if the Notify flag used in lpstrCommand)
    '====================================================================
    Function mciGetErrorStringA% (ByVal dwError As Integer, lpstrBuffer As String, Byval uLength As Integer)
    ' mciGetErrorStringA returns error info if the mciSendStringA failed.
    ' dwError is the return value from the mciSendString function.
    ' lpstrBuffer string holds the error information returned by the function.
    ' uLength is the length of the lpstrBuffer string buffer.
    '====================================================================
    Function PlaySound% Alias PlaySoundA (lpszName As String, Byval hModule As Integer, Byval dwFlags As Integer)
End Declare

Declare CustomType Library
    Function FindWindow& (ByVal ClassName As _Offset, WindowName$)
End Declare
Const SND_SYNC = 0 'Windows controlled
Const SND_ASYNC = 1 'user controlled
Const SND_NODEFAULT = 2 'only plays sound file requested
Const SND_LOOP = 8 'loops the sound. Use ASYNC also to stop later
Const SND_NOSTOP = &H10 'does not allow a sound to be stopped
Const SND_NOWAIT = &H2000 'will not play sound if driver is busy
Const SND_PURGE = &H40 'stop any sound playing


begin2:
ReDim Drives(0) As String
Screen _NewImage(380, 340, 32)
Drives$ = LoadDrives$(Drives()) 'windows only in current version

ReDim DirNew(0) As String
ReDim FileNew(0) As String
start2:


ReDim Dir(0) As String, File(0) As String


GetFileList _CWD$, Dir(), File()
ReDim All(UBound(dir) - 1 + UBound(file)) As String

i = 0


For AllLoader = LBound(dir) + 2 To UBound(dir) '                     i need not "." in list
    If Len(Dir(AllLoader)) Then All(i) = Dir(AllLoader): i = i + 1
Next
For AllLoader = LBound(File) To UBound(File)
    If Len(File(AllLoader)) Then All(i) = File(AllLoader): i = i + 1
Next

If UBound(all) <= 0 Then ChDir (Left$(_CWD$, 3)): GoTo start2

DIRcount = UBound(dir) - 1
FILEcount = UBound(File)
If DIRcount < 0 Then DIRcount = 0
If InStr(1, _OS$, "WINDOWS") Then OS = 0
If InStr(1, _OS$, "LINUX") Then OS = 1

Do
    Cls
    runit$ = ""
    runit$ = Browse$(All(), 20, 15, 40, 9, DIRcount, Drives$, 1) 'array  contains files/directories names, this list X start coordinate, this list Y start coordinate, This list lenght (300 pixel lenght), 30 records in this list to view), return file/folder/"..", "." name which is selected. Last parameter is for DRIVE characters (names) STRING
    '    PRINT runit$: SLEEP 2
    On Error GoTo handler


    Select Case OS
        Case 0
            invalid = InStr(1, runit$, "\\")
        Case 1
            invalid = InStr(1, runit$, "//")
    End Select
    If invalid Then runit$ = Left$(runit$, invalid) + Right$(runit$, Len(runit$) - invalid - 1)


    If Right$(runit$, 1) = "." And OS = 1 Then Beep: ChDir "/": _Delay .1: GoTo start2





    If runit$ = "---E" Then GoTo finish
    filename$ = runit$
    If Len(runit$) And _FileExists(runit$) Then
        GoTo begin
    End If
    If runit$ = "" Then ChDir Left$(_CWD$, 3): _Delay .1: GoTo start2
    If Right$(runit$, 2) = ".." And _DirExists("..") Then ChDir "..": _Delay .1: GoTo start2
    If Right$(runit$, 5) = ".DIR." Then
        runit$ = Left$(runit$, Len(runit$) - 5)
        ChDir runit$
        _Delay .1
        GoTo start2
    End If
Loop
GoTo begin2
handler:

Print "error handler RUN!!!!": Sleep 2
Select Case Err
    Case 76: ChDir Left$(_CWD$, 3) + ":": GoTo start2: Resume Next 'path not found ugrade / add + ":" and goto start
End Select
begin:
If Right$(runit$, 4) = ".mp3" Or Right$(runit$, 5) = ".flak" Or Right$(runit$, 4) = ".ogg" Then
    GoTo song
ElseIf Right$(runit$, 4) = ".mpg" Or Right$(runit$, 4) = ".wmv" Then
    GoTo playvideo
ElseIf Right$(runit$, 4) = ".wav" Then
    GoTo playwave
Else
    GoTo start2
End If
'Play One Song Here
song:
'defdbl a-z

Const sw = 1024
Const sh = 600


'''
Dim Left As _MEM
Dim Right As _MEM
Dim Analyzer(8) As Single
'''


Dim c As Double
Dim u_r As Double, u_i As Double
Dim v_r As Double, v_i As Double


Dim Shared pi As Double
'pi = 2*asin(1)
pi = 4 * Atn(1)

DECLARE SUB rfft(xx_r(), xx_i(), x_r(), n)

Dim x_r(sw - 1), x_i(sw - 1)
Dim xx_r(sw - 1), xx_i(sw - 1)
Dim t As Double

'''
AudioFile$ = filename$
S = _SndOpen(AudioFile$)
Left = _MemSound(S, 1)
Right = _MemSound(S, 2)

'''
Screen _NewImage(sw, sh, 32)

TestT = Timer
'''
_SndPlay S
Do Until _SndPlaying(S) = 0
    i = 0: j = 0 '                                             reset previous values
    Position& = _SndGetPos(S) * _SndRate * 2 '                 *2, because sound data are in INTEGER format and INTEGER is always 2 byte long
    If Position& > 1024 And Position& < Left.SIZE - 1024 Then 'current (actual playing) sound frame is in middle - in position Position&
        j& = Position& - 1022
        Do Until i >= 1024
            x_r(i) = 100 * _MemGet(Left, Left.OFFSET + j&, Integer) / 32767
            i = i + 1
            j& = j& + 2
        Loop
        test& = j& - Position&
    End If

    'FOR i = 0 TO sw - 1
    'x_r(i) = 100 * SIN(2 * pi * (sw * 20000 / 44000) * i / sw) + (100 * RND - 50)      '_Vince's signal generator in original source code
    'NEXT

    i = 0
    j& = 0
    '''



    'screenres sw, sh, 32
    'SCREEN _NEWIMAGE(sw, sh, 32)

    'plot signal
    Cls

    PSet (0, sh / 4 - x_r(0))
    For i = 0 To sw - 1
        Line -(i, sh / 4 - x_r(i)), _RGB(255, 0, 0)
    Next
    Line (0, sh / 4)-Step(sw, 0), _RGB(255, 0, 0), , &H5555

    ' _PRINTSTRING (0, 0), "2000 Hz signal with RND noise sampled at 44 kHz in 1024 samples"


    rfft xx_r(), xx_i(), x_r(), sw

    'plot its fft
    PSet (0, 50 + 3 * sh / 4 - 0.005 * Sqr(xx_r(0) * xx_r(0) + xx_i(0) * xx_i(0))), _RGB(255, 255, 0)
    For i = 0 To sw / 2
        Line -(i * 2, 50 + 3 * sh / 4 - 0.005 * Sqr(xx_r(i) * xx_r(i) + xx_i(i) * xx_i(i))), _RGB(255, 255, 0)
    Next
    Line (0, 50 + 3 * sh / 4)-Step(sw, 0), _RGB(255, 255, 0), , &H5555


    'find peak
    Dim max As Double, d As Double
    max = 0
    m = 0
    For i = 0 To sw / 2
        d = 0.01 * Sqr(xx_r(i) * xx_r(i) + xx_i(i) * xx_i(i))
        If d > max Then
            max = d
            m = i
        End If
    Next

    _PrintString (0, sh / 2), "m_peak =" + Str$(m)
    _PrintString (0, sh / 2 + 16), "f_peak = m_peak * 44 kHz / 1024 samples = " + Str$(m * 44000 / 1024) + " Hz"

    'apply frequency correction, only works for some signals
    '   DIM c AS DOUBLE
    '  DIM u_r AS DOUBLE, u_i AS DOUBLE
    ' DIM v_r AS DOUBLE, v_i AS DOUBLE

    If m = 0 Then _Continue
    u_r = xx_r(m - 1) - xx_r(m + 1)
    u_i = xx_i(m - 1) - xx_i(m + 1)
    v_r = 2 * xx_r(m) - xx_r(m - 1) - xx_r(m + 1)
    v_i = 2 * xx_i(m) - xx_i(m - 1) - xx_i(m + 1)
    c = (u_r * v_r + u_i * v_i) / (v_r * v_r + v_i * v_i)

    F = (m + c) * _SndRate / 1024 '                                                             1024 = number of samples
    _PrintString (0, sh / 2 + 2 * 16), "f_corrected = " + Str$(F) '(m + c) * 44000 / 1024) + " Hz"


    'If signal is contained in some range, add 30 pixels for Y coordinate (analyzer go up, its wroted as bottom - this value)
    Select Case F
        Case 20 TO 125: Analyzer(1) = Analyzer(1) + 30 'areas set by picture on google...
        Case 126 TO 300: Analyzer(2) = Analyzer(2) + 30
        Case 300 TO 500: Analyzer(3) = Analyzer(3) + 30
        Case 500 TO 1000: Analyzer(4) = Analyzer(4) + 30
        Case 1001 TO 2000: Analyzer(5) = Analyzer(5) + 30
        Case 2001 TO 4000: Analyzer(6) = Analyzer(6) + 30
        Case 4001 TO 8000: Analyzer(7) = Analyzer(7) + 30
        Case Is > 8001: Analyzer(8) = Analyzer(8) + 30
    End Select



    'analyzer overflow control
    For analyze = 1 To 8 '                                    analyze 8 spectrums
        If Analyzer(analyze) > 150 Then Analyzer(analyze) = 100
    Next

    'draw analyzer
    AnC = 0
    For AnalyzatorX = 600 To 670 Step 10
        AnC = AnC + 1
        FreqHeight = Analyzer(AnC) '                          Y coordinate for drawing frequency analyzer, maximal size is 150 pixels
        Line (AnalyzatorX - 4, 400)-(AnalyzatorX + 4, 400 - FreqHeight), &HFFAD0000, BF
        If Analyzer(AnC) > 0 Then Analyzer(AnC) = Analyzer(AnC) - 1 ' always, if analyzer contains some higher position than bottom, give one pixel out
    Next

    Print Position&, _SndGetPos(S) * _SndRate
    Print Timer - TestT: TestT = Timer
    _Display
    _Limit 200
Loop

System
GoTo begin2
playwave:
Synch = SND_ASYNC
retval% = PlaySound(filename$, 0, Synch)
GoTo start2
playvideo:


handle& = _NewImage(3000, 600, 256)
Screen handle&


_Title "QB64 Video"
hwnd& = _WindowHandle 'FindWindow(0, "QB64 Video" + CHR$(0))

ReturnString$ = Space$(255)
ErrorString$ = Space$(255)
'<========== video file to play

a% = mciSendStringA%("open " + filename$ + " style popup", ReturnString$, Len(ReturnString$), 0)

If a% Then
    x% = mciGetErrorStringA%(a%, ErrorString$, Len(ErrorString$))
    Print ErrorString$
    End
Else
    a2% = mciSendStringA%("window " + filename$ + " handle " + Str$(hwnd&), ReturnString$, Len(ReturnString$), 0)
    b% = mciSendStringA%("play " + filename$, "", 0, 0)
    _ScreenMove _Middle
    '=== Play video...
    Do: _Limit 30: Loop Until InKey$ <> ""

    x% = mciSendStringA%("stop " + filename$, "", 0, 0)
    x% = mciSendStringA%("close " + filename$, "", 0, 0)
End If
GoTo begin2



finish:
End




Function Browse$ (arr() As String, X, Y, lenght, height, numDirs, Drives As String, UseWheel)
    ' X and Y are coordinates for left upper corner, lenght is window lenght in CHARACTERS, height is window height in records + 2, numDirs = how nmuch
    ' records from begin in array arr() are DIRECTORIES, Drives is string contains valid disk names in Windows, in Linux it is empty string

    ListColor& = _RGB32(166, 244, 244)
    InPosColor& = _RGB32(67, 72, 238)
    DirColor& = _RGB32(238, 22, 28)
    'create string with drives names (i see this first by Eoredson)
    For Driv = 1 To Len(Drives)
        OnScreenDrives$ = OnScreenDrives$ + "[" + Mid$(Drives$, Driv, 1) + ":] "
    Next Driv
    If Len(OnScreenDrives$) > lenght Then OnScreenDrives$ = Left$(OnScreenDrives$, lenght - 3) + LTrim$("...")

    If Lb = 0 And le = 0 Then
        Lb = 1
        le = 20
    End If

    If InStr(1, _OS$, "WINDOWS") Then sel$ = Chr$(92)
    If InStr(1, _OS$, "LINUX") Then sel$ = "/"
    first = 1



    Do
        K& = _KeyHit
        iink$ = UCase$(InKey$)
        If Len(iink$) Then
            If InStr(1, Drives$, iink$) Then
                newdrive$ = iink$ + ":": ChDir newdrive$: Exit Function
            End If
            iink$ = ""
        End If
        oldposx = posx
        If first Then oldposx = -1: first = 0


        'mouse support ---

        While _MouseInput
            MoX = _MouseX: MoY = _MouseY
            If MoX > X And MoX < X + ((lenght + 4) * 8) And MoY > Y And MoY < Y + (height * 20) + 40 Then 'podle LINE

                poloha = _Ceil((MoY - Y - 20) / 20) 'pro mys


                If UseWheel Then ' in function last parameter: 0 = use wheel, 1 = not use wheel
                    Select Case Sgn(_MouseWheel)
                        Case -1: K& = 18432
                        Case 1: K& = 20480
                    End Select

                Else


                    If poloha < posx - Lb Then K& = 18432
                    If poloha > posx - Lb Then K& = 20480
                End If



                If _MouseButton(1) And poloha >= Lb And poloha <= le Then
                    If MoX < (8 * lenght) + X Then K& = 13: _Delay .1

                End If



                If _MouseButton(1) And MoX > (8 * lenght) + X And MoY < Y + 16 Then 'mouse / up arrow
                    K& = 18432
                End If


                If _MouseButton(1) And MoX > (8 * lenght) + X And MoY > Y + (height * 20) + 24 Then 'mouse / down arrow
                    K& = 20480
                End If
            End If

            'podpora prepnuti disku mysi: drive select mouse support (alfa - not full tested)

            If MoX >= X + 10 And MoX < X + 10 + (8 * Len(OnScreenDrives$)) - 8 And MoY >= (Y + 20 * height) + 50 And MoY < (Y + 20 * height) + 66 Then
                If _MouseButton(1) Then
                    DiskSel = _Ceil(((MoX - X + 10) / 8) / 6)
                    If DiskSel > Len(Drives$) Then DiskSel = Len(DiskSel)
                    iink$ = Mid$(Drives$, DiskSel, 1)
                    newdrive$ = iink$ + ":": ChDir newdrive$: Exit Function
                End If
            End If

        Wend
        '------------------


        ' --- keyboard inputs
        Select Case K&
            Case 18432: posx = posx - 1: GU = 1: GD = 0 'marks: Go down disabled, go up enbabled
            Case 20480: posx = posx + 1: GU = 0: GD = 1 'marks: Go down enabled, go up disabled
            Case 13: Browse$ = _CWD$ + sel$ + arr(posx) + dd$: Exit Function 'or if your choice is array record number then return PosX and erase $ in func name 'directory move is solved in my loop
            Case 27: Browse$ = "---E": Exit Function
            Case 32:
        End Select
        ' -------------------

        'if is link selected (not dir):
        If UBound(arr) < 0 Then Exit Function 'Browse$ = LEFT$(_CWD$, 3): EXIT FUNCTION
        'end of bug repair

        If posx <= 0 Then posx = 0: Lb = 0: le = Lb + height
        If posx > UBound(arr) - 1 Then posx = UBound(arr) - 1
        If oldposx <> posx Then
            If posx > le And GD Then Lb = Lb + 1: le = le + 1
            If GU And posx < Lb Then Lb = Lb - 1: le = le - 1
            textpos = 0
            If le > UBound(arr) Then le = UBound(arr)
            If le - Lb > height Then le = Lb + height
            If Lb > le Then Exit Function


            For V = Lb To le 'List Begin to List End

                textpos = textpos + 20 'row is 20 pixel height
                If V = posx Then
                    Color InPosColor&, ListColor&
                Else
                    If V > numDirs - 1 Then Color ListColor& Else Color DirColor&
                    If posx <= numDirs - 1 Then dd$ = ".DIR." Else dd$ = ""
                End If
                text$ = arr(V)
                If Len(text$) > lenght - 2 Then text$ = Left$(text$, lenght - 4) + LTrim$("...") Else text$ = text$ + Space$(lenght - Len(text$) - 1)
                _PrintString (X + 10, Y + textpos), text$
                Color ListColor&, _RGB32(0, 0, 0)


                possss = posx + 1


                Posuvnik_V_Procentech! = (possss / UBound(arr))

                '----------------------------------------------------------------------- dodelat
                WindowHeight = (23 + height * 20) - 40
                OldGC = GC
                GC = Y + WindowHeight * Posuvnik_V_Procentech!

                Color _RGB32(0, 0, 0)
                _PrintString (X + 5 + lenght * _FontWidth, OldGC + 22), Chr$(222)
                Color _RGB32(127, 127, 127)
                _PrintString (X + 5 + lenght * _FontWidth, GC + 22), Chr$(222)

                _PrintString (X + 5 + lenght * _FontWidth, Y + 7), Chr$(24)
                _PrintString (X + 5 + lenght * _FontWidth, 3 + Y + 20 + height * 20), Chr$(25)
                '---------------------------------------------------------------------------

            Next V

            diskar:
            Color _RGB32(255, 255, 0)
            _PrintString (X + 10, (Y + 20 * height) + 50), OnScreenDrives$
            Color _RGB32(255, 205, 249)
            CWD$ = _CWD$
            If Len(CWD$) > lenght Then CWD$ = Left$(CWD$, lenght - 3) + LTrim$("...")
            _PrintString (X + 10, (Y + 20 * height) + 70), CWD$
        End If

        Line (X + 1, Y + 1)-(X + 3 + (8 * lenght) + 16, Y + 3 + (20 * height) + 90), , B
        Line (X + 4, Y + 4)-(X + (8 * lenght) + 16, Y + (20 * height) + 90), , B
        Line (X + 4, Y + (height * 20) + 40)-(X + (8 * lenght) + 16, Y + (height * 20) + 40), , B



        _Limit 80
    Loop
End Function

Function LoadDrives$ (drives() As String)
    If InStr(_OS$, "[WINDOWS]") Then
        Shell _Hide Chr$(34) + "wmic logicaldisk get name" + Chr$(34) + ">TempDirList.txt"
        ReDim drives(0) As String

        Open "TempDirList.txt" For Input As #1
        Line Input #1, junk$ 'First line is  name
        counter = 0
        Do Until EOF(1)
            counter = counter + 1
            Input #1, junk$ 'drive name
            ReDim _Preserve drives(counter) As String
            If Len(junk$) > 1 Then junk$ = Mid$(junk$, 2, 1) + ":" Else junk$ = "": counter = counter - 1
            If junk$ <> "" Then
                drives(counter) = junk$
            End If
        Loop
        Close #1
        Kill "TempDirList.txt"

        For manual = 1 To counter
            LoadDrives$ = LoadDrives$ + Left$(drives(manual), 1)
        Next
    End If
End Function
Sub GetFileList (SearchDirectory As String, DirList() As String, FileList() As String)
    Const IS_DIR = 1
    Const IS_FILE = 2
    Dim flags As Long, file_size As Long

    ReDim _Preserve DirList(500), FileList(500)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory) Then
        Do
            length = has_next_entry
            If length > -1 Then
                nam$ = Space$(length)
                get_next_entry nam$, flags, file_size
                If flags And IS_DIR Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 500)
                    DirList(DirCount) = nam$
                ElseIf flags And IS_FILE Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(filelist) Then ReDim _Preserve FileList(UBound(filelist) + 500)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until length = -1
        close_dir
    Else
    End If
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
End Sub




'Change Directory Here




Sub loadDIR (fa() As String)
    Dim tmpFile As String, Index%, fline$, d$
    tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
    Shell _Hide "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
    Open tmpFile For Input As #1
    Index% = -1
    Do While Not EOF(1)
        Line Input #1, fline$
        If InStr(fline$, "<DIR>") Then
            d$ = _Trim$(rightOf$(fline$, "<DIR>"))
            Index% = Index% + 1
            ReDim _Preserve fa(Index%)
            fa(Index%) = d$
        End If
    Loop
    Close #1
    Kill tmpFile
End Sub

Function rightOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then rightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$))
End Function


Function getArrayItemNumber& (locateRow, locateColumn, boxWidth, boxHeight, arr() As String)

    Dim curRow As Integer, curCol As Integer, fg As _Unsigned Long, bg As _Unsigned Long
    Dim maxWidth As Integer, maxHeight As Integer, page As Integer, hlite As Integer, mx As Integer, my As Integer
    Dim lastMX As Integer, lastMY As Integer, row As Integer, mb As Integer
    Dim lba As Long, uba As Long, choice As Long, kh As Long, index As Long
    Dim clrStr As String, b As String

    'save old settings to restore at end ofsub
    curRow = CsrLin
    curCol = Pos(0)
    fg = _DefaultColor
    bg = _BackgroundColor
    _KeyClear

    maxWidth = boxWidth '       number of characters in box
    maxHeight = boxHeight - 2 ' number of lines displayed of array at one time = 1 page
    lba = LBound(arr)
    uba = UBound(arr)
    page = 0
    hlite = 0 '                 line in display ready for selection by spacebar or if no number is started, enter
    clrStr$ = Space$(maxWidth) 'clearing a display line

    GoSub update '              show the beginning of the array items for selection

    'signal cancel selection process, exit sub with this unlikely index to signal canel
    choice = -1719 'primes 7 and 8, not likely to be a select index of an array

    Do 'until get a selection or demand exit

        'handle the key stuff
        kh& = _KeyHit
        If kh& Then
            If kh& > 0 And kh& < 255 Then
                If InStr("0123456789", Chr$(kh&)) > 0 Then b$ = b$ + Chr$(kh&): GoSub update
                'IF CHR$(kh&) = "h" THEN HELP: _KEYCLEAR

                If Chr$(kh&) = "c" Then b$ = "": GoSub update
                If kh& = 13 Then 'enter pressed check if number is being entered?
                    If Len(b$) Then
                        If Val(b$) >= lba And Val(b$) <= uba Then 'we have number started
                            choice = Val(b$): Exit Do
                        Else 'clear b$ to show some response to enter
                            b$ = "": GoSub update 'clear the value that doesn't work
                        End If
                    Else
                        choice = hlite + page * maxHeight + lba 'must mean to select the highlighted item
                    End If
                End If
                If kh& = 27 Then Exit Do 'escape clause offered to Cancel selection process
                If kh& = 32 Then choice = hlite + page * maxHeight + lba 'best way to choose highlighted selection
                If kh& = 8 Then 'backspace to edit number
                    If Len(b$) Then b$ = Left$(b$, Len(b$) - 1): GoSub update
                End If
            Else
                Select Case kh& 'choosing sections of array to display and highlighted item
                    Case 20736 'pg dn
                        If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
                    Case 18688 'pg up
                        If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
                    Case 18432 'up
                        If hlite - 1 < 0 Then
                            If page > 0 Then
                                page = page - 1: hlite = maxHeight - 1: GoSub update
                            End If
                        Else
                            hlite = hlite - 1: GoSub update
                        End If
                    Case 20480 'down
                        If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
                            If hlite + 1 > maxHeight - 1 Then
                                page = page + 1: hlite = 0: GoSub update
                            Else
                                hlite = hlite + 1: GoSub update
                            End If
                        End If
                    Case 18176 'home
                        page = 0: hlite = 0: GoSub update
                    Case 20224 ' end
                        page = Int((uba - lba) / maxHeight): hlite = maxHeight - 1: GoSub update
                End Select
            End If
        End If

        'handle the mouse stuff
        While _MouseInput
            If _MouseWheel = -1 Then 'up?
                If hlite - 1 < 0 Then
                    If page > 0 Then
                        page = page - 1: hlite = maxHeight - 1: GoSub update
                    End If
                Else
                    hlite = hlite - 1: GoSub update
                End If
            ElseIf _MouseWheel = 1 Then 'down?
                If (hlite + 1) + page * maxHeight + lba <= uba Then 'ok to move up
                    If hlite + 1 > maxHeight - 1 Then
                        page = page + 1: hlite = 0: GoSub update
                    Else
                        hlite = hlite + 1: GoSub update
                    End If
                End If
            End If
        Wend
        mx = Int((_MouseX - locateColumn * 8) / 8) + 2: my = Int((_MouseY - locateRow * 16) / 16) + 2
        If _MouseButton(1) Then 'click contols or select array item
            'clear mouse clicks
            mb = _MouseButton(1)
            If mb Then 'clear it
                While mb 'OK!
                    If _MouseInput Then mb = _MouseButton(1)
                    _Limit 100
                Wend
            End If

            If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
                choice = my + page * maxHeight + lba - 1 'select item clicked
            ElseIf mx >= 1 And mx <= maxWidth And my = 0 Then 'page up or exit
                If my = 0 And (mx <= maxWidth And mx >= maxWidth - 2) Then 'exit sign
                    Exit Do 'escape plan for mouse click top right corner of display box
                Else 'PgUp bar clicked
                    If (page - 1) * maxHeight + lba >= lba Then page = page - 1: GoSub update
                End If
            ElseIf mx >= 1 And mx <= maxWidth And my = maxHeight + 1 Then 'page down bar clicked
                If (page + 1) * maxHeight + lba <= uba Then page = page + 1: GoSub update
            End If
        Else '   mouse over highlighting, only if mouse has moved!
            If mx >= 1 And mx <= maxWidth And my >= 1 And my <= maxHeight Then
                If mx <> lastMX Or my <> lastMY Then
                    If my - 1 <> hlite And (my - 1 + page * maxHeight + lba <= uba) Then
                        hlite = my - 1
                        lastMX = mx: lastMY = my
                        GoSub update
                    End If
                End If
            End If
        End If
        _Limit 200
    Loop Until choice >= lba And choice <= uba
    getArrayItemNumber& = choice
    Color fg, bg
    'clear key presses
    _KeyClear
    Locate curRow, curCol
    'clear mouse clicks
    mb = _MouseButton(1)
    If mb Then 'clear it
        While mb 'OK!
            If _MouseInput Then mb = _MouseButton(1)
            '_LIMIT 100
        Wend
    End If
    Exit Function

    'display of array sections and controls on screen
    update:

    'fix hlite if it has dropped below last array item
    While hlite + page * maxHeight + lba > uba
        hlite = hlite - 1
    Wend

    'main display of array items at page * maxHeight (lines high)
    For row = 0 To maxHeight - 1
        If hlite = row Then Color _RGB(200, 200, 255), _RGB32(0, 0, 88) Else Color _RGB32(0, 0, 88), _RGB(200, 200, 255)
        Locate locateRow + row, locateColumn: Print clrStr$
        index = row + page * maxHeight + lba
        If index >= lba And index <= uba Then
            Locate locateRow + row, locateColumn
            Print Left$(LTrim$(Str$(index)) + ") " + arr(index), maxWidth)
        End If
    Next

    'make page up and down bars to click, print PgUp / PgDn if available
    Color _RGB32(200, 200, 255), _RGB32(0, 100, 50)
    Locate locateRow - 1, locateColumn: Print Space$(maxWidth)
    If page <> 0 Then Locate locateRow - 1, locateColumn: Print Left$(" Pg Up" + Space$(maxWidth), maxWidth)
    Locate locateRow + maxHeight, locateColumn: Print Space$(maxWidth)
    If page <> Int(uba / maxHeight) Then
        Locate locateRow + maxHeight, locateColumn: Print Left$(" Pg Dn" + Space$(maxWidth), maxWidth)
    End If
    'make exit sign for mouse click
    Color _RGB32(255, 255, 255), _RGB32(200, 100, 0)
    Locate locateRow - 1, locateColumn + maxWidth - 3
    Print " X "

    'if a number selection has been started show it's build = b$
    If Len(b$) Then
        Color _RGB(255, 255, 0), _RGB32(0, 0, 0)
        Locate locateRow + maxHeight, locateColumn + maxWidth - Len(b$) - 1
        Print b$;
    End If
    _Display
    '_LIMIT 100
    Return
End Function
Sub rfft (xx_r(), xx_i(), x_r(), n)
    Dim w_r As Double, w_i As Double, wm_r As Double, wm_i As Double
    Dim u_r As Double, u_i As Double, v_r As Double, v_i As Double

    log2n = Log(n / 2) / Log(2)

    For i = 0 To n / 2 - 1
        rev = 0
        For j = 0 To log2n - 1
            If i And (2 ^ j) Then rev = rev + (2 ^ (log2n - 1 - j))
        Next

        xx_r(i) = x_r(2 * rev)
        xx_i(i) = x_r(2 * rev + 1)
    Next

    For i = 1 To log2n
        m = 2 ^ i
        wm_r = Cos(-2 * pi / m)
        wm_i = Sin(-2 * pi / m)

        For j = 0 To n / 2 - 1 Step m
            w_r = 1
            w_i = 0

            For k = 0 To m / 2 - 1
                p = j + k
                q = p + (m \ 2)

                u_r = w_r * xx_r(q) - w_i * xx_i(q)
                u_i = w_r * xx_i(q) + w_i * xx_r(q)
                v_r = xx_r(p)
                v_i = xx_i(p)

                xx_r(p) = v_r + u_r
                xx_i(p) = v_i + u_i
                xx_r(q) = v_r - u_r
                xx_i(q) = v_i - u_i

                u_r = w_r
                u_i = w_i
                w_r = u_r * wm_r - u_i * wm_i
                w_i = u_r * wm_i + u_i * wm_r
            Next
        Next
    Next

    xx_r(n / 2) = xx_r(0)
    xx_i(n / 2) = xx_i(0)

    For i = 1 To n / 2 - 1
        xx_r(n / 2 + i) = xx_r(n / 2 - i)
        xx_i(n / 2 + i) = xx_i(n / 2 - i)
    Next

    Dim xpr As Double, xpi As Double
    Dim xmr As Double, xmi As Double

    For i = 0 To n / 2 - 1
        xpr = (xx_r(i) + xx_r(n / 2 + i)) / 2
        xpi = (xx_i(i) + xx_i(n / 2 + i)) / 2

        xmr = (xx_r(i) - xx_r(n / 2 + i)) / 2
        xmi = (xx_i(i) - xx_i(n / 2 + i)) / 2

        xx_r(i) = xpr + xpi * Cos(2 * pi * i / n) - xmr * Sin(2 * pi * i / n)
        xx_i(i) = xmi - xpi * Sin(2 * pi * i / n) - xmr * Cos(2 * pi * i / n)
    Next

    'symmetry, complex conj
    For i = 0 To n / 2 - 1
        xx_r(n / 2 + i) = xx_r(n / 2 - 1 - i)
        xx_i(n / 2 + i) = -xx_i(n / 2 - 1 - i)
    Next
End Sub