beginners freebasic tool set

[ron77_db]

hi, hello... here is a file with useful code (subs and functions) originally for simple text games and other stuff I collected over the years just thought to share - some of it might be obsolete... some of it might not be relevant, but still, I thought to publish it here...

file "text_game_toolkit.bas"

'plus

'APPEND TO the STRING array the STRING item
SUB sAppend(arr() AS STRING , Item AS STRING)
	REDIM PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS STRING
	arr(UBOUND(arr)) = Item
END SUB
'APPEND TO the INTEGER array the INTEGER item
SUB nAppend(arr() AS INTEGER , Item AS INTEGER)
	REDIM PRESERVE arr(LBOUND(arr) TO UBOUND(arr) + 1) AS INTEGER
	arr(UBOUND(arr)) = Item
END SUB


'1 getkeys function

FUNCTION _
	getKeys(_
	BYREF keysToCatch AS CONST STRING) _
	AS STRING
	
	DIM AS STRING _
	k
	
	DO
        k = > INKEY()
        
        SLEEP(1 , 1)
    LOOP UNTIL (INSTR(keysToCatch , k))
	
	'CLEAR keyboard buffer
	DO WHILE (LEN(INKEY()) > 0)
        SLEEP(1 , 1)
    LOOP
	
	RETURN(k)
END FUNCTION

'2 dates function
FUNCTION dates1(months AS INTEGER) AS STRING
	DIM AS CONST STRING _
	monthNames(0 TO 11) = > { _
	"January" , _
	"February" , _
	"March" , _
	"April" , _
	"May" , _
	"June" , _
	"July" , _
	"August" , _
	"September" , _
	"October" , _
	"November" , _
	"December" }
	
	DIM AS INTEGER _
	m = > (months + 11) MOD 12
	
	RETURN(monthNames(m) & "," & STR(INT((months - 1) / 12) + 1997))
END FUNCTION

'3 ending tiles from bottom to top from a text file
SUB upper(f AS STRING)
	CLS
	REDIM lines(0) AS STRING
	DIM h AS LONG = FREEFILE()
	DIM AS INTEGER r = 35 , c = 30
	DIM fline AS STRING
	OPEN f FOR INPUT AS #h
	WHILE NOT EOF(h)
        LINE INPUT #h , fline
        sAppend lines() , fline
    WEND
	CLOSE #h
	
	DIM AS INTEGER hi = HIWORD(WIDTH()) 'num columns ON display
	'PRINT closing credits
	FOR i AS INTEGER = 0 TO UBOUND(lines)
        LOCATE hi , 10
        PRINT lines(i)
        SLEEP 500
    NEXT
	'CLEAR SCREEN
	FOR i AS INTEGER = 1 TO hi
        PRINT
        SLEEP 500
    NEXT
	PRINT "END"
	GETKEY()
END SUB

'4 print whole text file on screen
SUB txtfile(f AS STRING)
	CLS
	DIM AS STRING buffer
	DIM h AS LONG = FREEFILE()
	OPEN f FOR BINARY AS #h
	buffer = SPACE(LOF(h))
	GET #h ,  , buffer
	CLOSE #h
	PRINT buffer
End SUB

'improve print of whole text file on screen
SUB txtfile(f AS STRING)
	CLS
	DIM AS STRING buffer
	DIM h AS LONG = FREEFILE()
	if OPEN(f FOR BINARY access read AS #h) then
		print "file could not be opened!"
	elseif (lof(h) < 1) then
		print "file could not be read!"
	else
		buffer = SPACE(LOF(h))
		GET #h ,  , buffer
		CLOSE #h
		PRINT buffer
	end if
End SUB

'5 using fbsound to play wav files
' first initialize ONCE ONLY fbsound
IF fbs_Init()=false then
  print "error: FBS_INIT() " & FBS_Get_PlugError()
  beep : sleep : end 1
end IF

'then you can use this function

SUB SOUND(f AS STRING , t AS INTEGER)
	DIM AS Integer hWave
	fbs_Load_WAVFile(f , @hWave)
	fbs_Play_Wave(hWave , t)
	Sleep
	fbs_Destroy_Wave(@hWave)
END SUB

'play ogg files with fbsound

SUB playogg(f AS STRING, t AS INTEGER)
   dim hWave As INTEGER
   fbs_Load_OGGFile(f ,@hWave)
	fbs_Play_Wave(hWave, t)
	Sleep
	fbs_Destroy_Wave(@hWave)	
END SUB

'6 an example for an opening screen for a game with bmp pic and fbtruetype and costome fonts and music

SUB opening()
	
	SCREENRES 800 , 600 , 32
	'SOUND("sabrina.wav" , 2)
	DIM AS ANY PTR bild
	DIM AS STRING datei
	DIM AS INTEGER breite , hoehe
	
	datei = "hikpic.bmp"
	breite = 800
	hoehe = 600
	
	bild = IMAGECREATE(breite , hoehe , 0)
	BLOAD datei , bild
	PUT(0 , 0) , bild , PSET
	
	SLEEP
	'SOUND("sabrina.wav" , 2)
	IMAGEDESTROY(bild)
	
	VAR Font = FontLoad(".\fonts\Montserrat-Bold.ttf")
	
	DIM AS STRING WORD = "A GAME BY RON77"
	DIM s AS STRING = "HIKIKOMORY"
	
	TTPrint Font , 300 , 150 , s , RGB(0 , 255 , 0) , 50
	
	ttprint Font , 250 , 200 , WORD , RGB(0 , 80 , 255) , 50
	
	SOUND("sabrina.wav" , 2)
	SLEEP
	
END SUB

'how to make a playlist with fbsound
DIM as integer hWave1, hWave2, hWave3, hWave4
Dim as integer CurrentPlay = 1
fbs_Load_WAVFile("File name here" , @hWave1)
fbs_Load_WAVFile("File name here" , @hWave2)
fbs_Load_WAVFile("File name here" , @hWave3)
fbs_Load_WAVFile("File name here" , @hWave4)



'Main loop and other code go here 
'Inside main loop:
if fbs_Get_PlayingSounds() = 0 then
    Select Case CurrentPlay
        Case 1:
            fbs_Play_Wave(hWave1 , 1)
            CurrentPlay += 1
        Case 2:
            fbs_Play_Wave(hWave2 , 1)
            CurrentPlay += 1
        Case 3:
            fbs_Play_Wave(hWave3 , 1)
            CurrentPlay += 1
        Case 4:
            fbs_Play_Wave(hWave4 , 1)
            CurrentPlay = 1
    end select
end if


Sleep
fbs_Destroy_Wave(@hWave1)
fbs_Destroy_Wave(@hWave2)
fbs_Destroy_Wave(@hWave3)
fbs_Destroy_Wave(@hWave4)


'slow printing sub
SUB slow(Text AS STRING)
	DIM AS INTEGER speed(0 TO 4) = > {50 , 100 , 20 , 300 , 250}
	FOR i AS INTEGER = 1 TO LEN(Text)
        PRINT MID(Text , i , 1) ;
        SLEEP speed(INT(RND * UBOUND(speed)))
    NEXT
END SUB

'clear buffer of the keybord (batbass the keypress of sleep)
SUB SleepEx()
  sleep
  While Inkey <> "":Wend
end SUB


'for gui apps auto scrolling to textbox - to put right after new string 
Form1.Text1.Text = "some string" & !"\r\n"
DIM As Long SelEnd = Len(Form1.Text1.Text) 
    SendMessage(Form1.Text1.hWindow, EM_SETSEL, SelEnd, SelEnd)
    SendMessage Form1.text1.hWindow, EM_SCROLLCARET, 0, 0
    
'for creating gui chatbot using shell voice.exe tts command line without the cmd appearing
'remove "-s -gui" from build commands and insert this code in main bas at top
#INCLUDE "windows.bi"
ShowWindow( GetConsoleWindow() , SW_HIDE )

'Returns a random number within range.
Function RandomRange(lowerbound As Integer, upperbound As Integer) As Integer
	Return Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End FUNCTION


'' Remaps a value from one range into another
private function remap( _
  x as single, startF as single, endF as single, startT as single, endT as single ) as single
 
  return( ( x - startF ) * ( endT - startT ) / ( endF - startF ) + startT )
end function