Recent Posts

Pages: 1 ... 5 6 [7] 8 9 10
61
Community news and announcements / Fast and powerful string sort
« Last post by jj2007 on August 22, 2019, 12:01:05 PM »
The new MasmBasic version of 20 August 2019 features an improved sort algo. Case-sensitive sorts are now over 20% faster, case-insensitive sorting is now almost a factor 3 faster.
Code: [Select]
Intel(R) Core(TM) i5-2450M CPU @ 2.50GHz

sorting 1000000 lines case-insensitive took 504 ms
AAaAHZybMJfIBMDPTlGpjvUIKUAUarYYBhwoQzXDbBiAcpCJBdWibuPGKXCeSrAcOsQVouKGLUtXF
aAABoYraUmtdbUjgRDbugWslpjAUIKuszBiOYgbGgDwawBsyfUTodDuktDyLUCdtDSYqIFfwxoBlKDfbiuHQ
aaadeaEoIYWvHUzkSOtliXprvQLwLRmQtZnACEWprRsosQEBCExqPRkIFHyxbkWHovUZtDOKw
...
ZZzyzetRGgWITClgQOTutTCdCiuHMxPNPuxGIsUFqStMIuIRPqlWpHdzyckcajQMCgNTbYzilNuy
zzZzcsrZGTHbiajufJIMXwWdbKFncznEBmlSLCGJBKFTHoixDzzNgeXSRohyfJHAQreI
zZZzToOoFStspcNrVaEIfjsxTNFZWUIwVWqxrzppJBjnxhbFgXmoCjUQxitzjpsLsmkTJefTDsKUKDj

sorting 1000000 lines case-sensitive took 444 ms
AAAJkbfOkQBObDHcbTIwHpqfZhoeEAOdznaOpVJqBwanparynNfGQbaMfZwqeWVzuereGocrnKWbAx
AAAKDBqCLIvtYhNOwRHDkUdYhtCnqVlAtRxBIyOmZtyRTJmmduoLcogeGKDYzS
AAANyurgtXuGMSDjUiphJpjDEIXsqWblivOefMURODFFRLEmyNHboCtnRgrrGsTpQXBZ
...
zzzMNTYBXQesyiSPhDSnEMllmqJyPOetjQASwTjPPdMGALxaTsXIBwpiDnRqaG
zzzWKRnlAPdJrfgIgiHjbJTvoMgrRnxVAukqhhjMqshOgVAuaGceqItZADoDlNBtykFZjwKyKuMhTJeu
zzzYZAgWBUtSZfUmlAWnFFRpDcGgwdOFndrhSJZcyMsgkvLnTOTRmUtwjKvNKJndDYagMFDBnZQduJzTADOTbIsyx

P.S.: A fat text file for testing sort algorithms is here. To test them, extract the exe attached below to a folder, then open a DOS prompt and run it e.g. as MbSortText.exe RandSheet.tab

The example text files are tab-delimited, so that they are useful to test the sort-by-column feature of QSort(). With sort algos that do not have such a feature, they behave like a normal text file, i.e. the tabs will be ignored.
62
Offtopic / Re: The future of programming - new (or not so new) and different ways of thinking
« Last post by jj2007 on August 22, 2019, 11:43:15 AM »
Quote
In the beginning we programmed in absolute binary... Finally, a Symbolic Assembly Program was devised ... about 1% of the older programmers were interested in it -- using [assembly] was "sissy stuff"

I can still see that attitude in assembly programming cycles. No more "binary", fortunately, but now macros are the "sissy stuff". The "bare metal" fans prefer writing ten lines of cryptic code instead of a simple print "hello" 8)
63
Offtopic / The future of programming - new (or not so new) and different ways of thinking
« Last post by Richly on August 20, 2019, 09:08:39 PM »
I thought it was worth sharing this.

Persevere to the end and consider the different possibilities of doing things  :)

http://worrydream.com/dbx/
64
Code and examples / Hexagon Minesweeper wCustomize Field
« Last post by B+ on August 14, 2019, 01:33:19 PM »
Try this version of Minesweeper from QB64, it's a blast.
(Even better with sound effects but the zip folder too big to attach here even wo exe, a pity!)
Update: there is a zip file attached here at QB64 forum
https://www.qb64.org/forum/index.php?topic=1558.msg108269#msg108269

QB64 code (that should be fairly easy to modify and add your own sound effects):
Code: [Select]
OPTION _EXPLICIT 'Bplus started 2019-08-08 from quick version of Hex Minesweeper and Minesweeper Custom Field
' Attention: this program creates a file: "Hexagon Minefield Custom Specs.txt"
' that you edit with your text editor, if you select that option in the opening screen menu.

DEFINT A-Z
'to make things easy set cellR as const at 25
CONST cellR = 25 ' which makes the following constant
DIM SHARED xspacing!, yspacing!
xspacing! = 2 * cellR * COS(_D2R(30)): yspacing! = cellR * (1 + SIN(_D2R(30)))

DIM SHARED xmax, ymax, Xarrd, Yarrd, mines 'set all this in customField sub
_TITLE "Hexagon Minesweeper: Custom Field"
customField
_TITLE STR$(mines) + " Minesweeper: left click reveals, right marks red"
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE (1280 - xmax) / 2 + 60, (760 - ymax) / 2
RANDOMIZE TIMER
TYPE boardType
    x AS SINGLE 'pixel location
    y AS SINGLE 'pixel location
    id AS INTEGER '0 to 6 neighbor mines
    reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
    mine AS INTEGER '0 or -1
END TYPE
REDIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType 'oversize the board to make it easy to count mines
DIM SHARED restart
DIM gameOver, cc, cr, mbN, c, r, s$, sz!
restart = 1
WHILE 1
    gameOver = 0
    WHILE gameOver = 0
        IF restart THEN initialize
        mbN = 0
        getCell cc, cr, mbN
        'LOCATE 1, 1: PRINT cc, cr, mbN
        IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
            IF b(cc, cr).mine THEN 'ka boom
                FOR r = 1 TO Yarrd 'show all mines
                    FOR c = 1 TO Xarrd
                        IF b(c, r).mine THEN b(c, r).reveal = -1: showCell c, r
                    NEXT
                NEXT
                s$ = "KA - BOOOMMMM!"
                sz! = 1.2 * xmax / LEN(s$)
                cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
                cText xmax / 2 - 4, ymax / 2 - 4, sz!, &HFFFF0000, s$
                cText xmax / 2 - 8, ymax / 2 - 8, sz!, &HFFFFFF00, s$
                gameOver = -1
                _DELAY 7
            ELSE
                b(cc, cr).reveal = -1: showCell cc, cr
                IF b(cc, cr).id = 0 THEN sweepZeros cc, cr
            END IF
        ELSEIF mbN = 2 THEN
            IF b(cc, cr).reveal = 1 THEN
                b(cc, cr).reveal = 0: showCell cc, cr
            ELSE
                IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
            END IF
        END IF
        IF TFwin THEN
            s$ = "Good Job!"
            sz! = 1.2 * xmax / LEN(s$)
            cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
            cText xmax / 2 - 1, ymax / 2 - 2, sz!, &HFF000055, s$
            _DELAY 5
            gameOver = -1
        END IF
        _LIMIT 60
    WEND
    restart = 1
WEND

NoOff:
DATA 1,0,0,-1,0,1,-1,-1,-1,0,-1,1

xOff:
DATA -1,0,0,-1,0,1,1,-1,1,0,1,1

'set all this 'DIM SHARED xmax, ymax, XarrD, YarrD, mines
SUB customField
    DIM fName$, fe, fLine$, p, inCnt, beenHere, allow$, choice$

    fName$ = "Hexagon Minefield Custom Specs.txt"
    IF _FILEEXISTS(fName$) THEN fe = -1 ELSE fe = 0
    allow$ = "12" + CHR$(27)
    PRINT
    PRINT "     Hexagom Minesweeper options:"
    PRINT
    PRINT "  1. Use mine field settings: 10 X 10 cells and 10 mines."
    PRINT "  2. Customize your own field settings."
    IF fe THEN PRINT "  3. Use the last customized mine field settings.": allow$ = allow$ + "3"
    PRINT
    PRINT "     or press esc to quit."
    choice$ = getChar$(allow$)
    SELECT CASE choice$
        CASE "1": xmax = 800: ymax = 600: Xarrd = 10: Yarrd = 10: mines = 10
        CASE "2": GOSUB editCustom
        CASE "3": GOSUB loadCustom
        CASE ELSE: SYSTEM
    END SELECT
    xmax = (Xarrd + 2.5) * xspacing!: ymax = (Yarrd + 2) * yspacing!
    EXIT SUB

    editCustom:
    IF fe = 0 THEN
        OPEN fName$ FOR OUTPUT AS #1
        PRINT #1, " "
        PRINT #1, "          Custom Field Specs For Your Hexagon Minesweeper Game"
        PRINT #1, " "
        PRINT #1, " We will be sizing the screen according to a constant cell radius of 25"
        PRINT #1, " and then numbers filled in here."
        PRINT #1, " "
        PRINT #1, " Please fill out the right side of all Equal signs."
        PRINT #1, " "
        PRINT #1, "   X dimensions across the screen:"
        PRINT #1, "         Your Max Screen Width (pixels) = "
        PRINT #1, "      Number of Horizontal Cells Across = "
        PRINT #1, " "
        PRINT #1, "   Y dimensions going down:"
        PRINT #1, "        Your Max Screen Height (pixels) = "
        PRINT #1, "                   Number of Cells Down = "
        PRINT #1, " "
        PRINT #1, "The percent of mines (8 easy - 15 hard) = "
        PRINT #1, " "
        PRINT #1, "    To finish, Save the file and then close the editor."
        CLOSE #1
    END IF
    ' I picked up this shortcut from Ken, normally I would call a text editor that I don't know if you have!
    SHELL fName$
    GOSUB loadCustom
    RETURN

    loadCustom:
    beenHere = beenHere + 1 'we'll give it 5 tries
    IF beenHere > 5 THEN
        PRINT "OK we tried 5 times, going with default settings..."
        xmax = 800: ymax = 600: Xarrd = 10: Yarrd = 10: mines = 10
        RETURN
    END IF
    inCnt = 0
    OPEN fName$ FOR INPUT AS #1
    WHILE EOF(1) = 0 ' look to get 5 values from 5 = signs
        LINE INPUT #1, fLine$
        'PRINT fLine$
        p = INSTR(fLine$, "=")
        IF p > 0 THEN
            inCnt = inCnt + 1
            SELECT CASE inCnt
                CASE 1: xmax = VAL(rightOf$(fLine$, "="))
                CASE 2: Xarrd = VAL(rightOf$(fLine$, "="))
                CASE 3: ymax = VAL(rightOf$(fLine$, "="))
                CASE 4: Yarrd = VAL(rightOf$(fLine$, "="))
                CASE 5: mines = VAL(rightOf$(fLine$, "=")) * Xarrd * Yarrd / 100
            END SELECT
            IF inCnt = 5 THEN EXIT WHILE
        END IF
    WEND
    CLOSE #1
    IF inCnt = 5 THEN 'alternate exit from gosub
        IF xmax >= (Xarrd + 2.5) * xspacing! THEN
            IF ymax < (Yarrd + 2) * yspacing! THEN 'all good
                PRINT "Opps, Screen height is not big enough for Y cells down."
            ELSE
                RETURN
            END IF
        ELSE
            PRINT "Opps, Screen width is not big enough for X cells across."
        END IF
    ELSE
        PRINT "We did not get everything filled out by = signs."
    END IF
    PRINT: PRINT "Press any to continue.. "
    SLEEP
    SHELL fName$
    GOTO loadCustom
END SUB

SUB initialize ()
    DIM minesPlaced, rx, ry, x, y, nMines, xoffset!
    CLS
    restart = 0
    REDIM b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType
    minesPlaced = 0
    WHILE minesPlaced < mines
        rx = INT(RND * Xarrd) + 1: ry = INT(RND * Yarrd) + 1
        IF b(rx, ry).mine = 0 THEN
            b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
        END IF
    WEND
    'count mines amoung the neighbors
    FOR y = 1 TO Yarrd
        IF y MOD 2 = 0 THEN xoffset! = .5 * xspacing! ELSE xoffset! = 0
        FOR x = 1 TO Xarrd
            IF b(x, y).mine <> -1 THEN 'not already a mine
                '2 sets of neighbors depending if x offset or not
                IF xoffset! > .1 THEN
                    nMines = b(x - 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
                    nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
                ELSE
                    nMines = b(x + 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
                    nMines = nMines + b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
                END IF
                b(x, y).id = -nMines
            ELSE
                b(x, y).id = 0
            END IF
            b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing!
            b(x, y).y = y * yspacing! + .5 * yspacing!
            b(x, y).reveal = 0
            showCell x, y
        NEXT
    NEXT
END SUB

SUB showCell (c, r)
    DIM da, x!, y!, lastx!, lasty!, clr AS _UNSIGNED LONG
    SELECT CASE b(c, r).reveal
        CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
        CASE 0: clr = &HFF008800 'hidden green
        CASE 1: clr = &HFFFF0000 'marked red
    END SELECT
    lastx! = b(c, r).x + cellR * COS(_D2R(-30))
    lasty! = b(c, r).y + cellR * SIN(_D2R(-30))
    FOR da = 30 TO 330 STEP 60
        x! = b(c, r).x + cellR * COS(_D2R(da))
        y! = b(c, r).y + cellR * SIN(_D2R(da))
        LINE (lastx!, lasty!)-(x!, y!), &HFFFF00FF
        lastx! = x!: lasty! = y!
    NEXT
    PAINT (b(c, r).x, b(c, r).y), clr, &HFFFF00FF
    IF b(c, r).reveal = -1 THEN
        'cText b(c, r).x, b(c, r).y, 15, &HFF000000, _TRIM$(STR$(c)) + "," + _TRIM$(STR$(r))
        IF b(c, r).id > 0 THEN cText b(c, r).x, b(c, r).y, 35, &HFF000000, _TRIM$(STR$(b(c, r).id))
        IF b(c, r).mine = -1 THEN cText b(c, r).x, b(c, r).y, 35, &HFFFFFFFF, "*"
    END IF
END SUB

FUNCTION TFwin
    DIM c, x, y
    FOR y = 1 TO Yarrd
        FOR x = 1 TO Xarrd
            IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
        NEXT
    NEXT
    IF c = Xarrd * Yarrd - mines THEN TFwin = -1
END FUNCTION

SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
    DIM m, mx, my, mb1, mb2, r, c
    WHILE _MOUSEINPUT: WEND
    mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
    IF mb1 THEN mbNum = 1
    IF mb2 THEN mbNum = 2
    IF mb1 OR mb2 THEN '                      get last place mouse button was down
        WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
            m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
            mx = _MOUSEX: my = _MOUSEY
        WEND
        FOR r = 1 TO Yarrd
            FOR c = 1 TO Xarrd
                IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xspacing! THEN
                    returnCol = c: returnRow = r: EXIT SUB
                END IF
            NEXT
        NEXT
        mbNum = 0 'still here then clicked wrong
    END IF
END SUB

SUB sweepZeros (col, row) ' recursive sweep with Rod's limits set
    DIM c, r, cMin, cMax, rMin, rMax, x, y, id
    c = col: r = row 'get copies for recursive sub
    IF c > 2 THEN cMin = c - 1 ELSE cMin = 1
    IF c < Xarrd - 1 THEN cMax = c + 1 ELSE cMax = Xarrd
    IF r > 2 THEN rMin = r - 1 ELSE rMin = 1
    IF r < Yarrd - 1 THEN rMax = r + 1 ELSE rMax = Yarrd
    FOR y = rMin TO rMax
        FOR x = cMin TO cMax
            IF b(x, y).reveal = 0 THEN
                id = b(x, y).id
                IF b(x, y).mine = 0 AND id = 0 THEN
                    b(x, y).reveal = -1 'mark played
                    showCell x, y
                    sweepZeros x, y
                ELSE
                    IF b(x, y).mine = 0 AND id >= 1 AND id <= 8 THEN
                        b(x, y).reveal = -1
                        showCell x, y
                    END IF
                END IF
            END IF
        NEXT
    NEXT
END SUB

'center the text around (x, y) point, needs a graphics screen!
SUB cText (x, y, textHeight AS SINGLE, K AS _UNSIGNED LONG, txt$)
    DIM fg AS _UNSIGNED LONG, cur&, I&, mult!, xlen
    fg = _DEFAULTCOLOR
    'screen snapshot
    cur& = _DEST
    I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
    _DEST I&
    COLOR K, _RGBA32(0, 0, 0, 0)
    _PRINTSTRING (0, 0), txt$
    mult! = textHeight / 16
    xlen = LEN(txt$) * 8 * mult!
    _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
    COLOR fg
    _FREEIMAGE I&
END SUB

FUNCTION rightOf$ (source$, of$)
    IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
END FUNCTION

FUNCTION getChar$ (fromStr$)
    DIM OK AS INTEGER, k$
    WHILE OK = 0
        k$ = INKEY$
        IF LEN(k$) THEN
            IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
        END IF
        _LIMIT 200
    WEND
    _KEYCLEAR
    getChar$ = k$
END SUB


To customize the minefield, I use your editor to fill out a form with your specs if you choose that option at start. The default choice is pretty easy starter to get use to play. (see first attached) I am curious if this works in OS outside Windows, QB64 just runs a txt file through a SHELL command.

Here is the simple Spec form: Hexagom Minefield Custom Specs.txt
Code: [Select]

          Custom Field Specs For Your Hexagon Minesweeper Game
 
 We will be sizing the screen according to a constant cell radius of 25
 and then numbers filled in here.
 
 Please fill out the right side of all Equal signs.
 
   X dimensions across the screen:
         Your Max Screen Width (pixels) = 1280
      Number of Horizontal Cells Across = 25
 
   Y dimensions going down:
        Your Max Screen Height (pixels) = 720
                   Number of Cells Down = 15
 
The percent of mines (8 easy - 15 hard) = 12
 
    To finish, Save the file and then close the editor.

65
Announcements / Re: AllegroBASIC v0.7
« Last post by Cybermonkey on July 31, 2019, 12:24:41 PM »
Yes thanks, I joined the discussion as a guest...
66
Announcements / Re: AllegroBASIC v0.7
« Last post by mruh on July 31, 2019, 10:43:35 AM »
I came across this. Allegobasic looks well known.
http://rcbasic.freeforums.net/thread/235/allegrobasic-pulsarbasic
67
Offtopic / Re: A classic one - how does look your desktop?
« Last post by Mike Lobanovsky on July 27, 2019, 12:18:14 PM »
It would be awesome to have a horizontally tilable background image for the two halves of the virtual desktop to fit seamlessly at the desktop center. :)
68
Offtopic / Re: A classic one - how does look your desktop?
« Last post by Cybermonkey on July 27, 2019, 10:39:36 AM »
I newly installed Linux Mint on my main desktop PC because I installed a SSD into it. (Now boots in 14 seconds  :D).
On my mini PC I am also using Linux Mint. Because of that and because I am using two monitors this can be quite confusing especially if one is on the left and the other on the right monitor displayed. So I ended up with two different themes using the same background mirrored... But have a look for yourself.
69
Games / Re: TriQuad Remake
« Last post by B+ on July 21, 2019, 09:04:15 PM »
Hi Rick,

I am glad you approve of remake.

I don't think I've ever pasted a QB64 program into a third party editor, seems like an unnecessary step. But a third party editor has the advantage of a modern file manager that can create new folders and allow you see the other files you are Saving AS... as well as Rename, Delete and other file maintenance...
70
Games / Re: TriQuad Remake
« Last post by Rick3137 on July 21, 2019, 08:47:24 PM »
   Awesome!!

   Much better than the one I made. Thanks for sharing.

   I noticed a slight problem with qb64, when I was downloading. I have a habit of copy and paste to notepad or wordpad when I get a short program from a forum. This does not work with qb64.
   I had to paste straight to the qb64 editor. There is some problem somewhere with the text format that causes errors.

 
Pages: 1 ... 5 6 [7] 8 9 10