Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - B+

Pages: [1] 2 3 ... 7
1
Code and examples / eRATication
« on: 14. July 2018, 05:26:55 »
Astroids  inspired this rework of the SmallBASIC version, now the shooter is the spacebar and the arrow keys turn the gun.

QB64
Code: [Select]
_TITLE "eRATication by bplus 2018-07-13"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

' 2018-07-13 modified from Asteroids game

'screen dimensions
CONST xmax = 1200
CONST ymax = 700

DIM SHARED pi
pi = _PI

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 100, 20
RANDOMIZE TIMER

CONST nRats = 100
CONST nBullets = 1000
CONST bSpeed = 20

'r for rat prefix have x, y location, r for radius, h for heading, s for speed, k for kolor
DIM SHARED rx(nRats), ry(nRats), rr(nRats), rh(nRats), rs(nRats), rk(nRats) AS _UNSIGNED LONG
DIM SHARED shooterAngle, shooterX, shooterY, life, points
'b prefix for bullet, x, y, dx, dy, a for active
DIM SHARED bx(nBullets), by(nBullets), bdx(nBullets), bdy(nBullets), ba(nBullets)
points = 0
FOR i = 1 TO 100
    newRat i
NEXT
life = 1
shooterX = xmax / 2: shooterY = ymax / 2
rats = 5
shooterAngle = 0
WHILE life <= 3
    CLS
    FOR i = 1 TO life * rats 'the rats
        drawRat i
    NEXT

    '    _KEYDOWN WORKS NICE!!!!
    'use arrow keys to swing shooter, spacebar to fire
    IF _KEYDOWN(19200) THEN shooterAngle = shooterAngle - _PI(1 / 60)
    IF _KEYDOWN(19712) THEN shooterAngle = shooterAngle + _PI(1 / 60)
    IF _KEYDOWN(18432) OR _KEYDOWN(20480) THEN shooterAngle = shooterAngle + _PI(1 / 30)
    IF _KEYDOWN(32) THEN fire = 1 ELSE fire = 0
    drawshooter xmax / 2, ymax / 2, shooterAngle

    'handle bullets
    FOR i = 0 TO nBullets
        IF ba(i) = 0 AND fire = 1 THEN 'have in active bullet index to use
            bx(i) = shooterX + 3 * bSpeed * COS(shooterAngle)
            by(i) = shooterY + 3 * bSpeed * SIN(shooterAngle)
            bdx(i) = bSpeed * COS(shooterAngle)
            bdy(i) = bSpeed * SIN(shooterAngle)
            ba(i) = 1
            fire = 0
        END IF
        IF ba(i) = 1 THEN 'new location
            bx(i) = bx(i) + bdx(i)
            by(i) = by(i) + bdy(i)
            IF bx(i) > 0 AND bx(i) < xmax AND by(i) > 0 AND by(i) < ymax THEN 'in bounds draw it
                'check for collision with rock
                FOR r = 1 TO rats * life
                    IF ((rx(r) - bx(i)) ^ 2 + (ry(r) - by(i)) ^ 2) ^ .5 < .75 * rr(r) THEN
                        FOR rad = 1 TO rr(r)
                            fcirc rx(r), ry(r), rad, _RGB32(255 - rad, 128 - rad, 0)
                            _DISPLAY
                        NEXT
                        points = points + life ^ life
                        _TITLE "Rats Hit:" + STR$(points) + "   Life #" + STR$(life)
                        _DISPLAY
                        newRat r
                        ba(i) = 0
                    ELSE
                        fcirc bx(i), by(i), 2, _RGB32(255, 255, 0)
                    END IF
                NEXT
            ELSE
                ba(i) = 0
            END IF
        END IF
    NEXT
    _DISPLAY
    _LIMIT 30
WEND
_DELAY 5

SUB drawshooter (x, y, radianAngle) 'simple red iso triangle pointed towards radianAngle
    'calculate 3 points of triangle shooter
    x1 = x + 60 * COS(radianAngle) 'main point of shooter according to heading
    y1 = y + 60 * SIN(radianAngle)
    x2 = x + 30 * COS(radianAngle + _PI(2 / 3)) 'next two points are 120 degrees off main point in direction
    y2 = y + 30 * SIN(radianAngle + _PI(2 / 3))
    x3 = x + 30 * COS(radianAngle - _PI(2 / 3))
    y3 = y + 30 * SIN(radianAngle - _PI(2 / 3))
    fTri x, y, x1, y1, x2, y2, _RGB(255, 0, 0)
    fTri x, y, x1, y1, x3, y3, _RGB(255, 0, 0)
    ln x1, y1, x2, y2, _RGB32(255, 255, 128)
    ln x1, y1, x3, y3, _RGB32(255, 255, 128)
    ln x1, y1, x, y, _RGB32(255, 255, 128)
END SUB

SUB drawRat (i)
    rx(i) = rx(i) + rs(i) * COS(rh(i) + RND * _PI(rand(-5, 5) / 10))
    ry(i) = ry(i) + rs(i) * SIN(rh(i) + RND * _PI(rand(-5, 5) / 10))
    'rat collides with shooter?
    IF ((rx(i) - shooterX) ^ 2 + (ry(i) - shooterY) ^ 2) ^ .5 < rr(i) + 20 THEN
        FOR rad = 1 TO 200
            fcirc shooterX, shooterY, rad, _RGB32(255 - rad, 255 - 2 * rad, 0)
            _DISPLAY
            _LIMIT 300
        NEXT
        life = life + 1
        IF life <= 3 THEN
            _TITLE "Rats Hit:" + STR$(points) + "   Life #" + STR$(life)
        ELSE
            _TITLE "Rats Hit:" + STR$(points) + " THE END"
        END IF
        _DISPLAY
        newRat i
        EXIT SUB
    END IF
    IF rx(i) > 0 AND rx(i) < xmax AND ry(i) > 0 AND ry(i) < ymax THEN
        noseX = rx(i) + 2 * rr(i) * COS(rh(i))
        noseY = ry(i) + 2 * rr(i) * SIN(rh(i))
        neckX = rx(i) + .75 * rr(i) * COS(rh(i))
        neckY = ry(i) + .75 * rr(i) * SIN(rh(i))
        tailX = rx(i) + 2 * rr(i) * COS(rh(i) + _PI)
        tailY = ry(i) + 2 * rr(i) * SIN(rh(i) + _PI)
        earLX = rx(i) + rr(i) * COS(rh(i) - _PI(1 / 12))
        earLY = ry(i) + rr(i) * SIN(rh(i) - _PI(1 / 12))
        earRX = rx(i) + rr(i) * COS(rh(i) + _PI(1 / 12))
        earRY = ry(i) + rr(i) * SIN(rh(i) + _PI(1 / 12))
        fcirc rx(i), ry(i), .65 * rr(i), rk(i)
        fcirc neckX, neckY, rr(i) * .3, rk(i)
        fTri noseX, noseY, earLX, earLY, earRX, earRY, rk(i)
        fcirc earLX, earLY, rr(i) * .3, rk(i)
        fcirc earRX, earRY, rr(i) * .3, rk(i)
        wX = .5 * rr(i) * COS(rh(i) - _PI(11 / 18))
        wY = .5 * rr(i) * SIN(rh(i) - _PI(11 / 18))
        ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, rk(i)
        wX = .5 * rr(i) * COS(rh(i) - _PI(7 / 18))
        wY = .5 * rr(i) * SIN(rh(i) - _PI(7 / 18))
        ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, rk(i)
        ln rx(i), ry(i), tailX, tailY, rk(i)
    ELSE
        newRat i
    END IF
END SUB

SUB newRat (iRat)
    'bring rock in from one side, need to set heading according to side
    'RANDOMIZE TIMER + RND
    side = rand(1, 4)
    SELECT CASE side
        CASE 1: rx(iRat) = 0: ry(iRat) = RND * ymax: rh(iRat) = 3 * pi / 2 + RND * pi
        CASE 2: rx(iRat) = xmax: ry(iRat) = RND * ymax: rh(iRat) = pi / 2 + RND * pi
        CASE 3: rx(iRat) = RND * xmax: ry(iRat) = 0: rh(iRat) = RND * pi
        CASE 4: rx(iRat) = RND * xmax: ry(iRat) = ymax: rh(iRat) = pi + RND * pi
    END SELECT
    'speed, angle, radius, gray coloring, spin, seed
    rs(iRat) = RND * 5 * life + 1
    rr(iRat) = RND * 55 + 15
    r = rand(60, 255)
    rk(iRat) = _RGB32(r, .9 * r, .8 * r)
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

' found at QB64.net:    http://www.qb64.net/forum/index.php?topic=14425.0
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

SUB ln (x1, y1, x2, y2, K AS _UNSIGNED LONG) 'box frame
    LINE (x1, y1)-(x2, y2), K
END SUB

'vince version
SUB fcirc (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    x0 = R
    y0 = 0
    e = 0
    DO WHILE y0 < x0
        IF e <= 0 THEN
            y0 = y0 + 1
            LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
            LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        ELSE
            LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
            LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1
            e = e - 2 * x0
        END IF
    LOOP
    LINE (x - R, y)-(x + R, y), C, BF
END SUB


2
Code and examples / JB Rubic's Cube with Solver
« on: 30. May 2018, 04:00:55 »
Code: [Select]
'Rubic 4.txt for Just Basic v2 B+ started 2018-05-27 revised again
' post 2018-05-29 edited 2-3 times swap faces at bootom cube view and spin bottom face
' from Rubic 3.txt

'now for my next trick, 3D

global xmax, ymax, pi, cmd$, record$, c6, s6
xmax = 606
ymax = 450
pi = acs(-1)
c6 = 30 * cos(pi/6)
s6 = 30 * sin(pi/6)
nomainwin
WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (1200 - xmax) / 2
UpperLeftY = (700 - ymax) / 2

open "Rubic 4, press h for help..." for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "when leftButtonUp lButtonUp"
#gr "when characterInput charIn"
#gr "down"
#gr "fill 115 115 115"
#gr "size 3"
dim fx(5) : dim fy(5)
fx(0) = 120 : fy(0) = 180
fx(1) = 210 : fy(1) = 180
fx(2) = 300 : fy(2) = 180
fx(3) = 30  : fy(3) = 180
fx(4) = 120 : fy(4) = 90
fx(5) = 120 : fy(5) = 270

dim c(53) '54 colors for squares
dim l$(53) 'labels for squares = original index
dim spin(8)
dim spinl$(8)
for i = 0 to 53
    f = int(i / 9)
    select case f
    case 0 : c(i) = 40  ' front face is green
    case 1 : c(i) = 700 ' right face red
    case 2 : c(i) = 8   ' back face blue
    case 3 : c(i) = 940 ' left face orange
    case 4 : c(i) = 999 ' top face white (which is why the black background
    case 5 : c(i) = 990 ' bottom face yellow
    end select
    l$(i) = str$(i)
next
call update
#gr "flush"
wait

' ======================================  procedures this window

sub quit H$
    close #gr
    end
end sub

sub lButtonUp H$, mx, my
    call quit H$
end sub

sub charIn H$, c$
    'notice "*";c$;"*" 'debug 2nd character not found in INSTR, also 4th????
    'nstr$ = "1 2 3"  'there is some kind of bug such that the 2nd and 4th position in string is not found
    if c$ = "h" then call help
    if instr("xyz",c$) then cmd$ = c$
    if (c$ = "1" or c$ = "2" or c$ = "3") and cmd$ <> "" then
        call cwRotate c$
        cmd$ = ""
    end if
    if c$ = "s" then call solve
    if c$ = "q" then call quit H$
end sub

sub cwRotate level$
    select case cmd$
    case "x"
        select case level$
        case "1"
            call cs  0,  3,  6, 36, 39, 42, 26, 23, 20, 45, 48, 51
            call spinFace 3
        case "2"
            call cs  1,  4,  7, 37, 40, 43, 25, 22, 19, 46, 49, 52
        case "3"
            call cs  2,  5,  8, 38, 41, 44, 24, 21, 18, 47, 50, 53
            call spinFace 1
        end select
    case "y"
        select case level$
        case "1"
            call cs  0,  1,  2,  27, 28, 29,  18, 19, 20,   9, 10, 11
            call spinFace 4
        case "2"
            call cs  3,  4,  5,  30, 31, 32,  21, 22, 23,  12, 13, 14
        case "3"
            call cs 33, 34, 35,  24, 25, 26,  15, 16, 17,   6,  7,  8
            call spinFace 5
        end select
    case "z"
        select case level$
        case "1"
            call spinFace 0 'ok
            call cs 42, 43, 44, 9, 12, 15, 47, 46, 45, 35, 32, 29
        case "2"
            call cs 10, 13, 16, 50, 49, 48, 34, 31, 28, 39, 40, 41
        case "3"
            call cs 36, 37, 38, 11, 14, 17, 53, 52, 51, 33, 30, 27
            call spinFace 2
        end select
    end select
    record$ = record$ + cmd$;level$ + " "
    call update
end sub

' ======================================    JB Library of procedures

sub rgb n3
    s3$ = right$("000";str$(n3), 3)
    r = 28 * val(mid$(s3$, 1, 1)) + 3
    g = 28 * val(mid$(s3$, 2, 1)) + 3
    b = 28 * val(mid$(s3$, 3, 1)) + 3
    #gr "color ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
end sub

sub frgb n3
    s3$ = right$("000";str$(n3), 3)
    r = 28 * val(mid$(s3$, 1, 1)) + 3
    g = 28 * val(mid$(s3$, 2, 1)) + 3
    b = 28 * val(mid$(s3$, 3, 1)) + 3
    #gr "color ";r;" ";g;" ";b
end sub

sub brgb n3
    s3$ = right$("000";str$(n3), 3)
    r = 28 * val(mid$(s3$, 1, 1)) + 3
    g = 28 * val(mid$(s3$, 2, 1)) + 3
    b = 28 * val(mid$(s3$, 3, 1)) + 3
    #gr "backcolor ";r;" ";g;" ";b
end sub

sub label fColor, bColor, x, y, text$
    call frgb fColor
    call brgb bColor
    #gr "place ";x;" ";y;";\";text$
end sub

sub fbox x0, y0, x1, y1
    #gr "place ";x0;" ";y0
    #gr "boxfilled ";x1+1;" ";y1+1
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

'===============================================    procedures this app

sub update
    for i = 0 to 53
        f = int(i/9)
        xoff = fx(f) : yoff = fy(f)
        row = int((i - f * 9)/3) : col = i mod 3
        call rgb c(i)
        fore = 999 - c(i) : bk = c(i)
        call fbox xoff + col * 30, yoff + row * 30, xoff + col * 30 + 30, yoff + row * 30 + 30
        call label fore, bk, xoff + col * 30 + 8, yoff + row * 30 + 20, right$("  ";l$(i), 2)
    next
    'draw grids
    call rgb 0
    for f = 0 to 5
        xoff = fx(f) : yoff = fy(f)
        for i = 0 TO 3
            #gr "line ";xoff + 30 * i;" ";yoff;" ";xoff + 30 * i;" ";yoff + 90
            #gr "line ";xoff;" ";yoff + 30 * i;" ";xoff + 90;" ";yoff + 30 * i
        next
    next

    '3D views
    #gr "size 1"
    for face = 0 to 5
        fi = face * 9
        select case face
        case 0 : fx = 420 : fy = 75
            for row = 0 to 2
            for col = 0 to 2
                x = fx + col * c6
                y = fy + row * 30 + 15 * col
                call rgb c(fi + row * 3 + col)
                call d1 x, y
            next
            next
        case 1 : fx = 498 : fy = 120
            for row = 0 to 2
            for col = 0 to 2
                x = fx + col * c6
                y = fy + row * 30 - 15 * col
                call rgb c(fi + row * 3 + col)
                call d2 x, y
            next
            next
        case 3 : fx = 498 : fy = 240  'back side is mirror of front view
            for row = 0 to 2
            for col = 0 to 2
                x = fx + col * c6
                y = fy + row * 30 + 15 * col
                call rgb c(fi + row * 3 + (col))
                call d1 x, y
            next
            next
        case 2 : fx = 420 : fy = 285
            for row = 0 to 2
            for col = 0 to 2
                x = fx + col * c6
                y = fy + row * 30 - 15 * col
                call rgb c(fi + row * 3 + (col))
                call d2 x, y
            next
            next
        case 4 : fx = 498 : fy = 30
            for row = 0 to 2
            for col = 0 to 2
                x = fx + col * 26 - row * 26
                y = fy + row * 15 + 15 * col
                call rgb c(fi + row * 3 + col)
                call d3 x, y
            next
            next
        case 5 : fx = 498 : fy = 330
            for row = 0 to 2
            for col = 0 to 2
                x = fx + col * 26 - row * 26
                y = fy + row * 15 + 15 * col
                'spin the face
                i = row * 3 + col
                select case i
                case 0 : j = 6
                case 1 : j = 3
                case 2 : j = 0
                case 3 : j = 7
                case 4 : j = 4
                case 5 : j = 1
                case 6 : j = 8
                case 7 : j = 5
                case 8 : j = 2
                end select
                call rgb c(fi + j)
                call d3 x, y
            next
            next
        end select
    next
    call label 999, 444, 426, 20, "Top Front Right View:"
    call label 999, 444, 425, 440, "Back Left Bottom View:"
end sub

sub d1 x, y
    for yo = 0 to 30
        #gr "line ";x;" ";y + yo;" ";x + c6;" ";y + yo + s6
    next
    #gr "size 4"
    #gr "color black"
    #gr "line ";x;" ";y;" ";x + c6;" ";y + s6
    #gr "line ";x;" ";y;" ";x;" ";y + 30
    #gr "line ";x + c6;" ";y + s6;" ";x + c6;" ";y + 30 + s6
    #gr "line ";x;" ";y + 30;" ";x + c6;" ";y + 30 + s6
end sub

sub d2 x, y
    for yo = 0 to 30
        #gr "line ";x;" ";y + yo;" ";x + c6;" ";y + yo - s6
    next
    #gr "size 4"
    #gr "color black"
    #gr "line ";x;" ";y;" ";x + c6;" ";y - s6
    #gr "line ";x;" ";y;" ";x;" ";y + 30
    #gr "line ";x + c6;" ";y - s6;" ";x + c6;" ";y + 30 - s6
    #gr "line ";x;" ";y + 30;" ";x + c6;" ";y + 30 - s6
end sub

sub d3 x, y
    yy = y + 15
    for xx = 0 to 26
        fx = 15 - 15/26 * xx
        #gr "line ";x + xx;" ";yy - fx;" ";x + xx;" ";yy + fx
        #gr "line ";x - xx;" ";yy - fx;" ";x - xx;" ";yy + fx
    next
    #gr "size 4"
    #gr "color black"
    #gr "place ";x;" ";y
    #gr "north"
    #gr "turn 120"
    #gr "go 30"
    #gr "turn 120"
    #gr "go 30"
    #gr "turn 60"
    #gr "go 30"
    #gr "turn 120"
    #gr "go 30"
end sub

'color shifter, these are all indexes to the c() array
sub cs k1, k2, k3, k4, k5, k6, k7, k8, k9, k10, k11, k12
    ks1 = c(k10) : ks2 = c(k11) : ks3 = c(k12) 'save first three
    ls1$ = l$(k10) : ls2$ = l$(k11) : ls3$ = l$(k12) 'save first three

    c(k10) = c(k7) : c(k11) = c(k8) : c(k12) = c(k9)
    l$(k10) = l$(k7) : l$(k11) = l$(k8) : l$(k12) = l$(k9)

    c(k7) = c(k4) : c(k8) = c(k5) : c(k9) = c(k6)
    l$(k7) = l$(k4) : l$(k8) = l$(k5) : l$(k9) = l$(k6)

    c(k4) = c(k1) : c(k5) = c(k2) : c(k6) = c(k3)
    l$(k4) = l$(k1) : l$(k5) = l$(k2) : l$(k6) = l$(k3)

    c(k1) = ks1 : c(k2) = ks2 : c(k3) = ks3
    l$(k1) = ls1$ : l$(k2) = ls2$ : l$(k3) = ls3$
end sub

sub spinFace face
    for i = 0 to 8 'save data
        row = int(i / 3) : col = i mod 3
        idx = face * 9 + 3 * row + col
        spin(i) = c(idx)
        spinl$(i) = l$(idx)
    next
    if face = 0 or face = 1 or face = 4 then
        for i = 0 to 8 'swap data
            row = int(i / 3) : col = i mod 3
            idx = face * 9 + 3 * row + col
            select case i
            case 0 : c(idx) = spin(6) : l$(idx) = spinl$(6)
            case 1 : c(idx) = spin(3) : l$(idx) = spinl$(3)
            case 2 : c(idx) = spin(0) : l$(idx) = spinl$(0)
            case 3 : c(idx) = spin(7) : l$(idx) = spinl$(7)
            case 5 : c(idx) = spin(1) : l$(idx) = spinl$(1)
            case 6 : c(idx) = spin(8) : l$(idx) = spinl$(8)
            case 7 : c(idx) = spin(5) : l$(idx) = spinl$(5)
            case 8 : c(idx) = spin(2) : l$(idx) = spinl$(2)
            end select
        next
    else 'reverse
            for i = 0 to 8 'swap data
            row = int(i / 3) : col = i mod 3
            idx = face * 9 + 3 * row + col
            select case i
            case 0 : c(idx) = spin(2) : l$(idx) = spinl$(2)
            case 1 : c(idx) = spin(5) : l$(idx) = spinl$(5)
            case 2 : c(idx) = spin(8) : l$(idx) = spinl$(8)
            case 3 : c(idx) = spin(1) : l$(idx) = spinl$(1)
            case 5 : c(idx) = spin(7) : l$(idx) = spinl$(7)
            case 6 : c(idx) = spin(0) : l$(idx) = spinl$(0)
            case 7 : c(idx) = spin(3) : l$(idx) = spinl$(3)
            case 8 : c(idx) = spin(6) : l$(idx) = spinl$(6)
            end select
        next
    end if
end sub

sub solve
    i = 1 'cnt moves
    while word$(record$, i) <> ""
        scan
        cnt = cnt + 1
        i = i + 1
    wend
    for i = cnt to 1 step -1
        scan
        cmd$ = left$(word$(record$, i), 1)
        lv$ = right$(word$(record$, i), 1)
        for j = 1 to 3
            scan
            call cwRotate lv$
            call pause 100
        next
    next
    cmd$ = ""
    record$ = ""
end sub

sub help
    nl$ = Chr$(13)
    s$ =      "****************** Rubic Help *******************" + nl$
    s$ = s$ + "Let's call the 9 small cubes that make up 1/3" + nl$
    s$ = s$ + "of the entire cube a 'layer'.  Now, we need a" +nl$
    s$ = s$ + "shorthand method to specify which layer to rotate." + nl$
    s$ = s$ + "The x axis is layered left to right 1, 2, 3." + nl$
    s$ = s$ + "The y axis is layered top down 1, 2, 3." + nl$
    s$ = s$ + "The z axis is layered front to back 1, 2, 3." + nl$
    s$ = s$ + "So, to command a rotation:"+ nl$
    s$ = s$ + "Key press the axis and then the layer number." + nl$
    s$ = s$ + "Can also press h for this help, or q to quit." + nl$ + nl$
    s$ = s$ + "SOLVE!, press s to solve the cube."
    notice s$
end sub


3
Code and examples / Gears Afire!
« on: 25. May 2018, 04:04:24 »
Code: [Select]
_TITLE "Gears afire!.bas for QB64 by B+ started  2018-05-24"
'QB64 version 2017 1106/82 (the day before they switched to version 1.2)

CONST xmax = 800
CONST ymax = 600
DIM SHARED pi
pi = _PI
CONST bhr = 20
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60

DIM SHARED f(xmax, ymax) 'fire array tracks flames
DIM SHARED p&(300) 'pallette thanks harixxx
FOR i = 1 TO 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
NEXT

'gear up
sq = 20
nt1 = 12
r1 = gearRadius(nt1, sq)
nt2 = nt1 * 2
r2 = gearRadius(nt2, sq)
iA2 = pi / nt2
acc = 300: d = -1
WHILE 1 'main show
    CLS
    rao = rao + pi / acc
    gear 600, 300, nt1, sq, rao
    gear 600 - r1 - r2 - sq - 6, 300, nt2, sq, -.5 * rao - iA2
    FOR y = 1 TO ymax - 2 'fire based literally on 4 pixels below it like cellular automata
        FOR x = 1 TO xmax - 1
            v = (f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x, y + 2)) / 4 - 5
            IF v > 0 AND RND < .96 THEN f(x, y) = v ELSE f(x, y) = 0
            IF v > 294 THEN f(x, y) = 300
            PSET (x, y), p&(f(x, y))
        NEXT
    NEXT
    acc = acc + d * 2
    IF acc < 6 THEN acc = 6: d = d * -1
    IF acc > 300 THEN acc = 300: d = d * -1
    _DISPLAY
WEND

FUNCTION gearRadius (nteeth, sqtooth)
    gearRadius = .5 * sqtooth / SIN(.5 * pi / nteeth)
END FUNCTION

SUB gear (x, y, nteeth, sqtooth, raOffset)
    radius = .5 * sqtooth / SIN(.5 * pi / nteeth)
    FOR ra = 0 TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + (radius + sqtooth) * COS(ra + raOffset)
        y2 = y + (radius + sqtooth) * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth - 4
    NEXT
    FOR ra = pi / nteeth TO 2 * pi STEP 2 * pi / nteeth
        x2 = x + radius * COS(ra + raOffset)
        y2 = y + radius * SIN(ra + raOffset)
        thic x, y, x2, y2, sqtooth + 4
    NEXT
END SUB

SUB thic (x1, y1, x2, y2, thick)
    t2 = thick / 2
    IF t2 < 1 THEN t2 = 1
    a = _ATAN2(y2 - y1, x2 - x1)
    FOR i = 0 TO t2 STEP .5
        x3 = x1 + i * COS(a + _PI(.5))
        y3 = y1 + i * SIN(a + _PI(.5))
        x4 = x1 + i * COS(a - _PI(.5))
        y4 = y1 + i * SIN(a - _PI(.5))
        x5 = x2 + i * COS(a + _PI(.5))
        y5 = y2 + i * SIN(a + _PI(.5))
        x6 = x2 + i * COS(a - _PI(.5))
        y6 = y2 + i * SIN(a - _PI(.5))
        'fireLine x3, y3, x4, y4
        fireLine x4, y4, x6, y6
        'fireLine x6, y6, x5, y5
        fireLine x5, y5, x3, y3
    NEXT
END SUB

SUB fireLine (x, y, x1, y1)
    d = ((x - x1) ^ 2 + (y - y1) ^ 2) ^ .5
    a = _ATAN2(y1 - y, x1 - x)
    FOR i = 0 TO d
        xx = INT(x + i * COS(a) + .5)
        yy = INT(y + i * SIN(a) + .5)
        f(xx, yy) = rand(200, 300)
    NEXT
END SUB

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

Edit: Removed unused parameter in fireLine.

4
Code and examples / Sierpinski Circled
« on: 04. April 2018, 23:59:47 »
Code: [Select]
A new twist on an old fractal. Sierpinski triangle generalized and made dynamic for any regular poly though does not work well beyond 8 or 9.
[c_TITLE "Sierepinski Circled by bplus 2018-04-04 QB64 v 11-06-2017"
CONST xmax = 800
CONST ymax = 600
RANDOMIZE TIMER
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 360, 60
FOR n = 3 TO 8
    a = 0
    COLOR _RGBA((RND * 155 + 100) * INT(RND * 2), RND * 155 + 100, (RND * 155 + 100) * INT(RND * 2), 40)
    WHILE a < _PI(2) - _PI(1 / 360)
        CLS
        a = a + _PI(1 / 360)
        levels = 9 - n + 3
        RecurringCircles xmax / 2, ymax / 2, ymax / 8, n, a, levels
        _DISPLAY
        _LIMIT 200
    WEND
    _DELAY 5
NEXT
SUB RecurringCircles (x, y, r, n, rao, level)
    fcirc x, y, r
    IF level > 0 THEN
        ra = _PI(2) / n
        FOR i = 0 TO n - 1
            x1 = x + 1.5 * r * COS(i * ra + rao + _PI(-.5))
            y1 = y + 1.5 * r * SIN(i * ra + rao + _PI(-.5))
            RecurringCircles x1, y1, r * .5, n, 2 * rao, level - 1
        NEXT
    END IF
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

ode]


The screen shots are still shots of final positions (or start).

5
Code and examples / Happy St Patrick's Day
« on: 07. March 2018, 20:56:47 »
SmallBASIC version
Code: [Select]
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07

while 1
  cc1 = rgb(0, rnd*100 +50, 0)
  cc2 = rgb(0, rnd*100 +50, 0)
  xp = rnd * xmax
  yp = rnd * ymax
  size = int(rnd*100) + 10
  ang = rnd*2*pi
  color cc1
  for r = 1 to size
    drawShamrock xp+1, yp, r, ang
    drawShamrock xp-1, yp, r, ang
    drawShamrock xp, yp+1, r, ang
    drawShamrock xp, yp-1, r, ang
    drawShamrock xp+1, yp+1, r, ang
  next
  color cc2
  for r = 1 to size
    drawShamrock xp, yp, r, ang
  next
  showpage
  delay 10
wend
pause

'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub myArc( xCenter, yCenter, arcRadius, dAStart, dAMeasure)
    'notes:
    'you may want to adjust size and color for line drawing
    'using angle measures in degrees to match Just Basic ways with pie and piefilled
    'this sub assumes drawing in a CW direction if dAMeasure positive

    'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South

    'dAStart is degrees to start Angle, due East is 0 degrees

    'dAMeasure is degrees added (Clockwise) to dAstart for end of arc

    rAngleStart = RAD(dAStart)
    rAngleEnd = RAD(dAMeasure) + rAngleStart
    Stepper = RAD(1/(.1 * arcRadius)) 'fixed
    for rAngle = rAngleStart to rAngleEnd step Stepper
        if rAngle = rAngleStart then
            lastX = xCenter + arcRadius * cos(rAngle)
            lastY = yCenter + arcRadius * sin(rAngle)
        else
            nextX = xCenter + arcRadius * cos(rAngle)
            if nextX <= lastX then useX = nextX -1 else useX = nextX + 1
            nextY = yCenter + arcRadius * sin(rAngle)
            if nextY <= lastY then useY = nextY -1 else useY = nextY + 1
            line lastX, lastY, nextX, nextY
            lastX = nextX
            lastY = nextY
        end if
    next
end sub

sub drawHeart( x, y, r, a)
  local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
  'clockwise from due East, the V
  x1 = x + r * cos(a)
  y1 = y + r * sin(a)
  x2 = x + r * cos(a + pi/2)
  y2 = y + r * sin(a + pi/2)
  x3 = x + r * cos(a + pi)
  y3 = y + r * sin(a + pi)
  x4 = x + r * cos(a + 3*pi/2)
  y4 = y + r * sin(a + 3*pi/2)
  x5 = (x3 + x4)/2
  y5 = (y3 + y4)/2
  x6 = (x4 + x1)/2
  y6 = (y4 + y1)/2
  line x1, y1, x2, y2
  line x2, y2, x3, y3
  'left hump
  myArc x5, y5, .5 * r * 2 ^ .5, deg(a) + 135, 180
  'right hump
  myArc x6, y6, .5 * r * 2 ^ .5, deg(a) + 225, 180
end sub

sub drawShamrock(x, y, r, a)
  local x1, x2, x3, y1, y2, y3
  x1 = x + r * cos(a + 3*pi/2)
  y1 = y + r * sin(a + 3*pi/2)
  x2 = x + r * cos(a + pi/6)
  y2 = y + r * sin(a + pi/6)
  x3 = x + r * cos(a + 5*pi/6)
  y3 = y + r * sin(a + 5*pi/6)
  drawHeart x1, y1, r, a
  drawHeart x2, y2, r, a + 2*pi/3
  drawHeart x3, y3, r, a + 4*pi/3
end sub

QB version
Code: [Select]
_TITLE "Happy St Patrick's Day by bplus 2018-03-07"
' from
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07
CONST xmax = 1280
CONST ymax = 760
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 70, 0


WHILE 1
    cc1&& = _RGB32(0, RND * 100 + 50, 0)
    cc2&& = _RGB32(0, RND * 100 + 50, 0)
    xp = RND * xmax
    yp = RND * ymax
    size = INT(RND * 100) + 10
    ang = RND * _PI(2)
    COLOR cc1&&
    FOR r = 1 TO size
        drawShamrock xp + 1, yp, r, ang
        drawShamrock xp - 1, yp, r, ang
        drawShamrock xp, yp + 1, r, ang
        drawShamrock xp, yp - 1, r, ang
        drawShamrock xp + 1, yp + 1, r, ang
    NEXT
    COLOR cc2&&
    FOR r = 1 TO size
        drawShamrock xp, yp, r, ang
    NEXT
    _DISPLAY
    _LIMIT 20
WEND


'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
SUB myArc (xCenter, yCenter, arcRadius, dAStart, dAMeasure)
    'notes:
    'you may want to adjust size and color for line drawing
    'using angle measures in degrees to match Just Basic ways with pie and piefilled
    'this sub assumes drawing in a CW direction if dAMeasure positive

    'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South

    'dAStart is degrees to start Angle, due East is 0 degrees

    'dAMeasure is degrees added (Clockwise) to dAstart for end of arc

    rAngleStart = RAD(dAStart)
    rAngleEnd = RAD(dAMeasure) + rAngleStart
    Stepper = RAD(1 / (.1 * arcRadius)) 'fixed
    FOR rAngle = rAngleStart TO rAngleEnd STEP Stepper
        IF rAngle = rAngleStart THEN
            lastX = xCenter + arcRadius * COS(rAngle)
            lastY = yCenter + arcRadius * SIN(rAngle)
        ELSE
            nextX = xCenter + arcRadius * COS(rAngle)
            IF nextX <= lastX THEN useX = nextX - 1 ELSE useX = nextX + 1
            nextY = yCenter + arcRadius * SIN(rAngle)
            IF nextY <= lastY THEN useY = nextY - 1 ELSE useY = nextY + 1
            LINE (lastX, lastY)-(nextX, nextY)
            lastX = nextX
            lastY = nextY
        END IF
    NEXT
END SUB

SUB drawHeart (x, y, r, a)
    'local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
    'clockwise from due East, the V
    x1 = x + r * COS(a)
    y1 = y + r * SIN(a)
    x2 = x + r * COS(a + _PI(1 / 2))
    y2 = y + r * SIN(a + _PI(1 / 2))
    x3 = x + r * COS(a + _PI)
    y3 = y + r * SIN(a + _PI)
    x4 = x + r * COS(a + 3 * _PI / 2)
    y4 = y + r * SIN(a + 3 * _PI / 2)
    x5 = (x3 + x4) / 2
    y5 = (y3 + y4) / 2
    x6 = (x4 + x1) / 2
    y6 = (y4 + y1) / 2
    LINE (x1, y1)-(x2, y2)
    LINE (x2, y2)-(x3, y3)
    'left hump
    myArc x5, y5, .5 * r * 2 ^ .5, DEG(a) + 135, 180
    'right hump
    myArc x6, y6, .5 * r * 2 ^ .5, DEG(a) + 225, 180
END SUB

SUB drawShamrock (x, y, r, a)
    'local x1, x2, x3, y1, y2, y3
    x1 = x + r * COS(a + 3 * _PI / 2)
    y1 = y + r * SIN(a + 3 * _PI / 2)
    x2 = x + r * COS(a + _PI / 6)
    y2 = y + r * SIN(a + _PI / 6)
    x3 = x + r * COS(a + 5 * _PI / 6)
    y3 = y + r * SIN(a + 5 * _PI / 6)
    drawHeart x1, y1, r, a
    drawHeart x2, y2, r, a + 2 * _PI / 3
    drawHeart x3, y3, r, a + 4 * _PI / 3
END SUB

FUNCTION RAD (a)
    RAD = _PI(a / 180)
END FUNCTION

FUNCTION DEG (a)
    DEG = a * 180 / _PI
END FUNCTION

JB version
Code: [Select]
'from QB64
' _TITLE "Happy St Patrick's Day by bplus 2018-03-07"
' from
' Draw Angled Heart.bas SmallBASIC 0.12.11 (B+=MGA) 2018-03-07

global H$, XMAX, YMAX, PI, DEG, RAD
H$ = "gr"
XMAX = 1200 '<======================================== actual drawing space needed
YMAX = 720 '<======================================== actual drawing space needed
PI = acs(-1)
DEG = 180 / PI
RAD = PI / 180

nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2  'or delete if XMAX is 1200 or above
UpperLeftY = (720 - YMAX) / 2   'or delete if YMAX is 700 or above

open "     Happy St Patrick's Day by bplus 2018-03-07" for graphics_nsb_nf as #gr
#gr "setfocus"
#gr "trapclose quit"
#gr "down"
#gr "size 2"

WHILE 1
    scan
    cc1 = RND(0) * 100 + 50
    cc2 = RND(0) * 100 + 50
    xp = RND(0) * XMAX
    yp = RND(0) * YMAX
    sz = INT(RND(0) * 40) + 10
    ang = RND(0) * PI*2
    #gr "size 2"
    call fore 0, cc1, 0
    FOR r = 1 TO sz
        scan
        call drawShamrock xp +1, yp, r, ang
        'call drawShamrock xp - 1, yp, r, ang
        'call drawShamrock xp, yp + 1, r, ang
        'call drawShamrock xp, yp - 1, r, ang
        'call drawShamrock xp + 1, yp + 1, r, ang
    NEXT
    #gr "size 1"
    call fore 0, cc2, 0
    FOR r = 1 TO sz
        scan
        call drawShamrock xp, yp, r, ang
    NEXT
WEND
wait

sub fore r, g, b
    #gr "color ";r;" ";g;" ";b
end sub

sub aline x0, y0, x1, y1
    #gr "line ";x0;" ";y0;" ";x1;" ";y1  'add 1 to end point
end sub

'Need line: #gr "trapclose quit"
sub quit H$
    close #H$ '<=== this needs Global H$ = "gr"
    end       'Thanks Facundo, close graphic wo error
end sub

'draws an arc with center at xCenter, yCenter, radius from center is arcRadius
sub arc xCenter, yCenter, arcRadius, dAStart, dAMeasure
    'notes:
    'you may want to adjust size and color for line drawing
    'using angle measures in degrees to match Just Basic ways with pie and piefilled
    'this sub assumes drawing in a CW direction if dAMeasure positive

    'for Just Basic angle 0 degrees is due East and angle increases clockwise towards South

    'dAStart is degrees to start Angle, due East is 0 degrees

    'dAMeasure is degrees added (Clockwise) to dAstart for end of arc

    rAngleStart = RAD * dAStart
    rAngleEnd = RAD * dAMeasure + rAngleStart
    Stepper = RAD / (.1 * arcRadius) 'fixed
    for rAngle = rAngleStart to rAngleEnd step Stepper
        if rAngle = rAngleStart then
            lastX = xCenter + arcRadius * cos(rAngle)
            lastY = yCenter + arcRadius * sin(rAngle)
        else
            nextX = xCenter + arcRadius * cos(rAngle)
            if nextX <= lastX then useX = nextX -1 else useX = nextX + 1
            nextY = yCenter + arcRadius * sin(rAngle)
            if nextY <= lastY then useY = nextY -1 else useY = nextY + 1
            #gr "line ";lastX;" ";lastY;" ";nextX;" ";nextY
            lastX = nextX
            lastY = nextY
        end if
    next
end sub

SUB drawHeart x, y, r, a
    scan
    'local x1, x2, x3, x4, x5, x6, y1, y2, y3, y4, y5, y6
    'clockwise from due East, the V
    x1 = x + r * COS(a)
    y1 = y + r * SIN(a)
    x2 = x + r * COS(a + PI / 2)
    y2 = y + r * SIN(a + PI / 2)
    x3 = x + r * COS(a + PI)
    y3 = y + r * SIN(a + PI)
    x4 = x + r * COS(a + 3 * PI / 2)
    y4 = y + r * SIN(a + 3 * PI / 2)
    x5 = (x3 + x4) / 2
    y5 = (y3 + y4) / 2
    x6 = (x4 + x1) / 2
    y6 = (y4 + y1) / 2
    #gr "line ";x1;" ";y1;" ";x2;" ";y2
    #gr "line ";x2;" ";y2;" ";x3;" ";y3
    'left hump
    call arc x5, y5, .5 * r * 2 ^ .5, DEG*a + 135, 180
    'right hump
    call arc x6, y6, .5 * r * 2 ^ .5, DEG*a + 225, 180
END SUB

SUB drawShamrock x, y, r, a
    'local x1, x2, x3, y1, y2, y3
    scan
    x1 = x + r * COS(a + 3 * PI / 2)
    y1 = y + r * SIN(a + 3 * PI / 2)
    x2 = x + r * COS(a + PI / 6)
    y2 = y + r * SIN(a + PI / 6)
    x3 = x + r * COS(a + 5 * PI / 6)
    y3 = y + r * SIN(a + 5 * PI / 6)
    call drawHeart x1, y1, r, a
    call drawHeart x2, y2, r, a + 2 * PI / 3
    call drawHeart x3, y3, r, a + 4 * PI / 3
END SUB


6
Community news and announcements / QB64 world
« on: 15. February 2018, 16:50:56 »
I don't know if we ever talked about QB64 here?

For me it is like SmallBASIC's big brother but Compiled and with typed variables (many!) and many new features that are incompatible with old QBasic or QB45 or ... these keywords are all marked with a beginning underline _newKeyword  so old QB usually mostly works.

There is the official QB64.net
http://www.qb64.net/forum/
currently (2018-02-15) down

There is a newer OB64.org that takes over when .net is down (down allot) and as of today will stay up and co-exist with the official .net site.
http://qb64.org (important downloads and sources)
http://qb64.org/forum/

Walter Whitman's site: The Joyful Programmer (where I hang out too much and might find a couple golden oldies from BP.org)
http://qb64.thejoyfulprogrammer.com/?rndtime=1514578291164454855

There are many enthusiast sites, I will share one, Steve McNeil's because he has the Basic spirit of being teacher to beginners:
http://qb64.freeforums.net
(though ProBoards is NOT my favorite forum host environment) Steve has this forum as backup to his code but it is regular forum where the code could be discussed in advertised space.

So JJ, you don't have to just hang out at FB  8)
And Galileo, there are guys at .net that speak your language, I think.

Oh very important! Don't forget about the Wiki:
http://www.qb64.net/wiki/index.php/Main_Page
(but today is experiencing technical difficulties because QB64.net is down and Wiki is tied in with it. We gotta fix that because using help from IDE is as primitive as using the IDE's file LOAD Dialog.)

7
Code and examples / Text Rotation Fun
« on: 03. February 2018, 05:45:32 »
Code: [Select]
'text rotation fun.bas for SmallBASIC 0.12.11 (B+=MGA) 2017-02-02

'global variables
message = "abcdefghijklmnopqrstuvwxyz""
secWide = txtw(message) + 2
secHigh = txth(message) + 2
dim sect(secWide, secHigh) 'array to store message points
color rgb(200, 200, 200),0 : cls
rect 0, 0, secWide, secHigh, 9

? message
loadSect 0, 0 'load array
'debug checks
'for y = 0 to secHigh
'  for x = 0 to secWide
'    if sect(x, y) then pset x + 200, y + 200
'  next
'next
'input "OK ";ok

dim plasma(5, 3)
for i = 0 to 5
  plasma(i, 0) = rnd * rnd
  plasma(i, 1) = rnd * rnd
  plasma(i, 2) = rnd * rnd
next

cls
cx = xmax/2 : cy = ymax/2
while 1
  cls
  dp 0
  yaxis cx, cy/4, a, 2
  dp 1
  xaxis cx, 3*cy/4, a, 5
  dp 2
  rotate cx/2, cy, a, 1
  dp 3
  rotate 3*cx/2, cy, a -90, 2.5
  dp 4
  rotate cx, cy/2, -4*a + 90, 2
  dp 5
  rotate cx, 3*cy/2, 2*a + 180, 4.5
  showpage
  delay 10
  a = a + 1
  if a = 360 then a = 0
wend
pause

sub dp(i)
  color rgb(128 + 127*sin(plasma(i,0)*a), 128 + 127*sin(plasma(i, 1)*a), 128 + 127*sin(plasma(i, 2)*a))
end

sub loadSect(xstart, ystart)
  local x, y, p, black
  'these are all global
  black = rgb(100 ,100, 100)
  for y = 0 to secHigh
    for x = 0 to secWide
      p = POINT(xstart + x, ystart + y)
      if p < black then sect(x, y) = 1 '<== data from screen points
    next
  next
end

sub rotate(cx, cy, angle, scale) 'and scale
  local cax, cay, ra, cc, d, anew, ax,ay

  cax = secWide/2 : cay = secHigh/2  'array center
  for y = 0 to secHigh
    for x = 0 to secWide
      cc = sect(x,y)
      if (x-cax) <> 0  and cc <> 0 then
        d = ((x-cax)^2+(y-cay)^2)^.5
        anew = atan((y-cay)/(x-cax))
        if x-cax <  0 and y-cay  < 0 then anew = anew + pi+rad(angle)  '-x,-y
        if x-cax <  0 and y-cay >= 0 then anew = anew + pi+rad(angle) '-x,+y
        if x-cax >= 0 and y-cay  < 0 then anew = anew + rad(angle)    '+x,-y
        if x-cax >= 0 and y-cay >= 0 then anew = anew + rad(angle)   '+x,+y
        ax = d*cos(anew):ay=d*sin(anew)
        rect int(cx+ax*scale),int(cy+ay*scale) step scale+1, scale+1 filled
      end if
    next
  next
end

sub yaxis(cx, cy, angle, scale)
   local cax, cay, cc, ax,ay

  cax = secWide/2 : cay = secHigh/2  'array center
  for y = 0 to secHigh
    for x = 0 to secWide
      cc = sect(x,y)
      if cc <> 0 then
        ax = (x - cax)*cos(rad(angle)):ay= (y - cay)
        rect int(cx+ax*scale),int(cy+ay*scale) step scale+1, scale+1 filled
      end if
    next
  next
end

sub xaxis(cx, cy, angle, scale)
   local cax, cay, cc, ax,ay

  cax = secWide/2 : cay = secHigh/2  'array center
  for y = 0 to secHigh
    for x = 0 to secWide
      cc = sect(x,y)
      if cc <> 0 then
        ax = (x - cax) :ay = (y - cay) * sin( rad(angle))
        rect int(cx+ax*scale),int(cy+ay*scale) step scale+1, scale+1 filled
      end if
    next
  next
end 


8
Code and examples / Goldwave
« on: 29. January 2018, 03:11:00 »
Hi Galileo, maybe you have something like this?

Code: [Select]
'goldwave by johnno copied and mod 2018-01-28
dark1 = rgb(0,0,32)
dark2 = rgb(0,32,0)
dark3 = rgb(32,0,0)

for t=1 to 60 step .1  '< changed
  cls 'changed
  'rect 0,0,600,600 color dark3 filled
  For y1 = 0 to 24
    For x1 = 0 to 24
      x=(12*(24-x1))+(12*y1)
      y=(-6*(24-x1))+(6*y1)+300
      d= ((10-x1)^2+(10-y1)^2)^.5
      h=60*sin(x1/4+t)+65
      if t>10 and t<20 then h=60*sin(y1/4+t)+65
      if t>20 and t<30 then h=60*sin((x1-y1)/4+t)+65
      if t>30 and t<40 then h=30*sin(x1/2+t)+30*sin(y1/2+t)+65
      if t>40 and t<50 then h=60*sin((x1+y1)/4+t)+65
      if t>50 and t<60 then h=60*sin(d*.3+t)+65
      'TOP
      p1 = [x,y-h,x+10,y+5-h,x+20,y-h,x+10,y-5-h]
      drawpoly p1 color rgb(242+.1*h,242+.1*h,h) filled  '< changed
      'FRONT-LEFT
      p2 = [x,y-h,x+10,y+5-h,x+10,y,x,y-5]
      drawpoly p2 color rgb(255,80,0) filled
      'FRONT-RIGHT
      p3 = [x+10,y+5-h,x+10,y,x+20,y-5,x+20,y-h]
      drawpoly p3 color rgb(255,150,0) filled
      'if inkey$ = chr$(27) then end '<<<<<<<<<<<<<<<<<<<<< this is THE time killer
    next
  next
  showpage '< changed
  delay 20 '<changed
next

9
Offtopic / Goodbye SdlBasic (and Hello! again)
« on: 26. January 2018, 21:50:11 »
I see the forum site is gone.  :(

EDIT: added word "forum" (epizy).

10
General questions and discussions / Sudoku
« on: 11. January 2018, 17:54:51 »
Hi,

I am studying Sudoku Game and probably will revisit Solvers eventually, at these sites:

Just Basic: http://justbasic.conforums.com/index.cgi?board=code&action=display&num=1515342883

SmallBASIC: https://smallbasic.sourceforge.io/?q=node/1773

QB64: http://www.qb64.net/forum/index.php?topic=14672.0

and here The Joyful Programmer > The QB64 Edition:
http://qb64.thejoyfulprogrammer.com/showthread.php?tid=1207&pid=5720&rndtime=15156870881901289581#pid5720

My main interest is perfecting THE GAME algorithms, board making and cell hiding such that when you hide the cells you don't create a board that can be solved more than one way.

I've already learned you can make a legit board for a game but it is trivial to solve, as discussed or illustrated in above links.

I have devised code that will create non trivial boards but need an algo to hide the cells but keep solution unique, ie only one solution set. Is there one? 

Could I understand how it is put together and works? ;-))

11
Code and examples / Happy New Year 2018
« on: 30. December 2017, 18:53:16 »
From a little challenge at the QB64.net forum:
Code: [Select]
_TITLE "Happy Trails 2018"
' 2017-12-29 another redesign of fireworks
' 2017-12-28 redesign fireworks
' now with lake refelction 2017-12-27 forget the bouncing sparks
' combine Welcome Plasma Font with landscape
'_title "Fireworks 3 translation to QB64 2017-12-26 bplus"
'fireworks 3.bas SmallBASIC 0.12.2 [B+=MGA] 2015-05-09
'fireworks 2.bas 2016-05-05 now with Gravity, Newtonian bounce, smoke debris
'fireworks 3.bas try with map variables make bursts around a central point


RANDOMIZE TIMER
CONST xmax = 1200
CONST ymax = 720
CONST waterline = 600 ' 600 = ratio 5 to 1 sky to water
'                       raise and lower waterline as desired  highest about 400?
CONST lTail = 15
CONST bluey = 5 * 256 ^ 2 + 256 * 5 + 5
CONST debrisMax = 28000

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 120, 20

TYPE fireWorkType
    x AS INTEGER
    y AS INTEGER
    seed AS INTEGER
    age AS INTEGER
    life AS INTEGER
END TYPE


TYPE debrisType
    x AS SINGLE
    y AS SINGLE
    c AS LONG
END TYPE

COMMON SHARED fw() AS fireWorkType
COMMON SHARED debris() AS debrisType
COMMON SHARED cN, pR!, pG!, pB!

SCREEN _NEWIMAGE(xmax, ymax, 32)

'prepare message font
mess$ = " Happy New Year 2018"
PRINT mess$
w = 8 * LEN(mess$): h = 16
DIM p(w, h)
black&& = POINT(0, 10)
FOR y = 0 TO h
    FOR x = 0 TO w
        IF POINT(x, y) <> black&& THEN
            p(x, y) = 1
        END IF
    NEXT
NEXT
xo = 0: yo = 15: m = 7.2
resetPlasma

'prepare landscape
CLS
land& = _NEWIMAGE(xmax, ymax, 32)
_DEST land&
drawLandscape
_DEST 0

'prepare fire works
nFW = 3
DIM fw(1 TO 10) AS fireWorkType
FOR i = 1 TO nFW
    initFireWork (i)
NEXT

'debris feild
DIM debris(debrisMax) AS debrisType

'OK start the show
WHILE 1
    'cls screen with land image
    _PUTIMAGE , land&, 0

    'draw fireworks
    FOR f = 1 TO nFW
        IF fw(f).age <= fw(f).life THEN drawfw (f) ELSE initFireWork f
    NEXT

    'debris
    FOR i = 0 TO debrisStack
        PSET (debris(i).x, debris(i).y), debris(i).c
        debris(i).x = debris(i).x + RND * 3 - 1.5
        debris(i).y = debris(i).y + RND * 3.5 - 1.5
        IF debris(i).x < 0 OR debris(i).y < 0 OR debris(i).x > xmax OR debris(i).y > waterline + RND * 20 THEN NewDebris (i)
    NEXT

    'text message in plasma
    FOR y = 0 TO h - 1
        FOR x = 0 TO w - 1
            IF p(x, y) THEN
                changePlasma
            ELSE
                COLOR 0
            END IF
            LINE (xo + x * m, yo + y * m)-(xo + x * m + m, yo + y * m + m), , BF
        NEXT
    NEXT
    lc = lc + 1
    IF lc MOD 200 = 0 THEN resetPlasma

    'reflect sky
    skyWaterRatio = waterline / (ymax - waterline) - .05
    FOR y = waterline TO ymax
        FOR x = 0 TO xmax
            c&& = POINT(x, waterline - ((y - waterline - 1) * skyWaterRatio) + RND * 5)
            PSET (x, y + 1), c&& + bluey
        NEXT
    NEXT

    _DISPLAY
    _LIMIT 50 'no limit needed on my system!

    'accumulate debris
    IF lc MOD 2000 THEN
        IF debrisStack < debrisMax THEN
            FOR i = 1 TO 2
                NewDebris i + debrisStack
            NEXT
            debrisStack = debrisStack + 2
        END IF
    END IF
WEND

SUB NewDebris (i)
    debris(i).x = RND * xmax
    debris(i).y = RND * ymax
    c = RND * 155
    debris(i).c = _RGB32(c, c, c)
END SUB

SUB changePlasma ()
    cN = cN + .01
    COLOR _RGB(127 + 127 * SIN(pR! * .3 * cN), 127 + 127 * SIN(pG! * .3 * cN), 127 + 127 * SIN(pB! * .3 * cN))
END SUB

SUB resetPlasma ()
    pR! = RND ^ 2: pG! = RND ^ 2: pB! = RND ^ 2
END SUB

SUB drawLandscape
    'the sky
    FOR i = 0 TO ymax
        midInk 0, 0, 0, 78, 28, 68, i / ymax
        LINE (0, i)-(xmax, i)
    NEXT
    'the land
    startH = waterline - 80
    rr = 10: gg = 20: bb = 15
    FOR mountain = 1 TO 6
        Xright = 0
        y = startH
        WHILE Xright < xmax
            ' upDown = local up / down over range, change along Y
            ' range = how far up / down, along X
            upDown = (RND * .8 - .35) * (1 / (1 * mountain))
            range = Xright + rand&&(5, 35) * 2.5 / mountain
            lastx = Xright - 1
            FOR X = Xright TO range
                y = y + upDown
                COLOR _RGB32(rr, gg, bb)
                LINE (lastx, y)-(X, ymax), , BF 'just lines weren't filling right
                lastx = X
            NEXT
            Xright = range
        WEND
        rr = rand&&(rr + 5, rr): gg = rand&&(gg + 5, gg): bb = rand&&(bb + 4, bb)
        IF rr < 0 THEN rr = 0
        IF gg < 0 THEN gg = 0
        IF bb < 0 THEN bb = 0
        startH = startH + rand&&(1, 10)
    NEXT
    'LINE (0, waterline)-(xmax, ymax), _RGB32(0, 0, 0), BF
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

SUB drawfw (i)
    'here's how to "save" a bunch of random numbers without data and arrays but tons of redundant calculations
    RANDOMIZE USING fw(i).seed 'this repeats all random numbers generated by seed in same sequence
    'recreate our firework from scratch!
    red = rand&&(200, 255)
    green = rand&&(200, 255)
    blue = rand&&(200, 255)
    x = rand&&(1, 4)
    IF x = 1 THEN
        red = 0
    ELSEIF x = 2 THEN
        green = 0
    ELSEIF x = 3 THEN
        blue = 0
    ELSE
        x = rand&&(1, 4)
        IF x = 1 THEN
            red = 0: green = 0
        ELSEIF x = 2 THEN
            green = 0: blue = 0
        ELSEIF x = 3 THEN
            blue = 0: red = 0
        END IF
    END IF
    ne = rand&&(80, 300)
    DIM embers(ne, 1)
    FOR e = 0 TO ne
        r = RND * 3
        embers(e, 0) = r * COS(e * _PI(2) / 101)
        embers(e, 1) = r * SIN(e * _PI(2) / 101)
    NEXT
    start = fw(i).age - lTail ' don't let tails get longer than lTail const
    IF start < 1 THEN start = 1
    FOR e = 0 TO ne
        cx = fw(i).x: cy = fw(i).y: dx = embers(e, 0): dy = embers(e, 1)
        FOR t = 1 TO fw(i).age
            cx = cx + dx
            cy = cy + dy
            IF t >= start THEN
                'too much like a flower?
                midInk 60, 60, 60, red, green, blue, (t - start) / lTail
                'midInk 60, 60, 60, 128, 160, 150, (t - start) / lTail
                fcirc cx, cy, (t - start) / lTail
            END IF

            dx = dx * .99 'air resitance
            dy = dy + .01 'gravity
        NEXT
        COLOR _RGB32(255, 255, 255)
        'COLOR _RGB32(red, green, blue)
        cx = cx + dx: cy = cy + dy
        fcirc cx, cy, (t - start) / lTail
    NEXT
    fw(i).age = fw(i).age + 1
END SUB

SUB initFireWork (i)
    fw(i).x = rand&&(.1 * xmax, .9 * xmax)
    fw(i).y = rand&&(.1 * ymax, .5 * ymax)
    fw(i).seed = rand&&(0, 32000)
    fw(i).age = 0
    fw(i).life = rand&&(20, 120)
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

Maybe last post from the "dinosaur", got a new laptop where the limit in main loop is actually needed!

12
For some Hodiday fun, you might enjoy this link to the QB64 Season's Greeting Challenge:

http://www.qb64.net/forum/index.php?topic=14646.0

Merry Christmas!

13
Code and examples / Great balls of fire
« on: 24. November 2017, 05:00:46 »
Code: [Select]
'Great balls of fire.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-23

xxmax = 180 : yymax = 85  'pixels too slow
xstep = xmax / xxmax : ystep = ymax / yymax
dim p(300)  'pallette thanks harixxx
for i = 1 to 100
  fr = 240 * i / 100 + 15
  p(i) = rgb(fr, 0, 0)
  p(i + 100) = rgb(255, fr, 0)
  p(i + 200) = rgb(255, 255, fr)
next
dim f(xxmax, yymax) 'fire array tracks flames
nb = 13             'number of balls
acc = .1            'gravity
br = 4              'ball radius
brs = br * br       'ball radius squared
dim b(1 to nb)      'ball array
for i = 1 to nb     'ball maker
  b(i).x = (xxmax - 2 * br) * rnd + br            'x location
  b(i).y = (yymax - 2 * br) * (i - 1) / nb + br   'y location
  if rnd < .5 then b(i).dx = 1 + rnd * 2 else b(i).dx = -1 - rnd * 2  'dx change of x
  b(i).dy = 1                                                         'dy change of y
next

while 1  'main show
 
  cls 'some flames are sticking
  for i = 0 to xxmax : f(i, yymax) = 0 : f(i, yymax - 1) = 0 : next
  for i = 0 to yymax : f(0, i) = 0 : next
   
  for y = 1 to yymax - 2  'fire based literally on 4 pixels below it like cellular automata
    for x = 1 to xxmax - 1
      f(x, y) = max( (f(x - 1, y + 1) + f(x, y + 1) +f(x + 1, y + 1) + f(x, y + 2) ) / 4 - 5, 0)
      rect x * xstep, y * ystep, step xstep + 1, ystep + 1, p(f(x, y)) filled
    next
  next
 
  for i = 1 to nb  'move ball
    b(i).dy = b(i).dy + acc
   
    'new location unless out of boundsw
    b(i).y = b(i).y + b(i).dy
    b(i).x = b(i).x + b(i).dx
   
    'keep ball in bounds
    if b(i).y > yymax - br then b(i).dy = -.9 * b(i).dy : b(i).y = yymax - br : b(i).dx = b(i).dx *.9
    if b(i).x < br  then b(i).dx = -.9 * b(i).dx : b(i).x = br
    if b(i).x > xxmax - br  then b(i).dx = -.9 * b(i).dx : b(i).x = xxmax - br
   
    'handle new location
    fireBall b(i).x, b(i).y
   
    'handle dead balls
    if abs(b(i).lastbx - b(i).x)< .01 and abs(b(i).lastby-b(i).y) < .01  then
      b(i).x = (xxmax - 2 * br) * rnd + br
      b(i).y =  0
      b(i).dy = 1
      if rnd < .5 then b(i).dx = 1 + rnd * 2 else b(i).dx = -1 - rnd * 2  'edit
    fi
    b(i).lastby = b(i).y : b(i).lastbx = b(i).x
   
  next
  showpage
  delay 10
wend

sub fireBall(x, y)
  local xr, yr, yrMax
  for yr = 0 to br
    if y + yr <= yymax - 2  then f(x, y + yr) = 300
    if y - yr >= 0 then f(x, y - yr) = 300
  next
  for xr = 0 to br
    yrMax = (brs - xr * xr) ^ .5
    for yr = 0 to yrMax
      if x + xr < xxmax - 1 and y + yr <= yymax - 1  then f(x + xr, y + yr) = 300
      if x + xr < xxmax - 1 and y - yr >= 0  then f(x + xr, y - yr) = 300
      if x - xr >= 0 and y + yr <= yymax then f(x - xr, y + yr) = 300
      if x - xr >= 0 and y - yr >= 0  then f(x - xr, y - yr) = 300 
    next
  next
  circle x * xstep, y * ystep - ystep, br * xstep, xstep / ystep, p(300) filled
end

14
Community news and announcements / Game Competition
« on: 04. November 2017, 15:16:39 »
Richey's post reminded me of this:
http://www.qb64.net/forum/index.php?topic=14570.0

Hosted by GitHub, another game coding competition that is not too late to submit (I think).

wait... do game coders come here?

15
Code and examples / Halloween Reoccurence
« on: 31. October 2017, 04:28:10 »
Another occurrence of another variation, kind of scary how it wont go away...

QB64 so I had to make my own ellipse and fill triangle subs.

Code: [Select]
_TITLE "Halloween Reoccurence 2017-10-29 bplus"
CONST xmax = 1100
CONST ymax = 740

SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 160, 2

RANDOMIZE TIMER
COMMON SHARED sx
cx = xmax / 2: cy = ymax / 2: pr = .49 * xmax
d = 1: sx = 0
WHILE 1
    pumpkin cx, cy, pr, 3
    sx = sx + rand%(-4, 4)
    IF sx > .7 * pr / 12 THEN d = -1 * d: sx = 0
    IF sx < -.7 * pr / 12 THEN d = -1 * d: sx = 0
    _DISPLAY
    _LIMIT 6
WEND

FUNCTION rand% (lo%, hi%)
    rand% = INT(RND * (hi% - lo% + 1)) + lo%
END FUNCTION

SUB pumpkin (cx, cy, pr, limit)
    'carve this!
    COLOR &HFFFF0000
    fEllipse cx, cy, pr, 29 / 35 * pr
    COLOR &HFF000000
    lastr = 2 / 7 * pr
    DO
        ellipse cx, cy, lastr, 29 / 35 * pr
        lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr
        IF pr - lastr < 1 / 80 * pr THEN EXIT DO
    LOOP

    ' 'flickering candle light
    COLOR _RGB(RND * 55 + 200, RND * 55 + 200, 120)

    ' eye sockets
    ftri cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12
    ftri cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12
    ftri cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12
    ftri cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12

    ' nose
    ftri cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12

    ' evil grin
    ftri cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12
    ftri cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12

    ' moving teeth/talk/grrrr..
    u = rand%(4, 8)
    dx = pr / u
    FOR i = 1 TO u
        tx1 = cx - 6 * pr / 12 + (i - 1) * dx
        tx2 = tx1 + .5 * dx
        tx3 = tx1 + dx
        ty1 = cy + 5 * pr / 12
        ty3 = cy + 5 * pr / 12
        ty2 = cy + (4 - RND) * pr / 12
        ty22 = cy + (6 + RND) * pr / 12
        ftri tx1, ty1, tx2, ty2, tx3, ty3
        ftri tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3
    NEXT
    IF limit THEN

        'shifty eyes
        IF limit = 3 THEN sxs = sx ELSE sxs = .1 * sx
        pumpkin sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, INT(limit - 1)
        pumpkin sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, INT(limit - 1)
    END IF
END SUB

SUB fEllipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)
    DIM scale AS SINGLE, x AS LONG, y AS LONG
    scale = yRadius / xRadius
    LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF
    FOR x = 1 TO xRadius
        y = scale * SQR(xRadius * xRadius - x * x)
        LINE (CX + x, CY - y)-(CX + x, CY + y), , BF
        LINE (CX - x, CY - y)-(CX - x, CY + y), , BF
    NEXT
END SUB

SUB ellipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)
    DIM scale AS SINGLE, xs AS LONG, x AS LONG, y AS LONG
    DIM lastx AS LONG, lasty AS LONG
    scale = yRadius / xRadius: xs = xRadius * xRadius
    PSET (CX, CY - yRadius): PSET (CX, CY + yRadius)
    lastx = 0: lasty = yRadius
    FOR x = 1 TO xRadius
        y = scale * SQR(xs - x * x)
        LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)
        LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)
        LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)
        LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)
        lastx = x: lasty = y
    NEXT
END SUB

SUB ftri (xx1, yy1, xx2, yy2, xx3, yy3)
    'make copies before swapping
    x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3
    'thanks Andy Amaya!
    'triangle coordinates must be ordered: where x1 < x2 < x3
    IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2
    IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3
    IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3
    IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

    'draw the first half of the triangle
    length = x2 - x1
    IF length <> 0 THEN
        slope2 = (y2 - y1) / (x2 - x1)
        FOR x = 0 TO length
            LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))
            'lastx2% = lastx%
            lastx% = INT(x + x1)
        NEXT
    END IF

    'draw the second half of the triangle
    y = length * slope1 + y1: length = x3 - x2
    IF length <> 0 THEN
        slope3 = (y3 - y2) / (x3 - x2)
        FOR x = 0 TO length
            'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN  'works! but need 2nd? check
            IF INT(x + x2) <> lastx% THEN
                LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))
            END IF
        NEXT
    END IF
END SUB

Pages: [1] 2 3 ... 7