QB64-PE Sample Showcase

[grymmjack]

A collection of QB64 samples and a little program included with them to help showcase them for everyone.  Download the archive and enjoy!

Nice, is this still actively maintained @SMcNeill?

[grymmjack]

Not working on mac. Segfault 11.

I wonder if it's MacOS font specific stuff? This is the same thing that is happening on @bplus Wheel of fortune game.

[TempodiBasic]

@Steve

The program 251 Tic Tac Toe is that original one  travelling with the old Demo folder of ancient QB64 versions. You like to post the original  game with the bug and not my fixed version without the bug!
I can agree, 

Just a question about this showcase: is on developing a tool to add more examples to the list ?
If no is it possible to develope this feature/tool or it will be a fork with its own life?

[SMcNeill]

@Steve

The program 251 Tic Tac Toe is that original one  travelling with the old Demo folder of ancient QB64 versions. You like to post the original  game with the bug and not my fixed version without the bug!
I can agree, 

Just a question about this showcase: is on developing a tool to add more examples to the list ?
If no is it possible to develope this feature/tool or it will be a fork with its own life?

Honestly, I'd more-or-less just forgot about this.  LOL!

Adding more examples is basically as simple as just including them in the directories with a screenshot to represent them.   All this little interface really does is just let us browse them, select one, and then QB64 compiles it and runs it from its home directory for us.

If you want to build upon it, or alter it, feel free!  

[SpriggsySpriggs]

Huh. Had no idea this existed. Kind of cool

[bplus]

@SMcNeill I forgot about this too and it seems more fully developed since my last look at it.
Should the Search button work by just clicking it? It's not for me compiled on v3.8
Same with the Run button the up/down and page buttons are OK

Is this done?

If this is no longer a WIP then:
1. This could serve as gyrmmjacks suggestion for special picks
2. Need an "official" way to add to list or let anyone submit anything or a github thing?
3. Pin to resources boards for updates like with qb64pe maybe?

Update: OK Run did work on at least one.

[TempodiBasic]

@Steve
Ok I'll play with it to get something more suitable.

1. adding the compatibility with QB64pe compiler. Now if you press R or click on Run you'll compile the .BAS if there is no .EXE also if you install this SuitCase with QB64pe

here code

Code: (Select All)

'QB64-PE Sample Showcase
'code by SMcNeill (c) 2022
'code is under standard MIT License -- https://en.wikipedia.org/wiki/MIT_License
'inspired by MIT Licensed code sample archive from https://QB64.com/samples.html


Type Sample_Index_Type
    title As String
    author As String
    tag As String
    link As String
    description As String
End Type
'format for data files is:
'Start line                                                   [START ENTRY]
'Title                                                        This is the same as the directory name
'Author(s)
'Tag(s)
'Link
'Description
'Continue Description as needed.
'Finish Line                                                   [END ENTRY]
'All sample information is kept in the above format and organized for ease of reference and editing in any text editor.



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



$Color:32
Screen _NewImage(1280, 720, 32)
ReDim Shared SI(1000) As Sample_Index_Type, count, screenchanged
Dim Shared NoImage: NoImage = _LoadImage("no image.png", 32)
Dim Shared banner: banner = _LoadImage("Flaming Banner.png", 32)
Dim Shared logo: logo = _LoadImage("peWikiLogo.png", 32)
Dim Shared font: font = _LoadFont("courbd.ttf", 64, "monospace")

_Title "QB64-PE Sample Showcase"

Load_Sample_Index
count = count - 1
_Delay 1
_ScreenMove _Middle

SplashScreen

screenchanged = -1
Do
    If screenchanged Then
        DisplayScreen start, selected, limit
        screenchanged = 0
    End If
    k = _KeyHit
    If k = 0 Then k = MouseInput
    Select Case k
        Case 27: System
        Case 18432
            selected = selected - 1: If selected < 0 Then selected = 30
            screenchanged = -1
        Case 20480:
            selected = selected + 1: If selected > limit Then selected = 0
            screenchanged = -1
        Case 20736
            start = start + 30: If start >= count Then start = 0
            screenchanged = -1
        Case 18688
            If start = 0 Then
                start = count - 30
            Else
                start = start - 30: If start < 0 Then start = 0
            End If
            screenchanged = -1
        Case Asc("R"), Asc("r")
            RunFile SI(selected).title
    End Select
    _Limit 30
    _Display
Loop

Function MouseInput
    Static oldmouse
    mousewheel = 0
    While _MouseInput:
        mousewheel = mousewheel + _MouseWheel
    Wend
    If mousewheel < 0 Then MouseInput = 18432
    If mousewheel > 0 Then MouseInput = 20480
    mb = _MouseButton(1)
    If mb Then
        Select Case _MouseY
            Case 650 To 670
                Select Case _MouseX
                    Case 10 To 100: MouseInput = 18688: _Delay .1
                    Case 110 To 200: MouseInput = 18432: _Delay .1
                    Case 210 To 300: If Not oldmouse Then MouseInput = 115
                End Select
            Case 680 To 700
                Select Case _MouseX
                    Case 10 To 100: MouseInput = 20736: _Delay .1
                    Case 110 To 200: MouseInput = 20480: _Delay .1
                    Case 210 To 300: If Not oldmouse Then MouseInput = 114
                End Select
        End Select
    End If
    oldmouse = mb
End Function

Sub SplashScreen
    Cls , SkyBlue
    Color BrickRed, Black
    _Font font
    For i = 0 To 255
        Cls , Black
        _SetAlpha i, , banner
        _SetAlpha i, , logo
        _PutImage , banner
        _PutImage (100, 100)-Step(256, 256), logo
        _PutImage (950, 100)-Step(256, 256), logo
        _Limit 30
        _Display
    Next
    text$ = "                                                   Proudly Presents...                                          QB64-PE Sample Showcase                                                 Inspired by Https://www.qb64.com/samples.html"
    l = Len(text$)
    PCopy 0, 1
    For i = 1 To Len(text$)
        PCopy 1, 0
        _PrintString (0, 650), Mid$(text$, i)
        _Display
        _Limit 10
    Next
    _Font 16
End Sub


Sub DisplayScreen (start, selected, limit)
    Static screenshot, blankscreen, titlescreen
    If titlescreen = 0 Then titlescreen = _NewImage(560, 290, 32)
    If blankscreen = 0 Then blankscreen = _NewImage(930, 390, 32)
    finish = start + 30: If finish > count Then finish = count
    limit = finish - start
    If selected < 0 Then selected = 0
    If selected > limit Then selected = limit

    Cls , SkyBlue
    Color Black, Transparent

    Locate 10
    For i = start To finish
        If i = start + selected Then
            _PutImage (20, 20)-(120, 140), logo
            _PutImage (160, 20)-(300, 140), banner
            Line (0, selected * 16 + 142)-Step(320, 16), Red, BF
            Line (330, 20)-(1260, 699), Black, BF
            If screenshot <> 0 And screenshot <> -1 Then _FreeImage screenshot
            temp$ = "./" + SI(i).title + "/screenshot.png"
            screenshot = _LoadImage(temp$, 32)
            If screenshot <> -1 And screenshot <> 0 Then
                _PutImage (900, 20)-(1260, 309), screenshot
            Else
                _PutImage (900, 20)-(1260, 309), NoImage
            End If
            _Dest titlescreen
            Cls , Black
            Color White, Black
            Print
            Print
            Print "  TITLE : "; SI(i).title
            Print "  AUTHOR:"; SI(i).author
            Print "  TAGS  :"; SI(i).tag
            Print "  LINK  :"; SI(i).link
            _PutImage (330, 20)-(899, 309), titlescreen, 0
            _Dest blankscreen
            Cls , Black
            Color White, Black
            Print SI(i).description
            _Dest 0
            _PutImage (330, 310)-(1260, 699), blankscreen
        End If
        Print i; Tab(6); Left$(SI(i).title, 35)
    Next

    Button 10, 650, 100, 670, "PGUP"
    Button 110, 650, 200, 670, "UP"
    Button 210, 650, 300, 670, "SEARCH"
    Button 10, 680, 100, 700, "PGDN"
    Button 110, 680, 200, 700, "DOWN"
    Button 210, 680, 300, 700, "RUN"

    ' _PrintString (20, 650), "<P>revious Page      <N>ext Page"
    '_PrintString (20, 670), "<UP/DOWN> change selection   <R>un"

End Sub

Sub Button (x, y, x2, y2, caption$)
    Line (x, y)-(x2, y2), DarkGray, BF
    Color White, transparent
    printX = (x2 - x - _PrintWidth(caption$)) \ 2 + x + 1
    printy = (y2 - y - _FontHeight) \ 2 + y + 1
    _PrintString (printX, printy), caption$
End Sub

Sub Load_Sample_Index
    Open ".\index.txt" For Input As #1 'The only file we should ever have open, in all honesty.

    Do Until EOF(1)
        Line Input #1, start$
        If start$ <> "[START ENTRY]" Then Print "ERROR Reading file.  Invalid Start Entry Point.": End
        Line Input #1, title$
        Line Input #1, author$
        Line Input #1, tag$
        Line Input #1, link$
        description$ = "": finish$ = ""
        Do Until finish$ = "[END ENTRY]"
            Line Input #1, finish$
            finish$ = _Trim$(finish$)
            If finish$ <> "[END ENTRY]" Then description$ = description$ + finish$ + Chr$(13)
        Loop
        SI(count).title = _Trim$(title$)
        SI(count).author = _Trim$(author$)
        SI(count).tag = _Trim$(tag$)
        SI(count).link = _Trim$(link$)
        SI(count).description = _Trim$(description$)
        count = count + 1
    Loop
    Close
End Sub

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(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory + Chr$(0)) 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) + 100)
                    DirList(DirCount) = nam$
                ElseIf flags And IS_FILE Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    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

Sub RunFile (file$)
    ReDim As String Dir(0), File(0)
    $If WIN Then
        slash$ = "\"
    $Else
            slash$ = "/"
    $End If
    GetFileList file$, Dir(), File()
    'first, count bas files
    For i = 1 To UBound(File)
        If LCase$(Right$(File(i), 4)) = ".bas" Then counter = counter + 1: bas$ = File(i): num = i
    Next
    If counter = 1 Then
        path$ = _CWD$ + slash$ + file$ + slash$
        exe$ = path$ + Left$(bas$, Len(bas$) - 4) + ".exe"
        If _FileExists(exe$) Then 'see if that bas file has been turned into an exe file already
            Shell Chr$(34) + exe$ + Chr$(34) 'if so, then just run it
        Else
            b$ = path$ + bas$
            If _FileExists("..\qb64pe.exe") Then pe$ = "pe" Else pe$ = ""
            Shell _Hide "..\qb64" + pe$ + " -c " + Chr$(34) + b$ + Chr$(34) + " -o " + Chr$(34) + exe$ + Chr$(34)
            Shell Chr$(34) + exe$ + Chr$(34)
        End If
    End If
    screenchanged = -1
    _KeyClear
End Sub

and  there is a bug to fix about Run...
if you want see the bug try to compile example 200 and say me what you get back.
And this is the fix

Code: (Select All)

     RunFile SI(selected + start).title

Going on and waiting suggestions about QB64pe coders interested to this development.

[TempodiBasic]

Another minor fix

the actual program shows only .PNG screenshots.
But with this little mod it searches before for .PNG, then for JPG and JPEG screenshots.

Code: (Select All)

            temp$ = "./" + SI(i).title + "/screenshot.png" ' here program searches for only .PNG files
            If Not _FileExists(temp$) Then
                temp$ = "./" + SI(i).title + "/screenshot.jpg" 'here program searches for .JPG
                If Not _FileExists(temp$) Then temp$ = "./" + SI(i).title + "/screenshot.jpeg" 'here program searches for .JPEG
            End If

[TempodiBasic]

Hi friends
here a new step towards a more flexible version of the showcase

news:
1. fixed bug of index selection (loose in previous version for all code more then first 30)
2. added compatibility with QB64pe compiler (before it was not recognized)
3. added compatibility with Jpeg and Jpg screenshot (before it uses only Pgn screenshot)
4. added Status field to the UDT of database for better managing projects with chained files and projects with different files
5. added the managing of Multifiles to Run section via PopUp menu
6. added utility in SUB to translate old Index.txt file to new Index2.txt file with enlarged UDT and automatic definition of Status field.

please enjoy to run and play with this new version, so can find and fix bugs and unwanted features.

Code: (Select All)

'QB64-PE Sample Showcase
'code by SMcNeill (c) 2022
'code is under standard MIT License -- https://en.wikipedia.org/wiki/MIT_License
'inspired by MIT Licensed code sample archive from https://QB64.com/samples.html


Type Sample_Index_Type
    Status As String ' Invisible or Monofile or Multifile or Name of the first file of the chain of files
    title As String
    author As String
    tag As String
    link As String
    description As String
End Type
'format for data files is:
'Start line                                                   [START ENTRY]
'Status                                                        ' Invisible or Monofile or Multifile or Name of the first file of the chain of files
'Title                                                        This is the same as the directory name
'Author(s)
'Tag(s)
'Link
'Description
'Continue Description as needed.
'Finish Line                                                   [END ENTRY]
'All sample information is kept in the above format and organized for ease of reference and editing in any text editor.



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



$Color:32
Screen _NewImage(1280, 720, 32)
ReDim Shared SI(1000) As Sample_Index_Type, count, screenchanged
Dim Shared NoImage: NoImage = _LoadImage("no image.png", 32)
Dim Shared banner: banner = _LoadImage("Flaming Banner.png", 32)
Dim Shared logo: logo = _LoadImage("peWikiLogo.png", 32)
Dim Shared font: font = _LoadFont("courbd.ttf", 64, "monospace")

_Title "QB64-PE Sample Showcase"

NewIndex
Load_Sample_Index
count = count - 1
_Delay 1
_ScreenMove _Middle

SplashScreen


screenchanged = -1
Do
    If screenchanged Then
        DisplayScreen start, selected, limit
        screenchanged = 0
    End If
    k = _KeyHit
    If k = 0 Then k = MouseInput
    Select Case k
        Case 27: System
        Case 18432
            selected = selected - 1: If selected < 0 Then selected = 30
            screenchanged = -1
        Case 20480:
            selected = selected + 1: If selected > limit Then selected = 0
            screenchanged = -1
        Case 20736
            start = start + 30: If start >= count Then start = 0
            screenchanged = -1
        Case 18688
            If start = 0 Then
                start = count - 30
            Else
                start = start - 30: If start < 0 Then start = 0
            End If
            screenchanged = -1
        Case Asc("R"), Asc("r")
            If SI(selected + start).Status = "Invisible" Then
                ' if file is excluded
                Beep
            Else
                RunFile SI(selected + start).title, selected + start ' index corrected   and added as parameter
            End If
    End Select
    _Limit 30
    _Display
Loop

Function MouseInput
    Static oldmouse
    mousewheel = 0
    While _MouseInput:
        mousewheel = mousewheel + _MouseWheel
    Wend
    If mousewheel < 0 Then MouseInput = 18432
    If mousewheel > 0 Then MouseInput = 20480
    mb = _MouseButton(1)
    If mb Then
        Select Case _MouseY
            Case 650 To 670
                Select Case _MouseX
                    Case 10 To 100: MouseInput = 18688: _Delay .1
                    Case 110 To 200: MouseInput = 18432: _Delay .1
                    Case 210 To 300: If Not oldmouse Then MouseInput = 115
                End Select
            Case 680 To 700
                Select Case _MouseX
                    Case 10 To 100: MouseInput = 20736: _Delay .1
                    Case 110 To 200: MouseInput = 20480: _Delay .1
                    Case 210 To 300: If Not oldmouse Then MouseInput = 114
                End Select
        End Select
    End If
    oldmouse = mb
End Function

Sub SplashScreen
    Cls , SkyBlue
    Color BrickRed, Black
    _Font font
    For i = 0 To 255
        Cls , Black
        _SetAlpha i, , banner
        _SetAlpha i, , logo
        _PutImage , banner
        _PutImage (100, 100)-Step(256, 256), logo
        _PutImage (950, 100)-Step(256, 256), logo
        _Limit 30
        _Display
    Next
    text$ = "                                                   Proudly Presents...                                          QB64-PE Sample Showcase                                                 Inspired by Https://www.qb64.com/samples.html"
    l = Len(text$)
    PCopy 0, 1
    For i = 1 To Len(text$)
        PCopy 1, 0
        _PrintString (0, 650), Mid$(text$, i)
        _Display
        _Limit 10
    Next
    _Font 16
End Sub


Sub DisplayScreen (start, selected, limit)
    Static screenshot, blankscreen, titlescreen
    If titlescreen = 0 Then titlescreen = _NewImage(560, 290, 32)
    If blankscreen = 0 Then blankscreen = _NewImage(930, 390, 32)
    finish = start + 30: If finish > count Then finish = count
    limit = finish - start
    If selected < 0 Then selected = 0
    If selected > limit Then selected = limit

    Cls , SkyBlue
    Color Black, Transparent

    Locate 10
    For i = start To finish
        If i = start + selected Then
            _PutImage (20, 20)-(120, 140), logo
            _PutImage (160, 20)-(300, 140), banner
            Line (0, selected * 16 + 142)-Step(320, 16), Red, BF
            Line (330, 20)-(1260, 699), Black, BF
            If screenshot <> 0 And screenshot <> -1 Then _FreeImage screenshot
            temp$ = "./" + SI(i).title + "/screenshot.png" ' here program searches for only .PNG files
            If Not _FileExists(temp$) Then
                temp$ = "./" + SI(i).title + "/screenshot.jpg" 'here program searches for .JPG
                If Not _FileExists(temp$) Then temp$ = "./" + SI(i).title + "/screenshot.jpeg" 'here program searches for .JPEG
            End If

            screenshot = _LoadImage(temp$, 32)
            If screenshot <> -1 And screenshot <> 0 Then
                _PutImage (900, 20)-(1260, 309), screenshot
            Else
                _PutImage (900, 20)-(1260, 309), NoImage
            End If
            _Dest titlescreen
            Cls , Black
            Color White, Black
            Print
            Print
            Print "  TITLE : "; SI(i).title
            Print "  AUTHOR:"; SI(i).author
            Print "  TAGS  :"; SI(i).tag
            Print "  LINK  :"; SI(i).link
            Color Red, Black
            Print "  STATUS :"; SI(i).Status
            Color White, Black
            _PutImage (330, 20)-(899, 309), titlescreen, 0
            _Dest blankscreen
            Cls , Black
            Color White, Black
            Print SI(i).description
            _Dest 0
            _PutImage (330, 310)-(1260, 699), blankscreen
        End If
        Print i; Tab(6); Left$(SI(i).title, 35)
    Next

    Button 10, 650, 100, 670, "PGUP"
    Button 110, 650, 200, 670, "UP"
    Button 210, 650, 300, 670, "SEARCH"
    Button 10, 680, 100, 700, "PGDN"
    Button 110, 680, 200, 700, "DOWN"
    Button 210, 680, 300, 700, "RUN"

End Sub

Sub Button (x, y, x2, y2, caption$)
    Line (x, y)-(x2, y2), DarkGray, BF
    Color White, transparent
    printX = (x2 - x - _PrintWidth(caption$)) \ 2 + x + 1
    printy = (y2 - y - _FontHeight) \ 2 + y + 1
    _PrintString (printX, printy), caption$
End Sub

Sub Load_Sample_Index
    If _FileExists(".\index2.txt") Then 'it tryes if file index is there
        Open ".\index2.txt" For Input As #1 'The only file we should ever have open, in all honesty.

        Do Until EOF(1)
            Line Input #1, start$
            If start$ <> "[START ENTRY]" Then Print "ERROR Reading file.  Invalid Start Entry Point.": End
            Line Input #1, Statu$ ' Invisible or Monofile or Multifile or Name of the first file of the chain of files
            Line Input #1, title$
            Line Input #1, author$
            Line Input #1, tag$
            Line Input #1, link$
            description$ = "": finish$ = ""
            Do Until finish$ = "[END ENTRY]"
                Line Input #1, finish$
                finish$ = _Trim$(finish$)
                If finish$ <> "[END ENTRY]" Then description$ = description$ + finish$ + Chr$(13)
            Loop
            SI(count).Status = _Trim$(Statu$)
            SI(count).title = _Trim$(title$)
            SI(count).author = _Trim$(author$)
            SI(count).tag = _Trim$(tag$)
            SI(count).link = _Trim$(link$)
            SI(count).description = _Trim$(description$)
            count = count + 1
        Loop
        Close
    Else
        ' not found file index.txt
        Print " Not found index.txt "
        End ' no possible to continue to run program
    End If
End Sub

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(100), FileList(100)
    DirCount = 0: FileCount = 0

    If load_dir(SearchDirectory + Chr$(0)) 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) + 100)
                    DirList(DirCount) = nam$
                ElseIf flags And IS_FILE Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    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

Sub RunFile (file$, I%)
    ReDim As String Dir(0), File(0)
    $If WIN Then
        slash$ = "\"
    $Else
            slash$ = "/"
    $End If
    GetFileList file$, Dir(), File()
    'first, count bas files
    max = UBound(File)
    ReDim bbas$(max)
    For i = 1 To max
        If LCase$(Right$(File(i), 4)) = ".bas" Then counter = counter + 1: bas$ = File(i): num = i: bbas$(counter) = bas$
    Next
    If counter < max Then ReDim _Preserve bbas$(counter)

    ' selecting file.bas to run
    If SI(I%).Status = "Multifile" Then
        'pop up menu with files .BAS
        a& = _Dest
        _Dest 0

        chosen = 1
        Do
            Locate 12, 45
            For i = 1 To counter

                If i = chosen Then Color Black, Blue Else Color White, Black
                Locate , 45: Print bbas$(i)

            Next
            k = _KeyHit
            Select Case k
                Case 18432
                    'up
                    If chosen > 1 Then chosen = chosen - 1
                Case 20480:
                    'down
                    If chosen < counter Then chosen = chosen + 1
            End Select
            _Dest a&
            _Display

        Loop Until k = 13

    ElseIf LCase$(Right$(_Trim$(SI(I%).Status), 4)) = ".bas" Then
        ' it is a chain of programs and status is the head of the chain
        bas$ = LCase$(_Trim$(SI(I%).Status))
    ElseIf SI(I%).Status = "Monofile" Or counter = 1 Then
        ' do  nothing because file has already been selected
    End If

    ' running file.bas choosen
    '    If counter = 1 Then
    path$ = _CWD$ + slash$ + file$ + slash$
    exe$ = path$ + Left$(bas$, Len(bas$) - 4) + ".exe"
    If _FileExists(exe$) Then 'see if that bas file has been turned into an exe file already
        Shell Chr$(34) + exe$ + Chr$(34) 'if so, then just run it
    Else
        b$ = path$ + bas$
        If _FileExists("..\qb64pe.exe") Then pe$ = "pe" Else pe$ = "" ' path corrected for working both with QB64 both QB64pe
        Shell _Hide "..\qb64" + pe$ + " -c " + Chr$(34) + b$ + Chr$(34) + " -o " + Chr$(34) + exe$ + Chr$(34)
        Shell Chr$(34) + exe$ + Chr$(34)
    End If
    '   End If
    screenchanged = -1
    _KeyClear
End Sub

Sub NewIndex
    'this sub adds STATUS field to the original index.txt database
    If _FileExists(".\index.txt") Then 'it tryes if file index is there
        Open ".\index.txt" For Input As #1 'The only file we should ever have open, in all honesty.
        Open ".\index2.txt" For Output As #2
        Do Until EOF(1)
            Line Input #1, start$
            If start$ <> "[START ENTRY]" Then Print "ERROR Reading file.  Invalid Start Entry Point.": End
            Line Input #1, title$
            Line Input #1, author$
            Line Input #1, tag$
            Line Input #1, link$
            description$ = "": finish$ = ""
            Do Until finish$ = "[END ENTRY]"
                Line Input #1, finish$
                finish$ = _Trim$(finish$)
                If finish$ <> "[END ENTRY]" Then description$ = description$ + finish$ + Chr$(13)
            Loop

            ' now it looks at directory to know how many files there are in it
            file$ = _Trim$(title$)
            ReDim As String Dir(0), File(0)
            GetFileList file$, Dir(), File()
            'first, count bas files
            max = UBound(File)
            For i = 1 To max
                If LCase$(Right$(File(i), 4)) = ".bas" Then counter = counter + 1: bas$ = File(i): num = i
            Next
            If counter = 1 Then Statu$ = "Monofile" Else Statu$ = "Multifile"
            counter = 0
            '----------------------
            ' setting the field of UDT
            SI(count).Status = _Trim$(Statu$)
            SI(count).title = _Trim$(title$)
            SI(count).author = _Trim$(author$)
            SI(count).tag = _Trim$(tag$)
            SI(count).link = _Trim$(link$)
            SI(count).description = _Trim$(description$)
            ' it writes to index2.txt
            Print #2, "[START ENTRY]"
            Print #2, SI(count).Status
            Print #2, SI(count).title
            Print #2, SI(count).author
            Print #2, SI(count).tag
            Print #2, SI(count).link
            Print #2, SI(count).description
            Print #2, "[END ENTRY]"
            count = count + 1
        Loop
        Close
    End If
End Sub

Save this file into the same folder of original that you have downloaded.
the first time you must run it as is to adjourn the Index.txt to Index2.txt file, then you can REM out newindex call from main .
you can see in the showcase that the kind of code (monofile/multifile) has been showed in text with red color 
moreover when you press R to run the code on the side of showcase a popup list appears and using Up/Down arrows you can navigate it, while pressing Enter you will run the selected (text in Black on Blue background) file.BAS

Incoming an editor to build from zero an Index.txt with its folders' structure. 
And another idea is to let to add new projects as files and in the Index.txt file and to let to exclude unwanted projects making thme invisible!

Welcome suggestions and feedbacks

[TempodiBasic]

fixed an error occuring in multifile selection

this is the new code that runs ok

Code: (Select All)

Sub RunFile (file$, I%)
    ReDim As String Dir(0), File(0)
    $If WIN Then
        slash$ = "\"
    $Else
            slash$ = "/"
    $End If
    GetFileList file$, Dir(), File()
    'first, count bas files
    max = UBound(File)
    ReDim bbas$(max)
    For i = 1 To max
        If LCase$(Right$(File(i), 4)) = ".bas" Then counter = counter + 1: bas$ = File(i): num = i: bbas$(counter) = bas$
    Next
    If counter < max Then ReDim _Preserve bbas$(counter)

    ' selecting file.bas to run
    If SI(I%).Status = "Multifile" Then
        'pop up menu with files .BAS
        a& = _Dest
        _Dest 0
        chosen = 1
        Locate 10, 45: Print "arrows " + Chr$(24) + " " + Chr$(25) + " for choosing and Enter for running"
        Do
            Locate 12, 45
            For i = 1 To counter

                If i = chosen Then Color Black, Blue Else Color White, Black
                Locate , 45: Print bbas$(i)

            Next
            k = _KeyHit
            Select Case k
                Case 18432
                    'up
                    If chosen > 1 Then chosen = chosen - 1
                Case 20480:
                    'down
                    If chosen < counter Then chosen = chosen + 1
            End Select
            _Dest a&
            _Display

        Loop Until k = 13
        bas$ = bbas$(chosen)
    ElseIf LCase$(Right$(_Trim$(SI(I%).Status), 4)) = ".bas" Then
        ' it is a chain of programs and status is the head of the chain
        bas$ = LCase$(_Trim$(SI(I%).Status))
    ElseIf SI(I%).Status = "Monofile" Or counter = 1 Then
        ' do  nothing because file has already been selected
    End If

    ' running file.bas choosen
    '    If counter = 1 Then
    path$ = _CWD$ + slash$ + file$ + slash$
    exe$ = path$ + Left$(bas$, Len(bas$) - 4) + ".exe"
    If _FileExists(exe$) Then 'see if that bas file has been turned into an exe file already
        Shell Chr$(34) + exe$ + Chr$(34) 'if so, then just run it
    Else
        b$ = path$ + bas$
        If _FileExists("..\qb64pe.exe") Then pe$ = "pe" Else pe$ = "" ' path corrected for working both with QB64 both QB64pe
        Shell _Hide "..\qb64" + pe$ + " -c " + Chr$(34) + b$ + Chr$(34) + " -o " + Chr$(34) + exe$ + Chr$(34)
        Shell Chr$(34) + exe$ + Chr$(34)
    End If
    '   End If
    screenchanged = -1
    _KeyClear
End Sub