Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] Diff of /trunk/sml3d/src/particles/compiler/translate.sml
ViewVC logotype

Diff of /trunk/sml3d/src/particles/compiler/translate.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1110, Thu Apr 7 21:30:21 2011 UTC revision 1119, Mon Apr 11 17:09:46 2011 UTC
# Line 731  Line 731 
731         retState state))         retState state))
732       end       end
733    
734      fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let  (*
735        val PS{pos, vel, ...} = state  //    fun trPred(pred, env, state, thenk : particle_state -> IR.stmt, elsek : particle_state -> IR.stmt) = let
736        val P.PR{ifstmt, ...} = pred  //      val PS{pos, vel, ...} = state
737       in  //      val P.PR{ifstmt, ...} = pred
738        case ifstmt  //    in
739          of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>  //      case ifstmt
740                 IR.mkIF(withinVar, thenk(state), elsek(state)))  //       of P.WITHIN(d) => mkWithinVar("wv", env, pos, d, fn withinVar =>
741           | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>  //               IR.mkIF(withinVar, thenk(state), elsek(state)))
742                 IR.mkIF(withinVar, thenk(state), elsek(state)))  //         | P.WITHINVEL(d) => mkWithinVar("wv", env, vel, d, fn withinVar =>
743       end  //               IR.mkIF(withinVar, thenk(state), elsek(state)))
744    //     end            /
745      fun trAct (action, env, state, k : particle_state -> IR.stmt) = let  //
746            val PS{pos, vel, size, ttl, color, user} = state  //    fun trAct (action, env, state, k : particle_state -> IR.stmt) = let/
747            in  //        val PS{pos, vel, size, ttl, color, user} = state
748              case action  //        in
749               of P.BOUNCE{friction, resilience, cutoff, d} => let  //          case action
750                    val blk = newBlock (env, user, k)  //           of P.BOUNCE{friction, resilience, cutoff, d} => let
751                    val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)  //                val blk = newBlock (env, user, k)
752                    in  //                val negOne = IR.newConst("negOne", IR.C_FLOAT ~1.0)
753                      letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>  //                in
754                      letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>  //                  letPRIM("vs", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn velScale =>
755                      mkWithinVar("wcp", env, pos, d, fn withinCurPos =>  //                  letPRIM("np", IR.T_VEC, IR.ADD_VEC, [pos, velScale], fn nextPos =>
756                      mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>  //                  mkWithinVar("wcp", env, pos, d, fn withinCurPos =>
757                      letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>  //                  mkWithinVar("wnp", env, nextPos, d, fn withinNextPos =>
758                      letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>  //                  letPRIM("nwcp", IR.T_BOOL, IR.NOT, [withinCurPos], fn notWithinCurPos =>
759                      IR.mkIF(shouldBounce,  //                  letPRIM("sb", IR.T_BOOL, IR.AND, [notWithinCurPos, withinNextPos], fn shouldBounce =>
760                        (*then*)  //                  IR.mkIF(shouldBounce,
761                          normAtPoint("n", d, env, state, fn normAtD => fn state' => let  //                    (*then*)
762                 val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'  //                      normAtPoint("n", d, env, state, fn normAtD => fn state' => let
763                            in  //               val PS{pos=nextPos, vel=nextVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser} = state'
764                             letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>  //                        in
765                             letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>  //                         letPRIM("negVel", IR.T_VEC, IR.SCALE, [negOne, nextVel], fn negVel =>
766                             letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>  //                         letPRIM("dnv", IR.T_FLOAT, IR.DOT, [negVel, normAtD], fn dotNegVel =>
767                             letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>  //                         letPRIM("sn", IR.T_VEC, IR.SCALE, [dotNegVel, normAtD], fn scaledN =>
768    //                         letPRIM("t", IR.T_VEC, IR.SUB_VEC, [negVel, scaledN], fn tang =>
769                             letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>  //
770                             letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>  //                         letPRIM("tlsq", IR.T_FLOAT, IR.LEN_SQ, [tang], fn tangLenSq =>
771                             letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>  //                         letPRIM("cosq", IR.T_FLOAT, IR.MULT, [psvToIRVar(env, cutoff), psvToIRVar(env, cutoff)], fn cutoffSq =>
772    //                         letPRIM("inco", IR.T_BOOL, IR.GT, [tangLenSq, cutoffSq], fn inCutoff =>
773                             letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>  //
774    //                         letPRIM("resNorm", IR.T_VEC, IR.SCALE, [psvToIRVar(env, resilience), scaledN], fn resNorm =>
775                             IR.mkIF(inCutoff,  //
776                               (*then*)  //                         IR.mkIF(inCutoff,
777                               letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>  //                           (*then*)
778                               letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>  //                           letPRIM("fInv", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), psvToIRVar(env, friction)], fn frictInv =>
779                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>  //                           letPRIM("f", IR.T_FLOAT, IR.MULT, [negOne, frictInv], fn modFrict =>
780                               letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  //                           letPRIM("fTang", IR.T_VEC, IR.SCALE, [modFrict, tang], fn frictTang =>
781                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)  //                           letPRIM("newVel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
782                              )))),  //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
783                               (*else*)  //                          )))),
784                               letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>  //                           (*else*)
785                               letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>  //                           letPRIM("fTang", IR.T_VEC, IR.SCALE, [negOne, tang], fn frictTang =>
786                                goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)  //                           letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [frictTang, resNorm], fn newVel =>
787                               ))  //                            goto(PS{pos=nextPos, vel=newVel, size=nextSize, ttl=nextIsDead, color=nextColor, user=nextUser}, blk)
788                           )))))))))  //                           ))
789                           end  //                       )))))))))
790                        ),  //                       end
791                        (*else*)  //                    ),
792                        goto(state, blk))))))))  //                    (*else*)
793                    end  //                    goto(state, blk))))))))
794    //                end
795                | P.ACCEL dir =>  //
796                      letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>  //            | P.ACCEL dir =>
797                      letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>  //                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), psvToIRVar(env, dir)], fn theScale =>
798                        k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))  //                  letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [theScale, vel], fn newVel =>
799    //                    k(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user = user})))
800                | P.MOVE =>  //
801                  letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>  //            | P.MOVE =>
802                      letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>  //              letPRIM("scaledVec", IR.T_VEC, IR.SCALE, [psvToIRVar(env, PSV.timeStep), vel], fn theScale =>
803                        k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))  //                  letPRIM("ps_pos", IR.T_VEC, IR.ADD_VEC, [theScale, pos], fn newPos =>
804    //                    k(PS{pos = newPos, vel = vel, size = size, ttl = ttl, color = color, user = user})))
805                | P.ORBITPOINT {center, mag, maxRad} => let  //
806                    val blk = newBlock (env, user, k)  //            | P.ORBITPOINT {center, mag, maxRad} => let
807                   in  //                val blk = newBlock (env, user, k)
808                    letPRIM("toCenter", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn toCenter =>  //               in
809                    letPRIM("dist", IR.T_FLOAT, IR.LEN, [toCenter], fn dist =>  //                letPRIM("toCenter", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, center), pos], fn toCenter =>
810                    letPRIM("radInDist", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, maxRad)], fn radInDist =>  //                letPRIM("dist", IR.T_FLOAT, IR.LEN, [toCenter], fn dist =>
811                    IR.mkIF(radInDist,  //                letPRIM("radInDist", IR.T_BOOL, IR.GT, [dist, psvToIRVar(env, maxRad)], fn radInDist =>
812                      (* then *)  //                IR.mkIF(radInDist,
813                      goto(state, blk),  //                  (* then *)
814                      (* else *)  //                  goto(state, blk),
815                  letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [dist, psvToIRVar(env, maxRad)], fn magRatio =>  //                  (* else *)
816                  letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>  //                letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [dist, psvToIRVar(env, maxRad)], fn magRatio =>
817                  letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>  //                letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
818                  letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>  //                letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
819                  letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, toCenter], fn acc =>  //                letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
820                  letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>  //                letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, toCenter], fn acc =>
821                  goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)  //                letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
822                    ))))))))))  //                goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
823                   end  //                ))))))))))
824    //               end
825    //
826                | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let  //
827                    val blk = newBlock (env, user, k)  //            | P.ORBITLINESEG {endp1, endp2, maxRad, mag} => let
828                  in  //                val blk = newBlock (env, user, k)
829                  letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>  //              in
830                  letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>  //              letPRIM("subVec", IR.T_VEC, IR.SUB_VEC, [psvToIRVar(env, endp2), psvToIRVar(env, endp1)], fn subVec =>
831                  letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>  //              letPRIM("vecToEndP", IR.T_VEC, IR.SUB_VEC, [pos, psvToIRVar(env, endp1)], fn vecToEndP =>
832                  letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>  //              letPRIM("basis", IR.T_VEC, IR.NORM, [subVec], fn basis =>
833                  letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>  //              letPRIM("parDot", IR.T_FLOAT, IR.DOT, [basis, vecToEndP], fn parDot =>
834                  letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>  //              letPRIM("parVec", IR.T_VEC, IR.SCALE, [parDot, basis], fn parVec =>
835                  letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>  //              letPRIM("closestP", IR.T_VEC, IR.ADD_VEC, [psvToIRVar(env, endp1), parVec], fn closestP =>
836                  letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>  //              letPRIM("vecToP", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn vecToP =>
837                  letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>  //              letPRIM("distToP", IR.T_FLOAT, IR.LEN, [vecToP], fn distToP =>
838                  letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>  //              letPRIM("effRad", IR.T_FLOAT, IR.SUB, [psvToIRVar(env, maxRad), distToP], fn effRad =>
839                  IR.mkIF(radInDist,  //              letPRIM("radInDist", IR.T_BOOL, IR.GT, [psvToIRVar(env, epsilon), effRad], fn radInDist =>
840                    (*then*)  //              IR.mkIF(radInDist,
841                    goto(state, blk),  //                (*then*)
842                    (*else*)  //                goto(state, blk),
843                    letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>  //                (*else*)
844                    letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>  //                letPRIM("magRatio", IR.T_FLOAT, IR.DIV, [distToP, psvToIRVar(env, maxRad)], fn magRatio =>
845                    letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>  //                letPRIM("oneMinMR", IR.T_FLOAT, IR.SUB, [IR.newConst("one", IR.C_FLOAT 1.0), magRatio], fn oneMinMR =>
846                    letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>  //                letPRIM("gravityMag", IR.T_FLOAT, IR.MULT, [oneMinMR, psvToIRVar(env, mag)], fn gravityMag =>
847                    letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>  //                letPRIM("totalMag", IR.T_FLOAT, IR.MULT, [gravityMag, psvToIRVar(env, PSV.timeStep)], fn totMag =>
848                    letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>  //                letPRIM("accVec", IR.T_VEC, IR.SUB_VEC, [closestP, pos], fn accVec =>
849                    letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>  //                letPRIM("acc", IR.T_VEC, IR.SCALE, [totMag, accVec], fn acc =>
850                    goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)  //                letPRIM("ps_vel", IR.T_VEC, IR.ADD_VEC, [vel, acc], fn newVel =>
851                    )))))))  //                goto(PS{pos = pos, vel = newVel, size = size, ttl = ttl, color = color, user=user}, blk)
852                  )))))))))))  //                )))))))
853                  end  //              )))))))))))
854    //              end
855                (* just kill it. *)  //
856                (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)  //            (* just kill it. *)
857                | P.DIE => IR.DISCARD  //            (* | P.DIE => k(PS{pos = pos, vel = vel, size = size, ttl = IR.newConst("falseVar", IR.C_BOOL true), color = color, dummy=dummy}) *)
858                | _ => raise Fail("Action not implemented...")  //            | P.DIE => IR.DISCARD
859              (* end case *)  //            | _ => raise Fail("Action not implemented...")
860            end  //          (* end case *)
861    //        end
862    *)
863      fun compile (P.PG{      fun compile (P.PG{
864         emit as P.EMIT{freq, sv_gens}, act, render,         emit as P.EMIT{freq, sv_gens}, act, render,
865         vars, state_vars, render_vars         vars, state_vars, render_vars
# Line 885  Line 886 
886    
887                   fun convertToIR PSV.SV{name, ty, id, ...} = IR.newParam("ps_" ^ name, IR.psvTyToIRTy ty)                   fun convertToIR PSV.SV{name, ty, id, ...} = IR.newParam("ps_" ^ name, IR.psvTyToIRTy ty)
888                  in                  in
889                    TE(                    TE( blks, PSV.Set.foldl insv PSV.Map.empty pgm_vars )
                    blks,  
                    PSV.Set.foldl insv PSV.Map.empty pgm_vars  
                   )  
890                  end (* env *)                  end (* env *)
891    
892        fun evalActs f [] state = f [] state        fun evalActs f [] state = f [] state

Legend:
Removed from v.1110  
changed lines
  Added in v.1119

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0