スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

F#で入門 コンパイラ、インタプリタ編 befunge93(2)

 今回は前回のソフトをウィンドウソフト化します。
実行画面は次のようにします。
(一括実行)
コード部分は編集可能です。

479-1.jpg

(ワンステップ実行)
「ステップ実行リセット」ボタンで、一括実行の画面のコードをロードします。
ステップ毎にどのような命令かを下に表示されるようにしています。

479-2.jpg

デザイン部分は、コード表示部分のテキストボックス群以外の部分をC#プロジェクトとして、デザインしてこれをSimpleConverterで変換することにより作成しています。
またコード表示部分のテキストボックス群はF#のコード上で付け加えています。
(なお手抜きで大量のテキストボックスを使用していますが、良い子のみなさんはマネしないでください。
表示は遅いし大変です。)
(サンプルソースはこちらに多数あります。beer.bfなどは実行時間が異様にかかるので注意!)

全コードは次の通りです。
(ソースの改変・流用はご自由にどうぞ。)


  
open System    
open System.Windows.Forms    
open System.Drawing    
 
////////////////入出力用関数ホルダ////////////////  
let mutable forInputIntFunc :(unit->int)    = (fun () -> 0)  
let mutable forInputCharFunc :(unit->int)   = (fun () -> 0) 
let mutable forOutputIntFunc:(int->unit) = (fun _ -> ())  
let mutable forOutputCharFunc:(int->unit) = (fun _ -> ())  
 
 
let MaxRowNum =  25 
let MaxColNum =  80 
let MaxRowIndex = MaxRowNum - 1 
let MaxColIndex = MaxColNum - 1 
 
type ExecMode = 
    |ONCE_EXEC_STOP 
    |ASCII_PUSH 
    |DEFAULT 
    |EXIT 
 
type Direct = 
    |UP  
    |DOWN 
    |RIGHT 
    |LEFT 
 
//list<string>を2DArrayに変換 
let makeCode2DArr (inpStrLst:list<string>) = 
    let (codeArr:char[,]) = Array2D.create  MaxRowNum MaxColNum ' ' 
    inpStrLst 
       |> List.mapi (fun i st -> let cArr = st.ToCharArray()  
                                 for index in [0 .. ((Array.length cArr) - 1)] do 
                                      codeArr.[i,index] <- cArr.[index] 
                  )  
       |> ignore 
                                 
    codeArr    
 
//方向とindexの組から次のindexを返す 
//getNextCoord UP (3,2)  ->  (2, 2) 
let getNextCoord (dir:Direct) ((c,r):int*int) = 
    match dir with 
    |UP when c = 0              -> (MaxRowIndex,r) 
    |UP                         -> (c - 1 ,r) 
    |DOWN when c = MaxRowIndex  -> (0,r) 
    |DOWN                       -> (c + 1,r) 
    |LEFT when r = 0            -> (c,MaxRowIndex) 
    |LEFT                       -> (c, r - 1) 
    |RIGHT when r = MaxColIndex -> (c,0) 
    |RIGHT                      -> (c, r + 1)  
 
//スタック関連のエラー int*intはエラーの発生したコードの行と列 
exception MyStackExcp of int*int 
//ソース中に不正なcharactorが含まれていた時のエラー int*intはエラーの発生したコードの行と列 
exception MyCodeExcp of int*int 
 
//スタック処理用の補助関数 
let listOnePopAppFuncResPush (lst:list<int>)  (f:int->int) (r:int) (c:int) = 
    match lst with 
    |hd::tl -> (f hd)::tl 
    | _ -> raise <| MyStackExcp(r,c)  
 
//スタック処理用の補助関数 
let listTwoPopAppFuncResPush (lst:list<int>)  (g:int->int ->int) (r:int) (c:int) = 
    match lst with 
    |y::x::tl -> (g x y)::tl 
    | _ -> raise <| MyStackExcp(r,c)  
 
//一文字読み込む度に変化する可能性のあるものをまとめるための型 
//      モード  向き コード2Darray スタック   (行、列)  
type state = ExecMode*Direct* char[,] *     list<int>*(int*int) 
 
//処理のワンスステップ毎の処理 引数も返り値もstate型 
let oneStepProc ((excMode,dir,code,stack,(r,c)):state) = 
    let tarChar = code.[r,c] 
    match excMode with 
    // # 次の文字が表す命令を実行しない  
    |DEFAULT when tarChar = '#' 
                         -> (ONCE_EXEC_STOP,dir,code,stack,(getNextCoord dir (r,c)))  
    |ONCE_EXEC_STOP  -> (DEFAULT ,dir ,code, stack, (getNextCoord dir (r,c))) 
     
    // " 次に"が出現するまで、文字の命令を実行する代わりに文字のASCIIコードをスタックにプッシュする 
    |DEFAULT when tarChar = '\"' 
                         -> (ASCII_PUSH, dir, code, stack ,(getNextCoord dir (r,c))) 
    |ASCII_PUSH when tarChar = '\"' 
                         -> (DEFAULT, dir, code, stack, (getNextCoord dir (r,c))) 
    |ASCII_PUSH          -> (ASCII_PUSH ,dir, code, (int(tarChar) :: stack), (getNextCoord dir (r,c))) 
    // @ プログラムの実行を停止する  
    |DEFAULT when tarChar = '@' 
                         -> (EXIT,dir,code,stack,(r,c))  
    // < 実行の向きを左にする   
    |DEFAULT when tarChar = '<' 
                         -> (DEFAULT,LEFT,code,stack, (getNextCoord LEFT (r,c))) 
    // > 実行の向きを右にする  
    |DEFAULT when tarChar = '>' 
                         -> (DEFAULT,RIGHT,code,stack,(getNextCoord RIGHT (r,c))) 
    // ^ 実行の向きを上にする  
    |DEFAULT when tarChar = '^' 
                         -> (DEFAULT,UP,code,stack, (getNextCoord UP (r,c))) 
    // v 実行の向きを下にする  
    |DEFAULT when tarChar = 'v' 
                         -> (DEFAULT, DOWN, code,stack, (getNextCoord DOWN (r,c))) 
    // _ スタックをポップして、その値が0ならば実行の向きを右に、そうでなければ左にする 
    |DEFAULT when tarChar = '_' 
                         -> match stack with 
                            |hd::tl when hd = 0 ->  (DEFAULT,RIGHT,code,tl,(getNextCoord RIGHT (r,c))) 
                            |hd::tl             ->  (DEFAULT,LEFT,code,tl,(getNextCoord LEFT (r,c))) 
                            | _                 ->   raise <| MyStackExcp(r,c) 
    // | スタックをポップして、その値が0ならば実行の向きを下に、そうでなければ上にする  
    |DEFAULT when tarChar = '|' 
                         -> match stack with 
                            |hd::tl when hd = 0 ->  (DEFAULT,DOWN,code,tl,(getNextCoord DOWN (r,c))) 
                            |hd::tl             ->  (DEFAULT,  UP,code,tl,(getNextCoord UP   (r,c))) 
                            | _                 ->  raise <| MyStackExcp(r,c) 
    // ? 実行の向きを上下左右のいずれかにランダムで変更する。  
    |DEFAULT when tarChar = '?' 
                        ->let rnd = new System.Random() 
                          let rndNum = rnd.Next(4) 
                          if   rndNum = 0 then (DEFAULT,UP,   code,stack,(getNextCoord UP    (r,c))) 
                          elif rndNum = 1 then (DEFAULT,DOWN, code,stack,(getNextCoord DOWN  (r,c))) 
                          elif rndNum = 2 then (DEFAULT,RIGHT,code,stack,(getNextCoord RIGHT (r,c))) 
                          else                 (DEFAULT,LEFT, code,stack,(getNextCoord LEFT  (r,c))) 
    // (空白) 何もしない  
    |DEFAULT when tarChar = ' ' 
                         -> (DEFAULT,dir,code,stack,(getNextCoord dir (r,c))) 
    // 0-9 数値をスタックにプッシュする  
    |DEFAULT when tarChar >= '0'&& tarChar <= '9' 
                         -> (DEFAULT,dir,code,((int(tarChar) - int('0'))::stack),(getNextCoord dir (r,c))) 
     
    // & ユーザに数値を入力させ、その値をスタックにプッシュする  
    |DEFAULT when tarChar = '&'  
                        -> (DEFAULT,dir,code,((forInputIntFunc ())::stack),(getNextCoord dir (r,c)))                
 
    // ~ ユーザにchar値を入力させ、その値をスタックにプッシュする  
    |DEFAULT when tarChar = '~'  
                        -> (DEFAULT,dir,code,((forInputCharFunc ())::stack),(getNextCoord dir (r,c)))                
 
    //. スタックをポップして、その値を十進表示し、続けて半角スペースを出力する  
    |DEFAULT when tarChar = '.'  
                         -> match stack with 
                            |hd::tl      -> forOutputIntFunc hd  
                                            (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
                          
    // ,スタックをポップして、その値をASCIIコードに持つ文字を表示する  
    |DEFAULT when tarChar = ','  
                         -> match stack with 
                            |hd::tl      -> forOutputCharFunc hd  
                                            (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
                         
                                 
    // + スタックから y, x をポップして、x + y の値をプッシュする  
    |DEFAULT when tarChar = '+' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (+) r c, 
                             (getNextCoord dir (r,c))) 
 
    // - スタックから y, x をポップして、x - y の値をプッシュする  
    |DEFAULT when tarChar = '-' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (-) r c, 
                             (getNextCoord dir (r,c))) 
 
    // * スタックから y, x をポップして、x × y の値をプッシュする  
    |DEFAULT when tarChar = '*' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (*) r c, 
                             (getNextCoord dir (r,c))) 
 
    // / スタックから y, x をポップして、x / y の値をプッシュする  
    |DEFAULT when tarChar = '/' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (/) r c, 
                             (getNextCoord dir (r,c))) 
 
    // % スタックから y, x をポップして、x を y で割ったときの余りをプッシュする   
    |DEFAULT when tarChar = '%' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (%) r c, 
                             (getNextCoord dir (r,c))) 
 
    // ` スタックから y, x をポップして、x > y ならば 1 を、そうでなければ 0 をプッシュする  
    |DEFAULT when tarChar = '`' 
                         -> (DEFAULT,dir,code, 
                             listTwoPopAppFuncResPush stack (fun x y -> if x > y then 1 else 0) r c, 
                             (getNextCoord dir (r,c))) 
 
     // ! スタックをポップして、その値が 0 ならば 1 を、そうでなければ 0 をプッシュする   
    |DEFAULT when tarChar = '!' 
                         -> (DEFAULT,dir,code, 
                             listOnePopAppFuncResPush stack (fun x  -> if x =0 then 1 else 0) r c, 
                             (getNextCoord dir (r,c))) 
  
 
    // : スタックをポップして、その値を2回プッシュする 
    |DEFAULT when tarChar = ':'  
                         -> match stack with 
                            |hd::tl      ->  (DEFAULT,  dir,code,hd::hd::tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
  
    // \ スタックから y, x をポップして y をプッシュし、その後 x をプッシュする  
    |DEFAULT when tarChar = '\\'  
                         -> match stack with 
                            |y::x::tl    ->  (DEFAULT,  dir,code,x::y::tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
  
    // $ スタックをポップして、その値を使用しない  
    |DEFAULT when tarChar = '$'  
                         -> match stack with 
                            |hd::tl    ->  (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
  
    // g スタックから y, x をポップして、プログラムの y 行 x 桁目の文字のASCIIコードをスタックにプッシュする  
    |DEFAULT when tarChar = 'g'  
                         -> match stack with 
                            |y::x::tl    -> (DEFAULT,  dir,code,((int code.[y,x])::tl),(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
 
    // p スタックから y, x, v をポップして、プログラムの y 行 x 桁目を、v をASCIIコードに持つ文字に書き換える  
    |DEFAULT when tarChar = 'p'  
                         -> match stack with 
                            |y::x::v::tl    ->code.[y,x] <- char v  
                                              (DEFAULT,  dir,code,tl,(getNextCoord dir  (r,c))) 
                            | _          ->  raise <| MyStackExcp(r,c) 
     
    //対応するものがない 
    |_                   ->raise <| MyCodeExcp(r,c) 
 
//////////////ここよりWindowsソフト特有部分 
 
//処理のワンスステップ毎の処理の説明 返り値はstring 
let explainChar ((excMode,dir,code,stack,(r,c)):state) = 
    let tarChar = code.[r,c] 
    match excMode with 
    // # 次の文字が表す命令を実行しない  
    |DEFAULT when tarChar = '#' 
                         -> "# 次の文字が表す命令を実行しない"  
    |ONCE_EXEC_STOP  -> "この命令は実行されない" 
     
    // " 次に"が出現するまで、文字の命令を実行する代わりに文字のASCIIコードをスタックにプッシュする 
    |DEFAULT when tarChar = '\"' 
                         -> "\" 次に\"が出現するまで、文字の命令を実行する代わりに文字のASCIIコードをスタックにプッシュする" 
    |ASCII_PUSH when tarChar = '\"' 
                         -> "ここよりあとの命令は実行される" 
    |ASCII_PUSH          -> sprintf "文字%cのASCIIコードをスタックにプッシュする" tarChar 
    // @ プログラムの実行を停止する  
    |DEFAULT when tarChar = '@' 
                         -> " @ プログラムの実行を停止する"  
    // < 実行の向きを左にする   
    |DEFAULT when tarChar = '<' 
                         -> "< 実行の向きを左にする" 
    // > 実行の向きを右にする  
    |DEFAULT when tarChar = '>' 
                         -> "> 実行の向きを右にする" 
    // ^ 実行の向きを上にする  
    |DEFAULT when tarChar = '^' 
                         -> "^ 実行の向きを上にする" 
    // v 実行の向きを下にする  
    |DEFAULT when tarChar = 'v' 
                         -> "v 実行の向きを下にする" 
    // _ スタックをポップして、その値が0ならば実行の向きを右に、そうでなければ左にする 
    |DEFAULT when tarChar = '_' 
                         -> " _ スタックをポップして、その値が0ならば実行の向きを右に、そうでなければ左にする" 
    // | スタックをポップして、その値が0ならば実行の向きを下に、そうでなければ上にする  
    |DEFAULT when tarChar = '|' 
                         -> " | スタックをポップして、その値が0ならば実行の向きを下に、そうでなければ上にする" 
    // ? 実行の向きを上下左右のいずれかにランダムで変更する。  
    |DEFAULT when tarChar = '?' 
                        -> " ? 実行の向きを上下左右のいずれかにランダムで変更する。" 
    // (空白) 何もしない  
    |DEFAULT when tarChar = ' ' 
                         -> " (空白) 何もしない " 
    // 0-9 数値をスタックにプッシュする  
    |DEFAULT when tarChar >= '0' && tarChar <= '9' 
                         -> "0-9 数値をスタックにプッシュする" 
     
    // & ユーザに数値を入力させ、その値をスタックにプッシュする  
    |DEFAULT when tarChar = '&'  
                        -> "& ユーザに数値を入力させ、その値をスタックにプッシュする"             
 
    // ~ ユーザにchar値を入力させ、その値をスタックにプッシュする  
    |DEFAULT when tarChar = '~'  
                        -> "~ ユーザにchar値を入力させ、その値をスタックにプッシュする "              
 
    //. スタックをポップして、その値を十進表示し、続けて半角スペースを出力する  
    |DEFAULT when tarChar = '.'  
                         -> ". スタックをポップして、その値を十進表示し、続けて半角スペースを出力する " 
                          
    // ,スタックをポップして、その値をASCIIコードに持つ文字を表示する  
    |DEFAULT when tarChar = ','  
                         -> " ,スタックをポップして、その値をASCIIコードに持つ文字を表示する " 
                         
                                 
    // + スタックから y, x をポップして、x + y の値をプッシュする  
    |DEFAULT when tarChar = '+' 
                         -> " + スタックから y, x をポップして、x + y の値をプッシュする" 
 
    // - スタックから y, x をポップして、x - y の値をプッシュする  
    |DEFAULT when tarChar = '-' 
                         -> "- スタックから y, x をポップして、x - y の値をプッシュする" 
 
    // * スタックから y, x をポップして、x × y の値をプッシュする  
    |DEFAULT when tarChar = '*' 
                         -> "* スタックから y, x をポップして、x × y の値をプッシュする" 
 
    // / スタックから y, x をポップして、x / y の値をプッシュする  
    |DEFAULT when tarChar = '/' 
                         -> "/ スタックから y, x をポップして、x / y の値をプッシュする" 
 
    // % スタックから y, x をポップして、x を y で割ったときの余りをプッシュする   
    |DEFAULT when tarChar = '%' 
                         -> " % スタックから y, x をポップして、x を y で割ったときの余りをプッシュする" 
    // ` スタックから y, x をポップして、x > y ならば 1 を、そうでなければ 0 をプッシュする  
    |DEFAULT when tarChar = '`' 
                         -> "` スタックから y, x をポップして、x > y ならば 1 を、そうでなければ 0 をプッシュする" 
 
     // ! スタックをポップして、その値が 0 ならば 1 を、そうでなければ 0 をプッシュする   
    |DEFAULT when tarChar = '!' 
                         -> "! スタックをポップして、その値が 0 ならば 1 を、そうでなければ 0 をプッシュする " 
 
    // : スタックをポップして、その値を2回プッシュする 
    |DEFAULT when tarChar = ':'  
                         -> " : スタックをポップして、その値を2回プッシュする" 
     
    // \ スタックから y, x をポップして y をプッシュし、その後 x をプッシュする  
    |DEFAULT when tarChar = '\\'  
                         -> " \ スタックから y, x をポップして y をプッシュし、その後 x をプッシュする" 
  
    // $ スタックをポップして、その値を使用しない  
    |DEFAULT when tarChar = '$'  
                         -> " $ スタックをポップして、その値を使用しない" 
    // g スタックから y, x をポップして、プログラムの y 行 x 桁目の文字のASCIIコードをスタックにプッシュする  
    |DEFAULT when tarChar = 'g'  
                         -> " g スタックから y, x をポップして、プログラムの y 行 x 桁目の文字のASCIIコードをスタックにプッシュする" 
    // p スタックから y, x, v をポップして、プログラムの y 行 x 桁目を、v をASCIIコードに持つ文字に書き換える  
    |DEFAULT when tarChar = 'p'  
                         -> " p スタックから y, x, v をポップして、プログラムの y 行 x 桁目を、v をASCIIコードに持つ文字に書き換える" 
    //対応するものがない 
    |_                   -> "対応するものがない" 
 
 
 
 
//TextBox群を生成しArray2Dに収納し返す関数 
let makeTextBoxArr (readOnlyFlag:bool) = 
    let (tbArr:TextBox[,]) = Array2D.create MaxRowNum MaxColNum null 
    for r in [0 .. MaxRowIndex] do 
        for c in [0 .. MaxColIndex] do 
            let tempTB = (new TextBox(Text = "",ForeColor = Color.Maroon,MaxLength = 1, 
                            TextAlign = System.Windows.Forms.HorizontalAlignment.Center)) 
            if readOnlyFlag = true then tempTB.ReadOnly <- true 
            tbArr.[r,c] <- tempTB 
    tbArr 
 
//Panel上に行、列番号込みでTextBox[,]を配置する関数 
let placeTextBoxesWithTitle (panel:Panel) (textBoxes:TextBox[,]) (rightPos:int) (topPos:int) (width:int) (height:int) = 
    let labelHeight = 12 
    let labelWidth  = 18 
    for c in [0 .. MaxColIndex] do 
        let tmpLabel = new Label (Location = new Point (rightPos + width * (c + 1), topPos), 
                                  Size = new Size(width, 12),Text = sprintf"%d" c) 
 
        panel.Controls.Add tmpLabel 
 
    for r in [0 .. MaxRowIndex] do 
        let tmpLabel = new Label (Location = new Point (rightPos, topPos + height * (r + 1) ), 
                                  Size = new Size(width, 12),Text = sprintf"%d" r) 
 
        panel.Controls.Add tmpLabel 
 
    for r in [0 .. MaxRowIndex] do 
        for c in [0 .. MaxColIndex] do 
            textBoxes.[r,c].Size <- new Size(width,height) 
            textBoxes.[r,c].Location <- new Point (rightPos + labelWidth + width * c,topPos + labelHeight + height * r) 
            panel.Controls.Add textBoxes.[r,c] 
 
//codeArr上の値をtextBoxesに反映させる 
let showCodeOnTextBoxes (textBoxes:TextBox[,]) (codeArr:char[,]) = 
    for r in [0 .. MaxRowIndex] do 
        for c in [0 .. MaxColIndex] do 
            textBoxes.[r,c].Text <- codeArr.[r,c].ToString() 
     
//textBoxes上に表示されている値をcodeArrに格納する 
//stringなので最初の一文字をとる 
let shownCode2Arr2D (textBoxes:TextBox[,]) (codeArr:char[,]) = 
    for r in [0 .. MaxRowIndex] do 
        for c in [0 .. MaxColIndex] do 
            let tempCharArr = textBoxes.[r,c].Text.ToCharArray() 
            codeArr.[r,c] <-  if Array.length tempCharArr > 0 then tempCharArr.[0] else ' '   
 
//textBoxesのすべての背景色を変更する 
let changeTextBoxBackColor (textBoxes:TextBox[,]) (bkColor:Color)  = 
    for r in [0 .. MaxRowIndex] do 
        for c in [0 .. MaxColIndex] do 
            textBoxes.[r,c].BackColor <- bkColor   
 
//textBoxesとcodeArrと2つのテキストボックスをすべてクリアする 
let clearTextBoxesAndCodeArr (textBoxes:TextBox[,]) (codeArr:char[,]) (tb1:TextBox) (tb2:TextBox) = 
    tb1.Text <- "" 
    tb2.Text <- "" 
    for r in [0 .. MaxRowIndex] do 
        for c in [0 .. MaxColIndex] do 
            textBoxes.[r,c].Text <- "" 
            codeArr.[r,c] <- ' '   
 
//codeArrを行単位で結合しstring型に直してseq<string>型の値を返す。 
let codeArr2D2arr (codeArr:char[,])  = 
    let tempStr = ref "" 
    seq{  for r in [0 .. MaxRowIndex] do 
             tempStr := "" 
             for c in [0 .. MaxColIndex] do 
               tempStr := !tempStr + codeArr.[r,c].ToString() 
             yield !tempStr 
        }   
 
//一括実行用の関数 
 
let allExecMain (srcCharArr:char[,]) (errorTB:TextBox) (outPutTB:TextBox) = 
    //oneStepProcを繰り返し適用していく関数 
    let rec doProcess ((excMode,dir,code,stack,(r,c)) as t :state) = 
        match excMode with 
        |EXIT -> () 
        | _ ->let (nextExcMode,nextDir,nextCode,nextStack,(nextR,nextC)) = oneStepProc t  
              //ここでstack,nextStack等を表示すれば、進捗を表示できる 
              //printfn "%d %d -> %c %A " r c code.[r,c] stack 
              doProcess (nextExcMode,nextDir,nextCode,nextStack,(nextR,nextC)) 
     
    //エラーおよび結果表示部分のクリア 
    errorTB.Text <- "" 
    outPutTB.Text <- "" 
    //doProcessを実行 
    try 
        doProcess (DEFAULT,RIGHT,srcCharArr,[],(0,0)) 
    with 
    |MyStackExcp(r,c) -> errorTB.Text <- errorTB.Text + (sprintf "%d行%d列でスタックエラー\n" r c) 
    |MyCodeExcp(r,c)  -> errorTB.Text <- errorTB.Text + (sprintf "%d行%d列でコードの文字エラー" r c) 
    | ex              -> errorTB.Text <- errorTB.Text +  ex.Message + "\n" 
 
 
//ワンステップ実行用の変数ExecMode*Direct* char[,] *     list<int>*(int*int)////////////////////////////////////////// 
//この部分より下の広域変数となるので注意! 
 
let mutable (cur_mode:ExecMode) = DEFAULT 
let mutable (cur_dir:Direct) = RIGHT 
let mutable (cur_charCode:char[,]) = null 
let mutable (cur_stack:list<int>) = [] 
let mutable cur_row = 0 
let mutable cur_col = 0  
 
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 
 
//ステップ実行用の関数 
 
let doOneStepProcess (textBoxes:TextBox[,]) (errorTB:TextBox) (outputTB:TextBox) (stackTB:TextBox) (explainTB:TextBox)= 
    try 
        match cur_mode with 
        |EXIT ->errorTB.Text <- errorTB.Text + "実行終了"  
                () 
        | _ ->let (nextExcMode,nextDir,nextCode,nextStack,(nextR,nextC)) =  
                    oneStepProc (cur_mode,cur_dir,cur_charCode,cur_stack,(cur_row,cur_col))  
              textBoxes.[cur_row,cur_col].BackColor <- Color.White 
 
              textBoxes.[nextR,nextC].BackColor <- Color.Aqua 
              stackTB.Text <- sprintf "%A" nextStack 
              showCodeOnTextBoxes  textBoxes nextCode 
              explainTB.Text <- explainChar(nextExcMode,nextDir,nextCode,nextStack,(nextR,nextC)) 
               
              cur_mode <- nextExcMode 
              cur_dir <- nextDir 
              cur_charCode <- nextCode 
              cur_stack <- nextStack 
              cur_row <- nextR 
              cur_col <- nextC 
              //stackTB.Text <- sprintf "%A" cur_stack 
              //showCodeOnTextBoxes  textBoxes cur_charCode 
 
     with          
    |MyStackExcp(r,c) -> errorTB.Text <- errorTB.Text + (sprintf "%d行%d列でスタックエラー\n" cur_row cur_col) 
    |MyCodeExcp(r,c)  -> errorTB.Text <- errorTB.Text + (sprintf "%d行%d列でコードの文字エラー" cur_row cur_col) 
    | ex              -> errorTB.Text <- errorTB.Text +  ex.Message + "\n" 
 
///////////////SimpleConverterで作成した部分 
 
let f2c x = x :> System.Windows.Forms.Control  
let splitContainer1= new SplitContainer(Dock = DockStyle.Fill,Location = new Point(0, 0),Name = "splitContainer1",Orientation = Orientation.Horizontal,Size = new Size(936, 794),SplitterDistance = 662,TabIndex = 0) 
let save_btn= new Button(Location = new Point(101, 18),Name = "save_btn",Size = new Size(67, 23),TabIndex = 27,Text = "Save",UseVisualStyleBackColor = true) 
let load_btn= new Button(Location = new Point(17, 18),Name = "load_btn",Size = new Size(67, 23),TabIndex = 26,Text = "Load",UseVisualStyleBackColor = true) 
let label2= new Label(AutoSize = true,Location = new Point(20, 54),Name = "label2",Size = new Size(39, 12),TabIndex = 15,Text = "Output") 
let OUtput_tb= new TextBox(Location = new Point(82, 22),Multiline = true,Name = "OUtput_tb",ScrollBars = ScrollBars.Both,Size = new Size(380, 84),TabIndex = 14) 
let label3= new Label(AutoSize = true,Location = new Point(477, 54),Name = "label3",Size = new Size(26, 12),TabIndex = 13,Text = "Mes") 
let Error_tb= new TextBox(Location = new Point(516, 22),Multiline = true,Name = "Error_tb",ScrollBars = ScrollBars.Both,Size = new Size(399, 84),TabIndex = 12) 
let tabControl1= new TabControl(Dock = DockStyle.Fill,Location = new Point(0, 0),Name = "tabControl1",SelectedIndex = 0,Size = new Size(936, 662),TabIndex = 0) 
let tabPage1= new TabPage(Location = new Point(4, 22),Name = "tabPage1",Padding = new Padding(3),Size = new Size(928, 636),TabIndex = 0,Text = "一括実行",UseVisualStyleBackColor = true) 
let oriSrc_pl= new Panel(AutoScroll = true,Dock = DockStyle.Fill,Location = new Point(3, 3),Name = "oriSrc_pl",Size = new Size(922, 630),TabIndex = 0) 
let tabPage2= new TabPage(Location = new Point(4, 22),Name = "tabPage2",Padding = new Padding(3),Size = new Size(928, 636),TabIndex = 1,Text = "ステップ実行",UseVisualStyleBackColor = true) 
let oneStepSrc_pl= new Panel(AutoScroll = true,Dock = DockStyle.Fill,Location = new Point(3, 3),Name = "oneStepSrc_pl",Size = new Size(922, 630),TabIndex = 0) 
let oneStep_btn= new Button(Location = new Point(670, 588),Name = "oneStep_btn",Size = new Size(193, 25),TabIndex = 29,Text = "ワンステップ実行",UseVisualStyleBackColor = true) 
let allExec_btn= new Button(Location = new Point(658, 558),Name = "allExec_btn",Size = new Size(208, 35),TabIndex = 28,Text = "一括実行",UseVisualStyleBackColor = true) 
let label1= new Label(AutoSize = true,Location = new Point(15, 553),Name = "label1",Size = new Size(37, 12),TabIndex = 32,Text = "スタック") 
let stack_tb= new TextBox(Location = new Point(71, 540),Multiline = true,Name = "stack_tb",Size = new Size(821, 37),TabIndex = 31) 
let stepReset_btn= new Button(Location = new Point(530, 588),Name = "stepReset_btn",Size = new Size(111, 25),TabIndex = 30,Text = "ステップ実行リセット",UseVisualStyleBackColor = true) 
let groupBox1= new GroupBox(Location = new Point(25, 546),Name = "groupBox1",Size = new Size(188, 57),TabIndex = 29,TabStop = false,Text = "ファイル") 
let label4= new Label(AutoSize = true,Location = new Point(15, 513),Name = "label4",Size = new Size(29, 12),TabIndex = 34,Text = "説明") 
let explain_tb= new TextBox(Location = new Point(71, 502),Multiline = true,Name = "explain_tb",Size = new Size(821, 23),TabIndex = 33) 
let codeClear_btn= new Button(Location = new Point(241, 564),Name = "codeClear_btn",Size = new Size(81, 23),TabIndex = 30,Text = "コードクリア",UseVisualStyleBackColor = true) 
let Form1= new Form(AutoScaleDimensions = new SizeF(6.0f, 12.0f),AutoScaleMode = AutoScaleMode.Font,ClientSize = new Size(936, 794),Name = "Form1",Text = "Befunge93") 
[ f2c splitContainer1] |> List.iter(fun cnt -> Form1.Controls.Add cnt) 
[ f2c save_btn; f2c load_btn] |> List.iter(fun cnt -> groupBox1.Controls.Add cnt) 
[ f2c label4; f2c explain_tb; f2c label1; f2c stack_tb; f2c stepReset_btn; f2c oneStep_btn] |> List.iter(fun cnt -> oneStepSrc_pl.Controls.Add cnt) 
[ f2c codeClear_btn; f2c groupBox1; f2c allExec_btn] |> List.iter(fun cnt -> oriSrc_pl.Controls.Add cnt) 
[ f2c tabControl1] |> List.iter(fun cnt -> splitContainer1.Panel1.Controls.Add cnt) 
[ f2c label2; f2c OUtput_tb; f2c label3; f2c Error_tb] |> List.iter(fun cnt -> splitContainer1.Panel2.Controls.Add cnt) 
[ f2c tabPage1; f2c tabPage2] |> List.iter(fun cnt -> tabControl1.Controls.Add cnt) 
[ f2c oriSrc_pl] |> List.iter(fun cnt -> tabPage1.Controls.Add cnt) 
[ f2c oneStepSrc_pl] |> List.iter(fun cnt -> tabPage2.Controls.Add cnt) 
 
 
/////////////SimpleConverterで作成した部分 ここまで 
 
/////////////入力用サブフォーム関連  
 
let inputForm = new Form(Width = 300, Height = 150, Text = "input Form")  
let subInput_tb =  new TextBox(Width = 155,Height = 97,Location =new Point(5,5))  
let subInput_btn = new Button (Width = 75,Height = 23,Location =new Point(5,50),Text = "Submit")  
  
inputForm.Controls.Add subInput_tb  
inputForm.Controls.Add subInput_btn  
 
//サブウィンドウのボタンへのイベント登録  
subInput_btn.Click.Add (fun _ -> inputForm.Close())  
 
/////////入出力用の関数の割り当て 
 
forInputIntFunc <- (fun () ->subInput_tb.Text  <- ""  
                             inputForm.Text <- "数値を入力してください"  
                             inputForm.ShowDialog() |> ignore  
                             System.Int32.Parse(subInput_tb.Text))  
 
forInputCharFunc <- (fun () ->subInput_tb.Text  <- "" 
                              inputForm.Text <- "一文字入力してください" 
                              inputForm.ShowDialog() |> ignore  
                              let charArr = subInput_tb.Text.ToCharArray() 
                              int (charArr.[0])) 
 
forOutputIntFunc <- (fun i -> OUtput_tb.Text <- OUtput_tb.Text + (sprintf "%d " i))  
 
forOutputCharFunc <- (fun i -> OUtput_tb.Text <- OUtput_tb.Text + (sprintf "%c" (char i)))  
 
//ソース用のTextBoxesの作成と配置 
let oriSrcTextBoxes = makeTextBoxArr false 
placeTextBoxesWithTitle oriSrc_pl oriSrcTextBoxes 5 5 19 19 
 
//ソース用のchar[,]の作成     
let srcCharArray2D = Array2D.create MaxRowNum MaxColNum ' ' 
 
//ステップ実行用のTextBoxes(readOnly)の作成と背景色設定と配置 
let oneStepSrcTextBoxes = makeTextBoxArr true 
changeTextBoxBackColor oneStepSrcTextBoxes Color.White 
placeTextBoxesWithTitle oneStepSrc_pl oneStepSrcTextBoxes 5 5 19 19 
 
//ステップ実行用のchar[,]の作成     
let oneStepsrcCharArray2D = Array2D.create MaxRowNum MaxColNum ' ' 
 
//ファイル読み込みボタンへの関数登録 
load_btn.Click.Add  
    (fun _ -> try  
                let ofd = new OpenFileDialog(Filter = "BFファイル(*.bf)|*.bf|すべてのファイル(*.*)|*.*")  
                if(ofd.ShowDialog() = DialogResult.OK) then  
                    let charArr2D = System.IO.File.ReadAllLines (ofd.FileName) 
                                    |> List.ofArray  
                                    |> makeCode2DArr 
                     
                    showCodeOnTextBoxes  oriSrcTextBoxes charArr2D 
                     
              with  
                | ex -> Error_tb.Text <- ex.Message  
    )  
 
//ファイルセーブボタンへの関数登録 
save_btn.Click.Add 
    (fun _ -> try 
                let sfd = new SaveFileDialog(Filter = "BFファイル(*.bf)|*.bf|すべてのファイル(*.*)|*.*",  
                                              RestoreDirectory = true)  
                if (sfd.ShowDialog() = DialogResult.OK) then  
                    shownCode2Arr2D oriSrcTextBoxes srcCharArray2D   //oriSrcTB から srcChar へ 
                    System.IO.File.WriteAllLines(sfd.FileName,(codeArr2D2arr srcCharArray2D)) 
                with  
                | ex -> Error_tb.Text <- ex.Message  
    ) 
 
//コードクリアボタンへの関数登録 
codeClear_btn.Click.Add 
    (fun _ -> clearTextBoxesAndCodeArr oriSrcTextBoxes srcCharArray2D  Error_tb OUtput_tb) 
 
//一括実行ボタンへの関数登録 
  
allExec_btn.Click.Add 
    (fun _ -> shownCode2Arr2D oriSrcTextBoxes srcCharArray2D 
              allExecMain srcCharArray2D Error_tb OUtput_tb 
              Error_tb.Text <- Error_tb.Text + "実行終了"        ) 
 
//ここまでが一括実行用の部分 
 
//ステップ実行リセットボタンへの関数登録 
stepReset_btn.Click.Add 
    ( fun _ -> shownCode2Arr2D oriSrcTextBoxes srcCharArray2D              //oriSrcTB から srcChar へ 
               shownCode2Arr2D oriSrcTextBoxes oneStepsrcCharArray2D       //oriSrcTB から oneStepsrcCharArray2D へ 
               showCodeOnTextBoxes  oneStepSrcTextBoxes oneStepsrcCharArray2D   //neStepsrcCharArray2D を oneStepSrcTBへ表示 
               changeTextBoxBackColor oneStepSrcTextBoxes Color.White 
               cur_mode <- DEFAULT 
               cur_dir <- RIGHT 
               cur_charCode <- oneStepsrcCharArray2D 
               cur_stack <- [] 
               cur_row <- 0 
               cur_col <- 0 
               Error_tb.Text <- "" 
               OUtput_tb.Text <- "" 
               stack_tb.Text <- "" 
   
               oneStepSrcTextBoxes.[cur_row,cur_col].BackColor <- Color.Aqua 
               stack_tb.Text <- sprintf "%A" cur_stack 
               showCodeOnTextBoxes  oneStepSrcTextBoxes cur_charCode 
               explain_tb.Text <- explainChar(cur_mode,cur_dir,cur_charCode,cur_stack,(cur_row,cur_col)) 
                
               ) 
 
//ワンステップ実行ボタンへの関数登録 
oneStep_btn.Click.Add 
    ( fun _ -> doOneStepProcess oneStepSrcTextBoxes Error_tb OUtput_tb stack_tb explain_tb) 
 
 
[<STAThread()>]   
do Application.Run(Form1) 
 
スポンサーサイト

テーマ : プログラミング
ジャンル : コンピュータ

コメントの投稿

非公開コメント

プロフィール

T GYOUTEN

Author:T GYOUTEN
F#と英単語とフリーソフトと読書に興味があります。
ホームページでフリーソフトも公開しています。どぞ御贔屓に。

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
フリーエリア
フリーエリア
blogram投票ボタン
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QRコード
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。