(09-15-2024, 02:44 PM)madscijr Wrote: You must be reading this on a Braille computer display (I imagine those must really exist?)
Yes they do and have existed for a very long time. Back in the early 90's when I was a computer tech I serviced a blind person's system at a local bank. He was a loan officer. He used a combination of a Braille display and optical hand held screen reader. The Braille display would bring up a line of text as he panned the optical reader over the CRT. It was quite cumbersome to use but he made it work. I imagine today's systems are much more sophisticated.
It's amazing how we can solve problems to get over limitations.
(If only we as a species can apply that to finally end war, starvation, homelessness, violence, renewable energy, the mess that they're calling politics and news these days, and Microsoft's constant attempts to ruin Windows, etc.!)
At work we have to make sure our Web site is accessible to the handicapped and comply to a bunch of such standards called A11y. This includes things like formatting text to be compatible with screen reader software, using color palettes that accomodate the color blind, and making sure all diagrams and images include descriptive captions & alt text for those who can't see them!
do
mx = _mousex
my = _mousey
mb = _mousebutton(1)
zoom = zoom - 10*_mousewheel
loop while _mouseinput
cls
s = 0
for v=-2*pi to 2*pi step dv
s = s xor 1
for u=-3*pi to 3*pi step du
s = s xor 1
nx = sin(v)
ny = -cos(v)
nz = u
roty a
rotx b
'parallel
sx = -1
sy = -sx/0.707
sz = -0.707*sy
'perspective
sx = 0
sy = -1
sz = 0
'if (nx*sx + ny*sy + nz*sz) < 0 then
f u, v
proj
x1 = sw/2 + zoom*p
y1 = sh/2 - zoom*q
'pset (x1, y1)
f u + du, v
proj
x2 = sw/2 + zoom*p
y2 = sh/2 - zoom*q
'line -(x2, y2)
f u + du, v + dv
proj
x3 = sw/2 + zoom*p
y3 = sh/2 - zoom*q
'line -(x3, y3)
f u, v + dv
proj
x4 = sw/2 + zoom*p
y4 = sh/2 - zoom*q
'line -(x4, y4)
'line -(x1, y1)
if s then
c = 255 '- 20*y
FillTriangle x1,y1, x2,y2, x3,y3, _rgb(c,c,c)
FillTriangle x3,y3, x4,y4, x1,y1, _rgb(c,c,c)
else
FillTriangle x1,y1, x2,y2, x3,y3, _rgb(0,0,0)
FillTriangle x3,y3, x4,y4, x1,y1, _rgb(0,0,0)
end if
'end if
next
next
_limit 30
_display
loop until _keyhit = 27
sleep
system
sub f(u, v)
x = u*cos(v*t + tt)
y = u*sin(v*t + tt)
z = v
sub proj
'parallel
'p = x + 0.707*y
'q = z + 0.707*y
roty a
rotx b
p = x*10/(10 + y)
q = z*10/(10 + y)
end sub
sub rotx(u)
xx = x
yy = y*cos(u) - z*sin(u)
zz = y*sin(u) + z*cos(u)
x = xx
y = yy
z = zz
end sub
sub roty(u)
xx = x*cos(u) + z*sin(u)
yy = y
zz =-x*sin(u) + z*cos(u)
x = xx
y = yy
z = zz
end sub
sub rotz(u)
xx = x*cos(u) - y*sin(u)
yy = x*sin(u) + y*cos(u)
zz = z
x = xx
y = yy
z = zz
end sub
Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Static a&, m As _MEM
If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
_MemPut m, m.OFFSET, K
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
+1 @vince I hope you collect these mods and post in easy to find space here at this forum, hmm.. where might that be? They are lovely (including ones at JB).
Anybody tried reversing the direction, to create a "black hole"?
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, W.A.)
Please visit my Website at: http://oldendayskids.blogspot.com/
Nobody seems to have tried to do his problem, so I did. Here's mine:
Code: (Select All)
Option _Explicit
'$Let SINGLECOLOR = 1
$Let COLOR = 0
_Title "Time Tunnel Demo - Press ESC to exit."
' Simulation of the "Time Tunnel" visual effect from the 1960s show of the same name
' Paul Robinson 2024-09-20
Dim s&, centerW&, centerH&, mode&
Dim As Double T1, T2
Dim As _Unsigned _Byte Red, Gray, Yellow, Pink, Green, Blue, Black, White, Brown, Teal, Purple, Violet
Dim As _Unsigned _Byte Color1, Color2, OnColor, OffColor, LoopCount
Dim As Long I, J, K, sw, sh
sw = 1024
sh = 768
' On color is the band started
OnColor = Black 'Green
' Off color is the contrast
OffColor = White 'Yellow
s& = _NewImage(sw, sh, 32)
Screen s&
centerW& = _Width(mode&) \ 2 'returns pixels in graphic modes
centerH& = _Height(mode&) \ 2 'returns pixels in graphic modes
K = 1
Do
If K Mod 2 Then
$If COLOR = DEFINED Then
Color1 = OnColor
Color2 = OffColor
$Else
Color1 = 255 ' Black & White
Color2 = 0
$End If
Else
$If COLOR = DEFINED Then
Color1 = OffColor
Color2 = OnColor
$Else
Color1 = 0
Color2 = 255
$End If
End If
For I = 1 To 12
If I Mod 2 Then
For J = 1 To 50
$If COLOR = DEFINED Then
Circle (centerW&, centerH&), I * 50 + J, _RGB(ColorTable(Color1, 1), ColorTable(Color1, 2), ColorTable(Color1, 3)), , , 1
$Else
Circle (centerW&, centerH&), I * 50 + J, _RGB(Color1, Color1, Color1), , , 1
$End If
' Circle (centerW&, centerH&), I * 50 + J - 1, _RGB(255, 0, 0), , , 1
Next J
Else
For J = 1 To 50
$If COLOR = DEFINED Then
Circle (centerW&, centerH&), I * 50 + J + 1, _RGB(ColorTable(Color1, 1), ColorTable(Color1, 2), ColorTable(Color1, 3)), , , 1
$Else
Circle (centerW&, centerH&), I * 50 + J + 1, _RGB(Color2, Color2, Color2), , , 1
$End If
T2 = 0
T1 = Timer(.001)
Do While T2 < T1 + .01
T2 = Timer(.001)
Loop
$If COLOR = DEFINED Then
Circle (centerW&, centerH&), I * 50 + J, _RGB(ColorTable(Color2, 1), ColorTable(Color2, 2), ColorTable(Color2, 3)), , , 1
$Else
Circle (centerW&, centerH&), I * 50 + J, _RGB(Color2, Color2, Color2), , , 1
$End If
Next
End If
Next I
T2 = 0
T1 = Timer(.001)
Do While T2 < T1 + .3 ' Short delay
T2 = Timer(.001)
Loop
If InKey$ = Chr$(27) Then End
K = K + 1
Loop
Sub InitColortable (Colorindex%, RedValue%, BlueValue%, GreenValue%)
ColorTable(Colorindex%, 1) = RedValue%
ColorTable(Colorindex%, 2) = BlueValue%
ColorTable(Colorindex%, 3) = GreenValue%
End Sub
A copy is attached so it may be downloaded.
While 1
Fix Bugs
report all bugs fixed
receive bug report
end while
(09-20-2024, 08:51 PM)TDarcos Wrote: Nobody seems to have tried to do his problem, so I did. Here's mine:
...
A copy is attached so it may be downloaded.
Hey, thanks for noticing! LOL
It's a good start - I wonder if it can be sped up and the motion made more smooth?
I'll give the code a look in a bit and see what I can come up with.
