Posts: 477
Threads: 25
Joined: Nov 2022
Reputation:
45
(08-14-2022, 04:00 PM)SMcNeill Wrote: 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?
Posts: 477
Threads: 25
Joined: Nov 2022
Reputation:
45
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.
Posts: 348
Threads: 25
Joined: Jul 2022
Reputation:
20
@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?
Posts: 2,700
Threads: 328
Joined: Apr 2022
Reputation:
219
(10-09-2023, 11:29 PM)TempodiBasic Wrote: @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!
Posts: 730
Threads: 30
Joined: Apr 2022
Reputation:
43
Huh. Had no idea this existed. Kind of cool
Tread on those who tread on you
Posts: 3,990
Threads: 179
Joined: Apr 2022
Reputation:
222
10-10-2023, 09:41 AM
(This post was last modified: 10-10-2023, 09:46 AM by 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.
b = b + ...
Posts: 348
Threads: 25
Joined: Jul 2022
Reputation:
20
10-11-2023, 12:06 AM
(This post was last modified: 10-11-2023, 12:40 AM by 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.
Posts: 348
Threads: 25
Joined: Jul 2022
Reputation:
20
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
Posts: 348
Threads: 25
Joined: Jul 2022
Reputation:
20
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
Posts: 348
Threads: 25
Joined: Jul 2022
Reputation:
20
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
|
