Posts: 347
Threads: 45
Joined: Jun 2024
Reputation:
32
Steve asked for a dice function...and this is the best I can do as this level of math is beyond me.
4 sided is colours only as to me that is a weird die.
6 is normal die
>6 (Only even numbers)
So if anyone can fix
The rolling - All Dice
The dots on the cube (Noirmal dice)
The polys not touching on the 20 sided dice and also being mis sized...
Add Numbers (characters) to the >6 sided options
Resolve the visible face as the result...
Add, mod, change as you need (@Maghda _MAPTRI?) and then we have a tool for any board game you can think.
John
Code: (Select All)
' --- Dice for Steve - DEV ---
_TITLE "Dice: D4, D6, D20 Integrated"
SCREEN _NEWIMAGE(800, 600, 32)
' HW Layer 1 (Dice), SW Layer 2 (Text)
_DISPLAYORDER _GLRENDER , _SOFTWARE
RANDOMIZE TIMER ' Seed for 2025
TYPE Vector: X AS SINGLE: Y AS SINGLE: Z AS SINGLE: END TYPE
TYPE DiceObject
Faces AS INTEGER
CurX AS SINGLE: CurY AS SINGLE
TargetX AS SINGLE: TargetY AS SINGLE
Spinning AS INTEGER: Result AS INTEGER
PosX AS SINGLE
TexID AS LONG: Ready AS _BYTE ' Context Guard
END TYPE
DIM SHARED D(1 TO 3) AS DiceObject: CONST RAD2DEG = 180 / _PI
' 1. INITIALIZE DICE STACK
D(1).Faces = 4: D(1).PosX = -2.5
D(2).Faces = 6: D(2).PosX = 0.0
D(3).Faces = 20: D(3).PosX = 2.5
FOR i = 1 TO 3: RollDice D(i): NEXT
' LAYER 1: LOGIC
DO
_LIMIT 60
IF _KEYDOWN(32) THEN FOR i = 1 TO 3: RollDice D(i): NEXT
FOR i = 1 TO 3: UpdateDice D(i): NEXT
LOOP
' LAYER 2: HARDWARE & UI
SUB _GL
' Context Guard: GPU Initialization
IF D(2).Ready = 0 THEN
' Create 3x2 Sprite Sheet for D6
Temp& = _NEWIMAGE(512, 512, 32): _DEST Temp&
FOR i = 1 TO 6
tx = ((i - 1) MOD 3) * 170: ty = ((i - 1) \ 3) * 256
LINE (tx + 5, ty + 5)-(tx + 165, ty + 251), _RGB32(255, 255, 255), BF
COLOR _RGB32(0, 0, 0): _PRINTSTRING (tx + 75, ty + 120), STR$(i)
NEXT
D(2).TexID = GL_MAKE_TEXTURE(Temp&)
_DEST 0: _FREEIMAGE Temp&
D(2).Ready = -1
END IF
_GLCLEARCOLOR 0.05, 0.05, 0.1, 1: _GLCLEAR _GL_COLOR_BUFFER_BIT OR _GL_DEPTH_BUFFER_BIT
_GLENABLE _GL_DEPTH_TEST: _GLDISABLE _GL_CULL_FACE
_GLMATRIXMODE _GL_PROJECTION: _GLLOADIDENTITY: _GLUPERSPECTIVE 45, _WIDTH / _HEIGHT, 0.1, 20
_GLMATRIXMODE _GL_MODELVIEW
FOR i = 1 TO 3
_GLLOADIDENTITY: _GLTRANSLATEF D(i).PosX, 0, -8
_GLROTATEF D(i).CurX, 1, 0, 0: _GLROTATEF D(i).CurY, 0, 1, 0
SELECT CASE D(i).Faces
CASE 4: DrawD4 D(i).Result
CASE 6: DrawD6 D(i).TexID
CASE ELSE: DrawFibonacci D(i).Faces, D(i).Result
END SELECT
NEXT
' Software Text Overlay
COLOR _RGB32(255, 255, 255), _RGBA32(0, 0, 0, 0)
_PRINTSTRING (20, 20), "D4: COLORS | D6: ALL FACES (1-6) | D20: FIBONACCI"
_PRINTSTRING (20, 40), "SPACE TO ROLL ALL"
_DISPLAY
END SUB
' --- GEOMETRY SUBS ---
SUB DrawD4 (targetIdx)
' Symmetrical Tetrahedron coordinates (Origin Centered)
C! = 0.85
V1x! = 0: V1y! = 0: V1z! = C!
V2x! = C! * -0.9428: V2y! = 0: V2z! = C! * -0.3333
V3x! = C! * 0.4714: V3y! = C! * 0.8165: V3z! = C! * -0.3333
V4x! = C! * 0.4714: V4y! = C! * -0.8165: V4z! = C! * -0.3333
_GLBEGIN _GL_TRIANGLES
FOR i = 1 TO 4
SELECT CASE i
CASE 1: _GLCOLOR3F 1, 0, 0: _GLNORMAL3F 0, 0, 1: _GLVERTEX3F V3x!, V3y!, V3z!: _GLVERTEX3F V2x!, V2y!, V2z!: _GLVERTEX3F V1x!, V1y!, V1z!
CASE 2: _GLCOLOR3F 0, 1, 0: _GLNORMAL3F -0.82, 0, -0.58: _GLVERTEX3F V1x!, V1y!, V1z!: _GLVERTEX3F V2x!, V2y!, V2z!: _GLVERTEX3F V4x!, V4y!, V4z!
CASE 3: _GLCOLOR3F 0, 0.3, 1: _GLNORMAL3F 0.41, 0.71, -0.58: _GLVERTEX3F V1x!, V1y!, V1z!: _GLVERTEX3F V4x!, V4y!, V4z!: _GLVERTEX3F V3x!, V3y!, V3z!
CASE 4: _GLCOLOR3F 0.1, 0.1, 0.1: _GLNORMAL3F 0.41, -0.71, -0.58: _GLVERTEX3F V2x!, V2y!, V2z!: _GLVERTEX3F V3x!, V3y!, V3z!: _GLVERTEX3F V4x!, V4y!, V4z!
END SELECT
NEXT
_GLEND
END SUB
SUB DrawD6 (tex&)
_GLENABLE _GL_TEXTURE_2D: _GLBINDTEXTURE _GL_TEXTURE_2D, tex&
_GLCOLOR3F 1, 1, 1
_GLBEGIN _GL_QUADS
FOR i = 1 TO 6
' Correct 3x2 UV Calculation
u1! = ((i - 1) MOD 3) / 3: u2! = u1! + (1 / 3)
v1! = ((i - 1) \ 3) / 2: v2! = v1! + (1 / 2)
SELECT CASE i
CASE 1: _GLNORMAL3F 0, 0, 1: _GLTEXCOORD2F u1!, v1!: _GLVERTEX3F -0.6, -0.6, 0.6: _GLTEXCOORD2F u2!, v1!: _GLVERTEX3F 0.6, -0.6, 0.6: _GLTEXCOORD2F u2!, v2!: _GLVERTEX3F 0.6, 0.6, 0.6: _GLTEXCOORD2F u1!, v2!: _GLVERTEX3F -0.6, 0.6, 0.6
CASE 2: _GLNORMAL3F 0, 0, -1: _GLTEXCOORD2F u1!, v1!: _GLVERTEX3F -0.6, -0.6, -0.6: _GLTEXCOORD2F u1!, v2!: _GLVERTEX3F -0.6, 0.6, -0.6: _GLTEXCOORD2F u2!, v2!: _GLVERTEX3F 0.6, 0.6, -0.6: _GLTEXCOORD2F u2!, v1!: _GLVERTEX3F 0.6, -0.6, -0.6
CASE 3: _GLNORMAL3F 0, 1, 0: _GLTEXCOORD2F u1!, v1!: _GLVERTEX3F -0.6, 0.6, -0.6: _GLTEXCOORD2F u1!, v2!: _GLVERTEX3F -0.6, 0.6, 0.6: _GLTEXCOORD2F u2!, v2!: _GLVERTEX3F 0.6, 0.6, 0.6: _GLTEXCOORD2F u2!, v1!: _GLVERTEX3F 0.6, 0.6, -0.6
CASE 4: _GLNORMAL3F 0, -1, 0: _GLTEXCOORD2F u1!, v1!: _GLVERTEX3F -0.6, -0.6, -0.6: _GLTEXCOORD2F u2!, v1!: _GLVERTEX3F 0.6, -0.6, -0.6: _GLTEXCOORD2F u2!, v2!: _GLVERTEX3F 0.6, -0.6, 0.6: _GLTEXCOORD2F u1!, v2!: _GLVERTEX3F -0.6, -0.6, 0.6
CASE 5: _GLNORMAL3F 1, 0, 0: _GLTEXCOORD2F u1!, v1!: _GLVERTEX3F 0.6, -0.6, -0.6: _GLTEXCOORD2F u1!, v2!: _GLVERTEX3F 0.6, 0.6, -0.6: _GLTEXCOORD2F u2!, v2!: _GLVERTEX3F 0.6, 0.6, 0.6: _GLTEXCOORD2F u2!, v1!: _GLVERTEX3F 0.6, -0.6, 0.6
CASE 6: _GLNORMAL3F -1, 0, 0: _GLTEXCOORD2F u1!, v1!: _GLVERTEX3F -0.6, -0.6, -0.6: _GLTEXCOORD2F u2!, v1!: _GLVERTEX3F -0.6, -0.6, 0.6: _GLTEXCOORD2F u2!, v2!: _GLVERTEX3F -0.6, 0.6, 0.6: _GLTEXCOORD2F u1!, v2!: _GLVERTEX3F -0.6, 0.6, -0.6
END SELECT
NEXT
_GLEND: _GLDISABLE _GL_TEXTURE_2D
END SUB
SUB DrawFibonacci (n, targetIdx)
phi# = (1 + SQR(5)) / 2
FOR i = 1 TO n
IF i = targetIdx THEN _GLCOLOR3F 1, 0.1, 0.1 ELSE _GLCOLOR3F 0.6, 0.6, 0.7
y# = 1 - ((i - 0.5) / n) * 2: r# = SQR(1 - y# * y#): th# = 2 * _PI * i / (phi# * phi#)
nx# = COS(th#) * r#: ny# = y#: nz# = SIN(th#) * r#
_GLBEGIN _GL_TRIANGLE_FAN
_GLNORMAL3F nx#, ny#, nz#: _GLVERTEX3F nx#, ny#, nz#
FOR a# = 0 TO 2 * _PI STEP _PI / 3
ux# = -ny#: uy# = nx#: uz# = 0: IF ABS(nx#) < 0.1 THEN ux# = 0: uy# = -nz#: uz# = ny#
vx# = ny# * uz# - nz# * uy#: vy# = nz# * ux# - nx# * uz#: vz# = nx# * uy# - ny# * ux#
_GLVERTEX3F nx# + (COS(a#) * ux# + SIN(a#) * vx#) * 0.3, ny# + (COS(a#) * uy# + SIN(a#) * vy#) * 0.3, nz# + (COS(a#) * uz# + SIN(a#) * vz#) * 0.3
NEXT
_GLEND
NEXT
END SUB
' --- LOGIC & MATH ---
SUB UpdateDice (o AS DiceObject)
IF o.Spinning > 0 THEN
o.CurX = o.CurX + (RND * 30 - 15): o.CurY = o.CurY + (RND * 30 - 15): o.Spinning = o.Spinning - 1
ELSE
o.CurX = o.CurX + (o.TargetX - o.CurX) * 0.1: o.CurY = o.CurY + (o.TargetY - o.CurY) * 0.1
END IF
END SUB
SUB RollDice (o AS DiceObject)
o.Result = INT(RND * o.Faces) + 1: o.Spinning = 40 + INT(RND * 50)
DIM nx!, ny!, nz!
SELECT CASE o.Faces
CASE 4:
SELECT CASE o.Result
CASE 1: nx! = 0: ny! = 0: nz! = 1
CASE 2: nx! = -0.82: ny! = 0: nz! = -0.58
CASE 3: nx! = 0.41: ny! = 0.71: nz! = -0.58
CASE 4: nx! = 0.41: ny! = -0.71: nz! = -0.58
END SELECT
CASE 6:
SELECT CASE o.Result
CASE 1: nx! = 0: ny! = 0: nz! = 1
CASE 2: nx! = 0: ny! = 0: nz! = -1
CASE 3: nx! = 0: ny! = 1: nz! = 0
CASE 4: nx! = 0: ny! = -1: nz! = 0
CASE 5: nx! = 1: ny! = 0: nz! = 0
CASE 6: nx! = -1: ny! = 0: nz! = 0
END SELECT
CASE ELSE:
phi# = (1 + SQR(5)) / 2: i = o.Result
y# = 1 - ((i - 0.5) / o.Faces) * 2: r# = SQR(1 - y# * y#): th# = 2 * _PI * i / (phi# * phi#)
nx! = COS(th#) * r#: ny! = y#: nz! = SIN(th#) * r#
END SELECT
o.TargetY = -_ATAN2(nx!, nz!) * RAD2DEG: o.TargetX = _ATAN2(ny!, SQR(nx! * nx! + nz! * nz!)) * RAD2DEG
END SUB
' --- YOUR TEXTURE FUNCTION ---
FUNCTION GL_MAKE_TEXTURE& (File&)
Sx% = _WIDTH(File&): Sy% = _HEIGHT(File&)
DIM h AS LONG, LoadTexture_Buffer(Sx% * Sy%) AS LONG, LoadTexture_Buffer2(Sx% * Sy%) AS LONG
OldSrc& = _SOURCE: _SOURCE File&
GET (0, 0)-(Sx% - 1, Sy% - 1), LoadTexture_Buffer(0)
_SOURCE OldSrc&
FOR y% = 0 TO Sy% - 1
FOR x% = 0 TO Sx% - 1
clr~& = LoadTexture_Buffer(PXCnt&): LoadTexture_Buffer2(PXCnt&) = ((clr~& \ 65536) AND 255) + (clr~& AND &HFF00&) + ((clr~& AND 255) * 65536)
PXCnt& = PXCnt& + 1
NEXT
NEXT
_GLGENTEXTURES 1, _OFFSET(h): _GLBINDTEXTURE _GL_TEXTURE_2D, h
gluBuild2DMipmaps _GL_TEXTURE_2D, _GL_RGBA, Sx%, Sy%, _GL_RGBA, _GL_UNSIGNED_BYTE, LoadTexture_Buffer2(0)
_GLTEXPARAMETERI _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR
_GLTEXPARAMETERI _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR_MIPMAP_LINEAR
GL_MAKE_TEXTURE = h
END FUNCTION
DECLARE DYNAMIC LIBRARY "glu32"
SUB gluBuild2DMipmaps (BYVAL eg_GL_TEXTURE_2D&, BYVAL eg_GL_RGBA&, BYVAL sx&, BYVAL sy&, BYVAL eg_GL_RGBA&, BYVAL eg_GL_UNSIGNED_BYTE&, offset&)
SUB gluLookAt (BYVAL eyex#, BYVAL eyey#, BYVAL eyez#, BYVAL centerx#, BYVAL centery#, BYVAL centerz#, BYVAL upx#, BYVAL upy#, BYVAL upz#)
SUB gluOrtho2D (BYVAL left#, BYVAL right#, BYVAL bottom#, BYVAL top#)
END DECLARE
Posts: 3,448
Threads: 376
Joined: Apr 2022
Reputation:
345
Them be the craziest dice I has ever seen. 
To help you understand what the dice look like (as that 20 sided thing you created certainly doesn't look like any dice I've ever seen), here's a nice link for you: https://www.thingiverse.com/thing:3472349
![[Image: ee227899b1de8027d6a267bd1381551b_display_large.jpg]](https://cdn.thingiverse.com/renders/87/aa/ed/f6/e0/ee227899b1de8027d6a267bd1381551b_display_large.jpg)
When rolling the die, it can flip and turn and rotate however you want, but it should always land with one side flat, and the number up top is the number rolled. The d20, for example, has rolled a 19, while the d4 has rolled a 4.
From the link above, you can download the STL files for the dice, which I thought you could already render with the stuff you've been doing.
In the end, you want them to look like this:
![[Image: MET013.jpg]](https://www.meeplemart.com/resize/Shared/Images/Product/Metal-Polyhedral-Dice-Set-16mm-Purple-with-Gold-Numbers/MET013.jpg)
Posts: 164
Threads: 54
Joined: Sep 2025
Reputation:
18
(12-23-2025, 05:43 AM)Unseen Machine Wrote: Steve asked for a dice function...and this is the best I can do as this level of math is beyond me.
4 sided is colours only as to me that is a weird die.
6 is normal die
>6 (Only even numbers)
So if anyone can fix
The rolling - All Dice
The dots on the cube (Noirmal dice)
The polys not touching on the 20 sided dice and also being mis sized...
Add Numbers (characters) to the >6 sided options
Resolve the visible face as the result...
Add, mod, change as you need (@Maghda _MAPTRI?) and then we have a tool for any board game you can think.
John @Unseen Machine (I think that the @ contact function doesn't work for an avatar name with a space), your spelling of Magdha is incorrect here. When I was creating the avatar I misspelt this name (Maghda is usual?), and we're stuck with it. Anyway, I've found this thread.
John, you are right that this sort of thing - geometric shapes in 3D - is right up my street. Steve's function to detect the top number after the die is rolled is maybe something akin to my Rubik's Cube program where I had to know the directions of the faces. However, when I came to look at the code for getting ready to put in PE, most of that code is now a bafflement to me. Maybe something I could get around to in the future, but at present still wading through my old archive.
Players of Dungeons & Dragons will be familiar with Steve's array of dice.
Posts: 3,448
Threads: 376
Joined: Apr 2022
Reputation:
345
My request was to draw and render the dice, and then roll them. See if he could come up with a simple way to do something like:
SUB Showdie (xPos, yPos, zPos, xRot, yRot, zRot, scale)
Place it somewhere, rotate it along the axis, but it'd need to end with the rolled side up.
Basically, make dice that we can easily roll across the screen... Which is waaaay beyond my 3D talents, but something I could use in a ton of things with a simple command like above.
Posts: 164
Threads: 54
Joined: Sep 2025
Reputation:
18
12-23-2025, 02:33 PM
(This post was last modified: 12-23-2025, 02:36 PM by Magdha.)
Now I come to think of it...
Any of the Euclidean solids rolling in 3D, exchanging kinetic (linear & rotational) energy with gravitational potential energy. With a loss of energy at each pivot until the kinetic energy is insufficient to overcome the centre of gravity lifting. So then the die settles, and then check which face has vector upward.
Now, that IS a project. Prizes should be offered for anyone coming up with that. My brain is no longer so agile to deal with it, but there must be someone...
By the way, how did Fibonacci get into this thread?
Posts: 4,698
Threads: 222
Joined: Apr 2022
Reputation:
322
12-23-2025, 03:22 PM
(This post was last modified: 12-23-2025, 03:23 PM by bplus.)
The Fibonacci connection:
Quote:Fibonacci and dice connect through physical dice featuring Fibonacci numbers (1, 1, 2, 3, 5, 8...) for games like Agile Scrum estimation or specialized polyhedral dice (like D12s with sequences and spirals). They also link via betting systems, where the Fibonacci sequence (1, 1, 2, 3, 5...) is used to structure stakes in games like roulette or craps to manage losses, though it doesn't alter odds.
In Games & Design
Agile Scrum Dice: Standard six-sided dice with faces showing Fibonacci numbers (1, 2, 3, 5, 8, 13) used to estimate story points in software development, replacing standard numbers for focused discussion.
Specialty Dice: Manufacturers create polyhedral dice (like D12s) engraved with Fibonacci spirals and sequences for unique aesthetics and gameplay.
Game Mechanics: Some game systems use Fibonacci sequences to determine actions or power levels, like a "Fibonacci Fire" rule where tokens are grouped by the sequence to decide how many dice to roll.
In Betting Systems
Fibonacci Betting Strategy: A risk-management system where bets increase by following the sequence (1, 1, 2, 3, 5...) after a loss, aiming to recoup losses with a win, commonly used in casino games.
Application: Players bet on even-money outcomes (like red/black in roulette or pass/come in craps), increasing stakes after losses and resetting after wins, but casinos' table limits often prevent long-term success.
Key Concept
Fibonacci Sequence: A series (0, 1, 1, 2, 3, 5, 8, 13...) where each number is the sum of the two preceding ones, deeply connected to the Golden Ratio (Phi) (approx. 1.618) found in nature and art.
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
12-23-2025, 03:23 PM
(This post was last modified: 12-23-2025, 03:26 PM by Petr.)
We begin by calculating the vertices for each cube. Since the rotation pivot is centered, shifting the cube's position doesn't complicate the rotation logic. If the pivot were offset, each vertex would require recalculation.
We are currently using a wireframe model to verify the rotation.
The next step will be texture mapping or generating custom textures for each triangle, but that hasn't been implemented yet.
I am still refining the geometry and need to figure out how to handle rounded edges and reflections.
Code: (Select All)
'
' Output format (important):
' tri(i) is one Vertex3D
' every 3 consecutive entries form ONE triangle:
' (tri(0),tri(1),tri(2)) = triangle 0
' (tri(3),tri(4),tri(5)) = triangle 1
' ...
'
' Notes:
' - All meshes are centered at (0,0,0) for clean rotation about origin.
' - Winding is enforced to be CCW when viewed from outside (OpenGL default front face).
' - Each SetVertexD* SUB will REDIM the passed array to the required size.
'
' Triangle counts / required Vertex3D elements:
' d4 : 4 triangles -> 12 vertices
' d6 : 12 triangles -> 36 vertices
' d8 : 8 triangles -> 24 vertices
' d10 : 20 triangles -> 60 vertices (dual of regular pentagonal antiprism)
' d12 : 36 triangles -> 108 vertices (dual of icosahedron)
' d20 : 20 triangles -> 60 vertices
'
' Change desired "edge length" here:
Const DICE_EDGE! = .3
Const PI! = 3.14159265358979323846!
Const TEXW& = 256
Const TEXH& = 256
Const TSX1! = 32!: Const TSY1! = 224!
Const TSX2! = 224!: Const TSY2! = 224!
Const TSX3! = 128!: Const TSY3! = 32!
Type Vertex3D
X As Single
Y As Single
Z As Single
End Type
ReDim d4(0) As Vertex3D
ReDim d6(0) As Vertex3D
ReDim d8(0) As Vertex3D
ReDim d10(0) As Vertex3D
ReDim d12(0) As Vertex3D
ReDim d20(0) As Vertex3D
'--- One simple "main loop" to fill all dice meshes
Dim which As Long
For which = 0 To 5
Select Case which
Case 0
SetVertexD4 d4()
Case 1
SetVertexD6 d6()
Case 2
SetVertexD8 d8()
Case 3
SetVertexD10 d10()
Case 4
SetVertexD12 d12()
Case 5
SetVertexD20 d20()
End Select
Next which
'--- Debug / sanity check: counts should match expected triangle lists
PrintMeshInfo "d4", d4()
PrintMeshInfo "d6", d6()
PrintMeshInfo "d8", d8()
PrintMeshInfo "d10", d10()
PrintMeshInfo "d12", d12()
PrintMeshInfo "d20", d20()
' At this point:
' - each array is a triangle list for rendering / texturing
' - next step is _MapTriangle loop using tri(i), tri(i+1), tri(i+2)
Sleep
Screen _NewImage(800, 600, 32)
' Source triangle corners inside the texture (pixel centers).
' The texture will only contain the triangle OUTLINE, transparent elsewhere.
Dim wireTex&: MakeWireTriTexture wireTex&
Dim t!: t! = 0!
ZDepth = -4
Do
_Limit 60
Cls , _RGB(10, 10, 10)
' Two rows, reasonable perspective:
' x is left/right, y is up/down, z is depth (negative is into the screen)
' Rotations are in radians.
RenderMeshWire d4(), wireTex&, -2.2!, 1.2!, ZDepth, t! * 0.8!, t! * 1.0!, t! * 0.6!
RenderMeshWire d6(), wireTex&, 0.0!, 1.2!, ZDepth, t! * 0.7!, t! * 0.9!, t! * 0.5!
RenderMeshWire d8(), wireTex&, 2.2!, 1.2!, ZDepth, t! * 0.9!, t! * 0.6!, t! * 0.8!
RenderMeshWire d10(), wireTex&, -2.2!, -1.2!, ZDepth, t! * 0.6!, t! * 1.1!, t! * 0.7!
RenderMeshWire d12(), wireTex&, 0.0!, -1.2!, ZDepth, t! * 0.5!, t! * 0.8!, t! * 1.0!
RenderMeshWire d20(), wireTex&, 2.2!, -1.2!, ZDepth, t! * 1.0!, t! * 0.7!, t! * 0.6!
_Display
t! = t! + 0.02!
Loop Until _KeyDown(27)
_FreeImage wireTex&
End
Function VDot! (a As Vertex3D, b As Vertex3D)
VDot! = a.X * b.X + a.Y * b.Y + a.Z * b.Z
End Function
Function VLen! (a As Vertex3D)
VLen! = Sqr(a.X * a.X + a.Y * a.Y + a.Z * a.Z)
End Function
Sub VSet (r As Vertex3D, x As Single, y As Single, z As Single)
r.X = x: r.Y = y: r.Z = z
End Sub
Sub VAdd (a As Vertex3D, b As Vertex3D, r As Vertex3D)
r.X = a.X + b.X
r.Y = a.Y + b.Y
r.Z = a.Z + b.Z
End Sub
Sub VSub (a As Vertex3D, b As Vertex3D, r As Vertex3D)
r.X = a.X - b.X
r.Y = a.Y - b.Y
r.Z = a.Z - b.Z
End Sub
Sub VScale (a As Vertex3D, s As Single, r As Vertex3D)
r.X = a.X * s
r.Y = a.Y * s
r.Z = a.Z * s
End Sub
Sub VCross (a As Vertex3D, b As Vertex3D, r As Vertex3D)
r.X = a.Y * b.Z - a.Z * b.Y
r.Y = a.Z * b.X - a.X * b.Z
r.Z = a.X * b.Y - a.Y * b.X
End Sub
Sub VNorm (a As Vertex3D, r As Vertex3D)
Dim l As Single
l = VLen!(a)
If l = 0! Then
r.X = 0!: r.Y = 0!: r.Z = 0!
Else
r.X = a.X / l
r.Y = a.Y / l
r.Z = a.Z / l
End If
End Sub
' Face-list utilities
'
' Faces are stored as:
' pfStart(f) = start offset into pfIdx()
' pfSize(f) = vertex count of face f
' pfIdx() = concatenated vertex indices for all faces
'
' This lets us represent triangles/quads/pentagons uniformly, then fan-triangulate.
Sub ReverseFace (pfIdx() As Long, startOff As Long, cnt As Long)
Dim i As Long, j As Long, t As Long
i = 0: j = cnt - 1
While i < j
t = pfIdx(startOff + i)
pfIdx(startOff + i) = pfIdx(startOff + j)
pfIdx(startOff + j) = t
i = i + 1
j = j - 1
Wend
End Sub
Sub EnsureFacesOutward (v() As Vertex3D, pfStart() As Long, pfSize() As Long, pfIdx() As Long)
' Ensures CCW winding when looking from outside:
' If normal points toward origin (dot(normal, centroid) < 0) -> reverse the face order.
Dim f As Long, k As Long
Dim s As Long, n As Long
Dim a As Vertex3D, b As Vertex3D, c As Vertex3D
Dim e1 As Vertex3D, e2 As Vertex3D, nn As Vertex3D
Dim cen As Vertex3D, tmp As Vertex3D
Dim d As Single
For f = LBound(pfStart) To UBound(pfStart)
s = pfStart(f): n = pfSize(f)
If n < 3 Then
' skip
Else
a = v(pfIdx(s + 0))
b = v(pfIdx(s + 1))
c = v(pfIdx(s + 2))
VSub b, a, e1
VSub c, a, e2
VCross e1, e2, nn
' centroid
cen.X = 0!: cen.Y = 0!: cen.Z = 0!
For k = 0 To n - 1
tmp = v(pfIdx(s + k))
cen.X = cen.X + tmp.X
cen.Y = cen.Y + tmp.Y
cen.Z = cen.Z + tmp.Z
Next
cen.X = cen.X / n
cen.Y = cen.Y / n
cen.Z = cen.Z / n
d = VDot!(nn, cen)
If d < 0! Then
ReverseFace pfIdx(), s, n
End If
End If
Next
End Sub
Function MinEdgeLen! (v() As Vertex3D, pfStart() As Long, pfSize() As Long, pfIdx() As Long)
' Returns the minimum polygon edge length over all faces.
' Used to scale the whole polyhedron so that (min edge) becomes DICE_EDGE.
Dim f As Long, k As Long, s As Long, n As Long
Dim i0 As Long, i1 As Long
Dim ax As Single, ay As Single, az As Single
Dim bx As Single, by As Single, bz As Single
Dim dx As Single, dy As Single, dz As Single
Dim dist As Single
Dim best As Single
best = 1E+30
For f = LBound(pfStart) To UBound(pfStart)
s = pfStart(f): n = pfSize(f)
If n < 2 Then
' skip
Else
For k = 0 To n - 1
i0 = pfIdx(s + k)
i1 = pfIdx(s + ((k + 1) Mod n))
ax = v(i0).X: ay = v(i0).Y: az = v(i0).Z
bx = v(i1).X: by = v(i1).Y: bz = v(i1).Z
dx = ax - bx: dy = ay - by: dz = az - bz
dist = Sqr(dx * dx + dy * dy + dz * dz)
If dist > 0! And dist < best Then best = dist
Next
End If
Next
MinEdgeLen! = best
End Function
Sub ScaleVertices (v() As Vertex3D, s As Single)
Dim i As Long
For i = LBound(v) To UBound(v)
v(i).X = v(i).X * s
v(i).Y = v(i).Y * s
v(i).Z = v(i).Z * s
Next
End Sub
Sub PolyToTriList (v() As Vertex3D, pfStart() As Long, pfSize() As Long, pfIdx() As Long, tri() As Vertex3D)
' Fan-triangulates each face:
' face [i0 i1 i2 i3 ...] -> triangles (i0,i1,i2), (i0,i2,i3), ...
Dim f As Long, s As Long, n As Long, k As Long
Dim triCount As Long, need As Long
Dim baze As Long
Dim i0 As Long, i1 As Long, i2 As Long
triCount = 0
For f = LBound(pfStart) To UBound(pfStart)
triCount = triCount + (pfSize(f) - 2)
Next
need = triCount * 3
ReDim tri(0 To need - 1) As Vertex3D
baze = 0
For f = LBound(pfStart) To UBound(pfStart)
s = pfStart(f): n = pfSize(f)
If n < 3 Then
' skip
Else
i0 = pfIdx(s + 0)
For k = 1 To n - 2
i1 = pfIdx(s + k)
i2 = pfIdx(s + k + 1)
tri(baze + 0) = v(i0)
tri(baze + 1) = v(i1)
tri(baze + 2) = v(i2)
baze = baze + 3
Next
End If
Next
End Sub
' Dual builder (polar dual w.r.t. origin)
'
' Why dual?
' - d12 can be constructed as dual of d20 (icosahedron).
' - d10 (pentagonal trapezohedron) can be constructed as dual of a pentagonal antiprism.
'
' Geometry:
' - Each primal face defines a plane: n · x = d, with outward unit normal n and d>0.
' - Polar dual vertex is: v_dual = n / d
Sub BuildDual (pv() As Vertex3D, pfStart() As Long, pfSize() As Long, pfIdx() As Long, dv() As Vertex3D, dfStart() As Long, dfSize() As Long, dfIdx() As Long)
Dim fCount As Long, vCount As Long
Dim f As Long, i As Long, k As Long, s As Long, n As Long
Dim a As Vertex3D, b As Vertex3D, c As Vertex3D
Dim e1 As Vertex3D, e2 As Vertex3D, nn As Vertex3D, nnUnit As Vertex3D
Dim cen As Vertex3D, tmp As Vertex3D
Dim d As Single
vCount = UBound(pv) - LBound(pv) + 1
fCount = UBound(pfStart) - LBound(pfStart) + 1
ReDim dv(0 To fCount - 1) As Vertex3D
' Dual vertices: one per primal face
For f = 0 To fCount - 1
s = pfStart(f): n = pfSize(f)
a = pv(pfIdx(s + 0))
b = pv(pfIdx(s + 1))
c = pv(pfIdx(s + 2))
VSub b, a, e1
VSub c, a, e2
VCross e1, e2, nn
VNorm nn, nnUnit
' Ensure normal points outward using centroid sign (object is centered at origin)
cen.X = 0!: cen.Y = 0!: cen.Z = 0!
For k = 0 To n - 1
tmp = pv(pfIdx(s + k))
cen.X = cen.X + tmp.X
cen.Y = cen.Y + tmp.Y
cen.Z = cen.Z + tmp.Z
Next
cen.X = cen.X / n
cen.Y = cen.Y / n
cen.Z = cen.Z / n
If VDot!(nnUnit, cen) < 0! Then
nnUnit.X = -nnUnit.X
nnUnit.Y = -nnUnit.Y
nnUnit.Z = -nnUnit.Z
End If
' Plane distance d = n · a (for any vertex a on that face plane)
d = VDot!(nnUnit, a)
If d = 0! Then d = 1E-9
' Dual vertex = n / d
dv(f).X = nnUnit.X / d
dv(f).Y = nnUnit.Y / d
dv(f).Z = nnUnit.Z / d
Next
' Build dual faces: one per primal vertex
' Each dual face is the cycle of incident primal faces around that vertex.
Dim incCount As Long
ReDim incCount(0 To vCount - 1) As Long
' Count incident faces per vertex
For f = 0 To fCount - 1
s = pfStart(f): n = pfSize(f)
For k = 0 To n - 1
i = pfIdx(s + k)
incCount(i) = incCount(i) + 1
Next
Next
' Prefix sums for dfStart/dfSize
ReDim dfStart(0 To vCount - 1) As Long
ReDim dfSize(0 To vCount - 1) As Long
Dim total As Long, cur As Long
total = 0
For i = 0 To vCount - 1
dfStart(i) = total
dfSize(i) = incCount(i)
total = total + incCount(i)
incCount(i) = 0 ' reuse as write cursor
Next
ReDim dfIdx(0 To total - 1) As Long
' Fill unordered incident face IDs
For f = 0 To fCount - 1
s = pfStart(f): n = pfSize(f)
For k = 0 To n - 1
i = pfIdx(s + k)
cur = dfStart(i) + incCount(i)
dfIdx(cur) = f
incCount(i) = incCount(i) + 1
Next
Next
' Order each dual face cyclically around primal vertex (needed for correct polygon)
' We sort by angle in the tangent plane orthogonal to the vertex direction.
Dim nrm As Vertex3D, refVec As Vertex3D, u As Vertex3D, vtan As Vertex3D
Dim proj As Vertex3D, proj2 As Vertex3D, tmp2 As Vertex3D
Dim ang As Single, ids As Long
Dim m As Long, p As Long, q As Long
Dim tA As Single, tI As Long
Dim dp As Single
For i = 0 To vCount - 1
s = dfStart(i): m = dfSize(i)
If m < 3 Then
' skip
Else
VNorm pv(i), nrm
' Choose a reference not parallel to nrm
VSet refVec, 0!, 1!, 0!
dp = Abs(VDot!(nrm, refVec))
If dp > .9 Then VSet refVec, 1!, 0!, 0!
' Build tangent basis u, vtan
VCross refVec, nrm, tmp2
VNorm tmp2, u
VCross nrm, u, vtan
ReDim ang(0 To m - 1) As Single
ReDim ids(0 To m - 1) As Long
For k = 0 To m - 1
ids(k) = dfIdx(s + k)
proj = dv(ids(k))
' Project onto tangent plane: proj = proj - nrm * dot(proj,nrm)
dp = VDot!(proj, nrm)
VScale nrm, dp, tmp2
VSub proj, tmp2, proj2
' Angle in basis (u, vtan)
ang(k) = _Atan2(VDot!(proj2, vtan), VDot!(proj2, u))
Next
' Small m (<=5) -> simple bubble sort is fine
For p = 0 To m - 2
For q = 0 To m - 2 - p
If ang(q) > ang(q + 1) Then
tA = ang(q): ang(q) = ang(q + 1): ang(q + 1) = tA
tI = ids(q): ids(q) = ids(q + 1): ids(q + 1) = tI
End If
Next
Next
For k = 0 To m - 1
dfIdx(s + k) = ids(k)
Next
End If
Next
End Sub
Sub SetVertexD4 (tri() As Vertex3D)
' Regular tetrahedron:
' Use the classic symmetric coordinates (±1,±1,±1) with an even number of negatives.
' This gives a tetra centered at origin. Then scale so minimum edge length = DICE_EDGE.
Dim v(0 To 3) As Vertex3D
VSet v(0), 1!, 1!, 1!
VSet v(1), 1!, -1!, -1!
VSet v(2), -1!, 1!, -1!
VSet v(3), -1!, -1!, 1!
Dim pfStart(0 To 3) As Long, pfSize(0 To 3) As Long, pfIdx(0 To 11) As Long
Dim o As Long: o = 0
' 4 triangular faces (indices into v())
pfStart(0) = o: pfSize(0) = 3: pfIdx(o + 0) = 0: pfIdx(o + 1) = 2: pfIdx(o + 2) = 1: o = o + 3
pfStart(1) = o: pfSize(1) = 3: pfIdx(o + 0) = 0: pfIdx(o + 1) = 1: pfIdx(o + 2) = 3: o = o + 3
pfStart(2) = o: pfSize(2) = 3: pfIdx(o + 0) = 0: pfIdx(o + 1) = 3: pfIdx(o + 2) = 2: o = o + 3
pfStart(3) = o: pfSize(3) = 3: pfIdx(o + 0) = 1: pfIdx(o + 1) = 2: pfIdx(o + 2) = 3: o = o + 3
EnsureFacesOutward v(), pfStart(), pfSize(), pfIdx()
Dim edgeNow As Single, sc As Single
edgeNow = MinEdgeLen!(v(), pfStart(), pfSize(), pfIdx())
sc = DICE_EDGE! / edgeNow
ScaleVertices v(), sc
PolyToTriList v(), pfStart(), pfSize(), pfIdx(), tri()
End Sub
Sub SetVertexD6 (tri() As Vertex3D)
' Cube:
' Vertices are all combinations of (±1, ±1, ±1), centered at origin.
' Canonical cube edge length is 2 -> scaled to DICE_EDGE.
Dim v(0 To 7) As Vertex3D
VSet v(0), -1!, -1!, -1!
VSet v(1), 1!, -1!, -1!
VSet v(2), 1!, 1!, -1!
VSet v(3), -1!, 1!, -1!
VSet v(4), -1!, -1!, 1!
VSet v(5), 1!, -1!, 1!
VSet v(6), 1!, 1!, 1!
VSet v(7), -1!, 1!, 1!
Dim pfStart(0 To 5) As Long, pfSize(0 To 5) As Long, pfIdx(0 To 23) As Long
Dim o As Long: o = 0
' 6 quad faces (each will be triangulated into 2 triangles)
' Z-
pfStart(0) = o: pfSize(0) = 4: pfIdx(o + 0) = 0: pfIdx(o + 1) = 1: pfIdx(o + 2) = 2: pfIdx(o + 3) = 3: o = o + 4
' Z+
pfStart(1) = o: pfSize(1) = 4: pfIdx(o + 0) = 4: pfIdx(o + 1) = 7: pfIdx(o + 2) = 6: pfIdx(o + 3) = 5: o = o + 4
' X+
pfStart(2) = o: pfSize(2) = 4: pfIdx(o + 0) = 1: pfIdx(o + 1) = 5: pfIdx(o + 2) = 6: pfIdx(o + 3) = 2: o = o + 4
' X-
pfStart(3) = o: pfSize(3) = 4: pfIdx(o + 0) = 0: pfIdx(o + 1) = 3: pfIdx(o + 2) = 7: pfIdx(o + 3) = 4: o = o + 4
' Y+
pfStart(4) = o: pfSize(4) = 4: pfIdx(o + 0) = 3: pfIdx(o + 1) = 2: pfIdx(o + 2) = 6: pfIdx(o + 3) = 7: o = o + 4
' Y-
pfStart(5) = o: pfSize(5) = 4: pfIdx(o + 0) = 0: pfIdx(o + 1) = 4: pfIdx(o + 2) = 5: pfIdx(o + 3) = 1: o = o + 4
EnsureFacesOutward v(), pfStart(), pfSize(), pfIdx()
Dim edgeNow As Single, sc As Single
edgeNow = MinEdgeLen!(v(), pfStart(), pfSize(), pfIdx()) ' should be 2
sc = DICE_EDGE! / edgeNow
ScaleVertices v(), sc
PolyToTriList v(), pfStart(), pfSize(), pfIdx(), tri()
End Sub
Sub SetVertexD8 (tri() As Vertex3D)
' Octahedron:
' Canonical vertices on axes: (1,0,0),(0,1,0),(0,0,1).
' Canonical edge length is sqr(2) -> scaled to DICE_EDGE.
Dim v(0 To 5) As Vertex3D
VSet v(0), 1!, 0!, 0!
VSet v(1), -1!, 0!, 0!
VSet v(2), 0!, 1!, 0!
VSet v(3), 0!, -1!, 0!
VSet v(4), 0!, 0!, 1!
VSet v(5), 0!, 0!, -1!
Dim pfStart(0 To 7) As Long, pfSize(0 To 7) As Long, pfIdx(0 To 23) As Long
Dim o As Long: o = 0
' 8 triangular faces
pfStart(0) = o: pfSize(0) = 3: pfIdx(o + 0) = 4: pfIdx(o + 1) = 0: pfIdx(o + 2) = 2: o = o + 3
pfStart(1) = o: pfSize(1) = 3: pfIdx(o + 0) = 4: pfIdx(o + 1) = 2: pfIdx(o + 2) = 1: o = o + 3
pfStart(2) = o: pfSize(2) = 3: pfIdx(o + 0) = 4: pfIdx(o + 1) = 1: pfIdx(o + 2) = 3: o = o + 3
pfStart(3) = o: pfSize(3) = 3: pfIdx(o + 0) = 4: pfIdx(o + 1) = 3: pfIdx(o + 2) = 0: o = o + 3
pfStart(4) = o: pfSize(4) = 3: pfIdx(o + 0) = 5: pfIdx(o + 1) = 2: pfIdx(o + 2) = 0: o = o + 3
pfStart(5) = o: pfSize(5) = 3: pfIdx(o + 0) = 5: pfIdx(o + 1) = 1: pfIdx(o + 2) = 2: o = o + 3
pfStart(6) = o: pfSize(6) = 3: pfIdx(o + 0) = 5: pfIdx(o + 1) = 3: pfIdx(o + 2) = 1: o = o + 3
pfStart(7) = o: pfSize(7) = 3: pfIdx(o + 0) = 5: pfIdx(o + 1) = 0: pfIdx(o + 2) = 3: o = o + 3
EnsureFacesOutward v(), pfStart(), pfSize(), pfIdx()
Dim edgeNow As Single, sc As Single
edgeNow = MinEdgeLen!(v(), pfStart(), pfSize(), pfIdx()) ' should be sqr(2)
sc = DICE_EDGE! / edgeNow
ScaleVertices v(), sc
PolyToTriList v(), pfStart(), pfSize(), pfIdx(), tri()
End Sub
Sub SetVertexD20 (tri() As Vertex3D)
' Icosahedron:
' This is centered at origin. Canonical edge length becomes 2 -> scaled to DICE_EDGE.
Dim phi As Single
phi = (1! + Sqr(5!)) / 2!
Dim v(0 To 11) As Vertex3D
VSet v(0), -1!, phi, 0!
VSet v(1), 1!, phi, 0!
VSet v(2), -1!, -phi, 0!
VSet v(3), 1!, -phi, 0!
VSet v(4), 0!, -1!, phi
VSet v(5), 0!, 1!, phi
VSet v(6), 0!, -1!, -phi
VSet v(7), 0!, 1!, -phi
VSet v(8), phi, 0!, -1!
VSet v(9), phi, 0!, 1!
VSet v(10), -phi, 0!, -1!
VSet v(11), -phi, 0!, 1!
Dim pfStart(0 To 19) As Long, pfSize(0 To 19) As Long, pfIdx(0 To 59) As Long
Dim o As Long: o = 0
' 20 triangular faces (standard indexed set)
Dim F(0 To 19, 0 To 2) As Long
F(0, 0) = 0: F(0, 1) = 11: F(0, 2) = 5
F(1, 0) = 0: F(1, 1) = 5: F(1, 2) = 1
F(2, 0) = 0: F(2, 1) = 1: F(2, 2) = 7
F(3, 0) = 0: F(3, 1) = 7: F(3, 2) = 10
F(4, 0) = 0: F(4, 1) = 10: F(4, 2) = 11
F(5, 0) = 1: F(5, 1) = 5: F(5, 2) = 9
F(6, 0) = 5: F(6, 1) = 11: F(6, 2) = 4
F(7, 0) = 11: F(7, 1) = 10: F(7, 2) = 2
F(8, 0) = 10: F(8, 1) = 7: F(8, 2) = 6
F(9, 0) = 7: F(9, 1) = 1: F(9, 2) = 8
F(10, 0) = 3: F(10, 1) = 9: F(10, 2) = 4
F(11, 0) = 3: F(11, 1) = 4: F(11, 2) = 2
F(12, 0) = 3: F(12, 1) = 2: F(12, 2) = 6
F(13, 0) = 3: F(13, 1) = 6: F(13, 2) = 8
F(14, 0) = 3: F(14, 1) = 8: F(14, 2) = 9
F(15, 0) = 4: F(15, 1) = 9: F(15, 2) = 5
F(16, 0) = 2: F(16, 1) = 4: F(16, 2) = 11
F(17, 0) = 6: F(17, 1) = 2: F(17, 2) = 10
F(18, 0) = 8: F(18, 1) = 6: F(18, 2) = 7
F(19, 0) = 9: F(19, 1) = 8: F(19, 2) = 1
Dim fi As Long
For fi = 0 To 19
pfStart(fi) = o: pfSize(fi) = 3
pfIdx(o + 0) = F(fi, 0)
pfIdx(o + 1) = F(fi, 1)
pfIdx(o + 2) = F(fi, 2)
o = o + 3
Next
EnsureFacesOutward v(), pfStart(), pfSize(), pfIdx()
Dim edgeNow As Single, sc As Single
edgeNow = MinEdgeLen!(v(), pfStart(), pfSize(), pfIdx()) ' should be 2
sc = DICE_EDGE! / edgeNow
ScaleVertices v(), sc
PolyToTriList v(), pfStart(), pfSize(), pfIdx(), tri()
End Sub
Sub SetVertexD12 (tri() As Vertex3D)
' Dodecahedron as the dual of an icosahedron:
' - Build the icosahedron (same as d20)
' - Compute polar dual -> gives dodecahedron centered at origin
' - Scale so minimum edge length matches DICE_EDGE
Dim phi As Single
phi = (1! + Sqr(5!)) / 2!
' Primal: icosahedron vertices
Dim pv(0 To 11) As Vertex3D
VSet pv(0), -1!, phi, 0!
VSet pv(1), 1!, phi, 0!
VSet pv(2), -1!, -phi, 0!
VSet pv(3), 1!, -phi, 0!
VSet pv(4), 0!, -1!, phi
VSet pv(5), 0!, 1!, phi
VSet pv(6), 0!, -1!, -phi
VSet pv(7), 0!, 1!, -phi
VSet pv(8), phi, 0!, -1!
VSet pv(9), phi, 0!, 1!
VSet pv(10), -phi, 0!, -1!
VSet pv(11), -phi, 0!, 1!
' Primal faces (same 20 triangles as d20)
Dim pfStart(0 To 19) As Long, pfSize(0 To 19) As Long, pfIdx(0 To 59) As Long
Dim o As Long: o = 0
Dim F(0 To 19, 0 To 2) As Long
F(0, 0) = 0: F(0, 1) = 11: F(0, 2) = 5
F(1, 0) = 0: F(1, 1) = 5: F(1, 2) = 1
F(2, 0) = 0: F(2, 1) = 1: F(2, 2) = 7
F(3, 0) = 0: F(3, 1) = 7: F(3, 2) = 10
F(4, 0) = 0: F(4, 1) = 10: F(4, 2) = 11
F(5, 0) = 1: F(5, 1) = 5: F(5, 2) = 9
F(6, 0) = 5: F(6, 1) = 11: F(6, 2) = 4
F(7, 0) = 11: F(7, 1) = 10: F(7, 2) = 2
F(8, 0) = 10: F(8, 1) = 7: F(8, 2) = 6
F(9, 0) = 7: F(9, 1) = 1: F(9, 2) = 8
F(10, 0) = 3: F(10, 1) = 9: F(10, 2) = 4
F(11, 0) = 3: F(11, 1) = 4: F(11, 2) = 2
F(12, 0) = 3: F(12, 1) = 2: F(12, 2) = 6
F(13, 0) = 3: F(13, 1) = 6: F(13, 2) = 8
F(14, 0) = 3: F(14, 1) = 8: F(14, 2) = 9
F(15, 0) = 4: F(15, 1) = 9: F(15, 2) = 5
F(16, 0) = 2: F(16, 1) = 4: F(16, 2) = 11
F(17, 0) = 6: F(17, 1) = 2: F(17, 2) = 10
F(18, 0) = 8: F(18, 1) = 6: F(18, 2) = 7
F(19, 0) = 9: F(19, 1) = 8: F(19, 2) = 1
Dim fi As Long
For fi = 0 To 19
pfStart(fi) = o: pfSize(fi) = 3
pfIdx(o + 0) = F(fi, 0)
pfIdx(o + 1) = F(fi, 1)
pfIdx(o + 2) = F(fi, 2)
o = o + 3
Next
EnsureFacesOutward pv(), pfStart(), pfSize(), pfIdx()
' Dual
Dim dv(0) As Vertex3D, dfStart(0) As Long, dfSize(0) As Long, dfIdx(0) As Long
BuildDual pv(), pfStart(), pfSize(), pfIdx(), dv(), dfStart(), dfSize(), dfIdx()
EnsureFacesOutward dv(), dfStart(), dfSize(), dfIdx()
' Scale so minimum edge matches DICE_EDGE
Dim edgeNow As Single, sc As Single
edgeNow = MinEdgeLen!(dv(), dfStart(), dfSize(), dfIdx())
sc = DICE_EDGE! / edgeNow
ScaleVertices dv(), sc
PolyToTriList dv(), dfStart(), dfSize(), dfIdx(), tri()
End Sub
Sub SetVertexD10 (tri() As Vertex3D)
' d10 (pentagonal trapezohedron) via dual of a REGULAR pentagonal antiprism.
'
' Regular pentagonal antiprism construction:
' - Two pentagons of radius r at z=+h and z=-h.
' - Bottom pentagon is rotated by 36 (PI/5) relative to top.
' - Choose h so that:
' polygon edge length == side edge length
'
' For radius r:
' - polygon edge: s = 2r * sin(36) = 2r * sin(PI/5)
' - horizontal chord between a top vertex and its connected bottom vertex:
' c = 2r * sin(18) = 2r * sin(PI/10)
' - side edge is sqrt(c^2 + (2h)^2) -> set equal to s:
' s^2 = c^2 + (2h)^2 => h = 0.5 * sqrt(s^2 - c^2)
'
' Dual of this antiprism gives a trapezohedron with 10 kite faces (each a quad).
' IMPORTANT: A "regular" trapezohedron has congruent kites, but may have two edge lengths.
' We scale by MINIMUM edge length to match DICE_EDGE.
Dim r As Single, h As Single
Dim sPoly As Single, chord As Single
r = 1!
sPoly = 2! * r * Sin(PI! / 5!) ' sin(36°)
chord = 2! * r * Sin(PI! / 10!) ' sin(18°)
h = .5 * Sqr(sPoly * sPoly - chord * chord)
' Primal antiprism vertices: U0..U4 at +h, L0..L4 at -h, rotated by 36
Dim pv(0 To 9) As Vertex3D
Dim k As Long, ang As Single
For k = 0 To 4
ang = (2! * PI! * k) / 5!
VSet pv(k), r * Cos(ang), r * Sin(ang), h
Next
For k = 0 To 4
ang = (2! * PI! * k) / 5! + (PI! / 5!)
VSet pv(5 + k), r * Cos(ang), r * Sin(ang), -h
Next
' Primal faces: 2 pentagons + 10 triangles
Dim pfStart(0 To 11) As Long, pfSize(0 To 11) As Long
Dim pfIdx(0 To (5 + 5 + 10 * 3) - 1) As Long
Dim o As Long: o = 0
' Top pentagon (0..4)
pfStart(0) = o: pfSize(0) = 5
For k = 0 To 4: pfIdx(o + k) = k: Next
o = o + 5
' Bottom pentagon (5..9) reversed to be outward
pfStart(1) = o: pfSize(1) = 5
pfIdx(o + 0) = 5 + 0
pfIdx(o + 1) = 5 + 4
pfIdx(o + 2) = 5 + 3
pfIdx(o + 3) = 5 + 2
pfIdx(o + 4) = 5 + 1
o = o + 5
' Side triangles:
' For each i:
' (U_i, L_i, U_{i+1})
' (U_{i+1}, L_i, L_{i+1})
Dim i As Long, u0 As Long, u1 As Long, l0 As Long, l1 As Long
Dim f As Long: f = 2
For i = 0 To 4
u0 = i
u1 = (i + 1) Mod 5
l0 = 5 + i
l1 = 5 + ((i + 1) Mod 5)
pfStart(f) = o: pfSize(f) = 3
pfIdx(o + 0) = u0: pfIdx(o + 1) = l0: pfIdx(o + 2) = u1
o = o + 3: f = f + 1
pfStart(f) = o: pfSize(f) = 3
pfIdx(o + 0) = u1: pfIdx(o + 1) = l0: pfIdx(o + 2) = l1
o = o + 3: f = f + 1
Next
EnsureFacesOutward pv(), pfStart(), pfSize(), pfIdx()
' Dual -> d10
Dim dv(0) As Vertex3D, dfStart(0) As Long, dfSize(0) As Long, dfIdx(0) As Long
BuildDual pv(), pfStart(), pfSize(), pfIdx(), dv(), dfStart(), dfSize(), dfIdx()
EnsureFacesOutward dv(), dfStart(), dfSize(), dfIdx()
Dim edgeNow As Single, sc As Single
edgeNow = MinEdgeLen!(dv(), dfStart(), dfSize(), dfIdx())
sc = DICE_EDGE! / edgeNow
ScaleVertices dv(), sc
PolyToTriList dv(), dfStart(), dfSize(), dfIdx(), tri()
End Sub
Sub PrintMeshInfo (jmeno As String, tri() As Vertex3D)
Dim vCount As Long, tCount As Long
vCount = UBound(tri) - LBound(tri) + 1
tCount = vCount \ 3
Print jmeno; " vertices="; vCount; " triangles="; tCount
End Sub
' ADD THESE SUBs AT THE END (after your existing dice SUBs)
Sub MakeWireTriTexture (tex&)
' Creates a hardware texture (mode 33) with a transparent background
' and only a triangle outline drawn with LINE.
'
' Why this works as "wireframe":
' _MAPTRIANGLE maps the texture onto every 3D triangle.
' Since the texture is transparent except the outline, only edges show.
Dim sw&: sw& = _NewImage(TEXW&, TEXH&, 32) ' software RGBA
_Dest sw&
Cls , _RGBA(0, 0, 0, 0)
Dim c As _Unsigned Long
c = _RGBA(255, 255, 255, 255)
' 1px outline:
Line (TSX1!, TSY1!)-(TSX2!, TSY2!), c
Line (TSX2!, TSY2!)-(TSX3!, TSY3!), c
Line (TSX3!, TSY3!)-(TSX1!, TSY1!), c
' "Poor man's thickness": draw a few offset copies
Line (TSX1! + 1!, TSY1!)-(TSX2! + 1!, TSY2!), c
Line (TSX2! + 1!, TSY2!)-(TSX3! + 1!, TSY3!), c
Line (TSX3! + 1!, TSY3!)-(TSX1! + 1!, TSY1!), c
Line (TSX1!, TSY1! + 1!)-(TSX2!, TSY2! + 1!), c
Line (TSX2!, TSY2! + 1!)-(TSX3!, TSY3! + 1!), c
Line (TSX3!, TSY3! + 1!)-(TSX1!, TSY1! + 1!), c
_Dest 0
' Copy to a hardware image so it can be used efficiently as a source in SCREEN 33
tex& = _CopyImage(sw&, 33)
_FreeImage sw&
End Sub
Sub RenderMeshWire (tri() As Vertex3D, tex&, tx!, ty!, tz!, rx!, ry!, rz!)
' Draws the given triangle list as mapped "wireframe triangles".
'
' Steps:
' 1) Transform model vertices (rotate around origin, then translate).
' 2) Painter-sort triangles by average Z (far -> near) to reduce wrong overlap.
' (If you rely on a depth buffer, you can remove sorting.)
' 3) _MAPTRIANGLE the outline texture onto each triangle.
'
' IMPORTANT:
' If EVERYTHING disappears, flip _ANTICLOCKWISE to _CLOCKWISE below.
' The correct one depends on screen-space winding in your setup.
Dim lb&: lb& = LBound(tri)
Dim vCount&: vCount& = UBound(tri) - lb& + 1
If vCount& < 3 Then Exit Sub
Dim tCount&: tCount& = vCount& \ 3
If tCount& < 1 Then Exit Sub
' Precompute sines/cosines once per mesh draw
Dim cx!, sx!, cy!, sy!, cz!, sz!
cx! = Cos(rx!): sx! = Sin(rx!)
cy! = Cos(ry!): sy! = Sin(ry!)
cz! = Cos(rz!): sz! = Sin(rz!)
' Transform all vertices into tv()
Dim tv As Vertex3D
ReDim tv(0 To vCount& - 1) As Vertex3D
Dim As Long i, t, ord, k
Dim As Single x, y, z, y1, z1, x2, z2, x3, y3, zAvg
For i& = 0 To vCount& - 1
x! = tri(lb& + i&).X
y! = tri(lb& + i&).Y
z! = tri(lb& + i&).Z
' Rotate around X:
' (x stays), (y,z) rotates
y1! = y! * cx! - z! * sx!
z1! = y! * sx! + z! * cx!
' Rotate around Y:
' (y stays), (x,z) rotates
x2! = x! * cy! + z1! * sy!
z2! = -x! * sy! + z1! * cy!
' Rotate around Z:
' (z stays), (x,y) rotates
x3! = x2! * cz! - y1! * sz!
y3! = x2! * sz! + y1! * cz!
' Translate into world position
tv(i&).X = x3! + tx!
tv(i&).Y = y3! + ty!
tv(i&).Z = z2! + tz!
Next
' Build painter-sort keys (average Z)
ReDim zAvg(0 To tCount& - 1) As Single
ReDim ord(0 To tCount& - 1) As Long
For t& = 0 To tCount& - 1
Dim b&: b& = t& * 3
zAvg(t&) = (tv(b& + 0).Z + tv(b& + 1).Z + tv(b& + 2).Z) / 3!
ord(t&) = t&
Next
' Sort triangles far->near (more negative Z is farther)
' Simple bubble sort is fine: at most 36 triangles (d12) here.
Dim p&, q&, tmpI&, tmpZ!
For p& = 0 To tCount& - 2
For q& = 0 To tCount& - 2 - p&
If zAvg(ord(q&)) > zAvg(ord(q& + 1)) Then
tmpI& = ord(q&): ord(q&) = ord(q& + 1): ord(q& + 1) = tmpI&
End If
Next
Next
' Draw in sorted order
For k& = 0 To tCount& - 1
t& = ord(k&)
b& = t& * 3
_MAPTRIANGLE _ANTICLOCKWISE (TSX1!, TSY1!)-(TSX2!, TSY2!)-(TSX3!, TSY3!), tex& TO _
(tv(b& + 0).X, tv(b& + 0).Y, tv(b& + 0).Z)- _
(tv(b& + 1).X, tv(b& + 1).Y, tv(b& + 1).Z)- _
(tv(b& + 2).X, tv(b& + 2).Y, tv(b& + 2).Z), , _SMOOTH
Next
End Sub
Posts: 3,448
Threads: 376
Joined: Apr 2022
Reputation:
345
@Petr Those are some fine looking wireframes. The ten-sided dice seem a little off somehow to me, but that might just be the wireframe and these old eyes. I was going to say the same thing with the 12-sided dice at first, as it's primarily a pentagonal design, but then I noticed the pentagon *is* in there; it's just got some extra lines which seem to form a "V" in the middle of them. The 10-sided die may be the same, properly forming the geometrics with just a few extra lines in there, but these eggnog stained eyes just somehow seem to find it off a bit.
The other die, however, appear to be spot on! I'm really looking forward to whatever you guys end up coming up with in the end. You've already passed anything I could come up with, with my poor skills. They only way I might be able to do something at all similar to this, would be with a large ass sprite sheet with all the images already drawn out and then use it to mimic the drawing and rotating of the die. 3D is beyond me (I've just never really had any great interest in sorting out its depths as I'm a 2d game guy personally), so I'm more than impressed at all the attempts here.
Good look to all you guys! And... most important... MERRY CHRISTMAS!!!!
Posts: 347
Threads: 45
Joined: Jun 2024
Reputation:
32
Well it seems that me being unable to do it properly will yield way better results that i could ever have achieved! Happy Christmas Steve!
@Petr WOWWEE! You put some graft into that one didn't ya! Nice - Look forward to seeing the finished version!
Thanks folks and as always, happy coding!
Unseen
Posts: 513
Threads: 65
Joined: May 2022
Reputation:
83
Thanks. I'm having issues with texture stretching distorting the numbers. Is there an unwrapped UV map available? I need to check the correct placement of the numbers for each face of the cube.
![[Image: cubes.png]](https://i.ibb.co/N62DS8QY/cubes.png)
Happy Christmas!
|
