| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| Random Tessellations |
|
Posted by: bplus - 05-09-2023, 02:29 PM - Forum: Programs
- Replies (33)
|
 |
Inspired by Charlie's BAM version I started from scratch for QB64 version with added full colorization mode.
Use b key to toggle color modes or esc to quit, any other key shows another random tile tessellated screen:
Code: (Select All) _Title "Tessellation use b to toggle to 1 color and black or full color"
' b+ 2023-05-09 - Tiling with a pattern
'
' Inspired by Charlie's BAM example:
' https://qb64phoenix.com/forum/showthread.php?tid=1646&pid=15772#pid15772
'
' But I also wanted to try a colorized version.
'
' So use b key to toggle between:
' 1. a mod of Charlies version with different pixel block size with black backgrounds
' 2. the colorized version which reminds me of Magic Eye Art
'
DefLng A-Z
Screen _NewImage(800, 600, 12) ' only 16 colors here
_ScreenMove 250, 50
Dim Shared Pix ' Pix is number of pixels to Tile side
Dim Shared Scale ' Change a pixel to a bigger square block for not so subtle patterns
Dim Shared Tile ' Handle that stores Tile Image in memory to call up with _PutImage
Dim Shared B ' Set color mode from Full 16 colors Rainbow to 1 like for printing a label
Do
If InKey$ = "b" Then B = 1 - B ' toggle coloring mode on a b keypress
MakeTile ' create a new random tiling pattern
Tessellate ' tile the screen with it
_PrintString (740, 580), "ZZZ..." ' Show user we are sleeping awaiting a key press
Sleep
Loop Until _KeyDown(27) ' quit when detect escape key on sleep
Sub MakeTile ' make a random tile to Tesselate according to B Mode coloring
Pix = Int(Rnd * 9) + 4 ' sets tile size: pix X pix or a 4X4 to 12X12 Tile coloring
Scale = Int(Rnd * 6) + 4 ' to change pixels to square blocks
If Tile Then _FreeImage Tile ' throw old image away
Tile = _NewImage(Scale * Pix - 1, Scale * Pix - 1) ' make new one
_Dest Tile ' draw in the memory area Tile not on screen
oneColor = Int(Rnd * 15) + 1 ' one color and black background for B Mode
For y = 0 To Scale * Pix - 1 Step Scale
For x = 0 To Scale * Pix - 1 Step Scale
If B Then
If Rnd < .5 Then c = 0 Else c = oneColor 'one color and black background for B Mode
Else
c = Int(Rnd * 16)
End If
Line (x, y)-Step(Scale, Scale), c, BF ' draw square that is scaled pixel
Next
Next
_Dest 0
End Sub
Sub Tessellate ' just covering the screen with our Tile
For y = 0 To _Height Step Scale * Pix
For x = 0 To _Width Step Scale * Pix
_PutImage (x, y)-Step(Scale * Pix - 1, Scale * Pix - 1), Tile, 0
Next
Next
End Sub
|
|
|
Robot floor painter |
|
Posted by: mnrvovrfc - 05-08-2023, 10:39 PM - Forum: Programs
- Replies (2)
|
 |
This is a silly program that could almost be used as screensaver. It needs music LOL, so it's better.
I derrived the idea from a book on programming games in GW-BASIC by David L. Heiserman (had to look it up), but it's not the book being sold on Amazon that readily comes up in the searches. I think it was called "101 Games In BASIC" or alike. The programs weren't all games; some of them did silly things on the screen. My favorite from them was the "Hacker's Aid". I made my own version with fancy text-graphics and with beeping from "SOUND". It even emulated dial-tone telephone and ringing LOL.
Honorable mention was the "Surrogate Cusser" which could have gotten boring quickly. Fiddlesticks!
I don't remember very well but there might have been a version of that book for the Radio Shack TRS-80 Color Computer, or for the Model III which was incapable of sound. Instead of sound it had a subroutine that "blinked" a short message on the screen. That was its favorite trick.
This program has the "robot" moving in a different way from the old program it was derrived from. It has a quirk not found in the old program.
Code: (Select All) 'by mnrvovrfc 8-May-2023
OPTION _EXPLICIT
DIM AS LONG scren
DIM AS INTEGER px, py, xi, yi, xn, yn, xx, yy, c, l, nivel
DIM AS _UNSIGNED _BYTE redo
RANDOMIZE TIMER
scren = _NEWIMAGE(120, 31, 0)
SCREEN scren
_DELAY 0.5
_SCREENMOVE 0, 0
_TITLE "Press [ESC] to quit."
nivel = 1
px = Random1(100) + 10
py = Random1(29) + 1
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
xn = nivel
yn = nivel
c = 0
l = Random1(8) + 4
redo = 0
DO
_LIMIT 100
IF redo THEN
redo = 0
ELSE
outchar px, py, 219, 0
END IF
px = px + xi * xn
py = py + yi * yn
IF px < 1 OR px > 120 THEN
px = px - xi * xn
py = py - yi * yn
redo = 1
END IF
IF py < 1 OR py > 30 THEN
px = px - xi * xn
py = py - yi * yn
IF nivel > 1 THEN nivel = nivel - 1
IF Random1(2) = 1 AND xn > 1 THEN xn = xn - 1
IF Random1(2) = 1 AND yn > 1 THEN yn = yn - 1
redo = 1
END IF
IF redo = 0 THEN
IF SCREEN(py, px) = 219 THEN
px = px - xi * xn
py = py - yi * yn
IF c < l THEN
IF Random1(2) = 1 THEN
xn = nivel
IF xn > 40 THEN xn = 40
ELSEIF Random1(2) = 1 THEN
yn = nivel
IF yn > 16 THEN yn = 16
ELSE
nivel = nivel + 1
IF nivel > 50 THEN
nivel = 1
FOR yy = 1 TO 30
FOR xx = 1 TO 120
outchar xx, yy, 32, 219
NEXT
NEXT
END IF
END IF
END IF
END IF
c = c + 1
IF c > l THEN
outchar px, py, 219, 0
IF nivel > 1 THEN nivel = nivel - 1
IF Random1(2) = 1 AND xn > 1 THEN xn = xn - 1
IF Random1(2) = 1 AND yn > 1 THEN yn = yn - 1
redo = 1
END IF
END IF
IF redo THEN
xi = (Random1(2) - 1) * 2 - 1
yi = (Random1(2) - 1) * 2 - 1
c = 0
l = Random1(8) + 4
ELSE
outchar px, py, 82, 0
_DISPLAY
END IF
LOOP UNTIL _KEYDOWN(27)
_AUTODISPLAY
SYSTEM
SUB outchar (x AS INTEGER, y AS INTEGER, ca AS _UNSIGNED _BYTE, cb AS _UNSIGNED _BYTE)
STATIC sch AS _UNSIGNED _BYTE
IF cb THEN
sch = SCREEN(y, x)
IF sch = cb THEN sch = ca ELSE sch = cb
ELSE
sch = ca
END IF
LOCATE y, x: PRINT CHR$(sch);
END SUB
FUNCTION Random1& (maxvaluu&)
DIM sg%
sg% = SGN(maxvaluu&)
IF sg% = 0 THEN
Random1& = 0
ELSE
IF sg% = -1 THEN maxvaluu& = maxvaluu& * -1
Random1& = INT(RND * maxvaluu& + 1) * sg%
END IF
END FUNCTION
|
|
|
|
| Looking for a reliable way to determine if a drive letter is in use |
|
Posted by: hanness - 05-08-2023, 03:46 PM - Forum: General Discussion
- Replies (24)
|
 |
I'm looking for a reliable way to determine if a drive letter is in use but I'm running into some difficulties.
Take the following small clip as an example:
A$ = "F:\"
If _DirExists(A$) Then
Print A$; " Exists"
Else
Print A$; "Does not exist"
End If
Normally, this works fine and indicates if the drive letter contained in A$ exists. But now consider these two exceptions:
1) Suppose I have a thumbdrive attached to the system that has been wiped clean. By wiped clean, I mean you open DISKPART, select the thumbdrive, and perform a "CLEAN" on that drive. In this instance, there will be no partitions on the drive, but in File Explorer, the drive still shows up with a drive letter. However, the clip above will indicate that this drive letter does NOT exist. As a result, if I try to assign that drive letter to another drive, it will fail because it is already in use.
2) The same thing happens if I connect a drive that has BitLocker encryption but has not yet been unlocked. The QB64PE code will indicate that the drive letter does not exist even though it is already in use.
Any suggestions on a better way to determine if a drive letter is in use?
|
|
|
|
| SHELL creates unicode file, can't read correctly with LINE INPUT |
|
Posted by: thesolarcode - 05-05-2023, 10:39 PM - Forum: Help Me!
- Replies (3)
|
|
Hi,
I have this snippet to get the number of processor cores.
Problem is that the SHELL command produces a unicode text file and LINE INPUT is not able to read the text correctly.
Manually converting tmp.txt to an ascii file solves the problem.
Question is why is the file created as unicode by default?
Can I influence this from within QB64?
OS is Win 11.
Btw.: I tried also OPEN ... FOR BINARY - doesn't change anything (e.g. LINE INPUT still can't read UNICODE as text):
Code: (Select All) returncode% = SHELL("wmic cpu get NumberOfCores >tmp.txt")
IF _FILEEXISTS("tmp.txt") THEN
OPEN "tmp.txt" FOR INPUT AS #1
DO UNTIL EOF(1)
LINE INPUT #1, a$
?">";a$;"<";filecount%;",len=";len(a$)
filecount% = filecount% + 1
LOOP
CLOSE #1
END IF
'KILL "tmp.txt"
|
|
|
|
| Good Coding with ElseIF |
|
Posted by: Dimster - 05-04-2023, 04:11 PM - Forum: Help Me!
- Replies (12)
|
|
Going back through some of my coding I found I've used Else and If where I perhaps should have used ELSEIF. It seemed to work out ok but I'm not sure if there is difference in how these two work together.
For example
If ..... then
....
....
...Else
... if .. then
...
...
Else
......
......
End if
V's
If ... then
....
....
ElseIF .... then
.....
....
Else
....
End If
The logic flow would suggest there is no difference.
|
|
|
|
Schizandra - the QB64 English wordlist-walker |
|
Posted by: Sanmayce - 05-03-2023, 10:54 PM - Forum: Help Me!
- Replies (25)
|
 |
Glad to share one practical etude written entirely in QB64 - Schizandra - an open-source 100% FREE GUI tool for Linux/Windows.
The attached file contains the sourcecode and the binaries, as for the 44GB file, it is to be shared when I find hosting... maybe later this week.
https://www.youtube.com/watch?v=X_zKU_ku8P4
Whenever the need for checking some word spelling (or derivatives i.e. sister-words) arises then Schizandra comes in handy as ... first line of defense.
Recently, I bought the cutest computer ever - 4 cores/threads, FANLESS, 8GB DDR4 2400Mhz, nvme SSD. It is excellent for off-line usage, trumping tablets and such with its power and miniaturistic/ergonomic design.
Basically, one can make quick searches into 45 mainstay corpora (put under one roof and sorted, thus each word is within its eventual cluster).
Didn't make the wildcard/fuzzy functionality since this revision is initial, it is as simple as possible.
Love that simplistic format, it will be used for other similar GUI utilities.
Featuring:
- 881,283,514 distinct English words;
- using 8x16 and 16x32 state-of-the-art Japanese fonts;
- always dealing with 152x40 characters (in modes below 2K using 8x16 font, in modes 2K+ it uses 16x32 font);
- easy on the eyes;
- works on old laptops (as my Thinkpad 11e called 'Djudjeto') with HD resolution i.e. 1366x768.
Code: (Select All) README.TXT
Schizandra quick overview
This is the initial release of the HUGEST English wordlist lookuperess :P
Many a corpus are included, see the .PDF file.
Just run the elf/exe on Linux/Windows.
Enfun!
2023-May-03,
Sanmayce
P.S.
My main email is no longer functional, the new one is sanmayce@yahoo.com
As always, I am open for suggestions, new functionalities and critiques.
Schizandra_r1.zip (Size: 3.64 MB / Downloads: 372)
|
|
|
|
| double to 2^53 |
|
Posted by: Jack - 05-03-2023, 02:49 PM - Forum: General Discussion
- Replies (4)
|
 |
Ok, I know that the size of the mantissa of double is 53 bits, see if you can guess what values will be printed by this snippet
Code: (Select All) Dim As Double x
x = 9007199254740992 ' 2^53
Print x
x = x + 1#
Print x
x = x + 1#
Print x
Print "================="
x = 9007199254740998
Print x
x = x + 1#
Print x
x = x + 1#
Print x
Print "================="
x = 9999999999999998
Print x
x = x + 1#
Print x
|
|
|
|
|
