Author Topic: Layout updater  (Read 5896 times)

bob0

  • Posts: 80
  • Turrets: +11/-9
Layout updater
« on: August 11, 2010, 05:54:48 am »
I was unaware that a similar script already existed, but I couldn't have used it for what I wanted anyway, which was converting from the layout that the OC mod saves in (which is, as far as I know, the only precompiled qvm that also includes my implementation of Domination).  So I wrote one in my favourite language: Haskell.

This code is pretty verbose, but it provides an excellent base from which a program that does more sophisticated processing with buildables can be created.

This program converts a layout in the 1.1 format, OC format (will lose information after conversion), and GPP format to the GPP format.  I've used it to convert the dom layouts.

If you don't already have the wonderful GHC installed, you need to install a Haskell compiler or interpreter before you can use this (usually just "pacman -S ghc" or "apt-get install ghc").

After you put it in LayoutUpdate.hs, you can use it like this:
Code: [Select]
% ghc --make -o ~/bin/layoutUpdate LayoutUpdate
% cd /path/to/directory/with/layouts/
% PROG=layoutUpdate; FILES=`find . -name "*.dat"`; for FILE in $FILES; do TMP=$(mktemp); $PROG < $FILE > $TMP || echo -ne "Failed to process ${FILE}\n\n" && mv $TMP $FILE; done
(This last line can be used for other programs that read stdin and output back to stdout.  It can also be tweaked to selectively choose whichever files.)

I have this as an alias in my .zshrc file:
Code: [Select]
alias process='if [[ -z "$PROG" || -z "$FILES" ]]; then echo -ne "aborting: PROG or FILES is empty or not set\n" >& 2; false; else for FILE in $FILES; do cp -i $FILE .${FILE}.pbak; TMP=$(mktemp); ${=PROG} < $FILE > $TMP || echo -ne "Failed to process ${FILE}\n\n" && mv $TMP $FILE; done; unset PROG FILES; fi' # if user denies backing up file, it will still be overwritten unless the user cancels with ^C
alias processq='if [[ -z "$PROG" || -z "$FILES" ]]; then echo -ne "aborting: PROG or FILES is empty or not set\n" >& 2; false; else for FILE in $FILES; do cp $FILE .${FILE}.pbak; TMP=$(mktemp); ${=PROG} < $FILE > $TMP || echo -ne "Failed to process ${FILE}\n\n" && mv $TMP $FILE; done; unset PROG FILES; fi' # ALWAYS overwrite bak file if it exists

You probably want to back up your files first, because the command will overwrite your layouts.

Here it is:
Code: [Select]
#!/usr/bin/env runhaskell

{-
Copyright (C) 2010 Byron James Johnson

This file is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, version 2 of the License.

This file is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY 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 file.  If not, see <http://www.gnu.org/licenses/>.
-}

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative hiding ((<|>), many)
import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List
import Data.Maybe
import Data.Monoid
import System.IO
import Text.Parsec
import Text.Parsec.ByteString.Lazy
import Text.ParserCombinators.Parsec.Char

main :: IO ()
main = do
    contents <- B.getContents
    case parse layout "" contents of
        (Right layouts) -> B.putStr $ convert layouts
        (Left  uhoh)    -> error $ show uhoh

newtype Layout = Layout {buildables    :: [Buildable]}
    deriving (Eq, Show)

data Buildable = Buildable { b_type    :: BuildableType
                           , b_origin  :: Vec3
                           , b_angles  :: Vec3
                           , b_origin2 :: Vec3
                           , b_angles2 :: Vec3
                           }
    deriving (Eq, Show)

data BuildableType = Eggpod
                   | Overmind
                   | Barricade
                   | AcidTube
                   | Trapper
                   | Booster
                   | Hive
                   | Hovel  -- Note: This isn't in the buildable list anymore, but it was
                   | Spawn
                   | MGTurret
                   | Teslagen
                   | Armoury
                   | DCC
                   | Medistat
                   | Reactor
                   | Repeater
                   | DPoint_A
                   | DPoint_B
                   | DPoint_C
                   | DPoint_D
    deriving (Eq, Ord, Show)

newtype BuildableID = BuildableID {buildableID :: Integer}
    deriving (Eq, Ord, Show)
newtype BuildableName = BuildableName {buildableName :: B.ByteString}
    deriving (Eq, Show)

data BuildableDefinition = BuildableDefinition { bd_type :: BuildableType
                                               , bd_id   :: BuildableID
                                               , bd_name :: BuildableName
                                               }
    deriving (Eq, Show)

type Scalar = Double

data Vec3 = Polar3 !Scalar !Scalar !Scalar
    deriving (Eq, Show)

buildableNameSet :: String
buildableNameSet = ['a'..'z']++['A'..'Z']++['0'..'9']++['_', '\'']

buildableDefinitions :: [BuildableDefinition]
buildableDefinitions = flip zipWith [1..] (\ x ~(a, b) -> BuildableDefinition {bd_type = a, bd_id = BuildableID x, bd_name = BuildableName . B.pack $ b}) $
    [ (Eggpod,    "eggpod")
    , (Overmind,  "overmind")
    , (Barricade, "barricade")
    , (AcidTube,  "acid_tube")
    , (Trapper,   "trapper")
    , (Booster,   "booster")
    , (Hive,      "hive")
    , (Hovel,     "hovel")
    , (Spawn,     "telenode")
    , (MGTurret,  "mgturret")
    , (Teslagen,  "tesla")
    , (Armoury ,  "arm")
    , (DCC,       "dcc")
    , (Medistat,  "medistat")
    , (Reactor,   "reactor")
    , (Repeater,  "repeater")
    , (DPoint_A,  "dpoint_a")
    , (DPoint_B,  "dpoint_b")
    , (DPoint_C,  "dpoint_c")
    , (DPoint_D,  "dpoint_d")
    ]

findType :: (Eq a) => [b] -> (b -> a) -> a -> Maybe b
findType xs f x = listToMaybe . flip filter xs $ (== x) . f

findBDef :: (Eq a) => (BuildableDefinition -> a) -> a -> Maybe BuildableDefinition
findBDef = findType buildableDefinitions
findBDefByID = findBDef bd_id
findBDefByName = findBDef bd_name

number :: (Read a, Floating a) => Parser a
number = do
    sign     <- option '0' $ char '-'
    pre      <- many1 digit
    latter   <- option "" $ liftM2 (:) (char '.') (many digit)
    post     <- option "" $ liftM2 (:) (char 'e' <|> char 'E') (liftM2 (:) (option '0' $ char '-') (many digit))
    return . read $ (sign : pre ++ latter ++ post)
    ; <?> "number"

whole :: (Read a, Integral a) => Parser a
whole = read <$> many1 digit <?> "whole number"

vec3 :: Parser Vec3
vec3 = pure Polar3 <*> number <*> number' <*> number' <?> "vec3"
    where number' = spaces *> number

layout :: Parser Layout
layout = Layout <$> many buildable <?> "layout"

buildable :: Parser Buildable
buildable = pure Buildable <*> buildableType <*> s vec3 <*> s vec3 <*> s vec3 <*> (s vec3 <* latter) <?> "buildable"
    where s       = (*>) spaces
          latter  = newline <|> (s whole >> s whole >> s number >> newline) <?> "buildable tail"

buildableType :: Parser BuildableType
buildableType = bd_type <$> ((whole >>= maybe errBT return . findBDefByID . BuildableID) <|> (many1 (oneOf $ buildableNameSet) >>= maybe errBT return . findBDefByName . BuildableName . B.pack)) <?> "buildable type"
    where errBT = fail "invalid or unrecognized buildable type identifier"

convert :: Layout -> B.ByteString
convert = foldl' (flip buildable) B.empty . buildables
    where buildable  x        = flip B.append $ flip B.append (B.pack "\n") $ buildable' x
          buildable' x        = mappend (buildableName . bd_name . findBDefByType . b_type $ x) $
                                    B.concat . getZipList $ (pure $ mappend (B.pack " ") . vec3) <***>
                                    ZipList [b_origin, b_angles, b_origin2, b_angles2]
                                    <***> pure x
          findBDefByType      = fromJust . findBDef bd_type  -- We already parsed a valid buildable, so we know findBDef will never return Nothing
          vec3 (Polar3 x y z) = B.pack $ show x ++ " " ++ show y ++ " " ++ show z

infixr 4 <***>
(<***>) = (<*>)
« Last Edit: August 23, 2010, 05:34:34 am by bob0 »
bob

Crava_Loft

  • Guest
Re: Layout updater
« Reply #1 on: August 28, 2010, 12:05:25 pm »
you could just use awk

WoGoMo

  • Posts: 95
  • Turrets: +6/-6
Re: Layout updater
« Reply #2 on: December 08, 2010, 04:04:34 am »
Sorry if this is reinventing the wheel a bit, but i guess the more the merrier. My script is written in PHP:

To use it, use this on the command line:

Code: [Select]
php -q script_name.php -i input.dat -o output.dat

You must supply the input and output files, so it wont overwrite any files unless you specifically want that.

Code: [Select]
<?php
/**
 * 
 * vim: set expandtab tabstop=4 shiftwidth=4 softtabstop=4:
 *
 * Created : 2010/12/08
 * Author  : WoGoMo
 * License : http://www.gnu.org/licenses/gpl.html
 *
 */

// Some variables we will use throughout the script
$new_lines = array();
$errors = array();
$line_no 1;

// Get command line options
$options getopt('i:o:');

// If -i or -o option was not supplied then print usage message and quit
if (!array_key_exists('i'$options) || !array_key_exists('o'$options))
{
    
printf(
        
"Usage: php -q %s -i <input file> -o <output file>\n",
        
$argv[0]
    );
    exit;
}

// If input file was not found display fatal error and quit
if (!file_exists($options['i']))
{
    
printf(
        
"FATAL: input file '%s' not found\n",
        
$options['i']
    );
    exit;
}

// Populate buildable list
$buildable_list = array(
  
'1'   => 'eggpod',
  
'2'   => 'overmind',
  
'3'   => 'barricade',
  
'4'   => 'acid_tube',
  
'5'   => 'trapper',
  
'6'   => 'booster',
  
'7'   => 'hive',
  
'8'   => 'hovel',
  
'9'   => 'telenode',
  
'10'  => 'mgturret',
  
'11'  => 'tesla',
  
'12'  => 'arm',
  
'13'  => 'dcc',
  
'14'  => 'medistat',
  
'15'  => 'reactor',
  
'16'  => 'repeater',
  
'17'  => 'dpoint_a',
  
'18'  => 'dpoint_b',
  
'19'  => 'dpoint_c',
  
'20'  => 'dpoint_d',
);

// Open the input file for reading
$fd fopen($options['i'], 'r');

// Read input file up to EOF
while (!feof($fd))
{
    
$line trim(fgets($fd1024));
    if (
strlen($line) > 0) {
        if (
eregi('^([0-9]+) ([\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+ [\-]?[0-9]+\.[0-9]+)$'$line$regs))
        {
            
$new_lines[] = sprintf("%s %s\n"$buildable_list[$regs[1]], $regs[2]);
        }
        else
        {
            
$errors[] = sprintf('syntax error on line %d'$line_no);
        }
        
$line_no++;
    }
}

// Close input file
fclose($fd);

// Check for syntax errors and stop if we find any.
if (sizeof($errors) > 0) {
    echo 
"SYNTAX ERRORS DETECTED:\n";
    foreach(
$errors as $key=>$val) {
        echo 
'    '."$val\n";
    }
    echo 
"Please fix the input file and try again.\n";
    exit;
}

// Open output file for writing
$fd fopen($options['o'], 'w');

// Write contents of converted lines
foreach($new_lines as $key=>$val)
{
    
fwrite($fd$val);
}

// Close output file
fclose($fd);

printf("Output written to %s\n"$options['o']);
?>

There is no sig...