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