' **** Atari SIS program v2.0 ****
'   routine from the SIRDS FAQ
'
' read *.red (raw) file into thedepth array
' read *.tga file into tile 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
txr%=96                   ! width of tile in pixels
tyr%=72                   ! height of tile in pixels
'
DIM thedepth|(xres%*yres%)
depthofs%=VARPTR(thedepth|(0))
DIM link%(xres%*oversam%)
DIM pixels|(xres%*oversam%*3)
DIM z%(xres%)
DIM pal|(3*numcolors%)
DIM thesird|(xres%*(yres%+10)*3)       ! add 10 "help lines"
sirdofs%=VARPTR(thesird|(0))
DIM tile|(txr%*tyr%*3)
tileofs%=VARPTR(tile|(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
'
FILESELECT "\*.tga","",til$
IF til$=""
  END
ENDIF
PRINT "Input TGA tile file: ";til$
OPEN "i",#1,til$
SEEK #1,18
BGET #1,tileofs%,txr%*tyr%*3
CLOSE #1
'
PRINT "Res. ";xres%;"x";yres%;", ";
IF oversam%=1
  PRINT "no oversampling";
ELSE
  PRINT oversam%;" times oversampling";
ENDIF
IF dohiddenrem!
  PRINT ", hidden point removal."
ELSE
  PRINT "."
ENDIF
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_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%,xx%,highest%,separation%,left%,right%,pp%,tilep%,r%,g%,b%,v,visible!
  FOR y%=0 TO yres%-1
    PRINT AT(1,4);"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%
    FOR x%=0 TO xres%*oversam%-1
      tilep%=(y% MOD tyr%)*txr%+(x% DIV oversam%) MOD txr%
      IF link%(x%)=x%
        pixels|(3*x%)=tile|(3*tilep%)
        pixels|(3*x%+1)=tile|(3*tilep%+1)
        pixels|(3*x%+2)=tile|(3*tilep%+2)
      ELSE
        pixels|(3*x%)=pixels|(3*link%(x%))
        pixels|(3*x%+1)=pixels|(3*link%(x%)+1)
        pixels|(3*x%+2)=pixels|(3*link%(x%)+2)
      ENDIF
    NEXT x%
    FOR x%=0 TO xres%-1
      xx%=x%*oversam%
      SELECT oversam%
      CASE 1
        b%=pixels|(3*xx%)
        g%=pixels|(3*xx%+1)
        r%=pixels|(3*xx%+2)
      CASE 2
        IF (x%>0) AND (x%<xres%-1)
          b%=pixels|(3*xx%)*42+(pixels|(3*(xx%-1))+pixels|(3*(xx%+1)))*24
          b%=b%+(pixels|(3*(xx%-2))+pixels|(3*(xx%+2)))*5
          b%=b%/100
          g%=pixels|(3*xx%+1)*42+(pixels|(3*(xx%-1)+1)+pixels|(3*(xx%+1)+1))*24
          g%=g%+(pixels|(3*(xx%-2)+1)+pixels|(3*(xx%+2)+1))*5
          g%=g%/100
          r%=pixels|(3*xx%+2)*42+(pixels|(3*(xx%-1)+2)+pixels|(3*(xx%+1)+2))*24
          r%=r%+(pixels|(3*(xx%-2)+2)+pixels|(3*(xx%+2)+2))*5
          r%=r%/100
        ELSE
          b%=pixels|(3*xx%)
          g%=pixels|(3*xx%+1)
          r%=pixels|(3*xx%+2)
        ENDIF
      CASE 4
        IF (x%>0) AND (x%<xres%-1)
          b%=pixels|(3*xx%)*26+(pixels|(3*(xx%-1))+pixels|(3*(xx%+1)))*18
          b%=b%+(pixels|(3*(xx%-2))+pixels|(3*(xx%+2)))*12
          b%=b%+(pixels|(3*(xx%-3))+pixels|(3*(xx%+3)))*7
          b%=b%/100
          g%=pixels|(3*xx%+1)*26+(pixels|(3*(xx%-1)+1)+pixels|(3*(xx%+1)+1))*18
          g%=g%+(pixels|(3*(xx%-2)+1)+pixels|(3*(xx%+2)+1))*12
          g%=g%+(pixels|(3*(xx%-3)+1)+pixels|(3*(xx%+3)+1))*7
          g%=g%/100
          r%=pixels|(3*xx%+2)*26+(pixels|(3*(xx%-1)+2)+pixels|(3*(xx%+1)+2))*18
          r%=r%+(pixels|(3*(xx%-2)+2)+pixels|(3*(xx%+2)+2))*12
          r%=r%+(pixels|(3*(xx%-3)+2)+pixels|(3*(xx%+3)+2))*7
          r%=r%/100
        ELSE
          b%=pixels|(3*xx%)
          g%=pixels|(3*xx%+1)
          r%=pixels|(3*xx%+2)
        ENDIF
      CASE 6
        IF (x%>0) AND (x%<xres%-1)
          b%=pixels|(3*xx%)*14+(pixels|(3*(xx%-1))+pixels|(3*(xx%+1)))*14
          b%=b%+(pixels|(3*(xx%-2))+pixels|(3*(xx%+2)))*11
          b%=b%+(pixels|(3*(xx%-3))+pixels|(3*(xx%+3)))*8
          b%=b%+(pixels|(3*(xx%-4))+pixels|(3*(xx%+4)))*5
          b%=b%+(pixels|(3*(xx%-5))+pixels|(3*(xx%+5)))*3
          b%=b%+(pixels|(3*(xx%-6))+pixels|(3*(xx%+6)))*2
          b%=b%/100
          g%=pixels|(3*xx%+1)*14+(pixels|(3*(xx%-1)+1)+pixels|(3*(xx%+1)+1))*14
          g%=g%+(pixels|(3*(xx%-2)+1)+pixels|(3*(xx%+2)+1))*11
          g%=g%+(pixels|(3*(xx%-3)+1)+pixels|(3*(xx%+3)+1))*8
          g%=g%+(pixels|(3*(xx%-4)+1)+pixels|(3*(xx%+4)+1))*5
          g%=g%+(pixels|(3*(xx%-5)+1)+pixels|(3*(xx%+5)+1))*3
          g%=g%+(pixels|(3*(xx%-6)+1)+pixels|(3*(xx%+6)+1))*2
          g%=g%/100
          r%=pixels|(3*xx%+2)*14+(pixels|(3*(xx%-1)+2)+pixels|(3*(xx%+1)+2))*14
          r%=r%+(pixels|(3*(xx%-2)+2)+pixels|(3*(xx%+2)+2))*11
          r%=r%+(pixels|(3*(xx%-3)+2)+pixels|(3*(xx%+3)+2))*8
          r%=r%+(pixels|(3*(xx%-4)+2)+pixels|(3*(xx%+4)+2))*5
          r%=r%+(pixels|(3*(xx%-5)+2)+pixels|(3*(xx%+5)+2))*3
          r%=r%+(pixels|(3*(xx%-6)+2)+pixels|(3*(xx%+6)+2))*2
          r%=r%/100
        ELSE
          b%=pixels|(3*xx%)
          g%=pixels|(3*xx%+1)
          r%=pixels|(3*xx%+2)
        ENDIF
      ENDSELECT
      thesird|(3*((y%+10)*xres%+x%))=b%    ! blue
      thesird|(3*((y%+10)*xres%+x%)+1)=g%  ! green
      thesird|(3*((y%+10)*xres%+x%)+2)=r%  ! red
    NEXT x%
  NEXT y%
RETURN