' **** Atari SIRDS program v2.0 ****
'    routine from the SIRDS FAQ
'
' read *.red (raw) file into thedepth array
' write *.tga file out of thesird array
'
bkdepth%=-800             ! depth of background in pixels
e%=180                    ! eye separation in pixels
o%=700                    ! observer-screen distance in pixels
oversam%=6                ! oversampling ratio -- can be 1, 2, 4, 6
dohiddenrem!=FALSE        ! enable/disable SLOW hidden point removal
xres%=640                 ! width of the picture in pixels
yres%=470                 ! height of picture in pixels
numcolors%=64
'
DIM thedepth|(xres%*yres%)
depthofs%=VARPTR(thedepth|(0))
DIM link%(xres%*oversam%)
DIM pixels%(xres%*oversam%)
DIM z%(xres%)
DIM pal|(3*numcolors%)
DIM thesird|(xres%*(yres%+10)*3)       ! add 10 "help lines"
sirdofs%=VARPTR(thesird|(0))
'
FILESELECT "\*.red","",dep$
IF dep$=""
  END
ENDIF
PRINT "Input RAW depth file: ";dep$
OPEN "i",#1,dep$
BGET #1,depthofs%,xres%*yres%
CLOSE #1
'
PRINT "Res. ";xres%;"x";yres%;", ";numcolors%;" colors, ";
IF oversam%=1
  PRINT "no oversampling";
ELSE
  PRINT oversam%;" times oversampling";
ENDIF
IF dohiddenrem!
  PRINT ", hidden point removal."
ELSE
  PRINT "."
ENDIF
init_pal
init_sirds
do_sirds
PRINT CHR$(7);
'
FILESELECT "\*.tga","",sir$
IF sir$=""
  END
ENDIF
PRINT "Output TGA SIRDS file: ";sir$
OPEN "o",#1,sir$
PRINT #1;CHR$(0);CHR$(0);CHR$(2);
PRINT #1;CHR$(0);CHR$(0);CHR$(0);CHR$(0);CHR$(0);
PRINT #1;CHR$(0);CHR$(0);CHR$(0);CHR$(0);
PRINT #1;CHR$(xres% MOD 256);CHR$(xres% DIV 256);
PRINT #1;CHR$((yres%+10) MOD 256);CHR$((yres%+10) DIV 256);
PRINT #1;CHR$(24);CHR$(32);
BPUT #1,sirdofs%,xres%*(yres%+10)*3
CLOSE #1
END
'
'
'
PROCEDURE init_pal
  ' create palette with shades of gray
  LOCAL n%,cscale
  cscale=255/(numcolors%-1)
  FOR n%=0 TO numcolors%-1
    pal|(3*n%)=ROUND(n%*cscale)    ! blue
    pal|(3*n%+1)=ROUND(n%*cscale)  ! green
    pal|(3*n%+2)=ROUND(n%*cscale)  ! red
  NEXT n%
RETURN
'
PROCEDURE init_sirds
  ' add "help lines"
  LOCAL x%,y%,helpdist,th%
  helpdist=ABS(bkdepth%)*e%/(2*(ABS(bkdepth%)+o%))
  th%=0
  FOR y%=9 DOWNTO 0
    FOR x%=xres%/2-helpdist-th% TO xres%/2-helpdist+th%
      thesird|(3*(y%*xres%+x%))=255        ! blue
      thesird|(3*(y%*xres%+x%)+1)=255      ! green
      thesird|(3*(y%*xres%+x%)+2)=255      ! red
    NEXT x%
    FOR x%=xres%/2+helpdist-th% TO xres%/2+helpdist+th%
      thesird|(3*(y%*xres%+x%))=255
      thesird|(3*(y%*xres%+x%)+1)=255
      thesird|(3*(y%*xres%+x%)+2)=255
    NEXT x%
    INC th%
  NEXT y%
RETURN
'
PROCEDURE do_sirds
  ' render the SIRDS
  LOCAL x%,y%,h%,u%,dx%,c%,xx%,highest%,separation%,left%,right%,pp%,v,visible!
  FOR y%=0 TO yres%-1
    PRINT AT(1,3);"Rendering line ";y%+1;" of ";yres%
    FOR x%=0 TO xres%*oversam%-1
      link%(x%)=x%
    NEXT x%
    highest%=bkdepth%
    FOR x%=0 TO xres%-1
      ' h%=bkdepth%+128+63*(SIN(x%/70*PI)+COS(y%/70*PI))
      h%=bkdepth%+thedepth|(y%*xres%+x%)
      z%(x%)=h%
      IF h%>highest%
        highest%=h%
      ENDIF
    NEXT x%
    FOR x%=0 TO xres%*oversam%-1
      separation%=(e%*oversam%*z%(x%/oversam%))/(z%(x%/oversam%)-o%)
      left%=x%-separation%/2
      right%=left%+separation%
      IF (left%>=0) AND (right%<xres%*oversam%)
        visible!=TRUE
        IF dohiddenrem!
          v=2*(o%-z%(x%/oversam%))/e%
          dx%=1
          REPEAT
            u%=z%(x%/oversam%)+dx%*v
            IF (z%((x%+dx%)/oversam%)>=u%) OR (z%((x%-dx%)/oversam%)>=u%)
              visible!=FALSE
            ENDIF
            INC dx%
          UNTIL (u%>highest%) OR (NOT visible!)
        ENDIF
        IF visible!
          link%(right%)=left%
        ENDIF
      ENDIF
    NEXT x%
    pp%=0
    FOR x%=0 TO xres%*oversam%-1
      IF link%(x%)=x%
        IF (pp% MOD oversam%)=0
          c%=RANDOM(numcolors%)
        ENDIF
        pixels%(x%)=c%
        INC pp%
      ELSE
        pixels%(x%)=pixels%(link%(x%))
      ENDIF
    NEXT x%
    FOR x%=0 TO xres%-1
      xx%=x%*oversam%
      SELECT oversam%
      CASE 1
        c%=pixels%(xx%)
      CASE 2
        IF (x%>0) AND (x%<xres%-1)
          c%=pixels%(xx%)*42+(pixels%(xx%-1)+pixels%(xx%+1))*24
          c%=c%+(pixels%(xx%-2)+pixels%(xx%+2))*5
          c%=c%/100
        ELSE
          c%=pixels%(xx%)
        ENDIF
      CASE 4
        IF (x%>0) AND (x%<xres%-1)
          c%=pixels%(xx%)*26+(pixels%(xx%-1)+pixels%(xx%+1))*18
          c%=c%+(pixels%(xx%-2)+pixels%(xx%+2))*12
          c%=c%+(pixels%(xx%-3)+pixels%(xx%+3))*7
          c%=c%/100
        ELSE
          c%=pixels%(xx%)
        ENDIF
      CASE 6
        IF (x%>0) AND (x%<xres%-1)
          c%=pixels%(xx%)*14+(pixels%(xx%-1)+pixels%(xx%+1))*14
          c%=c%+(pixels%(xx%-2)+pixels%(xx%+2))*11
          c%=c%+(pixels%(xx%-3)+pixels%(xx%+3))*8
          c%=c%+(pixels%(xx%-4)+pixels%(xx%+4))*5
          c%=c%+(pixels%(xx%-5)+pixels%(xx%+5))*3
          c%=c%+(pixels%(xx%-6)+pixels%(xx%+6))*2
          c%=c%/100
        ELSE
          c%=pixels%(xx%)
        ENDIF
      ENDSELECT
      thesird|(3*((y%+10)*xres%+x%))=pal|(3*c%)      ! blue
      thesird|(3*((y%+10)*xres%+x%)+1)=pal|(3*c%+1)  ! green
      thesird|(3*((y%+10)*xres%+x%)+2)=pal|(3*c%+2)  ! red
    NEXT x%
  NEXT y%
RETURN