08-12-2023, 11:13 PM
A demo in QB64pe of the Sub FTri (Fill Triangle):
Here it is as crucial sub in an old Halloween thing (without a color parameter):
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 SubHere 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
b = b + ...