Filled Triangle for BAM?

[bplus]

Charlie I have some code for a Triangle Fill that I picked up from Andy Amaya at Just Basic Forum.

I've used it with SmallBASIC and I think it would be really handy for BAM if you don't have anything like that. QB64 has the _MapTriangle method so not really needed in that?

Your Area question reminded me of that and filling a polygon without Paint keyword.

[CharlieJV]

Charlie I have some code for a Triangle Fill that I picked up from Andy Amaya at Just Basic Forum.

I've used it with SmallBASIC and I think it would be really handy for BAM if you don't have anything like that. QB64 has the _MapTriangle method so not really needed in that?

Your Area question reminded me of that and filling a polygon without Paint keyword.

For sure!  Lob that over any time.

[bplus]

A demo in QB64pe of the Sub FTri (Fill Triangle):

Code: (Select All)

_Title "Filled Triangle Demo" 'b+ 2023-08-12
Screen _NewImage(800, 600, 12) ' use 16 colors for demo
_ScreenMove 250, 60
Print "Here is one, press any for many...."
ftri 100, 100, 500, 10, 300, 480, 9
Sleep
Do
    ftri Rnd * _Width, Rnd * _Height, Rnd * _Width, Rnd * _Height, Rnd * _Width, Rnd * _Height, Rnd * 15
    _Limit 2
Loop While _KeyDown(27) = 0

Sub ftri (xx1, yy1, xx2, yy2, xx3, yy3, c)
    'make copies before swapping because QB64 passes by ref and these get changed
    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)), c
            '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)), c
            End If
        Next
    End If
End Sub

Here it is as crucial sub in an old Halloween thing (without a color parameter):

Code: (Select All)

_Title "Halloween Recurrence" ' 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

[CharlieJV]

I'm pretty happy with that.  I just hat to tweak a couple of little things to get it working (I think it's working; something is working) in BAM:

• Run the program
  
• View the source code
  

J'ai les deux yeux dans le même trou (literal: I have both eyes in the same hole; meaning: I'm really sleepy), so I'll have to do side by side compare with QB64 tomorrow.