To start with, a few thoughts on details covered:
- Constants used to define stuff for: fbGFX, colors, screen definitions.
- Keyword Erase (seldom seen in code), erases a array (frees used memory).
- Separation of initializer-code, from run-code (aka: MAIN-LOOP).
- Separation of seldom used code-part from MAIN ('extender' Sub askUser()).
- Separation of Function Calc_V2D(...) As V2D (heavily used, by initializer-code).
- Consequent release of used resources, as soon as finished, using them.
Obvious advantage is: nothing to remember 'to free', at code end.
compact, fast running code in main-loop, with: good readability (lots of comments).
EDIT: a few code changes made, see: here! 2018-09-10
For more detail, refer to comments in the code itself:
Code: Select all
' Vectors&Lines.bas -- 2018-09-10, MrSwiss
'
' compile: -s gui
'
Type V2D ' a simple 2 dimension vector
As Single x, y ' x-axis pos. | y-axis pos.
End Type ' acessible from everywhere
Type anyLine ' a simple line type (24 bytes), both compilers 32/64
Private: ' NO direct type's/variable's access
As V2D v1, v2 ' start/end vector's (define the line)
As ULong c1, res ' color | res is for 8 byte alignment (FBC x64)
Public: ' minimal interface (no fancy OOP, here)
Declare Sub init(ByVal As Single, ByVal As Single, ByVal As Single, ByVal As Single, ByVal As ULong)
Declare Sub show(ByVal As Boolean=TRUE) ' to enable skipping of a instance, e.g. in a loop
End Type
Sub anyLine.init( _ ' pre-set the line's pos. & color
ByVal v1x As Single, _ ' vector 1 - x
ByVal v1y As Single, _ ' vector 1 - y
ByVal v2x As Single, _ ' vector 2 - x
ByVal v2y As Single, _ ' vector 2 - y
ByVal clr As ULong _ ' color (32 bit's)
)
With This
.v1.x = v1x : .v1.y = v1y ' assign values
.v2.x = v2x : .v2.y = v2y
.c1 = clr ' don't touch res (its reserved!)
End With
End Sub
Sub anyLine.show( _ ' line to screen
ByVal vis As Boolean = TRUE _ ' OPTIONAL: skip if FALSE (default TRUE)
)
If Not vis Then Exit Sub ' FALSE --> get out
With This
Line (.v1.x, .v1.y)-(.v2.x, .v2.y), c1 ' line to screen
End With
End Sub
' end type
' general constants for fbGFX
Const As Double pi = 4 * Atn(1), d2r = pi / 180.0, r2d = 180.0 / pi
' define some colors (32 bit's)
Const As ULong red = &hFFFF0000, blue = &hFF0000FF, green = &hFF00FF00, _
white = &hFFFFFFFF, black = &hFF000000
' define screen (keep 4 : 3 ratio) tested from: 641x481 to: 1281x961 (e.g. 801x601)
Const As UShort scr_w = 1025, scr_h = 769, scr_cx = scr_w \ 2, _ ' only change w/h definitions!
scr_cy = scr_h \ 2, scr_cd = 32, scr_pg = 2, scr_flg = 0
Const As Single DPI = .75 ' high DPI = 150%, change to 1, otherwise!
' declare external "helper" Function (external to type anyLine), uses only V2D
Declare Function Calc_V2D(ByVal As Single, ByVal As Single, ByVal As Single, ByVal As Single) As V2D
' ===== MAIN =====
ScreenRes(scr_w, scr_h, scr_cd, scr_pg, scr_flg) ' using (above) constants for screen definition
ScreenSet(1, 0) ' use double buffering
Color(black, white) : Cls ' pre-set default colors | set them
Dim As anyLine aLine(0 To 360), _ ' 1° step, anyLine (defined below), red, 360°
bLine(0 To 90), _ ' 3° step, anyLine (defined below), blue, 90°
cLine(0 To 90) ' 1° step, anyLine (defined below), green, 90°
ReDim As V2D vs(0 To 360), _ ' 1° step, start vector (helper), 360°
ve(0 To 360), _ ' 1° step, end vector (helper), 360°
ve1(0 To 90) ' 1° step, end vector (helper), 90°
Dim As ULong cnt = 0, _ ' counter (used as array index)
off = (scr_cy \ 16) * DPI, _ ' radius offset (with high DPI correction)
radius = scr_cy * DPI * .55 ' radius (based on scr_h \ 2, with high DPI correction)
Dim As Boolean qflg = FALSE ' quit flag (for main-loop)
' initialize anyLine() array's ... (using "helper" array's)
For ang As UInteger = LBound(aLine) To UBound(aLine) ' full circle 1° step
vs(ang) = Calc_V2D(scr_cx, scr_cy, ang * 1.03, ang) ' in-/outside of circle (below)
ve(ang) = Calc_V2D(scr_cx, scr_cy, radius, ang) ' strictly "on circle" (below)
aLine(ang).init(vs(ang).x, vs(ang).y, ve(ang).x, ve(ang).y, red) ' initialize line's array
Next
For a2 As UInteger = LBound(bLine) To UBound(bLine) ' cLine() has the same size!
ve1(a2) = Calc_V2D(scr_cx, scr_cy, radius + off, a2) ' initialize 3rd helper array
bLine(a2).init(30, scr_h - 30, vs(a2 * 3).x, vs(a2 * 3).y, blue) ' 3° step (a2 * 3)
cLine(a2).init(scr_w - 30, scr_h - 30, ve1(a2).x, ve1(a2).y, green) ' 1° step
Next
Erase vs, ve, ve1 ' the helper's are no longer needed, destroy them
Circle(scr_cx, scr_cy), radius ' frame the line's (in-/outside), default = black
' a little main-loop extension Sub
Declare Sub askUser(ByRef As ULong, ByRef As Boolean, ByVal As ULong)
' main-loop start
Do
If cnt < 91 Then ' assure: to NOT "blow", the small array's
bLine(cnt).show ' fast and rough 90° * 3 (result: 270°)
cLine(cnt).show ' fast and fine 90° * 1
End If
aLine(cnt).show : Flip ' show 1 line per run (360°) | copy screen page
Sleep(10, 1) : cnt += 1 ' slow it slightly down | incr. counter (index)
If cnt = 360 Then ' finished with graphics, ask user: repeat/quit
askUser(cnt, qflg, radius) ' a simple extension of the loop (could be inlined too)
End If
Loop Until qflg
' ===== End-MAIN =====
' implement loop-extension
Sub askUser( _ ' external user Q & A & the required actions!
ByRef c As ULong, _ ' counter (may be modified = reset)
ByRef q As Boolean, _ ' quit flag (may be modified = set)
ByVal r As ULong _ ' radius (for circle, copy only)
)
Var m = "Re-run program loop? [y/N]" ' user message (Var = String)
While Len(InKey()) > 0 : Wend ' assure: keyboard buffer = empty
Draw String (30, 30), m ' position | message (default: exit, aka "N")
Flip : Sleep ' show it | wait | get user answer
If LCase(InKey()) = "y" Then ' only if "y"/"Y" pressed
Cls : c = 0 ' prep. for re-run | clear screen | reset c
Circle(scr_cx, scr_cy), r ' re-draw circle then, back to: main-loop
Else ' anything NOT "y"/"Y", prep. exit
q = TRUE ' set quit flag (to exit main-loop)
End If
End Sub
' implement "helper"
Function Calc_V2D(_ ' angle/distance based calc. of a vector
ByVal vsx As Single, _ ' vector (start x pos.)
ByVal vsy As Single, _ ' vector (start y pos.)
ByVal radi As Single, _ ' radius (= distance)
ByVal angl As Single _ ' angle (in degrees, conv. to radian internal)
) As V2D ' calculated vector (start or end)
Dim As V2D ret ' define return type
Var rad = angl * d2r ' once, instead of twice (speed/readability)
ret.x = vsx + Cos(rad) * radi ' init. x pos. (of vector)
ret.y = vsy + Sin(rad) * radi ' init. y pos. (of vector)
Return ret ' return the calculated type
End Function
'-----EOF -----