01-13-2026, 12:51 AM (This post was last modified: 01-13-2026, 03:07 AM by bplus.)
Simpler Mystic 3 try image
This code, screenshot and zip have been updated 2 hours after original post. I wanted to keep in spirit of Mystic with the multiple frames fading.
Code: (Select All)
t$ = "Simpler Mystic 3 try image d = double on/off, q = 4 on/off,"
t$ = t$ + " spacebar resets color, m = more, l = less, n = new Poly, f = faster,"
t$ = t$ + " s = slower": _Title t$
_Title t$
' 2026-01-10 attempt to do Mystic with only one Poly and fades
' 2026-01-11 add number of points option from 1 to 9 points, one aint much but...
' 2026-01-12 Simpler Mystic 3 now try an image using a 4 point Poly
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! KEY Instructions !!!!!!!!!!!!!!!!!!!
' d = double ie 2 sets of Polys
' q = quad ie 4 sets of Polys
' f = faster s = slower
' m = more, l = less image Polys
' n = new Poly
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Const xmax = 1280, ymax = 720
Dim Shared pR, pG, pB, cN, NPm1, Img
Randomize Timer: Screen _NewImage(xmax, ymax, 32): _ScreenMove 0, 10
I$ = "Doyle Spirals.PNG" ' <<<<<<<<<<<< OR try your own image here!
Img = _LoadImage(I$, 32)
If Img = -1 Then Print "Image did not load, so sorry, goodbye!": End
_ClearColor &HFF000000, Img
np = 4: NPm1 = np - 1
ReDim Shared X(NPm1), Y(NPm1), DX(NPm1), DY(NPm1), dMode, qMode
dMode = 0: alpha = 35: lim = 10
resetPlasma: newPoly
While _KeyDown(27) = 0
Line (0, 0)-(xmax, ymax), _RGB32(0, 0, 0, alpha), BF
updatePoly
Color &HFFFFFFFF
Locate 1, 1
If qMode Then
Print " Mode: 4 Symmetric Sets",
ElseIf dMode Then
Print " Mode: 2 Symmetric Sets",
Else
Print "Mode: 1 Poly Set",
End If
Print " alpha:"; alpha, "speed:"; lim
_Display
k$ = InKey$
If k$ = "d" Then
Cls: dMode = Not dMode: qMode = 0
ElseIf k$ = "q" Then
Cls: qMode = Not qMode: dMode = 0
ElseIf k$ = "f" Then
lim = lim + 5: If lim > 120 Then lim = 120
ElseIf k$ = "s" Then
lim = lim - 5: If lim < 5 Then lim = 5
ElseIf k$ = "m" Then ' less alpha shows more triantgles
alpha = alpha - 1: If alpha < 1 Then alpha = 1
ElseIf k$ = "l" Then ' more alpha shows less Polys
alpha = alpha + 1: If alpha > 255 Then alpha = 255 ' one Poly
ElseIf k$ = "n" Then
Cls: newPoly
End If
_Limit lim
Wend
Sub newPoly
For I = 0 To NPm1
X(I) = Rnd * xmax: Y(I) = Rnd * ymax: DX(I) = (Rnd * 10 + 10) * rdir: DY(I) = (Rnd * 6 + 10) * rdir
Next
End Sub
Sub updatePoly
changePlasma
For I = 0 To NPm1
If X(I) + DX(I) < 0 Or X(I) + DX(I) >= xmax Then DX(I) = DX(I) * -1
If Y(I) + DY(I) < 0 Or Y(I) + DY(I) >= ymax Then DY(I) = DY(I) * -1
X(I) = X(I) + DX(I): Y(I) = Y(I) + DY(I)
Next
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(X(0), Y(0))-(X(1), Y(1))-(X(2), Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(X(2), Y(2))-(X(3), Y(3))-(X(0), Y(0)), 0
If dMode Then
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(xmax - X(0), ymax - Y(0))-(xmax - X(1), ymax - Y(1))-(xmax - X(2), ymax - Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(xmax - X(2), ymax - Y(2))-(xmax - X(3), ymax - Y(3))-(xmax - X(0), ymax - Y(0)), 0
ElseIf qMode Then
_MapTriangle (0, 0)-(_Width(Img) - 1, 0)-(_Width(Img) - 1, _Height(Img) - 1), Img To(xmax - X(0), ymax - Y(0))-(xmax - X(1), ymax - Y(1))-(xmax - X(2), ymax - Y(2)), 0
_MapTriangle (_Width(Img) - 1, _Height(Img) - 1)-(0, _Height(Img) - 1)-(0, 0), Img To(xmax - X(2), ymax - Y(2))-(xmax - X(3), ymax - Y(3))-(xmax - X(0), ymax - Y(0)), 0
