January 19, 2021, 08:13:36 PM

### Author Topic: Random Dot Stereogram  (Read 554 times)

#### kay63

• Jr. Member
• Posts: 1
##### Random Dot Stereogram
« on: May 09, 2020, 12:21:36 AM »
Code: [Select]
REM created: 08/05/2020
REM SmallBASIC Random Dot Stereogram Sphere
REM by kay63
a\$="Love the Planet ":th=txth(a\$):tw=txtw(a\$):'=== Text to Pix
dim pix(tw+2,th)
color 15: print a\$
'rect 0,0,tw+2,th:' === frame?
for x=0 to tw+2
for y=0 to th
pix(x,y)=point(x,y)
pset x+2*tw,y,pix(x,y)
next y
next x
s=0: rap=int(xmax/10):' ======= Raport ========
'goto lefts:' jump over random dots
'
repeat :' === gray Stripe
x=int(rnd*rap): y=int(rnd*(ymax+1))
if point(x,y)=0 then s+=1
pset x,y,15
until s>ymax*rap/2:'=== => 50% white

for I =1 to rap*5:'=== colored spots
paint rnd*(rap-30)+10,rnd*(ymax-20)+10,rnd*7+8
next i

label lefts:
' h = rap is background, rap*.75 is foreground, k=radius sphere, r=running radius
xm=xmax/2: ym=ymax/2: k=ym/1.8: yh=ym*.8: xh=xm*.7 :' === center left sphere
if ymax> xmax then k=xm/2.3
'goto rights:'=== jump over left sphere
for x=rap to int(xm*1.1)
x1=(x-xh)^2
for y=0 to ymax
y1=(y-yh)^2
h=rap
r=sqr(x1+y1)
if r<k then
h=rap-sqr(k^2-x1-y1)/k*rap/4 :' konvex left sphere
endif
pixel=0
if x>(xh*.7) and x<(xh*1.3) and y>(ymax*.7) and y<(ymax*.98) then
pixel =pix((x-xh*.71)/xh/.59*tw*.22+(tw*.32),((y-ymax*.7)/ymax/.25*th))
h *= 1.03
endif
if pixel<>0 then h *= .98:'=== text on bottom left (the)
pset x,y,point(x-h,y):' === 3d
'pset x,y,(rap-h+6)/rap*3.5*16:'=== colored circles to check position
next y
next x

label rights:
xh=xm*1.5 :' === center right sphere
for x=int(xm*1.1)+1 to xmax+1
x1=(x-xm*1.5)^2
for y=0 to ymax
y1=(Y-yh)^2
h=rap: ' === background
r=sqr(x1+y1):pixel=0
if x>(xh-k*.75) and x<(xh+k*.75) and y>(yh-k*.45) and y<(yh+k*.45) then
pixel = pix((x-(xh-k*.8))/2/(k*.9)*(tw/3.2),(y-(yh-k/1.8))/k*th)
'===text in deep right sphere
endif
if x>(xh*.78) and x<(xh*1.27) and y>(ymax*.7) and y<(ymax*.98) then
pixel =pix((x-xh*.78)/xh/.51*tw*.45+(tw*.55),((y-ymax*.7)/ymax/.25*th))
'===text bottom right
endif
if r<k then h += sqr(k^2-x1-y1)/k*rap/4 :' konkav right sphere
if pixel <> 0 and y< (yh+k) then h *= .96 :' === text deep in sphere (Love)
if pixel <> 0 and y> (yh+k) then h *= .97 :' === text on bottom right (Planet)
pset x,y,point(x-h,y):' === 3d
'pset x,y,(rap/4*5-h)/rap*4*14:'=== colored circles to check position
next y
next x
pause

#### bplus

• Full Member
• Posts: 151
##### Re: Random Dot Stereogram
« Reply #1 on: May 09, 2020, 04:01:15 PM »
Cool!

#### Derron

• Hero Member
• Posts: 3332
##### Re: Random Dot Stereogram
« Reply #2 on: May 09, 2020, 11:47:06 PM »
Had to try for 10 seconds to get my eyes back to the 90s where I was used to look at these pictures.

Nice job!

bye
Ron