Author Topic: Practicing Coding Game (Read 5495 times)

eddy498 · « **on:** March 20, 2019, 07:56:08 pm »

Im trying to write a code for a quick small cave adventure game.
Right now all i have is this

Code: QB64: [Select]

_TITLE "Little Cave"
DIM SHARED scrn&, left&, right&, forward&, back&
DIM SHARED black&, white&, green&, gold&
DIM SHARED gold, counter
scrn& = _NEWIMAGE(800, 600, 32)
 
SCREEN scrn&
CALL MakeColors
CALL MakeCaveEntrance
CALL MakeCaveRoom
CALL MakeSlime
CALL MakeTreasure
 
'make a timer
t = _FREETIMER
ON TIMER(t, 1) Countup
TIMER(t) ON
sec = 0
 
_DEST display&
gameover$ = "false"
DO
    CLS
    _PUTIMAGE (0, 0), cave&
    _PRINTSTRING (375, 10), "Time: " + STR$(hrs) + ":" + STR$(mins) + STR$(sec)
    _DISPLAY
 
 
 
 
 
LOOP UNTIL gameover$ = "true"
DO
    _DISPLAY
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
 
SUB Countup
    mins = 0
    hrs = 0
    sec = sec + 1
    IF sec >= 60 THEN
        min = FIX(counter / 60)
        sec = sec - (60 * mins)
    END IF
    IF mins >= 60 THEN
        hrs = FIX(min / 60)
        mins = mins - (60 * hrs)
    END IF
 
END SUB
 
SUB MakeColors
    white& = _RGB(225, 225, 225)
    black& = _RGB(0, 0, 0)
    green& = _RGB(0, 255, 0)
    gold& = _RGB(255, 215, 0)
    grey& = _RGB(125, 125, 125)
END SUB
 
SUB MakeSlime
    slime& = _NEWIMAGE(60, 60)
    _DEST slime&
    'draw the slime
    CIRCLE (50, 50), black&
    CIRCLE (48, 48), green&
END SUB
 
SUB MakeTreasure
    treasure& = _NEWIMAGE(60, 60)
    _DEST treasure&
    CIRCLE (20, 20), 20, black&
    PAINT (20, 10), black&
    CIRCLE (20, 20), 17, gold&
    PAINT (20, 20), gold&
    LINE (0, 20)-(40, 49), black&, BF
    LINE (2, 22)-(38, 45), gold, BF
    LINE (17, 17)-(23, 25), black&, BF
END SUB
 
SUB MakeCaveEntrance
    cave& = _NEWIMAGE(800, 600)
    _DEST cave&
    LINE (0, 0)-(800, 600), black&, BF
    CIRCLE (400, 300), 100, grey&
    PAINT (400, 300), grey&
END SUB
 
SUB MakeCaveRoom
    room& = _NEWIMAGE(800, 600)
    _DEST room&
    LINE (0, 0)-(800, 600), black&, BF
    LINE (0, 0)-(160, 120), grey&
    LINE (0, 600)-(160, 480), grey&
    LINE (640, 120)-(800, 0), grey&
    LINE (640, 480)-(800, 600), grey&
    LINE (160, 120)-(640, 480), white&, BF
END SUB

]

When i try to run this as is, just to check if it will put the image cave& on screen. i get an error on line 24 = (_PUTIMAGE (0, 0), cave&)
i have no idea why or what is wrong with the code. i would like to be able to test the images that appear as i go through the coding so if you understand what is wrong with it please let me know thanks:)

bplus · « **Reply #1 on:** March 20, 2019, 08:42:30 pm »

If you add cave& to the list of DIM SHARED variables, your error there will go away. Of course do same with other images created in SUBs. The error goes away but no image is drawn.

I have been told colors for graphics screen are best assigned with _RGB32() and best DIM SHARED AS _UNSIGNED LONG

eg
DIM SHARED white AS _UNSIGNED LONG
white = _RGB32(255, 255, 255)

or quicker

CONST white = &HFFFFFFFF '&H is hexadecimal first 2 F's are transparency, next two are Red, next 2 are Green Level, Last 2 are Blue level

Code: QB64: [Select]

_TITLE "Little Cave"
CONST white = &HFFFFFFFF
CONST black = &HFF000000
CONST green = &HFF00FF00
CONST gold = &HFFFFC700
CONST grey = &HFF7C7C7C
 
DIM SHARED scrn&, left&, right&, forward&, back&, cave&
 
DIM SHARED counter
scrn& = _NEWIMAGE(800, 600, 32)
 
SCREEN scrn&
'CALL MakeColors
 
'SUB MakeColors
'    white& = _RGB(225, 225, 225)
'    black& = _RGB(0, 0, 0)
'    green& = _RGB(0, 255, 0)
'    gold& = _RGB(255, 215, 0)
'    grey& = _RGB(125, 125, 125)
'END SUB
 
CALL MakeCaveEntrance
CALL MakeCaveRoom
CALL MakeSlime
CALL MakeTreasure
 
_DEST display& '<<<<<<<<<<<<< there is no display& assigned so same as 0 which is main screen
 
'make a timer
t = _FREETIMER
ON TIMER(t, 1) Countup
TIMER(t) ON
sec = 0
gameover$ = "false"
DO
    CLS
 
    _PUTIMAGE (0, 0), cave&
    _PRINTSTRING (375, 10), "Time: " + STR$(hrs) + ":" + STR$(mins) + STR$(sec)
    _DISPLAY
 
 
 
 
 
LOOP UNTIL gameover$ = "true"
DO
    _DISPLAY
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
 
SUB Countup
    mins = 0
    hrs = 0
    sec = sec + 1
    IF sec >= 60 THEN
        min = FIX(counter / 60)
        sec = sec - (60 * mins)
    END IF
    IF mins >= 60 THEN
        hrs = FIX(min / 60)
        mins = mins - (60 * hrs)
    END IF
 
END SUB
 
'SUB MakeColors
'    white& = _RGB(225, 225, 225)
'    black& = _RGB(0, 0, 0)
'    green& = _RGB(0, 255, 0)
'    gold& = _RGB(255, 215, 0)
'    grey& = _RGB(125, 125, 125)
'END SUB
 
SUB MakeSlime
    slime& = _NEWIMAGE(60, 60)
    _DEST slime&
    'draw the slime
    CIRCLE (50, 50), black
    CIRCLE (48, 48), green
END SUB
 
SUB MakeTreasure
    treasure& = _NEWIMAGE(60, 60)
    _DEST treasure&
    CIRCLE (20, 20), 20, black
    PAINT (20, 10), black
    CIRCLE (20, 20), 17, gold
    PAINT (20, 20), gold
    LINE (0, 20)-(40, 49), black, BF
    LINE (2, 22)-(38, 45), gold, BF
    LINE (17, 17)-(23, 25), black, BF
END SUB
 
SUB MakeCaveEntrance
    cave& = _NEWIMAGE(800, 600)
    _DEST cave&
    LINE (0, 0)-(800, 600), black, BF
    CIRCLE (400, 300), 100, grey
    PAINT (400, 300), grey
END SUB
 
SUB MakeCaveRoom
    room& = _NEWIMAGE(800, 600)
    _DEST room&
    LINE (0, 0)-(800, 600), black, BF
    LINE (0, 0)-(160, 120), grey
    LINE (0, 600)-(160, 480), grey
    LINE (640, 120)-(800, 0), grey
    LINE (640, 480)-(800, 600), grey
    LINE (160, 120)-(640, 480), white, BF
END SUB
 
 

eddy498 · « **Reply #2 on:** March 20, 2019, 10:09:51 pm »

Code: QB64: [Select]

_TITLE "Pirate Treasure"
DIM SHARED scrn&, island&, cloud&, pirate&, treasure&
DIM SHARED white&, black&, green&, gold&, brown&, sky&, darksand&, sand&
DIM SHARED ocean&, counter
RANDOMIZE TIMER
scrn& = _NEWIMAGE(800, 600, 32)
 
SCREEN scrn&
CALL MakeColors
CALL MakeIsland
CALL MakeCloud
 
CALL MakePirate
pirate_x = 10 + RND * 700
pirate_y = 280 + RND * 200
 
CALL MakeTreasure
treasure_x = 10 + RND * 700
treasure_y = 280 + RND * 220
 
'start a stopwatch timer
t = _FREETIMER
ON TIMER(t, 1) CountDown
TIMER(t) ON
counter = 31
 
_DEST display&
gameover$ = "false"
DO
    CLS
    _PUTIMAGE (0, 0), island&, scrn&
    _PUTIMAGE (100, 40), cloud&, scrn&
    _PUTIMAGE (600, 70), cloud&, scrn&
    _PUTIMAGE (treasure_x, treasure_y), treasure&, scrn&
    _PUTIMAGE (pirate_x, pirate_y), pirate&, scrn&
    _PRINTMODE _KEEPBACKGROUND
    _PRINTSTRING (350, 10), "Time: " + STR$(counter)
 
    k$ = INKEY$
    IF k$ <> "" THEN
        code = ASC(k$)
        IF code = 0 THEN
            code = ASC(k$, 2)
            IF code = 72 THEN 'move up
                pirate_y = pirate_y - 5
            ELSEIF code = 80 THEN 'move down
                pirate_y = pirate_y + 5
            ELSEIF code = 75 THEN 'move left
                pirate_x = pirate_x - 5
            ELSEIF code = 77 THEN 'move right
                pirate_x = pirate_x + 5
            END IF
        ELSE
            IF k$ = CHR$(27) THEN gameover$ = "true"
        END IF
    END IF
 
    'see if you got the treasure
    px = pirate_x + 30
    py = pirate_y + 30
    IF px > treasure_x AND py > treasure_y THEN
        IF px < treasure_x + 60 AND py < treasure_y + 60 THEN
            _PRINTSTRING (350, 50), "You got the treasure!"
            gold = INT((30 = counter) * 100 + RND * 100)
            _PRINTSTRING (350, 70), "You found" + STR$(gold) + " gold!"
            _PRINTSTRING (350, 120), "Press ESC to quit."
            gameover$ = "true"
        END IF
    END IF
    IF py < 270 THEN
        _PRINTSTRING (350, 50), "You drowned in the ocean!"
        gameover$ = "true"
    ELSEIF counter <= 0 THEN
        _PRINTSTRING (350, 50), "You ran out of time!"
        gameover$ = "true"
    END IF
    _DISPLAY
 
LOOP UNTIL gameover$ = "true"
DO
    _DISPLAY
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
 
SUB CountDown ()
    counter = counter - 1
END SUB
 
SUB MakeColors ()
    white& = _RGB(255, 255, 255)
    black& = _RGB(0, 0, 0)
    green& = _RGB(0, 255, 0)
    gold& = _RGB(255, 215, 0)
    brown& = _RGB(100, 100, 40)
    sky& = _RGB(110, 110, 240)
    darksand& = _RGB(214, 165, 116)
    sand& = _RGB(234, 185, 136)
    ocean& = _RGB(60, 60, 240)
END SUB
 
SUB MakePirate ()
    pirate& = _NEWIMAGE(60, 60)
    _DEST pirate&
    'make the pirate's shadow
    LINE (7, 11)-(19, 0), black&
    LINE (19, 1)-(31, 11), black&
    LINE (7, 11)-(31, 11), black&
    PAINT (19, 9), black&
    CIRCLE (19, 16), 6, black&
    LINE (19, 23)-(19, 37), black&
    LINE (19, 27)-(12, 31), black&
    LINE (19, 27)-(26, 31), black&
    LINE (19, 37)-(14, 49), black&
    LINE (19, 37)-(24, 49), black&
    'draw the pirate
    LINE (8, 12)-(20, 1), green&
    LINE (20, 1)-(32, 12), green&
    LINE (8, 12)-(32, 12), green&
    PAINT (20, 10), green&
    CIRCLE (20, 17), 6, green&
    LINE (20, 24)-(20, 38), green&
    LINE (20, 28)-(13, 32), green&
    LINE (20, 28)-(27, 32), green&
    LINE (20, 38)-(15, 50), green&
    LINE (20, 38)-(25, 50), green&
END SUB
 
SUB MakeTreasure ()
    treasure& = _NEWIMAGE(60, 60)
    _DEST treasure&
    CIRCLE (20, 20), 20, brown&
    PAINT (20, 10), brown&
    CIRCLE (20, 20), 17, gold&
    PAINT (20, 20), gold&
    LINE (0, 20)-(40, 49), brown&, BF
    LINE (2, 22)-(38, 45), gold&, BF
    LINE (17, 17)-(23, 25), black&, BF
END SUB
 
SUB MakeIsland ()
    island& = _NEWIMAGE(800, 600)
    _DEST island&
    LINE (0, 0)-(799, 200), sky&, BF
    LINE (0, 200)-(799, 270), ocean&, BF
    LINE (0, 270)-(799, 350), sand&, BF
    LINE (0, 350)-(799, 599), darksand&, BF
END SUB
 
SUB MakeCloud ()
    cloud& = _NEWIMAGE(100, 100)
    _DEST cloud&
    CIRCLE (20, 20), 20, white&
    PAINT (20, 20), white&
    CIRCLE (45, 25), 25, white&
    PAINT (45, 30), white&
    CIRCLE (70, 45), 28, white&
    PAINT (70, 45), white&
    CIRCLE (35, 45), 30, white&
    PAINT (35, 60), white&
END SUB
 

But this one works as it is using that RBG. so what is difference between this one and the one im working on right now. I dont know why its calling out the colors like it should.

another problem is my timer in the other codes. i tryied to make is so that it starts counting up and when it reaches a certain thing adds to minutes and such but its not working.

bplus · « **Reply #3 on:** March 20, 2019, 10:39:35 pm »

:) I remember that Pirate Game!

For timer how about something like this?

Code: QB64: [Select]

start = TIMER
WHILE _KEYDOWN(27) = 0
    CLS
    PRINT "  Time:"; INT(TIMER - start)
    _LIMIT 60
WEND
PRINT "Time:"; INT(TIMER - start)
 

bplus · « **Reply #4 on:** March 20, 2019, 10:49:46 pm »

Oh ha! you forgot to DIM SHARE Grey&

bplus · « **Reply #5 on:** March 20, 2019, 10:58:20 pm »

Here is minutes and seconds:

Code: QB64: [Select]

start = TIMER
WHILE _KEYDOWN(27) = 0
    CLS
    timeElapsed = INT(TIMER - start)
    mins = INT(timeElapsed / 60)
    secs = timeElapsed - mins * 60
    PRINT "  Mins:"; mins; " Secs:"; secs
 
 
    _LIMIT 30
WEND
 
 
 

eddy498 · « **Reply #6 on:** March 20, 2019, 10:58:30 pm »

I redid and dim shared grey still screen comes out black.
decided to take timer off since for my small game a timer like that wont really be needed so ill switch it around to a countdown making you have to compete before a certain amount of time passes.

something like

Code: QB64: [Select]

t = _FREETIMER
ON TIMER(t, 1) CountDown
TIMER(t) ON
counter = 30
 
SUB CountDown ()
    counter = counter - 1
END SUB
 
 

That creates a counter and works well but ill have to test how to get a minute and second timer together. want it to be like 5:00 minutes start and count down 4:59. ext.

Have to find how to make it collect gold for the game was thinking somewhere around the line of
gold = 0
While _KEYDOWN(27) = 0
CLS
PRINT "GOLD: "; gold
WEND

Then whenever a chest opens or money gets collected just do a
gold = gold + (gold collected)

as a forced change in whichever if statement or loop i put the gold grab into.

Any idea on how to make that easier or is what i thought about good?

Back to the whole grey&
my colors still havnt shown up and idk how to make the colors show up for it like how the pirate game made the bacground and island pop up just fine.

bplus · « **Reply #7 on:** March 20, 2019, 11:03:30 pm »

As I said, you had to DIM SHARE grey& AND cave&

Code: QB64: [Select]

 
_TITLE "Little Cave"
DIM SHARED scrn&, left&, right&, forward&, back&, cave& '<<<
DIM SHARED black&, white&, green&, gold&, grey& '<<<
DIM SHARED gold, counter
scrn& = _NEWIMAGE(800, 600, 32)
 
SCREEN scrn&
CALL MakeColors
CALL MakeCaveEntrance
CALL MakeCaveRoom
CALL MakeSlime
CALL MakeTreasure
 
'make a timer
't = _FREETIMER
'ON TIMER(t, 1) Countup
'TIMER(t) ON
'sec = 0
 
_DEST display&
gameover$ = "false"
start = TIMER
DO
    CLS
 
    _PUTIMAGE (0, 0), cave&
    timeElapsed = INT(TIMER - start)
    mins = INT(timeElapsed / 60)
    secs = timeElapsed - mins * 60
    PRINT "  Mins:"; mins; " Secs:"; secs
 
    '_PRINTSTRING (375, 10), "Time: " + STR$(hrs) + ":" + STR$(mins) + STR$(sec)
    _DISPLAY
 
 
 
 
 
LOOP UNTIL gameover$ = "true"
DO
    _DISPLAY
LOOP UNTIL INKEY$ = CHR$(27)
SYSTEM
 
SUB Countup
    mins = 0
    hrs = 0
    sec = sec + 1
    IF sec >= 60 THEN
        min = FIX(counter / 60)
        sec = sec - (60 * mins)
    END IF
    IF mins >= 60 THEN
        hrs = FIX(min / 60)
        mins = mins - (60 * hrs)
    END IF
 
END SUB
 
SUB MakeColors
    white& = _RGB(225, 225, 225)
    black& = _RGB(0, 0, 0)
    green& = _RGB(0, 255, 0)
    gold& = _RGB(255, 215, 0)
    grey& = _RGB(125, 125, 125)
END SUB
 
SUB MakeSlime
    slime& = _NEWIMAGE(60, 60)
    _DEST slime&
    'draw the slime
    CIRCLE (50, 50), black&
    CIRCLE (48, 48), green&
END SUB
 
SUB MakeTreasure
    treasure& = _NEWIMAGE(60, 60)
    _DEST treasure&
    CIRCLE (20, 20), 20, black&
    PAINT (20, 10), black&
    CIRCLE (20, 20), 17, gold&
    PAINT (20, 20), gold&
    LINE (0, 20)-(40, 49), black&, BF
    LINE (2, 22)-(38, 45), gold, BF
    LINE (17, 17)-(23, 25), black&, BF
END SUB
 
SUB MakeCaveEntrance
    cave& = _NEWIMAGE(800, 600)
    _DEST cave&
    LINE (0, 0)-(800, 600), black&, BF
    CIRCLE (400, 300), 100, grey&
    PAINT (400, 300), grey&
END SUB
 
SUB MakeCaveRoom
    room& = _NEWIMAGE(800, 600)
    _DEST room&
    LINE (0, 0)-(800, 600), black&, BF
    LINE (0, 0)-(160, 120), grey&
    LINE (0, 600)-(160, 480), grey&
    LINE (640, 120)-(800, 0), grey&
    LINE (640, 480)-(800, 600), grey&
    LINE (160, 120)-(640, 480), white&, BF
END SUB
 

eddy498 · « **Reply #8 on:** March 20, 2019, 11:09:07 pm »

okay retried and it worked. ill continue working on that later.
btw on that timer you did its great and im saving it for later.
tried to add the hrs doing same thing and it got screwed up xD

Code: QB64: [Select]

start = TIMER
WHILE _KEYDOWN(27) = 0
    CLS
    timeElapsed = INT(TIMER - start)
    hrs = INT(timeElapsed / 3600)
    mins = INT(timeElapsed / 60)
    secs = timeElapsed - mins * 60
    mins = timeElapsed - hrs * 3600
    PRINT " Hrs:"; hrs; " Mins:"; mins; " Secs:"; secs
 
 
    _LIMIT 30
WEND
 

where did i go wrong?

bplus · « **Reply #9 on:** March 20, 2019, 11:18:57 pm »

Subtract Hours * 3600 off TimeEllapsed before calculate minutes as we subtracted minutes off before finding secs remaining.

Code: QB64: [Select]

timeElapsed = INT(TIMER - start)
hrs = INT(timeElapsed / 3600)
te = timeElapsed - hrs * 3600
mins = INT(te / 60)
secs = te - mins * 60
PRINT " Hrs:"; hrs; " Mins:"; mins; " Secs:"; secs

eddy498 · « **Reply #10 on:** March 20, 2019, 11:24:07 pm »

Quote from: bplus on March 20, 2019, 11:18:57 pm

Subtract Hours * 3600 off TimeEllapsed before calculate minutes as we subtracted minutes off before finding secs remaining.

I dont get what you mean. i already for the mins and subtracted the hrs * 3600 from it. when i run the script it counts up the minutes at the same time as the seconds.

edit// nvm

i moved the mins elapes time above the mins count time and now its counting right. gonna leave it on for a bit to see if the counting goes well thanks. then gonna try to reverse it to make a countdown using this method :)

gotta try to get a bit more into the art so my backgrounds dont look so bland in the game. any ideas where i can find some references for objects such as rocks, trees, ext?

bplus · « **Reply #11 on:** March 20, 2019, 11:49:10 pm »

My code works
[ You are not allowed to view this attachment ]

bplus · « **Reply #12 on:** March 20, 2019, 11:57:22 pm »

Here are some trees

Code: QB64: [Select]

_TITLE "Fall Foliage 2017-10-21 by bplus"
'fall foliage.bas SmallBASIC 0.12.9 (B+=MGA) 2017-10-21
'test landscape and portrait views for Android
'xmx = min(xmax, 400) : ymx = min(700, ymax) 'portrait
'OK it's just plain better in landscape view
 
'now for full viewing enjoyment
'xmx = xmax : ymx = ymax
 
CONST xmx = 1200
CONST ymx = 700
COMMON SHARED rad
DEFSNG A-Z
 
rad = _PI(1 / 180)
SCREEN _NEWIMAGE(xmx, ymx, 32)
_SCREENMOVE 100, 20 'adjust as needed _MIDDLE needs a delay .5 or more for me
 
 
n = 3
WHILE 1
    IF n < 15 THEN n = n + 3
    horizon = rand%(.8 * ymx, .9 * ymx)
    FOR i = 0 TO horizon
        midInk 0, 0, 128, 10, 120, 128, i / horizon
        lien 0, i, xmx, i
    NEXT
    FOR i = horizon TO ymx
        midInk 70, 108, 30, 60, 10, 5, (i - horizon) / (ymx - horizon)
        lien 0, i, xmx, i
    NEXT
    FOR i = 1 TO xmx * ymx * .00018
        leaf rand%(0, xmx), rand%(horizon * 1.002, ymx)
    NEXT
    IF n < .01 * xmx THEN trees = n ELSE trees = rand%(.002 * xmx, .03 * xmx)
    FOR i = 1 TO trees
        y = horizon + .04 * ymx + i / trees * (ymx - horizon - .1 * ymx)
        r = .01 * y: h = rand%(y * .15, y * .18)
        branch rand%(10, xmx - 10), y, r, 90, h, 0
    NEXT
    fRect xmx, 0, xmax, ymax, 0
    fRect 0, ymx, xmx, ymax, 0
    _DISPLAY
    SLEEP 2
WEND
 
SUB branch (xx, yy, startrr, angDD, lengthh, levv)
    x = xx: y = yy
    lev = levv
    length = lengthh
    angD = angDD
    startr = startrr
    x2 = x + COS(rad * (angD)) * length
    y2 = y - SIN(rad * (angD)) * length
    dx = (x2 - x) / length
    dy = (y2 - y) / length
    bc& = _RGB(30 + 6 * lev, 15 + 3 * lev, 5 + 2 * lev)
    FOR i = 0 TO length
        COLOR bc&
        fCirc x + dx * i, y + dy * i, startr
    NEXT
    IF lev > 1 THEN leaf x2, y2
    IF .8 * startr < .1 OR lev > 7 OR length < 3 THEN EXIT SUB
    lev = lev + 1
    branch x2, y2, .8 * startr, angD + 22 + rand%(-10, 19), rand%(.75 * length, .9 * length), lev
    branch x2, y2, .8 * startr, angD - 22 - rand%(-10, 19), rand%(.75 * length, .9 * length), lev
END SUB
 
'Steve McNeil's  copied from his forum   note: Radius is too common a name
SUB fCirc (CX AS LONG, CY AS LONG, R AS LONG)
    DIM subRadius AS LONG, RadiusError AS LONG
    DIM X AS LONG, Y AS LONG
 
    subRadius = ABS(R)
    RadiusError = -subRadius
    X = subRadius
    Y = 0
 
    IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
 
    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    LINE (CX - X, CY)-(CX + X, CY), , BF
 
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
    WEND
END SUB
 
SUB fRect (x1, y1, x2, y2, c&)
    LINE (x1, y1)-(x2, y2), c&, BF
END SUB
 
SUB fRectStep (x1, y1, x2, y2)
    LINE (x1, y1)-STEP(x2, y2), , BF
END SUB
 
SUB lien (x1, y1, x2, y2)
    LINE (x1, y1)-(x2, y2)
END SUB
 
SUB leaf (x, y)
    sp = 15: leafs = rand%(xmx * ymx * .00001, xmx * ymx * .00002)
    FOR n = 1 TO leafs
        COLOR _RGB(rand%(50, 250), rand%(25, 255), rand%(0, 40))
        xoff = x + RND * sp - RND * sp
        yoff = y + RND * sp - RND * sp
        woff = 3 + RND * 3
        hoff = 3 + RND * 3
        fRectStep xoff, yoff, woff, hoff
    NEXT
END SUB
 
SUB midInk (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    COLOR _RGB(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
END SUB
 
FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION
 
 

eddy498 · « **Reply #13 on:** March 21, 2019, 12:18:00 pm »

Hmm that code confuses me. I'm still not at that level.
Want something more along the lines of
SUB makerocks
And the do a bunch of lines to make an outline of a rock. But my problem is how do I go about making angles and the faces different colors. For example u know how rocks have shades on different sides. And they are different shapes. I know about line BF which will fill the box in but how do I go about making a parrellelogram where the box is at an angle and it's filled with a different shade??
This is what has me confused since I don't want to just use boxes as rocks.

bplus · « **Reply #14 on:** March 21, 2019, 04:05:59 pm »

I must say, most people would grab images and manipulate them. But I admire the brave soul who chooses to draw by code! :)

Here is quad drawing tools. Basically you need a triangle fill routine and then draw 2 triangles that share an edge.

I constructed rectangles, random quad and rhombus from central point. I am afraid the level for that is a little high too.
Fortunately you don't need allot of math to get 4 points for the quad but you do have to watch that the shared edge is line x2, y2 to x4, y4 for quad sub.

Code: QB64: [Select]

_TITLE "A draw quad tool, white = rectangle, red = random quad, blue = rhombus" 'B+ started 2019-03-21
 
RANDOMIZE TIMER
CONST white = &HFFFFFFFF
CONST red = &HFFFF0000
CONST blue = &HFF0000FF
 
'a quad is 4 points about a center, squares, rectangles, rhombus, parallelogram, trapizoids are special cases
SCREEN _NEWIMAGE(800, 600, 32)
_SCREENMOVE 300, 40
 
WHILE _KEYDOWN(27) = 0
    CLS
    'try rectangle  white
    'pick a random point not too close to edge of screen (50 away) to be center of rect
    x0 = (_WIDTH - 100) * RND + 50: y0 = (_HEIGHT - 100) * RND + 50
    'pick a random radius from center, all are equal for rect
    r = RND * 40 + 10
    'pick an angle between 0 and 180 degrees =_PI radians
    a = RND * _PI
    'a par o gram has 2 angles that sum to 180 = _PI
    p1 = RND * PI(11 / 6) + _PI(1 / 6): p2 = _PI - p1
    a1 = a + p1
    a2 = a1 + p2
    a3 = a2 + p1
    x1 = x0 + r * COS(a): y1 = y0 + r * SIN(a)
    x2 = x0 + r * COS(a1): y2 = y0 + r * SIN(a1)
    x3 = x0 + r * COS(a2): y3 = y0 + r * SIN(a2)
    x4 = x0 + r * COS(a3): y4 = y0 + r * SIN(a3)
    fquad x1, y1, x2, y2, x3, y3, x4, y4, white
 
    'random quad
    ' or lets say all the angles are 90 more than last but use random radius from center point
    x0 = (_WIDTH - 100) * RND + 50: y0 = (_HEIGHT - 100) * RND + 50
    a = _PI(.25) * RND 'start point angle from center
    r = 10 + 40 * RND
    x1 = x0 + r * COS(a): y1 = y0 + r * SIN(a)
    r = 10 + 40 * RND
    x2 = x0 + r * COS(a + _PI(.5)): y2 = y0 + r * SIN(a + _PI(.5)) 'plus 90 degree = pi/2 = .5*pi
    r = 10 + 40 * RND
    x3 = x0 + r * COS(a + _PI): y3 = y0 + r * SIN(a + _PI) 'plus 180 degrees = pi
    r = 10 + 40 * RND
    x4 = x0 + r * COS(a + _PI(1.5)): y4 = y0 + r * SIN(a + _PI(1.5)) 'plus 270 degrees = 3/2*pi
    fquad x1, y1, x2, y2, x3, y3, x4, y4, red
    'PSET (x0, y0), white
    'LINE (x0, y0)-(x1, y1), white
    'LINE (x0, y0)-(x2, y2), blue
    'LINE (x0, y0)-(x3, y3), white
    'LINE (x0, y0)-(x4, y4), blue
 
    'rhombus like ellipse 2 radii
    r1 = RND * 35 + 15: r2 = RND * 35 + 15
    x0 = (_WIDTH - 100) * RND + 50: y0 = (_HEIGHT - 100) * RND + 50
    a = _PI(.25) * RND 'start point angle from center
    x1 = x0 + r1 * COS(a): y1 = y0 + r1 * SIN(a)
    x2 = x0 + r2 * COS(a + _PI(.5)): y2 = y0 + r2 * SIN(a + _PI(.5)) 'plus 90 degree = pi/2 = .5*pi
    x3 = x0 + r1 * COS(a + _PI): y3 = y0 + r1 * SIN(a + _PI) 'plus 180 degrees = pi
    x4 = x0 + r2 * COS(a + _PI(1.5)): y4 = y0 + r2 * SIN(a + _PI(1.5)) 'plus 270 degrees = 3/2*pi
    fquad x1, y1, x2, y2, x3, y3, x4, y4, blue
    _DISPLAY
    _LIMIT 1
WEND
' if you connect 2 points that are not adjacent but opposite each other you divide a quad to 2 triangle
' So if we have code to draw a filled triangle we have to just draw 2 filled triangles.
 
'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
SUB fquad (x1, y1, x2, y2, x3, y3, x4, y4, K AS _UNSIGNED LONG)
    ftri x1, y1, x2, y2, x4, y4, K
    ftri x3, y3, x2, y2, x4, y4, K
END SUB
 
'Very Handy code to draw a filled triangle
SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
    a& = _NEWIMAGE(1, 1, 32)
    _DEST a&
    PSET (0, 0), K
    _DEST 0
    _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
    _FREEIMAGE a& '<<< this is important!
END SUB
 
 

EDIT: I meant rectangles not parallelograms.

News:

Author Topic: Practicing Coding Game (Read 5495 times)

eddy498

Practicing Coding Game

bplus

Re: Practicing Coding Game

eddy498

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

eddy498

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

eddy498

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

eddy498

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game

eddy498

Re: Practicing Coding Game

bplus

Re: Practicing Coding Game