06-19-2022, 01:09 AM
Hi Ken,
No rules just get the screen saver looking like that guy's in video and enjoy your time trying.
Probably get a thumbs up for being first. Rho Sigma almost has it in an old screen saver he had called Splines, check out his "ScreenBlankers"
Here is a copy:
Looks kind of long and complicated, so thumbs up if can do something about that ;-))
No rules just get the screen saver looking like that guy's in video and enjoy your time trying.
Probably get a thumbs up for being first. Rho Sigma almost has it in an old screen saver he had called Splines, check out his "ScreenBlankers"
Here is a copy:
Code: (Select All)
'+---------------+---------------------------------------------------+
'| ###### ###### | .--. . .-. |
'| ## ## ## # | | )| ( ) o |
'| ## ## ## | |--' |--. .-. `-. . .-...--.--. .-. |
'| ###### ## | | \ | |( )( ) | ( || | |( ) |
'| ## ## | ' `' `-`-' `-'-' `-`-`|' ' `-`-'`- |
'| ## ## # | ._.' |
'| ## ###### | Sources & Documents placed in the Public Domain. |
'+---------------+---------------------------------------------------+
'| |
'| === Splines.bas === |
'| |
'| == Similar to the Mystify screen blanker, but adds Splines. |
'| |
'+-------------------------------------------------------------------+
'| Done by RhoSigma, R.Heyder, provided AS IS, use at your own risk. |
'| Find me in the QB64 Forum or mail to support@rhosigma-cw.net for |
'| any questions or suggestions. Thanx for your interest in my work. |
'+-------------------------------------------------------------------+
Dim Shared scrw%, scrh%
di& = _ScreenImage
scrw% = _Width(di&)
scrh% = _Height(di&)
_FreeImage di&
si& = _NewImage(scrw%, scrh%, 256)
Screen si&
_Delay 0.2: _ScreenMove _Middle
_Delay 0.2: _FullScreen
Const MAX_LINES = 30 'at least 1 !!!
Const MAX_POINTS = 20 'at least 16 !!!
Const ANIM_INTERVAL = 15 'change anim type every n seconds
Dim Shared storex%(MAX_LINES - 1, MAX_POINTS - 1)
Dim Shared storey%(MAX_LINES - 1, MAX_POINTS - 1)
Dim Shared ptr%, eptr%
Dim Shared numLines%, mdelta%, maxLines%
mdelta% = -1: maxLines% = MAX_LINES \ 2
Dim Shared maxPoints%
Dim Shared dx%(MAX_POINTS - 1), dy%(MAX_POINTS - 1)
Dim Shared ox%(MAX_POINTS - 1), oy%(MAX_POINTS - 1)
Dim Shared nx%(MAX_POINTS - 1), ny%(MAX_POINTS - 1)
Dim Shared dr%, dg%, db%
Dim Shared nr%, ng%, nb%
Dim Shared animTimeout%
Dim Shared closed%
Dim Shared nextlegal$(9)
nextlegal$(0) = "01458": nextlegal$(1) = "236": nextlegal$(2) = "01458"
nextlegal$(3) = "236": nextlegal$(4) = "01458": nextlegal$(5) = "23"
nextlegal$(6) = "01458": nextlegal$(7) = "": nextlegal$(8) = "0145"
nextlegal$(9) = ""
Dim Shared advval%(9)
advval%(0) = 3: advval%(1) = 2: advval%(2) = 3: advval%(3) = 2: advval%(4) = 1
advval%(5) = 0: advval%(6) = 1: advval%(7) = 0: advval%(8) = 1: advval%(9) = 0
Dim Shared realfunc%(13)
Dim Shared sp&
sp& = 1000
Dim Shared stack&(sp& - 1)
Dim Shared oldx&, oldy&
Randomize Timer
animTimeout% = 0
Color 1
MakeFunc
StartLines
Colors
_MouseHide
On Timer(1) GoSub raiseTimeout
Timer On
While InKey$ = "" And mx% = 0 And my% = 0
AdvanceLines
DrawNew
Colors
If animTimeout% >= ANIM_INTERVAL Then
Randomize Timer
animTimeout% = 0
MakeFunc
Cls
StartLines
End If
_Limit 60
_Display
Do While _MouseInput
mx% = mx% + _MouseMovementX
my% = my% + _MouseMovementY
Loop
Wend
Timer Off
_FullScreen _Off
_Delay 0.2: Screen 0
_Delay 0.2: _FreeImage si&
System
raiseTimeout:
animTimeout% = animTimeout% + 1
Return
'======================================================================
Sub StartLines
ptr% = 0
eptr% = 0
numLines% = 0
If dx%(0) = 0 Then
For i% = 0 To MAX_POINTS - 1
ox%(i%) = RangeRand%(0, scrw% - 1)
oy%(i%) = RangeRand%(0, scrh% - 1)
dx%(i%) = RangeRand%(4, 7)
dy%(i%) = RangeRand%(4, 7)
Next i%
End If
nr% = 53
ng% = 33
nb% = 35
dr% = -3
dg% = 5
db% = 7
_PaletteColor 1, _RGB32(nr%, ng%, nb%)
For i% = 0 To maxLines% - 1
AdvanceLines
DrawNew
Next i%
End Sub
'======================================================================
Sub AdvanceLines
For i% = 0 To maxPoints% - 1
Adv ox%(i%), dx%(i%), nx%(i%), scrw%
Adv oy%(i%), dy%(i%), ny%(i%), scrh%
Next i%
End Sub
'======================================================================
Sub DrawNew
While numLines% >= maxLines%
Color 0
bptr% = eptr%
DrawFunc bptr%
Color 1
numLines% = numLines% - 1
bptr% = bptr% + 1
If bptr% = MAX_LINES Then bptr% = 0
eptr% = bptr%
Wend
bptr% = ptr%
For i% = 0 To maxPoints% - 1
ox%(i%) = nx%(i%)
storex%(bptr%, i%) = ox%(i%)
oy%(i%) = ny%(i%)
storey%(bptr%, i%) = oy%(i%)
Next i%
DrawFunc bptr%
numLines% = numLines% + 1
bptr% = bptr% + 1
If bptr% = MAX_LINES Then
bptr% = 0
If mdelta% = 1 Then
maxLines% = maxLines% + 1
If maxLines% >= MAX_LINES - 1 Then mdelta% = -1
Else
maxLines% = maxLines% - 1
If maxLines% <= 2 Then mdelta% = 1
End If
End If
ptr% = bptr%
End Sub
'======================================================================
Sub MakeFunc
closed% = RangeRand%(0, 3)
Select Case closed%
Case 3: closed% = 2: goallen% = RangeRand%(3, 6)
Case 2: goallen% = RangeRand%(3, 6)
Case 1: goallen% = RangeRand%(4, 10)
Case 0: goallen% = RangeRand%(2, 9)
End Select
Do
If closed% = 0 Then nextpossib$ = "0145": Else nextpossib$ = "0123456"
sofar% = 0: p% = 0
While sofar% < goallen%
i% = Asc(Mid$(nextpossib$, RangeRand%(1, Len(nextpossib$)), 1)) - 48
realfunc%(p%) = i%
p% = p% + 1
nextpossib$ = nextlegal$(i%)
sofar% = sofar% + advval%(i%)
Wend
If sofar% = goallen% Then
If closed% = 0 Then
If Left$(nextpossib$, 1) = "0" Then Exit Do
Else
If (Left$(nextpossib$, 1) = "0") Or (realfunc%(0) < 4) Or (realfunc%(p% - 1) < 4) Then
If ((Left$(nextpossib$, 1) = "0") And ((realfunc%(0) And 2) <> 0)) Or ((Left$(nextpossib$, 1) <> "0") And ((realfunc%(0) And 2) = 0)) Then
If realfunc%(0) <> 5 Then
realfunc%(0) = realfunc%(0) ^ 2
Exit Do
End If
Else
Exit Do
End If
End If
End If
End If
Loop
realfunc%(p%) = 100
maxPoints% = goallen%
Select Case closed%
Case 2
For i% = 0 To p% - 1
realfunc%(p% + i%) = realfunc%(i%)
Next i%
realfunc%(p% + i%) = 100
Case 0
maxPoints% = maxPoints% + 1
End Select
End Sub
'======================================================================
Sub DrawFunc (bptr%)
Select Case closed%
Case 2
For i% = 0 To maxPoints% - 1
storex%(bptr%, maxPoints% + i%) = scrw% - 1 - storex%(bptr%, i%)
storey%(bptr%, maxPoints% + i%) = scrh% - 1 - storey%(bptr%, i%)
Next i%
GoSub setup
Case 1
i% = 0
GoSub setup
End Select
p% = 0: i% = 0
While realfunc%(p%) < 10
Select Case realfunc%(p%)
Case 0: DrawSF bptr%, i%
Case 1: DrawS_F bptr%, i%
Case 2: Draw_SF bptr%, i%
Case 3: Draw_S_F bptr%, i%
Case 4: DrawLF bptr%, i%
Case 5: DrawL_F bptr%, i%
Case 6: Draw_LF bptr%, i%
End Select
i% = i% + advval%(realfunc%(p%))
p% = p% + 1
Wend
If p% = 0 Then animTimeout% = ANIM_INTERVAL 'skip null random loop
Exit Sub
setup:
storex%(bptr%, maxPoints% + i%) = storex%(bptr%, 0)
storey%(bptr%, maxPoints% + i%) = storey%(bptr%, 0)
storex%(bptr%, maxPoints% + i% + 1) = storex%(bptr%, 1)
storey%(bptr%, maxPoints% + i% + 1) = storey%(bptr%, 1)
Return
End Sub
'======================================================================
Sub DrawSF (l%, p%)
oldx& = storex%(l%, p% + 0)
oldy& = storey%(l%, p% + 0)
DrawSpline storex%(l%, p%+0) * 128, storey%(l%, p%+0) * 128,_
storex%(l%, p%+1) * 128, storey%(l%, p%+1) * 128,_
storex%(l%, p%+2) * 128, storey%(l%, p%+2) * 128,_
storex%(l%, p%+3) * 128, storey%(l%, p%+3) * 128
End Sub
'======================================================================
Sub DrawS_F (l%, p%)
oldx& = storex%(l%, p% + 0)
oldy& = storey%(l%, p% + 0)
DrawSpline storex%(l%, p%+0) * 128, storey%(l%, p%+0) * 128,_
storex%(l%, p%+1) * 128, storey%(l%, p%+1) * 128,_
storex%(l%, p%+2) * 128, storey%(l%, p%+2) * 128,_
((storex%(l%, p%+2) + storex%(l%, p%+3)) \ 2) * 128,_
((storey%(l%, p%+2) + storey%(l%, p%+3)) \ 2) * 128
End Sub
'======================================================================
Sub Draw_SF (l%, p%)
oldx& = (storex%(l%, p% + 0) + storex%(l%, p% + 1)) \ 2
oldy& = (storey%(l%, p% + 0) + storey%(l%, p% + 1)) \ 2
DrawSpline oldx& * 128, oldy& * 128,_
storex%(l%, p%+1) * 128, storey%(l%, p%+1) * 128,_
storex%(l%, p%+2) * 128, storey%(l%, p%+2) * 128,_
storex%(l%, p%+3) * 128, storey%(l%, p%+3) * 128
End Sub
'======================================================================
Sub Draw_S_F (l%, p%)
oldx& = (storex%(l%, p% + 0) + storex%(l%, p% + 1)) \ 2
oldy& = (storey%(l%, p% + 0) + storey%(l%, p% + 1)) \ 2
DrawSpline oldx& * 128, oldy& * 128,_
storex%(l%, p%+1) * 128, storey%(l%, p%+1) * 128,_
storex%(l%, p%+2) * 128, storey%(l%, p%+2) * 128,_
((storex%(l%, p%+2) + storex%(l%, p%+3)) \ 2) * 128,_
((storey%(l%, p%+2) + storey%(l%, p%+3)) \ 2) * 128
End Sub
'======================================================================
Sub DrawLF (l%, p%)
PSet (storex%(l%, p% + 0), storey%(l%, p% + 0))
Line -(storex%(l%, p% + 1), storey%(l%, p% + 1))
End Sub
'======================================================================
Sub DrawL_F (l%, p%)
PSet (storex%(l%, p% + 0), storey%(l%, p% + 0))
LINE -((storex%(l%, p%+0) + storex%(l%, p%+1)) \ 2,_
(storey%(l%, p%+0) + storey%(l%, p%+1)) \ 2)
End Sub
'======================================================================
Sub Draw_LF (l%, p%)
PSET ((storex%(l%, p%+0) + storex%(l%, p%+1)) \ 2,_
(storey%(l%, p%+0) + storey%(l%, p%+1)) \ 2)
Line -(storex%(l%, p% + 1), storey%(l%, p% + 1))
End Sub
'======================================================================
Sub Colors
ar% = nr%
ag% = ng%
ab% = nb%
Adv ar%, dr%, nr%, 240
Adv ag%, dg%, ng%, 240
Adv ab%, db%, nb%, 240
_PaletteColor 1, _RGB32(nr%, ng%, nb%)
End Sub
'======================================================================
Sub Adv (a%, d%, n%, w%)
n% = a% + d%
If n% < 0 Then
n% = 0
d% = RangeRand%(1, 6)
ElseIf n% >= w% Then
n% = w% - 1
d% = RangeRand%(-6, -1)
End If
End Sub
'======================================================================
Sub DrawSpline (x1&, y1&, x2&, y2&, x3&, y3&, x4&, y4&)
PSet (oldx&, oldy&) 'move to start point
GoSub rspline
Exit Sub
'line by line convert from Motorola 68k assembler
'a0-a7 -> 32 bits long address registers (a7 = sp)
'd0-d7 -> 32 bits long data registers
'Inputs:
'a0 AS LONG x1, a1 AS LONG y1
'a2 AS LONG x2, a3 AS LONG y2
'a5 AS LONG x3, a6 AS LONG y3
'd6 AS LONG x4, d7 AS LONG y4
rspline:
d0& = x1& ' move.l a0,d0
d0& = d0& - x4& ' sub.l d6,d0
d3& = d0& ' move.l d0,d3
If d0& >= 0 GoTo save1 ' bpl.s save1
d0& = -d0& ' neg.l d0
save1:
d1& = y1& ' move.l a1,d1
d1& = d1& - y4& ' sub.l d7,d1
d4& = d1& ' move.l d1,d4
If d1& >= 0 GoTo save2 ' bpl.s save2
d1& = -d1& ' neg.l d1
save2:
d2& = d0& ' move.l d0,d2
tmp& = d1& - d0& ' cmp.l d0,d1
If tmp& < 0 GoTo save3 ' bmi.s save3
d2& = (d2& \ 8) And &H1FFFFFFF~& ' lsr.l #3,d2
GoTo save9 ' bra.s save9
save3:
d1& = (d1& \ 8) And &H1FFFFFFF~& ' lsr.l #3,d1
save9:
d2& = d2& + d1& ' add.l d1,d2
d2& = d2& \ 8 ' asr.l #3,d2
If d2& = 0 GoTo check2 ' beq.s check2
d3& = d3& \ 32 ' asr.l #5,d3
d4& = d4& \ 32 ' asr.l #5,d4
d0& = x2& ' move.l a2,d0
d0& = d0& - x1& ' sub.l a0,d0
d1& = y2& ' move.l a3,d1
d1& = d1& - y1& ' sub.l a1,d1
d0& = d0& \ 32 ' asr.l #5,d0
d1& = d1& \ 32 ' asr.l #5,d1
d0& = (d0& And &HFFFF~&) * (d4& And &HFFFF~&) ' muls.w d4,d0
d1& = (d1& And &HFFFF~&) * (d3& And &HFFFF~&) ' muls.w d3,d1
d0& = d0& - d1& ' sub.l d1,d0
If d0& >= 0 GoTo save4 ' bpl.s save4
d0& = -d0& ' neg.l d0
save4:
tmp& = d2& - d0& ' cmp.l d0,d2
If tmp& <= 0 GoTo pushem ' ble.s pushem
d0& = x3& ' move.l a5,d0
d0& = d0& - x1& ' sub.l a0,d0
d1& = y3& ' move.l a6,d1
d1& = d1& - y1& ' sub.l a1,d1
d0& = d0& \ 32 ' asr.l #5,d0
d1& = d1& \ 32 ' asr.l #5,d1
d0& = (d0& And &HFFFF~&) * (d4& And &HFFFF~&) ' muls.w d4,d0
d1& = (d1& And &HFFFF~&) * (d3& And &HFFFF~&) ' muls.w d3,d1
d0& = d0& - d1& ' sub.l d1,d0
If d0& >= 0 GoTo save5 ' bpl.s save5
d0& = -d0& ' neg.l d0
save5:
tmp& = d2& - d0& ' cmp.l d0,d2
If tmp& <= 0 GoTo pushem ' ble.s pushem
makeline:
y4& = (y4& \ 128) And &H01FFFFFF~& ' lsr.l #7,d7
d1& = y4& ' move.l d7,d1
x4& = (x4& \ 128) And &H01FFFFFF~& ' lsr.l #7,d6
d0& = x4& ' move.l d6,d0
oldx& = d0& ' move.l d0,_oldx
oldy& = d1& ' move.l d1,_oldy
Line -(d0&, d1&) ' jsr _LVODraw
Return ' rts
check2:
d0& = x1& ' move.l a0,d0
d0& = d0& - x2& ' sub.l a2,d0
If d0& >= 0 GoTo ch1 ' bpl.s ch1
d0& = -d0& ' neg.l d0
ch1:
d1& = y1& ' move.l a1,d1
d1& = d1& - y2& ' sub.l a3,d1
If d1& >= 0 GoTo ch2 ' bpl.s ch2
d1& = -d1& ' neg.l d1
ch2:
d1& = d1& + d0& ' add.l d0,d1
d1& = d1& \ 8 ' asr.l #3,d1
If d1& <> 0 GoTo pushem ' bne.s pushem
d0& = x1& ' move.l a0,d0
d0& = d0& - x3& ' sub.l a5,d0
If d0& >= 0 GoTo ch3 ' bpl.s ch3
d0& = -d0& ' neg.l d0
ch3:
d1& = y1& ' move.l a1,d1
d1& = d1& - y3& ' sub.l a6,d1
If d1& >= 0 GoTo ch4 ' bpl.s ch4
d1& = -d1& ' neg.l d1
ch4:
d1& = d1& + d0& ' add.l d0,d1
d1& = d1& \ 8 ' asr.l #3,d1
If d1& = 0 GoTo makeline ' beq.s makeline
pushem:
sp& = sp& - 2: stack&(sp&) = x4&: stack&(sp& + 1) = y4& 'movem.l d6/d7,-(sp)
d0& = x3& ' move.l a5,d0
d0& = d0& + x4& ' add.l d6,d0
d0& = d0& \ 2 ' asr.l #1,d0
d1& = y3& ' move.l a6,d1
d1& = d1& + y4& ' add.l d7,d1
d1& = d1& \ 2 ' asr.l #1,d1
sp& = sp& - 2: stack&(sp&) = d0&: stack&(sp& + 1) = d1& 'movem.l d0/d1,-(sp)
d2& = x2& ' move.l a2,d2
d2& = d2& + x3& ' add.l a5,d2
d2& = d2& \ 2 ' asr.l #1,d2
d3& = y2& ' move.l a3,d3
d3& = d3& + y3& ' add.l a6,d3
d3& = d3& \ 2 ' asr.l #1,d3
d4& = d0& ' move.l d0,d4
d4& = d4& + d2& ' add.l d2,d4
d4& = d4& \ 2 ' asr.l #1,d4
d5& = d1& ' move.l d1,d5
d5& = d5& + d3& ' add.l d3,d5
d5& = d5& \ 2 ' asr.l #1,d5
sp& = sp& - 2: stack&(sp&) = d4&: stack&(sp& + 1) = d5& 'movem.l d4/d5,-(sp)
x4& = x1& ' move.l a0,d6
x4& = x4& + x2& ' add.l a2,d6
x4& = x4& \ 2 ' asr.l #1,d6
y4& = y1& ' move.l a1,d7
y4& = y4& + y2& ' add.l a3,d7
y4& = y4& \ 2 ' asr.l #1,d7
d0& = d2& ' move.l d2,d0
d0& = d0& + x4& ' add.l d6,d0
d0& = d0& \ 2 ' asr.l #1,d0
d1& = d3& ' move.l d3,d1
d1& = d1& + y4& ' add.l d7,d1
d1& = d1& \ 2 ' asr.l #1,d1
x2& = x4& ' move.l d6,a2
y2& = y4& ' move.l d7,a3
x4& = d0& ' move.l d0,d6
x4& = x4& + d4& ' add.l d4,d6
x4& = x4& \ 2 ' asr.l #1,d6
y4& = d1& ' move.l d1,d7
y4& = y4& + d5& ' add.l d5,d7
y4& = y4& \ 2 ' asr.l #1,d7
sp& = sp& - 2: stack&(sp&) = x4&: stack&(sp& + 1) = y4& 'movem.l d6/d7,-(sp)
x3& = d0& ' move.l d0,a5
y3& = d1& ' move.l d1,a6
GoSub rspline ' bsr rspline
x1& = stack&(sp&): y1& = stack&(sp& + 1): sp& = sp& + 2 'movem.l (sp)+,a0/a1
x2& = stack&(sp&): y2& = stack&(sp& + 1): sp& = sp& + 2 'movem.l (sp)+,a2/a3
x3& = stack&(sp&): y3& = stack&(sp& + 1): sp& = sp& + 2 'movem.l (sp)+,a5/a6
x4& = stack&(sp&): y4& = stack&(sp& + 1): sp& = sp& + 2 'movem.l (sp)+,d6/d7
GoTo rspline ' bra rspline
End Sub
'======================================================================
Function RangeRand% (low%, high%)
RangeRand% = Int(Rnd(1) * (high% - low% + 1)) + low%
End FunctionLooks kind of long and complicated, so thumbs up if can do something about that ;-))
b = b + ...