| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 748
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 29
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 28
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 1,888
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,197
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 309
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 118
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,319
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 235
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 139
|
|
|
| Trying to figure algorithm to draw and paint polygons |
|
Posted by: CharlieJV - 08-13-2023, 05:43 PM - Forum: General Discussion
- Replies (11)
|
 |
My preoccupation at the moment is trying to pinpoint an X,Y position to get anywhere within a polygon to paint its innards.
I'm wondering, am I heading in the right direction with this prototyping code:
Code: (Select All) PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1) : PaintX = POINT(0) : PaintY = POINT(1)
LINE - STEP (20,15),14
PaintX = (PaintX + POINT(0) ) / 2
PaintY = (PaintY + POINT(1) ) / 2
LINE - STEP (-10,15),14
PaintX = ( PaintX + POINT(0) ) / 2
PaintY = ( PaintY + POINT(1) ) / 2
LINE - STEP (-10,-10),14
PaintX = ( PaintX + POINT(0) ) / 2
PaintY = ( PaintY + POINT(1) ) / 2
LINE - (AreaStartX, AreaStartY), 14
PaintX = ( PaintX + POINT(0) ) / 2
PaintY = ( PaintY + POINT(1) ) / 2
PRINT PaintX, PaintY
PAINT (PaintX, PaintY), 1, 14
EDIT 1: Had a bunch of unnecessary INT instances in there and yanked them out.
EDIT 2: Had a bunch of unnecessary ABS instances in there and yanked them out too.
|
|
|
| OmniPeg |
|
Posted by: PhilOfPerth - 08-13-2023, 12:57 AM - Forum: Programs
- Replies (2)
|
 |
Here is my version of the Peg Solitaire game, which has a couple of twists to the original.
Coding is not economized, and could be probably halved by some members (?), but it works.
Code: (Select All) Screen _NewImage(1024, 820, 32)
SetFont: f& = _LoadFont("C:\WINDOWS\fonts\courbd.ttf", 24, "monospace") ' 31 rows, 73 columns text, allows chr$(95)
_Font f&
dw = _DesktopWidth: dh = _DesktopHeight
lhs = (dw - 1024) / 2: top = 100
_ScreenMove lhs, top ' centre display horiz on screen, down 100
Common Shared board$(), cell$, v, h, pick$, bad$, Mode, score
Dim board$(7, 7)
pick$ = "o2l32dg": ok$ = "l32o2cego3c": bad$ = "l32o2co1bagfedc"
Intro:
yellow
Locate 4, 30: Print "Peg Solitaire": white
Locate 7, 1
Print " A board of 49 cells is displayed, with 48 of these occupied by pegs."
Print " Try to remove all pegs (except one) by jumping another peg over them."
Print " Jumps may be in any direction (but see ";: yellow: Print "Modes";: white: Print " below), over a single"
Print " peg, and the landing cell must be vacant."
Print
Print " Enter each jump as a ";: yellow: Print "FROM";: white: Print ", then a";
yellow: Print " TO";: white: Print " row and column e.g. A3, then C5."
Print " Each move must jump 2 cells, over an existing ";: yellow: Print "REMOVE";: white: Print " peg."
Print
Print " The FROM and REMOVE cells must be occupied, and the ";: yellow: Print "TO";: white: Print " cell must be"
Print " empty, otherwise the move is rejected."
Print
Print " If legal, the REMOVE cell is cleared, and the action can be repeated"
Print " until no more jumps are possible."
Print
Print " There are 3 ";: yellow: Print "Modes";: white: Print " of play, each with different directions for jumps:"
Print " 1: Jump in any direction 2: Hor and Vert only 3: Diagonal only."
Print Tab(12); "(Mode 1 is a simple version, mostly for children)."
yellow: Print: Print Tab(24); " Which Mode would you like?"
GetMode:
k$ = InKey$
If k$ = "" Then GoTo GetMode
If k$ <= "1" Or k$ > "3" Then Mode = 1 Else Mode = Val(k$)
Cls
drawgrid
Locate 2, 32: Print "Mode"; Mode
GetFrom:
_KeyClear
Locate 26, 32: Print "Score:"; score
WIPE "2829": Play pick$
white: Locate 28, 24: Print "Input ";: yellow: Print "FROM";: white: Print " as VH (e.g. A3)"
Print Tab(30); "or Q to quit"
Locate 28, 50: Input cell$
cell$ = UCase$(cell$)
If cell$ = "Q" Then Finish
v = Asc(Left$(cell$, 1)) - 64: h = Val(Right$(cell$, 1))
CheckFROM:
If Len(cell$) <> 2 Or Left$(cell$, 1) < "A" Or Left$(cell$, 1) > "G" Or Val(Right$(cell$, 1)) < 1 Or Val(Right$(cell$, 1)) > 7 Then
fromfailed:
WIPE "28": Locate 28, 13: red: Print "FROM must be entered as VH (vert and horiz) e.g. A3"
Play bad$: yellow: Sleep 1: WIPE "28": GoTo GetFrom
Else
fromv = Asc(Left$(cell$, 1)) - 64: fromh = Val(Right$(cell$, 1))
End If
FROMcontent:
If board$(fromv, fromh) = " " Then
WIPE "28": Locate 28, 27: red: Print "That cell is empty"
Play bad$: yellow: Sleep 1: WIPE "28": GoTo GetFrom
End If
AcceptFROM: ' FROM meets specs
red: Locate 8 + (fromv - 1) * 2, 27 + (fromh - 1) * 3: Print Chr$(249): yellow
WIPE "24"
white: Locate 24, 33: Print cell$; " -"
GetTO:
WIPE "28": Play pick$
Locate 28, 25: Print "Input ";: yellow: Print "TO";: white: Print " as VH (e.g. A3)"; Tab(21); "(or <Space> to restart this move)"
Locate 28, 49: Input cell$
cell$ = UCase$(cell$)
Locate 24, 38: Print cell$
Restart: ' player pressed <Space> to restart their move
If cell$ = " " Then
yellow: Locate 8 + (fromv - 1) * 2, 27 + (fromh - 1) * 3: Print "*"
board$(fromv, fromh) = "*"
Play bad$: yellow: Sleep 1: WIPE "2428": GoTo GetFrom
End If
v = Asc(Left$(cell$, 1)) - 64: h = Val(Right$(cell$, 1))
tov = v: toh = h ' we have fromh, fromv, toh and tov to identify middle cell
CheckTOchars:
If Len(cell$) <> 2 Or Left$(cell$, 1) < "A" Or Left$(cell$, 1) > "H" Or Right$(cell$, 1) < "1" Or Right$(cell$, 1) > "8" Then
WIPE "28": Locate 28, 13: red: Print "TO must be entered as vh (vert and horiz) e.g. C5"
Play bad$: yellow: Sleep 1: WIPE "28": Locate 24, 38: Print " ": GoTo GetTO
End If
CheckJump:
Select Case Mode
Case 1 ' children
fail = 0
If Abs(fromv - tov) = 2 And (Abs(fromh - toh) <> 2 And Abs(fromh - toh) <> 0) Then fail = 1
If fromv - tov = 0 And Abs(fromh - toh) <> 2 Then fail = 1
If fail = 1 Then
WIPE "28": Locate 28, 22: red: Print "Jump must be exactly 2 cells"
Play bad$: yellow: Sleep 1: WIPE "28": Locate 24, 38: Print " ": GoTo GetTO
End If
Case 2 ' horiz and vert
fail = 0
If ((Abs(fromv - tov) = 2 And Abs(fromh - toh) <> 0)) Or ((Abs(fromv - tov) = 2 And Abs(fromh - toh) <> 0)) Then
WIPE "28": Locate 28, 14: red: Print "Jump must be 2 cells, vertically or horizontally"
Play bad$: yellow: Sleep 1: WIPE "28": Locate 24, 38: Print " ": GoTo GetTO
End If
Case 3 ' diag
fail = 0
If Abs(fromv - tov) <> 2 Or Abs(fromh - toh) <> 2 Then fail = 1
If fail = 1 Then
WIPE "28": Locate 28, 20: red: Print "Jump must be 2 cells, diagonally"
Play bad$: yellow: Sleep 1: WIPE "28": Locate 24, 38: Print " ": GoTo GetTO
End If
End Select
CheckMiddleCell:
If fromv < tov Then midlv = fromv + 1
If fromv = tov Then midlv = fromv
If fromv > tov Then midlv = fromv - 1
If fromh < toh Then midlh = fromh + 1
If fromh = toh Then midlh = fromh
If fromh > toh Then midlh = fromh - 1
If board$(midlv, midlh) <> "*" Then
WIPE "28": Locate 28, 25: red: Print "The jumped cell is not occupied"
Play bad$: yellow: Sleep 1: WIPE "28": Locate 24, 38: Print " ": GoTo GetTO
End If
TOcontent:
If oard$(tov, toh) = "*" Then
WIPE "28": Locate 28, 25: red: Print "That cell is occupied"
Play bad$: yellow: Sleep 1: WIPE "28": Locate 24, 38: Print " ": GoTo GetTO
Else
ShowMove:
yellow
Locate 8 + (tov - 1) * 2, 27 + (toh - 1) * 3: Print "*"
Locate 8 + (fromv - 1) * 2, 27 + (fromh - 1) * 3: red: Print " "
Locate 8 + (midlv - 1) * 2, 27 + (midlh - 1) * 3: red: Print " "
ChangeBoard:
board$(fromv, fromh) = " ": board$(tov, toh) = "*": board$(midlv, midlh) = " "
score = score + 1
WIPE "24"
GoTo GetFrom
End If
Sub drawgrid
white
'labels
Locate 6, 27: Print "1 2 3 4 5 6 7"
For a = 1 To 7
Locate 6 + a * 2, 24
Print Chr$(64 + a)
Next
' all pegs
yellow
For a = 1 To 7
For b = 1 To 7
board$(a, b) = "*"
Locate a * 2 + 6, b * 3 + 24
Print "*"
Next
Next
'centre hole
red: Locate 14, 36: Print Chr$(249)
board$(4, 4) = " "
'draw frame
yellow
top = 160
For a = 0 To 6
PSet (355, top + a * 48)
For b = 1 To 7 ' row of 7 boxes
Draw "r30d33l30u33bm+42,0"
Next
Next
End Sub
Sub Finish
Cls
Locate 15, 18: Print "You scored"; score; "points, from a possible 47."
Sleep
System
End Sub
Sub red
Color _RGB(255, 0, 0)
End Sub
Sub yellow
Color _RGB(255, 255, 0)
End Sub
Sub white
Color _RGB(255, 255, 255)
End Sub
Sub WIPE (ln$) ' call with string of 2-digit line numbers only eg "0122" for lines 1 and 23
For a = 1 To Len(ln$) - 1 Step 2
Locate Val(Mid$(ln$, a, 2))
Print Space$(73)
Next
End Sub
|
|
|
|
| Filled Triangle for BAM? |
|
Posted by: bplus - 08-12-2023, 09:15 PM - Forum: QBJS, BAM, and Other BASICs
- Replies (3)
|
 |
Charlie I have some code for a Triangle Fill that I picked up from Andy Amaya at Just Basic Forum.
I've used it with SmallBASIC and I think it would be really handy for BAM if you don't have anything like that. QB64 has the _MapTriangle method so not really needed in that?
Your Area question reminded me of that and filling a polygon without Paint keyword.
|
|
|
|
| A 'retro' BASIC 'system' |
|
Posted by: Michelle - 08-12-2023, 08:52 PM - Forum: Works in Progress
- Replies (11)
|
 |
Well, awhile back, I got a wild hair. And well, that hair got me to building an old Z-80 CP/M machine, starting on a second one, and buying an old IBM PS/2 8560. Why you are probably asking... Other than, 'I can', I have no idea. Anyway, the 8560 (80286) is running DOS and I'm setting it up as a file-server via RS-232 to the two Z-80 CP/M machines. I have been writing a bunch of Z-80 assembly code for the CP/M machines to talk to the 8560. I'm writing the file-server code in good 'ol BASIC. Archaic as hell I know, but it is a good challenge....
One thing that does have me sorta stumped is how to have the file-server code 'poll' the open comm ports (old 16bit BASIC only supports two of them), to see if a command has come in. If there is nothing pending, then go to check the next one. Kind of like INKEY$ for a comm port. Of course, I'd love it if there was a 16 bit version of QB64 Phoenix.  Anyway, Michelle
|
|
|
|
| AmigaBASIC to QB64pe question out of left field |
|
Posted by: CharlieJV - 08-12-2023, 05:09 AM - Forum: General Discussion
- Replies (10)
|
|
I somehow manage to lose my evening by getting transfixed on AmigaBASIC's "AREA" statement.
Anybody have enough AmigaBASIC experience to let me know if I have it straight in my head what AREA does and how it would be translated to QB64pe?
Here's my guess on a couple samples:
Code: (Select All) <<AREA "(25,10) - (50,20) - (0,20)">>
PSET (25,10) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LINE - (50,20)
LINE - (0,20)
LINE - (AreaStartX, AreaStartY)
<<AREA "(50,25) - STEP (20,15) - STEP (-10,15) - STEP (-10,-10)">>
PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LINE - STEP (20,15)
LINE - STEP (-10,15)
LINE - STEP (-10,-10)
LINE - (AreaStartX, AreaStartY)
I did some shorthand there. In AmigaBASIC, the first example would look like
Code: (Select All) AREA (25,10)
AREA (50,20)
AREA ( 0,20)
AREAFILL 0
The AreaStartX and AreaStartY stuff, that's in case the first set of coordinates are prefixed by STEP.
|
|
|
|
Simple Regex matching |
|
Posted by: RhoSigma - 08-11-2023, 08:31 AM - Forum: RhoSigma
- Replies (2)
|
 |
A simple wrapper for the standard library regex_match() function. Save all files into the QB64pe folder to test.
qbregex.h
Code: (Select All) //====================================================================
//=== Regular Expressions support ====================================
//====================================================================
#include <regex>
// Check whether the given string does match the given regular expression.
// The regex must match entirely to be true (ie. without any additional
// characters before or after the match), hence the use of ^ or $ for
// line start or line end respectively is not required/supported.
// In: string, regex (both STRINGs, add CHR$(0) to end of strings)
// Out: match (INTEGER, 0 = no match, 1 = positive match)
// Err: out < 0 (call RegexError() to get the error message)
//--------------------------------------------------------------------
int16_t RegexMatch(const char *qbStr, const char *qbRegex) {
int16_t result;
try {result = regex_match(qbStr, std::regex(qbRegex));}
catch (const std::regex_error& e) {result = ~e.code();}
return result;
}
// Return a detailed error description message for any negative error code,
// which might be returned by the RegexMatch() function.
// In: error code (INTEGER, usually the code returned by RegexMatch())
// Out: error text (STRING, description for the given error code)
//--------------------------------------------------------------------
const char *RegexError(int16_t errCode) {
switch (~errCode) {
// just in case somebody pass in the regular matching result as error
case -2: {return "No error, it was a positive RegEx match."; break;}
case -1: {return "No error, the RegEx just didn't match."; break;}
// and now the real errors known to the regex library
case std::regex_constants::error_collate: {return "RegEx has an invalid collating element name."; break;}
case std::regex_constants::error_ctype: {return "RegEx has an invalid character class name."; break;}
case std::regex_constants::error_escape: {return "RegEx has an invalid escaped character, or a trailing escape."; break;}
case std::regex_constants::error_backref: {return "RegEx has an invalid back reference."; break;}
case std::regex_constants::error_brack: {return "RegEx has mismatched brackets [ and ]."; break;}
case std::regex_constants::error_paren: {return "RegEx has mismatched parentheses ( and )."; break;}
case std::regex_constants::error_brace: {return "RegEx has mismatched braces { and }."; break;}
case std::regex_constants::error_badbrace: {return "RegEx has an invalid range between braces { and }."; break;}
case std::regex_constants::error_range: {return "RegEx has an invalid character range."; break;}
case std::regex_constants::error_space: {return "Out of memory while converting RegEx into a finite state machine."; break;}
case std::regex_constants::error_badrepeat: {return "RegEx has a repeat specifier, one of *?+{, that was not preceded by a valid token."; break;}
case std::regex_constants::error_complexity: {return "Complexity of an attempted match exceeded a pre-set level."; break;}
case std::regex_constants::error_stack: {return "Out of memory while trying to match the specified string."; break;}
// everything else is unknown
default: {return "Unknown RegEx error."; break;}
}
}
qbregex.bi
Code: (Select All)
DECLARE LIBRARY "qbregex" 'Do not add .h here !!
FUNCTION RegexMatch% (qbStr$, qbRegex$) 'add CHR$(0) to both
FUNCTION RegexError$ (BYVAL errCode%)
END DECLARE
RE-Test.bas
Code: (Select All)
'$INCLUDE: 'qbregex.bi'
PRINT "Type a short phrase with your or others username in it: "
LINE INPUT "Phrase: "; phrase$
PRINT
'remove one open or close parantheses to check error part
you$ = "(.*)grymmjack(.*)"
res% = RegexMatch%(UCASE$(phrase$) + CHR$(0), UCASE$(you$) + CHR$(0)) 'match ignoring case
IF res% > 0 THEN
PRINT "Hey, must be you, grymmjack."
ELSEIF res% = 0 THEN
PRINT "Hello unknown user."
ELSE
PRINT "Error: "; RegexError$(res%)
END IF
END
|
|
|
|
|
Maybe it needs a new job. . .![[Image: Neun-Punkte.jpg]](https://i.ibb.co/C8z4gKr/Neun-Punkte.jpg)
