Show Posts

1

Programs / Re: MARBLE RING TRINKET

« on: October 29, 2020, 08:29:08 pm »

oops, I should include the purpose huh?
Thanks Bplus, Yes, the colors should match the inner colored LEDs so it can be solved

2

Programs / MARBLE RING TRINKET

« on: October 29, 2020, 07:11:52 pm »

Just finished making this lil toy~

It's a marble sliding ring puzzle.

Code: QB64: [Select]

'RING-PUZZLE-TRINKET
SCREEN _NEWIMAGE(700, 400, 32)
DIM col&(20) 'marble colors
DIM LMAP(30) 'Full marble layout
DIM KMAP(2, 20) 'Solution layout
DIM RINGMAP(2, 20) 'RING layout
 
'///////////SOUNDS////////////////////////////////
snda& = _SNDOPEN("SFX/rotate.wav", "sync")
sndb& = _SNDOPEN("SFX/final.wav", "sync")
sndc& = _SNDOPEN("SFX/correct.wav", "sync")
sndd& = _SNDOPEN("SFX/iMAC.wav", "sync")
snde& = _SNDOPEN("SFX/error.wav", "sync")
_SNDPLAY sndd& 'on initial only
 
'///////////CONSTANTS/////////////////////////////
r = 140 'ring radius
mr = 15 'marble radius
n = 6 'number of marbles PER RING *!make this even
q = (_PI(1) / n) 'half angle between marbles
d = r * COS(q) 'ring center offset from CENTRIX
CENTRIX = 350 'x axis center of RING SYSTEM
CENTRIY = 200 'y axis center of RING SYSTEM
mt = (2 * n) - 2 'marble total
BLK& = _RGB(0, 0, 0)
WHT& = _RGB(255, 255, 255)
 
 
'//////////ASSIGN COLOR TO MARBLES////////////////
FOR i = 1 TO mt
    w = (i / mt) - (1 / mt)
    GOSUB w_rainbow 'Linear Rainbow mixer using "w" input
    col&(i) = colr& 'color of marble ID
    LMAP(i) = i 'Initialize MARBLE ID LOCATIONS
NEXT i
 
GOSUB LOADA
GOSUB LOADB
 
'SET SOLUTION KMAP AS INITIAL LAYOUT
FOR i = 1 TO n
    KMAP(1, i) = i
NEXT i
FOR i = 1 TO n
    KMAP(2, i) = RINGMAP(2, i)
NEXT i
 
 
'/////////SCRAMBLE via RANDOM OPERATIONS///////
DIFFICULTY = 5 'minimum number of moves needed to solve
'try 10,20,50,100!!!
RANDOMIZE TIMER
FOR k = 1 TO DIFFICULTY 'DIFFICULTY OF SCRAMBLE
    scramble = INT(RND * 2)
    IF scramble = 0 THEN GOSUB ARSWIRL
    IF scramble = 1 THEN GOSUB BRSWIRL
NEXT k
 
 
'//////////////INITIAL DISPLAY///////////////////////
CIRCLE (CENTRIX - d, CENTRIY), r, _RGB(50, 100, 100)
CIRCLE (CENTRIX + d, CENTRIY), r, _RGB(150, 100, 100)
GOSUB LOADA
GOSUB LOADB
 
FOR k = 1 TO 2 'RINGID
    FOR i = 1 TO n 'number of marbles per ring
        u = 0 - (_PI(1) * (i) / (.5 * n)) + q
        marblex = r * COS(u)
        marbley = r * SIN(u)
        IF k = 1 THEN dd = d
        IF k = 2 THEN dd = -d
 
        '////////////////DRAW MARBLES//////////////////////
        CIRCLE (CENTRIX - dd + marblex, CENTRIY + marbley), mr, col&(RINGMAP(k, i))
        PAINT (CENTRIX - dd + marblex, CENTRIY + marbley), col&(RINGMAP(k, i))
        CIRCLE (CENTRIX - dd + marblex, CENTRIY + marbley), mr, WHT&
 
        '////////////////DRAW ARCS/////////////////////////
        FOR s = 1 TO 3
            CIRCLE (CENTRIX - dd + (marblex * .3), CENTRIY + (marbley * .3)), (mr * 3) + s, col&(KMAP(k, i)), ABS(u + .3), ABS(u - .3), 1
        NEXT s
 
        COLOR BLK&, col&(RINGMAP(k, i))
        IF RINGMAP(k, i) < 10 THEN P = 2 ELSE P = 6
        _PRINTSTRING (CENTRIX - dd + marblex - P, CENTRIY + marbley - 5), _TRIM$(STR$(RINGMAP(k, i)))
 
        GOSUB DRAWLEDS
    NEXT i
NEXT k
 
COLOR WHT&, BLK&
LOCATE 1, 1, 1
_DELAY 2
_SNDPLAY sndb&
PRINT "READING DISCS..."
FOR i = 1 TO 7
    LOCATE 1, 17
    IF (i MOD 2) THEN PRINT "Û" ELSE PRINT " "
    _DELAY .5
NEXT i
 
LOCATE 1, 1
_SNDPLAY snde&
PRINT "ERROR DISC OUT OF SYNC!": _DELAY 2
LOCATE 1, 1
PRINT "MANUAL SYNC REQUIRED!  ": _DELAY 2
LOCATE 1, 1
PRINT "LEFT CLICK : counter-clockwise"
PRINT "RIGHT CLICK: clockwise"
 
 
 
 
'MOUSE CAPTURE LOOP
DO
    z = _MOUSEINPUT
    IF _MOUSEBUTTON(1) OR _MOUSEBUTTON(2) THEN 'click trigger
        IF _MOUSEBUTTON(1) THEN RSWIRL = 1 'clockwise operation
        IF _MOUSEBUTTON(2) THEN LSWIRL = 1 'counter-clockwise operation
        DO 'clear out inputs
            z = _MOUSEINPUT
        LOOP UNTIL (_MOUSEBUTTON(2) = 0) AND (_MOUSEBUTTON(1) = 0)
 
        IF RSWIRL THEN dir = -.015: A = 0: B = -1
        IF LSWIRL THEN dir = .015: A = 0: B = 1
 
        IF (_MOUSEX - CENTRIX) < 0 THEN RINGID = 1 ELSE RINGID = 2
        GOSUB rotate
 
        GOSUB SHOWMAP 'show LEDS
 
        '//////////////////////ZOLVED///////////////////////////
        win = 0 'count ON LEDS
        FOR i = 1 TO n
            FOR k = 1 TO 2
                IF RINGMAP(k, i) = KMAP(k, i) THEN win = win + 1
            NEXT
        NEXT
        IF win = (2 * n) THEN GOTO final
 
    END IF
LOOP
 
LOADA:
FOR i = 1 TO n 'load marbles onto RING A
    RINGMAP(1, i) = LMAP(i)
NEXT i
RETURN
 
LOADB:
FOR i = 1 TO n - 1 'load marbles onto RING B
    j = i + (n / 2) 'n MUST BE EVEN! for this part to work
    IF j > n THEN j = j - n
    RINGMAP(2, j) = LMAP(n + i - 1)
NEXT i
RINGMAP(2, (n / 2)) = LMAP(1)
RETURN
 
DRAWLEDS:
IF RINGMAP(k, i) = KMAP(k, i) THEN 'DRAW ON
    CIRCLE (CENTRIX - dd + (marblex * .5), CENTRIY + (marbley * .5)), mr * .5, col&(KMAP(k, i)), , , 1
    PAINT (CENTRIX - dd + (marblex * .5), CENTRIY + (marbley * .5)), col&(KMAP(k, i))
    CIRCLE (CENTRIX - dd + (marblex * .5), CENTRIY + (marbley * .5)), mr * .5, WHT&, , , 1
ELSE 'DRAW OFF
    CIRCLE (CENTRIX - dd + (marblex * .5), CENTRIY + (marbley * .5)), mr * .5, BLK&, , , 1
    PAINT (CENTRIX - dd + (marblex * .5), CENTRIY + (marbley * .5)), BLK&
    CIRCLE (CENTRIX - dd + (marblex * .5), CENTRIY + (marbley * .5)), mr * .5, col&(KMAP(k, i)), , , 1
END IF
RETURN
 
SHOWMAP: 'Just shows LEDS actually
GOSUB LOADA
GOSUB LOADB
 
FOR k = 1 TO 2
    FOR i = 1 TO n
        u = 0 - (_PI(1) * (i) / (.5 * n)) + q
        marblex = r * COS(u)
        marbley = r * SIN(u)
 
        IF k = 1 THEN dd = d
        IF k = 2 THEN dd = -d
 
        GOSUB DRAWLEDS
    NEXT i
NEXT k
RETURN
 
 
'///////////////RING ROTATION ANIMATION////////////////////////////
rotate:
_SNDPLAY snda&
 
IF RINGID = 1 THEN dd = d: GOSUB LOADA
IF RINGID = 2 THEN dd = -d: GOSUB LOADB
 
FOR u = A TO B STEP dir
    FOR i = 1 TO n '// erase former marble positions
        LINE (CENTRIX - dd + marblex(i) - mr - 2, CENTRIY + marbley(i) - mr - 2)-(CENTRIX - dd + marblex(i) + mr + 2, CENTRIY + marbley(i) + mr + 2), BLK&, BF
    NEXT i
 
    t = u * 2 * q 'update radian of rotation
 
    CIRCLE (CENTRIX - dd, CENTRIY), r, _RGB(100 - dd, 100, 100)
    FOR i = 1 TO n '// draw marbles
        marblex(i) = r * COS(t - (_PI(1) * i / (.5 * n)) + q)
        marbley(i) = r * SIN(t - (_PI(1) * i / (.5 * n)) + q)
 
        COLOR BLK&, col&(RINGMAP(RINGID, i))
        CIRCLE (CENTRIX - dd + marblex(i), CENTRIY + marbley(i)), mr, col&(RINGMAP(RINGID, i))
        PAINT (CENTRIX - dd + marblex(i), CENTRIY + marbley(i)), col&(RINGMAP(RINGID, i))
 
        IF RINGMAP(RINGID, i) < 10 THEN P = 2: ELSE P = 6
        _PRINTSTRING (CENTRIX - dd + marblex(i) - P, CENTRIY + marbley(i) - 5), _TRIM$(STR$(RINGMAP(RINGID, i)))
        CIRCLE (CENTRIX - dd + marblex(i), CENTRIY + marbley(i)), mr, WHT&
    NEXT i
    _DELAY .02
NEXT u 'animation complete
 
'INDEX ROTATION OPERATION SELECTION
IF RSWIRL AND RINGID = 1 THEN GOSUB ARSWIRL
IF LSWIRL AND RINGID = 1 THEN GOSUB ALSWIRL
IF RSWIRL AND RINGID = 2 THEN GOSUB BRSWIRL
IF LSWIRL AND RINGID = 2 THEN GOSUB BLSWIRL
 
RETURN
 
 
'///////////////FINAL ANIMATION////////////////////////////
final:
_SNDPLAY sndc&
_DELAY 1.3
_SNDPLAY sndb&
CLS: PAINT (1, 1), _RGB(0, 0, 0)
GOSUB LOADA
GOSUB LOADB
FOR u = 0 TO 1 STEP .015
    FOR k = 1 TO 2
        IF k = 1 THEN dd = d: tt = tq: l = 2
        IF k = 2 THEN dd = -d: tt = -tq: l = -2
 
        CIRCLE (CENTRIX - dd - tt, CENTRIY), r, BLK&
        FOR i = 1 TO n '// erase former marble positions
            marblex(i) = r * COS((l * t) - (_PI(1) * i / (.5 * n)) + q)
            marbley(i) = r * SIN((l * t) - (_PI(1) * i / (.5 * n)) + q)
            LINE (CENTRIX - dd + marblex(i) - mr - 2 - tt, CENTRIY + marbley(i) - mr - 2)-(CENTRIX - dd + marblex(i) + mr + 2 - tt, CENTRIY + marbley(i) + mr + 2), BLK&, BF
            LINE (CENTRIX - dd + (marblex(i) * .5) - (mr * .6) - tt, CENTRIY + (marbley(i) * .5) - (mr * .6))-(CENTRIX - dd + (marblex(i) * .5) + (mr * .6) - tt, CENTRIY + (marbley(i) * .5) + (mr * .6)), BLK&, BF
        NEXT i
 
    NEXT k
 
    tq = tq + 1.3 'horizontal motion
    t = -u * 2 * q 'update radian of rotation
 
 
    FOR k = 1 TO 2
        IF k = 1 THEN dd = d: tt = tq: l = 2
        IF k = 2 THEN dd = -d: tt = -tq: l = -2
 
        CIRCLE (CENTRIX - dd - tt, CENTRIY), r, _RGB(100 - dd, 100, 100)
        FOR i = 1 TO n '// draw marbles
            marblex(i) = r * COS((l * t) - (_PI(1) * i / (.5 * n)) + q)
            marbley(i) = r * SIN((l * t) - (_PI(1) * i / (.5 * n)) + q)
 
            COLOR BLK&, col&(KMAP(k, i))
            CIRCLE (CENTRIX - dd + marblex(i) - tt, CENTRIY + marbley(i)), mr, col&(KMAP(k, i))
            PAINT (CENTRIX - dd + marblex(i) - tt, CENTRIY + marbley(i)), col&(KMAP(k, i))
 
            IF RINGMAP(k, i) < 10 THEN P = 2: ELSE P = 6
            _PRINTSTRING (CENTRIX - dd + marblex(i) - P - tt, CENTRIY + marbley(i) - 5), _TRIM$(STR$(KMAP(k, i)))
            CIRCLE (CENTRIX - dd + marblex(i) - tt, CENTRIY + marbley(i)), mr, WHT&
 
            '////LEDS
            CIRCLE (CENTRIX - dd + (marblex(i) * .5) - tt, CENTRIY + (marbley(i) * .5)), mr * .5, col&(KMAP(k, i)), , , 1
            PAINT (CENTRIX - dd + (marblex(i) * .5) - tt, CENTRIY + (marbley(i) * .5)), col&(KMAP(k, i))
            CIRCLE (CENTRIX - dd + (marblex(i) * .5) - tt, CENTRIY + (marbley(i) * .5)), mr * .5, WHT&, , , 1
 
        NEXT i
    NEXT k
    _DELAY .039
NEXT u
COLOR _RGB(0, 200, 250), _RGB(0, 50, 100)
_PRINTSTRING (CENTRIX - (6 * 8) - 3, CENTRIY), "DISCS SYNCED!"
 
END
'====================================================
'==========-  SOLUTION FOUND END  -==================
'====================================================
 
 
'////////////////////////////////////////////////////
'/////      INDEX ROTATION OPERATIONS           /////
'////////////////////////////////////////////////////
'ROTATION OPERATION on LMAP SEGMENTS
 
ARSWIRL: 'CLOCKWISE on RING A
temp = LMAP(n)
FOR i = n TO 2 STEP -1
    LMAP(i) = LMAP(i - 1)
NEXT i
LMAP(1) = temp
RSWIRL = 0
RETURN
 
ALSWIRL: 'COUNTER-CLOCKWISE on RING A
temp = LMAP(1)
FOR i = 1 TO (n - 1) STEP 1
    LMAP(i) = LMAP(i + 1)
NEXT i
LMAP(n) = temp
LSWIRL = 0
RETURN
 
BRSWIRL: 'CLOCKWISE on RING B
temp = LMAP(mt)
FOR i = mt TO (n + 1) STEP -1
    LMAP(i) = LMAP(i - 1)
NEXT i
LMAP(n) = LMAP(1)
LMAP(1) = temp
RSWIRL = 0
RETURN
 
BLSWIRL: 'COUNTER-CLOCKWISE on RING B
temp = LMAP(n)
FOR i = n TO (mt - 1) STEP 1
    LMAP(i) = LMAP(i + 1)
NEXT i
LMAP(mt) = LMAP(1)
LMAP(1) = temp
LSWIRL = 0
RETURN
 
 
'/////////////////////LINEAR RAINBOW////////////////////////////////////////////
w_rainbow: 'converts single variable ru=(0 to 1) into a mixture blending from R to G to B
t.col = INT(w * 1530) ' converts ru=(0,1) TO (0,1530)
colr& = _RGB(0, 0, 0) 'default if ru out of range
IF t.col >= (0 * 255) AND t.col < (1 * 255) THEN colr& = _RGB(255, t.col - (0 * 255), 0) 'R*/G-phase 0   = RED
IF t.col >= (1 * 255) AND t.col < (2 * 255) THEN colr& = _RGB(t.col - (255 * 1), 255, 0) 'G*\R-phase 255 = RG
IF t.col >= (2 * 255) AND t.col < (3 * 255) THEN colr& = _RGB(0, 255, t.col - (2 * 255)) 'G*/B-phase 510 = GREEN
IF t.col >= (3 * 255) AND t.col < (4 * 255) THEN colr& = _RGB(0, (4 * 255) - t.col, 255) 'B*\G-phase 765 = GB
IF t.col >= (4 * 255) AND t.col < (5 * 255) THEN colr& = _RGB(t.col - (4 * 255), 0, 255) 'B*/R-phase 1020= BLUE
IF t.col >= (5 * 255) AND t.col <= (6 * 255) THEN colr& = _RGB(255, 0, (6 * 255) - t.col) 'R*\B-phase 1275= BR
RETURN
 
 

TRINKET.zip

3

Programs / Re: Drawing App

« on: October 26, 2020, 01:35:47 pm »

Hey qbkiller,

you can compact your code like this:

For y = -1 to 1
For x = -1 to 1
PSET (_MOUSEX+x, _MOUSEY+y), 7
next:next

and again for black

then if u want a bigger draw square you can
have it range from -2 to 2 or set size as
-n to +n

4

Programs / Re: Pretentious not-really-a-clone clone of Among Us in QB64

« on: October 20, 2020, 06:09:22 pm »

Really cool. With some messenger features and a few collision objects, a lot of kids could get so into this! -for getting into qb64- :D

5

Programs / Re: Pretentious not-really-a-clone clone of Among Us in QB64

« on: October 20, 2020, 05:16:44 pm »

Impressive! do you have the code for the server as well? I'd like to try playing around with it :D

6

Programs / Re: Random sums Problem

« on: October 10, 2020, 06:21:40 pm »

Wow, this was reaaaallly hard for me to accept.

I was also thinking that the ~2.72 MUST HAVE BEEN due to the way qb64 creates a RANDOM number.

After a couple of tests, I realize my idea of how random numbers add up WAS wrong, and so I thought I'd share.

examining the sum of 3 random numbers,

I was thinking that adding 3 random numbers, where each random number has an equal distribution between 0 and 1,

would create a probability distribution space ranging between 0 and 3 equally, which would imply that the probability of the sum of 3 random numbers

adding up to less than 1 would simply be 1/3, which is WRONG because that is equivalent to thinking that the sum of 3 random numbers is on average equal to 1

random number x 3, which is a fallacy!

the volume boundaries you attached explain well how to properly understand the sum of random numbers by accepting that each

random number deserves it's own dimension and that the probability of the sum of n random numbers less than 1 is indeed equal to 1/n!

very beautiful to see Euler's number appear here as the sum of probabilities. Thanks for updating my view on numbers STxAxTIC!

7

Programs / Re: Scrapship Demo

« on: October 09, 2020, 09:58:09 pm »

Hey 40. So happy to have found this! This is great proof of qb64s gaming potential.
So Cool!

8

Programs / Re: Ordered Combinations Generator

« on: October 06, 2020, 07:43:37 pm »

I didn't until I read your post :)

It's amazing how that works out.

9

Programs / Re: Ordered Combinations Generator

« on: October 06, 2020, 07:18:30 pm »

Code: QB64: [Select]

DIM q(20) AS _UNSIGNED INTEGER 'index digit holders
DIM A$(26) 'sample space of the alphabet
 
FOR i = 1 TO 26 'create an alphabet deck of cards A$()
    A$(i) = CHR$(64 + i)
NEXT i
 
CLS
 
n = 7 'number of different characters to use
u = 1 ' initialize by choosing 1 of n characters skipping the combination of nothing 7 C 0
 
PRINT "CHARACTERS n:"; n
OPEN "combination_space.csv" FOR OUTPUT AS #1
 
DO
    'combination counter
    q(1) = q(1) + 1
 
    IF q(1) > n THEN
        FOR i = 1 TO u 'as in nCu: where u is the current number of "digits"
            IF q(i) > n - i + 1 THEN 'digit combination limit
                q(i + 1) = q(i + 1) + 1
                FOR k = (i) TO 1 STEP -1
                    q(k) = q(k + 1) + 1
                NEXT k
                IF i = u THEN u = u + 1
            END IF
        NEXT i
    END IF
 
    '// BELOW IS JUST FOR DISPLAY
    S$ = ""
    PRINT #1, " ,";
    FOR i = 1 TO u
        PRINT "["; RIGHT$(STR$(u - i + 1), 1); "]";
        PRINT #1, "q["; RIGHT$(STR$(u - i + 1), 1); "],";
    NEXT i
    PRINT #1, ""
    PRINT
 
 
    FOR i = 1 TO u
        S$ = A$(q(i)) + S$
        PRINT q(u - i + 1);
    NEXT i
    PRINT #1, S$; ",";
    FOR i = 1 TO u
        PRINT #1, q(u - i + 1); ",";
    NEXT i
 
    PRINT " = "; S$
 
    PRINT #1, ""
    PRINT #1, ""
    PRINT
    SLEEP
LOOP UNTIL u = n
PRINT "COMPLETED TOTAL COMBOS"
 
 

I made a similar one too so I thought I'd post.

10

Programs / Re: Knapsack Problem/0-1 - Rosetta Code

« on: October 06, 2020, 07:13:10 pm »

Yes, by sorting your items in descending order of Value per Weight you are guaranteed the top of the list up to 400 (dag) are the most valuable items to pack. very neat solution.

News:

Messages - Rubidium

Programs / Re: MARBLE RING TRINKET

Programs / MARBLE RING TRINKET

Programs / Re: Drawing App

Programs / Re: Pretentious not-really-a-clone clone of Among Us in QB64

Programs / Re: Pretentious not-really-a-clone clone of Among Us in QB64

Programs / Re: Random sums Problem

Programs / Re: Scrapship Demo

Programs / Re: Ordered Combinations Generator

Programs / Re: Ordered Combinations Generator

Programs / Re: Knapsack Problem/0-1 - Rosetta Code