Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 492
» Latest member: Feederumn
» Forum threads: 2,829
» Forum posts: 26,529

Full Statistics

Latest Threads
which day of the week
Forum: Programs
Last Post: Stuart
4 hours ago
» Replies: 26
» Views: 595
Playing sound files in QB...
Forum: Programs
Last Post: ahenry3068
7 hours ago
» Replies: 9
» Views: 1,154
Aloha from Maui guys.
Forum: General Discussion
Last Post: mrbcx
10 hours ago
» Replies: 6
» Views: 107
another variation of "10 ...
Forum: Programs
Last Post: Jack002
Yesterday, 11:54 PM
» Replies: 1
» Views: 83
Rock Jockey 2.0 is ready ...
Forum: Games
Last Post: NakedApe
Yesterday, 09:02 PM
» Replies: 20
» Views: 591
Button rack or hotkey fun...
Forum: Utilities
Last Post: Jack002
Yesterday, 08:20 PM
» Replies: 6
» Views: 392
ANSIPrint
Forum: a740g
Last Post: bplus
Yesterday, 05:36 PM
» Replies: 11
» Views: 216
Audio Spectrum Analyser
Forum: Programs
Last Post: Jack002
Yesterday, 01:56 AM
» Replies: 7
» Views: 164
_mem
Forum: Help Me!
Last Post: hsiangch_ong
Yesterday, 01:50 AM
» Replies: 13
» Views: 303
pan around a large image ...
Forum: Programs
Last Post: hsiangch_ong
Yesterday, 01:32 AM
» Replies: 0
» Views: 29

 
  Playing with code: a circle function using triangle math
Posted by: CharlieJV - 09-13-2023, 03:17 AM - Forum: QBJS, BAM, and Other BASICs - Replies (7)

Just experimenting with some code for creating circles with "triangle math".

As always, I start with big and ugly code just to understand the pieces before making the code pretty.

Code: (Select All)
' C is the right angle
' c is opposite side
' c squared = a squared + b squared

size = 100
aspect_ratio = 1
screen _newimage(size, size, 12)

root_x = size / 2 : root_y = size / 2
c = size / 2 - 25

for a = C to 0 step - 0.01
b = ( c ^ 2 - a ^ 2 ) ^ (0.5)
pset (root_x + a, root_y - (b/aspect_ratio)), 14
next a

for a = 0 to c step 0.01
b = ( c ^ 2 - a ^ 2 ) ^ (0.5)
pset (root_x - a, root_y - (b/aspect_ratio)), 13
next a

for a = -c to 0 step 0.01
b = ( c ^ 2 - a ^ 2 ) ^ (0.5)
pset (root_x + a, root_y + (b/aspect_ratio)), 12
next a

for a = 0 to c step 0.01
b = ( c ^ 2 - a ^ 2 ) ^ (0.5)
pset (root_x + a, root_y + (b/aspect_ratio)), 11
next a

   

Print this item

  draw lines and polygons with triangles .
Posted by: James D Jarvis - 09-12-2023, 08:36 PM - Forum: Works in Progress - Replies (2)

A set of routines for drawing lines and shapes using _maptriangle to fill the graphics. I've posted earlier versions of some of this before but it's getting refined and coming together better. Everything isn't perfect but it's better than what has come before.

Code: (Select All)
'drawtriangle_lines_polyFT_v0.3
' by James D.  Jarvis  , Sept 12,2023
'draw filled  polygons  using _maptriangle
' draw lines  using _maptrinagle
'
'HEADER
'$dynamic
Dim Shared xmax, ymax
Dim Shared line_endcap
xmax = 800: ymax = 500
Screen _NewImage(xmax, ymax, 32)
Dim Shared pk& 'must be included in a program that uses polyFT
Dim Shared lk&
pk& = _NewImage(3, 3, 32) 'must be included in a program that uses polyFT
lk& = _NewImage(3, 3, 32)
'======================================
' demo
'======================================
' This demo draws 64000 random polygons, and then clears the screen and draws a handful of polygons  rotating

Randomize Timer
_Title "Draw Triangle Lines Demo v0.3"
use_endcap "round"
t1 = Timer
For reps = 1 To 64000
    ' polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), Int(1 + Rnd * 3), Int(1 + Rnd * 3), Int(Rnd * 6), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    ts = Int(1 + Rnd * 4)
    polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * (5 * ts)), Int(3 + Rnd * 12), Int(Rnd * 60), ts, ts, ts, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next reps
t2 = Timer
Print "That took "; t2 - t1; " seconds to draw 64000 outlined and scaled polygons"
Sleep
Cls
t3 = Timer
For reps = 1 To 64000
    ' polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), Int(1 + Rnd * 3), Int(1 + Rnd * 3), Int(Rnd * 6), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    polyFT Int(Rnd * xmax), Int(Rnd * ymax), Int(3 + Rnd * 20), Int(3 + Rnd * 12), Int(Rnd * 60), 1, 1, 0, _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256)), _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next reps
t4 = Timer
Print "That took "; t4 - t3; " seconds to draw 64000 polygons"
Sleep
rtn = 0
tempi& = _NewImage(400, 250, 32)
Dim tsh(640, 10) As _Unsigned Long
For x = 1 To 64
    tsh(x, 1) = Int(Rnd * 400)
    tsh(x, 2) = Int(Rnd * 250)
    tsh(x, 3) = Int(3 + Rnd * 8)
    tsh(x, 4) = Int(1 + Rnd * 3)
    tsh(x, 5) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
    tsh(x, 6) = _RGB32(Int(Rnd * 256), Int(Rnd * 256), Int(Rnd * 256))
Next x
Do
    _Limit 60
    _Dest 0
    Cls
    Print "Press <ESC> to continue"
    polyFT 100, 100, 40, 3, rtn, 1, 1, 2, _RGB32(100, 200, 50), _RGB32(50, 100, 50)
    polyFT 200, 100, 40, 4, 45 + rtn, 1, 1, 2, _RGB32(100, 200, 250), _RGB32(50, 100, 250)
    polyFT 300, 100, 40, 5, rtn, 1, 1, 2, _RGB32(200, 100, 250), _RGB32(100, 50, 250)
    polyFT 400, 100, 40, 6, rtn, 1, 1, 2, _RGB32(100, 250, 150), _RGB32(50, 120, 150)
    polyFT 500, 100, 40, 7, rtn, 1, 1, 2, _RGB32(150, 200, 200), _RGB32(70, 100, 200)
    polyFT 600, 100, 40, 8, 22.5 + rtn, 1, 1, 2, _RGB32(200, 200, 0), _RGB32(100, 100, 0)
    _PrintString (100 - (_PrintWidth("Triangle")) / 2, 160), "Triangle"
    _PrintString (200 - (_PrintWidth("Square")) / 2, 160), "Square"
    _PrintString (300 - (_PrintWidth("Pentagon")) / 2, 160), "Pentagon"
    _PrintString (400 - (_PrintWidth("Hexagon")) / 2, 160), "Hexagon"
    _PrintString (500 - (_PrintWidth("Heptagon")) / 2, 160), "Heptagon"
    _PrintString (600 - (_PrintWidth("Octagon")) / 2, 160), "Octagon"
    rtn = rtn + 1: If rtn > 360 Then rtn = 0
    _Dest tempi&
    Cls
    For r = 1 To 64
        polyFT tsh(r, 1), tsh(r, 2), tsh(r, 3) * 2, tsh(r, 3), rtn, 1, 1, tsh(r, 4), tsh(r, 5), tsh(r, 6)
        Select Case Int(Rnd * 100)
            Case 1: tsh(r, 1) = tsh(r, 1) + 2
            Case 2: tsh(r, 1) = tsh(r, 1) - 2
            Case 3: tsh(r, 2) = tsh(r, 2) + 2
            Case 4: tsh(r, 2) = tsh(r, 2) - 2
        End Select
    Next r
    _Dest 0
    _PutImage (200, 200)-(599, 449), tempi&, 0, (0, 0)-(399, 249)
    _Display
Loop Until InKey$ = Chr$(27)
Cls
ang = 0
Dim aa(0 To 5, 2)
aa(0, 1) = 110: aa(0, 2) = 400
aa(1, 1) = 50: aa(1, 2) = 390
aa(2, 1) = 100: aa(2, 2) = 300
aa(3, 1) = 100: aa(3, 2) = 260
aa(4, 1) = 70: aa(4, 2) = 220
aa(5, 1) = 30: aa(5, 2) = 240
Do
    _Limit 20
    Cls
    Print "Press <q> to continue"
    use_endcap "round"
    lineFT 50, 30, 600, 30, 6, _RGB32(200, 50, 0)
    lineFT 200, 200, 300, 300, 2, _RGB32(200, 50, 0)
    use_endcap "bullet"
    lineFT 50, 60, 600, 60, 4, _RGB32(200, 50, 0)
    lineFT 250, 200, 350, 300, 2, _RGB32(200, 50, 0)
    use_endcap "square"
    lineFT 50, 90, 600, 90, 4, _RGB32(200, 50, 0)
    lineFT 300, 200, 400, 300, 2, _RGB32(200, 50, 0)
    use_endcap "arrow1"
    lineFT 50, 120, 600, 120, 4, _RGB32(200, 50, 0)
    lineFT 350, 200, 450, 300, 4, _RGB32(200, 50, 0)
    use_endcap "arrow2"
    lineFT 50, 150, 600, 150, 4, _RGB32(200, 50, 0)
    lineFT 400, 200, 500, 300, 4, _RGB32(200, 50, 0)
    _PrintString (620, 24), "Round"
    _PrintString (620, 54), "Bullet"
    _PrintString (620, 84), "Square"
    _PrintString (620, 114), "Arrow1"
    _PrintString (620, 144), "Arrow2"
    'wigglign the line aa()
    For n = 0 To UBound(aa)
        Select Case Int(Rnd * 50)
            Case 1: aa(n, 1) = aa(n, 1) + 2
            Case 2: aa(n, 2) = aa(n, 2) + 2
            Case 3: aa(n, 2) = aa(n, 2) - 2
            Case 4: aa(n, 1) = aa(n, 1) - 2
        End Select
    Next n
    aplotline aa(), "bs", "a1e", 4, _RGB32(0, 200, 200)
    use_endcap "a2e"
    line_toangle 600, 400, 80, 6, ang, _RGB32(240, 240, 240)
    ang = ang + 1
    _Display
Loop Until InKey$ = "q"

'==========================================================================
'subroutines
'
'  polyFT    draw a filled polygon
'  lineFT - draw a thick line constructed from 2 mapped triangles
'  line_toangle - draw a line from x,y to a specific lenght along an anfle defiend in degrees
'  aplotline - draw a line defined in a two dimensinal array of x and y coordinates
'  dplotline - draw a line defined by a two diensional array of length and angle coordinates
'  closeplot -draw an close a set of lines defined by a two dimensional array of lenght and ngles
'
'  DegTo - return angle (in degrees) between two points , used as an internal function in lineFT
'  setklr    is an  sub to build the color image used byt triangles in  polyT
'====================================== ==================================
Sub polyFT (cx As Long, cy As Long, rad As Long, sides As Integer, rang As Long, ww, vv, thk, klr As _Unsigned Long, lineyes As _Unsigned Long)
    'draw an equilateral polygon using filled triangle for each segment
    'centered at cx,cy to radius rad of sides # of face rotated to angle rang scaled to ww and vv of color klr and lineyes if there is an outline, a value 0 would create no outline
    setklr klr
    dd& = _Dest
    Dim px(sides)
    Dim py(sides)
    pang = 360 / sides
    ang = 0
    For p = 1 To sides
        px(p) = cx + (rad * Cos(0.01745329 * (ang + rang))) * ww
        py(p) = cy + (rad * Sin(0.01745329 * (ang + rang))) * vv
        ang = ang + pang
    Next p
    For p = 1 To sides - 1
        _MapTriangle (0, 0)-(0, 2)-(2, 0), pk& To(cx, cy)-(px(p), py(p))-(px(p + 1), py(p + 1)), dd&
    Next p
    _MapTriangle (0, 0)-(0, 2)-(2, 0), pk& To(cx, cy)-(px(sides), py(sides))-(px(1), py(1)), dd&
    If lineyes > 0 And thk > 0 Then
        For p = 1 To sides - 1
            lineFT px(p), py(p), px(p + 1), py(p + 1), thk, lineyes
        Next p
        lineFT px(sides), py(sides), px(1), py(1), thk, lineyes
    End If

End Sub
Sub setklr (klr As Long)
    'internal routine to setup an image to copy a colored triangle from in the color klr
    'called by polyT
    od& = _Dest
    _Dest pk&
    Line (0, 0)-(2, 2), klr, BF
    _Dest od&
End Sub
Sub lineFT (x1, y1, x2, y2, thk, klr As _Unsigned Long)
    'draw a line of thickness thk on color klr from x1,y1 to x2,y2
    'orientation of line is set in the middle of line thickness
    od& = _Dest
    _Dest lk&
    Line (0, 0)-(2, 2), klr, BF 'set the color for the line
    _Dest od&
    cang = DegTo!(x1, y1, x2, y2) 'get the calcualted angle from x1,y1 to x2,y2
    ta = cang + 90 'the anngle from center of line to botton edge
    tb = ta + 180 'the angle from center of line to the top edge
    tax1 = x1 + (thk \ 2) * Cos(0.01745329 * ta)
    tay1 = y1 + (thk \ 2) * Sin(0.01745329 * ta)
    tax4 = x1 + (thk \ 2) * Cos(0.01745329 * tb)
    tay4 = y1 + (thk \ 2) * Sin(0.01745329 * tb)
    tax2 = x2 + (thk \ 2) * Cos(0.01745329 * ta)
    tay2 = y2 + (thk \ 2) * Sin(0.01745329 * ta)
    tax3 = x2 + (thk \ 2) * Cos(0.01745329 * tb)
    tay3 = y2 + (thk \ 2) * Sin(0.01745329 * tb)
    _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(tax1, tay1)-(tax2, tay2)-(tax4, tay4), od&
    _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(tax2, tay2)-(tax3, tay3)-(tax4, tay4), od&
    Select EveryCase line_endcap
        Case 1, 3 'round at start of segment
            fcirc x1, y1, (thk \ 2) - .5, klr
        Case 2, 3 'round at end of segment
            fcirc x2, y2, (thk \ 2) - .5, klr
        Case 4, 6 'bullet at start of segment
            fcirc x1, y1, thk + 1, klr
        Case 5, 6 'bullet at start of segment
            fcirc x2, y2, thk + 1, klr
        Case 7, 9 'square at start of segment
            sx1 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 45))
            sx2 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 135))
            sx3 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 225))
            sx4 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 315))
            sy1 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 45))
            sy2 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 135))
            sy3 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 225))
            sy4 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 315))
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx1, sy1)-(sx2, sy2)-(sx4, sy4), od&
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx2, sy2)-(sx3, sy3)-(sx4, sy4), od&
        Case 8, 9 'square at end of segment
            sx1 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 45))
            sx2 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 135))
            sx3 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 225))
            sx4 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 315))
            sy1 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 45))
            sy2 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 135))
            sy3 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 225))
            sy4 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 315))
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx1, sy1)-(sx2, sy2)-(sx4, sy4), od&
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(sx2, sy2)-(sx3, sy3)-(sx4, sy4), od&
        Case 10, 12 'draw arrow 1 at start of segment
            ax1 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 180))
            ax2 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 90))
            ax3 = x1 + (thk * 2) * Cos(0.01745329 * (cang + 270))
            ay1 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 180))
            ay2 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 90))
            ay3 = y1 + (thk * 2) * Sin(0.01745329 * (cang + 270))
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(ax3, ay3), od&

        Case 11, 12 'draw arrow1 at end of segment
            ax1 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 180))
            ax2 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 90))
            ax3 = x2 + (thk * 2) * Cos(0.01745329 * (cang + 270))
            ay1 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 180))
            ay2 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 90))
            ay3 = y2 + (thk * 2) * Sin(0.01745329 * (cang + 270))
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(ax3, ay3), od&

        Case 13, 15 'draw arrow2 at start of segment
            ax1 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 180))
            ax2 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 40))
            ax3 = x1 + (thk * 3) * Cos(0.01745329 * (cang + 320))
            ay1 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 180))
            ay2 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 40))
            ay3 = y1 + (thk * 3) * Sin(0.01745329 * (cang + 320))
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(x1, y1), od&
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax3, ay3)-(x1, y1), od&

        Case 14, 15 'draw arrow2 at end of segment
            ax1 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 180))
            ax2 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 40))
            ax3 = x2 - (thk * 3) * Cos(0.01745329 * (cang + 320))
            ay1 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 180))
            ay2 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 40))
            ay3 = y2 - (thk * 3) * Sin(0.01745329 * (cang + 320))
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax2, ay2)-(x2, y2), od&
            _MapTriangle (0, 0)-(0, 2)-(2, 0), lk& To(ax1, ay1)-(ax3, ay3)-(x2, y2), od&
    End Select
End Sub

Sub line_toangle (x1, y1, lnth, thk, ang, klr As _Unsigned Long)
    x2 = x1 + lnth * Cos(0.01745329 * ang)
    y2 = y1 + lnth * Sin(0.01745329 * ang)
    lineFT x1, y1, x2, y2, thk, klr
End Sub

Sub aplotline (aa(), scap$, ecap$, thk, klr As _Unsigned Long)
    'plots an 2-d array of pre calculated points
    lp = UBound(aa)
    ocap = line_endcap 'get the current general line_endcap
    For n = 0 To lp - 1
        Select Case n
            Case 0: use_endcap scap$
            Case lp - 1: use_endcap ecap$
            Case Else: use_endcap "round"
        End Select
        lineFT aa(n, 1), aa(n, 2), aa(n + 1, 1), aa(n + 1, 2), thk, klr
        line_endcap = ocap 'reset the current general line_endcap
    Next n
End Sub
Sub dplotline (aa(), thk, klr As _Unsigned Long)
    'plots a line from starting point x1,yy1 built fro an array of lnths and angles
    '    ]the line starts at x1,y1 as deffined in aa(0,1) and aa(0,2)
    lp = UBound(aa)
    lastline = line_endcap
    x1 = aa(0, 1)
    y1 = aa(0, 2)
    lasta = 0
    For n = 1 To lp
        x2 = x1 + aa(n, 1) * Cos(0.01745329 * (aa(n, 2) + lasta))
        y2 = y1 + aa(n, 1) * Sin(0.01745329 * (aa(n, 2) + lasta))
        lineFT x1, y1, x2, y2, thk, klr
        x1 = x2
        y1 = y2
        lasta = lasta + aa(n, 2)
    Next n
End Sub
Sub closeplot (aa(), thk, klr As _Unsigned Long)
    'plots a line from starting point x1,yy1 built fro an array of lnths and angles
    '    ]the line starts at x1,y1 as deffined in aa(0,1) and aa(0,2)
    lp = UBound(aa)
    line_endcap = 3
    x1 = aa(0, 1)
    y1 = aa(0, 2)
    lasta = 0
    For n = 1 To lp
        x2 = x1 + aa(n, 1) * Cos(0.01745329 * (aa(n, 2) + lasta))
        y2 = y1 + aa(n, 1) * Sin(0.01745329 * (aa(n, 2) + lasta))
        lineFT x1, y1, x2, y2, thk, klr
        x1 = x2
        y1 = y2
        lasta = lasta + aa(n, 2)
    Next n
    lineFT aa(0, 1), aa(0, 2), x2, y2, thk, klr
End Sub
Sub use_endcap (ec$)
    'tells the line routine which endcap type to use
    Select Case LCase$(ec$)
        Case "", "none": line_endcap = 0
        Case "round", "rnd", "r": line_endcap = 3
        Case "roundend", "rndend", "rnde", "re": line_endcap = 2
        Case "roundstart", "rndstart", "rnds", "rs": line_endcap = 1
        Case "bullet", "blt", "b": line_endcap = 6
        Case "bulletend", "bltend", "blte", "be": line_endcap = 5
        Case "bulletstart", "blystart", "blts", "bs": line_endcap = 4
        Case "square", "sqr", "s": line_endcap = 9
        Case "sqyareend", "squaree", "sqrend", "sqre", "se": line_endcap = 8
        Case "squarestart", "squarestart", "squares", "sqrs", "ss": line_endcap = 7
        Case "arrow1", "arw1", "a1": line_endcap = 12
        Case "arrow1end", "arrow1end", "arw1e", "a1e": line_endcap = 11
        Case "arrow1start", "arw1start", "arw1s", "a1s": line_endcap = 10
        Case "arrow2", "arw2", "a2": line_endcap = 15
        Case "arrow2end", "arrow2end", "arw2e", "a2e": line_endcap = 14
        Case "arrow2start", "arw2start", "arw2s", "a2s": line_endcap = 13
        Case Else
            line_endcap = 0
    End Select
End Sub

Sub fcirc (CX As Long, CY As Long, R, klr As _Unsigned Long)
    'draw a filled circle with the quickest filled circle routine in qb64, not my development
    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), klr: Exit Sub
    Line (CX - X, CY)-(CX + X, CY), klr, 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), klr, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), klr, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), klr, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), klr, BF
    Wend
End Sub
Function DegTo! (x1, y1, x2, y2)
    '========================
    ' returns an angle in degrees from point x1,y1 to point x2,y2
    aa! = _Atan2((y2 - y1), (x2 - x1)) / 0.01745329
    DegTo! = aa!
End Function

Print this item

  BAM Sample Programs
Posted by: CharlieJV - 09-12-2023, 05:01 AM - Forum: QBJS, BAM, and Other BASICs - Replies (35)

This is a directory of BAM programs that I've published to the web:

Print this item

  HW image version of this little stupid thing
Posted by: grymmjack - 09-12-2023, 01:32 AM - Forum: Help Me! - Replies (35)

Code: (Select All)

SCREEN _NEWIMAGE(320, 200, 256)
_FULLSCREEN _SQUAREPIXELS
COLOR ,1
CLS

m = 1
d = 0
lim = 120
st = 1
c = 1
x = 0
y = 10
w = 50
h = 50

FGC$ = "12" : BGC$="8"
T$ = "C"+FGC$+" R10 E5 R20 F5 R10 BL50"
M$ = "D20 BR50 BU20 D20 BL50"
B$ = "D10 E10 U10 R30 D10 F10 U10 BL50"
F$ = "BU20 BF5 P "+BGC$+","+FGC$

ALIEN$ = T$+M$+B$+F$

ALIEN_SPRITE_CLEAR& = _NEWIMAGE(w+1, h+1, 256)
ALIEN_SPRITE& = _NEWIMAGE(w+1, h+1, 256)
' ALIEN_HW_CLEAR& = _NEWIMAGE(w+1, h+1, 32)
' ALIEN_HW& = _NEWIMAGE(w+1, h+1, 32)
_DEST ALIEN_SPRITE&

' _PALETTECOLOR 0, _RGB32(0, 0, 0)
' _PALETTECOLOR 1, _RGB32(0, 0, 64)
' _PALETTECOLOR 12, _RGB32(255, 170, 170)
' _PALETTECOLOR 8, _RGB32(170, 0, 0)
_CLEARCOLOR 0
PSET (0,10)
DRAW ALIEN$

_DEST ALIEN_SPRITE_CLEAR&
COLOR ,1
CLS

' ALIEN_HW& = _COPYIMAGE(ALIEN_SPRITE&, 33)
' ALIEN_HW_CLEAR& = _COPYIMAGE(ALIEN_SPRITE_CLEAR&, 33)

' _FREEIMAGE ALIEN_SPRITE&
' _FREEIMAGE ALIEN_SPRITE_CLEAR&

_DEST 0
' _DISPLAYORDER _HARDWARE
DO
FOR x = 0 TO _WIDTH-w STEP st
IF lim > 0 THEN _LIMIT lim
_PUTIMAGE (x, y)-(x+w, y+h), ALIEN_SPRITE&, 0, (0,0)-(w,h)
_DISPLAY
_DELAY d
_PUTIMAGE (x, y)-(x+w, y+h), ALIEN_SPRITE_CLEAR&, 0, (0,0)-(w,h)
' DRAW ALIEN$
' LINE (x, y-y)-(x + w, y + h), c, BF
' _DELAY 1
NEXT x
FOR x = _WIDTH-w TO 0 STEP -st
IF lim > 0 THEN _LIMIT lim
_PUTIMAGE (x, y)-(x+w, y+h), ALIEN_SPRITE&, 0, (0,0)-(w,h)
_DISPLAY
_DELAY d
_PUTIMAGE (x, y)-(x+w, y+h), ALIEN_SPRITE_CLEAR&, 0, (0,0)-(w,h)
' DRAW ALIEN$
' LINE (x, y-y)-(x + w, y + h), c, BF
' _DELAY 1
NEXT x
LOOP UNTIL _KEYHIT

I am trying to get this to work with hardware images. I can't seem to get it.

Could someone give me a hand?

Thanks

Print this item

  Wheel of Fortune
Posted by: bplus - 09-12-2023, 01:10 AM - Forum: bplus - Replies (9)

I don't think I ever posted this. Played this with my family awhile back never got around to making refinements.

It took me a while to remember how to Solve when you think you've got the answer. Just click the word Solve and Enter your guess.

   



Attached Files
.zip   Wheel of Fortune pack.zip (Size: 123 KB / Downloads: 60)
Print this item

  Spining spiral wheel
Posted by: Dav - 09-11-2023, 04:34 PM - Forum: Programs - Replies (4)

Played around with some spiral pattern code using sin/cos to plot the points.  Gave it some spinning wheel movement using Timer.  Got it working in QBJS.  Press ENTER to make a new wheel.  Here it is.

- Dav

Print this item

  "Raw" (OBS) Websocket ws:// communication (_OpenClient, Get, Put), is it possible?
Posted by: loopy750 - 09-11-2023, 12:04 PM - Forum: Help Me! - Replies (6)

I looked into this some time back but came to the conclusion that it's not possible with QB64, however, I never asked the good people here, who are much more knowledgeable than I.

Here is the documentation with connection steps: https://github.com/obsproject/obs-websoc...tion-steps

I understand the process with HTTP and sending headers etc ("User-Agent: curl/8.1.2" for example), and doing a search, this post suggests it might be possible, but there's no code to investigate https://qb64phoenix.com/forum/showthread...0#pid12740

Print this item

  Mnrvovrfc lite mode
Posted by: grymmjack - 09-10-2023, 09:47 PM - Forum: Site Suggestions - Replies (7)

Hey @mnrvovrfc

I remembered you saying you needed a new PC but saw this feature and it might help you:
https://qb64phoenix.com/forum/archive/index.php

This removes almost all slow stuff. Give that a shot?

I did not even know this existed until the dark mode theme made the link more visible.

Print this item

  Why no...
Posted by: TarotRedhand - 09-10-2023, 08:55 PM - Forum: Site Suggestions - Replies (3)

Why isn't there a cancel button on the reply to a post? I screwed up and had to log-out and log back in just to abandon the attempt to reply to somebody's post. Thank you.

TR

Print this item

Heart Dark Mode theme now available!
Posted by: grymmjack - 09-10-2023, 07:30 PM - Forum: Announcements - Replies (14)

A Dark Mode theme is now available.

Select it at the bottom.

Like this:
[Image: dark-mode.png?rlkey=0x0ypj1l6b0r0g4covdni6hlz&raw=1]

I'm sure there will be issues, reply in this thread when you find them.

Thanks

Print this item