Posted by: Pete - 04-25-2022, 07:03 PM - Forum: TheBOB
- No Replies
Winbit.bas by Bob Seguin
Description: A bitmap loader made for QBasic and modified to display 1, 4, 8, and 24bit .bmp files in QB64 SCREEN 12 or SCREEN 13. A 24-bit .bmp file "example.bmp" is included in the zip file. Type in "example" at the prompt for a quick demo.
Download: Download the zip file below. Unzip to either your QB64 folder, or for better organization, to a folder you create like "TheBOB-Winbit".
Install: Compile Winbit.bas with QB64 v1.3 or above, and make sure the compiler output is set to create the .exe file in the same folder. See the option in the QB64 IDE RUN menu and check the RUN option: "Output EXE to Source Folder".
I've recently been playing around with various programs which communicate with each other via TCP/IP, I've decided that I needed some sort of simple protocol to make certain that the data I send and receive from computer to computer is correct and not corrupted. Here's the routine I've basically set up so far:
Code: (Select All)
DIM SHARED Host AS LONG
SCREEN _NEWIMAGE(800, 600, 32)
COLOR &HFFFFFFFF, &HFF000000
Host = _OPENHOST("TCP/IP:7990") ' this will be the host code
DO
Player = GetClient 'Not
IF Player THEN
PRINT "New Player connected"
'Do stuff
UserData$ = In$(Player)
'do stuff with the data the user sent
'and close the connection
CLOSE Player
Player = 0
END IF
_LIMIT 30
LOOP
FUNCTION GetClient
GetClient = _OPENCONNECTION(Host) ' receive any new connection
END FUNCTION
FUNCTION In$ (who)
DIM b AS _UNSIGNED _BYTE
'CHR$(2) = Start of Text
'CHR$(3) = End of Text
'CHR$(4) = End of Transmission (It's what we use to tell the client, "We give up! Closing connection!"
'CHR$(6) = Acknowledge
'CHR$(15) = Not Acknowledge
GET #who, , b 'just check for a single byte from each connection
IF b <> 2 THEN
'If we get something which isn't a CHR$(2) to start communication, send back a failure notice.
SendError who
EXIT FUNCTION 'Exit so we can move on to the next connection to check for that leading chr$(2)
END IF
'Only if that initial byte is CHR$(2), do we acknowledge receipt and await further messages.
SendConfirmation who 'we send ACKnowledgement back to tell the client we're ready for them to talk to us.
DO
count = count + 1
timeout## = ExtendedTimer + 5
DO
_LIMIT 100 'no need to check for incoming information more than 100 times a second!
GET #who, , a$
IF a$ <> "" THEN tempIn$ = tempIn$ + a$ 'tempIn$ should never be more than 105 bytes
ETX = INSTR(a$, CHR$(3)) ' chr$(3) is our ETX character (End of TeXt)
IF ETX THEN EXIT DO
IF ExtendedTimer > timeout## THEN 'If it takes over 5 seconds to send 100 bytes (or less) of info
SendError who ' something is wrong. Terminate the attempt, but be nice, and let
EXIT FUNCTION ' the other client know something went wrong, so they can try again,
END IF ' if they want to.
LOOP UNTIL LEN(tempIn$) > 105 'If we have over 105 bytes with our string, we didn't send the data properly.
IF LEN(tempIn$) > 105 THEN
SendError who 'send the client an error message
EXIT FUNCTION
END IF
tempIn$ = _TRIM$(LEFT$(tempIn$, ETX - 1)) 'strip off the ETX character and check to make certain data is valid.
c$ = RIGHT$(tempIn$, 4) 'these 4 bytes are the checksum
CheckSum = CVL(c$) 'Check to make certain the data apprears valid.
FOR i = 1 TO LEN(l$): Check = Check + ASC(l$, i): NEXT
IF CheckSum <> Check THEN ' Our data is not what we expected. Part may be lost, or corrupted.
SendError who
EXIT FUNCTION
ELSE
SendConfirmation who
EXIT DO
END IF
LOOP UNTIL count = 5
'If we get bad data 5 times in a row, something is wrong. We're just going to close the connection.
IF count = 5 THEN
SendError who
EXIT FUNCTION
END IF
'and if we're down this far, our data has been recieved, verified, and is now good to use.
In$ = LEFT$(tempIn$, 4) 'left part of the string is the data the user is sending us
END FUNCTION
SUB SendError (who)
DIM b AS _UNSIGNED _BYTE
b = 4
PUT #who, , b
END SUB
SUB SendConfirmation (who)
DIM b AS _UNSIGNED _BYTE
b = 6
PUT #who, , b
END SUB
FUNCTION ExtendedTimer##
DIM m AS INTEGER, d AS INTEGER, y AS INTEGER
DIM s AS _FLOAT, day AS STRING
day = DATE$
m = VAL(LEFT$(day, 2))
d = VAL(MID$(day, 4, 2))
y = VAL(RIGHT$(day, 4)) - 1970
SELECT CASE m 'Add the number of days for each previous month passed
CASE 2: d = d + 31
CASE 3: d = d + 59
CASE 4: d = d + 90
CASE 5: d = d + 120
CASE 6: d = d + 151
CASE 7: d = d + 181
CASE 8: d = d + 212
CASE 9: d = d + 243
CASE 10: d = d + 273
CASE 11: d = d + 304
CASE 12: d = d + 334
END SELECT
IF (y MOD 4) = 2 AND m > 2 THEN d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
ExtendedTimer## = (s + TIMER)
END FUNCTION
Now this isn't going to work to send binary files, as I'm using some of the ASCII characters as reserved command codes, but since this isn't meant to be a file transfer protocol, I don't think it should be a problem. My command codes are as follows: 'CHR$(2) = Start of Text
'CHR$(3) = End of Text
'CHR$(4) = End of Transmission (It's what we use to tell the client, "We give up! Closing connection!"
'CHR$(6) = Acknowledge
'CHR$(15) = Not Acknowledge
The idea the behind the process is this one:
First, we simply wait for a CHR$(2) character to come in, as a request from a client saying they want to send us data. If we get anything else before that, we send them an error message. All messages start with chr$(2), and when we get it, we send a confirmation back to the client so they know we're all set to receive their data (CHR$(6)).
At this point, they send us the data, which is limited to being 105 bytes or less. This 105 byte structure consists of up to 100 bytes of data, 4 bytes for a checksum of the data sent, and then the termination code. (CHR$(3))
Once we verify that everything is correct, we either send back a success, or failure signal, to the client. If we fail, they can try to resend the data, otherwise all is golden.
I tried to comment the process here so that it'd be easily understood by anyone who looks it over, but if anyone has any questions, just ask them. If there appears to be something wrong with my logic, feel free to tell me about that as well. I haven't actually tested this in a working program yet (my test game is still in development and hasn't gotten to the point where it's trying to talk back and forth to other games yet), but I don't see anything that looks wrong with it. Unless I just made a common typo, or other silly mistake, it should work as intended here...
Take a look at it. See if it looks like a process that will hold up to general usage to send plain text back and forth between computers. And, if you see something that I goofed on, or overlooked, kindly point it out to me. If all works as intended, this will end up going into a transfer library later for me, so I can just plug it into any project and use it to send and receive data between devices.
If you guys are like me, and code everything into library snippets to reuse it over and over, you probably end up finding that some of your essential code ends up going into multiple libraries and then tossing errors when you make use of those libraries together.
Here's a solution which works in this case:
Code: (Select All)
$IF EXT = UNDEFINED THEN
$LET EXT = TRUE
FUNCTION ExtendedTimer##
DIM m AS INTEGER, d AS INTEGER, y AS INTEGER
DIM s AS _FLOAT, day AS STRING
day = DATE$
m = VAL(LEFT$(day, 2))
d = VAL(MID$(day, 4, 2))
y = VAL(RIGHT$(day, 4)) - 1970
SELECT CASE m 'Add the number of days for each previous month passed
CASE 2: d = d + 31
CASE 3: d = d + 59
CASE 4: d = d + 90
CASE 5: d = d + 120
CASE 6: d = d + 151
CASE 7: d = d + 181
CASE 8: d = d + 212
CASE 9: d = d + 243
CASE 10: d = d + 273
CASE 11: d = d + 304
CASE 12: d = d + 334
END SELECT
IF (y MOD 4) = 2 AND m > 2 THEN d = d + 1 'add a day if this is leap year and we're past february
d = (d - 1) + 365 * y 'current month days passed + 365 days per each standard year
d = d + (y + 2) \ 4 'add in days for leap years passed
s = d * 24 * 60 * 60 'Seconds are days * 24 hours * 60 minutes * 60 seconds
ExtendedTimer## = (s + TIMER)
END FUNCTION
$END IF
ExtendedTimer is something which I use in a lot of code, and as such, it gets included into a lot of libraries. By coding it like this, QB64 only includes it in my programs once -- no matter how many libraries it's contained within -- and doesn't toss me "Name already in use" errors and whatnot."
It's a simple enough little habit to get into using with our library code, and it'll prevent the issues with duplicate copies being in multiple libraries.
For folks who want a little extra information about how RND and RANDOMIZE work in QBASIC (and has been imitated to work the same in QB64), here's a little old documentation I dug up from the old drive on them:
Quote
Quote:;***
; RANDOM - RANDOM number generator AND RANDOMIZE
;
; Copyright <C> 1986, Microsoft Corporation
;
; Algorithm:
;
; We use the "linear congruential" method FOR RANDOM numnber generation. The
; formula IS:
;
; x1 = (x0 * a + c) MOD 2^24
;
; where
;
; x1 = IS a new RANDOM number in the range [0..1^24]
; x0 = the previous RANDOM number (OR the seed, FOR the first one)
; a = 214,013
; c = 2,531,011
;
; The RND FUNCTION returns a floating POINT number:
;
; x1 / (2^24)
;
; which changes the range TO [0..1].
;***
;GetNextRnd -- GET NEXT RANDOM number
;MakeFloat -- make the number in [b$RndVar] into a R4
;
;Purpose:
; GET NEXT RANDOM number in sequence.
;Entry:
; [b$RndVar] has the seed.
;EXIT:
; [AX] = *B$AC which contains the R4 result
;Exceptions:
; none
;*******************************************************************************
cProc GetNextRnd,<NEAR>
cBegin
PUSH DI
MOV AX,[WORD PTR b$RndVar] ;low half of previous number
MOV CX,[RndA] ;low half of A
MUL CX
XCHG AX,DI ;save low half in DI
MOV BX,DX ; high half in BX
MOV AX,[WORD PTR b$RndVar+2] ;high half of previous
MUL CX
ADD BX,AX ;sum partial products
MOV AX,[RndA]
MUL [WORD PTR b$RndVar]
ADD BX,AX ;last partial product (since we're mod 2^24)
ADD DI,[RndC] ;add in constant C
ADC BL,BYTE PTR [RndC]
XOR BH,BH ;extended 24-bit number TO 32 bits FOR NORM
MOV DX,DI ;number in BXX
MOV [WORD PTR b$RndVar],DX ;save FOR NEXT time
MOV [WORD PTR b$RndVar+2],BX
POP DI
MakeFloat:
FILD b$RndVar ; PUT 24-bit INTEGER ON numeric stack
FDIV FP_2T24 ; ST0 = seed/2^24
MOV BX,OFFSET DGROUP:B$AC
FSTP DWORD PTR [BX] ; PUT s.p. equivalent into FAC
XCHG AX,BX ; result IS *R4 in AX
FWAIT ; ensure result in RAM prior TO RETURN
cEnd ; EXIT TO caller
;***[6]
;B$RNZP - RANDOMIZE statement
;void B$RNZP (R8 SeedNum)
;
;Purpose:
; The number IS set into the middle word of the current RANDOM
; number AS the seed FOR the NEXT one.
;Entry:
; R8 SeedNum
;EXIT:
; A new seed IS created in RndVar, based ON the seed value at entry
; AND the least significant 2-words of the INPUT parameter.
;Exceptions:
; none
;*******************************************************************************
cProc B$RNZP,<PUBLIC,FAR>
ParmQ SeedNum ; R8 seed number
cBegin
LEA BX,SeedNum+4 ; GET MOST significant digits
MOV AX,[BX] ; GET word of D.P. number
XOR AX,[BX+2] ; XOR with the NEXT word
MOV [WORD PTR b$RndVar+1],AX ; replace middle word of current s.p. seed
; with this value - - now we're reseeded.
cEnd ; EXIT
As you can see, we don't have any true randomness with RND in QB64. In fact, our results are calculated on a mathematical formula! (Which is why we always get the same results if we don't use RANDOMIZE TIMER to jump to some off point in the list of numbers we generate and use.)
If you're interested in this stuff, then here it is. If not, then just ignore this topic and trust that RND isn't [i]truly[/i] random -- which is why we call it pseduo-random, at best.
Apparently either the documentation I found is old and didn't apply to QBASIC RND (maybe it was the formula used with some other version Microsoft produced?), or else QB64 uses a different RND formula.
What we actually use is this one (as taken from libqb.cpp):
Code: (Select All)
float func_rnd(float n,int32 passed){
if (new_error) return 0;
static uint32 m;
if (!passed) n=1.0f;
if (n!=0.0){
if (n<0.0){
m=*((uint32*)&n);
rnd_seed=(m&0xFFFFFF)+((m&0xFF000000)>>24);
}
rnd_seed=(rnd_seed*16598013+12820163)&0xFFFFFF;
}
return (double)rnd_seed/0x1000000;
}
Instead of a formula where Seed = (Seed * 214013 + 2531011) MOD 2 ^ 24, we use one where rnd_seed=(rnd_seed*16598013+12820163)&0xFFFFFF;
Basically the concept is the same, but the formula for the calculations are different in the two versions.
First and most important thing to keep in mind with these is: I'm not a public speaker, nor a YouTube Superstar. I'm not good with the capture software, I'm not working with a script, and things tend to meander along -- glitches and confusion and all -- without any sort of editing going on with the videos. They're all excessively long, and someone who works with these things could probably reduce them down to half the size if they edited out my rural nature -- but they are what they are.
First one is lower resolution than all the rest in an attempt to save bandwidth, but folks mentioned they couldn't make things out the best, so the ones after that are at a sharper resolution.
It'd be a weekend marathon to sit down and watch all these back to back, but once finished, I don't think anybody would have any issues using the _MEM commands anymore.
Like always -- if anyone has questions, comments, or thoughts, you can feel free to ask them here and I'll do my best to answer and respond to whatever concerns you guys might have.
Create your oh program in your favorite Word Processor, I am using Notepad++.
Drag and drop the file onto the compiled oh.exe to run it (old way).
oh Menu:
oh now displays the contents of a program on a scroller if get one off Command$.
All files selected from Load with be displayed on scroller with Menu on top line:
(in yellow and red) New, Edit, Load, Run, Quit ; click or press first letter of
menu item to select it. Edit or New should load up the file in your default .Txt
Editor from a Shell call.
Commands, variables, line labels are case insensitive.
Re: Comments
' at start of a line, formally tells oh to ignore the line, it's a comment.
You can probably write comments in at your own risk without the '
as long as they don't start with a command word or symbol or have = sign
after first word.
Re: oh color settings, in case you need to get back to them:
Ink 100;180;225
Paper 0;0;39
*** Preloaded Variables and their Values:
"MouseX" ' use the poll command to update x pix see demo ao 3/14
"MouseY" ' use the poll command to update y pix
"MouseL" ' use the poll command to update Left button down = -1 or 0
"MouseR" ' use the poll command to update Right button status
"Key" ' use the poll command to update Last non empty key pressed, not sure about this one
"MT" = "" ' constant, handy name for nut'n which you can compare to inps (Input String)
"XMAX" = "1024" screen pixel width, constant
"YMAX" = "672" screen pixel height, constant
"RMAX" = "42" screen print rows, constant
"CMAX" = "128" screen print columns, constant
"NL" = Chr$(13) + Chr$(10) for .txt file delimiter
(note: I say constant but these are variable not wise to change them though.)
*** Print commands which use ; to delimit variables inside text
. normal print and carriage return line feed use / one space after . or after ; to set spaces
; print and next print position is right where it is, dont forget to finish line with a . line
, tab built in columns
tab columnWidth;item;item;item;...
cpr row;textgoes here with plug-in variables ';here; and ;here;.
Center Print Row print a line of text.
clipout args1 - replace Clipboard contents from any variable or literal
clipadd args1 - Append tp Clipboard contents any variable or literal,
the command does the first NL$ = Chr$(13) + Chr$(10),
you must do manually any inside the stuff you are appending, if needed.
*** Input commands also ; to delimit prompt and variable
inps this is a sample prompt;var s on end signals string expected and will return mt for just enter keypress
inpn this is a sample number prompt;var n on end will turn an empty string entered to 0
*** Screen stuff now semi-colon delimited arguments to allow each argument to be evaluated:
loc row;col AKA Locate for print chars 8x16
at col;row Alternate that corresponds to graphics x, y but in char cells 8x16
tag pixX;pixY;text$ AKA _PrintString
cpr row;text Center Print atRow;text with variables;embedded;I think.
*** Screen Drawing now semi-colon delimited arguments to allow each argument to be evaluated:
ink r;g;b;a fore-color for printing or drawing
paper r;g;b;a back-color usually set at start
pix x;y AKA Pset(x, y)
line x1;y1;x2;y2 AKA Line(x1, y1)-(x2, y2)
box x1;y1;w;h AKA Line(x1, y1)-Step(x2, y2), ,B
fbox x1;y1;w;h AKA Line(x1, y1)-Step(x2, y2), ,BF
circ x1;y1;r AKA Circle (x1, y1), r
fcirc x1;y1;rr AKA For r = 0 To rr Step .25 : Circle (x, y), r : Next
ftri x1;y1;x2;y2;x3;y3 Special MapTriangle command for
*** Misc:
poll Updates preset mouse and key variables
cls AKA Cls
zzz AKA Sleep
beep AKA Beep this comes in handy for debugging
wait nSecs AKA _Delay
show TF AKA _Display, AutoDisplay Boolean: True = stops blinking, False = immediate draw/print
mouse TF Mouse Hide if False = 0, Show Mouse if True <> 0
set Astring;index;itemValue compare to A(i) = itemValue
also see var = get[astring,index] SFunction below
rndPt (arg = variableContainer) gets the next rndPt from a deck of all points on screen,
this helps distribute graphics "randomly" on screen, covers every point
then deck is reshuffled for next layer
rp = rndPt
x = rp mod xmax or as we like to say at oh, m[rp,xmax]
y = int(rp/ymax) or as we like to say at oh, int[d[rp,ymax]]
*** Boolean IF blocks
if BooleanExpression
ei BooleanExpression AKA ElseIf
el AKA Else
fi AKA End If
*** Loop structure only one unless count goto
[ - starts loop
] - ends loop
*** only ways out of loops are:
jmp BooleanExpression Jump! out of the current loop level the command is in.
exit usually from inner if block, exits current loop level
end stop run
goto labelName:
*** GoSub
gs labelName\ AKA GoSub (3/21 : changed to \ as line label marker)
rtn AKA Return
labelName\ for gs and goto (3/21 : changed to \ as line label marker)
*** File simplicity:
Save Astring;toFileName - command
AstringVar = load[fileName] - SFunction
files[] - AString list of the files in the current directory
*** SFunctions Syntax:
var = SFunction[a1, a2, a3,...] variables setting or reassigning
*** Booleans:
and[a1, a2, a3,... ] only returns -1 when all are <> 0
or[a1, a2, a3,... ] returns -1 if any one is <> 0
seq[a1, a2] does a string compare a1 = a2? -1 if true, 0 if not
eq[a1, a2] does a numeric compare a1 = a2? -1 if true, 0 if not
lt[a1, a2] less than a1<a2 -1 if true, 0 if not
lte[a1, a2] less than or equal a1<=a2 -1 if true, 0 if not
gt[a1, a2] greater than a1>a2 -1 if true, 0 if not
gte[a1, a2] greater than or equal a1>=a2 -1 if true, 0 if not
noteq[a1, a2] not equal a1<>a2 -1 if true, 0 if not
not[a1] if a1 = 0 then Not returns -1 else Not returns 0
*** Arithmetics:
a[a1, a2, a3,...] adds them all, a is for add
x[a1, a2, a3,...] multiplies all, x is for mult.
s[a1, a2] a1 - a2 s is for subtract
d[a1, a2] a1 / a2 if a2 <> 0 d is for divide
m[a1, a2] a1 mod a2 m is for mod AKA the remainder
p[a1, a2] a1 ^ a2 p is for power
*** Extended Arithmetics extended math so extended the names ;-))
add[a1,a2]
subtract[a1,a2] - should this be subtract or subtr? I don't like sub
mult[a1,a2] - I am sure this is OK for multiply
divide[a1,a2] - handles approx 100 decimal places (got to set a limit or it'd go on forever!),
the 3 binary's above are arbitrary.
inverse[PosInteger,NumberOfDecimals] - for custom designed division when 100 decimals wont do.
sqrroot[a1] - working independently from Mr$ Function like inverse.
(The extended math had 14 Routines, MR$ is controller of the Big 4 and stands for Math Regulator.)
*** Maths misc:
int[a1] converts to Integer, remove floating point decimal end if any
sqr[a1] returns square root if a1 is positive or 0
log[a1] QB64's Log, natural logarithm, see wiki Log to convert to Log(base 10)
exp[a1] QB64's Exp, Exp(1) = e
rnd[a1] a1 is multiplier of Rnd (0 to almost 1) * a1
abs[a1] Absolute value of a1
*** Trigs (Radian angle units)
sin[a1] a1 angle in radians, returns unique ratio
cos[a1] a1 angle in radians, returns unique ratio
tan[a1] a1 angle in radians, returns unique ratio
asin[a1] a1 is ratio, returns angle in radian units
acos[a1] a1 is ratio, returns angle in radian units
atan[a1] a1 is ratio, returns angle in radian units
rad[a1] a1 is usually an angle in degrees needing to be changed to radian units
deg[a1] a1 is usually an angle in radians needing to be converted to degree units
pi[a1] a1 is a multiplier or fraction of Pi
atan2[a1 (=deltaY's) , a2 (=deltaX's) ] SFunction with 2 args, definitely a plus!
note: delta usu. means difference
Find the angle of point 1 (x1,y1) from point 2 (x2, y2) )
Basic: var = _atan2(y1-y2,x1-x2) or oh: var = atan2[s[y1,y2],s[x1,x2]]
( You can figure the rest of the Trig Functions from these. )
join[delimiter$, a2, a3,...] like the above but links the with delimiter,
for comma or space separated items or Chr$(10) line separators
Allot of string functions have counterparts joins counterpart is:
split[a1, a2] a1 is string to split, a2 is the delimiter, splits usually go into arrays
for oh we are using Astrings, strings that can be indexed to retrieve items using the "get" function.
Another way to build giant strings from building block is:
cop[a1, a2] better than String$ command because it makes a1 concatenated copies of string a2
rejoin[a1, a2] will take the special Astring, a1, formed from split or cop maybe bnd and split
and rejoin using the the delimiters given as a2. Say you have processed an Astring of data and
wish to save it in a file as comma separated or as line by line.
*** String slices:
mid1[a1, a2] AKA Mid$(a1, a2, 1) a 1 char return in a1 at a2
mid2[a1, a2] AKA standard Mid$(a1, a2) 2 argument return remainder of a1 starting at a2
mid3[a1, a2, a3] AKA standard 3 argument MID$
left[a1, num of chars] AKA Left$
right[a1, num of chars] AKA Right$
head[a1, a2] from a1 find a2 and take the part that comes before a2
tail[a1, a2] from a1 find a2 (end) and take the remainder of string from there.
*** String finds:
in2[a1, a2] position of first a2 found in a1
in3[a1, a2, a3] starting at a1, find and return a3 position in a2
*** Chars:
asc[a1] returns ascii value of char, space = 32, enter = 13, tab = 9, dbl quote = 34, hyphen = 45
chr[a1] returns char of ascii number chr(65) = A, chr(48) = 0
*** Trimming spaces:
rtr[a1] removes spaces from right
ltr[a1] removes spaces from left
trim[a1] removes spaces left and right
*** Shouting, whispering, modifying:
cap[a1] a1 in all capitals
low[a1] a1 all lower case
replace[source$,replace$,new$] - replaces a string with new$ wherever found in source$
*** Astrings: like arrays, these are strings you can "get" an item value by index #
Set Astring;index;itemToAddOrReassign - this is a command as opposed to an SFunction
so sets counterpart is get:
get[a1, a2] from Astring, a1, get the item at index, a2. Compare to var = A(i), var = get[astring, index]
nItems[Astring] number of Items in the Astring (counts delimiters and adds 1)
*** Now for some easy string functions:
len[a1] returns the length in chars of a1
spc[a1] returns a1 block of spaces
date[] no argument Date$
time[] no argument Time$
clip[] no argument get contents of _ClipBoard
timer[] no argument still need [] this the number of secs since midnight, 3 decimals at least.
*** Special Order String Functions:
ASSORT[a1] ascending string sort of astring, a1
DSSORT[a1] descending string sort of astring, a1
ANSORT[a1] ascending numeric sort of astring, a1
DNSORT[a1] descending numeric sort of astring, a1
Fval[a1] will attempt to evaluate a string or numeric expression of functions and literals.
*** File simplicity:
Save Astring;toFileName
AstringVar = load[fileName]
files[] - AString list of the files in the current directory
*** 2021-03-09 The "Screen" commands are now ; delimited to allow each argument to be evaluated.
Commands effected: loc at tag ink pix line box fbox circ fcirc ftri wait show paper
All demos effected have been updated.
New command: cpr for centering print on a row: cpr row;my text is this with a variable ;here; to plug in.
See: Test ac Fval$ Tester.txt, demo as this has been completely rewritten for cpr and first
test of using Fval$ to check arguments to commands.
A Splash screen for Oh?
*** 2021-03-10 Added 300 plus lines for File Dialog & Company including a very nice array displayer for showing the
loaded programs, maybe I could do a help? No that is better in tabbed Notepad++
Internal Splash is gone and the other internal test programs, net effect 1300 LOC including the start
of oh's menu system
direntry.h has been added to the zip package, please copy | paste into your QB64 folder for cross platform
directory and files access if you dont have a copy there already. This allows the File Dialog part of oh to
work correctly.
*** 2021-03-14
Dumped checking the _ClipBoard for a program now with File Dialog and all.
Tidied up oh's menu a tiny bit.
Check cpr handling of embedded variables and or SF[]'s, OK that is fixed up but not sure I want to
do that for the other print commands? Oh yes!!! I do want that! (Done)
Note: it you call edit without a file name you will wind up on the command line, just type exit.
Add Command:
Save Astring;Filename
Reminder: Astring is my term for a string with indexed variable length string items.
Save will store each item as a line in given filename.
Add SFunction:
Astring = Load[filename]
So that you can load a file into an Astring for indexed access to lines.
Consolidate Set and RndPt (even though RndPt takes no arguments it assigns a var)
commands with all the other ; delimited commands that do calculations. So now,
you don't have to have middleman variables in the commands, you can calc directly
in the command.
Add preloaded Mouse variables:
MouseX, MouseY, MouseL, MouseR
Locate (x, y) mouse in pix and Boolean Left or Right Button Down
Add preloaded variable:
Key
For keypress detection.
New Poll command to update all those preloaded variables with mouse and Key status.
Left$ and Right$ var = Right[a1$, val(a2$)
Ubound of Astring amount = nItems[AString]
*** 2021-03-16
Added: string math for extended arithmetics in SFunctions
add[a1,a2]
subtract[a1,a2]
mult[a1,a2]
divide[a1,a2]
(Divide: numerator/denominator, is calc'd by multiplying numerator by inverse of denominator).
(So the inverse is calculated to 100 Decimal Places, but sometimes 100 decimal places wont do
so inverse[posInteger,NumberOfDecimals] is added to do custom "division" by controlling the
decimals in inverse and to be then multiplied by numerator in a hand made division calculation.)
Added command:
clipout a1 + whatever argument 1 is holding: literal, variable value substitution
or expression of SFunctions replaces contents of Clipboard
Added command:
clipadd a1 appends to, instead of replaces, Clipboard data.
Added SFunction clip[] no argument SFunction, you still need the brackets.
This puts the contents of the contents of the Clipboard into the spec'd var.
eg var = clip[]
*** 2021-03-17
Basically just a few fixes and tweaks to get Donut.txt to work. Fixed the file line count
with a different load of a file. Fixed bug from reading the Len[] of a file, thrown off by
the file containing []'s!!! So a new SafeBS$ Function filter/converter created that
converts [] to {}. Needed to fix the Ink, Paper and color restoring after Run.
*** 2021-03-19
For Mouse Action Shooter - Target Practice (Graphics Game #2 attempt)
3/18 added mouse TF - command with 1 argument. True to Show Mouse, False to Hide Mouse
3/18 added abs[arg1] - SFunction with 1 argument. Kind of surprised how much I use ABS.
3/18 added timer[] - SFunction no argument, still need brackets.
3/18 added atan2[a1 (=deltaY's) , a2 (=deltaX's) ] SFunction with 2 args, definitely a plus!
Find the angle of point 1 (x1,y1) from point 2 (x2, y2)
Basic: var = _atan2(y1-y2,x1-x2) or oh: var = atan2[s[y1,y2],s[x1,x2]]
3/19 added beep (command) no args, main reason: to help debug.
*** 2021-03-22
3/20 added inverse[PosInteger,NumberOfDecimals] for custom division or control of decimals.
This is = 1/PosNumber to a set amount of decimals.
3/21 added files[] - no argument SFunction that loads the files of current directory into an AString.
3/21 added replace[stringSource,stringToReplace,StringToRplaceWith] - 3 arguments SFunction.
3/21 fix? load[] renders [ brackets impotent by swapping them with { brackets
save Astring;FileName sort of needs to reverse that by replacing { back to [
This is messy, in future something else may be a better solution.
3/21 Line labels now end with \ instead of colon. This is to be consistent to oh rule, no shifts.
3/21 Added another preloaded variable nl (Next Line) for file line delimiter.
Vnames$(11) = "NL": Vvalues$(10) = Chr$(13) + Chr$(10)
3/21 Gutted out opening code and rewrote the code to display files on a scroller when have a
filename and existing file. Now the menu runs across top line in yellow and red and can
click menu item or key press first letter for New, Edit, Load, Run, or Quit.
Much better if I do say so myself :) This completes my goals for this revision.
*** 2021-03-27
3/23 Fix file display scroller to accept PgUp, PgDn, Home, End Keypresses.
Also run file lines through filter JIT to replace tabs with 4 spaces and other
chars < 32 with *. This enables the display of 39 lines on 39 lines without screen
scrolling and menu line lost.
3/23 NL fixed and working as expected in: Test oh replace and nl.txt file.
3/23 Adding SHARED Lists: CmdList$ and FunList$ for Function OK$ a line Syntax checker function
that will return nothing (OK) if the line is fine, or what it found wrong with proposed
program line. Inventory: 40 commands (fix 4 more), 74 SFunctions
3/26 Added 3 more procedures for Syntax checking and immediately learned I missed 4 commands in
command list. The only line it caught after that was an title line without a formal comment.
I started editing Particle Fountain (it is hopelessly S L O W) and the syntax checker caught
a missing argument in an Or line when I mistakenly typed a } instead of a regular ] bracket.
Good, it catches at least something. So now lines start with comments, commands, variables
or line labels\ (\ ends a line label now).
3/27 Fixed - Mouse Action Shooter - the first bullet fired was always nothing?? and yet 10 points
is deducted from the score as it should be. Show me the bullet! I just initialized all the
bullets properties instead of only the bLive AStrings (arrays).
3/27 Fixed. After editing a file, you have to change directory and change back to get the new
file loaded with the changes. I now do that automatically in code after an Edit.
*** 2021-03-27A
3/27A Syntax checking had a little sloppy handling of closing ] assuming it was at end of line
instead of checking if one was actually there to match opening [. I found 4
working programs that were missing a final bracket at the end. I also found a program
that used [] instead of parenthesis and it was flagged for unknown SFunction. So that part
of syntax checking is also fixed, you will be flagged for unrecognized functions.
So I went through all working programs and they now fly through syntax checking right into
a successful run.
*** 2021-06-03 fix divide$
6/03 Fix the divide$ Function so that, Test oh High Precision Square Root.txt, file program works.
Also found the clipout and clipadd help in, oh Cheat Sheet.txt in error and fixed (no square
brackets to enclose the argument).
*** 2021-06-15 String Math update
6/15 A number of fixes and improvements to the String Math package including new sqrroot[number]
Function. Unfortunately with the new fixes the inverse of STx number takes a bit longer than
it did, it's a wonder it was getting correct results originally. When testing all the
programs I noticed the nl "constant" I had forgotten all about. This is doing double spaced
lines because it is Chr$(13)+Chr$(10) probably should be one or other, not both together.
Since last update we created new programs:
Aurels Henon code, Bresenham Circle Fill, First 100 digit Fibonacci, Sqr Root estimating.
A version of the last program became part of the String Math package update!
KEYS48 is a simple virtual piano (with 48 playable keys/notes) that you can play, record & save little songs with. Use the mouse to click on and play the notes. There's a menu (press M) that lists available commands. Saved songs (.K48 files) have a very small size thanks to QB64's _DEFLATE command.
There are a few pre-recorded songs included that you can load and play. When you start the program, press "L" to load a sample song, then type in DAV or SAMPLE or WALTZ to load & hear those songs. Those are examples of what you can record with Keys48.
This was made mostly for coding fun and not intended to be a serious instrument. Hope you will have fun with it too.
As you guys might know (if you don't, what the heck have you been doing -- hiding your head under a rock somewhere??), I've transitioned into a writer/novelist now that I've more or less officially retired here at the farm. October to January still keeps me busy with farm life, but otherwise I've got the rest of the year free to indulge my hobbies however I want.
For ages, I've been promising, "Some day, I'm going to sit down and end up writing up some sort of overly complex and wordy manual for QB64 that everyone can laugh at and nobody will probably ever use!"
Well, I just so happen to be snowed in -- and have been snowed in for the last few weeks -- and my boredom and restlessness has now gotten to the point where I finally decided to sit down and start on this little project: The QB64 Bible.
For now, all I've got is basically a write up about SCREEN 0 -- (and it's only about 14 pages long) -- but I hope it shows the style and format I'm shooting for here, and the information which I want to try and gather up into one easy to find and reference area.
Feel free to download it. Study it. Point out anything that seems unclear or imprecise, or that you just don't like, and offer any ideas of what you guys think should go into this little project. I'm just starting on this, but if all works out, I can probably churn out a few hundred pages of nonsense by the end of the month (provided I stick with this project exclusively during that time), so at that point it might actually have enough information in it to become something that somebody, somewhere, might want to make use of sometime in the future.
Just remember: This is a work in progress and is subject to any and all revisions, edits, changes, additions, and deletions -- at my whim and whimsey -- for the foreseeable future.
UPDATE: There's a little more in there now than just SCREEN 0 stuff. The above was a copy/paste from the first page of the old topic from the past forums which we had, and I'd already posted several additions and updates to the work from then till when everything was shut down.
Just checked this in Keybone's QB64 - Lite for Linux, it's been awhile since I've seen this.
Code: (Select All)
Option _Explicit
_Title "Spiral Colored Balls" 'B+ 2019-10-29 mod from
' 2019-10-29 mod be able to draw these balls anywhere
' Rotate colors on a sphere.txt for JB v2.0 bplus 2018-04-16
' from (extremely simplified) Double spiral.bas SmallBASIC 0.12.8 [B+=MGA] 2017-03-28
Const xmax = 1200, ymax = 700, pi = _Pi, nBalls = 10, ww = 3.14159 / 2, gravity = 2
Type ball
x As Single
y As Single
a As Single
dx As Single
dy As Single
sc As Single
pr As Single
pg As Single
pb As Single
pn As Single
End Type
Dim Shared b(1 To nBalls) As ball
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 100, 20 'this fits my screen yours may be different
Randomize Timer
Dim i As Integer, j As Integer, b As Integer, power, sky As Long
For i = 1 To nBalls
newBall i
Next
sky = _NewImage(xmax, ymax, 32)
_Dest sky&
For i = 0 To ymax
Line (0, i)-(xmax, i), _RGB32(100 + i / ymax * 40, 100 + i / ymax * 50, 160 + i / ymax * 95)
Next
_Dest 0
While _KeyDown(27) = 0
_PutImage , sky&, 0
For i = 1 To nBalls
'ready for collision
b(i).a = _Atan2(b(i).dy, b(i).dx)
power = (b(i).dx ^ 2 + b(i).dy ^ 2) ^ .5
For j = i + 1 To nBalls
If Sqr((b(i).x - b(j).x) ^ 2 + (b(i).y - b(j).y) ^ 2) < 200 * (b(i).sc + b(j).sc) Then
b(i).a = _Atan2(b(i).y - b(j).y, b(i).x - b(j).x)
b(j).a = _Atan2(b(j).y - b(i).y, b(j).x - b(i).x)
Exit For
End If
Next
b(i).dx = power * Cos(b(i).a)
b(i).dy = power * Sin(b(i).a)
b(i).dy = b(i).dy + gravity
b(i).x = b(i).x + b(i).dx
b(i).y = b(i).y + b(i).dy '+ 2 * gravity
If b(i).x < -200 * b(i).sc Or b(i).x > xmax + 200 * b(i).sc Then
newBall i
End If
If b(i).y + 220 * b(i).sc > ymax Then
b(i).y = ymax - 220 * b(i).sc
b(i).dy = b(i).dy * -.8
If b(i).dx = 0 Then b(i).dx = rdir Else b(i).dx = b(i).dx * 1.03
End If
drawBall i
Next
_Display
Wend
Sub drawBall (i)
Dim w, r, e, tmp, p, x, y, lc As Long
w = ww 'fix
For r = 190 To 0 Step -.25
e = w - pi / 4 / (490 - 300)
tmp = e: e = w: w = tmp
For p = 0 To pi Step pi / 144
e = Int((Cos(w) * 380) / 2)
x = b(i).x + e * b(i).sc * Cos(p * 2)
y = b(i).y - 90 * b(i).sc + e * b(i).sc * Sin(p * 2) + r * b(i).sc
lc = lc + 1
If lc Mod 25 = 0 Then
fcirc x, y, 6 * b(i).sc, plasma~&(i)
End If
Next
Next
End Sub
Sub newBall (i)
b(i).x = Rnd * xmax - 40 + 20
b(i).y = Rnd * -200
b(i).dx = rand(1, 3) * rdir
b(i).dy = rand(-5, 5)
b(i).sc = rand(2, 5) / 10
setRGB i
End Sub
Sub setRGB (i)
b(i).pr = Rnd ^ 3: b(i).pg = Rnd ^ 3: b(i).pb = Rnd ^ 3: b(i).pn = 1
End Sub
Function rand (lo, hi)
rand = (Rnd * (hi - lo + 1)) \ 1 + lo
End Function
Function rdir ()
If Rnd < .5 Then rdir = -1 Else rdir = 1
End Function
'from Steve Gold standard
Sub fcirc (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, 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), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
10x10 is an addictive puzzle game - much like the Woody puzzle in which this game is modeled after. To play, drag pieces onto the board to make completed lines (rows or columns). Completed lines will erase. Bonus points given for clearing more than one line at a time.
Game progress is saved so you can quit and resume later. Game ends when there's no space left of the board for pieces. Click on the 'Menu' at the top right to pop up the menu of options. You may also right click the mouse, or press M to bring up the menu. HI score is saved. Try to beat your own HI score.
This is the final version of 10x10 with updated graphics and sound effects. I'm not sure if this version ever was posted on the old forum. Here is is...
![[Image: Screenshot-610.png]](https://i.ibb.co/FqkSCbJ/Screenshot-610.png)
X
