Post by tsh73 on Mar 18, 2024 16:53:39 GMT -5
from old Microsoft demo
Here it is at QB64 site
qb64.com/samples/torus-demo/
( this version was probably converted to brand new QB64 so I did not managed to run it as is )
I maked it work in JB
but filling polygons with lines is somewhat slow
So Windows API to the resque (polygon stuff from
alycesrestaurant.com/lbpe/APIPolygon.html
)
Now to works FAST
(there is Delay for 1 second, you can remove it)
Here it is at QB64 site
qb64.com/samples/torus-demo/
( this version was probably converted to brand new QB64 so I did not managed to run it as is )
I maked it work in JB
but filling polygons with lines is somewhat slow
So Windows API to the resque (polygon stuff from
alycesrestaurant.com/lbpe/APIPolygon.html
)
Now to works FAST
(there is Delay for 1 second, you can remove it)
'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
