前言:

話說今年 2018年農曆過年將至的時候, 年末大清掃的時候清出了兩本電腦書. 「BASIC 遊戲程式集」. 這兩本書是 1983年6月出版, 由慈恩書局所出版發行經銷. 郭飛龍先生編譯. 一共出了兩本, 分1, 2兩冊!

看到這本好舊的 BASIC 電腦書, 翻了翻, 熟悉的 BASIC 語言, 頓時回到當時國中生的回憶. 當時應該是國二吧, Apple ][ 的年代, 當時一鍵一鍵的 key-in 進程式碼, 然後在電腦上執行, 那種很神奇的感覺讓人沈迷. 雖然這兩本程式都是以文字畫面為主的, 但是透過簡單的 BASIC 還是可以寫出蠻有趣的遊戲程式的!

而當時的 BASIC 老實說, 程式裡面都用 GOTO 來亂跳, 缺乏結構化程式的語法, 其實程式是很難閱讀的. 但每天還是抱著這幾本書努力研究, 看看人家怎麼寫的. 國中生活除了唸書外的難忘回憶.

 

 

FORTH 程式語言:

FORTH 程式語言是我高中時候學的, 蠻喜歡這個語言的啦! (我的這篇 BLOG 有些簡介, 假如你很陌生的話)

然後想說過年了, 反正在家也是無聊, 何不利用這兩本書裡面的題目, 改用 FORTH 語言來撰寫囉, 當作 FORTH 語言程式練習囉. 這樣多少也為這個冷門的語言加減在網路上貢獻一些資源. 因為也很久沒寫 FORTH 程式囉, 剛好讓自己多熟悉一些解題跟程式撰寫的技巧 (在家閒著也是閒著, 把這當看電視, 打電動的消遣好囉). 所以打算在 BLOG 開個 FORTH 語言的專題啦! 給有興趣的人切磋!!

這裡所有的程式皆使用 gFORTH, gFORTH 是個 ANSI 標準的 FORTH 系統, 可以在 UNIX/ Linux/ Window ... 眾多的環境下執行. 電腦這邊用的是 Apple iMac 機型 (2012 late), macOS 10.13.3 High Sierra 作業系統.

 

划拳遊戲:

「BASIC 遊戲程式集 - 1」的第一個程式是划拳遊戲, 這就是我們熟習的 剪刀, 石頭, 布. 來做個這樣的練習, 寫個人可以跟電腦划拳決勝負的遊戲吧. 這本書上的程式是單人跟電腦DR.K 划拳比賽的遊戲. 但是這樣太簡單了, 為了增加一點難度, 再多寫一個多人划拳的程式吧! 讓你跟四位電腦的代表(DR.K, DR.J, DR.L, DR.M) 來划拳團戰決勝負啦.

 

剪刀, 石頭, 布:

來用點數學來分解這個問題吧! 剪刀, 石頭, 布是個三個符號的數學系統, 這三個符號遵守奇怪的大小比較規則!

定義:

A = Scissor 剪刀

B = Cloth 布

C = Stone 石頭

這個奇怪的規則是這樣, 假如他們可以比大小的話 A > B, B > C, C > A.  但這樣似乎不太符合數字大小的邏輯 (A>B, B>C 所以推論 A>C, 但實際又說 A<C, 兩者邏輯完全牴觸!). 所以用 [ , ] 來表示這樣一個競爭的運算.

[A,B] 代表 A , B 競爭, 結果 A 勝出 所以 [A,B] = A,  然後 [A,B] = [B,A] 這個競爭運算滿足交換律.

所以整個剪刀, 石頭, 布的競爭規則如下

[A,B] = [B,A] = A

[B,C] = [C,B] = B

[C,A] = [A,C] = C

[A,A] = [B,B] = [C,C] = Draw 平手

 

來實作這樣的剪刀, 石頭, 布 競爭規則的 FORTH 核心指令吧!

先定義剪刀, 石頭, 布的數字常數如下, 畢盡在程式裡用數字來比較大小還是比較方便的.

3 constant Scissor 剪刀
2 constant Cloth  布
1 constant Stone 石頭

再來定義一個剪刀, 石頭, 布競爭規則的指令 compete, 這個指令接受兩個代表 剪刀, 石頭, 布的數字於堆疊上, 透過競爭規則的比較, 留下勝利的一方! 同時會留下一個是否雙方平手的旗號於堆疊上.

例如:

Scissor Cloth compete 執行後會留下  Scissor false 於堆疊上

Stone Cloth compete 執行後會留下  Cloth false 於堆疊上

Scissor Scissor compete 執行後會留下  Scissor true 於堆疊上

 

經過分析, 發現全部的變化最後可以歸納成這三種:  [A,B] = A,  [A,C] = C,  [B,C] = B,  不是這三種的, 只要透過交換律對調就可以了! 所以 compete 指令很好寫囉,

 

compete 指令解說

: compete ( s1 s2 -- results draw?)
   2dup = if drop true exit then s1,s2 有沒有相等? 有的話平手, 留下true旗號後退出
   2dup < if swap then       假如 s1<s2, 利用交換律交換, 永遠大的數字在下面
   swap Scissor =            大的那個數字是剪刀嗎?
   if    Cloth =             是的話, 那小的那個數字是布嗎?
         if    Scissor       是的話, 剪刀勝出
         else  Stone   then  不是的話, 一定是石頭, 石頭勝出
   else  drop  Cloth   then  大的那個數字不是剪刀, 那一定是石頭跟布競爭, 所以一定是布勝出
   false ( not drawn)        因為不是平手, 所以留下旗號 false
;

 

有了這個重要的核心指令, 接下來就很簡單囉! 只要要求使用者輸入剪刀, 石頭, 布. 電腦利用亂數也來出個剪刀石頭布, 然後再用這個指令比較是誰贏還是輸就搞定囉!

 

亂數指令,

老實招認, 這段程式碼是從 Starting FORTH 參考過來的. 原來不是用這段, 可是後來發現 Starting FORTH 這段程式碼產生出來的亂數比較亂, 品質比較好, 所以就拿來用囉!

(1) 首先定義一個 亂數種子變數 seed

variable seed

(2) 透過下面的運算來弄亂這個 seed 變數裡的值, 來造成一個隨機性的數值: seed = 31421 * seed + 6927

: RND ( --- n)    

    seed @  31421 *  將 seed 裡的數字取出, 乘上 31421

    6927  +          再將這個數字加上 6927

    dup  seed !      這就是亂數, 複製一份回存回去,另一份留下使用

;

 

(3) 擷取特定範圍

需要特定的範圍, Choose指令 裁剪至所需範圍, 這段蠻 tricky, 蠻有趣的. RND 是產生出來的單整數亂數. Choose 的參數 特定範圍 limit 也是單整數的數字. 利用雙整數的乘法 um* 將兩個單整數相乘變成雙整數, 冒出頭來的那個單整數就是特定範圍 limit 的亂數了. 沒冒出頭的就把它丟棄!

: Choose ( limit --- n )      RND um* nip    ;

 

(4) 使用方法,

用 Randomize 來選取一個亂數種子

用 RND 就可以產生一個單整數的亂數出來

需要特定的範圍, 可以利用 Choose 選取特定範圍的亂數. 

 

例如:

10 Choose  --> 產生 0 - 9 之間的亂數

50 Choose --> 產生 0 - 49 之間的亂數

 

 

單人版的剪刀石頭布划拳遊戲:

電腦的名字叫做 DR.K , K博士. 你坐在電腦前面跟 K 博士划拳. 划拳的規則是剪刀石頭布. 程式會統計兩人的輸贏次數, 不想玩的話輸入 0 結束.

使用 gFORTH 系統在 iMac 上執行的結果如下,

ScissorStoneCloth01.png

 

先來看主程式 Go 吧!

很簡單, 先印一些解說, 設定一些初值. 然後跳入一個 begin-while-repeat 的遊戲大迴圈. 迴圈會利用 YOU 指令請你輸入並出拳, 然後檢查你的輸入是不是為 0, 是的話就跳出這個遊戲大迴圈停止遊戲囉! 不是的話就利用 DR.K 指令換請 K博士出拳, 然後利用指令 1round 來判斷這次誰輸誰贏並印出結果, 最後利用 .stat 來印出雙方比賽到現在為止的一些統計數據!

: Go
印些有的沒的解說

... 
  clear.all 設定一些初值 
  begin  YOU  使用者輸入
    dup 0 <>  不是零的話就留在迴圈繼續執行(是零的話就跳出)
  while  DR.K 電腦K博士輸入
    1round 判斷這次誰輸誰贏
    space space .stat cr cr  印出一些統計數據
  repeat
;

怎樣啊? FORTH 的可讀性很高吧?? 目前為止, 都是很清楚, 很高階的流程指令喲! 而且是高階抽象化的, 通用的流程, 不需要知道這些高階指令是如何透過細節的內部運作達成他們目的的, 只要他們最後能送出我們預期的資料到堆疊上, 整個程式就能運作!

跟那個 GOTO 來, GOTO 去的古老 BASIC 程式, 最後整個程式像個雜亂無章難以閱讀的一團麵條, 兩者相較這可讀性真是天壤之別啊! 假如 BASIC 是高階語言, 那 FORTH 的閱讀性可是更勝一籌啦!

 

使用者輸入 YOU,

這個指令會利用 FORTH 裡面的 KEY 指令來等待使用者按鍵盤. KEY 會把使用者所按的那個鍵的ASC II 值留在堆疊上, 這時候再利用一個 begin-until 的迴圈跟 within 的數值範圍判斷指令, 不斷檢查ASCII 數值的範圍來確認使用者所按的鍵盤是不是'0', '1', '2', '3' 四個的其中一個, 不是的話就是在迴圈裡面持續的要求使用者重新輸入, 直到正確為止!

因為我們只要輸入一位的數字, 所以, 所以減掉 '0' 的ASC II 值 48 的值就是所按的數字了!

 

: YOU ( -- sign)
  ." Choice: ? "   印一下提示元
  0  ( dummy flag) 先留一個傀儡旗號,因為一進迴圈會先被丟棄
  begin
    drop  KEY   丟棄傀儡旗號, 利用 KEY 來等待使用者輸入!
    dup [char] 0 [char] 4 within  這個所輸入ASCII的值是介於等於'0'跟'3'之間嗎?
  until        當為真,離開迴圈! 不為真,所輸入的ASCII值會變成下一個傀儡旗號,待丟棄!
  dup emit cr  稍微印一下所輸入的數字, 回饋給使用者輸入是正確的.
  dup seed +!  為了讓亂數更亂些, 把這個ASCII加入亂數的種子變數
  [char] 0 -   減掉 '0' 的 ASCII, 就是所按的數字了!
;

 

再來看 DR.K 的輸入吧!

很簡單的用亂數挑一個 0 - 2 之間的數字然後加1, 所以是 1 - 3之間的數字.  1 = Stone, 2 = Cloth, 3 = Scissor

: DR.K ( -- sign)
   3 Choose 1+
;

 

最後是最重要的, 判斷雙方出拳後誰輸誰贏, 順便統計一下結果的指令 1round

先定義一下 Player A 的名字, 叫做 "YOU ", Player B 的名字叫做 "DR.K". 

: A.player S" YOU " ;
: B.Player S" DR.K" ;

給初學者, FORTH 的字串有兩種. 一種是原始字串, 就從頭到尾一系列連續的8位元的 ASCII 的排列直到結束字元. 另外一種我們叫 Counted String 或簡稱 c-string. c-string 的第一個位址會存放這個字串的長度. 因為已經有長度了, 所以就很容易操控這個字串進行複製搬移的字串操作.

S" XXX" 是 FORTH 裡面用來編譯 c-string 的, 編譯器會把原始字串的長度算出來並包裝成 c-string 後編入冒號定義中, 執行時會將字串第一個字元的位址跟長度給推上堆疊, 所以用 type 指令就可以立刻印出囉.

 

然後定義一下三個變數來統計遊戲結果

variable no.A.win     Player A 划拳勝利的次數
variable no.B.win     Player B 划拳勝利的次數
variable total.plays  雙方已經划了幾次拳

 

: 1round ( A B --)  輸入雙方的划拳
   space   over .sign space dup .sign 印一下雙方的划拳
   2dup compete  利用規則,判斷誰贏誰輸. 留下勝方跟平手旗號!
   if     ."  -> Draw      ; "  drop 2drop  雙方平手!印結果!
   else   =   贏的人是 B 嗎?
          if     ."  -> " B.player type ."  wins ; " 印結果
                 1 no.B.win +!  統計加一, B贏一場   
          else   ."  -> " A.player type ."  wins ; " 印結果
                 1 no.A.win +!  統計加一, A贏一場
          then
          drop
   then
   1 total.plays +!  總划拳次數加一
;

 

就這樣, 超級簡單的!

 

原始程式碼列表

\
\ Scissor - Stone - Cloth
\
\   Frank Lin 2018.02.17
\

\ Rule:
\ A = Scissor
\ B = Cloth
\ C = Stone
\
\  [A,B] = [B,A] = A, wins
\  [B,C] = [C,B] = B, wins
\  [C,A] = [A,C] = C, wins
\  [X,X] = DRAWN

\ implement
\ [A,B] = A, [A,C] = C, [B,A] = A, [B,C] = B, [C,A] = C, [C,B] = B
\ just needs  [A,B], [A,C], [B,C] because commutative
\

3 constant Scissor
2 constant Cloth
1 constant Stone


: compete ( s1 s2 -- results draw?)
   2dup = if drop true exit then    \ exclude [X,X], [X,X] = DRAW, flag = true
   2dup < if swap then              \ make sure, must be [A,B], [A,C], [B,C]
   swap Scissor =                   \ [A?,]
   if    Cloth =                    \ [A,B?]
         if    Scissor              \ [A,B] = A
         else  Stone   then         \ [A,C] = C
   else  drop  Cloth   then         \ [B,C] = B
   false ( not drawn)
;


: .sign ( s -- )
   case
     Scissor of  ." Scissor"    endof
     Cloth   of  ." Cloth  "    endof
     Stone   of  ." Stone  "    endof
   endcase
;

: .result ( result flag --)
   if drop  ." Draw"
   else  .sign  then
;

\ string

: A.player S" YOU " ;
: B.Player S" DR.K" ;

variable no.A.win
variable no.B.win
variable total.plays


: 1round ( A B --)
   space   over .sign    space   dup .sign
   2dup compete 
   if     ."  -> Draw      ; "  drop 2drop   ( draw?)
   
   else   =   ( result = B?)
          if     ."  -> " B.player type ."  wins ; "
                 1 no.B.win +!
                 
          else   ."  -> " A.player type ."  wins ; " 
                 1 no.A.win +! 
          then
          drop
          
   then
   1 total.plays +!
;

: clear.all
   no.A.win off   no.B.win off   total.plays off
;

: .stat
   ." YOU:" no.A.win @   2 .r  ."  DR.K:" no.B.win @   2 .r  
   ." , Draw:"  total.plays @   no.A.win @ -   no.B.win @ -    2 .r
   ." , Total:"  total.plays @  2 .r
;

\
\ random number
\

variable seed 

: RND ( --- n)     seed @  31421 *  6927  +   dup  seed !   ;

: Randomize ( seed --- )      seed !    ;

here Randomize

: Choose ( limit --- n )      RND um* nip    ;

 

: DR.K ( -- sign)
   3 Choose 1+
;

: YOU ( -- sign)
  ." Choice: ? "
  0  ( dummy flag)
  Begin
    drop  KEY 
    dup [char] 0 [char] 4 within
  until
  dup emit cr
  dup seed +!
  [char] 0 -
;

: Go
  cr
  ." == Scissor - Cloth - Stone =="  cr
  ."   Contest with DR.K" cr cr
  ." Scissor(3), Cloth(2), Stone(1),  Exit(0)  Enter Your Choice after '?' mark!" 
  cr cr
  ."   YOU     DR.K" cr
  ."   ===     ====" cr
  
  clear.all
  begin  YOU
    dup 0 <>
  while  DR.K  1round  space space .stat cr cr
  repeat
;

 

多使用者版本的剪刀石頭布:

 

單使用者完畢了, 來個大挑戰, 來個大團戰版本的剪刀, 石頭, 布吧!

這裡先設定為五個人同時划拳比勝負, 當然, 也很容易擴充到 10個人以上啦!

 

大團戰, 剪刀, 石頭, 布的規則:

(1) 基本規則沒變, [剪刀,石頭] = [石頭,剪刀] = 石頭, [石頭,布] = [布,石頭] = 布, [布,剪刀] = [剪刀,布] = 剪刀, [X,X] = 平手. 所以可以繼續使用 compete 指令囉!

(2) 平手的規則多了兩個:

      i. 大家都出同樣的時候 [X,X,X,...X] = 平手, 這裡寫一個 AllSame? 指令來做這樣的判斷!

      ii. 大家同時又有剪刀, 又有石頭, 又有布的時候, 三個都有的時候, 這時候不曉得誰贏誰啦, 所以也是平手! [..,剪刀..,..石頭..,..布..] = 平手, 這裡寫一個 AllDraw? 指令來做這樣的判斷!


 

實際比賽的狀況如下,

就五個人一直出拳比賽, 輸的人淘汰, 最後直到最後一人勝出為止!

ScissorStoneCloth04.png

 

 

實際比賽的狀況,

你在第一輪就被淘汰了, 剩下電腦們自己在 PK.

ScissorStoneCloth05.png

 

資料結構:

因為是要多人團戰, 而且希望可以擴充到百人團戰都可以的! 所以每個人的資料被需要能被用指引 index 的方式被參考出來, 這最方便的結構就是陣列啦!

每個人會需要三個資料

(1) 第一個是這個人的人名, 這是個字串. "YOU", "DR.K", "DR.J", "DR.L" ... 就 K博士, J博士, L博士...   (陣列 PlayerName)

(2) 第二個是這個人的出拳, 到底是剪刀, 還是石頭, 還是布呢!  (陣列 PlayerSign)

(3) 第三個是這個人的狀態, 是已經出拳了(set) 嗎? 還是已經出局(out)囉!  (陣列 PlayerStatus)

 

FORTH 與陣列:

整個 FORTH 語言的設計是服謁在一個哲學跟最高指導原則之下的: 那就是任何事情的最好的解法, 一定是最簡單的那個! 就是 FORTH 界大家朗朗上口的: "Simple Is The Power!" 所以語言的設計者 Chunk Moore 先生, 在語言中已經把所有問題拆解成最基本元素, 跟提供這些基本工具給你. 讓你去自由運用!

所以對於陣列, FORTH 的態度認為, 在語言裡面設計一個通用的陣列函式是很沒有效率的事, 而且會把大家給綁死! 所以在 FORTH 語言的標準裡面沒有陣列的定義跟規定. ANSI 語言標準裡面只有規定了一些記憶體的存取規則, 大小跟方法, 更高階就不定義了, 避免用沒效率的方式綁死大家.

所以在 FORTH 裡面的陣列使用, 需由使用者視情況自由決定.

 

因為我們要用的陣列不會很大, 所以這裡採用 Starting FORTH 裡的方法, 請編譯器編譯一個長字串到記憶體裡面來當作主要的人名陣列 (PlayerName), 然後這個長字串的部分字元也同時提供給其他的兩個數字陣列 (PlayerSign, PlayerStatus) 使用.

要求編譯器編譯個長字串 PlayerList 進去字典! (要注意空格呀! 人名四個字元, 加上1個字元給Sign, 另一個字元給 Status. 每個玩家要有6個字元的固定長度喲!)

create PlayerList ," YOU   DR.K  DR.J  DR.L  DR.M  "

create PlayerList 先在字典裡面造個詞, 接續的 ," XXX" 是個指令, 可以直接把字串包裝成 c-string 編譯入字典!

這裡的資料結構是這樣, 每個名字的字串後面要空兩格, 第一格 1 byte 要給 PlayerSign 使用, 第二格 1 byte 要給 PlayerStatus 使用.

名字字串規定長度為 4 constant NameLength 為 4個 byte 的長度, 加上 1 bye Sign, 1 bye Status, 總共 6 bytes

| 1 byte 長字串長度 || 4 byte Name | 1 byte Sign | 1 byte Status || 4 byte Name | 1 byte Sign | 1 byte Status || ... ||4 byte Name | 1 byte Sign | 1 byte Status || 

 

給 index 要計算 PlayerName 的位址, 算式如下

addr = PlayerList.addr + 1 char + index * (4 + 2) chars

: PlayerName ( i -- addr)
   [ NameLength 2 + ] literal  *   1+  chars   PlayerList  +
;

 

給 index 要計算 PlayerSign 的位址, 算式如下

addr = PlayerList.addr + 1 char + index * (4 + 2) chars   +  4 chars

: PlayerSign ( i -- addr)
   PlayerName   NameLength  chars +
;

 

給 index 要計算 PlayerName 的位址, 算式如下

addr = PlayerList.addr + 1 char + index * 4 chars   +  5 chars

: PlayerStatus ( i -- addr)
   PlayerName  [ NameLength  1+  ]  literal  chars +
;

 

搞定資料結構了, 來看主程式吧!

程式先用 InitAll 把大家的狀態跟變數都設好, 然後一樣是一個 begin-while-repeat 的遊戲迴圈, 這個迴圈由變數 NumberOfSurvival 來控制. 這個變數紀錄了現在還有幾個人存活, 沒出局正在比賽! 當存活的人剩下一個人的時候代表最後的勝利者出現了, 停止遊戲, 並由 .Final 宣佈最後勝利者!

遊戲迴圈內, 首先用 NewSigns 讓大家出拳, 順便用 .All 印一下大家出拳的情況, 要要做龍虎鬥判斷大家划拳的輸贏前, 要先排除是不是有平手的情況! 當 AllDraw? 顯示大家出的拳, 結果剪刀石頭布, 三個都出現了, 或是 AllSame? 顯示大家出拳都一模一樣時, 這樣是無法判斷勝負的! 這輪就不用比了, 大家直接跳過, 繼續下一輪吧!

確定可以比勝負的時候, 用 CompeteAll 來對還存活的選手比划拳的勝負囉, 輸的淘汰!

: go

     印些有的沒的

   InitAll   先把每個人的狀態/出拳及一些變數都設好.

   0 ( # of round)  第幾輪的比賽,在堆疊上放數字來計數
   begin  1+        第幾輪的比賽加1

      NumberOfSurvival @ 1 >  剩下幾個人? 大於1人, 遊戲繼續.
   while
      NewSigns  大家出拳囉
      cr  ." == Round #" dup 2 .r ."  ==" 印一下第幾輪
      .All cr   印一下大家出拳的結果
      AllDraw? AllSame? or invert  沒有平手的狀況?
      if CompeteAll  then   判斷誰贏囉!輸的給他出局!
   repeat  drop cr
   .Final      宣布最後勝負!
;

 

來看一下大家出拳的指令 NewSigns

首先檢查 "你" 是不是還活著, 你的狀態資料存在 PlayerStatus 索引位置 0 的位置, 所以 0 PlayerStatus c@ 就可以取得你的狀態, 確認是不是 out? 假如不是的話, 就用 YOU 指令詢問你要出什麼拳. 把你的拳儲存放到 0 PlayerSign 的位置! 然後更新你的狀態至 set, 表示已經出拳了!

類似的程序, 利用 do-loop 迴圈, 依序為其他的遊戲者, 假如沒出局的話, 利用 GotChoice 來利用亂數來幫他們出拳!

 

: NewSigns  ( --)  \ gen. and store new signs if they are not out!
  0 PlayerStatus c@  out = invert
  if  cr ." Scissor (3), Cloth (2), Stone (1), "
      YOU  0 PlayerSign   c!   
      set  0 PlayerStatus c!
  then
  
  NumberOfPlayer  1
  do i PlayerStatus c@  out = invert
     if   GotChoice  i PlayerSign   c!
          set        i PlayerStatus c!
     then
  loop
;

 

再來看一下, 檢查有沒有平手的 AllDraw? 跟 AllSame?

AllDraw? 檢查是不是大家的出拳又有剪刀, 又有石頭, 又有布的?

為了方便, 這個用了 FORTH 的堆疊來儲存旗號, 先在堆疊上放上三個代表 剪刀, 石頭, 布 的旗號. 一開始都是 false. 然後用個 do-loop 迴圈掃描所有的使用者, 假如沒有出局的話就確認一下他們出的拳是什麼, 利用 or 來更新這三個旗號. (所以只要有對應拳的旗號出現, 邏輯為真) 全部檢查完後, 將三個剪刀, 石頭, 布 的旗號 and. 所以只要三個剪刀, 石頭, 布的旗號都曾出現的話, 最終的結果為真!

 

: AllDraw? ( -- f)
  false false false ( Scissor Cloth Stone)
  NumberOfPlayer  0
  do  i PlayerStatus c@ set =
      if
         i PlayerSign c@  >r
         rot  r@ Scissor =   or
         rot  r@ Cloth   =   or
         rot  r@ Stone   =   or
         r> drop
      then
  loop
  and and
;

 

AllSame? 檢查是不是大家的出拳是不是都划出同樣的拳?

這個寫法其實跟 AllDarw? 幾乎一模一樣. 只是邏輯判斷改成用 and 來更新對應拳的旗號, 最終用 or 來確認是否剪刀, 石頭, 布 的旗號中有任一為真! 有的話就代表大家都出那個旗號的拳囉!

 

: AllSame? ( -- f)
  false false false ( Scissor Cloth Stone)
  NumberOfPlayer  0
  do  i PlayerStatus c@ set =
      if
         i PlayerSign c@  >r
         rot  r@ Scissor =   and
         rot  r@ Cloth   =   and
         rot  r@ Stone   =   and
         r> drop
      then
  loop
  or or
;

 

然後, 是核心的程式碼 CompeteAll, 判斷這次划拳誰贏誰輸, 輸的就叫他出局!

這是剪刀石頭布的團戰, 理論上是大家要一起比勝負的. 但是這樣太複雜了! 我們的 compete 只能一次比兩個人呀! 也不難, 就把所有對戰的排列組合都放進來, 讓他們倆倆捉對廝殺, 敗的就直接淘汰他們囉! 最後留下來的就是優勝者們!

兩個  do-loop 迴圈, 考慮所有對戰的可能性, 來讓每個人倆倆捉對廝殺, 留下勝的一方! 當然啦, 兩個迴圈裡的清況, 有種可能性是自己比自己, 不過這種情況一定會平手. 不影響最終結果, 所以程式就沒另外處理囉!

 

: CompeteAll ( -- )
  NumberOfPlayer 0
  do
    NumberOfPlayer 0
    do
       i PlayerStatus c@ set =  j PlayerStatus c@ set = and
       對戰的兩個人沒人出局嗎?
       if  i PlayerSign c@ j PlayerSign c@ 
           2dup compete   那就來看誰贏誰輸囉?
           if ( Draw?) drop 2drop  兩人平手囉! 什麼事都不用做!
           else  =     不是平手, 是後面那個贏嗎?
                 if    out  i PlayerStatus  c!      前面這位出局!
                 else  out  j PlayerStatus  c! then 後面這位出局!
                 drop  -1 NumberOfSurvival +!  有人出局,存活人數減一
           then
       then
    loop
  loop
;

 

 

最後, 宣布最後勝利者! .Final

簡單用個 do-loop 迴圈檢查一下最後還沒出局的那個人是誰, 然後把他的名字印出來!

: .Final
   .All cr cr
   ." The Winner Is "
   NumberOfPlayer 0
   do  i PlayerStatus c@  set  =   if  i PlayerName NameLength type  then
   loop cr
;

 

 

原始程式碼列表

\
\ Scissor - Stone - Cloth 
\ Multi Player Version
\
\   Frank Lin 2018.02.25
\

\ Rule:
\ A = Scissor
\ B = Cloth
\ C = Stone
\
\  [A,B] = [B,A] = A, wins
\  [B,C] = [C,B] = B, wins
\  [C,A] = [A,C] = C, wins
\  [X,X] = Draw

\ implement
\ [A,B] = A, [A,C] = C, [B,A] = A, [B,C] = B, [C,A] = C, [C,B] = B
\ just needs  [A,B], [A,C], [B,C] because commutative
\

3 constant Scissor
2 constant Cloth
1 constant Stone


: compete ( s1 s2 -- results draw?)
   2dup = if drop true exit then    \ exclude [X,X], [X,X] = Draw, flag = true
   2dup < if swap then              \ make sure, must be [A,B], [A,C], [B,C]
   swap Scissor =                   \ [A?,]
   if    Cloth =                    \ [A,B?]
         if    Scissor              \ [A,B] = A
         else  Stone   then         \ [A,C] = C
   else  drop  Cloth   then         \ [B,C] = B
   false ( not drawn)
;


: .sign ( s -- )
   case
     Scissor of  ." Scissor"    endof
     Cloth   of  ." Cloth  "    endof
     Stone   of  ." Stone  "    endof
   endcase
;


\
\ random number
\

variable seed 

: RND ( --- n)     seed @  31421 *  6927  +   dup  seed !   ;

: Randomize ( seed --- )      seed !    ;

here Randomize

: Choose ( limit --- n )      RND um* nip    ;


: GotChoice ( -- sign)      3 Choose 1+   ;

: YOU ( -- sign)
  ." Choice: ? "
  0  ( dummy flag)
  Begin
    drop  KEY 
    dup [char] 0 [char] 4 within
  until
  dup emit cr
  dup seed +!
  [char] 0 -
;


4 constant NameLength
5 constant NumberOfPlayer


\ status 
variable NumberOfSurvive
0 constant clear
1 constant set
2 constant out


create PlayerList ," YOU   DR.K  DR.J  DR.L  DR.M  "

: PlayerName ( i -- addr)
   [ NameLength 2 + ] literal  *   1+  chars   PlayerList  +
;

: PlayerSign ( i -- addr)
   PlayerName   NameLength  chars +
;

: PlayerStatus ( i -- addr)
   PlayerName  [ NameLength  1+  ]  literal  chars +
;

: .status ( s -- )
   case
     clear of  ." clear"    endof
     set   of  ." set  "    endof
     out   of  ." out  "    endof
   endcase
;


: NewSigns  ( --)  \ gen. and store new signs if they are not out!
  0 PlayerStatus c@  out = invert
  if  cr ." Scissor (3), Cloth (2), Stone (1), "
      YOU  0 PlayerSign   c!   
      set  0 PlayerStatus c!
  then
  
  NumberOfPlayer  1
  do i PlayerStatus c@  out = invert
     if   GotChoice  i PlayerSign   c!
          set        i PlayerStatus c!
     then
  loop
;

: AllDraw? ( -- f)
  false false false ( Scissor Cloth Stone)
  NumberOfPlayer  0
  do  i PlayerStatus c@ set =
      if
         i PlayerSign c@  >r
         rot  r@ Scissor =   or
         rot  r@ Cloth   =   or
         rot  r@ Stone   =   or
         r> drop
      then
  loop
  and and
;

: AllSame? ( -- f)
  false false false ( Scissor Cloth Stone)
  NumberOfPlayer  0
  do  i PlayerStatus c@ set =
      if
         i PlayerSign c@  >r
         rot  r@ Scissor =   and
         rot  r@ Cloth   =   and
         rot  r@ Stone   =   and
         r> drop
      then
  loop
  or or
;

 

: InitAll ( --)
  NumberOfPlayer  0
  do  clear  i PlayerStatus  c!
  loop
  NumberOfPlayer NumberOfSurvive !
;

: CompeteAll ( -- )
  NumberOfPlayer 0
  do
    NumberOfPlayer 0
    do
       i PlayerStatus c@ set =  j PlayerStatus c@ set = and
       if  i PlayerSign c@ j PlayerSign c@ 
           2dup compete
           if ( Draw?) drop 2drop
           else  =
                 if    out  i PlayerStatus  c!
                 else  out  j PlayerStatus  c!   then
                 drop  -1 NumberOfSurvive +!
           then
       then
    loop
  loop
;

: .AllName
   cr
   NumberOfPlayer 0
   do  i PlayerName NameLength type 4 spaces
   loop
;

: .AllSigns
   cr
   NumberOfPlayer 0
   do i PlayerStatus c@  set  =  invert
      if    ." ----   "
      else  i PlayerSign c@  .sign then
      space
   loop
;

: .AllStatus
   cr
   NumberOfPlayer 0
   do  i PlayerStatus c@  .status space
   loop
;

: .All   
   .AllName .AllSigns cr
   ." # of Survive:" NumberOfSurvive ?
;

: .Final
   .All cr cr
   ." The Winner Is "
   NumberOfPlayer 0
   do  i PlayerStatus c@  set  =   if  i PlayerName NameLength type  then
   loop cr
;

: go
   cr cr
   ." == Multi-Players Scissor - Stone - Cloth ==" cr
   cr
   InitAll   0 ( # of round)
   begin  1+   NumberOfSurvive @ 1 >
   while
      NewSigns  
      cr  ." == Round #" dup 2 .r ."  =="
      .All cr
      AllDraw? AllSame? or invert
      if CompeteAll  then
   repeat  drop cr
   .Final
;

xxx

 

arrow
arrow

    ohiyooo2 發表在 痞客邦 留言(0) 人氣()