#!/bin/sh
# \
exec tclsh8.0 "$0" ${1+"$@"}

    #############
    # preferences - first of all, load preferences from Wobbleinit

set W_URL //LOCAL//
set includePrefixes {{} ../include/ ../src/}

if {[file exists Wobbleinit]} {
    
    proc Site {x} {
        set ::W_URL $x
    }
    
    proc Include {args} {
        foreach path $args {
            if {![string match */ $path]} {append path /}
            lappend ::includePrefixes $path
        }
    }
    
    source Wobbleinit
    
    rename Site ""
    rename Include ""
}

set W_SITE [lindex [split $W_URL /] 2]

    ################
    # expandIncludes  -  Expand '#include' directives in source file
    #
    # Use the global $includePrefixes list to search for the file.
    # Returns 1 if succesfully expanded, 0 otherwise.

proc expandIncludes {fileName {outFile stdout}} {

    set prefixList $::includePrefixes
    if {[string match /* $fileName]} {
        set prefixList {{}}
    }

    set found ""
    foreach prefix $prefixList {
        
        if {[file readable $prefix$fileName]} {
            set found $prefix$fileName
            break
        }
    }

    if {$found == ""} {
        return 0
    }

    set includePattern "^\[ \t\]*#\[ \t\]*include\[ \t\]*\"(.+)\""

    set inFile [open $found r]
    set lineNum 0

    puts $outFile "#line 1 \"$fileName\""

    while {[gets $inFile line] >= 0} {
        incr lineNum

        if {[regexp $includePattern $line x header]} {
            if {[expandIncludes $header $outFile]} {
                set line "#line $lineNum \"$fileName\""
            }
        }

        puts $outFile $line
    }

    close $inFile

    return 1
}

    ###########
    # urlEncode  -  Convert input string using URL-escapes (%xx)
    #
    # This code is used instead of http::formatQuery, which does not
    # work with binary data.  This implementation works, but is slow.

proc urlEncode {string} {
    global formMapx

    for {set i 0} {$i < 256} {incr i} {
        set c [format %c $i]
        if {[string match {[a-zA-Z0-9_.]} $c]} {
            set formMap($c) $c
        } else {
            array set formMap [list $c %[format %.2x $i]]
        }
    }

    array set formMap {" " +}

        # redefines self to be the workhorse, once setup is complete

    proc urlEncode {string} {
        global formMap

        foreach c [split $string {}] {
            append r $formMap($c)
        }

        return $r
    }

    return [urlEncode $string]
}

    # swiped from "tclhttpd"
proc Url_Decode {data} {
    regsub -all {\+} $data " " data
    regsub -all {([][$\\])} $data {\\\1} data
    regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data  {[format %c 0x\1]} data
    return [subst $data]
}

    # replace the above proc with compiled code if available
catch {package require wurlenc 1.0}

    #############
    # remote_http  -  Talks to the remote wobble server using HTTP
    #
    # Utility code used by do_compile and do_link.

proc remote_http {prog inExt outExt flags inFile outName} {

    set query prog=[urlEncode $prog]
    append query &flags=[urlEncode $flags]
    append query &input_extension=[urlEncode $inExt]
    append query &output_extension=[urlEncode $outExt]
    #puts $query
        # the following is likely to be very inefficient:
    append query &input=[urlEncode [read $inFile]]
    close $inFile

    package require http

    set out [open $outName w]
    set token [::http::geturl $::W_URL -query $query -channel $out]
    close $out

    upvar #0 $token state
    unset state(-query) ;# because it can be huge
    array set meta $state(meta)

    if {[info exists meta(X-WOBBLE-result)]} {
        set result [string trim [Url_Decode $meta(X-WOBBLE-result)]]
        if {$result != ""} {
            puts $result
            set state(status) "remote command failed"
        }
    }

    if {$state(status) != "ok"} {
        file delete $outName
        #parray state
        #parray meta
        error $state(status)
    }
}

    ############
    # do_compile  -  Do one complete remote source compile
    #
    # Uses expandIncludes to locate the file and expand headers.

proc do_compile {command outName inName args} {
    puts "  $command -c -o $outName $args $inName  ($::W_SITE)"

    set inExt c
    if {$command == "g++"} {
        set inExt cpp
    }

    set outExt o
    regexp {\.(.+)$} $outName x outExt

    set tempFile [open tempIn.txt w+]
    fconfigure $tempFile -translation lf

    set flags -c
    if {$outExt == "ro"} {
        append flags " -fPIC"
    }

    if {![expandIncludes $inName $tempFile]} {
        error "Can't find input file: $inName"
    }
    
    seek $tempFile 0
    remote_http $command $inExt $outExt $flags $tempFile $outName

    file delete tempIn.txt
}

    #########
    # do_link  -  Do one complete remote binary link step
    #
    # Sets the result file mode to executable if succesful.

proc do_link {command outName inName args} {
    puts "  $command -o $outName $args $inName  ($::W_SITE)"

    set inExt [string range $inName end end]

    set outExt x
    regexp {\.(.+)$} $outName x outExt

    set flags "-Wl,-s"
    if {$outExt == "so"} {
        set flags "-shared"
    }

    set inFile [open $inName r]
    fconfigure $inFile -translation binary

    remote_http gcc $inExt $outExt $flags $inFile $outName

    file attributes $outName -permissions 0755
}

    #######
    # do_ar  -  Build an archive out of object files (locally)

proc do_ar {outName inName args} {
    puts "  ar crS $outName $inName $args"

    eval exec ar crS $outName $inName $args
}

    #########
    # do_make  -  Wrapper to do a remote make
    #
    # Creates a "../w_<system>/" directory and copies all modified
    # files into it, then starts a "make" in that directory.

proc do_make {os args} {
    if {![file exists os_$os/Wobbleinit]} {
        error "Unknown target, cannot find 'os_$os/Wobbleinit'"
    }

    set dest ../w_$os

        # set up the list of files to copy
    foreach f [glob -nocomplain *] {
        if {![file isdirectory $f]} {
            set fileList($f) $f
        }
    }

        # add/replace platform-specific files
    foreach f [glob -nocomplain os_$os/*] {
        set fileList([file tail $f]) $f
    }

        # omit specific generic files if necessary
    foreach f [glob -nocomplain os_$os.omit/*] {
        unset fileList([file tail $f])
    }

        # create destination, copy changed files into it
    file mkdir $dest
    foreach n [lsort [array names fileList]] {
        set f $fileList($n)
        if {[catch {file copy $f $dest}] &&
                [file mtime $f] > [file mtime $dest/$n]} {
            file copy -force $f $dest
        }
    }

    eval exec make -C $dest $args >@stdout 2>@stderr
}

    ########
    # wobble  -  Dispatches calls to one of the above do_* routines
    #
    # Creates a "../w_<system>/" directory and copies all modified

proc wobble {command args} {
    switch $command {

        c       { eval do_compile gcc $args }
        c++     { eval do_compile g++ $args }

        ld      { eval do_link gcc $args }

        default { eval do_$command $args }
    }
}

    ###########
    # main code

if {[catch {eval wobble $argv} errMsg]} {
    puts "    *** $errMsg ***"
}

exit





##### unused for now

eval wobble $argv

proc expandAll {} {
    foreach arg $argv {

        if {[regexp {^-I(.+)$} $arg x path]} {

                # make sure each prefix ends with a slash
            if {![string match */ $path]} {
                set path $path/
            }

            lappend ::includePrefixes $path

        } else {

            expandIncludes $arg

        }
    }
}