barebones calendar for fb and sdl

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

barebones calendar for fb and sdl

Post by thrive4 »

Recently I came across some excellent code by zippy see
viewtopic.php?p=53982&hilit=calendar#p53982
and took the liberty to pimp it a bit.

In essence this code adds:
- cheap month and day localization (without forcing the locale)
- highlight current date
- adds a modicum of customization
- adds basic navigation (month and year) with keyboard, mouse and gamepad

It comes in two flavors:
- fb only ascii
- fb and sdl

For the record the more conventional way would / could be
by doing the heavy lifting with the os there are two demo's
bundled with FB at:
os unix \ gtk version
<drive:>\freebasic\FreeBASIC-1.09.0-gcc-9.3\examples\GUI\GTK+\Tutorials\calendar.bas
os windows version
<drive:>\freebasic\FreeBASIC-1.09.0-gcc-9.3\examples\GUI\win32\calendar.bas

however this approach allows for a bit more freedom in
visual design and are both, to a degree, platform agnostic.

navigation
dpad gamepad or arrow keys keyboard > up - down / year | left - right / month
mouse cursor > left - right / month
mouse wheel > up - down / year

fb ascii version:

Code: Select all

' generic calendar generation with keyboard, mouse and gamepad navigation
' by thrive4 2022
' based on code by zippy see
' https://www.freebasic.net/forum/viewtopic.php?p=53982&hilit=calendar#p53982

#include once "fbgfx.bi"
#include once "vbcompat.bi"

' init screen
dim screenwidth  As integer  = 180
dim screenheight As integer  = 160
dim aspectratio  as single   = screenwidth / screenheight
' 32 bit
'type calatributes
'    foregroundcolor as ulong = RGB(255, 255, 255)
'    backgroundcolor as ulong = RGB(0, 0, 0)
'    highlightcolor  as ulong = rgba(255, 0, 0, 0)
'    headercolor     as ulong = rgba(125, 125, 125, 0)
'end type

' 8 bit
type calatributes
    foregroundcolor as integer = 15
    backgroundcolor as integer = 0
    highlightcolor  as integer = 4
    headercolor     as integer = 7
    customdate      as boolean = true
end type
dim cb as calatributes

' customdate force date to other langauage
dim shared customday(1 to 7) as string
customday(1) = "sunday"
customday(2) = "monday"
customday(3) = "tuesday"
customday(4) = "wensday"
customday(5) = "thurseday"
customday(6) = "friday"
customday(7) = "saturday"
dim shared custommonth(1 to 12) as string
custommonth(1)  = "january"
custommonth(2)  = "february"
custommonth(3)  = "march"
custommonth(4)  = "april"
custommonth(5)  = "may"
custommonth(6)  = "june"
custommonth(7)  = "july"
custommonth(8)  = "august"
custommonth(9)  = "september"
custommonth(10) = "oktober"
custommonth(11) = "november"
custommonth(12) = "december"

' init mouse feedback
Type mousecoord
    x  As integer
    y  As integer
End Type
dim mouse as mousecoord
Dim As Integer x, y, wheel, wheelup, buttons, buttonsup, res 
mouse.x = 0
mouse.y = 0
dim keybbuffer as string = ""
' size of increment move mouse pointer when simulated by keyboard or gamepad
dim pointermove as integer = 10
' init hitbox for month navigation with mouse click
Type hbcoord
    x  As integer
    y  As integer
    w  As integer
    h  As integer
End Type
dim navleft as hbcoord
navleft.x = 2
navleft.y = 5
navleft.w = 40
navleft.h = 20
dim navright as hbcoord
navright.x = 120
navright.y = 5
navright.w = 60
navright.h = 20

' init gamepad
dim resgp       as integer
dim swapgamepad as boolean = false
dim gpbuttons   as integer
dim hatlr       as single
dim hatud       as single
dim chkgp       as boolean = false

Const JoystickID = 0
if GetJoystick(JoystickID) then
    ' no gamepad reversed logic..
    chkgp = false
else
    chkgp = true
end if

' generate ascii calendar
function asciical(m as integer, y as integer, cb as calatributes) as integer
    dim as double db, dn = now
    dim as integer d, sdow
    dim as integer a, c, ndays
    dim as string t

    cls
    Color (cb.headercolor, cb.backgroundcolor)

    d = day(dn)
    if m = 0 or m > 12 or m < 0 then
        m = month(dn)
    end if
    if y = 0 then        
        y = year(dn)
    end if
    db = dateserial(y,m,1)
    sdow = weekday(db,0)

    for ndays = 31 to 28 step -1
        if month(dateserial(y,m,ndays)) = m then exit for
    next

    if cb.customdate then
        t = custommonth(m) & " " & y
        print:print;space(8 - len(t) \ 2);"< ";t;" >"
        print
        for a = 1 to 7
            print " ";left(customday(a), 2);
        next
        print
    else
        t = MonthName(m) & " " & y
        print:print space(11 - len(t) \ 2);t
        print
        for a=1 to 7
            print " ";left(WeekdayName(a, 1, 0), 2);
        next
        print
    end if

    a = 2 - sdow:c = 0
    while a <= ndays
        if a >= 1 then
            ' highlight current date when applicable
            if a = val(Format(now, "d")) and m = val(format(now, "mm")) and y = val(format(now, "yyyy")) then
                Color (cb.foregroundcolor, cb.highlightcolor)
                print using "###";a;
            else
                print using "###";a;
            end if
        else
            print space(3);
        end if
        Color (cb.foregroundcolor, cb.backgroundcolor)
        a += 1:c += 1
        if c = 7 then c = 0:print:end if
    wend
    print
    return 0
end function

' main
ScreenRes screenwidth, screenheight, 8,, (FB.GFX_WINDOWED) 
SetMouse(screenwidth * 0.5, screenheight * 0.5)
' use 8 x 14 font
Width screenwidth \ 8, screenheight \ 14

' asciical (month(numrical), year, custom(use custom month and day name), cb is calendar attributes)
asciical(0, 0, cb)

' main navigation with mouse, keyboard and gamepad
dim monthbkm as integer = val(format(now, "mm"))
dim yearbkm  as integer = val(format(now, "yyyy"))
Do
    ' note check is needed otherwise calling getjoystick with no gamepad can crash application
    if chkgp then
        resgp = GetJoystick(JoystickID, gpbuttons,,,,,,, hatlr, hatud)
        ' reinit gamepad not supported
        if gpbuttons = -1 then
            swapgamepad = true
            exit do
        end if
    end if

    buttonsup = buttons
    ' catch wheel value to -1 when outside window
    if wheel <> -1 then
        wheelup = wheel
    end if
    res = GetMouse (x, y, wheel, buttons)
    'Locate 1, 1
    If res <> 0 Then '' Failure
        #ifdef __FB_DOS__
            'Print "Mouse or mouse driver not available"
        #else
            'Print "Mouse not available or not on window"
        #endif
    Else
        ' debug
        'Print Using "mouse position: ###:###  buttons: "; x; y;
        'If buttons And 1 Then Print "l";" hitbox output ";'hboutput
        'If buttons And 2 Then Print "r";"                "
        'If buttons And 4 Then Print "m";"                "

        ' navigate with mouse wheel
        if wheel <> wheelup then
            if wheel > wheelup then
                ' scroll up
                yearbkm += 1
                asciical(monthbkm, yearbkm, cb)
                'y = y - pointermove
            else
                ' scroll down
                yearbkm -= 1
                asciical(monthbkm, yearbkm, cb)
                'y = y + pointermove
            end if
        else
            ' nop stationary
        end if

        ' naviagte with mouse
        mouse.x = x
        mouse.y = y

        ' ghetto hitbox navigate with mouse click left
        ' left
        if ((mouse.x >= navright.x) and (mouse.x < (navright.x + navright.w))_
            and (mouse.y >= navright.y) and (mouse.y < (mouse.y + navright.h)))_ 
            and  buttons And 1 then
            if monthbkm < 12 then
                monthbkm += 1
                asciical(monthbkm, yearbkm, cb)
            end if
        end if
        ' right
        if ((mouse.x >= navleft.x) and (mouse.x < (navleft.x + navleft.w))_
            and (mouse.y >= navleft.y) and (mouse.y < (mouse.y + navleft.h)))_ 
            and  buttons And 1 then
            if monthbkm > 1 then
                monthbkm -= 1
                asciical(monthbkm, yearbkm, cb)
            end if
        end if
        
        ' navigate with keyboard arrow keys a bit klunky
        ' scancode constants need #include "fbgfx.bi" and using FB
        ' left
        If MultiKey(&h4B) And mouse.x > 0 Then
            if monthbkm > 1 then
                monthbkm -= 1
                asciical(monthbkm, yearbkm, cb)
            end if
            'SetMouse mouse.x - pointermove, mouse.y
        end if
        ' right
        If MultiKey(&h4D) And mouse.x < screenwidth Then
            if monthbkm < 12 then
                monthbkm += 1
                asciical(monthbkm, yearbkm, cb)
            end if
            'SetMouse mouse.x + pointermove, mouse.y
        end if
        ' up
        If MultiKey(&h48) And mouse.y > 0 Then 
            yearbkm += 1
            asciical(monthbkm, yearbkm, cb)
            'SetMouse mouse.x, mouse.y - pointermove
        end if    
        ' down
        If MultiKey(&h50) And mouse.y < screenheight Then
            yearbkm -= 1
            asciical(monthbkm, yearbkm, cb)
            'SetMouse mouse.x, mouse.y + pointermove
        end if
        If MultiKey(&h1C)Then
            ' fake mouse button left
            buttons = 1
            'print "enter"
        end if

        ' naviagte with gamepad dpad input and button A
        select case hatud
            ' hat down
            case 1
                yearbkm -= 1
                asciical(monthbkm, yearbkm, cb)
                'SetMouse mouse.x, mouse.y + pointermove
            ' hat up
            case -1
                yearbkm += 1
                asciical(monthbkm, yearbkm, cb)
                'SetMouse mouse.x, mouse.y - pointermove
        end select
        select case hatlr
            ' hat right
            case 1
                if monthbkm < 12 then
                    monthbkm += 1
                    asciical(monthbkm, yearbkm, cb)
                end if
                'SetMouse mouse.x + pointermove, mouse.y
            ' hat left
            case -1
                if monthbkm > 1 then
                    monthbkm -= 1
                    asciical(monthbkm, yearbkm, cb)
                end if
                'SetMouse mouse.x - pointermove, mouse.y
        end select
        select case gpbuttons
            ' dinput A
            case 2
                buttons = 1
            ' xinput A
            case 1
                buttons = 1
        end select

        ' mouse button up see https://www.freebasic.net/forum/viewtopic.php?p=15237&hilit=mouse+button+up#p15237
        ' comment coderjeff
        if ((buttons And 1) = 1) And ((buttonsup And 1) = 0) then 
            'keybbuffer = keybbuffer + hboutput
        end if
    End If

    ' use sleep to keep cpu usage low also effects naviagtion speed
    sleep(120)

Loop While Inkey <> chr$(27)
end

/' sample ini for forced language date
[language-en month]
m1  = january
m2  = february
m3  = march
m4  = april
m5  = may
m6  = june
m7  = july
m8  = august
m9  = september
m10 = oktober
m11 = november
m12 = december

[language-en day]
d1 = monday
d2 = tuesday
d3 = wednesday
d4 = thurseday
d5 = friday
d6 = saturday
d7 = sunday
'/
Last edited by thrive4 on Aug 31, 2022 12:43, edited 3 times in total.
thrive4
Posts: 70
Joined: Jun 25, 2021 15:32

Re: barebones calendar for fb and sdl

Post by thrive4 »

( needed a separate posting)

sdl version 32 bit
if needed download
sdl https://github.com/libsdl-org/SDL/relea ... ase-2.24.0
sdl ttf https://github.com/libsdl-org/SDL_ttf/releases
either copy a ttf font from
<os drive>:\windows\fonts
or download a ttf font

place:
gisha.ttf
SDL2.dll
SDL2_ttf.dll

in the same folder as the compiled exe
either rename the ttf to 'gisha.ttf'
or change line 39:
ttffont as string = exepath + "\gisha.ttf"
to:
ttffont as string = exepath + "\<fontname>.ttf"

update 01/09/2022
- added blendmode for sdl draw rect (needed if a background image is used)
- added curdateboxcolor to calendar attributes
- tweaked proportional placing of date and year

Code: Select all

' sdl2 version
' generic calendar generation with keyboard, mouse and gamepad navigation
' by thrive4 2022
' based on code by zippy see
' https://www.freebasic.net/forum/viewtopic.php?p=53982&hilit=calendar#p53982

#include once "SDL2/SDL.bi"
#include once "SDL2/SDL_ttf.bi"
#include once "vbcompat.bi"

' init screen
dim shared screenwidth  As integer  = 1280
dim shared screenheight As integer  = 720
dim aspectratio  as single   = screenwidth / screenheight

' setup sdl
dim event as SDL_Event
dim running as boolean = True
dim shared renderpass as boolean = true
dim dummy as string = ""
dim mousebutton as string
Dim As SDL_Color backgrondcolor = (75, 85, 95, 0)
Dim As SDL_Texture Ptr texture
' used for memory management
Dim As SDL_Texture Ptr background_surface
Dim As SDL_Texture Ptr preview_surface

' calendar attributes
type calatributes
    textcolor           as SDL_Color = (255, 255, 255, 0)
    backgroundcolor     as SDL_Color = (0, 0, 0, 255)
    curdatetextcolor    as SDL_Color = (125, 0, 0, 0)
    curdateboxcolor     as SDL_Color = (45, 125, 125, 255)
    headercolor         as SDL_Color = (175, 175, 175, 0)
    headerboxcolor      as SDL_Color = (84, 0, 0, 255)
    customdate          as boolean = true
    offsetx             as integer = 100
    offsety             as integer = 50
    ttffont             as string  = exepath + "\gisha.ttf"
    fontsize            as integer = 22
    boundbox            as boolean = true
end type
dim cb as calatributes

' setup calendar
dim monthbkm as integer = val(format(now, "mm"))
dim yearbkm  as integer = val(format(now, "yyyy"))
' ghetto hitbox detection for mousepointer
dim monthleft as sdl_rect
monthleft.x = cb.offsetx - cb.fontsize
monthleft.y = cb.offsety
monthleft.w = 2 * cb.fontsize
monthleft.h = 2 * cb.fontsize
dim monthright as sdl_rect
monthright.x = cb.offsetx + 12 * cb.fontsize
monthright.y = cb.offsety
monthright.w = 2 * cb.fontsize
monthright.h = 2 * cb.fontsize

' customdate force date to other langauage
dim shared customday(1 to 7) as string
customday(1) = "sunday"
customday(2) = "monday"
customday(3) = "tuesday"
customday(4) = "wensday"
customday(5) = "thurseday"
customday(6) = "friday"
customday(7) = "saturday"
dim shared custommonth(1 to 12) as string
custommonth(1)  = "january"
custommonth(2)  = "february"
custommonth(3)  = "march"
custommonth(4)  = "april"
custommonth(5)  = "may"
custommonth(6)  = "june"
custommonth(7)  = "july"
custommonth(8)  = "august"
custommonth(9)  = "september"
custommonth(10) = "oktober"
custommonth(11) = "november"
custommonth(12) = "december"

' init mouse coordinates
Type mousecoord
    x  As integer
    y  As integer
End Type

' init mouse feedback
dim mouse as mousecoord
Dim As Integer x, y, buttons, buttonsup, res
mouse.x = 0
mouse.y = 0

' video
If (SDL_Init(SDL_INIT_VIDEO) = not NULL) Then
    print "sdl2 video could not be initlized error: " + *SDL_GetError()
    SDL_Quit()
else
    ' audio not used    
    SDL_QuitSubSystem(SDL_INIT_AUDIO)
    ' render scale quality: 0 point, 1 linear, 2 anisotropic
    SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, "1")
End If

' gamepad
Dim As SDL_GameController Ptr controller = NULL
If (SDL_Init(SDL_INIT_GAMECONTROLLER) = not NULL) Then 
    print "sdl2 gamecontroller could not be initlized error: " + *SDL_GetError()
End If
controller = SDL_GameControllerOpen(0)
If (controller = NULL) Then
    print "unable to open gamepad - sdl error: " & *SDL_GetError()
else
    SDL_SetHint(SDL_HINT_JOYSTICK_ALLOW_BACKGROUND_EVENTS, "1")
    print "gamepad detected " & *SDL_GameControllerName(controller)
end if

' possible fix for unrecognized gamepad https://github.com/gabomdq/SDL_GameControllerDB
'SDL_GameControllerAddMappingsFromFile("gamecontrollerdb.txt")
Dim As ZString Ptr map = SDL_GameControllerMapping(controller)

' gamepad map debug
'Print *SDL_GameControllerName(controller)
'print *map
'sleep 3000

' window
Dim As SDL_Window Ptr glass = SDL_CreateWindow("calendar sdl2", 100, 100, screenwidth, screenheight, SDL_WINDOW_RESIZABLE)
dim mousepos as SDL_Point
SDL_ShowCursor(SDL_ENABLE)

' renderer
Dim As SDL_Renderer Ptr renderer = SDL_CreateRenderer(glass, -1, SDL_RENDERER_ACCELERATED Or SDL_RENDERER_PRESENTVSYNC)
if (renderer = NULL) Then
    print "sdl2 could not create render"
    SDL_Quit()
    sleep
    end
End If

if (TTF_Init() = Not 0) Then 
    print "sdl2 could not initilize ttf"
    SDL_Quit()
    sleep
    end
End If

Sub renderTexture OverLoad (  ByVal tex As SDL_Texture Ptr, _
	                          ByVal ren As SDL_Renderer Ptr, _
	                          ByVal x   As Integer, _
	                          ByVal y   As Integer, _
	                          ByVal w   As Integer, _
	                          ByVal h   As Integer)

	Dim As SDL_Rect dst	
	dst.x = x
	dst.y = y
	dst.w = w
	dst.h = h
	SDL_RenderCopy(ren, tex, NULL, @dst)
    SDL_DestroyTexture(tex) ' todo check this
End Sub

Sub renderTexture(  ByVal tex As SDL_Texture Ptr, _
	                ByVal ren As SDL_Renderer Ptr, _ 
	                Byval x   As Integer, _
	                Byval y   As Integer)
    if tex <> null then	
        Dim As Integer w, h
        SDL_QueryTexture(tex, NULL, NULL, @w, @h)
        renderTexture(tex, ren, x, y, w, h)
        SDL_DestroyTexture(tex)' todo check this
    end if	
End Sub

Function renderText( Byval message  As Const String, _
                     Byval fontFile As Const String, _
                     ByVal col      As SDL_Color, _
                     ByVal fontSize As Integer, _
                     ByVal renderer As SDL_Renderer Ptr ) As SDL_Texture Ptr

    if message <> "" then
        Dim As TTF_Font Ptr font = TTF_OpenFont(fontFile, fontSize)
        if (font = NULL) Then Return NULL EndIf
        ' load surface into a texture
        Dim As SDL_Surface Ptr surf = TTF_RenderText_Blended(font, message, col)
        if (surf = NULL) Then
            SDL_FreeSurface(surf)
            TTF_CloseFont(font) 
            Return NULL
        End If
        Dim As SDL_Texture Ptr texture = SDL_CreateTextureFromSurface(renderer, surf)
        if (texture = NULL) Then 
            Return NULL 
        End If
        ' clean up
        SDL_FreeSurface(surf)
        TTF_CloseFont(font)
        return texture
    else
        return null
    end if

End Function

' generate calendar with sdl
function sdlcal(m as integer, y as integer, cb as calatributes, renderer As SDL_Renderer Ptr) as integer
    dim as double db, dn = now
    dim as integer d, sdow
    dim as integer a, c, ndays
    dim as string t
    dim row as integer = 1
    dim col as integer = 1
    dim iW as integer
    dim iH as integer
    Dim As SDL_Texture Ptr texture
    ' used for background colors calendar
    dim boundbox as sdl_rect

    d = day(dn)
    if m = 0 or m > 12 or m < 0 then
        m = month(dn)
    end if
    if y = 0 then        
        y = year(dn)
    end if
    db = dateserial(y,m,1)
    sdow = weekday(db,0)

    for ndays = 31 to 28 step -1
        if month(dateserial(y,m,ndays)) = m then exit for
    next

    if cb.boundbox then
        SDL_SetRenderDrawBlendMode(renderer, SDL_BLENDMODE_BLEND)
        ' background
        SDL_SetRenderDrawColor(renderer, cb.backgroundcolor.r, cb.backgroundcolor.g, cb.backgroundcolor.b, cb.backgroundcolor.a)
        boundbox.x = cb.offsetx - cb.fontsize
        boundbox.y = cb.offsety - cb.fontsize
        boundbox.w = 15 * cb.fontsize
        boundbox.h = 15 * cb.fontsize
        SDL_RenderFillRect(renderer, @boundbox)
        ' highlight month and year
        SDL_SetRenderDrawColor(renderer, cb.headerboxcolor.r, cb.headerboxcolor.g, cb.headerboxcolor.b, cb.headerboxcolor.a)
        boundbox.x = cb.offsetx - cb.fontsize
        boundbox.y = cb.offsety - cb.fontsize
        boundbox.w = 15 * cb.fontsize
        boundbox.h = 2.75 * cb.fontsize
        SDL_RenderFillRect(renderer, @boundbox)
    end if
    
    ' hitbox nav left mousepointer
    texture = renderText("<", cb.ttffont, cb.headercolor, cb.fontsize, renderer)
    SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
    renderTexture(texture, renderer, cb.offsetx, cb.offsety)

    ' hitbox nav right mousepointer
    texture = renderText(">", cb.ttffont, cb.headercolor, cb.fontsize, renderer)
    SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
    renderTexture(texture, renderer, cb.offsetx + 12 * cb.fontsize, cb.offsety)

    col = cb.offsetx
    if cb.customdate then
        t = custommonth(m) & " " & y
        for a = 1 to 7
            texture = renderText(left(customday(a), 2), cb.ttffont, cb.headercolor, cb.fontsize, renderer)
            SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
            col = col + cb.fontsize + iW
            renderTexture(texture, renderer, (cb.offsetx - (iW + cb.fontsize)) + a * (2 * cb.fontsize), cb.fontsize + cb.offsety + cb.fontsize)
        next
        texture = renderText(t, cb.ttffont, cb.headercolor, cb.fontsize, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
        renderTexture(texture, renderer, (col - 8 * cb.fontsize) - iW * 0.5, cb.offsety)
    else
        t = MonthName(m) & " " & y
        for a=1 to 7
            texture = renderText(left(WeekdayName(a, 1, 0), 2), cb.ttffont, cb.headercolor, cb.fontsize, renderer)
            SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
            col = col + cb.fontsize + iW
            renderTexture(texture, renderer, (cb.offsetx - (iW + cb.fontsize)) + a * (2 * cb.fontsize), cb.fontsize + cb.offsety + cb.fontsize)
        next
        texture = renderText(t, cb.ttffont, cb.headercolor, cb.fontsize, renderer)
        SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
        renderTexture(texture, renderer, (col - 8 * cb.fontsize) - iW * 0.5, cb.offsety)
    end if

    a = 2 - sdow:c = 0
    col = cb.offsetx
    while a <= ndays
        if a >= 1 then
            ' highlight current date when applicable
            if a = val(Format(now, "d")) and m = val(format(now, "mm")) and y = val(format(now, "yyyy")) then
                texture = renderText(str(a), cb.ttffont, cb.curdatetextcolor, cb.fontsize, renderer)
                SDL_QueryTexture(texture, NULL, NULL, @iW, @iH)
                SDL_SetRenderDrawColor(renderer, cb.curdateboxcolor.r, cb.curdateboxcolor.g, cb.curdateboxcolor.b, cb.curdateboxcolor.a)
                if iW < cb.fontsize then
                    boundbox.x = cb.offsetx + c * (2 * cb.fontsize) - iW * 1.5f
                else
                    boundbox.x = cb.offsetx + c * (2 * cb.fontsize) - iW * 0.5f
                end if
                boundbox.y = cb.offsety + ((row + 1) * 1.525f * cb.fontsize)
                boundbox.w = 2 * cb.fontsize
                boundbox.h = 2 * cb.fontsize
                SDL_RenderFillRect(renderer, @boundbox)
            else
                texture = renderText(str(a), cb.ttffont, cb.textcolor, cb.fontsize, renderer)
          end if
        else
            col += cb.fontsize + 10
        end if
        renderTexture(texture, renderer, (cb.offsetx) + c * (2 * cb.fontsize), cb.fontsize + cb.offsety + cb.fontsize + row * 1.5 * cb.fontsize)
        a += 1:c += 1
        if c = 7 then c = 0:print:row += 1:end if
    wend

    return 0

end function

' main
while running
    while SDL_PollEvent(@event) <> 0
        ' basic window interaction 
        select case event.type
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_ESCAPE
                running = False
            case SDL_WINDOWEVENT and event.window.event = SDL_WINDOWEVENT_CLOSE
                running = False
            case SDL_MOUSEMOTION
                mouse.x = event.motion.x 
                mouse.y = event.motion.y
            case SDL_MOUSEWHEEL
                'scroll up
                if event.wheel.y > 0 then  
                    'mouse.y = mouse.y - 20
                    'SDL_WarpMouseInWindow(glass, mouse.x, mouse.y - 20)
                    yearbkm += 1
                'scroll down
                elseif event.wheel.y < 0 then
                    'mouse.y = mouse.y + 20
                    'SDL_WarpMouseInWindow(glass, mouse.x, mouse.y + 20)
                    yearbkm -= 1
                end if
                'scroll right
                if event.wheel.x > 0 then
                    'nop
                ' scroll left
                elseif event.wheel.x < 0 then
                    'nop
                end if
            case SDL_MOUSEBUTTONDOWN
                ' button
                select case event.button.button
                    case SDL_BUTTON_LEFT
                        buttons = 1
                        mousebutton = "left"
                        if sdl_pointinrect(@mouse, @monthleft) then
                            if monthbkm < 12 then
                                monthbkm += 1
                            end if
                        end if
                        if sdl_pointinrect(@mouse, @monthright) then
                            if monthbkm > 1 then
                                monthbkm -= 1
                            end if
                        end if
                    case SDL_BUTTON_MIDDLE
                        buttons = 4
                        mousebutton = "middle"
                    case SDL_BUTTON_RIGHT
                        buttons = 2
                        mousebutton = "right"
                    case else
                end select
            case SDL_MOUSEBUTTONUP
                buttons = 0                    
                mousebutton = ""
            ' navigation keyboard arrow keys and select
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_LEFT
'                SDL_WarpMouseInWindow(glass, mouse.x - 50, mouse.y)
                if monthbkm > 1 then
                    monthbkm -= 1
                end if
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_RIGHT
'                SDL_WarpMouseInWindow(glass, mouse.x + 50, mouse.y)
                if monthbkm < 12 then
                    monthbkm += 1
                end if
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_DOWN
                'SDL_WarpMouseInWindow(glass, mouse.x, mouse.y + 50)
                yearbkm -= 1
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_UP
                'SDL_WarpMouseInWindow(glass, mouse.x, mouse.y - 50)
                yearbkm += 1
            case SDL_KEYDOWN and event.key.keysym.sym = SDLK_RETURN
                ' fake mouse button left
                buttons = 1
                mousebutton = "left"
            case SDL_KEYUP and event.key.keysym.sym = SDLK_RETURN
                ' fake mouse button left
                buttons = 0
                mousebutton = ""
            ' navigation gamepad dpad and A button
            case SDL_CONTROLLERBUTTONDOWN
                select case event.cbutton.button    
                    case SDL_CONTROLLER_BUTTON_DPAD_LEFT
'                        SDL_WarpMouseInWindow(glass, mouse.x - 50, mouse.y)
                        if monthbkm > 1 then
                            monthbkm -= 1
                        end if
                    case SDL_CONTROLLER_BUTTON_DPAD_RIGHT
'                        SDL_WarpMouseInWindow(glass, mouse.x + 50, mouse.y)
                        if monthbkm < 12 then
                            monthbkm += 1
                        end if
                    case SDL_CONTROLLER_BUTTON_DPAD_DOWN
                        'SDL_WarpMouseInWindow(glass, mouse.x, mouse.y + 50)
                        yearbkm -= 1
                    case SDL_CONTROLLER_BUTTON_DPAD_UP
                        'SDL_WarpMouseInWindow(glass, mouse.x, mouse.y - 50)
                        yearbkm += 1
                    case SDL_CONTROLLER_BUTTON_A
                        buttons = 1
                        mousebutton = "left"
                end select
            case SDL_CONTROLLERBUTTONUP
                select case event.cbutton.button    
                    case SDL_CONTROLLER_BUTTON_A
                        buttons = 0
                        mousebutton = ""
                end select
            case SDL_CONTROLLERDEVICEADDED
                SDL_free(map)
                SDL_GameControllerClose(controller)
                controller = SDL_GameControllerOpen(0)
                print "switched to game controller: " & *SDL_GameControllerName(controller)
                map = SDL_GameControllerMapping(controller)
        end select
        renderpass = true
    wend

    ' use renderpass to reduce cpu usage
    if renderpass then
        ' background
        SDL_SetRenderDrawColor(renderer, backgrondcolor.r, backgrondcolor.g, backgrondcolor.b, backgrondcolor.a )
        ' draw calendar
        SDL_RenderClear(renderer)
            ' attempt to mitigate memeory leak ttf
            background_surface = null
            SDL_DestroyTexture(background_surface)
            sdlcal(monthbkm, yearbkm, cb, renderer)
        SDL_RenderPresent(renderer)
        ' remove stray textures reduce memory footprint todo evaluate better
        SDL_DestroyTexture(texture)
        renderpass = false
    end  if

    SDL_SetWindowTitle(glass, "calendar sdl2 | coord: " &  mouse.x & ":" & mouse.y & " | button: " + mousebutton)
    ' use sdl_delay to keep cpu usage low
    SDL_Delay(50)

wend

'clean up sdl
SDL_DestroyTexture(texture)
SDL_DestroyRenderer(renderer)
SDL_DestroyWindow(glass)
SDL_Quit()
TTF_Quit()
end
Post Reply