Random Dot Stereogram

[kay63]

Code Select Expand


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]

Cool!

[Derron]

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