QB64-PE Sample Showcase

[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.