| 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: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
| Math Evaluator |
|
Posted by: SMcNeill - 12-11-2022, 08:06 PM - Forum: SMcNeill
- Replies (2)
|
 |
I was going to point someone to my math evaluator in a different post, to showcase our math order of operations, and after searching the forums, I couldn't find it. GASP!!
I guess this little routine was over at the old forums and was just one that I forgot to move over, when things went belly up and burnt down. My apologies.
Enjoy guys, and feel free to make use of the code within in any of your projects that you might want -- it's a pretty comprehensive math evaluation routine. Pass it a string full of math stuff, get back the answer to it. It's really that simple.
Code: (Select All) ReDim Shared OName(0) As String 'Operation Name
ReDim Shared PL(0) As Integer 'Priority Level
Dim Shared QuickReturn As Integer
Set_OrderOfOperations 'This will also make certain our directories are valid, and if not make them.
Do
Input math$
Print Evaluate_Expression(math$)
Loop
'Steve Subs/Functins for _MATH support with CONST
Function Evaluate_Expression$ (e$)
t$ = e$ 'So we preserve our original data, we parse a temp copy of it
b = InStr(UCase$(e$), "EQL") 'take out assignment before the preparser sees it
If b Then t$ = Mid$(e$, b + 3): var$ = UCase$(LTrim$(RTrim$(Mid$(e$, 1, b - 1))))
QuickReturn = 0
PreParse t$
If QuickReturn Then Evaluate_Expression$ = t$: Exit Function
If Left$(t$, 5) = "ERROR" Then Evaluate_Expression$ = t$: Exit Function
'Deal with brackets first
exp$ = "(" + t$ + ")" 'Starting and finishing brackets for our parse routine.
Do
Eval_E = InStr(exp$, ")")
If Eval_E > 0 Then
c = 0
Do Until Eval_E - c <= 0
c = c + 1
If Eval_E Then
If Mid$(exp$, Eval_E - c, 1) = "(" Then Exit Do
End If
Loop
s = Eval_E - c + 1
If s < 1 Then Print "ERROR -- BAD () Count": End
eval$ = " " + Mid$(exp$, s, Eval_E - s) + " " 'pad with a space before and after so the parser can pick up the values properly.
ParseExpression eval$
eval$ = LTrim$(RTrim$(eval$))
If Left$(eval$, 5) = "ERROR" Then Evaluate_Expression$ = eval$: Exit Function
exp$ = DWD(Left$(exp$, s - 2) + eval$ + Mid$(exp$, Eval_E + 1))
If Mid$(exp$, 1, 1) = "N" Then Mid$(exp$, 1) = "-"
temppp$ = DWD(Left$(exp$, s - 2) + " ## " + eval$ + " ## " + Mid$(exp$, E + 1))
End If
Loop Until Eval_E = 0
c = 0
Do
c = c + 1
Select Case Mid$(exp$, c, 1)
Case "0" To "9", ".", "-" 'At this point, we should only have number values left.
Case Else: Evaluate_Expression$ = "ERROR - Unknown Diagnosis: (" + exp$ + ") ": Exit Function
End Select
Loop Until c >= Len(exp$)
Evaluate_Expression$ = exp$
End Function
Sub ParseExpression (exp$)
Dim num(10) As String
'We should now have an expression with no () to deal with
If Mid$(exp$, 2, 1) = "-" Then exp$ = "0+" + Mid$(exp$, 2)
For J = 1 To 250
lowest = 0
Do Until lowest = Len(exp$)
lowest = Len(exp$): OpOn = 0
For P = 1 To UBound(OName)
'Look for first valid operator
If J = PL(P) Then 'Priority levels match
If Left$(exp$, 1) = "-" Then op = InStr(2, exp$, OName(P)) Else op = InStr(exp$, OName(P))
If op > 0 And op < lowest Then lowest = op: OpOn = P
End If
Next
If OpOn = 0 Then Exit Do 'We haven't gotten to the proper PL for this OP to be processed yet.
If Left$(exp$, 1) = "-" Then op = InStr(2, exp$, OName(OpOn)) Else op = InStr(exp$, OName(OpOn))
numset = 0
'*** SPECIAL OPERATION RULESETS
If OName(OpOn) = "-" Then 'check for BOOLEAN operators before the -
Select Case Mid$(exp$, op - 3, 3)
Case "NOT", "XOR", "AND", "EQV", "IMP"
Exit Do 'Not an operator, it's a negative
End Select
If Mid$(exp$, op - 3, 2) = "OR" Then Exit Do 'Not an operator, it's a negative
End If
If op Then
c = Len(OName(OpOn)) - 1
Do
Select Case Mid$(exp$, op + c + 1, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N": numset = -1 'Valid digit
Case "-" 'We need to check if it's a minus or a negative
If OName(OpOn) = "_PI" Or numset Then Exit Do
Case Else 'Not a valid digit, we found our separator
Exit Do
End Select
c = c + 1
Loop Until op + c >= Len(exp$)
E = op + c
c = 0
Do
c = c + 1
Select Case Mid$(exp$, op - c, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", "N" 'Valid digit
Case "-" 'We need to check if it's a minus or a negative
c1 = c
bad = 0
Do
c1 = c1 + 1
Select Case Mid$(exp$, op - c1, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "."
bad = -1
Exit Do 'It's a minus sign
Case Else
'It's a negative sign and needs to count as part of our numbers
End Select
Loop Until op - c1 <= 0
If bad Then Exit Do 'We found our seperator
Case Else 'Not a valid digit, we found our separator
Exit Do
End Select
Loop Until op - c <= 0
s = op - c
num(1) = Mid$(exp$, s + 1, op - s - 1) 'Get our first number
num(2) = Mid$(exp$, op + Len(OName(OpOn)), E - op - Len(OName(OpOn)) + 1) 'Get our second number
If Mid$(num(1), 1, 1) = "N" Then Mid$(num(1), 1) = "-"
If Mid$(num(2), 1, 1) = "N" Then Mid$(num(2), 1) = "-"
num(3) = EvaluateNumbers(OpOn, num())
If Mid$(num(3), 1, 1) = "-" Then Mid$(num(3), 1) = "N"
'PRINT "*************"
'PRINT num(1), OName(OpOn), num(2), num(3), exp$
If Left$(num(3), 5) = "ERROR" Then exp$ = num(3): Exit Sub
exp$ = LTrim$(N2S(DWD(Left$(exp$, s) + RTrim$(LTrim$(num(3))) + Mid$(exp$, E + 1))))
'PRINT exp$
End If
op = 0
Loop
Next
End Sub
Sub Set_OrderOfOperations
'PL sets our priortity level. 1 is highest to 65535 for the lowest.
'I used a range here so I could add in new priority levels as needed.
'OName ended up becoming the name of our commands, as I modified things.... Go figure! LOL!
'Constants get evaluated first, with a Priority Level of 1
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_PI"
ReDim _Preserve PL(i): PL(i) = 1
'I'm not certain where exactly percentages should go. They kind of seem like a special case to me. COS10% should be COS.1 I'd think...
'I'm putting it here for now, and if anyone knows someplace better for it in our order of operations, let me know.
i = i + 1: ReDim _Preserve OName(i): OName(i) = "%"
ReDim _Preserve PL(i): PL(i) = 5
'Then Functions with PL 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ACOS"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ASIN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ARCSEC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ARCCSC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ARCCOT"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_SECH"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_CSCH"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_COTH"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "COS"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "SIN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "TAN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "LOG"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "EXP"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ATN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_D2R"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_D2G"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_R2D"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_R2G"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_G2D"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_G2R"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ABS"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "SGN"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "INT"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_ROUND"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "FIX"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_SEC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_CSC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "_COT"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ASC"
ReDim _Preserve PL(i): PL(i) = 10
i = i + 1: ReDim _Preserve OName(i): OName(i) = "CHR$"
ReDim _Preserve PL(i): PL(i) = 10
'Exponents with PL 20
i = i + 1: ReDim _Preserve OName(i): OName(i) = "^"
ReDim _Preserve PL(i): PL(i) = 20
i = i + 1: ReDim _Preserve OName(i): OName(i) = "SQR"
ReDim _Preserve PL(i): PL(i) = 20
i = i + 1: ReDim _Preserve OName(i): OName(i) = "ROOT"
ReDim _Preserve PL(i): PL(i) = 20
'Multiplication and Division PL 30
i = i + 1: ReDim _Preserve OName(i): OName(i) = "*"
ReDim _Preserve PL(i): PL(i) = 30
i = i + 1: ReDim _Preserve OName(i): OName(i) = "/"
ReDim _Preserve PL(i): PL(i) = 30
'Integer Division PL 40
i = i + 1: ReDim _Preserve OName(i): OName(i) = "\"
ReDim _Preserve PL(i): PL(i) = 40
'MOD PL 50
i = i + 1: ReDim _Preserve OName(i): OName(i) = "MOD"
ReDim _Preserve PL(i): PL(i) = 50
'Addition and Subtraction PL 60
i = i + 1: ReDim _Preserve OName(i): OName(i) = "+"
ReDim _Preserve PL(i): PL(i) = 60
i = i + 1: ReDim _Preserve OName(i): OName(i) = "-"
ReDim _Preserve PL(i): PL(i) = 60
'Relational Operators =, >, <, <>, <=, >= PL 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "<>"
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "><" 'These next three are just reversed symbols as an attempt to help process a common typo
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "<="
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = ">="
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "=<" 'I personally can never keep these things straight. Is it < = or = <...
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "=>" 'Who knows, check both!
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = ">"
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "<"
ReDim _Preserve PL(i): PL(i) = 70
i = i + 1: ReDim _Preserve OName(i): OName(i) = "="
ReDim _Preserve PL(i): PL(i) = 70
'Logical Operations PL 80+
i = i + 1: ReDim _Preserve OName(i): OName(i) = "NOT"
ReDim _Preserve PL(i): PL(i) = 80
i = i + 1: ReDim _Preserve OName(i): OName(i) = "AND"
ReDim _Preserve PL(i): PL(i) = 90
i = i + 1: ReDim _Preserve OName(i): OName(i) = "OR"
ReDim _Preserve PL(i): PL(i) = 100
i = i + 1: ReDim _Preserve OName(i): OName(i) = "XOR"
ReDim _Preserve PL(i): PL(i) = 110
i = i + 1: ReDim _Preserve OName(i): OName(i) = "EQV"
ReDim _Preserve PL(i): PL(i) = 120
i = i + 1: ReDim _Preserve OName(i): OName(i) = "IMP"
ReDim _Preserve PL(i): PL(i) = 130
End Sub
Function EvaluateNumbers$ (p, num() As String)
Dim n1 As _Float, n2 As _Float, n3 As _Float
Select Case OName(p) 'Depending on our operator..
Case "_PI": n1 = 3.14159265358979323846264338327950288## 'Future compatable in case something ever stores extra digits for PI
Case "%": n1 = (Val(num(1))) / 100 'Note percent is a special case and works with the number BEFORE the % command and not after
Case "_ACOS": n1 = _Acos(Val(num(2)))
Case "_ASIN": n1 = _Asin(Val(num(2)))
Case "_ARCSEC": n1 = _Arcsec(Val(num(2)))
Case "_ARCCSC": n1 = _Arccsc(Val(num(2)))
Case "_ARCCOT": n1 = _Arccot(Val(num(2)))
Case "_SECH": n1 = _Sech(Val(num(2)))
Case "_CSCH": n1 = _Csch(Val(num(2)))
Case "_COTH": n1 = _Coth(Val(num(2)))
Case "COS": n1 = Cos(Val(num(2)))
Case "SIN": n1 = Sin(Val(num(2)))
Case "TAN": n1 = Tan(Val(num(2)))
Case "LOG": n1 = Log(Val(num(2)))
Case "EXP": n1 = Exp(Val(num(2)))
Case "ATN": n1 = Atn(Val(num(2)))
Case "_D2R": n1 = 0.0174532925 * (Val(num(2)))
Case "_D2G": n1 = 1.1111111111 * (Val(num(2)))
Case "_R2D": n1 = 57.2957795 * (Val(num(2)))
Case "_R2G": n1 = 0.015707963 * (Val(num(2)))
Case "_G2D": n1 = 0.9 * (Val(num(2)))
Case "_G2R": n1 = 63.661977237 * (Val(num(2)))
Case "ABS": n1 = Abs(Val(num(2)))
Case "SGN": n1 = Sgn(Val(num(2)))
Case "INT": n1 = Int(Val(num(2)))
Case "_ROUND": n1 = _Round(Val(num(2)))
Case "FIX": n1 = Fix(Val(num(2)))
Case "_SEC": n1 = _Sec(Val(num(2)))
Case "_CSC": n1 = _Csc(Val(num(2)))
Case "_COT": n1 = _Cot(Val(num(2)))
Case "^": n1 = Val(num(1)) ^ Val(num(2))
Case "SQR": n1 = Sqr(Val(num(2)))
Case "ROOT"
n1 = Val(num(1)): n2 = Val(num(2))
If n2 = 1 Then EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1))): Exit Function
If n1 < 0 And n2 >= 1 Then sign = -1: n1 = -n1 Else sign = 1
n3 = 1## / n2
If n3 <> Int(n3) And n2 < 1 Then sign = Sgn(n1): n1 = Abs(n1)
n1 = sign * (n1 ^ n3)
Case "*": n1 = Val(num(1)) * Val(num(2))
Case "/": n1 = Val(num(1)) / Val(num(2))
Case "\"
If Val(num(2)) <> 0 Then
n1 = Val(num(1)) \ Val(num(2))
Else
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)"
Exit Function
End If
Case "MOD": n1 = Val(num(1)) Mod Val(num(2))
Case "+": n1 = Val(num(1)) + Val(num(2))
Case "-": n1 = Val(num(1)) - Val(num(2))
Case "=": n1 = Val(num(1)) = Val(num(2))
Case ">": n1 = Val(num(1)) > Val(num(2))
Case "<": n1 = Val(num(1)) < Val(num(2))
Case "<>", "><": n1 = Val(num(1)) <> Val(num(2))
Case "<=", "=<": n1 = Val(num(1)) <= Val(num(2))
Case ">=", "=>": n1 = Val(num(1)) >= Val(num(2))
Case "NOT": n1 = Not Val(num(2))
Case "AND": n1 = Val(num(1)) And Val(num(2))
Case "OR": n1 = Val(num(1)) Or Val(num(2))
Case "XOR": n1 = Val(num(1)) Xor Val(num(2))
Case "EQV": n1 = Val(num(1)) Eqv Val(num(2))
Case "IMP": n1 = Val(num(1)) Imp Val(num(2))
Case Else
EvaluateNumbers$ = "ERROR - Bad operation (We shouldn't see this)" 'Let's say we're bad...
End Select
EvaluateNumbers$ = RTrim$(LTrim$(Str$(n1)))
End Function
Function DWD$ (exp$) 'Deal With Duplicates
'To deal with duplicate operators in our code.
'Such as -- becomes a +
'++ becomes a +
'+- becomes a -
'-+ becomes a -
t$ = exp$
Do
bad = 0
Do
l = InStr(t$, "++")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "+-")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "-+")
If l Then t$ = Left$(t$, l - 1) + "-" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Do
l = InStr(t$, "--")
If l Then t$ = Left$(t$, l - 1) + "+" + Mid$(t$, l + 2): bad = -1
Loop Until l = 0
Loop Until Not bad
DWD$ = t$
VerifyString t$
End Function
Sub PreParse (e$)
Dim f As _Float
t$ = e$
'First strip all spaces
t$ = ""
For i = 1 To Len(e$)
If Mid$(e$, i, 1) <> " " Then t$ = t$ + Mid$(e$, i, 1)
Next
t$ = UCase$(t$)
If t$ = "" Then e$ = "ERROR -- NULL string; nothing to evaluate": Exit Sub
'ERROR CHECK by counting our brackets
l = 0
Do
l = InStr(l + 1, t$, "("): If l Then c = c + 1
Loop Until l = 0
l = 0
Do
l = InStr(l + 1, t$, ")"): If l Then c1 = c1 + 1
Loop Until l = 0
If c <> c1 Then e$ = "ERROR -- Bad Parenthesis:" + Str$(c) + "( vs" + Str$(c1) + ")": Exit Sub
'Modify so that NOT will process properly
l = 0
Do
l = InStr(l + 1, t$, "NOT")
If l Then
'We need to work magic on the statement so it looks pretty.
' 1 + NOT 2 + 1 is actually processed as 1 + (NOT 2 + 1)
'Look for something not proper
l1 = InStr(l + 1, t$, "AND")
If l1 = 0 Or (InStr(l + 1, t$, "OR") > 0 And InStr(l + 1, t$, "OR") < l1) Then l1 = InStr(l + 1, t$, "OR")
If l1 = 0 Or (InStr(l + 1, t$, "XOR") > 0 And InStr(l + 1, t$, "XOR") < l1) Then l1 = InStr(l + 1, t$, "XOR")
If l1 = 0 Or (InStr(l + 1, t$, "EQV") > 0 And InStr(l + 1, t$, "EQV") < l1) Then l1 = InStr(l + 1, t$, "EQV")
If l1 = 0 Or (InStr(l + 1, t$, "IMP") > 0 And InStr(l + 1, t$, "IMP") < l1) Then l1 = InStr(l + 1, t$, "IMP")
If l1 = 0 Then l1 = Len(t$) + 1
t$ = Left$(t$, l - 1) + "(" + Mid$(t$, l, l1 - l) + ")" + Mid$(t$, l + l1 - l)
l = l + 3
'PRINT t$
End If
Loop Until l = 0
'Check for bad operators before a ( bracket
l = 0
Do
l = InStr(l + 1, t$, "(")
If l And l > 2 Then 'Don't check the starting bracket; there's nothing before it.
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, l - Len(OName(i)), Len(OName(i))) = OName(i) And PL(i) > 1 And PL(i) <= 250 Then good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Next
If Not good Then e$ = "ERROR - Improper operations before (.": Exit Sub
l = l + 1
End If
Loop Until l = 0
'Check for bad operators after a ) bracket
l = 0
Do
l = InStr(l + 1, t$, ")")
If l And l < Len(t$) Then
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, l + 1, Len(OName(i))) = OName(i) And PL(i) > 1 And PL(i) <= 250 Then good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Next
If Mid$(t$, l + 1, 1) = ")" Then good = -1
If Not good Then e$ = "ERROR - Improper operations after ).": Exit Sub
l = l + 1
End If
Loop Until l = 0 Or l = Len(t$) 'last symbol is a bracket
'Turn all &H (hex) numbers into decimal values for the program to process properly
l = 0
Do
l = InStr(t$, "&H")
If l Then
E = l + 1: finished = 0
Do
E = E + 1
comp$ = Mid$(t$, E, 1)
Select Case comp$
Case "0" To "9", "A" To "F" 'All is good, our next digit is a number, continue to add to the hex$
Case Else
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, E, Len(OName(i))) = OName(i) And PL(i) > 1 And PL(i) <= 250 Then good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Next
If Not good Then e$ = "ERROR - Improper &H value. (" + comp$ + ")": Exit Sub
E = E - 1
finished = -1
End Select
Loop Until finished Or E = Len(t$)
t$ = Left$(t$, l - 1) + LTrim$(RTrim$(Str$(Val(Mid$(t$, l, E - l + 1))))) + Mid$(t$, E + 1)
End If
Loop Until l = 0
'Turn all &B (binary) numbers into decimal values for the program to process properly
l = 0
Do
l = InStr(t$, "&B")
If l Then
E = l + 1: finished = 0
Do
E = E + 1
comp$ = Mid$(t$, E, 1)
Select Case comp$
Case "0", "1" 'All is good, our next digit is a number, continue to add to the hex$
Case Else
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, E, Len(OName(i))) = OName(i) And PL(i) > 1 And PL(i) <= 250 Then good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Next
If Not good Then e$ = "ERROR - Improper &B value. (" + comp$ + ")": Exit Sub
E = E - 1
finished = -1
End Select
Loop Until finished Or E = Len(t$)
bin$ = Mid$(t$, l + 2, E - l - 1)
For i = 1 To Len(bin$)
If Mid$(bin$, i, 1) = "1" Then f = f + 2 ^ (Len(bin$) - i)
Next
t$ = Left$(t$, l - 1) + LTrim$(RTrim$(Str$(f))) + Mid$(t$, E + 1)
End If
Loop Until l = 0
t$ = N2S(t$)
VerifyString t$
e$ = t$
End Sub
Sub VerifyString (t$)
'ERROR CHECK for unrecognized operations
j = 1
Do
comp$ = Mid$(t$, j, 1)
Select Case comp$
Case "0" To "9", ".", "(", ")": j = j + 1
Case Else
good = 0
For i = 1 To UBound(OName)
If Mid$(t$, j, Len(OName(i))) = OName(i) Then good = -1: Exit For 'We found an operator after our ), and it's not a CONST (like PI)
Next
If Not good Then t$ = "ERROR - Bad Operational value. (" + comp$ + ")": Exit Sub
j = j + Len(OName(i))
End Select
Loop Until j > Len(t$)
End Sub
Function N2S$ (exp$) 'scientific Notation to String
t$ = LTrim$(RTrim$(exp$))
If Left$(t$, 1) = "-" Then sign$ = "-": t$ = Mid$(t$, 2)
dp = InStr(t$, "D+"): dm = InStr(t$, "D-")
ep = InStr(t$, "E+"): em = InStr(t$, "E-")
check1 = Sgn(dp) + Sgn(dm) + Sgn(ep) + Sgn(em)
If check1 < 1 Or check1 > 1 Then N2S = exp$: Exit Function 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
Select Case l 'l now tells us where the SN starts at.
Case Is < dp: l = dp
Case Is < dm: l = dm
Case Is < ep: l = ep
Case Is < em: l = em
End Select
l$ = Left$(t$, l - 1) 'The left of the SN
r$ = Mid$(t$, l + 1): r&& = Val(r$) 'The right of the SN, turned into a workable long
If InStr(l$, ".") Then 'Location of the decimal, if any
If r&& > 0 Then
r&& = r&& - Len(l$) + 2
Else
r&& = r&& + 1
End If
l$ = Left$(l$, 1) + Mid$(l$, 3)
End If
Select Case r&&
Case 0 'what the heck? We solved it already?
'l$ = l$
Case Is < 0
For i = 1 To -r&&
l$ = "0" + l$
Next
l$ = "0." + l$
Case Else
For i = 1 To r&&
l$ = l$ + "0"
Next
End Select
N2S$ = sign$ + l$
End Function
![[Image: image.png]](https://i.ibb.co/0XdSR42/image.png)
|
|
|
Silent pw entry not working |
|
Posted by: Ra7eN - 12-11-2022, 02:06 PM - Forum: Help Me!
- Replies (46)
|
 |
The following code does the following
prints "*" when entering a password (scratch built) and then return the plaintext back.
Instead it returns a zero and blank text. What did I miss? thanks.
Code: (Select All) Print "-Enter Password: "; pInput$ = silentInput$
Print pInput$ 'DEBUG DELETE AFTER TESTING
Code: (Select All) Function silentInput$
Dim Txt$
Dim KeyPress$
Txt$ = ""
' GREAT FOR PASSWORDS
Do
Do: KeyPress$ = InKey$: Loop Until KeyPress$ > ""
If KeyPress$ <> Chr$(13) Then
Txt$ = Txt$ + KeyPress$
Print "*"; ' crate a visual
End If
Loop Until KeyPress$ = Chr$(13)
Print
silentInput$ = Txt$
End Function
PS, appreciate you guys keeping the qb64 going!! thank you
|
|
|
|
| suggestion: change to _MEMFREE |
|
Posted by: OldMoses - 12-11-2022, 12:43 PM - Forum: General Discussion
- Replies (5)
|
 |
While working with _MEM blocks and freeing them, it occurred to me that perhaps it would be a useful alteration to have _MEMFREE work similar to the new DIM syntax, where one can:
DIM AS INTEGER a, b, c, etc.
Where instead of the required syntax following:
_MEMFREE m
_MEMFREE m2
_MEMFREE m3
One could do:
_MEMFREE m, m2, m3
Would there be any interest in such a change, or would that be too difficult of an implementation?
|
|
|
|
| Chat with Me -- HOST |
|
Posted by: SMcNeill - 12-11-2022, 12:30 PM - Forum: General Discussion
- Replies (61)
|
|
Now, as I mentioned in the topic Come chat with me! (qb64phoenix.com), I told you guys I was going to share the HOST part of the program which we were all using to play around and chat with yesterday -- and try to highlight the steps necessary to get it to run properly for everyone.
First, let's start with the code. We'll begin with the HOST version of my Mini Messenger (qb64phoenix.com):
Code: (Select All) DIM SHARED Users(1 TO 1000) ' array to hold other client info
DIM SHARED NumClients
DIM SHARED out$
PRINT "[Steve's Mini Messenger]"
host = _OPENHOST("TCP/IP:7319") ' no host found, so begin new host
IF host THEN
PRINT "[Beginning new host chat session!]"
NumClients = 0
client = _OPENCLIENT("TCP/IP:7319:localhost")
IF client = 0 THEN PRINT "ERROR: could not attach host's personal client to host!"
INPUT "Enter your name:", myname$
'PRINT #client, myname$ + " connected!"
PRINT "[Chat session active!]"
ELSE
PRINT "ERROR: Could not begin new host!"
END IF ' host
DO ' host main loop
newclient = _OPENCONNECTION(host) ' receive any new connection
IF newclient THEN
NumClients = NumClients + 1
Users(NumClients) = newclient
PRINT "Welcome to Steve's Mini Messenger!"
END IF
FOR i = 1 TO NumClients
GetMessage Users(i) 'check all clients for a message
IF out$ <> "" THEN
l = LEN(out$)
FOR j = 1 TO NumClients ' distribute incoming messages to all clients
PUT #Users(j), , l
PUT #Users(j), , out$
NEXT
END IF
NEXT i
SendMessage myname$, mymessage$, client
_LIMIT 30
LOOP
SUB GetMessage (client) ' get & display any new message
GET #client, , l
IF l > 0 THEN
out$ = SPACE$(l)
GET #client, , out$
VIEW PRINT 1 TO 20
LOCATE 20, 1
PRINT out$
VIEW PRINT 1 TO 24
ELSE
out$ = ""
END IF
END SUB
SUB SendMessage (myname$, mymessage$, client) ' simple input handler
k$ = INKEY$
IF LEN(k$) THEN
IF k$ = CHR$(8) AND LEN(mymessage$) <> 0 THEN
mymessage$ = LEFT$(mymessage$, LEN(mymessage$) - 1)
ELSE
IF LEN(k$) = 1 AND ASC(k$) >= 32 THEN mymessage$ = mymessage$ + k$
END IF
END IF
VIEW PRINT 1 TO 24
LOCATE 22, 1: PRINT SPACE$(80); ' erase previous message displayed
LOCATE 22, 1: PRINT myname$ + ": "; mymessage$;
IF k$ = CHR$(13) THEN ' [Enter] sends the message
IF mymessage$ = "" THEN SYSTEM ' [Enter] with no message ends program
mymessage$ = myname$ + ":" + mymessage$
l = LEN(mymessage$)
PUT #client, , l
PUT #client, , mymessage$
mymessage$ = ""
END IF
IF k$ = CHR$(27) THEN SYSTEM ' [Esc] key ends program
END SUB[color=#cccccc][font=Monaco, Consolas, Courier, monospace][/font][/color]
Now, I tried to keep this as simple as I possibly could -- without any bells or whistles to complicate the viewing and understanding of the basic process we're using here -- so don't think this is anything fancy at all. All this basically does is show how to set up a host connection, accept users trying to connect to that connection, and then transfer information back and forth between the two.
It's a demo to showcase the very bare bones of the TCP/IP stuff, and nothing more, so keep that in mind as we go along and talk about things. 
First change needed to swap this over from LOCALHOST to world wide web hosting involves... dum dum de dum.... Opening a browser tab and going to What Is My IP? Shows Your Public IP Address - IPv4 - IPv6. If you're using a VPN or such to protect your IP, you may be able to get by with using it, or you may not. That all depends on your VPN's safety protocols. If it just forwards anything that comes its way back your way, you're fine. If it wants you to open ports and such as that and only forward certain things, then you're screwed unless you jump through their hoops and allow the transfer.
My advice here: Use your actual web address. 172.83.131.239 happens to be my permanent little home on the web. From time to time, I tend to host my own website, and I need a static IP so I can always connect to it when it's up and going. Most folks have a dynamic IP, which is assigned to them randomly every time they connect to the internet (it costs extra $$ each month for a static IP), so you'll need to update your chat program with the current IP with each reboot of your computer.
Once you've gotten your IP address, you can now go into the code above and make the drastic change from local to www connections:
Code: (Select All) client = _OpenClient("TCP/IP:7319:localhost")
Change the line above to where it now has your IP address, rather than "localhost".
Code: (Select All) client = _OpenClient("TCP/IP:7319:172.83.131.239")
^That's what it'll look like for me. For you, the same, except with a different IP address in there.
And that's basically the ONLY TCP/IP requirement that QB64-PE makes you have to change to make it work and communicate across the net!
And chances are, if some of you try to make that work, it's not going to work for you. In fact, I'd bet against it. 
WHY??
First is the TCP/IP:7319... What the heck is that 7319, and why is it in there?
It's one of the multitude of ports which our modern PCs have available for us to use to communicate with things. How was 7319 chosen? That was all just Steve, picking an unused port on my PC, and deciding, "I'm ah gonna use dis one!" Most of the time, our modern routers tend to lock down port access for most people and things. You have one or two ports open for common stuff (like http and https transfers), but the rest of those ports are locked for security purposes.
Since there's a zillion different routers, and a zillion different ways they're configured, with a zillion different sets of software to interact with them, *I CAN'T HELP YOU WITH YOUR ROUTER SETTINGS.* You'll have to Google, dig out the manual that came packaged when you bought the router, or call your ISP and ask them to help. At the end of the day though, you're NOT going to be able to share communications unless you're sharing on a port that's opened and allows it. <--This part, unfortunately, you're on your own to puzzle out. All I can say is "Open your router settings, choose a port you like that's not currently in use, and open it -- however you do that on your router."
Once you've got an open port, and if it's not 7319 like I chose for it to be, then you'd need to change your program to work on the port you've chosen.
Code: (Select All) client = _OpenClient("TCP/IP:####:172.83.131.239")
Try that, and it MAY work for you. Once again, however, I'd be willing to bet against it.
Once more, go into your router settings, and this time look for PORT FORWARDING. Most of us have multiple devices set up for the internet. Our phones are connected, as is our pc, our ipad, our tv, all our damn smart lightbulbs... You probably need to do a little more specific directing with port forwarding to tell your router where you want to send that open port information to.
Once again, I'm sorry, but I can't really help much with this step as every router has it's own software and way of interacting with you.
![[Image: image.png]](https://i.ibb.co/wQjS5vB/image.png)
Click on the image above, if you want, and it'll show my router's port forwarding setup. The first three and where I host my own private server from time to time (ports 80 and 443 and http and https traffic, while 3306 is where my SQL Database likes to communicate back and forth when it's up and running). The last entry in that list, however, is the one of interest for you guys -- Laptop Forwarding on port 7319, and which is going to 10.243.1.77...
That 10.242.1.77 is my laptop's local address on my network. By setting up port forwarding like this, communications on port 7319 are now routed directly to it, allowing it to communicate with the rest of the world.
Once you've set up the open port, and forwarded it to your machine which is going to run the compiled EXE, chances are you're good to go!! Your firewall might pop up a question "Do you really want to allow this", but you can feel free to tell it to pisser off. You've got to let the information travel back and forth to your PC, or else you'll never be able to communicate on an open port like this with the outside world.
So you run it... And it works!! YAAAAAAYYYY!!!
You go to bed, get up the next morning, notice that Windows did an update on you, and it now no longer works. WTF?!! (I can just hear some of you cussing already! No worries -- no judgement. I've been there as well!!)
Two important things to keep in mind:
1) If you don't have a permanent STATIC IP address (you'll know if you do because you asked for it specifically from your ISP and are paying extra each month for it), then your IP address is dynamically allocated for you. You'll need to get the new address, swap it into your program, and try it again.
2) And if number one doesn't fix the issue, problem number two is... dum dum de dum... once again dynamic addresses. That last step that we did, with the port forwarding... Remember it? You forwarded your data to a specific local IP address... If you don't have that configured as a static address (set up manually instead of automatic), then it may not be the same as it was before either. You may have to go back and change your port forwarding address once again so it works as you'd expect.
|
|
|
|
| Playing with the mouse |
|
Posted by: NasaCow - 12-11-2022, 07:59 AM - Forum: Help Me!
- Replies (13)
|
 |
I am running this program to play with the mouse, just playing with things to understand it before trying to imbed it into something else.
Code: (Select All) $NOPREFIX
CONST FALSE = 0, TRUE = NOT FALSE
TYPE MouseType
EndX AS INTEGER
EndY AS INTEGER
StartX AS INTEGER
StartY AS INTEGER
LButDown AS INTEGER
RButDown AS INTEGER
OldLBut AS INTEGER
OldRBut AS INTEGER
END TYPE
SCREEN NEWIMAGE(1280, 720, 32)
DIM AS MouseType Mouse
DIM AS INTEGER highlight(500000)
DIM AS BIT Active
Mouse.OldLBut = --1
Active = FALSE
LINE (500, 200)-(600, 300), RGB(0, 0, 255), BF
DO
'LIMIT 120
DO WHILE MOUSEINPUT
LOOP
Mouse.StartX = MOUSEX
Mouse.StartY = MOUSEY
Mouse.LButDown = MOUSEBUTTON(1)
IF Mouse.StartX >= 500 AND Mouse.StartX <= 600 AND Mouse.StartY >= 200 AND Mouse.StartY <= 300 AND NOT Active THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = TRUE
ELSEIF Active EQV Mouse.StartX < 500 OR Mouse.StartX > 600 OR Mouse.StartY < 200 OR Mouse.StartY > 300 THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = FALSE
END IF
IF Mouse.LButDown AND NOT Mouse.OldLBut THEN
LOCATE 1, 1
PRINT Mouse.StartX, Mouse.StartY, Mouse.LButDown
END IF
Mouse.OldLBut = Mouse.LButDown
LOOP UNTIL INKEY$ = CHR$(27)
and it is working as expected with a box highlighting and not but I don't understand why this if statement needs EQV:
Code: (Select All) ELSEIF Active EQV Mouse.StartX < 500 OR Mouse.StartX > 600 OR Mouse.StartY < 200 OR Mouse.StartY > 300 THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = FALSE
END IF
than the one I was trying to work with at first:
Code: (Select All) ELSEIF Active AND Mouse.StartX < 500 OR Mouse.StartX > 600 OR Mouse.StartY < 200 OR Mouse.StartY > 300 THEN
GET (500, 200)-(600, 300), highlight()
PUT (500, 200), highlight(), PRESET
Active = FALSE
END IF
My belief that If (false and True or True or True or True) should return a false with false and true.... condition.
Never used EQV before but the table on the wiki implies both should return false. Maybe someone can educate me where my logic has gone wrong? Many thanks 
|
|
|
|
| DAY 030: _CONTROLCHR |
|
Posted by: Pete - 12-11-2022, 02:13 AM - Forum: Keyword of the Day!
- Replies (5)
|
 |
Ever want to be able to see the ASCII characters that do things like eject the printer paper, CHR$(12)? Well with the keyword _CONTROLCHR OFF, you can! And if you act now, because we can't do this all day, we'll throw in _CONTROLCHR$ ON at no extra charge. Just pay separate shipping and handling.
SYNTAX _CONTROLCHR {OFF|ON}
Code: (Select All) WIDTH 127, 20
_FONT 16
_KEYCLEAR
msg$ = "ASCII CHaracter Chart"
LOCATE 1, _WIDTH \ 2 - LEN(msg$) \ 2
PRINT msg$;
c = 1
_CONTROLCHR OFF
FOR i = 0 TO 255 ' There are 256 ASCII characters.
i$ = LTRIM$(STR$(i))
FOR j = 1 TO 2
IF LEN(i$) < 3 THEN i$ = "0" + i$
NEXT
IF i AND i MOD (_HEIGHT - 4) = 0 THEN c = c + 8: LOCATE 3, c
LOCATE i MOD (_HEIGHT - 4) + 3, c + 1: PRINT i$; " "; CHR$(i);
NEXT
SLEEP
_CONTROLCHR ON
_DELAY .5
FOR i = 1 TO _HEIGHT
PRINT CHR$(13);
_DELAY .2
NEXT
So now we have some nice symbols we can print to the screen for our text programs, which without this KEYWORD, would be used for the following...
Code: (Select All) CTRL + A = CHR$(1) ? StartHeader (SOH) CTRL + B = CHR$(2) ? StartText (STX)
CTRL + C = CHR$(3) ? EndText (ETX) CTRL + D = CHR$(4) ? EndOfTransmit (EOT)
CTRL + E = CHR$(5) ? Enquiry (ENQ) CTRL + F = CHR$(6) ? Acknowledge (ACK)
CTRL + G = CHR$(7) • Bell (BEL) CTRL + H = CHR$(8) ? [Backspace] (BSP)
CTRL + I = CHR$(9) ? Horiz.Tab [Tab] CTRL + J = CHR$(10) ? LineFeed(printer) (LF)
CTRL + K = CHR$(11) ? Vert. Tab (VT) CTRL + L = CHR$(12) ? FormFeed(printer) (FF)
CTRL + M = CHR$(13) ? [Enter] (CR) CTRL + N = CHR$(14) ? ShiftOut (SO)
CTRL + O = CHR$(15) ¤ ShiftIn (SI) CTRL + P = CHR$(16) ? DataLinkEscape (DLE)
CTRL + Q = CHR$(17) ? DevControl1 (DC1) CTRL + R = CHR$(18) ? DeviceControl2 (DC2)
CTRL + S = CHR$(19) ? DevControl3 (DC3) CTRL + T = CHR$(20) ¶ DeviceControl4 (DC4)
CTRL + U = CHR$(21) § NegativeACK (NAK) CTRL + V = CHR$(22) ? Synchronous Idle (SYN)
CTRL + W = CHR$(23) ? EndTXBlock (ETB) CTRL + X = CHR$(24) ? Cancel (CAN)
CTRL + Y = CHR$(25) ? EndMedium (EM) CTRL + Z = CHR$(26) ? End Of File(SUB) (EOF)
Note that PRINT CHR$(7) used t sound a BEEP in QuickBasic and older QB64 versions, but not any longer. I wonder who the dev was who decided to get the BEEP out of QB64?
Pete
|
|
|
|
| A little DIR test |
|
Posted by: BDS107 - 12-10-2022, 05:52 PM - Forum: Help Me!
- Replies (4)
|
 |
I would like to perform a test.
I would like to know if the output of the directory is the same for every language? Also what happens with date/time? And is the distance to the file name the same per language? I use Windows 10 (BE-NL) system. And what about Linux and iOS?
Code: (Select All) dir *.* /A-D-H-S-L-R /n /ON /4 /l
What is your result? I have the following (excerpt):
Code: (Select All) 26/11/2022 21:10 2.433 filename1.ext
28/11/2022 11:50 3.467 filename2.ext
28/11/2022 16:09 3.522 filename3.ext
So 10 characters for the date
2 spaces in between
5 characters for the date (maybe there will be more due to AM/PM)?
Then the size of the file.
From position 37 the file name.
In other words, can we use fixed values for MID$ ???
Maybe you van upload an excerpt to this post?
|
|
|
|
| Come chat with me! |
|
Posted by: SMcNeill - 12-10-2022, 12:06 PM - Forum: General Discussion
- Replies (6)
|
|
Code: (Select All) Dim Shared out$
Print "[Steve's Mini Messenger]"
client = _OpenClient("TCP/IP:7319:172.83.131.239") ' Attempt to connect to local host as a client
Print "[connected to " + _ConnectionAddress(client) + "]"
Input "Enter your name: ", myname$
out$ = myname$ + " connected!"
l = Len(out$)
Put #client, , l
Put #client, , out$
Do
GetMessage client
SendMessage myname$, mymessage$, client ' display current input on screen
_Limit 30
Loop
'.................... END OF MAIN PROGRAM ................
Sub GetMessage (client) ' get & display any new message
Get #client, , l
If l > 0 Then
_Delay .25
out$ = Space$(l)
Get #client, , out$
View Print 1 To 20
Locate 20, 1
Print out$
View Print 1 To 24
Else
out$ = ""
End If
End Sub
Sub SendMessage (myname$, mymessage$, client) ' simple input handler
k$ = InKey$
If Len(k$) Then
If k$ = Chr$(8) And Len(mymessage$) <> 0 Then
mymessage$ = Left$(mymessage$, Len(mymessage$) - 1)
Else
If Len(k$) = 1 And Asc(k$) >= 32 Then mymessage$ = mymessage$ + k$
End If
End If
View Print 1 To 24
Locate 22, 1: Print Space$(80); ' erase previous message displayed
Locate 22, 1: Print myname$ + ": "; mymessage$;
If k$ = Chr$(13) Then ' [Enter] sends the message
If mymessage$ = "" Then System ' [Enter] with no message ends program
mymessage$ = myname$ + ":" + mymessage$
l = Len(mymessage$)
Put #client, , l
Put #client, , mymessage$
_Delay .25
mymessage$ = ""
End If
If k$ = Chr$(27) Then System ' [Esc] key ends program
End Sub
There's been several folks who have been chatting and asking about TCP/IP communications between computers here lately, so I thought I'd showcase how it's done once again.
Above is a very simple client, which remotes out from your PC (you may have to open your firewall for it, or disable a few "protect yourself from yourself" settings, depending on your system), and which then connects to my laptop by which we can then chat happily with each other.
Feel free to hang around in the little chat all day with us, if you're able. I'm going to keep the host up and going until after midnight EST for everyone, but that certainly doesn't mean I'm going to sit and hover over my laptop that whole time to always be available to instantly say, "HEY! I SEE YOU! CAN YOU HEAR ME NOW??"
The more folks who pop in and hang around, the more folks who can chatter with each other and welcome someone new into the channel, so they can be certain that the program is working and communicating in both directions for them.
If all this works, without folks having too hard an issue running with it, I'll post the host and client both sometime tomorrow and then try and walk everyone through all the steps I went through to get it to play nicely with my router, firewall, and all.
|
|
|
|
| DAY 029: _EXIT |
|
Posted by: Pete - 12-10-2022, 05:41 AM - Forum: Keyword of the Day!
- Replies (8)
|
|
Not to be confused with _BREXIT, which was a useful keyword to get the hell out of the E.U., _EXIT is a useful keyword to get you out of trouble if you mistakenly click the "X" symbol before parts of your app have completed, like writing to a very large file.
SYNTAX: var% = _EXIT
Values are as follows...
Code: (Select All) ' "x"......... 1
' Alt + F4.....1
' Ctrl + Break 2
DO
a% = _EXIT
PRINT a%
_LIMIT 1
IF INKEY$ = CHR$(27) THEN END
LOOP
_EXIT covers all exit routines, which is why I put that INKEY Esc to end line in the code; otherwise, you'd have to shut it down with Task manager.
So, what's it good for? Well, let's say your cat walks into the room, jumps on your mouse and sits its kitty-butt down on the left mouse button. Well wouldn't you know it, the mouse pointer is positioned on the "x" and the program is running a pi algorithm that has been going on for days! Well, before you think about getting rid of your cat, and getting a life, try _EXIT in your program instead; here's how...
Code: (Select All) DO
FOR i = 1 TO 10
ON _EXIT GOSUB pete ' Pauses this count routine when the "x" is clicked.
PRINT i
_DELAY .5
NEXT
LOOP UNTIL LEN(INKEY$) ' If you press a key, it will end after it prints "10".
END
pete:
LINE INPUT "Are you sure you want to quit? Y/N: "; ans$
IF LCASE$(ans$) = "y" THEN SYSTEM
RETURN
So you might ask, hey Pete, why'd you put the _EXIT command in the FOR LOOP, instead of the DO LOOP? And I'd reply, so the user doesn't think the "x" close program function is broken.
Now let's try it in the DO LOOP, and see what happens...
Code: (Select All) DO
ON _EXIT GOSUB pete ' Pauses this count routine after count "10".
FOR i = 1 TO 10
PRINT i
_DELAY .5
NEXT
LOOP UNTIL LEN(INKEY$) ' If you press a key, it will end after it prints "10".
END
pete:
LINE INPUT "Are you sure you want to quit? Y/N: "; ans$
IF LCASE$(ans$) = "y" THEN SYSTEM
RETURN
So we click "x" after it prints 2 or 3, whatever... and it keeps counting. Go ahead, click the hell out of "x", it won't matter. It isn't going to move to the sub-routine until it finishes the FOR LOOP.
Now you could do worse, and put it outside the DO LOOP. This disables the "x" quit function, but keeps the click in memory. That's a problem as our program is supposed to "END" with the screen still up and a, "Press any key to continue." message at the bottom. Oops, that click in memory kills the window!
So knowing what effect you want and where to place the _EXIT command is important. For instance, let's say it was imperative we get that FOR LOOP to complete before we quit. I'd say code a warning message something like this...
Code: (Select All) DO
stopexit = -1
FOR i = 1 TO 10
ON _EXIT GOSUB pete
PRINT i
_DELAY .5
NEXT
IF stopexit = 0 THEN END
PRINT "You have 10 seconds to exit before the next loop begins..."
stopexit = 0
z1 = TIMER
DO: ON _EXIT GOSUB pete: LOOP UNTIL ABS(TIMER - z1) >= 10
LOOP UNTIL LEN(INKEY$) ' If you press a key, it will end after it prints "10".
END
pete:
SELECT CASE stopexit
CASE -1
PRINT: PRINT "Okay, the program will end after it prints to 10.": PRINT: _DELAY 3
stopexit = 0
CASE 0
SYSTEM ' But Yogi, won't exiting before returning cause a stack space leak? I don't give a **** Booboo.
END SELECT
RETURN
So in review, _EXIT returns 1 for "x" in the window or in the task bar projection, 1 for Alt + F4, and 2 for Ctrl + Break. Where you place it determines the behavior, either immediate or delayed action, and be sure to use a key routine or sub-routine to bail yourself out so you don't have to resort to Task manager to suspend the program window.
<--- Pete _EXIT stage left...
|
|
|
|
|
