mirror of
https://github.com/anoma/juvix.git
synced 2024-12-24 07:57:58 +03:00
6ea7da9990
Now that integer literals have the builtin int type we need an actual IOUnit value to use in the IO sequence implementation. This commit also adds the TicTacToe web example to the test suite. It is a typecheck / C generation only test because it uses the Wasm browser APIs.
165 lines
4.5 KiB
Plaintext
165 lines
4.5 KiB
Plaintext
--- Tic-tac-toe is a paper-and-pencil game for two players who take turns marking the spaces
|
||
--- in a three-by-three grid with X or O.
|
||
---
|
||
--- The player who succeeds in placing three of their marks in a horizontal, vertical, or
|
||
--- diagonal row is the winner. It is a solved game, with a forced draw assuming best play from both players.
|
||
---
|
||
--- The module Logic.Game contains the game logic.
|
||
module Web.TicTacToe;
|
||
|
||
open import Stdlib.Data.Nat.Ord;
|
||
open import Stdlib.Prelude;
|
||
open import Logic.Game;
|
||
|
||
-- Functions provided by the host
|
||
|
||
axiom hostLog : String → IO;
|
||
|
||
-- XCoord → YCoord → Width → Height → Color → IO
|
||
axiom hostFillRect : ℕ → ℕ → ℕ → ℕ → String → IO;
|
||
|
||
-- XCoord → YCoord → Text → Size → Color → Align → IO
|
||
axiom hostFillText : ℕ → ℕ → String → ℕ → String → ℕ → IO;
|
||
|
||
-- Nat extension
|
||
|
||
foreign c {
|
||
int div(n, d) {
|
||
return n/d;
|
||
\}
|
||
};
|
||
|
||
infixl 7 div;
|
||
axiom div : ℕ → ℕ → ℕ;
|
||
|
||
compile div {
|
||
c ↦ "div";
|
||
};
|
||
|
||
-- IO extensions
|
||
|
||
axiom IOUnit : IO;
|
||
compile IOUnit {
|
||
c ↦ "0";
|
||
};
|
||
|
||
sequenceIO : List IO → IO;
|
||
sequenceIO ≔ foldr (>>) IOUnit;
|
||
|
||
mapIO : {A : Type} → (A → IO) → List A → IO;
|
||
mapIO f xs ≔ sequenceIO (map f xs);
|
||
|
||
-- List extensions
|
||
|
||
zip : {A : Type} → {B : Type} → List A → List B → List (A × B);
|
||
zip (a ∷ as) (b ∷ bs) ≔ (a , b) ∷ zip as bs;
|
||
zip _ _ ≔ nil;
|
||
|
||
rangeAux : ℕ → ℕ → List ℕ;
|
||
rangeAux _ zero ≔ nil;
|
||
rangeAux m (suc n) ≔ m ∷ rangeAux (suc m) n;
|
||
|
||
range : ℕ → List ℕ;
|
||
range n ≔ rangeAux zero n;
|
||
|
||
enumerate : {A : Type} → List A → List (ℕ × A);
|
||
enumerate l ≔ zip (range (length l)) l;
|
||
|
||
-- Formatting constants
|
||
|
||
squareWidth : ℕ;
|
||
squareWidth ≔ 100;
|
||
|
||
textSize : ℕ;
|
||
textSize ≔ 30;
|
||
|
||
xTextOffset : ℕ;
|
||
xTextOffset ≔ 50;
|
||
|
||
yTextOffset : ℕ;
|
||
yTextOffset ≔ 60;
|
||
|
||
canvasPadding : ℕ;
|
||
canvasPadding ≔ 8;
|
||
|
||
textColor : String;
|
||
textColor ≔ "#000000";
|
||
|
||
backgroundColor : String;
|
||
backgroundColor ≔ "#c4434e";
|
||
|
||
lightBackgroundColor : String;
|
||
lightBackgroundColor ≔ "#c7737a";
|
||
|
||
-- Rendering
|
||
|
||
inductive Align {
|
||
left : Align;
|
||
right : Align;
|
||
center : Align;
|
||
};
|
||
|
||
alignNum : Align → ℕ;
|
||
alignNum left ≔ zero;
|
||
alignNum right ≔ one;
|
||
alignNum center ≔ two;
|
||
|
||
renderText : String → ℕ → ℕ → Align → IO;
|
||
renderText t row col a ≔ hostFillText ((squareWidth * row) + xTextOffset) ((squareWidth * col) + yTextOffset) t textSize textColor (alignNum a);
|
||
|
||
renderSymbol : Symbol → ℕ → ℕ → IO;
|
||
renderSymbol s row col ≔ renderText (showSymbol s) row col center;
|
||
|
||
renderNumber : ℕ → ℕ → ℕ → IO;
|
||
renderNumber n row col ≔ renderText (natToStr n) row col center;
|
||
|
||
renderSquare : ℕ → ℕ → Square → IO;
|
||
renderSquare row col (occupied s) ≔
|
||
hostFillRect (squareWidth * row) (squareWidth * col) squareWidth squareWidth backgroundColor
|
||
>> renderSymbol s row col;
|
||
renderSquare row col (empty n) ≔
|
||
hostFillRect (squareWidth * row) (squareWidth * col) squareWidth squareWidth lightBackgroundColor
|
||
>> renderNumber n row col;
|
||
|
||
renderRowAux : ℕ → (ℕ × Square) → IO;
|
||
renderRowAux col (row , s) ≔ renderSquare row col s;
|
||
|
||
renderRow : ℕ × (List Square) → IO;
|
||
renderRow (n , xs) ≔ mapIO (renderRowAux n) (enumerate xs);
|
||
|
||
renderBoard : Board → IO;
|
||
renderBoard (board squares) ≔ mapIO renderRow (enumerate squares);
|
||
|
||
renderFooterText : String → IO;
|
||
renderFooterText msg ≔ renderText msg 0 3 left;
|
||
|
||
nextPlayerText : Symbol → String;
|
||
nextPlayerText s ≔ "Next player: " ++str (showSymbol s);
|
||
|
||
renderError : Error → IO;
|
||
renderError noError ≔ IOUnit;
|
||
renderError (continue msg) ≔ renderText msg 0 3 left;
|
||
renderError (terminate msg) ≔ renderText msg 0 3 left;
|
||
|
||
renderGameState : GameState → IO;
|
||
renderGameState (state b _ (terminate msg)) ≔ renderBoard b >> renderFooterText msg;
|
||
renderGameState (state b p (continue msg)) ≔ renderBoard b >> renderFooterText (nextPlayerText p) >> renderText (msg) 0 4 left;
|
||
renderGameState (state b p _) ≔ renderBoard b >> renderFooterText (nextPlayerText p);
|
||
|
||
renderAndReturn : GameState → GameState;
|
||
renderAndReturn s ≔ const s (renderGameState s);
|
||
|
||
selectedSquare : ℕ → ℕ → ℕ;
|
||
selectedSquare row col ≔ 3 * (col div squareWidth) + (row div squareWidth) + 1;
|
||
|
||
-- API
|
||
|
||
initGame : GameState;
|
||
initGame ≔ const beginState (renderGameState beginState >> renderText "Click on a square to make a move" 0 4 left);
|
||
|
||
move : GameState → ℕ → ℕ → GameState;
|
||
move (state b p (terminate e)) x y ≔ renderAndReturn (state b p (terminate e));
|
||
move s x y ≔ renderAndReturn (playMove (validMove (selectedSquare x y)) s);
|
||
|
||
end;
|