The Dungeon contains assembly to trap ctrl-break and can be removed from the source by deleting Call Setint/Call Restint.
This program and source are completely 16-bit and won't load in QB64 because it contains arrays in UDTs..
For Dungeon_v12_QB64.zip it contains no assembly.
Attached is:
Dngeon12.zip for VB10.
Dungeon_v12_QB64.zip for QB64.
The readme.txt is:
Code: (Select All)
Program:
Welcome to The Dungeon Adventure Game v12.0 r3.0. These files, documents,
and programs are public domain. Anyone may use, rewrite, or distribute
them without any fee, charge for use, or packaging requirements.
Files:
Separate the .zip file with the PKWare utility into the directory:
c:
cd \
md dngeon12
cd \dngeon12
copy \temp\dngeon12.zip \dngeon12
with the command
pkunzip dngeon12.zip
The .zip file contains the files:
ansi.bas -- opening screen source
ansi.exe -- opening screen program
compile.bat -- compiling batch program
compile.txt -- compile instructions
desc.sdi -- program description
dungeon.bas -- main dungeon source
dungeon.doc -- short documentation
dungeon.exe -- main dungeon program
edit.bas -- edit utility source
edit.exe -- edit utility program
file_id.diz -- program description
features.txt -- list of features
go.bat -- startup batch file
help.bas -- help menu source
help.exe -- help menu program
keytrap.asm -- assembly utility source
list.bat -- lists source to printer
mapedit.bas -- map edit utility source
mapedit.exe -- map edit utility program
page.com -- display utility
print.bat -- prints documentation
program.txt -- description of program
readme.bat -- displays readme file
readme.txt -- readme text file
swapbas.asm -- assembly utility source
util.bas -- display utility
util.exe -- display utility source
Dungeon creates the files:
datafile.00x -- player data file
players.dat -- player data file
ranklist.dat -- ranking list bulletin
Requirements:
The Dungeon is designed to operate on any standard PC, XT, or AT with
minimum of 256K memory, a floppy or fixed disk, and any color graphics
adapter.
The DUNGEON v12.0 r3.0 Documentation Page i
Starting the game:
Enter one of the following commands at the DOS prompt:
go -- read documentation and start the program
print -- print the documentation
readme -- display the readme text file
Instructions:
Playing is done by entry on the numeric keypad. Keys 0, 1, .., 9, and
other symbols like -, +, and = are used for commands. Be sure you have
turned on numlock before game play. The Dungeon also recognizes cursor
keys for moving in the game without numlock.
Program compiling:
This disk contains the compile batch files, BASIC source, and additional
utility for the dungeon v12.0. These files, documents, and programs are
public domain. Anyone may use, rewrite, or distribute them without any
fee, charge for use, or packaging requirements.
Compiling requirements:
The compile program is designed to operate on any standard PC, XT, or AT
with 512K, fixed disk, and any monitor.
Starting the compiler:
Enter one of the following commands at the DOS prompt:
compile -- start the compiling process
list -- print the source
Compiling instructions:
Compiling is done by entering the subprogram name to create with the
compile.bat program. You should have the required compiler and library
listed in the compile.txt file. Example to start: compile dungeon. Also,
the dungeon comes with a makefile containing instructions for nmake.exe
to compile the dungeon programs by date of .exe files.
Maintenance release v12.0 r2.0 Fixed/added:
Alt-Tab to add the globe of power to player inventory.
Clearing monster array between changing dungeon levels.
Dungeon level replenish to avoid placing items in rooms.
Overflow error in info screen for levels greater than 50.
More than eight monsters attacking player at once.
Distance to monsters for evade/approach fixed.
Count loops inside searching for empty dungeon cell.
Timer beyond midnight pause loop corrected.
Bulletin report utility display cleaned.
Added F11/F12 display/clear dungeon symbols.
Fixed page length in util display.
Eat keystrokes in second timer pause routine.
Remove monsters beyond player from attack array.
Update some counting variables during player movement.
Trapped interrupt service error during program shells.
Error with trapped control-break being returned as two-byte null.
Problem restoring current directory during shells.
ERASE probably should be renamed ARRase, because all it erases is the values stored in a specified array.
ERRASE makes the strings assigned to an array null or makes the numeric values assigned to a numeric array zero.
ERASE ArrayName [, others...]
Example:
Code: (Select All)
DIM Pete(10) AS STRING, var(100) AS INTEGER, cnt(20) AS LONG
ERASE Pete, var, cnt
ERASE can be used with STATIC or DYNAMIC arrays, but there is an important difference. Try running the two following code snippets.
Code: (Select All)
DIM Pete(1 TO 20) AS INTEGER ' DIM makes Pete a STATIC array.
FOR i = 1 TO 20
Pete(i) = -i
NEXT
FOR i = 1 TO UBOUND(Pete)
PRINT Pete(i)
NEXT
SLEEP
ERASE Pete
' All zeros will now be output.
CLS
FOR i = 1 TO 20
PRINT Pete(i)
NEXT
PRINT " ubound(Pete) is still ="; UBOUND(Pete)
Pete(15) = 101
PRINT: PRINT " Pete(15) ="; Pete(15)
Note: This routine will error out unless we Re-initialize the Pete array.
Code: (Select All)
REDIM Pete(1 TO 20) AS INTEGER ' REDIM makes Pete a DYNAMIC array.
FOR i = 1 TO 20
Pete(i) = -i
NEXT
FOR i = 1 TO UBOUND(Pete)
PRINT Pete(i)
NEXT
SLEEP
ERASE Pete
' This will error out unless we do a REDIM Pete(1 TO 20) here.
CLS
FOR i = 1 TO 20
PRINT Pete(i)
NEXT
PRINT " ubound(Pete) is still ="; UBOUND(Pete)
Pete(15) = 101
PRINT: PRINT " Pete(15) ="; Pete(15)
So ERASE appears to have more value and versatility when used with STATIC arrays, if you consider not de-initialing your array as a benefit.
And what makes an array either static or dynamic? Well...
DIM makes the array static.
REDIM makes the array dynamic
And this important note...
REM $DYNAMIC makes ALL arrays dynamic. So even...
Code: (Select All)
REM $DYNAMIC
DIM Pete(1 to 20)
ERASE Pete
REDIM Pete(1 to 20)
...makes the otherwise static DIM array, of Pete, dynamic. So if you use REM $DYNAMIC at the top of your code, use REDIM because a DIM statement after an ERASE statement won't work with REM DYNAMIC in your code.
REM $STATIC makes ALL arrays static. but...
Code: (Select All)
REM $STATIC
REDIM Pete(1 to 20) ' Change to DIM to get this to work.
ERASE Pete
PRINT Pete(15) ' Errors out because even though we used REM $STATIC REDIM messed it up.
So we've kicked the tires quite a bit here. Anyone want to add anything more?
Function ColorValue&& (text$)
ReDim values(1000) As String
ColorValue = -1 'This is to report a failed attempt to get a valid color.
' All valid colors will be greater than -1, so be certain the return variable is an _INTEGER64 type
' so that this -1 value doesn't overflow and become bright white (most likely), or some other color
Function ParseValues (text$, values() As String)
ReDim values(1000) As String
temp$ = text$ 'preserve without changing our text
lp = InStr(temp$, "("): temp$ = Mid$(temp$, lp + 1) 'strip off any left sided parenthesis, such as _RGB32(
rp = _InStrRev(temp$, ")"): If rp Then temp$ = Left$(temp$, rp - 1) 'strip off the right sided parenthesis )
Do
p = InStr(temp$, ",")
If p Then
eval$ = Left$(temp$, p - 1)
If IsNum(eval$) = 0 Then ParseValues = -1: Exit Function
count = count + 1
If count > UBound(values) Then ReDim _Preserve values(UBound(values) + 1000) As String
values(count) = eval$
temp$ = Mid$(temp$, p + 1)
Else
eval$ = temp$
If IsNum(eval$) = 0 Then ParseValues = -1: Exit Function
count = count + 1
If count > UBound(values) Then ReDim _Preserve values(UBound(values) + 1) As String
values(count) = eval$
temp$ = ""
End If
Loop Until temp$ = ""
ReDim _Preserve values(count) As String
ParseValues = count
End Function
Function IsNum%% (PassedText As String)
text$ = _Trim$(PassedText)
special$ = UCase$(Left$(text$, 2))
Select Case special$
Case "&H", "&B", "&O"
'check for symbols on right side of value
r3$ = Right$(text$, 3)
Select Case r3$
Case "~&&", "~%%", "~%&" 'unsigned int64, unsigned byte, unsigned offset
text$ = Left$(text$, Len(text$) - 3)
Case Else
r2$ = Right$(text$, 2)
Select Case r2$
Case "~&", "##", "%&", "%%", "~%", "&&" 'unsigned long, float, offset, byte, unsigned integer, int64
text$ = Left$(text$, Len(text$) - 2)
Case Else
r$ = Right$(text$, 1)
Select Case r$
Case "&", "#", "%", "!" 'long, double, integer, single
text$ = Left$(text$, Len(text$) - 1)
End Select
End Select
End Select
check$ = "0123456789ABCDEF"
If special$ = "&O" Then check$ = "01234567"
If special$ = "&B" Then check$ = "01"
temp$ = Mid$(UCase$(text$), 2)
For i = 1 To Len(temp$)
If InStr(check$, Mid$(temp$, i, 1)) = 0 Then Exit For
Next
If i <= Len(temp$) Then IsNum = -1
Case Else
If _Trim$(Str$(Val(text$))) = text$ Then IsNum = -1
End Select
End Function
Coming in at 440 lines of code, this awesome Colornator... umm... well.. It gives you the color value of a text string, if possible.
/blush
Lots and lots of code, just to do something so simple -- but it's more complex than you'd first imagine!!
This works with plain numeric values for colors. This works with _RGB, _RGBA, _RGB32, _RGBA32 values. Hex values, Octal, and even Binary values are all fine! (&H, &O, &B prefaced values.) This lets you specify a color NAME, and it returns the 32-bit color value back from that!!
It's THE COLORNATOR!! Dr. Doofenshmirtz, eat your heart out! I just out NATORed you!
Out of curiosity, I created a program for converting images to characters.
There are so many online, there are also online converters.
I tried to add something extra. It also works with variable character width, and the shades of the image can be adjusted.
Enter the image and font in the source code. You can change what characters it uses.
When the program starts, the optimal image can be adjusted with brightness/contrast.
It is possible to set how many lines the image is displayed.
Black characters on a white background or white characters on a black background.
The width of the letter can be adjusted. (1- original 0.5, half as wide, 2, double wide)
You can set the size of the map to work on. This is important when saving, because the image can be saved in very good quality.
The program does not require external files.
Give it a picture and start it.
Code: (Select All)
'MasterGy 2022
Dim Shared pic, contrast, brightness, contrast_ref, char_collection$
picture$ = "image1.jpg" ' <------ set a picture
char_collection$ = "'+0123456789.?!=:>()<%/-,ABCDEFGHIJKLMNOPQRSTVXYZUWabcdefghijklmnopqrstvxyzuw" '<----- charecters used
type_s$ = Environ$("systemroot") + "/fonts/arial.ttf" '<------ font type
k$ = InKey$
Select Case k$
Case Chr$(27): System
Case "1", "2", "3": work_type = Val(k$): GoSub work
End Select
mousew = 0: While _MouseInput: mousew = mousew + _MouseWheel: Wend: If _MouseButton(1) = 0 Then mc = -1
s(3, 0) = Int(s(3, 0))
s(4, 0) = Int(s(4, 0))
s(5, 0) = CInt(s(5, 0))
s(7, 0) = CInt(s(7, 0))
For sa = 0 To s_c - 1
y1 = (s_sy + sa * 3 - 1) * 16 + 20: y2 = y1 + 14: x1 = (winx - x_size) / 2: x2 = x1 + x_size
under2 = _MouseX > x1 And _MouseX < x2: under = under2 And _MouseY > y1 And _MouseY < y2
mgrey = 128 + (CInt(s(5, 0)) * 2 - 1) * 127 * under
Color _RGB(mgrey, mgrey, mgrey)
s$ = s$(sa) + " (" + LTrim$(Str$(Int(s(sa, 0) * 100) / 100)) + ")"
If sa = 4 Then s$ = s$(sa) + " (" + LTrim$(Str$(Int(s(sa, 0)))) + " x " + LTrim$(Str$(Int(s(sa, 0) / x * y))) + ")"
Locate s_sy + sa * 3, (winx - Len(s$) * 8) / 16: Print UCase$(s$)
Color _RGB(200, 40, 40): Line (x1, y1)-(x2, y2), , B
x2 = x1 + x_size / (s(sa, 2) - s(sa, 1)) * (s(sa, 0) - s(sa, 1)): Line (x1, y1)-(x2, y2), , BF
If under And _MouseButton(1) And mc = -1 Then mc = sa
Next sa
If mc <> -1 And under2 And mc <> 5 Then s(mc, 0) = (s(mc, 2) - s(mc, 1)) * (1 / x_size * (_MouseX - (winx - x_size) / 2)) + s(mc, 1)
If mc = 5 And under2 And m5last = 0 Then s(5, 0) = 1 - s(5, 0): m5last = 1
m5last = m5last And -_MouseButton(1)
'statistic
min = 999999: max = -min: _Dest mon: _Source pic
For tx = 0 To x - 1: For ty = 0 To y - 1: grey = pic_read(tx, ty): If grey > max Then max = grey
If grey < min Then min = grey
Next ty, tx
'draw
temp = 255 / (max - min)
sx = (winx - x) / 2: For tx = 0 To x - 1: For ty = 0 To y - 1: grey = temp * (pic_read(tx, ty) - min): PSet (sx + tx, ty), _RGB(grey, grey, grey): Next ty, tx
_Display
grey = 255 * CInt(s(5, 0))
Cls , _RGB(grey, grey, grey)
Color _RGB(50, 128, 50), 0
Locate Int(winy / 16) - 3, 3: Print "-1- work variable character width";
Locate Int(winy / 16) - 2, 3: Print "-2- work same character width";
Locate Int(winy / 16) - 1, 3: Print "-3- work random character location";
If st(stx, 0) = a_col Then
st = st(stx, 1)
Else
sum = 0: c = 0: For tx = x1 To x2
For ty = y1 To y2: sum = sum + _Red(Point(tx, ty)): c = c + 1: Next ty, tx
st(stx, 0) = a_col
st = sum / (255 * c)
st(stx, 1) = st
End If
dif = Abs(st - font_collection(ac + 1, 2))
If dif < dif_ok Then dif_ok = dif: st_need = ac: x2_need = x2
Next ac
sum = 0: c = 0: For tx = 0 To xsize - 1
_Source pic_work
For ty = 0 To ysize - 1: sum = sum + _Red(Point(tx + xpos, ty + ypos)): c = c + 1: Next ty, tx
st = sum / (255 * c)
dif_ok = 99999
For ac = 0 To Len(char_collection$) - 1
dif = Abs(st - font_collection(ac + 1, 2))
If dif < dif_ok Then dif_ok = dif: st_need = ac
Next ac
_Source font_collection(st_need + 1, 0)
_PutImage (xpos, ypos)-(xpos + xsize, ypos + ysize)
Loop
End Select
saving: _AutoDisplay: Screen 0: _FullScreen _Off: Cls: Print "saving picture to SAVED.BMP...waiting": SaveImage pic_out, "saved.bmp": Sleep 2: System
c = 0: st = 0: For tx = 0 To _Width(temp2) - 1: For ty = 0 To _Height(temp2) - 1: c = c + 1: st = st + Abs(_Red(Point(tx, ty)) <> _Red(tc&&)): Next ty, tx
font_collection(ac + 1, 2) = 1 / c * st: _FreeImage temp2
font_collection(ac + 1, 1) = Asc(ac$): Next ac
font_collection(0, 0) = af
min_g = 99999: max_g = -min_g
For t = 0 To Len(char_collection$) - 1 'find limits
If font_collection(t + 1, 2) < min_g Then min_g = font_collection(t + 1, 2)
If font_collection(t + 1, 2) > max_g Then max_g = font_collection(t + 1, 2)
Next t
For t = 0 To Len(char_collection$) - 1 'normalizing limits
font_collection(t + 1, 2) = 1 / (max_g - min_g) * (font_collection(t + 1, 2) - min_g)
Next t
End Sub
Function pic_read (tx, ty)
p&& = Point(tx, ty): grey = (_Red(p&&) + _Green(p&&) + _Blue(p&&)) * .33333
grey = contrast_ref + (grey - contrast_ref) * contrast + brightness
If grey < 0 Then grey = 0
If grey > 255 Then grey = 255
pic_read = grey
End Function
Sub SaveImage (image As Long, filename As String)
bytesperpixel& = _PixelSize(image&)
If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
x& = _Width(image&)
y& = _Height(image&)
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
If bytesperpixel& = 1 Then
For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
cv& = _PaletteColor(c&, image&) ' color attribute to read.
b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
Next
End If
Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
lastsource& = _Source
_Source image&
If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
r$ = ""
For px& = 0 To x& - 1
c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
If bytesperpixel& = 1 Then r$ = r$ + Chr$(c&) Else r$ = r$ + Left$(MKL$(c&), 3)
Next px&
d$ = d$ + r$ + padder$
Next py&
_Source lastsource&
Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
b$ = b$ + d$ ' total file data bytes to create file
Mid$(b$, 3, 4) = MKL$(Len(b$)) ' size of data file(BMP header)
If LCase$(Right$(filename$, 4)) <> ".bmp" Then ext$ = ".bmp"
f& = FreeFile
Open filename$ + ext$ For Output As #f&: Close #f& ' erases an existing file
Open filename$ + ext$ For Binary As #f&
Put #f&, , b$
Close #f&
End Sub
$RESIZE:SMOOTH
Sw = 60
Sh = 25
S& = _NEWIMAGE(Sw, Sh, 0)
SCREEN S&
DO: LOOP UNTIL _SCREENEXISTS
font& = _LOADFONT(ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf", 18, "MONOSPACE")
_FONT font&
PALETTE 0, 8
COLOR 15, 0
_SCREENMOVE 10, 10
_DELAY .2
ml = 0: mr = ml
w = _WIDTH - (ml + mr)
DO
_LIMIT 30
x$ = "In West Los Angeles born and raised, at the yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser, 'Save password log in later!' Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
x$ = "In West Los Angeles born and raised, at the yacht club is where I spent most of my days, 'til a couple of coders who were up to no good, started making trouble in my neighborhood. I got booted off Discord and my vids wouldn't play, so I moved to the hills in the State of VA. I pulled up to the forum 'bout a week into April and I yelled to the browser, 'Save password log in later!' Now I'm able to post and my speech is still free as I sit on my throne as the Prince of P.E."
w2 = w - (ml + mr)
CLS
LOCATE 2
DO
WHILE -1
t$ = MID$(x$, 1, w2)
chop = 1
IF w2 <> 1 THEN
DO
IF LEFT$(t$, 1) = " " THEN
' Only happens with more than 1 space between characters.
IF LTRIM$(t$) = "" THEN EXIT DO ELSE x$ = LTRIM$(x$): EXIT WHILE
END IF
IF MID$(x$, w2 + 1, 1) <> " " AND LTRIM$(t$) <> "" THEN ' Now we have to chop it.
IF INSTR(x$, " ") > 1 AND INSTR(t$, " ") <> 0 AND LEN(x$) > w2 THEN
t$ = MID$(t$, 1, _INSTRREV(t$, " ") - 1)
chop = 2
END IF
ELSE
chop = 2
END IF
EXIT DO
LOOP
x$ = MID$(x$, LEN(t$) + chop)
ELSE
x$ = MID$(x$, LEN(t$) + 1)
END IF
IF LEN(t$) AND CSRLIN < _HEIGHT - 1 THEN LOCATE , ml + 1: PRINT LTRIM$(t$)
EXIT WHILE
WEND
LOOP UNTIL LEN(t$) AND LEN(LTRIM$(x$)) = 0
oldsw = Sw: oldsh = Sh
IF _RESIZE THEN
Sw = _RESIZEWIDTH \ _FONTWIDTH
Sh = _RESIZEHEIGHT \ _FONTHEIGHT
IF oldsw <> Sw OR oldsh <> Sh THEN
w = Sw
S& = _NEWIMAGE(Sw, Sh, 0)
SCREEN S&
_FONT font&
PALETTE 0, 8
END IF
ELSE
DO
_LIMIT 30
IF _RESIZE THEN EXIT DO
b$ = INKEY$
IF LEN(b$) THEN
IF b$ = CHR$(27) THEN SYSTEM
SELECT CASE MID$(b$, 2, 1)
CASE "M"
IF ml < _WIDTH \ 2 THEN ml = ml + 1: mr = mr + 1
EXIT DO
CASE "K"
IF ml > 0 THEN ml = ml - 1: mr = mr - 1
EXIT DO
END SELECT
END IF
LOOP
END IF
LOOP
Now before you get too excited... and we'll pause a moment so Steve can change his pants... this little routine just clears the screen on each resize. That means if we added vertical scrolling we would also have to build an algorithm to handle vertical positioning so we don't just always return to the start of the document every time the window gets resized.
Oh, now that Steve's back, yo can use the arrow left and right keys to increase and decrease the page margins.
I need sleep. I'm having too much fun coding stuff from the past all over again... [Search Fresh Prince of Bel Air for ref to text].
_CLIPBOARD$ captures the string contents of the operating system clipboard contents.
The neat thing about this platform cross-compatible feature is the ability to use it outside the immediate program. I'll explain...
_CLIPBOARD$ can be used to capture any copied text from any running application. Once captured, the string can be used inside your app, or transferred to another QB64 app. _CLIPBOARD$ is therefore one of a few ways we can communicate with other QB64 programs running simultaneously. Now as exciting as that may be, the use of _CLIPBOARD, for inter-program communications, is somewhat frowned upon by Microsoft. The preferred M$ method is to establish a TCP/IP communications, which will be discussed a bit later along with piping to the clipboard using Windows SHELL command.
Right now, let's take a look at a copying, parse and print text example.
For this demo, start the app and then come back to this page, do Ctrl + A to copy all the tet, and Ctrl + C to copy it to the clipboard. Upon copying, the app will parse and display the clipboard text capture.
Code: (Select All)
$CONSOLE:ONLY
_CLIPBOARD$ = ""
COLOR 15, 1
CLS
PRINT " Copy the Keyword of the Day page..."
DO: _LIMIT 1: LOOP UNTIL LEN(_CLIPBOARD$)
CLS
a$ = _CLIPBOARD$ + CHR$(13)
DO
x$ = MID$(a$, 1, INSTR(a$, CHR$(13)))
a$ = LTRIM$(MID$(a$, LEN(x$) + 2))
x$ = _TRIM$(MID$(x$, 1, INSTR(x$, CHR$(13)) - 1))
IF LEN(x$) THEN
IF MID$(x$, 1, 11) = "IP Address:" OR INSTR(x$, "AM") AND LEFT$(x$, 1) = "(" OR INSTR(x$, "PM") AND LEFT$(x$, 1) = "(" THEN pon = 0: spacer = 0
IF pon THEN
w = _WIDTH - 2
IF MID$(a$, 1, 2) = CHR$(13) + CHR$(10) AND last = 0 THEN spacer = 1
IF w > 0 THEN
DO
t$ = MID$(x$, 1, w)
chop = 1
IF MID$(x$, w + 1, 1) <> " " THEN ' Now we have to chop it.
IF INSTR(x$, " ") > 1 AND INSTR(t$, " ") <> 0 AND LEN(x$) > w THEN
t$ = MID$(t$, 1, _INSTRREV(t$, " ") - 1)
chop = 2
END IF
ELSE
chop = 2
END IF
IF w = 1 THEN chop = 1
x$ = MID$(x$, LEN(t$) + chop)
'-----------------------------------------------------------------------
IF LEN(t$) THEN LOCATE , 2: PRINT LTRIM$(t$): IF spacer = 0 THEN last = 0
'-----------------------------------------------------------------------
LOOP UNTIL LEN(t$) AND LEN(LTRIM$(x$)) = 0
IF spacer = 1 THEN PRINT: spacer = 0
END IF
END IF
IF INSTR(x$, ",") <> 0 AND INSTR(x$, "-") <> 0 THEN
IF INSTR(x$, "AM") OR INSTR(x$, "PM") AND LEFT$(x$, 1) <> "(" THEN
pon = 1
END IF
END IF
ELSE
END IF
LOOP UNTIL a$ = ""
PRINT: PRINT "Click the 'X' in the title bar to close this window."
DO: _LIMIT 1: SLEEP: LOOP
Okay, now how about we have a look at using _CLIPBOARD$ to make a small chat app...
For this demo you will need to save the second app as: "myclip.exe" and run the first app to access it.
Code: (Select All)
_SCREENMOVE 0, 0 ' Set up this host window to the left of your desktop.
WIDTH 60, 25
IF NOT _FILEEXISTS("myclip.exe") THEN PRINT "Cannot find file: "; "myclip.exe. Ending...": END
a$ = "Opening as host." '
PRINT a$: PRINT
SHELL _HIDE "start myclip.exe" ' Open the client window.
_SCREENCLICK 30 * 8, 10
PRINT "Connection established.": PRINT
DO
_CLIPBOARD$ = ""
' Okay, time to input something on the host that will be communicated to the client.
INPUT "Input a message: "; msg$: PRINT
_CLIPBOARD$ = msg$
_KEYCLEAR
_DELAY 2
_CLIPBOARD$ = ""
DO: _LIMIT 5: LOOP UNTIL LEN(_CLIPBOARD$)
_SCREENCLICK 30 * 8, 10
PRINT "Reply received: "; _CLIPBOARD$: PRINT
LOOP
Save this as "myclip.exe" but don't run it. Run the first app (it doesn't matter if it's named) to start the chat sequence.
Code: (Select All)
_SCREENMOVE 60 * 8 + 10, 0 ' Set up this client window to the right of host.
WIDTH 60, 25
_CLIPBOARD$ = ""
a$ = "Opening as host." '
PRINT a$: PRINT
PRINT "Connection established.": PRINT
DO
DO: _LIMIT 5: LOOP UNTIL LEN(_CLIPBOARD$)
_SCREENCLICK 90 * 8, 10: _DELAY .25
PRINT "Message received: "; _CLIPBOARD$: PRINT
' Okay, time to input something on the client that will be communicated to the host.
INPUT "Input a message: "; msg$: PRINT
_CLIPBOARD$ = msg$
_KEYCLEAR
_DELAY 2
_CLIPBOARD$ = ""
LOOP
So M$ recommends using TCP/IP to accomplish what we just demoed with _CLIPBOARD. This example covers how to do that, but it's much more involved. Also, because it uses TCP/IP, you will have to clear it with Windows Defender.
This is a Windows only demo. It uses min/restore to regain focus to each window, instead of _SCREENCLICK like the _CLIPBOARD demo above. Save, but don't run the second app as "messenger_client.exe" then run the first one. Clear for use with Windows Defender when the alert pops up on your screen.
Code: (Select All)
DECLARE DYNAMIC LIBRARY "user32"
FUNCTION FindWindowA%& (BYVAL ClassName AS _OFFSET, WindowName$) 'handle by title
FUNCTION ShowWindow& (BYVAL hwnd AS _OFFSET, BYVAL nCmdShow AS LONG) 'maximize process
FUNCTION SetForegroundWindow%& (BYVAL hwnd AS _OFFSET) 'set foreground window process(focus)
FUNCTION GetForegroundWindow%& 'Find currently focused process handle
END DECLARE
_SCREENMOVE 0, 0 ' Set up this host window to the left of your desktop.
WIDTH 60, 25
IF NOT _FILEEXISTS("messenger_client.exe") THEN PRINT "Cannot find file: messenger_client.exe. Ending...": END
DIM host_msg AS STRING, client_msg AS STRING
DO
IF initiate = 0 THEN ' This only needs to be performed once, to open the client window.
DO UNTIL x ' Stay in loop until window determines if it is the host or client window.
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
IF x = 0 THEN
x = _OPENHOST("TCP/IP:1234") ' Note the host and clinet must have the same 1234 I.D. number.
a$ = "Opening as host." ' x channel is now open and this window becomes the host.
ELSE
a$ = "Opening as client." ' Should not go here for this demo.
END IF
PRINT a$
LOOP
SHELL _HIDE _DONTWAIT "messenger_client.exe" ' Open the client window.
initiate = -1 ' Switches this block statement off for all subsequent loops.
END IF
IF z = 0 THEN ' Initiates an open channel number when zero.
DO
z = _OPENCONNECTION(x) ' Checks if host is available to transfer data.
LOOP UNTIL z
PRINT "Connection established."
_DELAY 1
LOCATE 2: PRINT SPACE$(_WIDTH * 2) ' Remove these lines.
LOCATE 3, 1
GOSUB focus ' Sends focus back to host window.
END IF
' Okay, time to input something on the host that will be communicated to the client.
LINE INPUT "Message to client: "; host_msg: PRINT
PUT #z, , host_msg ' Input is now entered into TCP/IP routine.
DO
GET #z, , client_msg
LOOP UNTIL LEN(client_msg) ' Exits loop when a return msg is received.
PRINT "Message from client: "; client_msg: PRINT
host_msg = "": PUT #z, , host_msg$ ' Now put our client value back into the routine. Failure to do so would result in the client not waiting in the GET #x DO/LOOP.
_KEYCLEAR ' Prevents typing before ready.
GOSUB focus
LOOP
focus:
DO UNTIL hwnd%&
_LIMIT 10
hwnd%& = FindWindowA(0, title$)
LOOP
FGwin%& = GetForegroundWindow%& 'get current process in focus.
_DELAY .1
IF FGwin%& <> hwnd%& THEN
y& = ShowWindow&(hwnd%&, 0)
y& = ShowWindow&(hwnd%&, 2)
y& = ShowWindow&(hwnd%&, 9)
DO
_LIMIT 10
FGwin%& = GetForegroundWindow%&
LOOP UNTIL FGwin%& = hwnd%&
END IF
RETURN
This client app must be saved as: messenger_client.exe Run the first app after this app is saved.
Code: (Select All)
DECLARE DYNAMIC LIBRARY "user32"
FUNCTION FindWindowA%& (BYVAL ClassName AS _OFFSET, WindowName$) 'handle by title
FUNCTION ShowWindow& (BYVAL hwnd AS _OFFSET, BYVAL nCmdShow AS LONG) 'maximize process
FUNCTION SetForegroundWindow%& (BYVAL hwnd AS _OFFSET) 'set foreground window process(focus)
FUNCTION GetForegroundWindow%& 'Find currently focused process handle
END DECLARE
DIM host_msg AS STRING, client_msg AS STRING
_SCREENMOVE 600, 0 ' Set up this client window next to your host window.
WIDTH 50, 25
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
PRINT "Opened as client.": PRINT
DO UNTIL x = 0 ' Prevents running if this app is opened without using host.
DO
_LIMIT 30
GET #x, , host_msg ' Waits until it receives message sent from the host.
LOOP UNTIL LEN(host_msg)
PRINT "Message from host: "; host_msg
PRINT
_KEYCLEAR ' Prevents typing before ready.
GOSUB focus
LINE INPUT "Message to host: "; client_msg: PRINT
PUT #x, , client_msg
LOOP
END
focus:
DO UNTIL hwnd%&
_LIMIT 10
hwnd%& = FindWindowA(0, title$)
LOOP
FGwin%& = GetForegroundWindow%& 'get current process in focus.
_DELAY .1
IF FGwin%& <> hwnd%& THEN
y& = ShowWindow&(hwnd%&, 0)
y& = ShowWindow&(hwnd%&, 2)
y& = ShowWindow&(hwnd%&, 9)
DO
_LIMIT 10
FGwin%& = GetForegroundWindow%&
LOOP UNTIL FGwin%& = hwnd%&
END IF
RETURN
PIPING:
In Windows, _CLIPBOARD can be used with SHELL to extract the directory contents. This method avoids then need to make and read temp file, which would be: SHELL _HIDE "dir /b *.bas>temp.tmp"
For Windows users, _CLIPBOARD can also be used with Win32API SENDKEYS, which allows you to use your program to copy text from other apps, instead of manually doing a copy to the clipboard. See my Sam-Clip thread for more info: https://staging.qb64phoenix.com/showthre...t=sam-clip
## New features
### All platforms
- New `$Debug` metacommand, with added breakpoint/step abilities and real-time variable watching to the IDE.
- Quick reference for commands is now shown in the status bar when syntax errors are detected.
- `_Source` is now also set to `_Console` when `$Console:Only` is used.
- Allows `Ctrl+\` to be used as a shortcut to repeat search (legacy QBasic shortcut).
- Functions `_MK$` and `_CV` can now deal with `_OFFSET` values.
- New "View on Wiki" button on help panel (launches equivalent wiki page using the default browser).
- New `_EnvironCount` function to show how many environment variables are found.
- Color schemes can now be set/saved individually for each running instance of the IDE.
### Windows
- Automatically embeds a manifest file when compiling an exe with `$VersionInfo`, so that Common Controls v6.0 gets linked at runtime.
- Adds the %TEMP%, Program Files and Program Files (x86) directories to `_Dir$()` folder specifications.
<!---
### macOS
### Linux
--->
## Fixes
### All platforms
- Improved wiki parser.
- Contextual menu would crash when right-clicking a series of high-ascii characters.
- Fixes an issue with passing an array as a Sub/Function argument (missing parenthesis now properly detected).
- Fixes `Clear` making `$Console` mode invalid.
- Fixes a syntax highlighter issue regarding scientific notation.
- Fixes an issue in Windows Vista and up with incorrect resolution returned on a scaled desktop.
- Fixes `Const` parser accepting unsupported string functions and failing with some very specific const names.
- Explicitly sets x87 fpu to extended precision mode.
- Removes 255-character limit for `Input/Line Input` with strings.
- Fixes `Data` commands failing to compile in some circumstances.
- `$NoPrefix`, `Option _Explicit` and `Option _ExplicitArray` can now be placed anywhere in a program, no longer having to be the first statement.
- Fixes `MEM` reverting to `_MEM` as a sub parameter in `$NoPrefix` mode.
- Fixes case adjustment of array names in `UBound`/`LBound` calls.
- Prevents users from creating self-referencing `Type` blocks.
- Fixes issue that prevented loading file names beginning with numbers.
- Fixes file open/save dialogs issue with path navigation.
- Complete rewrite of the internals for `Environ$()`.
- Fixes evaluation of valid var/flag names for `$Let`/`$If` - same rules for variable names now apply.
- Fixes incorrect parsing of `Type` blocks with multiple elements using the `AS type element-list` syntax.
- Fixes issue with `Put #` and variable-length strings in UDTs (`Binary` files).
- Fixes issue with recursive functions without parameters.
#### Fixed in 2.0.1
- Fix "Duplicate definition" error with Static arrays in Subs/Functions with active On Error trapping.
- Fix internal UDT arrays not resetting when a new file is loaded.
- Fix issue preventing `$Debug` from working in Windows versions prior to Windows 10.
#### Fixed in 2.0.2
- Fix issue with `LBound`/`UBound` calls in complex expressions.
### Windows
- Allows `$Console:Only` programs to return `_WindowHandle`.
- Saving a file to the root of a drive would display double backslashes in the Recent Files list.
### macOS
- Flushes the console output so `Print` can properly display text even while retaining the cursor.
#### Fixed in 2.0.2
- Fix issue preventing compilation in macOS versions prior to Catalina.
### Linux
- `xmessage` added to dependency list (setup script).
- Fixes `InKey$` acting too slow.
- Fixes compilation error with `Data` statements on gcc 11.
- Detects non-x86 based architectures.
- Flushes the console output so `Print` can properly display text even while retaining the cursor.
Code: (Select All)
QB64 v1.5 - What's new?
New features
All platforms
New _MEMSOUND function, that allows you to access raw audio data decoded by the _SNDOPEN function.
Added tiling support to PAINT for legacy SCREEN modes.
Holding CTRL while dragging colors sliders in RGB mixer locks all sliders together (useful for generating gray scale values).
Adds OPTION _EXPLICITARRAY - like OPTION _EXPLICIT but only makes array declaration mandatory, not regular variables.
EXIT SELECT/CASE implemented to allow breaking out of a SELECT CASE block or out of a CASE block, in case it's used in a SELECT EVERYCASE block.
New <New Folder> button in open/save dialogs.
Ability to disable the Syntax Highlighter entirely (Options menu).
New default color scheme "Super dark blue".
Adds Alt+F3 as a shortcut to Search->Change...
Adds Ctrl+F2 as a shortcut to clicking the "back" arrow (quick navigation).
New CTRL+K shortcut that allows you to insert _KEYHIT and _KEYDOWN codes easily.
Find and Change dialogs (Search menu) now allow you to ignore text in comments and strings - or search exclusively in comments or strings.
SUBs dialog (F2 key) now shows how many lines each procedure contains.
Adds ability to change color/cursor position in $CONSOLE mode in macOS and Linux.
Extends contextual menu (right click) to the Help area.
Warnings dialog now displays the correct line number if a warning refers to an $INCLUDE file.
New colorized output for command-line compilation.
New -w switch for command-line compilation to show warnings.
Revamped ASCII Chart dialog.
Rewritten Math Evaluator dialog.
Added dialog to show progress of updating help pages (Help->Update All Pages).
Menu items reorganized for clearer grouping. New Tools menu.
Menu items descriptions are now shown in the status bar.
New _ERRORMESSAGE$ function, to return a human-readable description of the most recent runtime error.
New $ERROR metacommand, which prevents compilation depending on an $IF precompiler block condition.
New VERSION precompiler variable which can be used to check the current version of QB64 being used.
Setting $CONSOLE:ONLY now automatically switches _DEST to _CONSOLE.
New alternative syntax for DIM, REDIM, SHARED, STATIC, COMMON, TYPE, that allows for less typing by grouping variables of the same type (like DIM AS INTEGER a, b, c, d, e, f, g '...)
Ability to have the IDE format keywords in camel case like _FullScreen instead of _FULLSCREEN (opt-out feature, check Options->Code Layout).
Menus items now have brief descriptions that get displayed in the status bar.
File menu now shows more recent files and the full path is displayed in the status bar.
Cursor shapes "HELP" and "WAIT" can now be set via _MOUSESHOW.
Fixes
All platforms
Fixed the QB4.5 binary format converter to allow some syntax blocks to be properly recognized.
Fixed an error that would prevent the QB4.5 binary format converter from being launched.
Allows the RGB mixer to be invoked with Alt+Enter when $NOPREFIX is used.
RGB mixer now inserts new color values even if _RGB32 is used with less than three parameters.
Fixes syntax highlighter for some corner case non-numbers being colorized - as well as some numbers not being colorized properly (scientific notation).
Fixes $CHECKING:OFF bug related to arrays with non-zero lower bound.
Fixes ENVIRON$() not working in some scenarios.
Fixes issue that allowed code in a SELECT CASE block but before a CASE condition.
Syntax Highlighter gets automatically disabled if rendering a page takes longer than a second.
Fixes a bug that wouldn't display the recent search history if it was too long and a help page was active.
Fixes _MOUSEMOVEMENTX and _MOUSEMOVEMENTY in Windows systems. Implements both commands for macOS and Linux (limited to the program window area).
Fixes SEEK not resetting EOF().
END/EXIT SUB/FUNCTION get correctly changed, like in QB4.5 (e.g. use EXIT SUB in a FUNCTION and it'll become EXIT FUNCTION).
CONST evaluator fixed to allow using existing constants in equations reliably.
$LET lines would be incorrectly indented in some scenarios.
Allows DATA to contain numbers with trailing data type markers, for retrocompatibility with QB4.5.
The IDE will now let you know early on that labels placed between Subs/Functions are not valid, instead of just crashing at C++ compilation. CONST statements are no longer accepted between Subs/Functions either (they would be accepted in previous versions, but inaccessible).
Classic metacommands parsing adapted to more closely behave like QB4.5.
Windows
Fixes a _LOADFONT issue when attempting to load a font from C:\Windows\Fonts when no path is passed.
macOS
The IDE would segfault at startup if the clipboard contained an image.
Fixed an issue that prevented the IDE window size to be restored from previous sessions and kept defaulting to 80x25.
Replaced all g++ and gcc calls with clang++ and clang, to prevent failures in some scenarios.
Fixes scaling for UHD/5K resolution systems.
Fixes an issue with variable-length strings in TYPEs.
Enables _SCREENX and _SCREENY to return the window position on the desktop. The IDE now properly stores its last position too.
Linux
Programs written for $CONSOLE:ONLY no longer pull in GL/X11 libs
Code: (Select All)
QB64 Version 1.4 - Changelog
First things first, we have moved development to a new GitHub repository. Follow us at https://github.com/QB64Team/qb64.
Although we don't follow a strict schedule regarding updates to QB64, every once in a while a feature that's been requested gets implemented or a new bug is found and then fixed, and eventually we have enough for a new release.
$NOPREFIX
One big change worth mentioning first, since it affects QB64 code from now on in a big way, is the new $NOPREFIX metacommand.
QB64-specific keywords, those that expand on the original set of keywords from QBasic/QuickBASIC 4.5, which we aim to replicate, are those that start with an underscore. It has been designed that way so that, in the event that you want to load an older program you wrote back in the day that had variables or procedures with identical names, they would not collide with the new keywords, making it possible to use QB64 entirely as you did with QBasic but also add the new functionality without breaking anything.
However, we have over the years been following our userbase create more and more programs that have no dependency whatsoever on older code, which means these aren't just QBasic programs with benefits, but actually QB64-native programs, written from scratch with QB64 in mind.
All that said, the new $NOPREFIX metacommand allows you, for the first time ever, to write QB64 programs without having to add the leading underscore to use the modern keywords.
That will allow code like this:
DO
_DISPLAY
_LIMIT 30
LOOP UNTIL _KEYHIT
To be written as:
$NOPREFIX
SCREEN NEWIMAGE(800, 600, 32)
COLOR RGB32(255), RGB32(255, 0, 255)
m$ = "Hello, world!"
PRINTSTRING ((WIDTH - PRINTWIDTH(m$)) \ 2, (HEIGHT - FONTHEIGHT) \ 2), m$
DO
DISPLAY
LIMIT 30
LOOP UNTIL KEYHIT
With the new metacommand in use, a program can both use _DISPLAY and DISPLAY, for example. User variables and procedures still cannot start with a single underscore (double underscores are accepted).
Here's the complete changelog for v1.4:
New features
All platforms
New $NOPREFIX metacommand.
New _DEFLATE$() and _INFLATE$() functions, that can be used to compress and decompress text or data strings using zlib, which has been added to our parts system.
New $ASSERTS metacommand and _ASSERT macro.
More bit-related functionality has been added: _READBIT, _SETBIT, _RESETBIT and _TOGGLEBIT.
You can now use _PUTIMAGE to place a portion of an image onto itself (source and destination can now be the same).
New $COLOR metacommand, which adds preset color constants based on HTML color names (per program).
Enhanced support for &B prefixed numbers, so the notation can now also be used in DATA lines and read by INPUT (from file & keyboard).
Windows
Enhancements to $CONSOLE: you can now use statements and functions you are already familiar with for SCREEN 0 but for console output. CSRLIN, POS(0), LOCATE, COLOR, _WIDTH, _HEIGHT, WIDTH (statement), CLS, SLEEP and END have all been reworked to deal with terminal output.
It is now possible to read input while working in $CONSOLE windows using _CONSOLEINPUT (for both keyboard and mouse support) and _CINP (to read individual key strokes).
You can now read the states of _CAPSLOCK, _NUMLOCK and _SCROLLLOCK keys, as well as set their states.
macOS
Basic detection of Retina displays has been implemented and programs should now render properly.
Fixes and improvements
All platforms
The warnings functionality can now be disabled (Options menu).
Numbers expressed in scientific notation now get properly colorized.
Enhanced "Open" and "Save as..." dialogs with added file list (save dialog) and support for wildcard filtering (* and ?).
Fixes a bug that would cause $INCLUDE lines to be duplicated in some scenarios.
Fixes a bug that wouldn't restore VIEW PRINT settings when RUN was called.
Linux
The IDE won't become unresponsive when the mouse pointer leaves the window anymore.
Windows
Fixes a bug that would prevent compilation when $EXEICON was used with $CHECKING:OFF set.
Fixed $VERSIONINFO so the embedded data gets properly displayed in newer versions of Windows.
Hello, this is my first post on the forum I think!
I got a Colour Maximite computer a few years ago, but didn't use it much until recently. I like the MMBASIC on it but there don't seem to be that many resources for learning it that I know of. Then I found out that MMBASIC is similar to QBASIC so I've been learning that for now instead. I'm interested in various types of BASIC, such as Locomotive BASIC on the Amstrad CPC, Atari BASIC on the Atari 8-bit computers... not a massive fan of Commodore 64 BASIC so far lol, although apparently it was designed to be more efficient, plus there are other forms of Commodore BASIC.
So anyway, I'm learning QBASIC mainly from this book at the moment: "A course in programming with QBASIC" by Tony Hawken. I'm mainly using QB45 via DOSBOX on a Linux PC.. hopefully I'm still welcome on this forum, come to think of it lol.
Hoping that posting here will help motivate me to learn BASIC quicker!
![[Image: screen1.jpg]](https://i.ibb.co/NjTH0x4/screen1.jpg)
[Search Fresh Prince of Bel Air for ref to text]. 
