#!/usr/bin/tclsh

# Program "convertLevel"
# (C) by Oliver Vogel (e-mail: vogel@ikp.uni-koeln.de)
# May 1st 1996
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public Licences as by published
# by the Free Software Foundation; either version 2; or (at your option)
# any later version
#
# This program is distributed in the hope that it will entertaining,
# but WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILTY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.
# 675 Mass Ave, Cambridge, MA 02139, USA.


proc listLevels {inFile} {
    set fin [open $inFile r]
    while {-1!=[gets $fin line]} {
	if {-1!=[string first "static BMLevelData" $line]} {
	    set name {}
	    scan $line "%s %s %s" d1 d2 name
	    if {"*"!=[string index $name 0]} {
		puts $name
	    }
	}
    }
}

proc extractLevel {levelName inFile outFile} {
    #
    set mode 0
    puts "Parsing data file \"$inFile\"."
    set fin [open $inFile r]
    set fout [open $outFile w]
    while {-1!=[gets $fin line]} {
	if {-1!=[string first "static BMLevelData" $line]} {
	    if {-1!=[string first $levelName $line]} {
		set mode 1
	    } else {
		incr mode $mode
	    }
	}
	if {1==$mode} {
	    set tmp {}
	    scan $line "%s" tmp
	    if {($tmp != {}) && ($tmp != "/*")} {
		puts $fout $line
	    }
	}
    }

    #
    close $fin
    close $fout
    #
    puts "Done."
}

#
# merge level into TCL source file
#
proc mergeLevel {inFile outFile} {
    set fin [open $inFile r]
    set fout [open $outFile w]
    
    # print header
    gets $fin line
    puts -nonewline $fout "set levelData "

    # get rest of file
    while {-1!=[gets $fin line]} {
	if {-1 != [string first "SPRITE_" $line]} {
	    regsub "," $line "\} \{" newLine
	    set line $newLine
	    regsub -all "," $line " " newLine
	    set line "\{ $newLine \} "
	} else {
	    regsub -all "," $line " " newLine
	    set line $newLine
	    regsub -all ";" $line " " newLine
	}
	puts -nonewline $fout $line
    }
    puts $fout ""
    #
    close $fin
    close $fout
}

proc printLevel {levelName levelFile} {
    #
    # set level variable
    #
    source .level.tcl

    #
    regsub -all "_" $levelName "" levelRes

    #
    # print level data
    #
    puts "Writing level data to file \"$levelFile\"."
    set fp [open $levelFile w]
    
    #header
    puts $fp "/* XBlast 2.0 level */"
    puts $fp "static BMLevelData $levelName ="
    puts $fp "\{"
    #level name
    puts $fp "  \"[lindex $levelData 0]\","
    #authors name (default)
    puts $fp "  \"unknown author\","
    #resource name
    puts $fp "  \"xblast.use$levelRes\","
    # game mode (default)
    puts $fp "  GM_Random | GM_234_Player,"
    # scramble blocks (default)
    puts $fp "  SCRAMBLE_VOID,"
    puts $fp "  SCRAMBLE_VOID,"
    # shrink_function
    case [lindex $levelData 1] {
	"special_init_shrink"  {
	    puts $fp "  shrink_compound,"
	}
	"special_init_shrink_2"  {
	    puts $fp "  shrink_spiral,"
	}
	"special_init_shrink_3"  {
	    puts $fp "  shrink_down,"
	}
	"special_init_shrink_4"  {
	    puts $fp "  shrink_???,"
	}
	"special_init_shrink_and_kick"  {
	    puts $fp "  shrink_compound,"
	}
	"special_init_shrink_2_and_kick"  {
	    puts $fp "  shrink_spiral,"
	}
	"special_init_shrink_2_kick_and_remote"  {
	    puts $fp "  shrink_spiral,"
	}
	"special_init_shrink_and_short_fuse"  {
	    puts $fp "  shrink_compound,"
	}
	"special_init_kick_and_RC_and_shrink" {
	    puts $fp "  shrink_compound,"
	}
	default {
	    puts $fp "  shrink_void,"
	}
    }
    # special init function (default)
    puts $fp "  special_init_void,"
    # special game function 
    case [lindex $levelData 3] {
	"special_game_shrink_2_and_haunt" {
	    puts $fp "  special_game_haunt,"
	}
	"special_game_shrink_and_haunt_fast" {
	    puts $fp "  special_game_haunt_fast,"
	}
	"special_game_shrink_2_and_haunt_fast" {
	    puts $fp "  special_game_haunt_fast,"
	}
	default {
	    puts $fp "  special_game_void,"
	}
    }
    # special extra_function
    if {[lindex $levelData 4]=="special_extra_auto_fire"} {
	puts $fp "  special_extra_void,"
    } else {
	puts $fp "  [lindex $levelData 4],"
    }
    # special key_function
    if {[lindex $levelData 5]=="special_key_auto_fire"} {
	puts $fp "  special_key_void,"
    } else {
	puts $fp "  [lindex $levelData 5],"
    }
    # now the player positions
    puts $fp "  \{"
    foreach ppos [lindex $levelData 6] {
	regsub -all "SPRITE_UP" $ppos "1" p1
	regsub -all "SPRITE_DOWN" $p1 "11" p2
	regsub -all "SPRITE_LEFT" $p2 "1" p3
	regsub -all "SPRITE_RIGHT" $p3 "13" p4
	regsub -all "BLOCK_WIDTH" $p4 "1" p5
	regsub -all "BLOCK_HEIGHT" $p5 "1" p6
	set ypos [expr [lindex $p6 0]]
	set xpos [expr [lindex $p6 1]]
	puts $fp "    \{ $ypos, $xpos \},"
    }
    puts $fp "  \},"
    # print number of bombs, inital range, init_flags, init_heath
    case [lindex $levelData 1] {
	special_init_kick {
	    set initFlag IF_Kick
	}
	special_init_teleport {
	    set initFlag IF_Teleport
	}
	special_init_shrink_and_kick {
	    set initFlag IF_Kick
	}
	special_init_kick_and_RC_and_shrink {
	    set initFlag "IF_Kick | IF_RC"
	}
	special_init_shrink_2_and_kick {
	    set initFlag IF_Kick
	}
	special_init_shrink_2_kick_and_remote {
	    set initFlag "IF_Kick | IF_RC"
	}
	default {
	    set initFlag IF_None
	}
    }
    case [lindex $levelData 1] {
	special_init_race {
	    set initHealth IllRun
	}
	default {
	    set initHealth Healthy
	}
    }
    puts $fp [format "  %s, %s, %s, %s, %s,"  \
	    [lindex $levelData 7] \
	    [lindex $levelData 8] \
	    [lindex $levelData 9] \
	    $initFlag \
	    $initHealth ]
    # bomb behavours
    case [lindex $levelData 1] {
	special_init_short_fuse {
	    set fuseTime FUSEshort
	}
	special_init_shrink_and_short_fuse {
	    set fuseTime FUSEshort
	}
	default {
	    set fuseTime FUSEnormal
	}
    }
    puts $fp "  $fuseTime, BMTnormal, BMTnormal, BMTnormal,"
    # extra patterns
    puts -nonewline $fp "  \{"
    foreach i [lindex $levelData 10] {
	puts -nonewline $fp " $i,"
    }
    puts $fp " \},"
    # now the block gfx
    puts $fp "  \{"
    set count 0
    foreach i [lindex $levelData 11] {
	case $count {
	    0 {
		set fgColor  "SlateBlue"
		set addColor "SteelBlue"
	    }
	    2 {
		set fgColor  "Goldenrod"
		set addColor "LightGoldenrod"
	    }
	    3  {
		set fgColor  "Sienna"
		set addcolor  "Orange"
	    }
	    10 {
		set fgColor  "RoyalBlue"
		set addColor  "MidnightBlue"
	    }
	}
	case $i {
	    BLBomb {
		puts $fp "    EXTRA_BOMB,"
	    }
	    BLRange {
		puts $fp "    EXTRA_RANGE,"
	    }
	    BLTrap {
		puts $fp "    EXTRA_TRAP,"
	    }
	    BLKick {
		puts $fp "    EXTRA_KICK,"
	    }
	    BLInvincible {
		puts $fp "    EXTRA_INVINC,"
	    }
	    BLIgnite {
		puts $fp "    EXTRA_BUTTON,"
	    }
	    BLRemoteControl {
		puts $fp "    EXTRA_RC,"
	    }
	    BL_Q3A_BEAM {
		puts $fp "    EXTRA_BEAM,"
	    }
	    default {
		puts $fp "    \{ $i, \"Black\", \"$fgColor\", \"$addColor\" \},"
	    }
	}
	incr count
    }
    # fill up rest of blocks
    set fgColor RoyalBlue
    while {$count < 11} {
	puts $fp "    \{ BLScoreFloor, \"$fgColor\", \"$fgColor\", \"$fgColor\"\
		 \},"
	incr count
    }
    puts $fp "  \},"
    # now shadow and extra mode
    case [lindex $levelData 4] {
	special_extra_auto_fire {
	    puts $fp "  [lindex $levelData 12], DEnone,"
	}
	special_extra_void {
	    puts $fp "  [lindex $levelData 12], DEnone,"
	}
	special_extra_stunned {
	    puts $fp "  [lindex $levelData 12], DEnone,"
	}
	default {
	    puts $fp "  [lindex $levelData 12], DEall,"
	}
    }
    # bomb click behoavor (default)
    puts $fp "  BC_None, WC_None, PC_StunStop,"
    # level description
    puts $fp "  \"no description yet\","
    # now the block data 
    puts $fp "  \{"
    foreach x [lindex $levelData 13] {
	puts -nonewline $fp "    \{ "
	foreach y $x {
	    puts -nonewline $fp "$y,"
	}
	puts $fp " \},"
    }
    puts $fp "  \},"
    # that's all folks
    puts $fp "\};"
    
    #
    close $fp
    puts "Done!"
}

#
# main programm
#

# check args
if {($argc != 2) && ($argc != 1)} {
    puts "usage: $argv0 dataFile \[levelName\]"
    exit 
}

set levelName [lindex $argv 1]
set dataFile  [lindex $argv 0]
set levelFile "level/${levelName}.h"

if {$argc == 1} {
    # just list levels
    listLevels $dataFile
} else {
    # check if level file exits
    if {[file exists $levelFile]} {
	puts "Error: level file \"$levelFile\" already exits"
	exit 
    }
    
    # the conversion
    extractLevel $levelName $dataFile .level.dat
    mergeLevel .level.dat .level.tcl
    printLevel $levelName $levelFile
    
    # garbage collection
    exec rm .level.tcl .level.dat
}

exit
