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,033
|
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
|
|
|
Wiki Updates |
Posted by: TerryRitchie - 05-10-2023, 09:00 PM - Forum: Wiki Discussion
- Replies (5)
|
|
I noticed _DEVICE$ now includes [DISCONNECTED] when a controller is disconnected but find no mention of this in the Wiki. When will the Wiki be updated with the new controller features offered by v3.7.0?
|
|
|
A program to solve a problem: filter Linux/Unix 'ls' output |
Posted by: TDarcos - 05-10-2023, 08:58 PM - Forum: Programs
- Replies (1)
|
|
This is my first program contribution, it worked so well I thought I'd pass it on.
Here is the backstory about why I wrote this program.
I had a problem. My Windows computer started BSODing during initial boot/startup. Since it was an actual BSOD with frowny face, this means it's a Windows problem, not a hardware one. After several attempts to use any of the recovery methods which would leave my files intact, I came to the conclusion that I am in a pickle. Then, I find the recovery partition no longer works. Now, I came to the condclusion that I was, quite frankly, screwed. So, I used the time-tested method of attacking a problem: I threw money at it.
I went on Amazon and purchased a refurbished machine. The new (to me) machine is actually better than the one I had. A "Dell OptiPlex 7020 Desktop Computer,Intel Quad Core i7 4790 3.6Ghz, 32GB Ram New 2TB SSD." After I received it, I discovered that while it has 4 cores (as I had expected) it has 8 threads (which i did not.) So the computer is actually better than what I thought I was buying. With that I purchased something I really needed: a 4 TB ruggedized external hard drive, so I can back up my computers without worrying about someone dropping it. I already have a 6 TB external, but I don't feel good about it being moved around.
The price was terrific: with Windows 10 Professional, it was $265.00. Add the external drive and sales tax, $401. So I set up the new computer, and have it build a Windows recovery SSD on an SD card. Plug the reader into the old computer, reset the BIOS to allow boot from an external drive, and I try again. Nothing works. So, from my new computer, I download a Linux distribution,Xubuntu. Repeat the process and it boots fine, file manager can see the internal drive, and it can even see the 6TB external, but not the 4TB ruggedized (even though the new machine does). So I copied my most recent files from my working directory to the 6 TB.
The Problem
I do have a backup of my huge collection of downloaded open-source software on the 6TB but it's old., from last year. It does not have local changes I made from writing programs. On Windows, I just have Free File Sync scan the work directory and mirror to backup. So that is out. I had, however, downloaded the Linux version of QB64PE, but attempt to install it fails because the Wifi adapter apparently is not recognized; it can't download required packages.
Well, I could just copy the new archive to replace the backup. About 1.3 million files, 100,000+ directories, 411 GB, and will take about 500 hours, So, that's not an answer. So how can I solve this problem? So, it hits me: run an 'ls' directory scan with recursive subdirectory search, piped to a file, then take that file over to my new computer and write a filtering program to run there. I had ls exclude owner and group, and list one file per line. Output from ls looks like this:
Output:
Code: (Select All) Paul (From LENOVO)/:
total 39638
drwxrwxrwx 1 163840 Apr 30 17:45 gatekeeper
drwxrwxrwx 1 20480 Feb 21 17:06 MERGER-raw
drwxrwxrwx 1 4096 Feb 21 16:49 cvs2svn
...
-rwxrwxrwx 1 631462 Nov 23 2017 .cardpeek.log
-rwxrwxrwx 1 52475 Aug 27 2017 reasonable-argument.png
Paul (From LENOVO)/gatekeeper:
total 604715
-rwxrwxrwx 1 527259 Apr 30 17:45 Marnie.odt
What can be determined from this is:
- The current directory is shown followed by a colon.
- The first letter of a file entry is 'd' for a directory. Ignore these; we get specific directories from the prior item.
- Size summary starts with "total ".
- There is a blank line before a new directory.
- Items from 2023 have a colon in the time field, older files have a year in the field.
- Entries are separated by one space, with the file name last.
I have one additional problem. Just the listing of files itself is an 88 megabyte text file!
The solution:
Code: (Select All) ' Process ls program output to exclude files before this year
FN$ = "k:\files.list"
outFile$ = "k:\keepfiles.list"
Print
Locate 5, 1
Print Time$
FF& = FreeFile
lc = 0
Total$ = "total "
Open FN$ For Input Access Read As #FF&
OutFile& = FreeFile
Open outFile$ For Output As #OutFile&
While Not EOF(FF&)
Line Input #FF&, Line$
Line$ = _Trim$(Line$)
LineEnd = Len(Line$)
If Line$ = "" Then GoTo SKIP
If Left$(Line$, 6) = "total " GoTo SKIP ' avoid summary
Colon = InStr(Line$, ":")
If Colon = Len(Line$) Then ' it's a directry being listed
Curdir$ = _Trim$(Left$(Line$, Colon - 1))
If Right$(Curdir$, 1) <> "/" Then Curdir$ = Curdir$ + "/"
Locate 9, 1: Print Space$(240): Locate 9, 1
Print "Current dir="; Curdir$
ListDir = ListDir + 1
GoTo SKIP
End If
If Left$(Line$, 1) = "d" Then
DirCount = DirCount + 1
GoTo SKIP
End If
FileCount = FileCount + 1
' First, skip attributes
SpacePos = InStr(1, Line$, " ")
'Skip over node count
SpacePos = InStr(SpacePos + 1, Line$, " ")
'Skip over file size
SpacePos = InStr(SpacePos + 1, Line$, " ")
' determine if current year
Colon = InStr(SpacePos, Line$, ":")
If Colon = 0 Then
skipFile = skipFile + 1
' Print "colon at "; Colon; " skipping "
' Print Line$
GoTo SKIP
End If
SpacePos = InStr(Colon + 1, Line$, " ")
Print #OutFile&, Curdir$ + Mid$(Line$, SpacePos + 1)
Chosen = Chosen + 1
SKIP: '
If FileCount Mod 5000 = 0 Then
Locate 2, 1
Print FileCount; " ";
Locate 5, 20
Print Time$
End If
Wend
Close #FF&
Close #OutFile&
Locate 6, 1
Print Time$
Print "Search directories "; ListDir
Print "Subdirectories "; DirCount
Print FileCount; " Files Found"
Print skipFile; " Files skipped"
Print Chosen; " Files chosen for review"
End
Result? Of more than 900,000 files scanned, I need to copy 53. That's all. The program took 5 minutes, processing an average of about 2500 items per second. A really satisfying conclusion, and should put paid to those who claim Basic, and specifically QuickBasic, is not relevant for solving real-world problems.
Paul
|
|
|
Memory Leak |
Posted by: NasaCow - 05-10-2023, 02:27 AM - Forum: Help Me!
- Replies (12)
|
|
Never noticed it before but my menu selection screens have a memory leak! It keeps adding about 8MB/s of system memory. It is a pretty forward loop and the MOUSE calls are not the source (they were all commented out when I was trying to locate the source of the leak). I am really at a loss here....
Code: (Select All) DO
LIMIT LIMITRATE
CLS
PUTIMAGE (0, 0), BGImage
MENUMAKER Menu()
SELECT CASE Pointer
CASE 0: PUTIMAGE (MenuPos(2).X1 - 50, MenuPos(2).Y1 + 10), CheckSelect
CASE 1: PUTIMAGE (MenuPos(3).X1 - 50, MenuPos(3).Y1 + 10), CheckSelect
CASE 2: PUTIMAGE (MenuPos(4).X1 - 50, MenuPos(4).Y1 + 10), CheckSelect
CASE 3: PUTIMAGE (MenuPos(5).X1 - 50, MenuPos(5).Y1 + 10), CheckSelect
END SELECT
DISPLAY
IF SelectFlag THEN PAUSE TIME 'Avoid double press delay
SelectFlag = FALSE 'reset input
'Checking for key press (keyboard)
IF KEYDOWN(CVI(CHR$(0) + "H")) THEN ' up case
IF Pointer = 0 THEN Pointer = 3 ELSE Pointer = Pointer - 1
SelectFlag = TRUE
END IF
IF KEYDOWN(CVI(CHR$(0) + "P")) THEN 'down case
IF Pointer = 3 THEN Pointer = 0 ELSE Pointer = Pointer + 1
SelectFlag = TRUE
END IF
'Checking for mouse input
MOUSE "Poll"
MOUSE "Release"
MOUSE "Action"
MOUSE "Loop"
LOOP UNTIL KEYDOWN(13) OR KEYDOWN(32) OR MFlag 'Return/space bar/mouse click to select
(Using almost 3 times as Chrome after a few mins...)
It seems to only happen on Menu selection screens. The leak appears in all V4 releases from me but V3 does not have the leak. Any thoughts what it may be?
If any additional code is needed or anything else of the sort, please let me know!!
|
|
|
Linux only: random dark modes for KDE |
Posted by: mnrvovrfc - 05-09-2023, 11:10 PM - Forum: Programs
- No Replies
|
|
This is a program that fabricates desktop environment color sets for KDE Plasma. :O
It creates a definition which changes the colors for the window title bar and stuff contained inside the window such as buttons and text fields. It also affects the "main" panel that contains the desktop menu, digital clock, notifications etc.
The random scheme could be improved. Especially for the window title bar. Generally dark has to contrast with light. It seems far too often it creates bright pink as foreground color, but the important thing is that it could be seen. The color settings for the tooltip are not touched. The original definition was from "Oxygen Cold".
This program creates only "dark" modes. To get light ones might have to tone down what two of the functions do. Swap "lightcolor$" and "darkcolor$" assignments on RHS for starters. But something has to be done also about "twincolor$" so it returns dark colors, ie. the value is related to "darkcolor$".
The color definitions are dropped right into the area the System Settings/Appearance/Colors expects them so they could be viewed straight away. Otherwise it's clunky to load one definition at a time from disk only to see what it is. After all, they are harmless text files. (Um, for some people being unable to see anything on the screen clearly, because foreground and background colors are almost the same, counts as "causing harm" but anyway. Windows doesn't allow it, but also doesn't allow too many other combinations which could be sensible but could tire the eyes faster.)
The output example of this program will not change the position nor behavior of widgets or other screen elements, or any aspect of its appearance than the colors. This doesn't affect applications such as Kate and Konsole which have distinct settings, even if they were written by KDE. (Kate/KWrite does have a plethora of color settings and a program like this one could be created for it.) It might cause some "Plasmoids" and other widgets to look weird, and it might not work well with certain visual effects the young people love so well. It won't affect a bunch of other applications that keep their own settings such as Geany.
Code: (Select All) 'by mnrvovrfc 9-May-2023
'for Linux, and KDE Plasma v5.20 and later
$CONSOLE:ONLY
option _explicit
dim sco(1 to 12) as string
dim ani$, a$, lf$, u as long, ff as long
dim as integer rr, gg, bb, i, w
lf$ = chr$(10)
for w = 1 to 10
for i = 1 to 3
sco(i) = lightcolor$
sco(i + 5) = darkcolor$
next
sco(4) = sco(Random1(3))
sco(5) = sco(Random1(3))
sco(9) = sco(Random1(3) + 5)
sco(10) = sco(Random1(3) + 5)
a$ = twincolor$
u = instr(a$, "|")
sco(11) = left$(a$, u - 1)
sco(12) = mid$(a$, u + 1)
ani$ = "[ColorEffects:Disabled]" + lf$ +_
"ColorAmount=0" + lf$ +_
"ColorEffect=0" + lf$ +_
"ContrastAmount=0.65" + lf$ +_
"ContrastEffect=1" + lf$ +_
"IntensityAmount=0.1" + lf$ +_
"IntensityEffect=2" + lf$ +_
"" + lf$ +_
"[ColorEffects:Inactive]" + lf$ +_
"Color=112,111,110" + lf$ +_
"ColorAmount=0.025" + lf$ +_
"ColorEffect=2" + lf$ +_
"ContrastAmount=0.1" + lf$ +_
"ContrastEffect=2" + lf$ +_
"Enable=true" + lf$ +_
"IntensityAmount=0" + lf$ +_
"IntensityEffect=0" + lf$ + lf$
ani$ = ani$ + "[Colors:Button]" + lf$ +_
"BackgroundAlternate=" + sco(7) + lf$ +_
"BackgroundNormal=" + sco(6) + lf$ +_
"DecorationFocus=" + sco(11) + lf$ +_
"DecorationHover=" + sco(12) + lf$ +_
"ForegroundActive=" + sco(1) + lf$ +_
"ForegroundInactive=" + sco(11) + lf$ +_
"ForegroundLink=" + sco(5) + lf$ +_
"ForegroundNegative=" + sco(5) + lf$ +_
"ForegroundNeutral=" + sco(5) + lf$ +_
"ForegroundNormal=" + sco(5) + lf$ +_
"ForegroundPositive=" + sco(5) + lf$ +_
"ForegroundVisited=" + sco(5) + lf$ +_
"" + lf$ +_
"[Colors:Complementary]" + lf$ +_
"BackgroundAlternate=196,224,255" + lf$ +_
"BackgroundNormal=24,21,19" + lf$ +_
"DecorationFocus=58,167,221" + lf$ +_
"DecorationHover=110,214,255" + lf$ +_
"ForegroundActive=255,128,224" + lf$ +_
"ForegroundInactive=137,136,135" + lf$ +_
"ForegroundLink=88,172,255" + lf$ +_
"ForegroundNegative=191,3,3" + lf$ +_
"ForegroundNeutral=176,128,0" + lf$ +_
"ForegroundNormal=231,253,255" + lf$ +_
"ForegroundPositive=0,110,40" + lf$ +_
"ForegroundVisited=150,111,232" + lf$ +_
"" + lf$ +_
"[Colors:Selection]" + lf$ +_
"BackgroundAlternate=" + sco(3) + lf$ +_
"BackgroundNormal=" + sco(4) + lf$ +_
"DecorationFocus=" + sco(3) + lf$ +_
"DecorationHover=" + sco(4) + lf$ +_
"ForegroundActive=" + sco(10) + lf$ +_
"ForegroundInactive=" + sco(9) + lf$ +_
"ForegroundLink=" + sco(10) + lf$ +_
"ForegroundNegative=" + sco(10) + lf$ +_
"ForegroundNeutral=" + sco(8) + lf$ +_
"ForegroundNormal=" + sco(10) + lf$ +_
"ForegroundPositive=" + sco(10) + lf$ +_
"ForegroundVisited=" + sco(8) + lf$ +_
"" + lf$ +_
"[Colors:Tooltip]" + lf$ +_
"BackgroundAlternate=196,224,255" + lf$ +_
"BackgroundNormal=192,218,255" + lf$ +_
"DecorationFocus=43,116,199" + lf$ +_
"DecorationHover=119,183,255" + lf$ +_
"ForegroundActive=255,128,224" + lf$ +_
"ForegroundInactive=96,112,128" + lf$ +_
"ForegroundLink=0,87,174" + lf$ +_
"ForegroundNegative=191,3,3" + lf$ +_
"ForegroundNeutral=176,128,0" + lf$ +_
"ForegroundNormal=20,19,18" + lf$ +_
"ForegroundPositive=0,110,40" + lf$ +_
"ForegroundVisited=69,40,134" + lf$ +_
"" + lf$ +_
"[Colors:View]" + lf$ +_
"BackgroundAlternate=" + sco(7) + lf$ +_
"BackgroundNormal=" + sco(6) + lf$ +_
"DecorationFocus=" + sco(11) + lf$ +_
"DecorationHover=" + sco(12) + lf$ +_
"ForegroundActive=" + sco(1) + lf$ +_
"ForegroundInactive=" + sco(11) + lf$ +_
"ForegroundLink=" + sco(3) + lf$ +_
"ForegroundNegative" + sco(3) + lf$ +_
"ForegroundNeutral=" + sco(4) + lf$ +_
"ForegroundNormal=" + sco(1) + lf$ +_
"ForegroundPositive=" + sco(4) + lf$ +_
"ForegroundVisited=" + sco(5) + lf$ +_
"" + lf$ +_
"[Colors:Window]" + lf$ +_
"BackgroundAlternate=" + sco(7) + lf$ +_
"BackgroundNormal=" + sco(6) + lf$ +_
"DecorationFocus=" + sco(11) + lf$ +_
"DecorationHover=" + sco(12) + lf$ +_
"ForegroundActive=" + sco(1) + lf$ +_
"ForegroundInactive=" + sco(11) + lf$ +_
"ForegroundLink=" + sco(3) + lf$ +_
"ForegroundNegative" + sco(3) + lf$ +_
"ForegroundNeutral=" + sco(4) + lf$ +_
"ForegroundNormal=" + sco(1) + lf$ +_
"ForegroundPositive=" + sco(4) + lf$ +_
"ForegroundVisited=" + sco(5) + lf$ +_
"" + lf$ +_
"[General]" + lf$ +_
"Name=randomcolorscheme" + Zeroes$(w, 2) + lf$ +_
"shadeSortColumn=true" + lf$ + lf$ +_
"[KDE]" + lf$ +_
"contrast=4" + lf$ + lf$ +_
"[WM]" + lf$ +_
"activeBackground=" + sco(7) + lf$ +_
"activeForeground=" + sco(5) + lf$ +_
"inactiveBackground=224,223,222" + lf$ +_
"inactiveForeground=20,19,18" + lf$
a$ = environ$("HOME") + "/.local/share/color-schemes/randomcolorscheme" + Zeroes$(w, 2) + ".colors"
ff = freefile
open a$ for output as ff
print #ff, ani$
close ff
print w
next 'w
print "FINISHED"
system
'CHANGED: rr, gg, bb
function lightcolor$ ()
dim as integer rr, gg, bb
rr = Rand(192, 255)
gg = Rand(192, 223)
bb = Rand(224, 255)
if Random1(3) = 1 then gg = gg + 16
if Random1(3) = 1 then gg = gg + 16
if Random1(2) = 1 then swap rr, bb
if Random1(2) = 1 then swap gg, bb
if Random1(2) = 1 then swap rr, gg
if Random1(2) = 1 then swap rr, bb
if Random1(2) = 1 then swap gg, bb
lightcolor$ = _trim$(str$(rr)) + "," + _trim$(str$(gg)) + "," + _trim$(str$(bb))
end function
function darkcolor$ ()
dim as integer rr, gg, bb
rr = Random1(64)
gg = Rand(48, 79)
bb = Rand(48, 95)
if Random1(3) = 1 then gg = gg + 16
if Random1(4) = 1 then gg = gg + 32
if Random1(2) = 1 then swap rr, bb
if Random1(2) = 1 then swap gg, bb
if Random1(2) = 1 then swap rr, gg
darkcolor$ = _trim$(str$(rr)) + "," + _trim$(str$(gg)) + "," + _trim$(str$(bb))
end function
function twincolor$ ()
dim as integer rr, gg, bb, xx, yy
dim sret as string
rr = Rand(224, 255)
gg = Rand(224, 239)
bb = Rand(248, 255)
xx = Random1(80)
yy = Random1(80)
if Random1(3) = 1 then gg = gg + 16
if Random1(2) = 1 then swap rr, bb
if Random1(2) = 1 then swap gg, bb
if Random1(2) = 1 then swap rr, gg
if Random1(2) = 1 then swap rr, bb
if Random1(2) = 1 then swap gg, bb
sret$ = _trim$(str$(rr)) + "," + _trim$(str$(gg)) + "," + _trim$(str$(bb)) + "|"
select case Random1(6)
case 1 : rr = xx : gg = yy
case 2 : gg = xx : bb = yy
case 3 : rr = xx : bb = yy
case 4
swap rr, bb
rr = xx : gg = yy
case 5
swap rr, gg
gg = xx : bb = yy
case 6
swap gg, bb
rr = xx : bb = yy
end select
sret$ = sret$ + _trim$(str$(rr)) + "," + _trim$(str$(gg)) + "," + _trim$(str$(bb))
twincolor$ = sret$
end function
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
FUNCTION Rand& (fromval&, toval&)
DIM f&, t&, sg%
IF fromval& = toval& THEN
Rand& = fromval&
EXIT FUNCTION
END IF
f& = fromval&
t& = toval&
IF (f& < 0) AND (t& < 0) THEN
sg% = -1
f& = f& * -1
t& = t& * -1
ELSE
sg% = 1
END IF
IF f& > t& THEN SWAP f&, t&
Rand& = INT(RND * (t& - f& + 1) + f&) * sg%
END FUNCTION
FUNCTION Zeroes$ (num AS LONG, numdig AS INTEGER)
dim as _byte sg, hx
dim b$, v as long
IF num < 0 THEN sg = -1: num = num * -1
IF numdig < 0 THEN hx = 1: numdig = numdig * -1 ELSE hx = 0
IF hx THEN
b$ = HEX$(num)
ELSE
b$ = LTRIM$(STR$(num))
END IF
v = numdig - LEN(b$)
IF v > 0 THEN b$ = STRING$(v, 48) + b$
IF sg = -1 THEN b$ = "-" + b$
Zeroes$ = b$
END FUNCTION
|
|
|
A little mod of a Love Song |
Posted by: bplus - 05-09-2023, 05:27 PM - Forum: Programs
- No Replies
|
|
Silly Love Songs:
Code: (Select All) You'd think that people would've had enough of silly love songs
I look around me, and I see it isn't so
Some people want to fill the world with silly love songs
And what's wrong with that?
I'd like to know, 'cause here I go again
I love you
I love you
I love you
I love you
I can't explain, the feeling's plain to me (I love you)
Now can't you see?
Ah, she gave me more, she gave it all to me (I love you)
Now can't you see?
What's wrong with that?
I need to know, 'cause here I go again
I love you
I love you
Love doesn't come in a minute
Sometimes it doesn't come at all
I only know that when I'm in it
It isn't silly, love isn't silly, love isn't silly at all
How can I tell you about my loved one?
How can I tell you about my loved one?
How can I tell you about my loved one? (I love you)
How can I tell you about my loved one? (I love you)
I love you
I love you
I love you (I can't explain, the feeling's plain to me, say, can't you see?)
I love you (Ah, he gave me more, he gave it all to me, say, can't you see?)
I love you (I can't explain, the feeling's plain to me
Say, can't you see?)
{How can I tell you about my loved one?}
I love you (Ah, he gave me more, he gave it all to me
Say, can't you see?)
How can I tell you about my loved one?
I love you
I can't explain, the feeling's plain to me
(Say, can't you see?)
How can I tell you about my loved one?
I love you
Ah, he gave me more, he gave it all to me
(Say, can't you see?)
How can I tell you about my loved one?
You'd think that people would've had enough of silly love songs
I look around me and I see it isn't so, oh, no
Some people want to fill the world with silly love songs
And what's wrong with that?
modification code:
Code: (Select All) _Title "Silly Love Songs Rewrite" ' b+ 2023-05-09
Open "Silly Love Songs.txt" For Input As #1
Open "Silly Graph Apps.txt" For Output As #2
While EOF(1) = 0
Line Input #1, fl$
fl$ = strReplace$(fl$, "song", "app")
fl$ = strReplace$(fl$, "loved", "graphed")
fl$ = strReplace$(fl$, "love", "graph")
fl$ = strReplace$(fl$, "Love", "Graph")
fl$ = strReplace$(fl$, " he ", " e ")
fl$ = strReplace$(fl$, " she ", " e ")
Print fl$
Print #2, fl$
Wend
Close
Function strReplace$ (s$, replace$, new$) 'case sensitive 2020-07-28 version
Dim p As Long, sCopy$, LR As Long, lNew As Long
If Len(s$) = 0 Or Len(replace$) = 0 Then
strReplace$ = s$: Exit Function
Else
LR = Len(replace$): lNew = Len(new$)
End If
sCopy$ = s$ ' otherwise s$ would get changed
p = InStr(sCopy$, replace$)
While p
sCopy$ = Mid$(sCopy$, 1, p - 1) + new$ + Mid$(sCopy$, p + LR)
p = InStr(p + lNew, sCopy$, replace$)
Wend
strReplace$ = sCopy$
End Function
The rewrite, Silly Graph Apps.txt:
Code: (Select All) You'd think that people would've had enough of silly graph apps
I look around me, and I see it isn't so
Some people want to fill the world with silly graph apps
And what's wrong with that?
I'd like to know, 'cause here I go again
I graph you
I graph you
I graph you
I graph you
I can't explain, the feeling's plain to me (I graph you)
Now can't you see?
Ah, e gave me more, e gave it all to me (I graph you)
Now can't you see?
What's wrong with that?
I need to know, 'cause here I go again
I graph you
I graph you
Graph doesn't come in a minute
Sometimes it doesn't come at all
I only know that when I'm in it
It isn't silly, graph isn't silly, graph isn't silly at all
How can I tell you about my graphed one?
How can I tell you about my graphed one?
How can I tell you about my graphed one? (I graph you)
How can I tell you about my graphed one? (I graph you)
I graph you
I graph you
I graph you (I can't explain, the feeling's plain to me, say, can't you see?)
I graph you (Ah, e gave me more, e gave it all to me, say, can't you see?)
I graph you (I can't explain, the feeling's plain to me
Say, can't you see?)
{How can I tell you about my graphed one?}
I graph you (Ah, e gave me more, e gave it all to me
Say, can't you see?)
How can I tell you about my graphed one?
I graph you
I can't explain, the feeling's plain to me
(Say, can't you see?)
How can I tell you about my graphed one?
I graph you
Ah, e gave me more, e gave it all to me
(Say, can't you see?)
How can I tell you about my graphed one?
You'd think that people would've had enough of silly graph apps
I look around me and I see it isn't so, oh, no
Some people want to fill the world with silly graph apps
And what's wrong with that?
|
|
|
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://staging.qb64phoenix.com/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?
|
|
|
|