#
# parser.tk
#

proc parser(build) name {
    global Parser

    set psid [pid]
    set Parser(Tempfile) "/tmp/dstool_tk_pid_$psid"

    build_Title $name "Dynamical system definition"

    build_DismissButtonbar $name dbbar "window(dismiss) parser" \
	{"Build model" {parser(build_model)} } \
	{"Clear" {parser(clear)} }
    
    build_Buttonbar $name bbar \
	{"Load..." {parser(preload)} } \
	{"Save..." {parser(presave)} } \
	{"Write C code..." {parser(ccode)} }
    pack $name.bbar -side bottom

    set cmd [build_CmdFrame $name cmd]

    build_Filename $cmd f Parser(Filename) Parser(Directory)
    build_LabelEntryColumns $cmd m \
        {text   {} {"Model name:"} } \
        {lentry {} {Parser(Modelname)}}

    build_Choicefield $cmd cf1 "" Parser(Mapping_Flag) \
        { "Vector Field" \
          "Mapping" }

    set stext [build_Scrollingtext $cmd stext 40 20]

    if { [string length [$stext get 1.0 end]] < 2} {
	$stext insert 1.0 "#\n# The Lorenz dynamical system\n#\n\n"
	$stext insert end "x' = sigma ( y - x )\n"
        $stext insert end "y' = rho x - y - x z \n"
        $stext insert end "z' = -beta z + x y\n\n"
        $stext insert end "INITIAL sigma 10.0 rho 28.0 beta 2.66666666\n"
        $stext insert end "RANGE x -30 30 y -30 30 z -20 50\n"
    }

    pack $cmd -fill both -expand 1
    tcl_to_pm_obj Parser
}

proc parser(enter) {} {
    pm_to_tcl_obj Parser
}

proc parser(leave) {} {
    tcl_to_pm_obj Parser
    pm_to_tcl_obj Parser
}

proc parser(init_model) {} {
    global Parser

    pm EXEC Parser.Init

    # strip out comments from text and then carriage returns
    set ptext "[.parser.cmd.stext.text get 1.0 end]\n"
    regsub -all "\#\[^\n\]*\n" $ptext " " ptext
    regsub -all "\n" $ptext " " ptext

    # break into segments of length maxlen as necessary
    set maxlen [pm GET Parser.Text_Max_Length]
  
    set ptxlen [string length $ptext]

    # test for an empty parsed text (with 2 empty chars)
    if { $ptxlen == 2 } {
      return 0
    }

    set idxa 0

    while { $idxa < $ptxlen } {
      set idxb [expr $idxa + $maxlen]

      set pchar [string index $ptext $idxb]

      while { ($pchar != " ") \
            &&($pchar != "=") \
            &&($pchar != "^") \
            &&($pchar != "%") \
            &&($pchar != ")") \
            &&($pchar != "(") \
            &&($pchar != "+") \
            &&($pchar != "*") \
            &&($pchar != "/") \
            &&($pchar != "-") \
            &&($idxb >= $idxa) } {

        set idxb [expr $idxb - 1]
        set pchar [string index $ptext $idxb]
      }

      set ptemp [string range $ptext $idxa $idxb]

      set Parser(Text) $ptemp
      tcl_to_pm Parser
      pm EXEC Parser.Add_Text

      set idxa [expr $idxb + 1]
    }

    return $ptxlen
}

proc parser(load_model) {} {
    global Parser

    # check model is valid
    pm EXEC Parser.New_DS_Check
    if { [pm GET Parser.New_DS_Status] } {
	load_model -1
        return 1
    } else {
       build_Dialog dialog "Error" "Parser build model failed."  0 Ok
       return 0
    }
}

proc parser(build_model) {} {
    global Parser

    begin_wait "Building parsed model..."

    set init [parser(init_model)]
    set load 0

    if { $init > 0 } {
      set load [parser(load_model)]
    } else {
      end_wait "Failed parsed model."
    }


    if { $load > 0 } {
      end_wait "Succesful parsed model."
    } else { 
      end_wait "Failed parsed model."
    }
}

proc parser(ccode) {} {
    global Parser

    begin_wait "Writing C code parsed model..."

    set init [parser(init_model)]
    if { $init > 0 } {

      # check model is valid
      pm EXEC Parser.New_DS_Check
      if { [pm GET Parser.New_DS_Status] } {
	  #puts stdout "parser build model successful."
          pm EXEC Parser.WriteC
      
          if { [file exists   $Parser(Tempfile)] == 0 } {
             #puts stderr "could not write temp file."
             build_Dialog dialog "Error" "Could not write temp file $$Parser(Tempfile)" 0 Ok
          }
          end_wait "Succesful C code parsed model."
          window(open) ccode
      } else {
         build_Dialog dialog "Error" "Parser build model failed."  0 Ok
          end_wait "Failed C code parsed model."
      }
    } else {
      end_wait "Failed C code parsed model."
    }
}

proc parser(noop) {} {
}

proc parser(clear) {} {
    .parser.cmd.stext.text delete 1.0 end
}

proc parser(preload) {} {
    global Parser

    window(open) filesl
    filesl(init) "Load" \
                 "*.def" \
                 $Parser(Directory) \
                 $Parser(Filename)  \
                 "parser(upfile)"   \
                 "parser(load)"
}

proc parser(load) {} {
    global Parser

    parser(clear)
    set f [open "$Parser(Directory)/$Parser(Filename)" r]

    while {![eof $f]} {
      .parser.cmd.stext.text insert end [read $f 1000]
    }
    close $f
}

proc parser(upfile) {} {
    global Parser
    global File

    set Parser(Filename)  $File(Filename)
    set Parser(Directory) $File(Directory)

    tcl_to_pm Parser
    pm_to_tcl Parser
}

proc parser(presave) {} {
    global Parser

    window(open) filesl
    filesl(init) "Save" \
                 "*.def" \
                 $Parser(Directory) \
                 $Parser(Filename)  \
                 "parser(upfile)"   \
                 "parser(save)"
}

proc parser(save) {} {
    global Parser

    set f [open "$Parser(Directory)/$Parser(Filename)" w]
    set buffer [.parser.cmd.stext.text get 1.0 end]
    puts $f $buffer
    close $f
}