Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

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?

Print this item

  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

Print this item

  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


[Image: image.png]
(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!!

Print this item

Lightbulb 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

[Image: plasma-colors-bas-prog.png]

Print this item

  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?

Print this item

  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

   
   

Print this item

Smile 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

Print this item

  Can I get info about SUB inside SUB?
Posted by: thesolarcode - 05-08-2023, 04:37 PM - Forum: Help Me! - Replies (15)

Hi,

if code is running inside a SUB, can I somehow get the SUB name?
This would be great to have for debugging or logging.

Print this item

  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?

Print this item

Star Fedora review on Distrowatch and RHEL family folly
Posted by: mnrvovrfc - 05-08-2023, 07:08 AM - Forum: General Discussion - Replies (12)

https://distrowatch.com/weekly.php?issue...508#fedora

This but sucks so very hard.

It looks like IBM and Red Hat want as less people as possible programming, especially if the user is stuck using one operating system which belongs to Fedora/Red Hat Enterprise Linux family. They are not leaving behind the GNU Compiler Collection because they want to save disk space on the ISO!

They didn't dare touch Git (yet). :/

Kudos to Slackware, soon to celebrate its 30th anniversary for never, ever taking off many of the "devel" libraries and other tools needed to build PPA's and stuff like that. Because that was a requirement on Unix. Long live the slack!

I was going to post this on the QB64PE v3.7 release announcement thread but created a separate topic here because I would like other people to react to these news about one of the most popular distros around. React only to the review about Fedora 38 if you want. Correct me if this insinuation about "gcc" is not right LOL.

Print this item