It's officially 99.8 degrees F (38 C) outside right now with 55% humidity! While not uncommon to get this hot in Ohio it's the length of this heatwave that's unusual. I finally had to break down and turn the air conditioning on a bit ago. My computer was beginning to overheat.
(I know, it's been a while since the last extended KotD. I've been distracted with playing around with other stuffs and just hadn't gotten around to continuing on these. My apologies -- I haven't forgotten my pledge to count down all the way to highlight all the QB64PE now commands. I'm just lazy/busy/and distractable... )
Now this command is a very simple one, I think, to explain. Let's start with a link to the wiki for it:
And, as you can see, gosh darn it, there's a lot of differences in these two commands to go over!!
Why, one of them has a U in it, and the other doesn't!! /GASP!!
All joking aside, there really isn't any difference in how one would call, or use, these two commands, with the exception of that "U" being at the front of one. If you know how to use _FontHeight, then you know how to use _UFontHeight. They're more or less exactly the same *except*....
Remember the last few keywords that I mentioned that _UPRINTSTRING prints wider and taller characters?? *THIS* command will tell you how tall the characters are that it prints.
_FontHeight tells you how high a font is going to render characters if you use PRINT or _PRINTSTRING.
_UFontHeights tell you how high a font is going to render characters if you use _UPRINTSTRING.
That's honestly the only difference between these commands. Use this when you need the font height for use with _UPrintString. Otherwise, just ignore it and keep on doing whatever you've always been doing.
It's that simple of a command. I don't think anyone should ever have any issues with this one.
Attached is a 7z archive of some SVGs I made on my reMarkable 2 tablet. I want to see if anyone is capable of displaying them with the SVG loading in QB64. I've tried and failed.
_Title "Amazing rat B+ trans 2018-06-15"
'from SmallBASIC to QB64 version 2017 1106/82 (the day before they switched to version 1.2)
'2018-06-15 added more fun!
'rat runs whole maze.bas for SmallBASIC 0.12.6 [B+MGA] 2016-06-30
' mod of Chris maze gererator post
' Backtracking maze generator
' https://en.wikipedia.org/wiki/Maze_generation_algorithm
'
' - Starting from a random cell,
' - Selects a random neighbouring cell that has not been visited.
' - Remove the wall between the two cells and marks the new cell as visited,
' and adds it to the stack to facilitate backtracking.
' - Continues with a cell that has no unvisited neighbours being considered a dead-end.
' When at a dead-end it backtracks through the path until it reaches a cell with an
' unvisited neighbour, continuing the path generation by visiting this new,
' unvisited cell (creating a new junction).
' This process continues until every cell has been visited, backtracking all the
' way back to the beginning cell. We can be sure every cell is visited.
'
' model consts
Const W = 48
Const H = 28
Const margin = 25
Const border = margin / 2
Type cell
x As Integer
y As Integer
End Type
Dim Shared cellW
cellW = (xmax - margin) / W
Dim Shared cellH
cellH = (ymax - margin) / H
Dim Shared h_walls(W, H)
Dim Shared v_walls(W, H)
Dim Shared pi
pi = _Pi
' What's a maze without a little white mouse
Randomize Timer
init_walls
generate_maze
rX = 0: rY = 0: rd = 180
Dim trail As cell
ti = 0
cheese = 0
chx = Int(Rnd * (W - 1)) + 1
chy = Int(Rnd * (H - 1)) + 1
While 1
'maze board
Color _RGB32(155, 75, 32)
recf 0, 0, xmax, ymax
show_maze
'add to trail
ti = ti + 1
ReDim _Preserve trail(ti) As cell
trail(ti).x = border + (rX + .5) * cellW
trail(ti).y = border + (rY + .5) * cellH
'bread crumbs or whatever...
Color _RGBA(8, 4, 2, 40)
For i = 1 To ti
fcirc trail(i).x, trail(i).y, 2
Next
'mouse find the cheese?
If rX = chx And rY = chy Then
cheese = cheese + 1
chx = Int(Rnd * (W - 1)) + 1
chy = Int(Rnd * (H - 1)) + 1
ti = 0
ReDim trail(ti) As cell
_Delay 1
End If
_Display
_Delay .2
'setup next move
Select Case rd
Case 0
If h_walls(rX, rY + 1) = 0 Then
rY = rY + 1: rd = 90
ElseIf v_walls(rX + 1, rY) = 0 Then
rX = rX + 1
ElseIf h_walls(rX, rY) = 0 Then
rY = rY - 1: rd = 270
Else
rX = rX - 1: rd = 180
End If
Case 90
If v_walls(rX, rY) = 0 Then
rX = rX - 1: rd = 180
ElseIf h_walls(rX, rY + 1) = 0 Then
rY = rY + 1
ElseIf v_walls(rX + 1, rY) = 0 Then
rX = rX + 1: rd = 0
Else
rY = rY - 1: rd = 270
End If
Case 180
If h_walls(rX, rY) = 0 Then
rY = rY - 1: rd = 270
ElseIf v_walls(rX, rY) = 0 Then
rX = rX - 1
ElseIf h_walls(rX, rY + 1) = 0 Then
rY = rY + 1: rd = 90
Else
rX = rX + 1: rd = 0
End If
Case 270
If v_walls(rX + 1, rY) = 0 Then
rX = rX + 1: rd = 0
ElseIf h_walls(rX, rY) = 0 Then
rY = rY - 1
ElseIf v_walls(rX, rY) = 0 Then
rX = rX - 1: rd = 180
Else
rY = rY + 1: rd = 90
End If
End Select
Wend
Sub init_walls ()
For x = 0 To W
For y = 0 To H
v_walls(x, y) = 1
h_walls(x, y) = 1
Next
Next
End Sub
Sub show_maze ()
Color _RGB32(180, 90, 45)
'cls
py = border
For y = 0 To H
px = border
For x = 0 To W
If x < W And h_walls(x, y) = 1 Then
recf px, py, px + cellW, py + 2
End If
If y < H And v_walls(x, y) = 1 Then
recf px, py, px + 2, py + cellH
End If
px = px + cellW
Next
py = py + cellH
Next
End Sub
Sub rand_cell (rWx, rHy)
rWx = Int(Rnd * 1000) Mod W
rHy = Int(Rnd * 1000) Mod H
End Sub
Sub get_unvisited (visited(), current As cell, unvisited() As cell, uvi)
'local n
ReDim unvisited(0) As cell
x = current.x
y = current.y
uvi = 0
If x > 0 Then
If visited(x - 1, y) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x - 1
unvisited(uvi).y = y
End If
End If
If x < W - 1 Then
If visited(x + 1, y) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x + 1
unvisited(uvi).y = y
End If
End If
If y > 0 Then
If visited(x, y - 1) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x
unvisited(uvi).y = y - 1
End If
End If
If y < H - 1 Then
If visited(x, y + 1) = 0 Then
uvi = uvi + 1
ReDim _Preserve unvisited(uvi) As cell
unvisited(uvi).x = x
unvisited(uvi).y = y + 1
End If
End If
End Sub
Sub generate_maze ()
'local curr_cell, next_cell, num_visited, num_cells, visited, stack, cells
'local x, y
Dim visited(W, H)
ReDim stack(0) As cell
Dim curr_cell As cell
Dim next_cell As cell
rand_cell cur_cell.x, cur_cell.y
visited(curr_cell.x, curr_cell.y) = 1
num_visited = 1
num_cells = W * H
si = 0
While num_visited < num_cells
ReDim cells(0) As cell
cnt = 0
get_unvisited visited(), curr_cell, cells(), cnt
If cnt > 0 Then
' choose randomly one of the current cell's unvisited neighbours
rc = Int(Rnd * 100) Mod cnt + 1
next_cell.x = cells(rc).x
next_cell.y = cells(rc).y
' push the current cell to the stack
si = si + 1
ReDim _Preserve stack(si) As cell
stack(si).x = curr_cell.x
stack(si).y = curr_cell.y
' remove the wall between the current cell and the chosen cell
If next_cell.x = curr_cell.x Then
x = next_cell.x
y = max(next_cell.y, curr_cell.y)
h_walls(x, y) = 0
Else
x = max(next_cell.x, curr_cell.x)
y = next_cell.y
v_walls(x, y) = 0
End If
' make the chosen cell the current cell and mark it as visited
curr_cell.x = next_cell.x
curr_cell.y = next_cell.y
visited(curr_cell.x, curr_cell.y) = 1
num_visited = num_visited + 1
ElseIf si > 0 Then
' pop a cell from the stack and make it the current cell
curr_cell.x = stack(si).x
curr_cell.y = stack(si).y
si = si - 1
ReDim _Preserve stack(si) As cell
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), , BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End Sub
' found at QB64.net: http://www.qb64.net/forum/index.php?topic=14425.0
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest 0
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage a& '<<< this is important!
End Sub
Sub ln (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2)
End Sub
Sub rec (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2), , B
End Sub
Sub recf (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2), , BF
End Sub
Function max (a, b)
If a > b Then max = a Else max = b
End Function
Function min (a, b)
If a > b Then min = b Else min = a
End Function
Function rad (a)
rad = a * pi / 180
End Function
when this rat finally finds the cheese it grows bigger and heads out again for another bite
'test wordwrap with some ascii code 'the first character would normally be part of a 2-byte utf-8 code, which is why it's here for testing WordWrap"Àabc123 1234567890.1234567890 123457890 1234567890 1234567890 abc123 1234567890.1234567890 123457890 1234567890 1234567890 abc123 1234567890.1234567890 123457890 1234567890 1234567890 ", 0
SUBWordWrap (text$, format ASLONG) SELECT CASE format CASE0, 8, 16, 32 CASEELSE _MESSAGEBOX"Invalid Format", "Invalid format sent to WordWrap.", "error" EXIT SUB END SELECT
temp$ = text$
w = _WIDTH: h = _HEIGHT
y = (CSRLIN - 1) IF_FONTWIDTHTHEN'monospace font
x = (POS(0) - 1) * _FONTWIDTH ELSE'variable width font
x = POS(0) END IF
wMAx = w - x 'the most width that we have left on this line to print to DO
l = LEN(temp$)
pw = _UPRINTWIDTH(temp$, format) IF pw < wMAx THEN'if the printwidth is smaller than the available width on the line, print it _UPRINTSTRING (x, y * _UFONTHEIGHT), temp$, , format
x = 0: y = y + 1 LOCATE y + 1, 1 EXIT DO ELSE'we determine how much we can print, and print what we can in the available space
cp = 1: bp = 0
t$ = "" DO
a = ASC(temp$, cp) SELECT CASE format CASE0'ASCII
length = 1 CASE8'UTF-8 SELECT CASE a CASE0TO127: length = 1 CASE128TO191: length = 2 CASE192TO223: length = 2 CASE224TO239: length = 3 CASE240TO248: length = 4 CASE252, 253: length = 5 CASEELSE: length = 1'we should never see these. Use alt text here END SELECT CASE16'UTF-16
length = 2'not fully true, but we'll come back to this later CASE32'UTF-32
length = 4 END SELECT
t$ = t$ + MID$(temp$, cp, length) IF_UPRINTWIDTH(t$, format) > wMAx THEN
t$ = LEFT$(temp$, bp) 'back up to the last breakpoint
temp$ = MID$(temp$, bp + 1) 'remove what we print from the string _UPRINTSTRING (x, y * _UFONTHEIGHT), t$, , format 'print what we remove
x = 0: y = y + 1'update the print position LOCATE y + 1, 1 EXIT DO ELSE SELECT CASE a 'valid breakpoints CASE10'chr$(10) line ending CASE32: bp = cp 'space CASE46: bp = cp 'period . CASE44: bp = cp 'comma , CASE45: bp = cp 'dash - CASE33: bp = cp 'exclaimation point ! CASE63: bp = cp 'question mark ? CASE59: bp = cp 'semi-colon ; END SELECT
cp = cp + length END IF LOOP
Note that this doesn't do page scrolling or such yet, but it *does* do word wrap and proper character displaying for utf-8 endcoded text!
For me, personally, this is a huge step forward so that I can eventually add full unicode support to my own programs. My _Keyhit library has allowed us to get unicode values from keypresses for ages now. I just haven't had a good means to display those characters and wordwrap them and such. This is the next step to doing just that.
Eventually, I'll have a set of libraries which will give me full unicode support. No need for CodePages and a 256 character limit like ASCII has. I'll be able to do everything with all the characters that unicode (and my chosen font) can support!
Trying to make a glow/spotlight effect where only the circle area of the screen where the mouse is at shows. This works but it lags pretty bad on my laptop. The circle draws are the slow down. Is there a better way to do this effect? I remember someone at the old forum posted an effect like this, but I forget who it was.
- Dav
Code: (Select All)
Screen _NewImage(1000, 700, 32)
'draw a background
For x = 0 To _Width Step 25
For y = 0 To _Height Step 25
Line (x, y)-Step(25, 25), _RGBA(Rnd * 255, Rnd * 255, Rnd * 255, 150), BF
Next
Next
'copy screen as image
back& = _CopyImage(_Display)
Do
'get mouse input
While _MouseInput: Wend
mx = _MouseX: my = _MouseY
'place background first
_PutImage (0, 0), back&
'draw fadeout circle where mouse x/y is
For x = 0 To _Height * 2 Step .333
Circle (mx, my), x, _RGBA(0, 0, 0, x / 1.9)
Next
btw: I have rewritten SuperTrek into Strek9x for QB64.
Which is compatible with QB11, QB45, and QB71.
Version history:
Code: (Select All)
Version history of Strek9x 09/01/2024 PD for QB64.
New version v1.0a
Includes Romulans and a Vulcan starbase.
New version v2.0a
And function softkeys and row 24 statusline.
Now prompts for Captains name.
New version v3.0a
Adds several new commands.
Including BUY/PUR/RND/TOP.
New version v4.0a includes
All text prints lowercased.
Adds color statements to all prints.
Adds Executive command.
Adds Top Ten Captain datafile.
New version v5.0a includes
Adds Save/Load current game.
Moves instructions to textfile.
Adds Ferengi Starbase.
Adds debris to destroyed ship.
Now 1370 lines.
Code: (Select All)
Additional commands for QB64:
FIX (Repair All Devcies)
Attempts to repair all damaged devices. Costs 100 energy units.
This failsafe function is also called when all devices damaged.
INC (Increment Device)
Prompts to increase status of any device.
Costs 10 energy units per device.
PHO (Star Destroyer Torpedo)
Fires a star destoyer torpedo.
This torpedo also obliterates stars.
If all stars in a quadrant are destroyed then the Captain
will be found unfit for duty and the game will quit.
GEN (Genesis Device)
Initiates the star creator Gensis Device.
This creates a star. When the star is formed all enemies in the quadrant
will be vaporized and the starship hit for 50 shield points.
LOC (Starbase Locate)
Lists all Starbase coordinates in the galaxy.
DIS (Display Klingons/Romulans)
Lists all klingon and romulan coordinates in the Galaxy.
SEA (Searchs Galaxy)
Prompts for Quadrant values to search in Galaxy.
RAT (Display Current Rating)
Displays the Captains current effeceincy rating.
BUY (Buy Star Photonic Device)
Purchases a star photonic destroyer device at a vulcan starbase.
Costs 100 credits.
PUR (Purchase Energy)
Purchases 100 energy points at a vulcan starbase.
Costs 100 credits.
RND (Random Course)
Moves the Enterprise in a random direction at a random warp factor.
LST (List Staff)
Lists all 10 Enterprise staff crew.
EXE (Executive Command)
Uses executive order to destroy ships in all nearby quadrants.
Reduces ship energy by 1000 units.
TOP (Top 10 Report)
Displays top 10 scores from most recent Captains.
SAV (Save Current Game)
Prompts for and saves current game.
LOA (Load Game Number)
Prompts for and loads a saved game.
QUIT (Exits Current Game)
Exits game and prompts to restart.
INIT (Initializes Top 10)
Deletes and restarts Top 10 datafile.
SAVE/LOAD (Save or Load a Game)
Also allows <n> after command.
![[Image: icon-ghost.gif]](https://i.ibb.co/z7YH9zF/icon-ghost.gif){kind=icon}
)
![[Image: bcg-cover.jpg]](https://i.ibb.co/0swbnjS/bcg-cover.jpg)
