SCREEN _NEWIMAGE(1024, 720, 32)



arrow = _NEWIMAGE(75, 100, 32)



font = _LOADFONT("courbd.ttf", 100, "monospaced")

_DEST arrow

_FONT font

_CONTROLCHR ON

PRINT "";

_DEST 0





DO

    WHILE _MOUSEINPUT

        angle = angle + _MOUSEMOVEMENTX

    WEND

    CLS , 0

    PRINT "Angle:"; angle

    DisplayImage arrow, 512, 360, 3, 3, angle, 0

    _LIMIT 15

    _DISPLAY

LOOP UNTIL _MOUSEBUTTON(2)







SUB DisplayImage (Image AS LONG, x AS INTEGER, y AS INTEGER, xscale AS SINGLE, yscale AS SINGLE, angle AS SINGLE, mode AS _BYTE)

    'Image is the image handle which we use to reference our image.

    'x,y is the X/Y coordinates where we want the image to be at on the screen.

    'angle is the angle which we wish to rotate the image.

    'mode determines HOW we place the image at point X,Y.

    'Mode 0 we center the image at point X,Y

    'Mode 1 we place the Top Left corner of oour image at point X,Y

    'Mode 2 is Bottom Left

    'Mode 3 is Top Right

    'Mode 4 is Bottom Right



    DIM AS INTEGER px(3), py(3), w, h, w1, h1

    DIM sinr AS SINGLE, cosr AS SINGLE, i AS _BYTE

    w = _WIDTH(Image): h = _HEIGHT(Image)

    w1 = w * xscale: h1 = h * yscale

    SELECT CASE mode

        CASE 0 'center

            px(0) = -w1 / 2: py(0) = -h1 / 2: px(3) = w1 / 2: py(3) = -h1 / 2

            px(1) = -w1 / 2: py(1) = h1 / 2: px(2) = w1 / 2: py(2) = h1 / 2

        CASE 1 'top left

            px(0) = 0: py(0) = 0: px(3) = w1: py(3) = 0

            px(1) = 0: py(1) = h1: px(2) = w1: py(2) = h1

        CASE 2 'bottom left

            px(0) = 0: py(0) = -h1: px(3) = w1: py(3) = -h1

            px(1) = 0: py(1) = 0: px(2) = w1: py(2) = 0

        CASE 3 'top right

            px(0) = -w1: py(0) = 0: px(3) = 0: py(3) = 0

            px(1) = -w1: py(1) = h1: px(2) = 0: py(2) = h1

        CASE 4 'bottom right

            px(0) = -w1: py(0) = -h1: px(3) = 0: py(3) = -h1

            px(1) = -w1: py(1) = 0: px(2) = 0: py(2) = 0

    END SELECT

    sinr = SIN(angle / 57.2957795131): cosr = COS(angle / 57.2957795131)

    FOR i = 0 TO 3

        x2 = (px(i) * cosr + sinr * py(i)) + x: y2 = (py(i) * cosr - px(i) * sinr) + y

        px(i) = x2: py(i) = y2

    NEXT

    _MAPTRIANGLE (0, 0)-(0, h - 1)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MAPTRIANGLE (0, 0)-(w - 1, 0)-(w - 1, h - 1), Image TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

END SUB

I'm trying to grasp using_MOUSEMOVEMENTX & Y in  a program, not sure I fully understand these two functions yet.  I have run the wiki examples, but I'm not seeing how they could be used for something like below.   Could those functions be used to easier compute mouse movement for like grabing an object and move it only for as much as the mouse has moved since clicking on it?

Here's some code I was playing with for testing.  Could something like this be streamlined with _MOUSEMOVEMENTX & Y instead of using another DO/LOOP to calculate mouse movement?

- Dav 

Screen _NewImage(800, 600, 32)



cx = 400: cy = 400



Do



    Cls , _RGB(32, 0, 0)



    Locate 1, 1: Print "Click on and drag curves to shape...";



    While _MouseInput: Wend



    'grabbed screen

    If _MouseButton(1) Then

        startmx = _MouseX: startmy = _MouseY



        '=====================================================

        'Can _MOUSEMOVEMENTX/Y be used instead of below?

        Do

            Cls , _RGB(32, 0, 0)

            While _MouseInput: Wend

            newcx = cx + (_MouseX - startmx)

            newcy = cy + (_MouseY - startmy)

            For c = -300 To 300 Step 20

                Curve 400, 100, 400, 500, newcx + c, newcy, _RGB(255, 0, 0)

            Next

            _Limit 30

            _Display

        Loop Until _MouseButton(1) = 0

        cx = newcx: cy = newcy

        '=====================================================



    End If



    For c = -300 To 300 Step 20

        Curve 400, 100, 400, 500, cx + c, cy, _RGB(255, 0, 0)

    Next



    _Limit 30

    _Display

Loop



Sub Curve (x1, y1, x2, y2, cx, cy, clr&)

    'Draws a curved line using a quadratic bezier curve formula

    'x1/y1 = start point

    'x2/y2 = end point

    'cx.cy = control point

    Do While t <= 1

        x = (1 - t) ^ 2 * x1 + 2 * (1 - t) * t * cx + t ^ 2 * x2

        y = (1 - t) ^ 2 * y1 + 2 * (1 - t) * t * cy + t ^ 2 * y2

        PSet (x, y), clr&

        t = t + .001

    Loop

End Sub

Terry posted an idea for improving QB64PE here:  https://qb64phoenix.com/forum/showthread.php?tid=2075

Basically, his idea was simple -- Add an optional parameter to CLS so you don't have to change _DEST when using it.

And hey, let's be honest, that's a GREAT idea!!   But, let's take it a step further:  How many times have you wished you could just do a simple PSET (x, y), color, optional_imagehandle?  Set a color of a pixel on an image, without having to alter source and dest to do so!

And how many other commands are there that could benefit from this type improvement?  Off the top of my head, I can think of:

CLS ,background, imagehandle
PSET (x, y), color, imagehandle
LINE (x, y) - (x,y), color, BF, imagehandle
CIRCLE (though I'm too lazy to look up all its syntax), imagehandle

Now, here's my question for you guys, and here's where you can help with some easy development tasks: Give me a list of any and all other commands which could benefit from this simple optional parameter addition. A change like this won't affect existing code at all. Your old stuff won't break. All it'll do is allow a little more flexibility to be added to new stuff, and make it just a little simpler to code things in the future. And, honestly, making such changes is more or less a trivial matter which even someone like myself can push into the repo with just a few hours work and a couple lines of code.

Wrack your brain and help list what needs this style improvement. Heck, if you're brain damaged like me, yet have a ton of free time, pop over to the wiki and scroll down the command list and see what it seems like an optional parameter could help improve.

List those ideas here, and I'll see about taking a little free time this week and next weekend, and making the changes for us and push them into the repo for folks to enjoy in future versions of QB64PE. I'm getting older, and my eyes go all crosseyed and I fall asleep scrolling up and down lists of raw documentation anymore. You guys make me a list, and I'll make what changes I can. You won't get a better offer than that for $1.29 at your local McDonalds!

An attempt to do Conways' game of life as two images without using defined arrays. Not sure it works right but it simulates working right.  The overall program can surely be trimmed down. I posted this on a facebook group a couple weeks a go and figured.. heck why not post it here?

'pixel_life

' an attmept to repilicate Conway's game of life without arrays by using 2 images

'not sure if I got it working right just yet

'feel free to fiddle with it, press <esc> to exit the program at any time

'there are multiple start states you can change by editing the comments

Dim Shared xmax, ymax

xmax = 400: ymax = 400 'change these as you wish , high numbers may be slow on older machines

Dim Shared s0 As Long

Dim Shared s1 As Long

Dim Shared klr As _Unsigned Long

s0 = _NewImage(xmax, ymax, 32)

s1 = _NewImage(xmax, ymax, 32)

Screen s0

_Title "Pixel Life      <esc> to exit"

'_FullScreen

Randomize Timer

klr = _RGB32(30, 200, 0)

'use comments to change starting population of dots

'rand_gen0

test_genA

'test_genB

'test_mousepop

t = 0

rr = 0: gg = 80: bb = 0

Do

    _Limit 6 'I want to be able to see the changes as the generations go on

    gg = gg + 2

    t = t + 1

    _PutImage (0, 0), s1, s0

    update_gen

Loop Until InKey$ = Chr$(27)

_Dest s0

Print t, " generations"

End



Sub test_genA

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    PSet (xmax \ 2, ymax \ 2 - 2), klr

    PSet (xmax \ 2, ymax \ 2 - 1), klr

    PSet (xmax \ 2, ymax \ 2), klr

    PSet (xmax \ 2, ymax \ 2 + 1), klr

    PSet (xmax \ 2, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 1, ymax \ 2), klr

    PSet (xmax \ 2 - 1, ymax \ 2), klr

End Sub

Sub test_genB

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    PSet (xmax \ 2, ymax \ 2), klr

    PSet (xmax \ 2 + 1, ymax \ 2), klr

    PSet (xmax \ 2 + 2, ymax \ 2 + 1), klr

    PSet (xmax \ 2, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 1, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 2, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 3, ymax \ 2 + 2), klr

End Sub

Sub test_mousepop

    _Dest s1

    Screen s1

    Cls , _RGB32(0, 0, 0)

    Do

        ' press space when done drawing

        Do While _MouseInput

            mx = _MouseX

            my = _MouseY

            If mx > 0 And mx < xmax And my > 0 And my < ymax Then

                If _MouseButton(2) Then

                    PSet (mx, my), klr

                End If

            End If

        Loop

    Loop Until InKey$ = Chr$(32)

    Screen s0

    _Dest s0

End Sub

Sub rand_gen0

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    For y = 0 To ymax - 1

        For x = 0 To xmax - 1

            If Rnd * 30 < 2 Then PSet (x, y), klr

        Next

    Next

    _Dest s0

End Sub

Sub update_gen

    'change each generation

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    _Dest s0

    For y = 0 To ymax - 1

        For x = 0 To xmax - 1

            update_cell x, y

        Next

    Next

End Sub

Sub update_cell (sx, sy)

    'check each cell for neighbors and update life

    _Source s0

    _Dest s1

    ds = -1 'set to -1 because we are going to count the cell itself and ignore it this way

    If sx > 1 Then x0 = sx - 1 Else x0 = 0

    If sy > 1 Then y0 = sy - 1 Else y0 = 0

    If sx < xmax - 1 Then x1 = sx + 1 Else x1 = xmax - 1

    If sy < ymax - 1 Then y1 = sy + 1 Else y1 = ymax - 1

    For y = y0 To y1

        For x = x0 To x1

            If Point(x, y) <> _RGB32(0, 0, 0) Then ds = ds + 1

        Next

    Next

    Select Case ds

        Case 0, 1

            PSet (sx, sy), _RGB32(0, 0, 0)

        Case 2,3

            PSet (sx, sy), klr

       ' Case 3     'yeah this was strange... keeping it here as comments for reasons

        '    If Point(sx, sy) = _RGB32(0, 0, 0) Then PSet (sx, sy), klr Else PSet (sx, sy), klr

        Case Is > 3

            PSet (sx, sy), _RGB32(0, 0, 0)

    End Select

End Sub

I am doing a demo of setting up Conways Game of Life at other forum and run into a problem getting proper neighbor counts of a cell with this code:

Definitely not pretty, however kind of cool in a nostalgic way: aside from a few mods, it is GW-BASIC code used to create a simple calendar that can be embedded as a kind of gadget via an iframe:

Calendar (a GW-BASIC program ported to BAM)

Hi there!

I'm actually a long time veteran with a new name (aren't we all?) I have a general question concerning web development and QBJS.

Although it seems interesting enough with ElectronJS, I am primarily interested in embedding an HTML5 module for Chrome and Firefox to implement my web sites as standalone projects. About 10 or 15 years ago, QB64 was just a standalone compiler, but it has grown significantly over the past 10 years, and with the QBJS project, it's really starting to "PEEK" my interest. 

Is there a compiler I can use to where I can generate QB64 code and save the output as a package, resource, or folder where I can just plug it on and go?

I will be using an old version of Dreamweaver for this, and basically link to my pages in an old-school fashion.

I'm relatively out of the do/loop for this, though.

Last time I generated a project in was 2012 and I was using NSBASIC. I've heard a few years ago that SpiderBasic can do this too, but haven't checked it out yet.

Is there a wiki for this or a simple framework in a cookbook fashion where I can just automatically write ny QB64 code, and instead of compiling it, I can automatically export it to Javascript as I would NSBASIC?

Thanks in advance!
James

I was making a stop watch thing, couldn't make/use a variable named vwatch.   IDE info in the status box says it's a SUB VWATCH.   I'm guessing it's an internal name for debugging or something?  Has me curious.

- Dav

Standard Toolbox message:  As I'm working up my new library (details here: https://qb64phoenix.com/forum/showthread.php?tid=2085), I'm going to be working up samples and demos highlighting how simple I'm trying to make it to use all these additional subs and functions.  Many of these routines I've uploaded in one version, demo, sample, or another, over the years, but I'm changing the format on a few of them for simplicity's sake.  

To run this download:
1) First head your browser over to: https://github.com/SteveMcNeill/QB64-Pho...on-Toolbox
2) Click the GREEN <> Code button.  It stands out; it's the only green item on the whole page.
3) Click the "Download Zip" link and you'll download all the files in the Github down to your PC.
4) Extract that file, as you would any ZIP file before trying to use it.
5) Start QB64, navigate to that file folder that you extracted things to, and open the "Samples" folder.

In this case, you can select "GetFileList.bas" and run it.  It contains the code below:

$LET INCLUDE_ALL = TRUE

'$INCLUDE:'..\Library Files\Toolbox.BI'



DIM AS LONG i



GetFileList _CWD$

FOR i = 1 TO UBOUND(FileList)

    PRINT FileList(i);

    IF _FILEEXISTS(FileList(i)) THEN

        PRINT "(File)"

    ELSEIF _DIREXISTS(FileList(i)) THEN

        PRINT "(Dir)"

    ELSE

        PRINT "(Unidentified)"

    END IF

NEXT





'$INCLUDE:'..\Library Files\Toolbox.BM'

Option _Explicit



Screen _NewImage(640, 480, 32)

$Color:32



RoundRect 100, 100, 200, 200, 15, Red

RoundRectFill 200, 210, 300, 250, 5, Green

thickCircle 300, 325, 50, 4, Blue



Sub RoundRect (x As Single, y As Single, x1 As Single, y1 As Single, r As Single, c As _Unsigned Long)

    Dim a As Single, b As Single, e As Single

    'Draw the 4 straight lines first

    Line (x, y + r)-(x, y1 - r), c

    Line (x1, y + r)-(x1, y1 - r), c

    Line (x + r, y)-(x1 - r, y), c

    Line (x + r, y1)-(x1 - r, y1), c

    a = r: b = 0: e = -a



    'And then draw the rounded circle portions of the RoundRect

    Do While a >= b

        PSet (x + r - b, y + r - a), c: PSet (x1 - r + b, y + r - a), c

        PSet (x + r - a, y + r - b), c: PSet (x1 - r + a, y + r - b), c

        PSet (x + r - b, y1 - r + a), c: PSet (x1 - r + b, y1 - r + a), c

        PSet (x + r - a, y1 - r + b), c: PSet (x1 - r + a, y1 - r + b), c

        b = b + 1: e = e + b + b

        If e > 0 Then a = a - 1: e = e - a - a

    Loop

End Sub





Sub RoundRectFill (x As Single, y As Single, x1 As Single, y1 As Single, r As Single, c As _Unsigned Long)

    Dim a As Single, b As Single, e As Single

    Line (x, y + r+1)-(x1, y1 - r-1), c, BF



    a = r: b = 0: e = -a



    Do While a >= b

        Line (x + r - b, y + r - a)-(x1 - r + b, y + r - a), c, BF

        Line (x + r - a, y + r - b)-(x1 - r + a, y + r - b), c, BF

        Line (x + r - b, y1 - r + a)-(x1 - r + b, y1 - r + a), c, BF

        Line (x + r - a, y1 - r + b)-(x1 - r + a, y1 - r + b), c, BF

        b = b + 1: e = e + b + b

        If e > 0 Then a = a - 1: e = e - a - a

    Loop

End Sub



Sub thickCircle (x As Single, y As Single, radius As Single, thickness As Single, colour As _Unsigned Long)

    Dim rp As Single, rm As Single, rp2 As Single, rm2 As Single

    Dim sm As Single, rpi2 As Single, rmi2 As Single, sp As Single

    Dim i As Single



    rp = radius + thickness / 2

    rm = radius - thickness / 2

    rp2 = rp ^ 2

    rm2 = rm ^ 2

    For i = -rp To -rm Step .2

        rpi2 = rp2 - i ^ 2

        sp = Sqr(rpi2)

        Line (x + i, y)-(x + i, y + sp), colour, BF

        Line (x + i, y)-(x + i, y - sp), colour, BF

    Next

    For i = -rm To 0 Step .2

        rpi2 = rp2 - i ^ 2

        rmi2 = rm2 - i ^ 2

        sm = Sqr(rmi2)

        sp = Sqr(rpi2)

        Line (x + i, y + sm)-(x + i, y + sp), colour, BF

        Line (x - i, y + sm)-(x - i, y + sp), colour, BF

        Line (x + i, y - sm)-(x + i, y - sp), colour, BF

        Line (x - i, y - sm)-(x - i, y - sp), colour, BF

    Next

    For i = rm To rp Step .2

        rpi2 = rp2 - i ^ 2

        sp = Sqr(rpi2)

        Line (x + i, y)-(x + i, y + sp), colour, BF

        Line (x + i, y)-(x + i, y - sp), colour, BF

    Next

End Sub