QB64 Dev Competition Idea

Aaditya Parashar
Full Member

Just somebody with an abnormal coding routine.

Posts: 103

QB64 Dev Competition Idea Oct 4, 2023 16:12:38 GMT

Quote

Post by Aaditya Parashar on Oct 4, 2023 16:12:38 GMT

A basic coloured raycaster.
Works in qb4.5

Type Vec2

    X As Single

    Y As Single

End Type

Dim WorldSizeW, WorldSizeH, Player As Vec2

WorldSizeW = 24

WorldSizeH = 24

Player.X = 2

Player.Y = 2

Const pi = 22 / 7

Dim World(1 To WorldSizeW, 1 To WorldSizeH) As Integer

For i = 1 To WorldSizeW

    For j = 1 To WorldSizeH

        Read World(i, j)

Next j, i

Data 1,2,3,4,3,2,1,2,3,4,3,2,1,2,3,4,3,2,1,2,3,4,3,2

Data 2,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1

Data 3,0,1,5,5,0,4,0,4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2

Data 4,0,2,0,6,0,7,0,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3

Data 3,0,3,0,7,0,4,0,9,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4

Data 2,0,0,0,8,0,6,0,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3

Data 1,0,9,0,0,0,6,0,8,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2

Data 2,0,3,2,1,2,3,0,7,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1

Data 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2

Data 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3

Data 3,0,0,0,0,0,0,0,3,0,0,0,3,3,3,3,0,0,0,0,0,0,0,4

Data 2,0,0,0,0,0,0,0,3,0,0,0,4,0,0,3,0,0,0,0,0,0,0,3

Data 1,0,0,0,0,0,0,0,3,0,0,0,4,0,0,3,0,0,0,0,0,0,0,2

Data 2,0,0,0,0,0,0,0,3,0,0,0,0,0,0,3,0,0,0,0,0,0,0,1

Data 3,0,0,0,0,0,0,0,3,0,0,0,0,0,0,3,0,0,0,0,0,0,0,2

Data 4,0,0,0,0,0,0,0,3,3,3,3,3,3,3,3,0,0,0,0,0,0,0,3

Data 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4

Data 2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3

Data 1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,2

Data 2,0,0,0,0,0,0,0,0,0,0,0,3,4,5,6,7,8,9,2,1,0,0,1

Data 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2

Data 4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3

Data 3,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4

Data 2,3,4,3,2,1,2,3,4,3,2,1,2,3,4,3,2,1,2,3,4,3,2,1

Const FOV = 90

Screen 12

ms = 0.2

playerangle = 0

Dim keys(1 To 32) As Integer

Do

    Line (0, 0)-(640, 480), 11, BF

    Delay 1 / 30

    k = Inp(&H60)

    If k = 17 Then

        If World(Int(Player.X + Cos(playerangle * pi / 180) / 2), Int(Player.Y)) = 0 Then Player.X = Player.X + Cos(playerangle * pi / 180) * ms

        If World(Int(Player.X), Int(Player.Y + Sin(playerangle * pi / 180) / 2)) = 0 Then Player.Y = Player.Y + Sin(playerangle * pi / 180) * ms

    End If

    If k = 31 Then

        If World(Int(Player.X - Cos(playerangle * pi / 180) / 2), Int(Player.Y)) = 0 Then Player.X = Player.X - Cos(playerangle * pi / 180) * ms

        If World(Int(Player.X), Int(Player.Y - Sin(playerangle * pi / 180) / 2)) = 0 Then Player.Y = Player.Y - Sin(playerangle * pi / 180) * ms

    End If

    If k = 30 Then playerangle = playerangle - 3.5

    If k = 32 Then playerangle = playerangle + 3.5

    If k = 1 Then End

    For x = -320 To 320 Step 1

        angle = FOV * x / 640 + playerangle

        xx = Player.X

        yy = Player.Y

        dist! = 0

        d = 0.01

        Do

            xx = xx + Cos(angle * pi / 180) * d

            yy = yy + Sin(angle * pi / 180) * d

            dist! = dist! + d

            If dist! > 3 And dist! < 11 Then d = dist! / 20 - 0.05

            If xx > WorldSizeW Or xx < 1 Or yy > WorldSizeH Or yy < 1 Then Exit Do

            If World(xx, yy) <> 0 Then Exit Do

        Loop

        y = 240 / dist!

        If xx > WorldSizeW Or xx < 1 Or yy > WorldSizeH Or yy < 1 Then _Continue

        Line (x + 321, 240 - y)-(x + 321, 240 + y), World(xx, yy)

    Next x

    _Display

Loop

Sub Delay (d!)

    s! = Timer

    Do While s! + d! >= Timer

        If s! > Timer Then s! = s! - 86400

    Loop

End Sub

bplus Global Moderator b = b + ... Posts: 841	QB64 Dev Competition Idea Oct 4, 2023 17:53:18 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by bplus on Oct 4, 2023 17:53:18 GMT Hi aadi, Fabulous bit of code but don't see how it fits in with this thread? S'OK I am thinking of my own DrawStrings set of commands anyway (for another thread).
	Last Edit: Oct 4, 2023 17:54:19 GMT by bplus Cheers! to the stars of Basic where ever they shine!

Aaditya Parashar Full Member Just somebody with an abnormal coding routine. Posts: 103	QB64 Dev Competition Idea Oct 6, 2023 2:59:55 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by Aaditya Parashar on Oct 6, 2023 2:59:55 GMT I only got this for the topic DRAW

bplus Global Moderator b = b + ... Posts: 841	QB64 Dev Competition Idea Oct 6, 2023 10:14:52 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by bplus on Oct 6, 2023 10:14:52 GMT Hi aadi, I don't understand, no DRAW in that code you last posted. Do you intend to add DRAW commands to that?
	Cheers! to the stars of Basic where ever they shine!

Aaditya Parashar Full Member Just somebody with an abnormal coding routine. Posts: 103	QB64 Dev Competition Idea Oct 6, 2023 15:15:40 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by Aaditya Parashar on Oct 6, 2023 15:15:40 GMT Oh Sorry, I thought it wasn't about the command DRAW, just something to draw.

bplus Global Moderator b = b + ... Posts: 841	QB64 Dev Competition Idea Oct 6, 2023 15:37:56 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by bplus on Oct 6, 2023 15:37:56 GMT OK well it is nice piece of code.
	Cheers! to the stars of Basic where ever they shine!

neils4
New Member

Posts: 38

QB64 Dev Competition Idea Oct 6, 2023 22:33:24 GMT

Quote

Post by neils4 on Oct 6, 2023 22:33:24 GMT

A coding competition in time for Halloween sounds cool. I'm definitely interested. I need to work on using the Draw command. I was messing around with it a little. I can't figure out how to indicate the coordinates on the screen where you want to start drawing. Also, how do you paint the screen a certain color and then draw over the paint?

bplus
Global Moderator

b = b + ...

Posts: 841

QB64 Dev Competition Idea Oct 6, 2023 23:59:34 GMT

Quote

Post by bplus on Oct 6, 2023 23:59:34 GMT

Before a Painting make sure the area is enclosed by lines and move without drawing to a place inside that area and issue P command with the color number for filling.
see Help > DRAW command

You can start DRAW commands after a Pset(x, y) to get it started otherwise I think it starts from middle of screen. _width/2, _height/2

Yes you can draw again over a painted area, it dries very fast!

Last Edit: Oct 7, 2023 0:00:30 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

marjagonzalves
New Member

Posts: 34

QB64 Dev Competition Idea Oct 8, 2023 10:47:42 GMT bplus likes this

Quote

Post by marjagonzalves on Oct 8, 2023 10:47:42 GMT

Program original was 32-bit color. Screwed up "SCREEN 13" palette makes this less interesting.

Gazooks I dislike old "DIM" style and also had to change "SCREEN." While I was posting this I caught "_WIDTH" and "_HEIGHT" cannot be used in QB45. Next time I'm going to post for QB64 only. Sorry, but I like it like that.


DIM s$(1 TO 20)
DIM i AS INTEGER, ai AS INTEGER, cc AS INTEGER, u AS INTEGER
DIM a$, middle$

RANDOMIZE TIMER

FOR i = 1 TO 20
    a$ = ""
    DO UNTIL LEN(a$) > 30
        IF Random1(2) = 1 THEN a$ = a$ + "D" ELSE a$ = a$ + "U"
        IF Random1(2) = 1 THEN
            IF Random1(2) = 1 THEN a$ = a$ + "L" ELSE a$ = a$ + "R"
        ELSE
            a$ = a$ + CHR$(Rand(69, 72))
        END IF
    LOOP
    s$(i) = a$
NEXT

SCREEN 13
'middle$ = "BM" + LTRIM$(STR$(_WIDTH \ 2)) + "," + LTRIM$(STR$(_HEIGHT \ 2))
middle$ = "BM160,100"
FOR i = 1 TO 24
    FOR ai = 0 TO 315 STEP 45
        cc = Rand(64, 160)
        IF i > 10 THEN u = 10 ELSE u = i
        cc = cc + (u - 1) * 8
        a$ = middle$ + "S" + LTRIM$(STR$(22 - u * 2)) + "TA" + LTRIM$(STR$(ai)) + "C" + LTRIM$(STR$(cc)) + s$(Random1(20))
        DRAW a$
    NEXT
NEXT
SLEEP
SYSTEM


FUNCTION Rand& (fromval&, toval&)
    DIM sg%, f&, t&
    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 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

It's supposed to be "marja_gonzalves" with "n". Didn't let me put underscore too.

marjagonzalves
New Member

Posts: 34

QB64 Dev Competition Idea Oct 8, 2023 10:52:43 GMT bplus likes this

Quote

Post by marjagonzalves on Oct 8, 2023 10:52:43 GMT

Wow that is short time, also to keep neils4 in loop we need to avoid _Command words so our code works in QB4.5

You can start DRAW commands after a Pset(x, y) to get it started otherwise I think it starts from middle of screen. _width/2, _height/2

Remember Neils has QB45 16-bit and cannot use those functions. Cannot use "_NEWIMAGE" and 32-bit color. Could get middle of the screen right after "SCREEN" or "CLS" in graphics screen, use "POINT(0)" and "POINT(1)". It has to be the first thing done before draw anything.

Last Edit: Oct 8, 2023 10:54:14 GMT by marjagonzalves

It's supposed to be "marja_gonzalves" with "n". Didn't let me put underscore too.

bplus
Global Moderator

b = b + ...

Posts: 841

QB64 Dev Competition Idea Oct 8, 2023 12:32:03 GMT

Quote

Post by bplus on Oct 8, 2023 12:32:03 GMT

Oct 8, 2023 10:52:43 GMT marjagonzalves said:

Wow that is short time, also to keep neils4 in loop we need to avoid _Command words so our code works in QB4.5

You can start DRAW commands after a Pset(x, y) to get it started otherwise I think it starts from middle of screen. _width/2, _height/2

Remember Neils has QB45 16-bit and cannot use those functions. Cannot use "_NEWIMAGE" and 32-bit color. Could get middle of the screen right after "SCREEN" or "CLS" in graphics screen, use "POINT(0)" and "POINT(1)". It has to be the first thing done before draw anything.

Ooops

but Neils4 did say he got QB64 now so OK? This being a QB64 forum, better to talk and teach QB64, I think...

QB4.5 was nice for the 80's and 90's but lets get updated, no?

Having been huge fan of QB4.5 and VB for DOS before 2000's I think I can help you guys and gals make the transition to QB64 as painless as possible

It is my hope and dream.

I hope you do not desire to crush that

Cheers! to the stars of Basic where ever they shine!

bplus
Global Moderator

b = b + ...

Posts: 841

QB64 Dev Competition Idea Oct 8, 2023 13:28:11 GMT

Quote

Post by bplus on Oct 8, 2023 13:28:11 GMT

Oct 8, 2023 10:47:42 GMT marjagonzalves said:

Program original was 32-bit color. Screwed up "SCREEN 13" palette makes this less interesting.

Gazooks I dislike old "DIM" style and also had to change "SCREEN." While I was posting this I caught "_WIDTH" and "_HEIGHT" cannot be used in QB45. Next time I'm going to post for QB64 only. Sorry, but I like it like that.


DIM s$(1 TO 20)
DIM i AS INTEGER, ai AS INTEGER, cc AS INTEGER, u AS INTEGER
DIM a$, middle$

RANDOMIZE TIMER

FOR i = 1 TO 20
    a$ = ""
    DO UNTIL LEN(a$) > 30
        IF Random1(2) = 1 THEN a$ = a$ + "D" ELSE a$ = a$ + "U"
        IF Random1(2) = 1 THEN
            IF Random1(2) = 1 THEN a$ = a$ + "L" ELSE a$ = a$ + "R"
        ELSE
            a$ = a$ + CHR$(Rand(69, 72))
        END IF
    LOOP
    s$(i) = a$
NEXT

SCREEN 13
'middle$ = "BM" + LTRIM$(STR$(_WIDTH \ 2)) + "," + LTRIM$(STR$(_HEIGHT \ 2))
middle$ = "BM160,100"
FOR i = 1 TO 24
    FOR ai = 0 TO 315 STEP 45
        cc = Rand(64, 160)
        IF i > 10 THEN u = 10 ELSE u = i
        cc = cc + (u - 1) * 8
        a$ = middle$ + "S" + LTRIM$(STR$(22 - u * 2)) + "TA" + LTRIM$(STR$(ai)) + "C" + LTRIM$(STR$(cc)) + s$(Random1(20))
        DRAW a$
    NEXT
NEXT
SLEEP
SYSTEM


FUNCTION Rand& (fromval&, toval&)
    DIM sg%, f&, t&
    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 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

Oh this is nice mess!

Here is a little mod of your code MG, hope you don't mind:

' Mod MG DRAW by bplus 2023-10-08

Dim i As Integer, ai As Integer, cc As Integer, u As Integer
Dim a$, s$

Randomize Timer
Screen 13
Do
    a$ = ""
    Do Until Len(a$) > 20
        If Random1(2) = 1 Then
            If Random1(2) = 1 Then a$ = a$ + "L" Else a$ = a$ + "R"
        Else
            If Random1(2) = 1 Then a$ = a$ + "D" Else a$ = a$ + "U"
        End If
        a$ = a$ + Str$(Rand(1, 15))
    Loop
    s$ = a$
    Cls
    For i = 1 To 24
        stepper = Val(Mid$(" 10 12 15 18 20 30 40 45 60 72 90120180", Int(Rnd * 13) + 1, 3))
        For ai = 0 To 360 - stepper Step stepper
            cc = Rand(64, 160)
            If i > 10 Then u = 10 Else u = i
            If i Mod 2 Then cc = 9 Else cc = 15
            PSet (160, 100)
            a$ = "S" + Str$(22 - u * 2) + "TA" + Str$(ai) + "C" + Str$(cc) + s$
            Draw a$
        Next
    Next
    Print "spacebar for another, esc to quit"
    Sleep
Loop Until Asc(InKey$) = 27

Function Rand& (fromval&, toval&)
    Dim sg%, f&, t&
    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 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

Oh I bet charliejv is going to love this one!

@mg if we win you get half the smiles!

Last Edit: Oct 8, 2023 13:41:10 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

bplus
Global Moderator

b = b + ...

Posts: 841

QB64 Dev Competition Idea Oct 8, 2023 13:57:10 GMT

Quote

Post by bplus on Oct 8, 2023 13:57:10 GMT

Sorry MG I missed this part of yours:
<Next time I'm going to post for QB64 only. Sorry, but I like it like that.>

Don't be sorry, I like it like that too! Please do.

Update: Oh happy day, this works in QBJS without a single change!

[qbjs]https://qbjs.org/?code=JyBNb2QgTUcgRFJBVyBieSBicGx1cyAyMDIzLTEwLTA4CidyZWYgIGh0dHBzOi8vcWI2NC5ib2FyZHMubmV0L3RocmVhZC8yMTnFGy1kZXYtY29tcGV0aXRpb24taWRlYT9wYWdlPTImc2Nyb2xsVG89MTIyOAoKRGltIGkgQXMgSW50ZWdlciwgYc4PY2PND3XLDsU9YSQsIHMkCgpSYW5kb21pemUgVGltZXIKU2NyZWVuIDEzCkRvCiAgICBhJCA9ICIixQxEbyBVbnRpbCBMZW4oYSQpID4gMjDFGsQBSWYgxk4xKDIpID0gMSBUaGVuyR/aI8ZkYSQgKyAiTCIgRWxzZcwTUsZ9xAHEG99R0FFE0lFVy1FuZCBJZskPyiVTdHIkKMRbKDEsIDE1KSnFJExvb3DFCXPGKcUMQ2xzxQhGb3IgaeYAhG8gMjTJVXN0ZXBwZXIgPSBWYWwoTWlkJCgiIDEwIDEyIDE1IDE4IDIwIDMwIDQwIDQ1IDYwIDcyIDkwMTIwMTgwIizkAbUoUm5kICogMTMpICsgMSwgM+cAjsh1YcR2MMR2MzYwIC3JcVN0ZXDIDckxxAFjYyA95QE4KDY0LCAxNjDKUMQBSWYgaSA+5ACj5QFNdeQA1DDmAUbEDGnSLeQDCDLGLsVcOcYuxQwxNc0wUFNldCAoMTYwLCAxMM95J0RyYXcgInRhMCIgICcgdGhpcyBuZWVkZWQ/zSjmApRTIugBqDIyIC0gdSAqIDLkASIiVEHJGmFpxRJDyRFjY8QRc+YBusgBxXfnAc7EAU5leHTFDckJUHJpbnQgInNwYWNlYmFyIGbkAXdub3Ro5ANdZXNjIHRvIHF1aXTmAlpTbGVlcArkAi3nAzBBc2MoSW5LZXkk5AKlMjcKCkZ1bmPkA+XlAYcmIChmcm9tdmFsJiwgdG/ECOYBGeQDqnNnJSwgZsQZJsUUSWYgyC0gPccu7gNqxlM9ySfJGUV4aXQgyHrFFusDAGbRM3TKYch6KGYmIDwgMCkgQW5kICh0xw3NfnNnJSA9IC0xyRHGWSYgKswVxlzLFe0D28ZExxnqAKPkAPsmID7EOMRzIFN3YXDsARvoAPnqAzTkAKMtxDUrIDHkAflmJikgKsRfCsRX6QEL7gGPb20xJiAobWF4dmFsdXXuAYvFDOYAn1NnbtAlSWbHHOYDO+0BksVWPSDmBTDtAO7JNi3nBL/JViA9ywztAUDLUuoA7sos5QDv5gDp6wFE7QD0[/qbjs]

Last Edit: Oct 8, 2023 15:14:14 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

neils4 New Member Posts: 38	QB64 Dev Competition Idea Oct 8, 2023 16:40:05 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by neils4 on Oct 8, 2023 16:40:05 GMT I have QB64 now so if there is a competition then I can participate.

bplus Global Moderator b = b + ... Posts: 841	QB64 Dev Competition Idea Oct 8, 2023 16:59:23 GMT Quote Select Post Deselect Post Link to Post Member Give Gift Back to Top Post by bplus on Oct 8, 2023 16:59:23 GMT Excellent! I look forward to seeing what you come with.
	Cheers! to the stars of Basic where ever they shine!

QB64 Dev Competition Idea

Post by Aaditya Parashar on Oct 4, 2023 16:12:38 GMT

Post by bplus on Oct 4, 2023 17:53:18 GMT

Post by Aaditya Parashar on Oct 6, 2023 2:59:55 GMT

Post by bplus on Oct 6, 2023 10:14:52 GMT

Post by Aaditya Parashar on Oct 6, 2023 15:15:40 GMT

Post by bplus on Oct 6, 2023 15:37:56 GMT

Post by neils4 on Oct 6, 2023 22:33:24 GMT

Post by bplus on Oct 6, 2023 23:59:34 GMT

Post by marjagonzalves on Oct 8, 2023 10:47:42 GMT

Post by marjagonzalves on Oct 8, 2023 10:52:43 GMT

Post by bplus on Oct 8, 2023 12:32:03 GMT

Post by bplus on Oct 8, 2023 13:28:11 GMT

Post by bplus on Oct 8, 2023 13:57:10 GMT

Post by neils4 on Oct 8, 2023 16:40:05 GMT

Post by bplus on Oct 8, 2023 16:59:23 GMT