#!/usr/local/bin/perl #MPML2MSAScript ver. 1.0.0 Feb/14/1999 #usage: MPML2MSAScript mpmlfile [htmlfile] #output: htmlfile.out ### 初期化 ### &initialize; ############## open (INFILE, $ARGV[0]) || die "cannot open $ARGV[0]"; # mpmlファイル読み込み ######################################### ####### MPML解析部 ####### $code = &makecode; # 内部変数作成用にコードの変数を作成 &make_construction('root','mpml_1',$code); # 内部変数を作成 ######################################### ####################################### ###### MPML検証部呼び出し ####### &verify(@{ $construction{root} }); ####################################### open (INFILE, $ARGV[1]) || $no_html++; # 入力されたhtmlファイルをINFILEに $filename = $ARGV[1]; # ２番目に入力されたファイル名 if ($filename) { $filename =~ s/(\w+).*/$1\.out/; # 拡張子を.outにして出力用にopen } else { $filename = "a.out"; # htmlファイルが入力されなかったらa.outに } open (OUTFILE, ">$filename") || die "cannot create $filename\n"; open (TMPFILE, ">a.tmp") || die "cannot create a.tmp\n"; ## HTMLファイルをの直前まで出力ファイルに書き込む ## ## 以降はTMPファイルに保存しておく ## HTMLLINE: while () { until ($bodyend_exist){ unless (m@@i) { # を含まないなら print OUTFILE; # 普通に吐いて next HTMLLINE; # 次の行を見ます。 } print OUTFILE $`; print TMPFILE $'; $bodyend_exist++; next HTMLLINE; } print TMPFILE $_; } close OUTFILE; # 一回閉じます close TMPFILE; # 閉じます ############################################################## &convert; # メインルーチンを呼び出します ############################################################## open (OUTFILE, ">>$filename"); # 追加書き込み用に開きます open (WORKFILE, "a.log"); # 読み込み用に開きます while (){ # a.logが残っている限り print OUTFILE; # 吐きます } close WORKFILE; # 全部吐いたのでもう用なしです unlink "a.log"; # （捨ててもよい） open (TMPFILE, "a.tmp"); # 以降を保存する一時ファイル while (){ # 一時ファイルがあれば print OUTFILE; # 吐きます } close TMPFILE; # 一時ファイルを閉じて unlink "a.tmp"; # 捨てます exit; # 終わります ################################################################## #@@@@@@@@@@@@@@@ メインルーチン @@@@@@@@@@@@@@@@# ################################################################## sub convert{ open (WORKFILE, ">a.log") || die "cannot create a.log\n"; # 書き込み用 &set_background; # まず背景リージョンを設定します &write_region; # リージョンを作業ファイルに書き込みます &write_Sub_Initialize; # Initializeサブルーチンをa.initに &write_mainpart; # メインパートをa.mptに作成します &write_command; # コマンドルーチンをa.cmdに作成 ##################################################### # これ以降、スクリプトをWORKFILEに書き込みます # まで。 select WORKFILE; &add_start; # OBJECT, SCRIPTタグを追加 # Dim,mpt,pcd, cmd,rqc,init を追加 &add_file("a.dim", "a.mpt", "a.pcd", "a.cmd", "a.rqc", "a.init"); &add_bodyend; # bodyを閉じます ##################################################### close WORKFILE; # 書き込み用だったのを一回閉じて } ############################## a.mpt の書き込み ########################### sub write_mainpart{ open (MAINPART, ">a.mpt"); # 書き込み用。このルーチンで全て書込完了なら。 select MAINPART; print "Sub Window_OnLoad()\nInitialize\n"; print "Step1\nEnd Sub\n\n"; my @wbody = @{ $construction{body_1} }; # body要素のリストを格納 ##################### を読んでいきます ####################### &read_contents(@wbody); ##################################################################### close MAINPART; open(RQCFILE, ">>a.rqc"); if ($reqnum >= 2) { print RQCFILE "End If\nEnd Sub\n"; close RQCFILE; } return; } sub read_contents{ my @wbody = @_; my $element; while ( $element = shift( @wbody ) ) { # 子要素をひとつずつ見ていきます #$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$# my $nextelement; if ($wbody[0]) { $nextelement = $wbody[0]; } else { $end = 1; } # 自分がだったら if ( $element =~ /^par/) { &print_par($element, $nextelement); # 自分がだったら } elsif ( $element =~ /^seq/ ) { &print_seq($element, $nextelement); # 自分がそれ以外の要素だったら } else { if ($end) { # 終わりなら &print_parchild($element); } else { # 終わりでないなら &print_seqchild($element, $nextelement); } } #$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$# } #&&&&&&& anchor の処理 &&&&&&&# my $i; for ($i=1; $i<=$number{anchor}; $i++) { my $ancname = "anchor_$i"; my $parentname = $parent{$ancname}; $whenis{$ancname} = $whenis{$parentname}; } } sub print_seq{ my $element = @_[0]; my $nextelement =@_[1]; $whenis{$element} = $step; # stepを記憶させます。 my $childnum = scalar(@{$construction{$element}}); for ($i=0; $i<$childnum; $i++) { my $childname = $construction{$element}[$i]; my $nextchild = $construction{$element}[$i+1]; if ($nextchild) { &print_seqchild($childname, $nextchild); } elsif (! $end) { &print_seqchild($childname, $nextelement); } else { &print_parchild($childname); } } } sub print_seqchild{ my $element = @_[0]; my $nextelement = @_[1]; $whenis{$element} = $step; # stepを記憶させます。 ##### parタグが出てきたら ##### if ($element =~ /^par_/) { &print_par($element); ##### seqタグが出てきたら ##### } elsif ($element =~ /^seq_/) { &print_seq($element); ##### agentタグが出てきたら ##### } elsif ($element =~ /^agent_(\d+)/) { # タグの場合 print "\nSub Step$step\n"; $cagent = "AgentChar$1"; if ($attribute{$element}{appear} eq 'now'){ &define_newvar ("Request$reqnum"); # リクエストを設定して print "Set Request$reqnum = "; # カキコ &write_ReqComp($nextelement); # RequestCompleteに追加 print "\t$cagent.Show\n"; } else { $step++; print "\tStep$step\n"; } print "End Sub\n\n"; ##### moveタグが出てきたら ##### } elsif ($element =~ /^move_/) { print "Sub Step$step\n"; my $agentid = $id{ $attribute{$element}{agent} }; if ($agentid =~ /(\d)/) { # ?agent指定 $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } else { $agentid = "agent_$number{agent}"; } if (defined $attribute{$element}{region} ) { my $x = $location{ $id{$attribute{$element}{region}}}{left}; my $y = $location{ $id{$attribute{$element}{region}}}{top}; &define_newvar ("Request$reqnum"); # リクエストを設定して print "Set Request$reqnum = "; # カキコ &write_ReqComp($nextelement); # RequestCompleteに追加 print "$cagent.MoveTo($x, $y)\n"; $whareis{$agentid}{x} = $x; $whareis{$agentid}{y} = $y; } elsif (defined $attribute{$element}{location}) { my $loc = "$attribute{$element}{location}"; $loc =~ /(\S+?),\s*(\S+)/; my $x = $1; my $y = $2; $x = $bglx + $window_x * $1 / 100 if ($x =~ /([\w\.]+)%/); $y = $bgty + $window_y * $1 / 100 if ($y =~ /([\w\.]+)%/); &define_newvar ("Request$reqnum"); # リクエストを設定して print "Set Request$reqnum = "; # カキコ &write_ReqComp($nextelement); # RequestCompleteに追加 print "$cagent.MoveTo($x, $y)\n"; $whareis{$agentid}{x} = $x; $whareis{$agentid}{y} = $y; } $step++; print "End Sub\n\n"; ##### playタグが出てきたら ##### } elsif ($element =~ /^play_/) { print "Sub Step$step\n"; my $agentid; my $actval = "\L$attribute{$element}{act}\E"; # 属性値を小文字に if ($id{ $attribute{$element}{agent} } =~ /(\d)/) { # ?agent指定 $agentid = $id{ $attribute{$element}{agent} }; $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } else { $agentid = "agent_$number{agent}"; } &define_newvar ("Request$reqnum"); # リクエストを設定して print "Set Request$reqnum = "; # カキコ &write_ReqComp($nextelement); # RequestCompleteに追加 unless ($playact{$actval} =~ /^!/) { # 特別な属性値でなければ print "$cagent.Play(\"$playact{$actval}\")\n"; } else { # $playactに!がある場合の処理 if ($playact{$actval} eq '!look'){ # 対象を見る場合 my $ax = $whareis{$agentid}{x}; my $ay = $whareis{$agentid}{y}; my $ox = $location{$id{$attribute{$element}{object}}}{left}; my $oy = $location{$id{$attribute{$element}{object}}}{top}; my $direct = &whichdirection($ax,$ay,$ox,$oy); print "$cagent.Play(\"Look$direct\")\n"; }elsif ($playact{$actval} eq '!point'){ # 対象を指す場合 my $ox = $location{$id{$attribute{$element}{object}}}{left}; my $oy = $location{$id{$attribute{$element}{object}}}{top}; print "$cagent.GestureAt $ox, $oy\n"; }else{ # その他のdegreeによって変わる属性値 my $act = &act_routine($element); print "$cagent.Play(\"$act\")\n"; } } $step++; print "End Sub\n\n"; ##### speakタグが出てきたら ##### } elsif ($element =~ /^speak_/) { print "Sub Step$step\n"; if ($id{ $attribute{$element}{agent} } =~ /(\d)/) { # ?agent指定 $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } # my $content = &cut_white( $speakcontent{$element} ); $content =~ s///ig; # とりあえずanchorはサポートせず &define_newvar ("Request$reqnum"); # リクエストを設定して print "Set Request$reqnum = "; # カキコ &write_ReqComp($nextelement); # RequestCompleteに追加 print "$cagent.Speak(\"$content\")\n"; $step++; print "End Sub\n\n"; ##### refタグが出てきたら ##### } elsif ($element =~ /^ref_/) { # print "Sub Step$step\n"; my $lockey; # $lockeyがtargetウィンドウになります if (defined $attribute{$element}{region}){ # $lockey = $id{$attribute{$element}{region}}; } else { # $lockey = $id{background}; } # my $func; if (exists $location{$lockey}){ $func = ",\"location=no"; # IEのロケーションボックスを無効に $func .= ", scrollbars=yes" # スクロールバー付けるか? if $attribute{$lockey}{fit}=~/scroll/i; $func .= ", width=$location{$lockey}{width}" if $location{$lockey}{width}; # $func .= ", height=$location{$lockey}{height}" if $location{$lockey}{height}; # $func .= ", top=$location{$lockey}{top}" if (exists $location{$lockey}{top}); # $func .= ", left=$location{$lockey}{left}" # if (exists $location{$lockey}{left}); # $func .= "\""; # } print "Open \"$attribute{$element}{src}\",\"$lockey\""."$func\n"; my $nextstep = $step +1; # Openメソッドはリクエストとして認識されない print "Step$nextstep\n"; $step++; print "End Sub\n\n"; ##### a タグが出て来たら ##### } elsif ($element =~ /^a_/) { print "Sub Step$step\n"; my $agentid; if ($id{ $attribute{$element}{agent} } =~ /(\d)/) { # ?agent指定 $agentid = $id{ $attribute{$element}{agent} }; $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } print "$cagent.Listen True\n"; # Listenメソッドはリクエストにならない? my $nextstep = $step +1; print "Step$nextstep\n"; $step++; print "End Sub\n\n"; } } sub print_par{ my $element = @_[0]; my $nextelement = @_[1]; $whenis{$element} = $step; # stepを記憶させます。 my $childnum = scalar(@{$construction{$element}}); print "Sub Step$step\n"; my $i; for ($i=1; $i<=$childnum; $i++) { my $snum = $step + $i; print "\tStep$snum\n"; } print "End Sub\n\n"; for ($i=0; $i<$childnum-1; $i++) { $step++; &print_parchild($construction{$element}[$i]); } $step++; unless ($end) { &print_seqchild($construction{$element}[$i], $nextelement); } else { &print_parchild($construction{$element}[$i]); } } sub print_parchild{ my $element = @_[0]; $whenis{$element} = $step; # stepを記憶させます。 ##### parタグが出てきたら ##### if ($element =~ /^par_/) { &print_par($element); ##### seqタグが出てきたら ##### } elsif ($element =~ /^seq_/) { &print_seq($element); ##### agentタグが出てきたら ##### } elsif ($element =~ /^agent_(\d+)/) { # タグの場合 print "\nSub Step$step\n"; $cagent = "AgentChar$1"; if ($attribute{$element}{appear} eq 'now'){ print "\t$cagent.Show\n"; } print "End Sub\n\n"; ##### moveタグが出てきたら ##### } elsif ($element =~ /^move_/) { print "Sub Step$step\n"; my $agentid = $id{ $attribute{$element}{agent} }; if ($agentid =~ /(\d)/) { # ?agent指定 $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } else { $agentid = "agent_$number{agent}"; } if (defined $attribute{$element}{region} ) { my $x = $location{ $id{$attribute{$element}{region}}}{left}; my $y = $location{ $id{$attribute{$element}{region}}}{top}; print "\t$cagent.MoveTo $x, $y \n"; $whareis{$agentid}{x} = $x; $whareis{$agentid}{y} = $y; } elsif (defined $attribute{$element}{location}) { my $loc = "$attribute{$element}{location}"; $loc =~ /(\S+?),\s*(\S+)/; my $x = $1; my $y = $2; $x = $bglx + $window_x * $1 / 100 if ($x =~ /([\w\.]+)%/); $y = $bgty + $window_y * $1 / 100 if ($y =~ /([\w\.]+)%/); print "\t$cagent.MoveTo $x, $y\n"; $whareis{$agentid}{x} = $x; $whareis{$agentid}{y} = $y; } print "End Sub\n\n"; ##### playタグが出てきたら ##### } elsif ($element =~ /^play_/) { print "Sub Step$step\n"; my $agentid; my $actval = "\L$attribute{$element}{act}\E"; # 属性値を小文字に if ($id{ $attribute{$element}{agent} } =~ /(\d)/) { # ?agent指定 $agentid = $id{ $attribute{$element}{agent} }; $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } else { $agentid = "agent_$number{agent}"; } unless ($playact{$actval} =~ /^!/) { # 特別な属性値でなければ print "$cagent.Play \"$playact{$actval}\"\n"; } else { # $playactに!がある場合の処理 if ($playact{$actval} eq '!look'){ # 対象を見る場合 my $ax = $whareis{$agentid}{x}; my $ay = $whareis{$agentid}{y}; my $ox = $location{$id{$attribute{$element}{object}}}{left}; my $oy = $location{$id{$attribute{$element}{object}}}{top}; my $direct = &whichdirection($ax,$ay,$ox,$oy); print "$cagent.Play \"Look$direct\"\n"; }elsif ($playact{$actval} eq '!point'){ # 対象を指す場合 my $ox = $location{$id{$attribute{$element}{object}}}{left}; my $oy = $location{$id{$attribute{$element}{object}}}{top}; print "$cagent.GestureAt $ox, $oy\n"; }else{ # その他のdegreeによって変わる属性値 my $act = &act_routine($element); print "$cagent.Play \"$act\"\n"; } } print "End Sub\n\n"; ##### speakタグが出てきたら ##### } elsif ($element =~ /^speak_/) { print "Sub Step$step\n"; if ($id{ $attribute{$element}{agent} } =~ /(\d)/) { # ?agent指定 $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } # my $content = &cut_white( $speakcontent{$element} ); $content =~ s///ig; # とりあえずanchorはサポートせず print "$cagent.Speak \"$content\"\n"; print "End Sub\n\n"; ##### refタグが出てきたら ##### } elsif ($element =~ /^ref_/) { # print "Sub Step$step\n"; my $lockey; # $lockeyがtargetウィンドウになります if (defined $attribute{$element}{region}){ # $lockey = $id{$attribute{$element}{region}}; } else { # $lockey = $id{background}; } # my $func; if (exists $location{$lockey}){ $func = ",\"location=no"; # IEのロケーションボックスを無効に $func .= ", scrollbars=yes" # スクロールバー付けるか? if $attribute{$lockey}{fit}=~/scroll/i; $func .= ", width=$location{$lockey}{width}" if $location{$lockey}{width}; # $func .= ", height=$location{$lockey}{height}" if $location{$lockey}{height}; # $func .= ", top=$location{$lockey}{top}" if (exists $location{$lockey}{top}); # $func .= ", left=$location{$lockey}{left}" # if (exists $location{$lockey}{left}); # $func .= "\""; # } print "Open \"$attribute{$element}{src}\",\"$lockey\""."$func\n"; print "End Sub\n\n"; ##### a タグが出て来たら ##### } elsif ($element =~ /^a_/) { print "Sub Step$step\n"; my $agentid; if ($id{ $attribute{$element}{agent} } =~ /(\d)/) { # ?agent指定 $agentid = $id{ $attribute{$element}{agent} }; $cagent = "AgentChar$1"; # 指定されていたらそのキャラ } print "$cagent.Listen True\n"; print "End Sub\n\n"; } } #エージェントの座標と対象の座標から、エージェントからみた対象の方向を返す sub whichdirection{ my $rx = $_[2]-$_[0]; my $ry = -$_[3]+$_[1]; # 座標の付け方がxy座標と反対なので my $dval= atan2($ry,$rx)*$fourparpi; if (-1<=$dval && $dval<1) {return "Left";} elsif (1<=$dval && $dval<3) {return "Up";} elsif (-3<=$dval && $dval<-1) {return "Down";} else {return "Right";} } # degreeによって変化したりするようなactの属性値を決定するルーチン sub act_routine { my $element = $_[0]; # 引数 my $actval = "\L$attribute{$element}{act}\E"; # 属性値を小文字に my $degree; # 動作の程度 if ($attribute{$element}{degree}) { # が設定されていたら $degree = $attribute{$element}{degree}; # それを$degreeに } else { # されていなかったら $degree = 50; # デフォルト値に設定 } if ($actval eq 'uncertain') { ($degree <= 60)? return 'Uncertain': return 'DontRecognize'; } elsif ($actval eq 'dontrecognize') { ($degree <= 40)? return 'Uncertain': return 'DontRecognize'; } elsif ($actval eq 'listen') { ($degree <= 40)? return 'Hearing_1': return 'StartListening'; } elsif ($actval eq 'listening') { ($degree <= 40)? return 'Hearing_1': return 'StartListening'; } elsif ($actval eq 'hear') { ($degree <= 60)? return 'Hearing_1': return 'StartListening'; } elsif ($actval eq 'hearing') { ($degree <= 60)? return 'Hearing_1': return 'StartListening'; } } sub write_command{ open (CMDFILE, ">a.cmd") || die "cannot open a.cmd"; select CMDFILE; if ($number{a}){ print "\nSub AgentCtl_Command (ByVal UserInput)\n"; print "CommandSelected = UserInput.Name\n\n"; print "Select Case CommandSelected\n"; my $i; for ($i=1; $i<=$number{a}; $i++) { my $myele = "a_$i"; my $mymode = $attribute{$myele}{mode}; $mymode ="jump" unless ($attribute{$myele}{mode}); $mymode =~ s/(.*)/\L$1\E/; my $com; if ($attribute{"a_$i"}{title}) { $com = $attribute{$myele}{title}; } else { $com = "Com$i"; } print "\tCase \"$com\"\n"; if ($mymode eq 'replay'){ print "\tNavigate \"$filename\"\n"; # はじめからやりなおし } elsif ($mymode eq 'open'){ print "\tOpen \"$attribute{$myele}{href}\"\n"; } elsif ($mymode eq 'jump'){ $attribute{$myele}{href} =~ /#(\S+)/; my $targetele = $id{$1}; my $targetstep = $whenis{$targetele}; print "\tStep$targetstep\n"; } } print "End Select\n\nEnd Sub\n"; } close CMDFILE; } sub write_Sub_Initialize{ open (INITFILE, ">a.init") || die "cannot open a.init"; select INITFILE; print "\nSub Initialize\n"; print "AgentCtl.Connected = True\nOn Error Resume Next\n"; # オマジナイ ###################### agentの初期設定 ############################### my $i; my $agentname; for ($i=1; $i<=$number{agent}; $i++) { $cagent = "AgentChar$i"; print "'Load $cagent\n"; my $char = $attribute{"agent_$i"}{character}; if ($char =~ /(genie|robby|merlin|peedy)/i) { # この中のどれかだったら $char = "\L$1\E.acs"; # それをロード } else { # 違ったら $char = "genie.acs"; # ジーニーの登場となる } print "Set LoadReq = AgentCtl.Characters.Load (\"char$i\", \"$char\")\n"; print "If LoadReq.Status = 1 Then\n\tMsgBox 'cannot load character!'\nEnd If\n"; print "Set $cagent = AgentCtl.Characters (\"char$i\")\n"; &define_newvar($cagent); # グローバルに定義 if (! $attribute{"agent_$i"}{language} || # 設定されてないか $attribute{"agent_$i"}{language} eq "english") { # englishなら print "$cagent.LanguageID = &H0409\n"; # 英語に設定 } if ($attribute{"agent_$i"}{region}){ # regionが指定されていたら my $regionname = $id{$attribute{"agent_$i"}{region}}; print "$cagent.MoveTo "; print "$location{$regionname}{left}, "; print "$location{$regionname}{top}\n"; $whareis{"agent_$i"}{x} = $location{$regionname}{left}; $whareis{"agent_$i"}{y} = $location{$regionname}{top}; } $attribute{"agent_$i"}{appear}="always" unless $attribute{"agent_$i"}{appear}; if ($attribute{"agent_$i"}{appear} eq 'always') { # alwaysだったら print "$cagent.Show\n"; } } ######コマンド追加 for ($i=1; $i<=$number{a}; $i++) { if ($attribute{"a_$i"}{key}){ if ($attribute{"a_$i"}{agent}) { my $ag = $id{$attribute{"a_$i"}{agent}}; $ag =~ /(\d)/; $cagent = "AgentChar$1"; } if ($i==1){ print "$cagent.Commands.Caption = \"Control Commands\"\n"; print "$cagent.Commands.Voice = \"Control Commands\"\n\n"; } my ($com, $conf); if ($attribute{"a_$i"}{title}) { $com = $attribute{"a_$i"}{title}; } else { $com = "Com$i"; } print "$cagent.Commands.Add \"$com\", \"&$com\", "; my $key = $attribute{"a_$i"}{key}; print "\"$key\"\n"; print "$cagent.Commands.ConfidenceText = \"Dont Recognize.\"\n"; if ($attribute{"a_$i"}{confidence}){ $conf = $attribute{"a_$i"}{confidence} - 100; } else { $conf = -50; } print "$cagent.Commands.Confidence = $conf\n"; } } print "End Sub\n"; close INITFILE; } sub write_region{ my $i; for ($i=1; $i<=$number{region}; $i++){ my $workregion = "region_"."$i"; &set_location($workregion); } } sub add_file { # 指定ファイルを現在ハンドルに書き込み my $filename; foreach $filename (@_){ print "\n"; open(ADDINGFILE, $filename); while(){ print; } close ADDINGFILE; unlink $filename; } } #### backgroundのウィンドウサイズを定義 #### sub set_background{ my $bgregion; if ($number{'root-layout'}){ # ちゃんとroot-layoutがあったら $bgregion = "root-layout_"."$number{'root-layout'}"; # 最後のを。 } ## widthで指示された場合 $window_x = $attribute{$bgregion}{width} if defined $attribute{$bgregion}{width}; $window_y = $attribute{$bgregion}{height} if defined $attribute{$bgregion}{height}; ## boxで指示された場合 if (defined $attribute{$bgregion}{box}) { unless ($attribute{$bgregion}{box} =~ /%/ ) { $attribute{$bgregion}{box} =~ /(\S+?),\s*(\S+?),\s*(\S+?),\s*(\S+)/; my $value = $&; my $lx = $1; my $ty = $2; my $rx = $3; my $by = $4; $bglx = $lx; $bgty = $ty; if (not $value =~ /\+/){ $window_x = $rx - $lx; $window_y = $by - $ty; } else { $window_x = abs $rx; $window_y = abs $by; } } } # もしbackgroundという名のidが設定されていなかったら $id{background} = $bgregion unless (defined $id{background}); # デフォルトの背景のサイズ(800x600)を設定 $window_x = 800 unless defined $window_x; $window_y = 600 unless defined $window_y; } ########### regionのlocationをセットします ########## sub set_location{ my $workregion = $_[0]; # 引数 my $lx = $attribute{$workregion}{left}; # left属性があったら my $ty = $attribute{$workregion}{top}; # top属性があったら my ($rx, $by); my $width = $attribute{$workregion}{width}; my $height = $attribute{$workregion}{height}; if (defined $attribute{$workregion}{location}){ # location属性が $attribute{$workregion}{location} =~ /(\S+?),\s*(\S+)/; $lx = $1; $ty = $2; } if (defined $attribute{$workregion}{box}){ # box属性があったら $attribute{$workregion}{box} =~ /(\S+?),\s*(\S+?),\s*(\S+?),\s*(\S+)/; $lx = $1; $ty = $2; $rx = $3; $by = $4; } $lx = $bglx + $window_x * $1 / 100 if ($lx =~ /([\w\.]+)%/); $ty = $bgty + $window_y * $1 / 100 if ($ty =~ /([\w\.]+)%/); $rx = $bglx + $window_x * $1 / 100 if ($rx =~ /([\w\.]+)%/); $by = $bgty + $window_y * $1 / 100 if ($by =~ /([\w\.]+)%/); $width = $rx - $lx if defined $rx; $height = $by - $ty if defined $by; if ($rx =~ /\+/ ) { $width = $rx; } if ($by =~ /\+/ ) { $height = $by; } $location{$workregion}{left} = $lx; $location{$workregion}{top} = $ty; $location{$workregion}{width} = $width; $location{$workregion}{height} = $height; } sub define_newvar{ # 新しいグローバル変数を定義 open(DIMFILE, ">>a.dim"); print DIMFILE "Dim $_[0]\n"; close DIMFILE; } sub write_ReqComp{ # Sub AgentCtl_RequestCompleteを書いてリクエストを追加します my $myreq = "Request$reqnum"; my $nextele = @_[0]; my $mybeg; open(RQCFILE, ">>a.rqc"); if ($reqnum == 1){ print RQCFILE "Sub AgentCtl_RequestComplete (ByVal Request)\n"; print RQCFILE "If Request = $myreq Then\n\t"; } else { print RQCFILE "ElseIf Request = $myreq Then\n\t"; } if ($attribute{$nextele}{begin}){ $mybeg = $attribute{$nextele}{begin}; # beginが指定されていたら $mybeg =~ /(\d+)/; # とりあえず単位"s"とする $mybeg *= 1000; } else { $mybeg = 500; } my $nextstep = $step+1; print RQCFILE "ID = SetTimeout(\"Step$nextstep\", $mybeg)\n"; close RQCFILE; ++$reqnum; } sub add_bodyend{ print ' --> '; print "\n" unless $no_html; } sub add_start{ #