qb64.com/samples/torus-demo/
( this version was probably converted to brand new QB64 so I did not managed to run it as is )
Now it works in LB/LBB/(even JB if change API call with commented-out filled triangle sub by Andy Amaya)
It was rather complex conversion (long program), and I used Notepad++/LBB/JB/LB
I used LBB to spot erroneous lines and convert it one-by-one
- because it just selected next errorand stop there
(while JB made error message without particular line to fix)
I used JB to actually debug stuff (because I am used to it)
I used LB to put fast API call (polygon) instead of slow filling triangle by lines
Then I run it in LBB and found black rectangles all over the colored tiles
Happened to be (topic in LBB help section on Troubleshooting)
that LBB needs some wait statements to "reconcile" API-drawn graphics
(or so I got)
So I changed busy loop to Timer/Wait, now program works on both LB and LBB.
'from qb64.com/samples/torus-demo/
'conversion to JB by tsh73
'March 2024
'-----------------------------------------------------------------------------------------------------
' TORUS
' This program draws a Torus figure. The program accepts user input
' to specify various TORUS parameters. It checks the current system
' configuration and takes appropriate action to set the best possible
' initial mode.
'-----------------------------------------------------------------------------------------------------
global FALSE, TRUE
global C.RNDM, C.START, C.CONTINUE
global VGA', MCGA, EGA256, EGA64, MONO, HERC, CGA
global BACK$
BACK$ = "black"
'BACK$ = "darkblue"
'Sub TorusDefine
global TOR.Thick, TOR.Bord$, TOR.Panel, TOR.Sect, TOR.XDegree, TOR.YDegree, TOR.Delay
'Sub SetConfig
global VC.Colors, VC.Atribs, VC.XPix, VC.YPix, VC.TCOL, VC.TROW, VC.Scrn
global QuitRequested, Pi
'Sub TileDraw
Global T.x1,T.x2,T.x3,T.x4,T.y1,T.y2,T.y3,T.y4,T.z1,T.xc,T.yc,T.TColor
'Sub TorusCalc
'indices for columns in T(tile, column)
Global Ix1, Ix2, Ix3, Ix4, Iy1, Iy2, Iy3, Iy4, Iz1, Ixc, Iyc, ITColor
Dim T(10, 12) 'to be redimmed
Ix1=1:Ix2=2:Ix3=3:Ix4=4:Iy1=5:Iy2=6:Iy3=7:Iy4=8:Iz1=9:Ixc=10:Iyc=11:ITColor=12
'Sub TorusColor
global Max
'Sub TorusRotate , to preserve between calls
global FirstClr
Pi=acs(-1)
' General purpose constants
FALSE = 0: TRUE = Not( FALSE)
BACK = 0
TROW = 24: TCOL = 60
' Rotation flags
C.RNDM = -1: C.START = 0: C.CONTINUE = 1
' Constants for best Available screen mode
VGA = 12 'set on this
' MCGA = 13
' EGA256 = 9
' EGA64 = 8
' MONO = 10
' HERC = 3
' CGA = 1
' User-defined type for tiles - an array of these make a torus
' used array T(numTiles, 12) instead, with colNumbers Ix1, Ix2, ..., ITColor
' Type Tile
' x1 As Single
' x2 As Single
' x3 As Single
' x4 As Single
' y1 As Single
' y2 As Single
' y3 As Single
' y4 As Single
' z1 As Single
' xc As Single
' yc As Single
' TColor As Integer
' End Type
' User-defined type to hold information about the mode
' Type Config
' Scrn As Integer
' Colors As Integer
' Atribs As Integer
' XPix As Integer
' YPix As Integer
' TCOL As Integer
' TROW As Integer
' End Type
'''Dim VC As Config
'only single instance
'used global vars VC.Scrn etc instead
' User-defined type to hold information about current Torus
' Type TORUS
' Panel As Integer
' Sect As Integer
' Thick As Single
' XDegree As Integer
' YDegree As Integer
' Bord As String * 3
' Delay As Single
' End Type
''Dim TOR As TORUS, Max As Integer
'only single instance
'used global vars TORUS.Panel etc instead
' A palette of colors to paint with
Dim Pal(300) 'As Long
'added to use with JB
Dim Pal$(300)
Dim Colr$(300)
STRUCT PolyPoints,_
x1 as long,_
y1 as long,_
x2 as long,_
y2 as long,_
x3 as long,_
y3 as long,_
x4 as long,_
y4 as long
' The code of the module-level program begins here
' Initialize defaults
TOR.Thick = 3: TOR.Bord$ = "YES"
TOR.Panel = 8: TOR.Sect = 14
TOR.XDegree = 60: TOR.YDegree = 165
' Get best configuration and set initial graphics mode to it
'just set for VGA for now
VC.Scrn = VGA
Do While TRUE ' Loop forever (exit is from within a SUB)
' Get Torus definition from user
call TorusDefine
' Dynamically dimension arrays
Tmp = TOR.Panel
Max = TOR.Panel * TOR.Sect
' Array for indexes
ReDim Index(Max - 1)
' Array for tiles
ReDim T(Max - 1, 12) ''As Tile
' Initialize array of indexes
For Til = 0 To Max - 1
Index(Til) = Til
Next
' Calculate the points of each tile on the torus
call Message "Calculating"
call TorusCalc '' T(max, 12), and arrays are global in JB
' Sort the tiles by their "distance" from the screen
call Message "Sorting"
call TorusSort 0, Max - 1
'open corresponding gr window
' ajust for borders
desiredWidth = VC.XPix+1
desiredHeight = VC.YPix+1
gosub [ajustWindow]
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
open "Torus" for graphics_nsb_nf as #gr
#gr, "trapclose [quit]"
#gr, "down; fill ";BACK$
#gr, "flush"
' Mix a palette of colors
call SetPalette
' Color each tile in the torus.
call TorusColor
' Set logical window with variable thickness
' Center is 0, up and right are positive, down and left are negative
''Window (-(TOR.Thick + 1), -(TOR.Thick + 1))-(TOR.Thick + 1, TOR.Thick + 1)
global width, minX, maxX, height, minY, maxY
width=VC.XPix+1
minX=0-(TOR.Thick + 1)
maxX=TOR.Thick + 1
height=VC.YPix+1
minY=0-(TOR.Thick + 1)
maxY=TOR.Thick + 1
global hdc
h=hwnd(#gr) 'window handle
'get device context for window:
calldll #user32, "GetDC",_
h as ulong,_ 'window handle
hdc as ulong 'returns handle to device context
' Draw and paint the tiles, the farthest first and nearest last
call Message "Drawing"
call TorusDraw
' Rotate the torus by rotating the color palette
Do While 1''InKey$ = ""
SCAN
'call Delay TOR.Delay
'if QuitRequested then [quit]
timer TOR.Delay*1000, [waitABit]
wait
[waitABit]
timer 0
#gr, "discard"
call TorusRotate C.CONTINUE
call Message "Drawing"
call TorusDraw
Loop
Loop
[quit]
calldll #user32, "ReleaseDC",_
h as ulong,_ 'window handle
hdc as ulong,_ 'device context
ret as long
timer 0
close #gr
end
' ============================ CountTiles ==============================
' Displays number of the tiles currently being calculated or sorted.
' ======================================================================
'
Sub CountTiles T1, T2
Print "Tile "; Using (" ###", T1); Using (" ###", T2)
End Sub
' ============================ DegToRad ================================
' Convert degrees to radians, since BASIC trigonometric functions
' require radians.
' ======================================================================
'
Function DegToRad (Degrees)
DegToRad = (Degrees * 2 * Pi) / 360
End Function
' ============================= Message ================================
' Displays a status message followed by blinking dots.
' ======================================================================
'
Sub Message Text$
Print "-";
print time$();".";time$("ms") mod 1000;
print "-------------------------"
'Print "-22:17:30.421-------------------------"
Print Text$
Print "--------------------------------------"
End Sub
' ============================ SetConfig ===============================
' Sets the correct values for each field of the VC variable. They
' vary depending on Mode and on the current configuration.
' ======================================================================
'
Sub SetConfig mode 'use VGA for now
'Case 12 ' 16-color very high-res graphics for VGA
VC.Colors = 216
VC.Atribs = 16
VC.XPix = 639
VC.YPix = 479
'VC.XPix = 319
'VC.YPix = 239
VC.TCOL = 80
VC.TROW = 30
VC.Scrn = mode
End Sub
' ============================ SetPalette ==============================
' Mixes palette colors in an array.
' ======================================================================
'
Sub SetPalette
VC.Colors = TOR.Sect 'this makes each section to have same color
' VC.Colors = TOR.Sect*2
' VC.Colors = TOR.Sect*TOR.Panel '==Max == number of tiles
' VC.Colors = Max
' VC.Colors =256
for i = 0 to VC.Colors-1
Colr$(i)=rainbow$(i/VC.Colors)
next
' Assign colors
call TorusRotate C.RNDM
' print "--- SetPalette -----"
' print "VC.Colors",VC.Colors
' print "Index", Index
' for i = 0 to VC.Colors-1
' print i, Colr$(i)
' next
' print "--- //SetPalette ---"
End Sub
' ============================ TileDraw ================================
' Draw and optionally paint a tile. Tiles are painted if there are
' more than two atributes and if the inside of the tile can be found.
' ======================================================================
'
Sub TileDraw
'copyToGlobT is called before
'fill the tile - as 2 triangles
activeColr=(T.TColor+FirstClr) mod VC.Colors
'print "activeColr ",activeColr, Colr$(activeColr)
'LB way - API call
#gr "backcolor ";Colr$(activeColr)
nCount=4 'number of x,y pairs in STRUCT
PolyPoints.x1.struct = sx(T.x1)
PolyPoints.y1.struct = sy(T.y1)
PolyPoints.x2.struct = sx(T.x2)
PolyPoints.y2.struct = sy(T.y2)
PolyPoints.x3.struct = sx(T.x3)
PolyPoints.y3.struct = sy(T.y3)
PolyPoints.x4.struct = sx(T.x4)
PolyPoints.y4.struct = sy(T.y4)
calldll #gdi32, "Polygon",_
hdc as ulong,_ 'device context of window or control
PolyPoints as struct,_'array of points
nCount as long,_ 'number of x,y pairs in array
result as long
''''JB way
' #gr "color ";Colr$(activeColr)
' call fillTriangle "#gr",sx(T.x1),sy(T.y1),sx(T.x2),sy(T.y2),sx(T.x3),sy(T.y3)
''paint over possible diagonal line
' #gr "size 2"
' #gr "line ";sx(T.x1);" ";sy(T.y1);" ";sx(T.x3);" ";sy(T.y3)
' #gr "size 1"
' call fillTriangle "#gr",sx(T.x1),sy(T.y1),sx(T.x4),sy(T.y4),sx(T.x3),sy(T.y3)
' A border drawn with the background color looks like a border.
' One drawn with the tile color doesn't look like a border.
If TOR.Bord$ = "YES" Then
Border$ = BACK$
Else
Border$ = Colr$(activeColr)
End If
' Redraw with the final border
' Line (T.x1, T.y1)-(T.x2, T.y2), Border
' Line -(T.x3, T.y3), Border
' Line -(T.x4, T.y4), Border
' Line -(T.x1, T.y1), Border
#gr "color ";Border$
#gr "line ";sx(T.x1);" ";sy(T.y1);" ";sx(T.x2);" ";sy(T.y2)
#gr "goto ";sx(T.x3);" ";sy(T.y3)
#gr "goto ";sx(T.x4);" ";sy(T.y4)
#gr "goto ";sx(T.x1);" ";sy(T.y1)
End Sub
' =========================== TorusCalc ================================
' Calculates the x and y coordinates for each tile.
' ======================================================================
'
Sub TorusCalc ''(T() As Tile) Static 'now use T(tile, column)
' Calculate sine and cosine of the angles of rotation
XRot = DegToRad(TOR.XDegree)
YRot = DegToRad(TOR.YDegree)
CXRot = Cos(XRot)
SXRot = Sin(XRot)
CYRot = Cos(YRot)
SYRot = Sin(YRot)
' Calculate the angle to increment between one tile and the next.
XInc = 2 * Pi / TOR.Sect
YInc = 2 * Pi / TOR.Panel
' First calculate the first point, which will be used as a reference
' for future points. This point must be calculated separately because
' it is both the beginning and the end of the center seam.
FirstY = (TOR.Thick + 1) * CYRot
' Starting point is x1 of 0 section, 0 panel last 0
T(0,Ix1) = FirstY ' +------+------+
' Also x2 of tile on last section, 0 panel ' | | | last
T(TOR.Sect - 1,Ix2) = FirstY ' | x3|x4 |
' Also x3 of last section, last panel ' +------+------+
T(Max - 1,Ix3) = FirstY ' | x2|x1 | 0
' Also x4 of 0 section, last panel ' | | |
T(Max - TOR.Sect,Ix4) = FirstY ' +------+------+
' A similar pattern is used for assigning all points of Torus
' Starting Y point is 0 (center)
T(0,Iy1) = 0
T(TOR.Sect - 1,Iy2) = 0
T(Max - 1,Iy3) = 0
T(Max - TOR.Sect,Iy4) = 0
' Only one z coordinate is used in sort, so other three can be ignored
T(0,Iz1) = 0-(TOR.Thick + 1) * SYRot
' Starting at first point, work around the center seam of the Torus.
' Assign points for each section. The seam must be calculated separately
' because it is both beginning and of each section.
For XSect = 1 To TOR.Sect - 1
' X, Y, and Z elements of equation
sx = (TOR.Thick + 1) * Cos(XSect * XInc)
sy = (TOR.Thick + 1) * Sin(XSect * XInc) * CXRot
sz = (TOR.Thick + 1) * Sin(XSect * XInc) * SXRot
ssx = (sz * SYRot) + (sx * CYRot)
T(XSect,Ix1) = ssx
T(XSect - 1,Ix2) = ssx
T(Max - TOR.Sect + XSect - 1,Ix3) = ssx
T(Max - TOR.Sect + XSect,Ix4) = ssx
T(XSect,Iy1) = sy
T(XSect - 1,Iy2) = sy
T(Max - TOR.Sect + XSect - 1,Iy3) = sy
T(Max - TOR.Sect + XSect,Iy4) = sy
T(XSect,Iz1) = (sz * CYRot) - (sx * SYRot)
Next
' Now start at the first seam between panel and assign points for
' each section of each panel. The outer loop assigns the initial
' point for the panel. This point must be calculated separately
' since it is both the beginning and the end of the seam of panels.
For YPanel = 1 To TOR.Panel - 1
' X, Y, and Z elements of equation
sx = TOR.Thick + Cos(YPanel * YInc)
sy = 0-Sin(YPanel * YInc) * SXRot
sz = Sin(YPanel * YInc) * CXRot
ssx = (sz * SYRot) + (sx * CYRot)
' Assign X points for each panel
' Current ring, current side
T(TOR.Sect * YPanel,Ix1) = ssx
' Current ring minus 1, next side
T(TOR.Sect * (YPanel + 1) - 1,Ix2) = ssx
' Current ring minus 1, previous side
T(TOR.Sect * YPanel - 1,Ix3) = ssx
' Current ring, previous side
T(TOR.Sect * (YPanel - 1),Ix4) = ssx
' Assign Y points for each panel
T(TOR.Sect * YPanel,Iy1) = sy
T(TOR.Sect * (YPanel + 1) - 1,Iy2) = sy
T(TOR.Sect * YPanel - 1,Iy3) = sy
T(TOR.Sect * (YPanel - 1),Iy4) = sy
' Z point for each panel
T(TOR.Sect * YPanel,Iz1) = (sz * CYRot) - (sx * SYRot)
' The inner loop assigns points for each ring (except the first)
' on the current side.
For XSect = 1 To TOR.Sect - 1
' Display section and panel
call CountTiles XSect, YPanel
ty = (TOR.Thick + Cos(YPanel * YInc)) * Sin(XSect * XInc)
tz = Sin(YPanel * YInc)
sx = (TOR.Thick + Cos(YPanel * YInc)) * Cos(XSect * XInc)
sy = ty * CXRot - tz * SXRot
sz = ty * SXRot + tz * CXRot
ssx = (sz * SYRot) + (sx * CYRot)
T(TOR.Sect * YPanel + XSect,Ix1) = ssx
T(TOR.Sect * YPanel + XSect - 1,Ix2) = ssx
T(TOR.Sect * (YPanel - 1) + XSect - 1,Ix3) = ssx
T(TOR.Sect * (YPanel - 1) + XSect,Ix4) = ssx
T(TOR.Sect * YPanel + XSect,Iy1) = sy
T(TOR.Sect * YPanel + XSect - 1,Iy2) = sy
T(TOR.Sect * (YPanel - 1) + XSect - 1,Iy3) = sy
T(TOR.Sect * (YPanel - 1) + XSect,Iy4) = sy
T(TOR.Sect * YPanel + XSect,Iz1) = (sz * CYRot) - (sx * SYRot)
Next
Next
' Erase message
call CountTiles -1, -1
End Sub
' =========================== TorusColor ===============================
' Assigns color atributes to each tile.
' ======================================================================
'
Sub TorusColor
' Cycle through each attribute until all tiles are done
For Til = 0 To Max - 1
T(Til,ITColor) = Til mod VC.Colors
print "Colr",Til, T(Til,ITColor)
Next
End Sub
' ============================ TorusDefine =============================
' Define the attributes of a Torus based on information from the
' user, the video configuration, and the current screen mode.
' ======================================================================
'
Sub TorusDefine 'LB window to setup params
WindowWidth = 328
WindowHeight = 260
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
statictext #main.statictext1, "Thickness", 22, 16, 144, 20
textbox #main.txtThick, 190, 11, 100, 25
statictext #main.statictext3, "Panels per Section", 22, 41, 144, 20
textbox #main.txt.Panel, 190, 36, 100, 25
statictext #main.statictext5, "Sections per Torus", 22, 66, 144, 20
textbox #main.txt.Sect, 190, 61, 100, 25
statictext #main.statictext7, "Tilt around Horizontal Axis", 22, 91, 144, 20
textbox #main.txtXDegree, 190, 86, 100, 25
statictext #main.statictext9, "Tilt around Vertical Axis", 22, 116, 144, 20
textbox #main.txtYDegree, 190, 111, 100, 25
statictext #main.statictext11, "Tile Border", 22, 141, 144, 20
textbox #main.txtBord, 190, 136, 100, 25
statictext #main.statictext13, "Screen Mode", 22, 166, 144, 20
statictext #main.lblScrn, "12 (640x480)", 190, 166, 144, 20
button #main.button16, "Start", [btnStartClick], UL, 22, 191, 122, 25
button #main.button17, "Quit", [btnQuitClick], UL, 174, 191, 122, 25
open "Torus" for window_nf as #main
print #main, "trapclose [quit.main]"
print #main, "font ms_sans_serif 10"
#main.txtThick TOR.Thick
#main.txt.Panel TOR.Panel
#main.txt.Sect TOR.Sect
#main.txtXDegree TOR.XDegree
#main.txtYDegree TOR.YDegree
#main.txtBord TOR.Bord$
' #main.lblScrn VC.Scrn
#main.button16, "!setfocus"
wait
[quit.main]
Close #main
END
[btnStartClick]
'get data and return
errList$=chr$(13)
#main.txtThick "!contents? TOR.Thick" '1, 9
errList$=errList$+chkRange$("TOR.Thick", TOR.Thick, 1, 9)
#main.txt.Panel "!contents? TOR.Panel" '6, 20
errList$=errList$+chkRange$("TOR.Panel", TOR.Panel, 6, 20)
#main.txt.Sect "!contents? TOR.Sect" '6, 20
errList$=errList$+chkRange$("TOR.Sect", TOR.Sect, 6, 20)
#main.txtXDegree "!contents? TOR.XDegree" '0, 345, by 15deg
errList$=errList$+chkRange$("TOR.XDegree", TOR.XDegree, 0, 345)
#main.txtYDegree "!contents? TOR.YDegree" '0, 345, by 15deg
errList$=errList$+chkRange$("TOR.YDegree", TOR.YDegree, 0, 345)
#main.txtBord "!contents? TOR.Bord$" 'YES NO
if (TOR.Bord$<>"YES") and (TOR.Bord$<>"NO") then
errList$=errList$+"TOR.Bord$ value (";TOR.Bord$;") should be YES or NO"
end if
if trim$(errList$)<>"" then
notice "Errors found: ";errList$
wait
end if
Close #main
call SetConfig VC.Scrn
' Set different delays depending on mode
'Case Else
TOR.Delay = 1 '.05 'drawing torus take lots of time
' Get new random seed for this torus
' JB uses new random each run
exit sub
wait
[btnQuitClick] 'Perform action for the button named 'button17'
goto [quit.main]
end sub
' =========================== TorusDraw ================================
' Draws each tile of the torus starting with the farthest and working
' to the closest. Thus nearer tiles overwrite farther tiles to give
' a three-dimensional effect. Notice that the index of the tile being
' drawn is actually the index of an array of indexes. This is because
' the array of tiles is not sorted, but the parallel array of indexes
' is. See TorusSort for an explanation of how indexes are sorted.
' ======================================================================
'
Sub TorusDraw
For Til = 0 To Max - 1
call copyToGlobT Til 'T(Index(Til)) - >T.*
'print "Tile ",Til,
call TileDraw ''T(Index(Til))
Next
End Sub
' =========================== TorusRotate ==============================
' Rotates the Torus. This can be done more successfully in some modes
' than in others. There are three methods:
'
' 1. Rotate the palette colors assigned to each attribute
' 2. Draw, erase, and redraw the torus (two-color modes)
' 3. Rotate between two palettes (CGA and MCGA screen 1)
'
' Note that for EGA and VGA screen 2, methods 1 and 2 are both used.
' ======================================================================
'
Sub TorusRotate First
' Argument determines whether to start at next color, first color,
' or random color
Select Case First
Case C.RNDM
FirstClr = Int(Rnd(0) * VC.Colors)
Case C.START
FirstClr = 0
Case Else
FirstClr = (FirstClr+1) mod VC.Colors
End Select
End Sub
' ============================ TorusSort ===============================
' Sorts the tiles of the Torus according to their Z axis (distance
' from the "front" of the screen). When the tiles are drawn, the
' farthest will be drawn first, and nearer tiles will overwrite them
' to give a three-dimensional effect.
'
' To make sorting as fast as possible, the Quick Sort algorithm is
' used. Also, the array of tiles is not actually sorted. Instead a
' parallel array of tile indexes is sorted. This complicates things,
' but makes the sort much faster, since two-byte integers are swapped
' instead of 46-byte Tile variables.
' ======================================================================
'
Sub TorusSort Low, High
'basically, qsort of indices T(Index(i),Iz1)
If Low < High Then
' If only one, compare and swap if necessary
' The SUB procedure only stops recursing when it reaches this point
If High - Low = 1 Then
If T(Index(Low),Iz1) > T(Index(High),Iz1) Then
call CountTiles High, Low
call swapIndex Low,High
End If
Else
' If more than one, separate into two random groups
RandIndex = Int(Rnd * (High - Low + 1)) + Low
call CountTiles High, Low
call swapIndex High, RandIndex
Partition = T(Index(High),Iz1)
' Sort one group
Do
i = Low: j = High
' Find the largest
Do While (i < j) And (T(Index(i),Iz1) <= Partition)
i = i + 1
Loop
' Find the smallest
Do While (j > i) And (T(Index(j),Iz1) >= Partition)
j = j - 1
Loop
' Swap them if necessary
If i < j Then
call CountTiles High, Low
call swapIndex i, j
End If
Loop While i < j
' Now get the other group and recursively sort it
call CountTiles High, Low
call swapIndex i, High
If (i - Low) < (High - i) Then
call TorusSort Low, i - 1
call TorusSort i + 1, High
Else
call TorusSort i + 1, High
call TorusSort Low, i - 1
End If
End If
End If
End Sub
'- aux funcs by tsh73, for TileDraw ------------------------------
'should be global
'Global T.x1,T.x2,T.x3,T.x4,T.y1,T.y2,T.y3,T.y4,T.z1,T.xc,T.yc,T.TColor
sub copyToGlobT Til
T.x1=T(Index(Til), Ix1)
T.x2=T(Index(Til), Ix2)
T.x3=T(Index(Til), Ix3)
T.x4=T(Index(Til), Ix4)
T.y1=T(Index(Til), Iy1)
T.y2=T(Index(Til), Iy2)
T.y3=T(Index(Til), Iy3)
T.y4=T(Index(Til), Iy4)
T.z1=T(Index(Til), Iz1)
T.xc=T(Index(Til), Ixc)
T.yc=T(Index(Til), Iyc)
T.TColor=T(Index(Til), ITColor)
end sub
'- aux func by Tsh73, for new Sub TorusDefine -------------------
function chkRange$(varName$, varVal, mn, mx)
if (varVal < mn) or (varVal > mx) then
chkRange$=varName$;" value (";varVal;") is out of range [";mn;", ";mx;"]"+chr$(13)
end if
end function
sub Delay sec 'now after pause you can check if QuitRequested
t=time$("ms")
while time$("ms")<t+sec*1000
scan
wend
exit sub
[quit]
QuitRequested=1
end sub
sub swapIndex idx1, idx2
tmp=Index(idx1):Index(idx1)=Index(idx2):Index(idx2)=tmp
end sub
'conversions (logical coords to screen)
function sx(x)
'screen X. Depends on width, minX, maxX
sx = int((x- minX)/(maxX-minX) * width)
end function
function sy(y)
'screen Y. Depends on height, minY, maxY. Upside down.
sy = int((1-(y- minY)/(maxY-minY)) * height)
end function
'- Fast Filled Triangle sub by Andy Amaya ------------
Sub fillTriangle h$,x1, y1, x2, y2, x3, y3
'triangle coordinates must be ordered: where x1 < x2 < x3
If x2 < x1 Then x = x2 : y = y2 : x2 = x1 : y2 = y1 : x1 = x : y1 = y
'swap x1, y1, with x3, y3
If x3 < x1 Then x = x3 : y = y3 : x3 = x1 : y3 = y1 : x1 = x : y1 = y
'swap x2, y2 with x3, y3
If x3 < x2 Then x = x3 : y = y3 : x3 = x2 : y3 = y2 : x2 = x : y2 = y
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
'if X is not integer, using INT on then will improve timing
#h$ "Line ";int(x+x1);" ";int(x*slope1+y1);" ";int(x+x1);" ";int(x*slope2+y1)
'#h$ "Line ";x+x1;" ";int(x*slope1+y1);" ";x+x1;" ";int(x*slope2+y1)
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
#h$ "Line ";int(x+x2);" ";int(x*slope1+y);" ";int(x+x2);" ";int(x*slope3+y2)
'#h$ "Line ";x+x2;" ";int(x*slope1+y);" ";x+x2;" ";int(x*slope3+y2)
Next
End If
End Sub
'---------------------------------------------
' 0..1 into red-green-blue-red continuous colors
function rainbow$(x)
hi = int((x*6) mod 6)+ 5*(x<0) 'fixed to 0..5
f = (x*6) mod 1 + (x<0) 'frac, 0..1
q = (1-f)
select case hi
case 0
r = 1: g = f: b = 0
case 1
r = q: g = 1: b = 0
case 2
r = 0: g = 1: b = f
case 3
r = 0: g = q: b = 1
case 4
r = f: g = 0: b = 1
case 5
r = 1: g = 0: b = q
end select
R = int(r*255)
G = int(g*255)
B = int(b*255)
rainbow$= R;" ";G;" ";B
end function
[ajustWindow]
UpperLeftX = 20
UpperLeftY = 20
WindowWidth = 200 '100 seems to be too much - works different
WindowHeight = 100
open "Ajusting..." for graphics_nsb_nf as #gr
' graphics
' graphics_nsb
' graphics_nsb_nf
#gr, "home ; down ; posxy x y"
'x, y give us width, height
width = 2*x : height = 2*y
close #gr
slackX = 200-width
slackY = 100-height
WindowWidth = desiredWidth + slackX
WindowHeight = desiredHeight + slackY
return