1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-24 07:57:58 +03:00
juvix/examples/milestone/TicTacToe/Web/TicTacToe.juvix
Paul Cadman 6ea7da9990
Fixes TicTacToe Web example (#1454)
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.
2022-08-15 14:11:30 +02:00

165 lines
4.5 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

--- 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;