require 'files'

magnitude=: [: %: [: +/ *:      NB. sqrt of sum of squares
normalize=: ] * [: % magnitude  NB. scale by reciprocal of magnitude
dotproduct=: +/ . *
toRGB=: ([: <.&255 >.&0) @ ([: <. 255&*) NB. 0->1 becomes 0->255 (clamped)
reflect=: [ - ] * +:@dotproduct          NB. (vector normal)
coordinates=: [: (] ,"0 |:) 2&# $ ] # i. NB. y is square array width
hit=: ([: {. /:~) & (0&< # ])   NB. smallest positive intersection

intersect=: dyad define         NB. (origin direction)
a=. y dotproduct y
b=. 2 * y dotproduct x
c=. (x dotproduct x) - 1
discriminant=. (*: b) - (4 * a * c)
if. discriminant >: 0 do.
  i1=. ((- b) - (%: discriminant)) % +: a
  i2=. ((- b) + (%: discriminant)) % +: a
  i1 ; i2
else.
  0                             NB. lest we return the last calculated value...
end.
)

lighting=: monad define
'light material position eye normal'=. y
'lPosition lIntensity'=. light
'mAmbient mDiffuse mSpecular mShiny mColor'=. material
effectiveColor=. mColor * lIntensity
ambient=. effectiveColor * mAmbient
lightv=. normalize lPosition - position
l=. lightv dotproduct normal
r=. ((- lightv) reflect normal) dotproduct eye
diffuse=. (l>:0) { > (0 0 0) ; l * effectiveColor * mDiffuse
specular=. (r>:0) { > (0 0 0) ; lIntensity * mSpecular * r ^ mShiny
ambient + diffuse + specular
)

trace=: dyad define             NB. (width (x y)) e.g. 300 trace"1 (coordinates 300)
'xcoord ycoord'=. y
rOrigin=. 0 0 _5
wallZ=. 10
wallSize=. 7.0
pixelSize=. wallSize % x
position=. ((- -: wallSize) + pixelSize * xcoord) , ((-: wallSize) - pixelSize * ycoord) , wallZ
rDirection=. normalize position - rOrigin
contactTime=. hit >rOrigin intersect rDirection
if. contactTime do.
  pos=. rOrigin + rDirection * contactTime
  normal=. normalize pos
  eye=. -rDirection
  light=. (_10 _8 _10); (0.2 1 1) NB. position intensity
  material=. 0.1 ; 0.9 ; 0.9 ; 200 ; 0.5 0.2 1 NB. ambient diffuse specular shiny color
  lighting light; material ; pos; eye; normal
else.
  0 0 0
end.
)

writePPM=: dyad define          NB. (array filename) TODO wrap at 70 characters
header=. 'P3', LF, (": 0 1 { $x), LF, '255', LF
(header, (": toRGB ,,/x), LF) fwrite y
)