# This is S3Dparse.icn

# It might be best to write a YACC grammar for parsing
# .s3d files but let us first consider a handwritten parse
# and see if it is viable.  Pretend that the entire file
# is read into one big string s and that procedure main()
# reads that in and invokes a string scanning environment on it:

procedure main(av)
   fin := open(av[1]) | stop("usage: s3dparse file.s3d")
   s := reads(fin, 100000000) | stop("empty s3d file?!")
   close(fin)
   s ? {
      S3Dparse()
      }
   write("parsed ", *partRecs, " parts, ", *textureRecs, " textures, ",
	 *triangleRecs, " triangles, ", *vertexRecs, " vertices")
end


# Principle: a Bit of Bottom Up Engineering

# skip (scan past) the rest of this line
procedure comment(howMany : 1) # aka skipLine
   if not ="//" then write("warning, expected comment at ", tab(find("\n")))
   every i := 1 to howMany do tab(find("\n")+1)
   return
end

# parse a bunch of digits
procedure d()
   return integer(tab(many(&digits)))
end

procedure f()
   return real(tab(many(&digits++'.-e')))
end

procedure nl()
    ="\r"
    ="\n" | fail
    return
end

procedure cm()
    tab(many(' '))
    ="," | fail
    tab(many(' '))
    return
end

#
# The S3D Master File Format uses exactly these variable names
#

global textureCount, triCount, vertexCount,
       frameCount, partCount, lightCount, cameraCount


#
# Principle: Don't Overengineer
#

# The procedure S3Dparse could be a class constructor instead,
# for object-oriented parsing, but let's see what it looks
# like in procedural style first.  Make it OO if its
# complexity justifies that.

procedure S3Dparse()
   comment() | stop("missing version field description")
   version() | stop("missing version number")
   comment() | stop("missing header field descriptions")
   (textureCount := d(), cm(), triCount := d(), cm(),
    vertexCount := d(), cm(), partCount := d(), cm(),
    frameCount := d(), cm(), lightCount := d(), cm(),
    cameraCount := d()) |
      stop("missing header field(s)")
   ="\r"
   nl() | stop("extra junk on header fields line ", tab(find("\n")))

   write("header ", textureCount , ",", triCount, ",",
    vertexCount, ",", frameCount , ",", partCount , ",", lightCount , ",",
    cameraCount )

   comment() | stop("missing part list field descriptions")
   partRecords()
   write("parsed ", *partRecs, " parts")
   comment() | stop("missing texture list field descriptions")
   textureRecords()
   write("parsed ", *textureRecs, " textures")
   comment() | stop("missing triangle list field descriptions")
   triangleRecords()
   write("parsed ", *triangleRecs, " triangles")
   comment() | stop("missing vertex list field descriptions")
   vertexRecords()
   write("parsed ", *vertexRecs, " vertices")
   comment() | stop("missing light list field descriptions")
   lightRecords()
   write("parsed ", *lightRecs, " lights")
   comment() | stop("missing camera list field descriptions")
   cameraRecords()
   write("parsed ", *cameraRecs, " cameras")
   extensions()
end

procedure version()
    if not ="103" then write("warning, version number ", tab(find("\n")))
    else tab(find("\n"))
    move(1)
    return
end

# When are globals harmful?

# These Lists of Records could in fact be class variables of
# a class S3DFile.  OOP experts say if we have state like
# this, AND WE HAVE BEHAVIOR enough justify a few methods,
# then we have reason to make this into a class.

global partRecs, textureRecs, triangleRecs,
    vertexRecs, lightRecs, cameraRecs

# partRecord is not a class, because it has no methods.
record partRecord(firstVertexIndex, vertexCount,
		  firstTriIndex, triCount, partName)

procedure partRecords()
   local L
   L := partRecs := []
   every i := 1 to partCount do {
      put(L,partRecord(d(), cm() & d(), cm() & d(), cm() & d(),
		   =",\"" & tab(find("\"")))) |
         stop("bad partrecord data ", image(tab(find("\n"))))


      ="\"" | stop("bad partrecord before ", image(tab(find("\n"))))
      ="\r"
      nl() | stop("bad partrecord before ", image(tab(find("\n"))))
      }
end

procedure textureRecords()
    local L
    L := textureRecs := []
    every 1 to textureCount do {
	put(L, tab(find("\n")))
	move(1)
    }
end

record triangleRecord(textureIndex, vi1,u1,v1, vi2,u2,v2, vi3,u3,v3)

procedure triangleRecords()
    local L
    L := triangleRecs := []
    every 1 to triCount do {
      put(L,triangleRecord(d(),
		   cm() & d(), cm() & f(), cm() & f(),
		   cm() & d(), cm() & f(), cm() & f(),
		   cm() & d(), cm() & f(), cm() & f())) |
         stop("bad trianglerecord ", image(tab(find("\n"))))
      nl() | stop("bad trianglerecord before ", image(tab(find("\n"))))
    }
end


record vertexRecord(x,y,z)

procedure vertexRecords()
    local L
    L := vertexRecs := []
    every 1 to vertexCount do {
      put(L,vertexRecord( f(), cm() & f(), cm() & f())) |
         stop("bad vertexrecord ", image(tab(find("\n"))))
      nl() | stop("bad vertexrecord before ", image(tab(find("\n"))))
    }
    # discard extra/bogus records
    discards := 0
    while not match("//") do { tab(find("\n")+1); discards +:= 1 }
    if discards > 0 then write("discarded ", discards, " extra vertices")
end


record lightRecord(name, typ, x, y, z, r, g, b, typedata)

procedure lightRecords()
    local L
    L := lightRecs := []
    every 1 to lightCount do {
      put(L,lightRecord( 2(="\"", tab(find("\"")), ="\""),
			cm() & d(),cm() & f(),cm() & f(),
			cm() & f(),cm() & f(),cm() & f(),cm() & f()),
			cm() & tab(find("\n"))) |
         stop("bad lightrecord ", image(tab(find("\n"))))
      nl() | stop("bad lightrecord before ", image(tab(find("\n"))))
    }
end



record cameraRecord(name, x, y, z,
		    pitch, blank, heading, horizontalFieldOfViewinRadians,
		    rightX, rightY, rightZ,
		    upX, upY, upZ, fwdX, fwdY, fwdZ, ex, wye, zee)

procedure cameraRecords()
    local L
    L := cameraRecs := []
    every 1 to cameraCount do {
      put(L,cameraRecord( 2(="\"", tab(find("\"")), ="\""),
			cm() & f(),cm() & f(),cm() & f(),
			cm() & f(),cm() & f(),cm() & f(),cm() & f()),
			tab(find("\n")),
			nl() & f(), cm() & f(), cm() & f(),
			nl() & f(), cm() & f(), cm() & f(),
			nl() & f(), cm() & f(), cm() & f(),
			nl() & f(), cm() & f(), cm() & f()) |
         stop("bad camerarecord ", image(tab(find("\n"))))
      nl() | stop("bad camerarecord before ", image(tab(find("\n"))))
    }
end

procedure extensions()
    while extensionName := tab(find(" ")) do {
	=" "
	length := d()
        nl()
	every 1 to length do tab(find("\n")+1)
    }
end