Proggies

[bplus]

More Image to Cube fun!

Brain Cubed:

Code: (Select All)

Option _Explicit

_Title "Brain Cubed" ' b+ 2026-01-27



Type xy

    As Single x, y

End Type



Screen _NewImage(700, 700, 32)

_ScreenMove 300, 0



Dim As Long sb1, sb2, sb3

sb1 = _LoadImage("TBrain.PNG") ' rev 3 PM horrible again only the top face is screwed up ???

sb3 = _LoadImage("RBrain.PNG")

sb2 = _LoadImage("LBrain.PNG")



' draw cube 3 faces showing

Dim c(0 To 6) As xy

Dim As Integer i

c(0).x = 350: c(0).y = 350

_PrintString (c(0).x - 4, c(0).y - 8), "0" ' drawing points for set up of faces

For i = 1 To 6

    c(i).x = 350 + 340 * Cos(i * _Pi / 3)

    c(i).y = 350 + 340 * Sin(i * _Pi / 3)

    Circle (c(i).x, c(i).y), 8

    _PrintString (c(i).x - 4, c(i).y - 8), _Trim$(Str$(i))

    'Sleep

Next

Cls



'top face

' map image top face

_MapTriangle (0, 0)-(_Width(sb1), 0)-(_Width(sb1), _Height(sb1)), sb1 To(c(4).x, c(4).y)-(c(5).x, c(5).y)-(c(6).x, c(6).y), 0

_MapTriangle (0, 0)-(0, _Height(sb1))-(_Width(sb1), _Height(sb1)), sb1 To(c(4).x, c(4).y)-(c(0).x, c(0).y)-(c(6).x, c(6).y), 0



'right face

_MapTriangle (0, 0)-(_Width(sb3), 0)-(_Width(sb3), _Height(sb3)), sb3 To(c(0).x, c(0).y)-(c(6).x, c(6).y)-(c(1).x, c(1).y), 0

_MapTriangle (0, 0)-(0, _Height(sb3))-(_Width(sb3), _Height(sb3)), sb3 To(c(0).x, c(0).y)-(c(2).x, c(2).y)-(c(1).x, c(1).y), 0

ftri c(0).x, c(0).y, c(6).x, c(6).y, c(1).x, c(1).y, &H99000000 ' dim face for shadow

ftri c(1).x, c(1).y, c(2).x, c(2).y, c(0).x, c(0).y, &H99000000



' left face

'map image

_MapTriangle (0, 0)-(_Width(sb2), 0)-(_Width(sb2), _Height(sb2)), sb2 To(c(4).x, c(4).y)-(c(0).x, c(0).y)-(c(2).x, c(2).y), 0

_MapTriangle (0, 0)-(0, _Height(sb2))-(_Width(sb2), _Height(sb2)), sb2 To(c(4).x, c(4).y)-(c(3).x, c(3).y)-(c(2).x, c(2).y), 0

ftri c(3).x, c(3).y, c(4).x, c(4).y, c(0).x, c(0).y, &H55000000

ftri c(3).x, c(3).y, c(2).x, c(2).y, c(0).x, c(0).y, &H55000000

Sleep



Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)

    Dim D As Long

    Static a&

    D = _Dest

    If a& = 0 Then a& = _NewImage(1, 1, 32)

    _Dest a&

    _DontBlend a& '  '<<<< new 2019-12-16 fix

    PSet (0, 0), K

    _Blend a& '<<<< new 2019-12-16 fix

    _Dest D

    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)

End Sub



'Þ  _MAPTRIANGLE [{_CLOCKWISE|_ANTICLOCKWISE}] [{_SEAMLESS}] (sx1, sy1)-(sx2, sy2)-(sx3, sy3), source& TO (dx1,

'Þ  dy1, dz1)-(dx2, dy2, dz2)-(dx3, dy3, dz3)[, destination&][{_SMOOTH|_SMOOTHSHRUNK|_SMOOTHSTRETCHED}]]

   

Code: (Select All)

Option _Explicit

_Title "T Cubed" ' b+ 2026-01-27



Type xy

    As Single x, y

End Type



Screen _NewImage(700, 700, 32)

_ScreenMove 300, 0



Dim As Long sb1, sb2, sb3

sb1 = _LoadImage("topFace.PNG") ' rev 3 PM horrible again only the top face is screwed up ???

sb2 = _LoadImage("rFace.PNG")

sb3 = _LoadImage("lFace.PNG")



' draw cube 3 faces showing

Dim c(0 To 6) As xy

Dim As Integer i

c(0).x = 350: c(0).y = 350

_PrintString (c(0).x - 4, c(0).y - 8), "0"

For i = 1 To 6

    c(i).x = 350 + 340 * Cos(i * _Pi / 3)

    c(i).y = 350 + 340 * Sin(i * _Pi / 3)

    Circle (c(i).x, c(i).y), 8

    _PrintString (c(i).x - 4, c(i).y - 8), _Trim$(Str$(i))

    'Sleep

Next

Cls



'top face

' map image top face

_MapTriangle (0, 0)-(_Width(sb1), 0)-(_Width(sb1), _Height(sb1)), sb1 To(c(4).x, c(4).y)-(c(5).x, c(5).y)-(c(6).x, c(6).y), 0

_MapTriangle (0, 0)-(0, _Height(sb1))-(_Width(sb1), _Height(sb1)), sb1 To(c(4).x, c(4).y)-(c(0).x, c(0).y)-(c(6).x, c(6).y), 0



'right face

' map image

_MapTriangle (0, 0)-(_Width(sb3), 0)-(_Width(sb3), _Height(sb3)), sb3 To(c(0).x, c(0).y)-(c(6).x, c(6).y)-(c(1).x, c(1).y), 0

_MapTriangle (0, 0)-(0, _Height(sb3))-(_Width(sb3), _Height(sb3)), sb3 To(c(0).x, c(0).y)-(c(2).x, c(2).y)-(c(1).x, c(1).y), 0

ftri c(0).x, c(0).y, c(6).x, c(6).y, c(1).x, c(1).y, &H99000000 ' dim face for shadow

ftri c(1).x, c(1).y, c(2).x, c(2).y, c(0).x, c(0).y, &H99000000



' left face

'map image

_MapTriangle (0, 0)-(_Width(sb2), 0)-(_Width(sb2), _Height(sb2)), sb2 To(c(4).x, c(4).y)-(c(0).x, c(0).y)-(c(2).x, c(2).y), 0

_MapTriangle (0, 0)-(0, _Height(sb2))-(_Width(sb2), _Height(sb2)), sb2 To(c(4).x, c(4).y)-(c(3).x, c(3).y)-(c(2).x, c(2).y), 0

ftri c(3).x, c(3).y, c(4).x, c(4).y, c(0).x, c(0).y, &H55000000

ftri c(3).x, c(3).y, c(2).x, c(2).y, c(0).x, c(0).y, &H55000000

Sleep



Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)

    Dim D As Long

    Static a&

    D = _Dest

    If a& = 0 Then a& = _NewImage(1, 1, 32)

    _Dest a&

    _DontBlend a& '  '<<<< new 2019-12-16 fix

    PSet (0, 0), K

    _Blend a& '<<<< new 2019-12-16 fix

    _Dest D

    _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)

End Sub



'Þ  _MAPTRIANGLE [{_CLOCKWISE|_ANTICLOCKWISE}] [{_SEAMLESS}] (sx1, sy1)-(sx2, sy2)-(sx3, sy3), source& TO (dx1,

'Þ  dy1, dz1)-(dx2, dy2, dz2)-(dx3, dy3, dz3)[, destination&][{_SMOOTH|_SMOOTHSHRUNK|_SMOOTHSTRETCHED}]]

   

zips for source and images: