├── .gitignore ├── .gitmodules ├── .ocamlformat ├── 02-exercises ├── 01-introduction │ ├── dune │ └── problem.ml ├── 02-basic_types │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 03-define_functions │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 04-call_functions │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 05-twice │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 06-pattern-matching │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 07-simple_recursion │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 08-list_intro │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 09-list_range │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 10-higher_order_functions │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 11-labeled_arguments │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 12-list_functions │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 13-arrays │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 14-variants │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 15-options │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 16-tuples │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 17-records │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 18-mutable_records │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 19-refs │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 20-anonymous_functions │ ├── dune │ ├── problem.ml │ └── problem.mli ├── 21-reading_sigs │ ├── dune │ ├── problem.ml │ └── problem.mli ├── dune └── dune-project ├── 03-frogger ├── Dockerfile ├── Makefile ├── README.org ├── assets │ ├── background.png │ ├── buggy-left.png │ ├── buggy-right.png │ ├── camel-down.png │ ├── camel-left.png │ ├── camel-right.png │ ├── camel-up.png │ ├── carpet_blue.png │ ├── carpet_green.png │ ├── carpet_red.png │ ├── confetti.png │ ├── police-car-left.png │ ├── police-car-right.png │ ├── red-pickup-left.png │ ├── red-pickup-right.png │ ├── skull.png │ ├── truck-left.png │ └── truck-right.png ├── config.ml ├── draw.ml ├── dune ├── frogger.ml ├── frogger.mli ├── import.ml ├── index.html ├── main.ml ├── scaffold.ml ├── scaffold.mli ├── suggested_frogger.mli └── test-js-of-ocaml-install │ ├── Makefile │ ├── dune │ ├── index.html │ └── main.ml ├── 03-lumines ├── README.org ├── bin │ ├── dune │ └── lumines.ml └── lib │ ├── board.ml │ ├── board.mli │ ├── color.ml │ ├── color.mli │ ├── dune │ ├── filled_square.ml │ ├── filled_square.mli │ ├── game.ml │ ├── game.mli │ ├── import.ml │ ├── lumines_graphics.ml │ ├── lumines_graphics.mli │ ├── moving_piece.ml │ ├── moving_piece.mli │ ├── point.ml │ ├── point.mli │ ├── sweeper.ml │ └── sweeper.mli ├── 03-snake ├── README.org ├── bin │ ├── dune │ ├── snake.ml │ └── snake.mli ├── lib │ ├── apple.ml │ ├── apple.mli │ ├── direction.ml │ ├── direction.mli │ ├── dune │ ├── game.ml │ ├── game.mli │ ├── game_state.ml │ ├── game_state.mli │ ├── position.ml │ ├── position.mli │ ├── snake.ml │ ├── snake.mli │ ├── snake_graphics.ml │ └── snake_graphics.mli └── tests │ ├── phase1 │ ├── apple_tests.ml │ ├── apple_tests.mli │ ├── dune │ ├── game_tests.ml │ ├── game_tests.mli │ ├── snake_tests.ml │ └── snake_tests.mli │ ├── phase2 │ ├── direction_tests.ml │ ├── direction_tests.mli │ ├── dune │ ├── game_tests.ml │ ├── game_tests.mli │ ├── snake_tests.ml │ └── snake_tests.mli │ └── phase3 │ ├── dune │ ├── game_tests.ml │ ├── game_tests.mli │ ├── snake_tests.ml │ └── snake_tests.mli ├── 04-bigger-projects ├── fuzzy-finder │ ├── Makefile │ ├── README.org │ └── bin │ │ ├── dune │ │ ├── fuzzy.ml │ │ ├── render.ml │ │ ├── render.mli │ │ ├── screen_dimensions.ml │ │ ├── screen_dimensions.mli │ │ ├── spinner.ml │ │ ├── spinner.mli │ │ ├── tty_text.ml │ │ └── tty_text.mli └── irc-bot │ ├── Makefile │ ├── README.org │ └── bin │ ├── bot.ml │ └── dune ├── LICENSE.txt ├── Makefile ├── README.org ├── make_learn_ocaml_directory.sh └── solutions ├── frogger └── frogger.ml ├── fuzzy-find └── fuzzy.ml ├── irc-bot ├── bin │ ├── bot.ml │ └── dune └── lib │ ├── dune │ ├── irc_protocol.ml │ ├── message.ml │ ├── message.mli │ ├── parser.ml │ └── parser_tests.ml ├── lumines ├── board.ml ├── game.ml └── moving_piece.ml └── snake ├── apple.ml ├── direction.ml ├── game.ml └── snake.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .merlin 3 | .DS_Store 4 | node_modules 5 | .#* 6 | *~ 7 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "01-install-ocaml"] 2 | path = 01-install-ocaml 3 | url = https://github.com/janestreet/install-ocaml 4 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | profile = janestreet 2 | -------------------------------------------------------------------------------- /02-exercises/01-introduction/dune: -------------------------------------------------------------------------------- 1 | ;; -*- Scheme -*- 2 | 3 | (library 4 | (name problem_1) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/01-introduction/problem.ml: -------------------------------------------------------------------------------- 1 | (* Welcome to Jane Street's OCaml challenges! 2 | 3 | This exercise is just meant to familiarize you with the build process and 4 | tools. 5 | 6 | Write OCaml code using your favorite text editor; if you aren't already 7 | committed to one, we recommend Visual Studio Code. *) 8 | 9 | let () = Stdio.printf "Hello, World! 10 | 11 | (** =========== Compilation ========== **) 12 | (* To compile your code and run inline tests, run 13 | 14 | $ dune runtest 15 | 16 | in a terminal session in this exercise's directory. 17 | 18 | Try building this code. 19 | 20 | You should see a compilation error because the line of code above is missing 21 | the end quote. Add the end quote and re-run. You should see that the code 22 | compiled and ran! 23 | 24 | This process of building/running tests, fixing compilation errors, and 25 | repeating until all tests pass should roughly be your workflow as you work 26 | through these exercises. Make sure to only build inside each exercise's 27 | directory, so you don't have to sift through irrelevant output from other 28 | exercises' tests. *) 29 | 30 | (** =========== utop ========== **) 31 | (* OCaml has a toplevel interpreter (i.e. a REPL, or read-eval-print loop) 32 | called utop. Try starting up utop in the command line like so: 33 | 34 | $ utop 35 | 36 | You can also execute code in this environment directly. Try pasting the 37 | previous line of code into utop and running it there. 38 | 39 | Note that in utop, every line must end with a double semi-colon (;;). Your 40 | session should look like this: 41 | 42 | {| 43 | utop # Stdio.printf "Hello, world";; 44 | Hello, world- : unit = () 45 | |} 46 | 47 | If you see "Error: Unbound module Stdio", your utop environment might be 48 | missing the stdio package. Try running the following: 49 | 50 | {| 51 | utop # #require "stdio";; 52 | |} 53 | 54 | and retrying. 55 | 56 | While going through these exercises, it may be helpful to play around in utop! *) 57 | 58 | -------------------------------------------------------------------------------- /02-exercises/02-basic_types/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_2) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/02-basic_types/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* This is an mli, a file that declares the interface that the corresponding 4 | implementation file (problem.ml) exposes to other code. 5 | 6 | The compiler will enforce that the implementations you write for 7 | [int_average] and [float_average] in problem.ml have the type signatures 8 | written below. 9 | *) 10 | val four : int 11 | val float_four : float 12 | 13 | val first_name : string 14 | 15 | val int_average : int -> int -> int 16 | val float_average : float -> float -> float 17 | -------------------------------------------------------------------------------- /02-exercises/03-define_functions/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_3) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/03-define_functions/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Recall from exercise 2 that we use [let] to define functions. 4 | 5 | Definitions take on the form: 6 | 7 | {| let FUNCTION_NAME ARG1 ARG2 ... = BODY |} 8 | 9 | For example, here we define a function [add1] that takes a single int 10 | argument and returns that argument plus 1. *) 11 | let add1 arg = arg + 1 12 | 13 | (* [string_append] uses the built-in [( ^ )] operator to concatenate two 14 | strings. *) 15 | let string_append x y = x ^ y 16 | 17 | (* We can annotate a function definition with types as well. *) 18 | let add1_float (arg : float) : float = arg +. 1. 19 | 20 | (* In OCaml, outside of strings, whitespace and newlines are the same. 21 | 22 | So, you could also write 23 | 24 | {| 25 | let FUNCTION_NAME 26 | ARG1 27 | ARG2 28 | = 29 | BODY 30 | |} 31 | 32 | and it's the same to the compiler. *) 33 | 34 | (* Let's define a few more functions below. Remember that you can see the 35 | function signatures in the mli file. *) 36 | 37 | let plus x y = failwith "For you to implement" 38 | let times x y = failwith "For you to implement" 39 | let minus x y = failwith "For you to implement" 40 | let divide x y = failwith "For you to implement" 41 | 42 | let%test "Testing plus..." = Int.( = ) 2 (plus 1 1) 43 | let%test "Testing plus..." = Int.( = ) 49 (plus (-1) 50) 44 | let%test "Testing times..." = Int.( = ) 64 (times 8 8) 45 | let%test "Testing times..." = Int.( = ) (-2048) (times (-2) 1024) 46 | let%test "Testing minus..." = Int.( = ) (-4) (minus (-2) 2) 47 | let%test "Testing minus..." = Int.( = ) 1000 (minus 1337 337) 48 | let%test "Testing divide..." = Int.( = ) 512 (divide 1024 2) 49 | let%test "Testing divide..." = Int.( = ) 1010 (divide 31337 31) 50 | -------------------------------------------------------------------------------- /02-exercises/03-define_functions/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val plus : int -> int -> int 4 | val times : int -> int -> int 5 | val minus : int -> int -> int 6 | val divide : int -> int -> int 7 | -------------------------------------------------------------------------------- /02-exercises/04-call_functions/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_4) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/04-call_functions/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Here are a few example functions. *) 4 | let square x = x * x 5 | let half x = x / 2 6 | let add x y = x + y 7 | 8 | (* You can order function invocations with either parentheses or let bindings. *) 9 | (* Parentheses: *) 10 | let () = 11 | Stdio.printf "(5^2)/2 = %i\n" (half (square 5)) 12 | 13 | (* Let bindings: *) 14 | let () = 15 | let squared = square 5 in 16 | let halved = half squared in 17 | Stdio.printf "(5^2)/2 = %i\n" halved 18 | 19 | (* Try to write [average] by reusing [add] and [half], first ordering your 20 | function invocations using parentheses, then using let bindings. *) 21 | let average x y = failwith "For you to implement" 22 | 23 | let%test "Testing average..." = 24 | Int.(=) 5 (average 5 5) 25 | 26 | let%test "Testing average..." = 27 | Int.(=) 75 (average 50 100) 28 | -------------------------------------------------------------------------------- /02-exercises/04-call_functions/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val average : int -> int -> int 4 | -------------------------------------------------------------------------------- /02-exercises/05-twice/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_5) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/05-twice/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Write a function that adds 1 to an int. (This function may seem familiar!) *) 4 | let add1 x = failwith "For you to implement" 5 | 6 | (* Now write a function that squares its argument. *) 7 | let square x = failwith "For you to implement" 8 | 9 | (* Functions are "first class" in OCaml. This means that you can take a function 10 | and pass it around as an argument to other functions. We call functions that 11 | take other functions as arguments "higher order functions". 12 | 13 | Let's write a function named [twice], which will take a function as its first 14 | argument, and apply that function two times to its second argument. 15 | 16 | Hint: Remember that you can use parenthese or let bindings to order function 17 | calls. *) 18 | let twice f x = failwith "For you to implement" 19 | 20 | (* Take a second to look at the function signature for [twice] in the mli 21 | file. Note that the first argument of twice is a function, [f], which has 22 | type [int -> int]. We had to wrap its type in parentheses when representing 23 | it in the function signature. *) 24 | 25 | (* Now that we have [twice], try writing [add2] and [raise_to_the_fourth] using 26 | [add1] and [square]. *) 27 | let add2 = failwith "For you to implement" 28 | let raise_to_the_fourth = failwith "For you to implement" 29 | 30 | let%test "Testing add1..." = 31 | Int.(=) 5 (add1 4) 32 | 33 | let%test "Testing square..." = 34 | Int.(=) 16 (square 4) 35 | 36 | let%test "Testing square..." = 37 | Int.(=) 16 (square (-4)) 38 | 39 | let%test "Testing add1..." = 40 | Int.(=) 5 (twice add1 3) 41 | 42 | let%test "Testing add2..." = 43 | Int.(=) 1337 (add2 1335) 44 | 45 | let%test "Testing raise_to_the_fourth..." = 46 | Int.(=) 1 (raise_to_the_fourth 1) 47 | 48 | let%test "Testing raise_to_the_fourth..." = 49 | Int.(=) 10000 (raise_to_the_fourth 10) 50 | -------------------------------------------------------------------------------- /02-exercises/05-twice/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val twice : (int -> int) -> int -> int 4 | 5 | -------------------------------------------------------------------------------- /02-exercises/06-pattern-matching/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_6) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/06-pattern-matching/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Pattern matching lets us compare inputs to known values. 4 | 5 | In general, pattern matching looks like this: 6 | 7 | {| 8 | match SOMETHING with 9 | | PATTERN1 -> WHAT TO DO IF PATTERN1 MATCHES 10 | | PATTERN2 -> WHAT TO DO IF PATTERN2 MATCHES 11 | ... 12 | |} 13 | 14 | Patterns are tested (i.e. checked for whether they match) in order starting 15 | from the top. 16 | 17 | On the first pattern that matches, we go into the code block following [->]. 18 | 19 | Note that the [_] pattern matches anything. (Can you think of why this might 20 | be dangerous?) *) 21 | let is_superman x = 22 | match x with 23 | | "Clark Kent" -> true 24 | | _ -> false 25 | ;; 26 | 27 | (* We can also pattern match on multiple values at the same time. Notice how we 28 | can group different patterns together to avoid repeating code following 29 | [->]. *) 30 | let is_same_person x y = 31 | match x, y with 32 | | "Clark Kent", "Superman" 33 | | "Peter Parker", "Spiderman" -> true 34 | | _ -> false 35 | ;; 36 | 37 | (* Let's write our own pattern matching. Write a function that returns whether [x] 38 | is non-zero by matching on [x]. *) 39 | let non_zero x = failwith "For you to implement" 40 | 41 | let%test "Testing non_zero..." = Bool.( = ) false (non_zero 0) 42 | let%test "Testing non_zero..." = Bool.( = ) true (non_zero 500) 43 | let%test "Testing non_zero..." = Bool.( = ) true (non_zero (-400)) 44 | 45 | (* Now, write a function that returns true if [x] and [y] are both non-zero by 46 | matching on both of them at the same time. *) 47 | let both_non_zero x y = failwith "For you to implement" 48 | 49 | let%test "Testing both_non_zero..." = Bool.( = ) false (both_non_zero 0 0) 50 | let%test "Testing both_non_zero..." = Bool.( = ) false (both_non_zero 0 1) 51 | let%test "Testing both_non_zero..." = Bool.( = ) false (both_non_zero (-20) 0) 52 | let%test "Testing both_non_zero..." = Bool.( = ) true (both_non_zero 400 (-5)) 53 | -------------------------------------------------------------------------------- /02-exercises/06-pattern-matching/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val non_zero : int -> bool 4 | -------------------------------------------------------------------------------- /02-exercises/07-simple_recursion/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_7) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/07-simple_recursion/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Functions can call other functions. They can call themselves too, but only 4 | with a special keyword. 5 | 6 | First, try to compile this directory. What is the error that you see? 7 | 8 | Now change [let] to [let rec] and recompile. 9 | 10 | A function is only allowed to call itself if the [rec] flag is specified. *) 11 | let add_every_number_up_to x = 12 | (* Make sure we don't call this on negative numbers! *) 13 | assert (x >= 0); 14 | match x with 15 | | 0 -> 0 16 | | _ -> x + add_every_number_up_to (x - 1) 17 | ;; 18 | 19 | (* Now, let's write a function to take the product of every number up to [x]. *) 20 | let rec factorial x = 21 | assert (x >= 0); 22 | failwith "For you to implement" 23 | ;; 24 | 25 | let%test "Testing factorial..." = Int.( = ) 1 (factorial 0) 26 | let%test "Testing factorial..." = Int.( = ) 120 (factorial 5) 27 | let%test "Testing factorial..." = Int.( = ) 479001600 (factorial 12) 28 | -------------------------------------------------------------------------------- /02-exercises/07-simple_recursion/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val factorial : int -> int 4 | -------------------------------------------------------------------------------- /02-exercises/08-list_intro/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_8) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/08-list_intro/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* OCaml natively supports lists as a part of the language. Lists are 4 | implemented as linked lists, and can only contain values of the same 5 | type. 6 | 7 | Lists are commonly referred to as having a head and a tail. The head is the 8 | first element of the linked list The tail is everything else. 9 | 10 | To construct a list we use the cons infix operator [( :: )] to prepend 11 | elements to the front of a list: 12 | 13 | {| val (::) : 'a -> 'a list -> 'a list |} 14 | 15 | [] means "the empty list". hd :: tl means "the element hd added to the front 16 | of the list tl". 17 | 18 | The following assertion shows that we can construct lists in two ways. *) 19 | let () = assert ([%compare.equal: int list] [ 5; 1; 8; 4 ] (5 :: 1 :: 8 :: 4 :: [])) 20 | 21 | (* When matching on a list, it's either empty or non-empty. To say it another 22 | way, it's either equal to [] or equal to (hd :: tl) where hd is the first 23 | element of the list and tl is all the rest of the elements of the list (which 24 | may itself be empty). 25 | 26 | For example, this function computes the length of a list. *) 27 | let rec length lst = 28 | match lst with 29 | | [] -> 0 30 | | _ :: tl -> 1 + length tl 31 | ;; 32 | 33 | (* Write a function to add up the elements of a list by matching on it. *) 34 | let rec sum lst = failwith "For you to implement" 35 | 36 | let%test "Testing sum..." = Int.( = ) 0 (sum []) 37 | let%test "Testing sum..." = Int.( = ) 55 (sum [ 55 ]) 38 | let%test "Testing sum..." = Int.( = ) 0 (sum [ 5; -5; 1; -1 ]) 39 | let%test "Testing sum..." = Int.( = ) 12 (sum [ 5; 5; 1; 1 ]) 40 | 41 | (* Now write a function to multiply together the elements of a list. *) 42 | let rec product xs = failwith "For you to implement" 43 | 44 | let%test "Testing product..." = Int.equal 1 (product []) 45 | let%test "Testing product..." = Int.equal 55 (product [ 55 ]) 46 | let%test "Testing product..." = Int.equal 25 (product [ 5; -5; 1; -1 ]) 47 | let%test "Testing product..." = Int.equal 25 (product [ 5; 5; 1; 1 ]) 48 | -------------------------------------------------------------------------------- /02-exercises/08-list_intro/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val sum : int list -> int 4 | val product : int list -> int 5 | -------------------------------------------------------------------------------- /02-exercises/09-list_range/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_9) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/09-list_range/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* The append infix operator, [( @ )], which concatenates two lists: 4 | 5 | {| val (@) : 'a list -> 'a list -> 'a list |} *) 6 | let () = 7 | assert ([%compare.equal: int list] ([ 5; 1 ] @ [ 8; 4 ]) [ 5; 1; 8; 4 ]); 8 | assert ([%compare.equal: int list] (List.append [ 5; 1 ] [ 8; 4 ]) [ 5; 1; 8; 4 ]) 9 | ;; 10 | 11 | (* Write a function to construct a list of all integers in the range from [from] to [to_] 12 | 13 | including [from] but excluding [to_] in increasing order. 14 | 15 | {| val range : int -> int -> int list |} *) 16 | let range from to_ = failwith "For you to implement" 17 | 18 | (* You might've noticed that the list type in the function definitions of the 19 | operator [( @ )] (and also [( :: )]) look a bit different from every other 20 | type we've used thusfar. This is because a list is a "parameterized data 21 | type". You can't just have a list; you have to have a list of somethings 22 | (like a list of integers). 23 | 24 | The ['a list] in the signature means that this functions can be used on lists 25 | containing any type of data, as long as the contained data is the same in the 26 | two argument lists (you can't concatenate a list of integers with a list of 27 | strings). 28 | 29 | Here, the ['a] is called a "type parameter", and [list_append] is described as 30 | a "polymorphic function". We'll revisit parametrized types in later 31 | exercises. *) 32 | 33 | let%test "Testing range..." = [%compare.equal: int list] (range 1 4) [ 1; 2; 3 ] 34 | 35 | let%test "Testing range..." = 36 | [%compare.equal: int list] (range (-5) 3) [ -5; -4; -3; -2; -1; 0; 1; 2 ] 37 | ;; 38 | 39 | (* By the way, [%compare.equal: t] is some syntatic magic that the OCaml ppx 40 | processor turns into the standard equality function for comparing two values 41 | of type [t]. 42 | 43 | For example, [%compare.equal: float] is replaced at compile-time with the 44 | equality function for floats, whilte [%compare.equal: int list] is the 45 | equality function for lists of integers. 46 | 47 | One situation where this is really useful is instantiations of containers 48 | (like the [int list] example above). Instead of writing an equality function 49 | by hand, or defining a module specialized to that type just to use its 50 | equality operator, you can ask the [ppx_compare] syntax extension to create 51 | it for you on the fly. *) 52 | -------------------------------------------------------------------------------- /02-exercises/09-list_range/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val range : int -> int -> int list 4 | -------------------------------------------------------------------------------- /02-exercises/10-higher_order_functions/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_10) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/10-higher_order_functions/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | let plus x y = x + y 4 | let times x y = x * y 5 | 6 | (* Sometimes, multiple functions look similar. For example, consider 7 | [add_every_number_up_to] and [factorial]. *) 8 | let rec add_every_number_up_to x = 9 | match x with 10 | | 0 -> 0 11 | | _ -> plus x (add_every_number_up_to (x - 1)) 12 | ;; 13 | 14 | let rec factorial x = 15 | match x with 16 | | 0 -> 1 17 | | _ -> times x (factorial (x - 1)) 18 | ;; 19 | 20 | (* These functions have a lot in common: 21 | 22 | {| 23 | let rec NAME x = 24 | match x with 25 | | 0 -> ANSWER 26 | | _ -> COMBINE x (NAME (x-1)) 27 | |} 28 | *) 29 | 30 | (* OCaml lets us write the common parts just once. We just have to add some 31 | extra arguments. *) 32 | let rec up_to answer combine x = 33 | match x with 34 | | 0 -> answer 35 | | _ -> combine x (up_to answer combine (x - 1)) 36 | ;; 37 | 38 | (* Now we can write our original functions in one line each! 39 | 40 | Check out the signature for [up_to] in the mli. Do all the arguments make 41 | sense? 42 | 43 | Note that the [combine] argument of [up_to] is a function. (Remember higher 44 | order functions?) *) 45 | let simpler_add_every_number_up_to x = up_to 0 plus x 46 | let simpler_factorial x = up_to 1 times x 47 | 48 | (* Infix operators like [( + )] and [( * )] can actually be passed as functions 49 | too, without writing [plus] and [times] like we did above. Another way to 50 | write the above two functions would be: 51 | 52 | [let simpler_add_every_number_up_to x = up_to 0 ( + ) x] 53 | [let simpler_factorial x = up_to 1 ( * ) x] *) 54 | 55 | (* Now let's try refactoring another example. 56 | 57 | Remember [sum] and [product]? *) 58 | let rec sum xs = 59 | match xs with 60 | | [] -> 0 61 | | x :: ys -> plus x (sum ys) 62 | ;; 63 | 64 | let rec product xs = 65 | match xs with 66 | | [] -> 1 67 | | x :: ys -> times x (product ys) 68 | ;; 69 | 70 | (* These functions look pretty similar too! 71 | 72 | Try factoring out the common parts like we did above. *) 73 | let rec every answer combine xs = failwith "For you to implement" 74 | 75 | (* Can you write a signature in the mli for [every]? How does it compare with [up_to]? 76 | 77 | Now, rewrite sum and product in just one line each using [every]. *) 78 | let simpler_sum xs = failwith "For you to implement" 79 | let simpler_product xs = failwith "For you to implement" 80 | 81 | let%test "Testing simpler_product..." = Int.( = ) 1 (simpler_product []) 82 | let%test "Testing simpler_product..." = Int.( = ) 55 (simpler_product [ 55 ]) 83 | let%test "Testing simpler_product..." = Int.( = ) 25 (simpler_product [ 5; -5; 1; -1 ]) 84 | let%test "Testing simpler_product..." = Int.( = ) 25 (simpler_product [ 5; 5; 1; 1 ]) 85 | let%test "Testing simpler_sum..." = Int.( = ) 0 (simpler_sum []) 86 | let%test "Testing simpler_sum..." = Int.( = ) 55 (simpler_sum [ 55 ]) 87 | let%test "Testing simpler_sum..." = Int.( = ) 0 (simpler_sum [ 5; -5; 1; -1 ]) 88 | let%test "Testing simpler_sum..." = Int.( = ) 12 (simpler_sum [ 5; 5; 1; 1 ]) 89 | -------------------------------------------------------------------------------- /02-exercises/10-higher_order_functions/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val up_to : int -> (int -> int -> int) -> int -> int 4 | val simpler_sum : int list -> int 5 | val simpler_product : int list -> int 6 | -------------------------------------------------------------------------------- /02-exercises/11-labeled_arguments/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_11) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/11-labeled_arguments/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | (* The following function has the signature: 3 | 4 | {| val divide : int -> int -> int |} 5 | 6 | Looking at just the signature, it's not obvious which [int] argument is the 7 | dividend and which is the divisor. *) 8 | let divide dividend divisor = dividend / divisor 9 | 10 | (* We can fix this ambiguity using labeled arguments. 11 | 12 | To label an argument in a signature, we put "NAME:" before the type. Then, 13 | when defining the function, we put a tilde (~) before the name of the 14 | argument. 15 | 16 | The following function has the signature: 17 | 18 | {| val divide : dividend:int -> divisor:int -> int |} *) 19 | let divide ~dividend ~divisor = dividend / divisor 20 | 21 | (* We can then call it using: 22 | 23 | {| divide ~dividend:9 ~divisor:3 |} *) 24 | let () = 25 | assert ([%compare.equal: int] (divide ~dividend:9 ~divisor:3) 3); 26 | assert ([%compare.equal: int] (divide ~divisor:3 ~dividend:12) 4) 27 | 28 | (* As you see above, labeled arguments can be passed in in any order! 29 | 30 | We can also pass variables into the labeled argument: 31 | 32 | {| 33 | let nine = 9 in 34 | let three = 3 in 35 | divide ~dividend:nine ~divisor:three 36 | |} 37 | 38 | If the variable name happens to be the same as the labeled argument, we 39 | don't even have to write it twice: 40 | 41 | {| 42 | let dividend = 9 in 43 | let divisor = 3 in 44 | divide ~dividend ~divisor 45 | |} 46 | *) 47 | 48 | (* Now, implement [modulo] using our version of divide with labeled 49 | arguments. Remember that you can look at the mli for the function 50 | signature. *) 51 | let modulo ~dividend ~divisor = failwith "For you to implement" 52 | 53 | let%test "Testing modulo..." = 54 | Int.(=) 2 (modulo ~dividend:17 ~divisor:5) 55 | 56 | let%test "Testing modulo..." = 57 | Int.(=) 0 (modulo ~dividend:99 ~divisor:9) 58 | 59 | -------------------------------------------------------------------------------- /02-exercises/11-labeled_arguments/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val modulo : dividend:int -> divisor:int -> int 4 | -------------------------------------------------------------------------------- /02-exercises/12-list_functions/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_12) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/12-list_functions/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Remember the list functions we wrote in exercises 8-10? Many of those 4 | functions that we've been writing by hand are actually available in the 5 | language in a nice, first class way in the [List] module. 6 | 7 | Let's take look at some of the useful functions that are given to you. *) 8 | 9 | (** ========== [List.fold] ========== **) 10 | (* [List.fold] has the following signature: 11 | 12 | {| val fold : 'a list ‑> init:'b ‑> f:('b ‑> 'a ‑> 'b) ‑> 'b |} 13 | 14 | Maybe this looks familiar? This is almost the same as the [every] function 15 | we wrote in exercise 11. 16 | 17 | Let's rewrite [simpler_sum] and [simpler_product] using List.fold *) 18 | 19 | let simpler_sum xs = failwith "For you to implement" 20 | let simpler_product xs = failwith "For you to implement" 21 | 22 | (** ========== [List.map] ========== **) 23 | (* [List.map] has the following signature: 24 | 25 | {| val map : 'a list ‑> f:('a ‑> 'b) ‑> 'b list |} 26 | 27 | [map] allows us to transforms lists from one type to lists of another type by 28 | applying some function [f] to every element of the list. 29 | 30 | Let's write a function that takes in an int list and transforms it into a 31 | float list. (Hint: you can cast an int to a float using [Float.of_int].) *) 32 | 33 | let float_of_int xs = failwith "For you to implement" 34 | 35 | (** ========== [List.init] ========== **) 36 | (* [List.init] has the following signature: 37 | 38 | {| val init : int -> f:(int -> 'a) -> 'a t |} 39 | 40 | [init] allows you to construct new lists. Given a number representing the 41 | number of elements to generate and a function to construct a new element, it 42 | returns a new list 43 | 44 | Let's rewrite the [range] function we wrote in problem 9 to use [init]. *) 45 | 46 | let range from to_ = failwith "For you to implement" 47 | 48 | (** ========== [List.range] ========== **) 49 | (* Turns out this special case of [List.init] is useful enough that it has it's own 50 | function: 51 | 52 | {| 53 | val range : 54 | ?stride:int 55 | -> ?start:[ `exclusive | `inclusive ] 56 | -> ?stop:[ `exclusive | `inclusive ] 57 | -> int 58 | -> int 59 | -> int list 60 | |} 61 | 62 | The arguments that are preceded with a question mark (i.e. [stride], [start], 63 | and [stop]) are called "optional arguments", and are arguments that don't have to 64 | be passed when invoking the function. We'll learn about optional arguments in more 65 | detail in exercise 15.*) 66 | 67 | (** ========== [List.iter] ========== **) 68 | (* [List.iter] has the following signature: 69 | 70 | {| val iter : 'a list -> f:('a -> unit) -> unit |} 71 | 72 | Sometimes you want to do something side-effecting to all the elements of a 73 | list, such as printing them out. [iter] allows you to run a side-effecting 74 | function on every element of a list. 75 | 76 | Let's use [iter] to print a list of ints. Remember that we can use 77 | [Stdio.printf] to print formatted strings. *) 78 | 79 | let print_int_list xs = failwith "For you to implement" 80 | 81 | (* There are many more useful [List] functions, which you can read about here: 82 | https://ocaml.janestreet.com/ocaml-core/latest/doc/base/Base/List/index.html 83 | 84 | A couple that are worth noting: 85 | 86 | * [List.find] 87 | 88 | {| val find : 'a list -> f:('a -> bool) -> 'a option |} 89 | 90 | This allows you to find the first element in a list that satifies some 91 | condition [f]. 92 | 93 | * [List.filter] 94 | 95 | {| val filter : 'a list -> f:('a -> bool) -> 'a list |} 96 | 97 | This allows you to remove all elements from a list that do not satisfy some 98 | condition [f]. 99 | 100 | * [List.mapi] 101 | 102 | {| val mapi : 'a list -> f:(int -> 'a -> 'b) -> 'b list |} 103 | 104 | This is just like map, but it also gives [f] the index of the element in the 105 | list. 106 | 107 | * [List.zip] 108 | 109 | {| val zip : 'a list -> 'b list -> ('a * 'b) list option |} 110 | 111 | This allows you to combine two lists pairwise. It will return [None] if the 112 | lists are not equal in length. (You will learn about options and what [None] 113 | means in exercise 15.) *) 114 | 115 | let%test "Testing simpler_product..." = Int.( = ) 1 (simpler_product []) 116 | let%test "Testing simpler_product..." = Int.( = ) 55 (simpler_product [ 55 ]) 117 | let%test "Testing simpler_product..." = Int.( = ) 25 (simpler_product [ 5; -5; 1; -1 ]) 118 | let%test "Testing simpler_product..." = Int.( = ) 25 (simpler_product [ 5; 5; 1; 1 ]) 119 | let%test "Testing simpler_sum..." = Int.( = ) 0 (simpler_sum []) 120 | let%test "Testing simpler_sum..." = Int.( = ) 55 (simpler_sum [ 55 ]) 121 | let%test "Testing simpler_sum..." = Int.( = ) 0 (simpler_sum [ 5; -5; 1; -1 ]) 122 | let%test "Testing simpler_sum..." = Int.( = ) 12 (simpler_sum [ 5; 5; 1; 1 ]) 123 | 124 | let%test "Testing float_of_int..." = [%compare.equal: float list] (float_of_int [1; 2; 3]) [ 1.0; 2.0; 3.0 ] 125 | 126 | let%test "Testing range..." = [%compare.equal: int list] (range 1 4) [ 1; 2; 3 ] 127 | 128 | let%test "Testing range..." = 129 | [%compare.equal: int list] (range (-5) 3) [ -5; -4; -3; -2; -1; 0; 1; 2 ] 130 | ;; 131 | -------------------------------------------------------------------------------- /02-exercises/12-list_functions/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val print_int_list : int list -> unit -------------------------------------------------------------------------------- /02-exercises/13-arrays/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_13) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess 8 | (pps ppx_jane))) 9 | 10 | (env 11 | (dev 12 | (flags 13 | (:standard -w -20 -w -27 -w -32 -w -34 -w -37 -w -39))) 14 | (release 15 | (flags (:standard)))) 16 | -------------------------------------------------------------------------------- /02-exercises/13-arrays/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Arrays are mutable data structures with a fixed size. Like lists, arrays can 4 | only contain elements of the same type. Unlike lists, arrays have fast access 5 | and modification, so they are often used in the more imperative style of 6 | OCaml. *) 7 | 8 | (* We can create an array of a given length, initialized with a given value, 9 | using [create]: 10 | 11 | {| val create : len:int -> 'a -> 'a array |} 12 | 13 | We can also use the array literal "[||]": 14 | 15 | {| let array = [| 1; 2; 3 |] |} 16 | 17 | We can query for the length of an array with [length]: 18 | 19 | {| val length : 'a array -> int |} 20 | 21 | We can access a value at a given index in an array using [get]: 22 | 23 | {| val get : 'a array -> int -> 'a |} 24 | 25 | We can write a value to a given index in an array using [set]: 26 | 27 | {| val set : 'a array -> int -> 'a -> unit |} *) 28 | let () = 29 | let array = Array.create ~len:5 "hello" in 30 | assert (String.(=) "hello" (Array.get array 1)); 31 | Array.set array 2 "hello world"; 32 | assert (String.(=) "hello world" (Array.get array 2)) 33 | 34 | (* OCaml also provides some nice syntatic sugar for accessing values and setting 35 | the value at [INDEX] in an array [ARRAY]: 36 | 37 | {| ARRAY.(INDEX) |} 38 | 39 | The following code behaves exactly as the previous block of code. *) 40 | let () = 41 | let array = Array.create ~len:5 "hello" in 42 | assert (String.(=) "hello" array.(1)); 43 | array.(2) <- "hello world"; 44 | assert (String.(=) "hello world" array.(2)) 45 | 46 | (* We can apply a function [f] to each element of an array using [iter]: 47 | 48 | {| val iter : 'a array -> f:('a -> unit) -> unit |} 49 | 50 | [iteri] works almost the same way, it also gives [f] the index of the element 51 | in the array (like [List.mapi] from exercise 12). 52 | 53 | {| val iteri : 'a array -> f:(int -> 'a -> unit) -> unit |} 54 | 55 | Let's implement a function [double] using [Array.iteri], which takes an [int 56 | array] and doubles each element of the array in place. *) 57 | let double array : unit = failwith "For you to implement" 58 | 59 | let%test "Testing double..." = 60 | let array = [| 1; 1; 1 |] in 61 | double array; 62 | [%compare.equal: int array] 63 | [| 2; 2; 2 |] 64 | array 65 | 66 | let%test "Testing double..." = 67 | let array = [| 1; 2; 3; 4; 5 |] in 68 | double array; 69 | [%compare.equal: int array] 70 | [| 2; 4; 6; 8; 10 |] 71 | array 72 | 73 | (* Write a function that takes an [int array] and a list of indicies and 74 | doubles each of the elements at the specified indices. *) 75 | let double_selectively array indices : unit = failwith "For you to implement" 76 | 77 | let%test "Testing double_selectively..." = 78 | let array = [| 1; 1; 1 |] in 79 | (double_selectively array [ 1 ]); 80 | [%compare.equal: int array] 81 | [| 1; 2; 1 |] 82 | array 83 | 84 | let%test "Testing double_selectively..." = 85 | let array = [| 1; 2; 3; 4; 5 |] in 86 | double_selectively array [ 0; 2; 4]; 87 | [%compare.equal: int array] 88 | [| 2; 2; 6; 4; 10 |] 89 | array 90 | 91 | (* Two-dimensional arrays are common enough in code that OCaml provides special 92 | functions just for constructing them! 93 | 94 | {| val make_matrix : dimx:int -> dimy:int -> 'a -> 'a array array |} 95 | 96 | We can access and set values in a two-dimensional array just as we do a 97 | one-dimensional array. *) 98 | let () = 99 | let matrix = Array.make_matrix ~dimx:5 ~dimy:3 "hello" in 100 | assert (String.(=) "hello" matrix.(1).(2)); 101 | matrix.(4).(1) <- "hello world"; 102 | assert (String.(=) "hello world" matrix.(4).(1)) 103 | 104 | (* Write a function that takes an [int array array] and doubles each of the 105 | elements at the specified indices. *) 106 | let double_matrix matrix : unit = failwith "For you to implement" 107 | 108 | let%test "Testing double_matrix..." = 109 | let matrix = [| [| 1; 2; 3 |]; [| 1; 1; 1 |] |] in 110 | (double_matrix matrix); 111 | [%compare.equal: int array array] 112 | [| [| 2; 4; 6 |]; [| 2; 2; 2 |] |] 113 | matrix 114 | -------------------------------------------------------------------------------- /02-exercises/13-arrays/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val double : int array -> unit 4 | val double_selectively : int array -> int list -> unit 5 | -------------------------------------------------------------------------------- /02-exercises/14-variants/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_14) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/14-variants/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* As in most languages, you can define your own types. The keyword [type] 4 | introduces a type definition. 5 | 6 | One of the non-basic types in OCaml is called the variant type. Variant 7 | types are similar to Enums in other languages. They are types which may take 8 | on multiple forms, where each form is marked by an explicit tag. A variant 9 | type is defined as follows: *) 10 | type color = 11 | | Red 12 | | Green 13 | | Blue 14 | 15 | (* Variants are very useful in combination with pattern matching. (Check out 16 | exercise 6 for a refresher on pattern matching.) *) 17 | let to_string color = 18 | match color with 19 | | Red -> "red" 20 | | Green -> "green" 21 | | Blue -> "blue" 22 | 23 | (* OCaml variants are in many ways more powerful than Enums because the 24 | different constructors of your variant can include data in them. Here's an 25 | example: *) 26 | type card_value = 27 | | Ace 28 | | King 29 | | Queen 30 | | Jack 31 | | Number of int 32 | 33 | let one_card_value : card_value = Queen 34 | let another_card_value : card_value = Number 8 35 | 36 | let card_value_to_string card_value = 37 | match card_value with 38 | | Ace -> "Ace" 39 | | King -> "King" 40 | | Queen -> "Queen" 41 | | Jack -> "Jack" 42 | | Number i -> Int.to_string i 43 | 44 | (* Write a function that computes the score of a card (aces should score 11 45 | and face cards should score 10). *) 46 | let card_value_to_score card_value = 47 | failwith "For you to implement" 48 | 49 | (* Remember the list type? We can define a list as a variant type too! *) 50 | type int_list = 51 | | Empty 52 | | Not_empty of int * int_list 53 | 54 | (* OCaml actually allows us to define a list type that can contain any type of 55 | value, not just integers, by using parametrized types. *) 56 | type 'a generic_list = 57 | | Empty 58 | | Not_empty of 'a * 'a generic_list 59 | 60 | (* Recall that ['a] is called a type parameter, for which any other type may be 61 | supplied. For example, we can use the [generic_list] type to define an 62 | integer list. *) 63 | type another_int_list = int generic_list 64 | 65 | let%test "Testing card_value_to_score..." = 66 | Int.(=) 11 (card_value_to_score Ace) 67 | 68 | let%test "Testing card_value_to_score..." = 69 | Int.(=) 10 (card_value_to_score King) 70 | 71 | let%test "Testing card_value_to_score..." = 72 | Int.(=) 10 (card_value_to_score Queen) 73 | 74 | let%test "Testing card_value_to_score..." = 75 | Int.(=) 10 (card_value_to_score Jack) 76 | 77 | let%test "Testing card_value_to_score..." = 78 | Int.(=) 5 (card_value_to_score (Number 5)) 79 | 80 | -------------------------------------------------------------------------------- /02-exercises/14-variants/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type card_value 4 | 5 | val card_value_to_score : card_value -> int 6 | -------------------------------------------------------------------------------- /02-exercises/15-options/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_15) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/15-options/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type 'a option = 4 | | None 5 | | Some of 'a 6 | 7 | val safe_divide : dividend:int -> divisor:int -> int option 8 | val option_concatenate : string option -> string option -> string option 9 | val concatenate : ?separator : string -> string -> string -> string 10 | -------------------------------------------------------------------------------- /02-exercises/16-tuples/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_16) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/16-tuples/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Another non-basic type in OCaml is a tuple. A tuple is an ordered collection 4 | of values that can each be of a different type. The signature for a tuple is 5 | written by separating all the types within the tuple by a [*]. *) 6 | type string_and_int = string * int 7 | type int_and_string_and_char = int * string * char 8 | 9 | (* Tuples are created by joining values with a comma. *) 10 | let example : int_and_string_and_char = 5, "hello", 'A' 11 | 12 | (* You can also extract the components of a tuple. *) 13 | let i, s, c = example 14 | 15 | let () = 16 | assert (i = 5); 17 | assert (String.( = ) s "hello"); 18 | assert (Char.( = ) c 'A') 19 | ;; 20 | 21 | (* Consider a coordinate type containing the x and y values of a coordinate. 22 | Write a function that computes the sum of two coordinates. *) 23 | type coordinate = int * int 24 | 25 | let add coord1 coord2 = failwith "For you to implement" 26 | 27 | (* Now consider a [name] type containing two [string]s representing the first and 28 | the last name. *) 29 | type name = string * string 30 | 31 | (* Or an [initials] type containing two [char]s representing the first and the 32 | last initial. *) 33 | type initials = char * char 34 | 35 | (* Say we want to write a function that extracts the first element from a 36 | coordinate, name, or initials. We currently can't write that because they all 37 | have different types. 38 | 39 | Let's define a new [pair] type which is parameterized over the type contained 40 | in the pair. *) 41 | type 'a pair = 'a * 'a 42 | 43 | (* Our types defined above could be rewritten as 44 | 45 | {| 46 | type coordinate = int pair 47 | type name = string pair 48 | type initials = char pair 49 | |} 50 | *) 51 | 52 | (* We can construct pairs just like we construct regular tuples *) 53 | let int_pair : int pair = 5, 7 54 | let string_pair : string pair = "foo", "bar" 55 | let nested_char_pair : char pair pair = ('a', 'b'), ('c', 'd') 56 | 57 | (* Write functions to extract the first and second elements from a pair. Their 58 | signatures can be found in the mli. *) 59 | let first pair = failwith "For you to implement" 60 | let second pair = failwith "For you to implement" 61 | 62 | (* Notice the cool [%compare.equal: int * int] here! *) 63 | let%test "Testing add..." = [%compare.equal: int * int] (4, 7) (add (5, 3) (-1, 4)) 64 | let%test "Testing first..." = String.( = ) "foo" (first ("foo", "bar")) 65 | let%test "Testing second..." = Char.( = ) 'b' (second ('a', 'b')) 66 | -------------------------------------------------------------------------------- /02-exercises/16-tuples/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val add : int * int -> int * int -> int * int 4 | 5 | type 'a pair 6 | val first : 'a pair -> 'a 7 | val second : 'a pair -> 'a 8 | 9 | -------------------------------------------------------------------------------- /02-exercises/17-records/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_17) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/17-records/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* OCaml allows us to define record types. 4 | 5 | Records are like structs in C, or data members of a class in 6 | python/ruby/java. *) 7 | 8 | (* Consider this example of the type [person], which contains four fields. *) 9 | type person = 10 | { age : int 11 | ; first_name : string 12 | ; last_name : string 13 | ; number_of_cars : int 14 | } [@@deriving compare] 15 | 16 | (* We can create a [person] by specifying each of the fields. 17 | 18 | When defining (or matching on) a record, the fields can be listed in any 19 | order. *) 20 | let an_example : person = 21 | { first_name = "Cotton-eyed" 22 | ; last_name = "Joe" 23 | ; age = 22 24 | ; number_of_cars = 0 25 | } 26 | 27 | (* We can use the "." operator to get the value of a field out of a record: 28 | VARIABLE.FIELD *) 29 | let age : int = an_example.age 30 | let () = assert (age = 22) 31 | 32 | (* We can also match on records to get values for multiple fields at once. 33 | 34 | Note that we can assign the value of a field to a different variable name 35 | (like we do here with [age]). *) 36 | let print_info {first_name; last_name; age = number_of_years_alive; number_of_cars} = 37 | Stdio.print_endline first_name; 38 | Stdio.print_endline last_name; 39 | Stdio.printf "Age: %d, # of cars: %d\n" number_of_years_alive number_of_cars 40 | ;; 41 | 42 | (* If we don't care about an argument we can ignore it by assigning it to [_]. *) 43 | let print_name ({first_name; last_name; age = _; number_of_cars = _}) = 44 | Stdio.print_endline first_name; 45 | Stdio.print_endline last_name 46 | 47 | (* Finally, we can perform "functional updates" by replacing the value of a 48 | field, yielding a brand new record. We use the [with] keyword to do this. 49 | 50 | Verify the type of [add_one_to_age] in the mli. *) 51 | let add_one_to_age person = 52 | { person with age = person.age + 1 } 53 | 54 | let () = assert (23 = (add_one_to_age an_example).age) 55 | 56 | (* Write a function that does different things for different people: 57 | 58 | - When the person's first name is "Jan", you should return a record with the 59 | age set to 30. 60 | 61 | - Otherwise, you should increase the number of cars by 6. *) 62 | let modify_person (person : person) = 63 | failwith "For you to implement" 64 | 65 | module For_testing = struct 66 | let test_ex1 : person = { 67 | first_name = "Jan"; 68 | last_name = "Saffer"; 69 | age = 55; 70 | number_of_cars = 0; 71 | };; 72 | 73 | let test_ex1' : person = {test_ex1 with age = 30};; 74 | 75 | let test_ex2 : person = { 76 | first_name = "Hugo"; 77 | last_name = "Heuzard"; 78 | age = 4; 79 | number_of_cars = 55; 80 | };; 81 | 82 | let test_ex2' : person = { test_ex2 with number_of_cars = 61};; 83 | 84 | let%test "Testing modify_person..." = 85 | [%compare.equal: person] test_ex1' (modify_person test_ex1) 86 | ;; 87 | 88 | let%test "Testing modify_person..." = 89 | [%compare.equal: person] test_ex2' (modify_person test_ex2) 90 | ;; 91 | end 92 | -------------------------------------------------------------------------------- /02-exercises/17-records/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type person 4 | 5 | val add_one_to_age : person -> person 6 | val modify_person : person -> person 7 | -------------------------------------------------------------------------------- /02-exercises/18-mutable_records/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_18) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/18-mutable_records/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Sometimes rather than redefining the record you would like to have a field or 4 | a set of fields that you can modify on the fly. 5 | 6 | In OCaml, we can use the [mutable] keyword to indicate that a particular 7 | field in a record can be modified in place. Then we can use [<-] to set the 8 | record value to a new value. *) 9 | type color = 10 | | Red 11 | | Yellow 12 | | Green 13 | 14 | (* An aside: Note that for the [stoplight] type definition is followed by 15 | [@@deriving compare]. This is a ppx (remember the [%compare.equal] ppx from 16 | exercise 9?) that gives us functions for comparing values of the [stoplight] 17 | type without having to define them by hand. 18 | 19 | Before changing anything in this exercise, you'll get an error about "Unbound 20 | value compare_color". This is because we tried to use the [compare] ppx for 21 | [stoplight] below, which has a [color] as one of its fields, but the compiler 22 | does not know how to compare two [color]s. 23 | 24 | We can fix this compile error by either manually writing a compare function 25 | for the [color] type, or (much more easily) by adding the [compare] ppx to 26 | the [color] type as well. *) 27 | type stoplight = 28 | { location : string (* stoplights don't usually move *) 29 | ; mutable color : color (* but they often change color *) 30 | } 31 | [@@deriving compare] 32 | 33 | (* On creation, mutable fields are defined just like normal fields. *) 34 | let an_example : stoplight = 35 | { location = "The corner of Vesey Street and the West Side highway"; color = Red } 36 | ;; 37 | 38 | (* Now rather than using a functional update we can use a mutable update. This 39 | doesn't return a new stoplight, it modifies the input stoplight. 40 | 41 | Inspect the type of [set_color]. *) 42 | let set_color stoplight color = stoplight.color <- color 43 | 44 | (* For this exercise, assume that stoplights always transition from [Green] to 45 | [Yellow], [Yellow] to [Red], and [Red] to [Green]. Since we know this is the 46 | only transition, we can just write a function to advance the color of the 47 | light without taking an input color. *) 48 | let advance_color stoplight = failwith "For you to implement" 49 | 50 | module For_testing = struct 51 | let test_ex_red : stoplight = { location = ""; color = Red } 52 | let test_ex_red' : stoplight = { test_ex_red with color = Green } 53 | let test_ex_yellow : stoplight = { location = ""; color = Yellow } 54 | let test_ex_yellow' : stoplight = { test_ex_red with color = Red } 55 | let test_ex_green : stoplight = { location = ""; color = Green } 56 | let test_ex_green' : stoplight = { test_ex_red with color = Yellow } 57 | 58 | let%test "Testing advance_color..." = 59 | advance_color test_ex_green; 60 | [%compare.equal: stoplight] test_ex_green' test_ex_green 61 | ;; 62 | 63 | let%test "Testing advance_color..." = 64 | advance_color test_ex_yellow; 65 | [%compare.equal: stoplight] test_ex_yellow' test_ex_yellow 66 | ;; 67 | 68 | let%test "Testing advance_color..." = 69 | advance_color test_ex_red; 70 | [%compare.equal: stoplight] test_ex_red' test_ex_red 71 | ;; 72 | end 73 | -------------------------------------------------------------------------------- /02-exercises/18-mutable_records/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type color 4 | type stoplight 5 | 6 | val set_color : stoplight -> color -> unit 7 | val advance_color : stoplight -> unit 8 | -------------------------------------------------------------------------------- /02-exercises/19-refs/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_19) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/19-refs/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* It is sometimes useful to create a single mutable value. We can do this using 4 | a [ref]. We can create an [int ref] containing 0 as follows. *) 5 | let x = ref 0 6 | 7 | (* Then we can access the value in the ref using the [!] operator, and we can 8 | update it using the [:=] operator. So, we could increment our ref as 9 | follows. *) 10 | let () = 11 | x := !x + 1 12 | 13 | (* Write a function min_and_max which returns a tuple containing the minimum and 14 | maximum values in a non-empty list of positive integers. Your function should 15 | raise if the list is empty. 16 | 17 | You could do this using [List.fold], but for the purpose of this exercise, 18 | let's iterate over the list and explicitly maintain refs of the minimum and 19 | maximum values seen so far instead. *) 20 | let min_and_max lst = 21 | failwith "For you to implement" 22 | 23 | (* By the way, can you guess how a [ref] is implemented under the hood? 24 | 25 | (Hint: exercise 18.) *) 26 | 27 | let%test "Testing min_and_max..." = 28 | [%compare.equal: int * int] (min_and_max [5;9;2;4;3]) (2,9) 29 | ;; 30 | 31 | let%test "Testing min_and_max..." = 32 | [%compare.equal: int*int] (min_and_max [11;15;7;34]) (7,34) 33 | ;; 34 | -------------------------------------------------------------------------------- /02-exercises/19-refs/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val min_and_max : int list -> int * int 4 | -------------------------------------------------------------------------------- /02-exercises/20-anonymous_functions/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_20) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/20-anonymous_functions/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* Recall: In OCaml, functions are values, so we can pass them in as arguments 4 | to other functions (higher order functions). 5 | 6 | As we've seen before, in order to represent a function in a signature, we 7 | wrap its type in parenthesis, with arrows separating arguments. 8 | 9 | Remember [add1] from exercise 4? 10 | 11 | {| val add1 : int -> int |} 12 | 13 | When we used its signature in a type, we had to write [(int -> int)]. *) 14 | 15 | (* Now, let's define a function called [map_option]. [map_option] takes a 16 | function and an option. 17 | 18 | If the option has a value of [None], [map_option] returns [None]. 19 | 20 | If the option has a value of [Some x], the function is called on x, and 21 | wrapped up in a [Some]. 22 | 23 | It may seem unintuitive, but this kind of function is very useful because it 24 | allows you to continue applying functions to data without having to 25 | explicitly deal with [None] values or worry about null pointer exceptions if 26 | the data isn't there! 27 | 28 | Make sure to inspect and understand the signature for [map_option]. *) 29 | let map_option f opt = 30 | match opt with 31 | | None -> None 32 | | Some i -> Some (f i) 33 | 34 | let double i = 2 * i 35 | 36 | let () = 37 | assert 38 | ([%compare.equal: int option] 39 | (map_option double None) 40 | None) 41 | 42 | let () = 43 | assert 44 | ([%compare.equal: int option] 45 | (map_option double (Some 2)) 46 | (Some 4)) 47 | 48 | (* In the previous example, we defined [double] separately before using it with 49 | [map_option]. Instead of defining the [double] beforehand, we can use an 50 | anonymous function. 51 | 52 | To write an anonymous function, we use the [fun] keyword in the following 53 | form: 54 | 55 | {| (fun ARG1 ARG2 ... -> BODY) |} 56 | 57 | The following has the same effect as above: *) 58 | let () = 59 | assert 60 | ([%compare.equal: int option] 61 | (map_option (fun i -> 2 * i) (Some 2)) 62 | (Some 4)) 63 | 64 | (* Define a function, [apply_if_nonzero], which takes a function from an integer 65 | to an integer and applies the function to the supplied argument if it is not 66 | zero, and otherwise just returns 0. *) 67 | let apply_if_nonzero f i = 68 | failwith "For you to implement" 69 | 70 | (* Now, using [apply_if_nonzero] with an anonymous function, write 71 | [add1_if_nonzero], which takes an integer and adds 1 to it if it is not zero, 72 | and otherwise just returns 0. *) 73 | let add1_if_nonzero i = 74 | failwith "For you to implement" 75 | 76 | let%test "Testing add1_if_nonzero..." = 77 | Int.(=) 0 (add1_if_nonzero 0) 78 | 79 | let%test "Testing add1_if_nonzero..." = 80 | Int.(=) 2 (add1_if_nonzero 1) 81 | 82 | let%test "Testing add1_if_nonzero..." = 83 | Int.(=) 6 (add1_if_nonzero 5) 84 | -------------------------------------------------------------------------------- /02-exercises/20-anonymous_functions/problem.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | val map_option : ('a -> 'b) -> 'a option -> 'b option 4 | val apply_if_nonzero : (int -> int) -> int -> int 5 | -------------------------------------------------------------------------------- /02-exercises/21-reading_sigs/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name problem_21) 5 | (libraries base stdio) 6 | (inline_tests) 7 | (preprocess (pps ppx_jane))) 8 | 9 | (env 10 | (dev 11 | (flags (:standard 12 | -w -20 13 | -w -27 14 | -w -32 15 | -w -34 16 | -w -37 17 | -w -39))) 18 | (release 19 | (flags (:standard)))) 20 | -------------------------------------------------------------------------------- /02-exercises/21-reading_sigs/problem.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* OCaml, like many other languages, provides a way to interact with code via 4 | interfaces. This allows implementation details to be hidden away, and for 5 | grouped units of code to restrict how they are used. 6 | 7 | Thusfar, we've only dealt with interfaces in the context of mli files. mli 8 | files define what is exposed to code outside of the ml file; anything that is 9 | not exposed in the mli cannot be accessed outside of the ml file. 10 | 11 | We can also define modules and signatures within a single ml file. Just like 12 | when we define a signature in an mli file, signatures defined in ml files 13 | determine what functions are exposed to the rest of the code. 14 | 15 | Here's an example of a module signature coupled with an implementation. The 16 | signature is wrapped in a [sig] / [end] pair. The implementation is wrapped 17 | in a [struct] / [end] pair. *) 18 | module Example : sig 19 | (* Here, just as in mli files, [val] indicates that we are exposing a 20 | value. This value is an integer *) 21 | val the_meaning_of_life_the_universe_and_everything : int 22 | 23 | (* To declare functions, again we use [val] (remember, in OCaml, functions are 24 | values). This value takes an integer as a parameter and returns an integer. 25 | *) 26 | val subtract_one : int -> int 27 | end = struct 28 | let the_meaning_of_life_the_universe_and_everything = 42 29 | let subtract_one x = x - 1 30 | 31 | (* [a_secret_value] is not exposed in the mli, so it will not be accessible 32 | outside the code. *) 33 | let a_secret_value = 17 34 | end 35 | 36 | (* Here's how we use these values. *) 37 | let one_less_than_the_meaning_of_life_etc = 38 | Example.subtract_one Example.the_meaning_of_life_the_universe_and_everything 39 | ;; 40 | 41 | let () = 42 | assert (one_less_than_the_meaning_of_life_etc = 41) 43 | 44 | (* Try uncommenting this line of code. What does the compiler tell you? *) 45 | (* let () = 46 | * assert (Example.a_secret_value = 17) *) 47 | 48 | (* Types can be exposed via signatures in OCaml as well. Here's an example of 49 | declaring an "abstract" type - one where the definition of the type is not 50 | exposed. *) 51 | module Abstract_type_example : sig 52 | (* We do not let the user know the underlying representation of [t]. *) 53 | type t 54 | 55 | (* This function allows [t] to be coerced into an integer. *) 56 | val to_int : t -> int 57 | 58 | (* Users need some way to start with some [t]. *) 59 | val zero : t 60 | val one : t 61 | 62 | (* Let them do something with the [t]. *) 63 | val add : t -> t -> t 64 | end = struct 65 | type t = int 66 | 67 | let to_int x = x 68 | let zero = 0 69 | let one = 1 70 | let add = ( + ) 71 | end 72 | 73 | (* Here's an example of adding 2 and 2 *) 74 | let two = Abstract_type_example.add Abstract_type_example.one Abstract_type_example.one 75 | let four = Abstract_type_example.to_int (Abstract_type_example.add two two);; 76 | 77 | assert (four = 4) 78 | 79 | module Fraction : sig 80 | type t 81 | (* Now, add signatures for the create and value functions to expose them in 82 | the [Fraction] module. Note that you shouldn't need to change any of the 83 | underlying implementation, nor change anything about how [t] is exposed. *) 84 | end = struct 85 | type t = int * int 86 | 87 | let create ~numerator ~denominator = numerator, denominator 88 | let value (numerator, denominator) = Float.of_int numerator /. Float.of_int denominator 89 | end 90 | 91 | let%test "Testing Fraction.value..." = 92 | Float.( = ) 2.5 (Fraction.value (Fraction.create ~numerator:5 ~denominator:2)) 93 | ;; 94 | 95 | let%test "Testing Fraction.value..." = 96 | Float.( = ) 0.4 (Fraction.value (Fraction.create ~numerator:4 ~denominator:10)) 97 | ;; 98 | -------------------------------------------------------------------------------- /02-exercises/21-reading_sigs/problem.mli: -------------------------------------------------------------------------------- 1 | (* This file deliberately left empty. *) 2 | -------------------------------------------------------------------------------- /02-exercises/dune: -------------------------------------------------------------------------------- 1 | ;; -*- Scheme -*- 2 | 3 | (alias 4 | (name DEFAULT) 5 | (deps 6 | (alias_rec 01-introduction/runtest) 7 | (alias_rec 02-basic_types/runtest) 8 | (alias_rec 03-define_functions/runtest) 9 | (alias_rec 04-call_functions/runtest) 10 | (alias_rec 05-twice/runtest) 11 | (alias_rec 06-pattern-matching/runtest) 12 | (alias_rec 07-simple_recursion/runtest) 13 | (alias_rec 08-list_intro/runtest) 14 | (alias_rec 09-list_range/runtest) 15 | (alias_rec 10-list_product/runtest) 16 | (alias_rec 11-sum_product/runtest) 17 | (alias_rec 12-list_functions/runtest) 18 | (alias_rec 13-labelled_arguments/runtest) 19 | (alias_rec 14-variants/runtest) 20 | (alias_rec 15-options/runtest) 21 | (alias_rec 16-tuples/runtest) 22 | (alias_rec 17-records/runtest) 23 | (alias_rec 18-mutable_records/runtest) 24 | (alias_rec 19-refs/runtest) 25 | (alias_rec 20-anonymous_functions/runtest) 26 | (alias_rec 21-reading_sigs/runtest) 27 | )) 28 | -------------------------------------------------------------------------------- /02-exercises/dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.5) 2 | -------------------------------------------------------------------------------- /03-frogger/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM kyma/docker-nginx 2 | COPY . /var/www 3 | CMD 'nginx' 4 | -------------------------------------------------------------------------------- /03-frogger/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build @DEFAULT 3 | -------------------------------------------------------------------------------- /03-frogger/README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Frogger in your browser 2 | 3 | * Introduction 4 | If you've never played Frogger, play an online version (picked at random) here: 5 | [[https://denodell.github.io/frogger/]] 6 | 7 | You will be writing a simplified version that discretizes time and space, which 8 | makes the collision and movement logic a lot easier to implement. [[http://storage.googleapis.com/jane-street-ocaml-workshop-2018-03-24-frogger/index.html][Here's]] an 9 | example of the finished product. Try pressing the keys ~i~ and ~u~ to see some 10 | fun tricks! 11 | 12 | * ~js_of_ocaml~ 13 | This version of Frogger will run in the browser by using ~js-of-ocaml~ to 14 | transpile OCaml bytecode into Javascript. Fortunately for us, ~dune~ 15 | supports this out of the box: all one needs to do is ask for the ~.bc.js~ 16 | target (see the definition of the ~DEFAULT~ alias in the [[file:dune][dune]] file). 17 | 18 | First, test your installation of ~js-of-ocaml~ by running ~make~ in the 19 | [[file:test-js-of-ocaml-install][test-js-of-ocaml-install]] directory. Then, point your browser at 20 | ~_build/default/03-frogger/test-js-of-ocaml-install/index.html~. 21 | 22 | * Writing a game in functional programming style 23 | We have written a simple scaffold that handles graphics, events and 24 | interactions with the DOM so you can focus on implementing just the game 25 | logic. [[file:scaffold.mli][scaffold.mli]] defines modules and types that you'll need to use, like 26 | the number and kinds of rows in the playing board, and images of characters. 27 | 28 | Take a look at [[file:frogger.mli][frogger.mli]]. This is the interface you will implement by 29 | writing a corresponding ~frogger.ml~. The contract between the scaffold and 30 | your code is that you implement the four functions at the bottom of this 31 | ~.mli~, and the scaffold will call those functions with the appropriate events 32 | at the right times. 33 | 34 | A ~World.t~ represents the entire state of the game at a given point in time. 35 | It is up to you to define what goes in the type -- that's why ~frogger.mli~ 36 | does not specify what's inside the type (we call this an /opaque/ type). 37 | However, to help you get started, we've specified some function signatures in 38 | the ~World~ module [[file:suggested_frogger.mli][here]] that are likely to be useful. 39 | 40 | To specify the logic of the game, you'll need to figure out the following 41 | things (these correspond to the functions in [[file:frogger.mli][frogger.mli]]): 42 | 43 | ** How to create the world 44 | This is the ~create~ function. You may want to use the ~Random~ module (from 45 | ~Base~) to make life interesting. 46 | 47 | ** How to advance the world one timestep 48 | For this first project, we'll say that time advances only in units of 1 49 | second. The ~tick~ function should implement how the ~World.t~ is transformed 50 | when time advances. Note its signature: 51 | 52 | #+BEGIN_SRC ocaml 53 | val tick : World.t -> World.t 54 | #+END_SRC 55 | 56 | It takes a ~World.t~ and returns a new ~World.t~. Writing your game in this 57 | functional style will allow us to do some interesting things later on. 58 | 59 | ** How to respond to player input 60 | Players can press one of the four arrow keys to move their character around. 61 | You specify what to do when they do that by writing a ~handle_input~ 62 | function. 63 | 64 | All this function needs to know is: what the current state of the world is (a 65 | ~World.t~), and what button player pressed (a ~Key.t~). Its output: the 66 | resulting state of the world (a ~World.t~). 67 | 68 | ** ~handle_event~: dispatch to ~tick~ or ~handle_input~ 69 | It's nice to be able to say, "The only things that happen in this game are: 70 | time progressing, and the player doing something." Your ~handle_event~ 71 | function should just ~match~ on the kind of event and dispatch to the 72 | appropriate handler (one of the two above). 73 | 74 | ** How to draw the world 75 | A list of tuples ~(Image.t, Position.t)~ tell the scaffold which images to 76 | draw where, and in what order: images later in the list will be overlaid on 77 | top of earlier ones at the same position. 78 | 79 | * That seems awfully complicated! How should I start? 80 | A reasonable starting point is to just move the frog (well, camel) around the 81 | game board. Read [[file:frogger.ml][frogger.ml]] and follow the suggestions to build this basic game. 82 | 83 | * Build and run 84 | Type =make= to build, and point your browser to 85 | =_build/default/03-frogger/index.html= to play the game! 86 | 87 | * Extensions 88 | ** AI 89 | Write an AI player for your game. Given the initial ~World.t~, it should emit 90 | a sequence of ~Key.t option~, one for every timestep. 91 | 92 | To see your AI in action you will need to modify the scaffold a little: 93 | instead of feeding player input into the ~handle_input~ function, make it 94 | feed in the output of the AI you write. 95 | 96 | *** Some interesting extensions once you've written an AI 97 | 1. Does your ~create~ function ever produce initial states that cannot be 98 | played to a win? 99 | 100 | 2. How would you write AI to deal with potential randomness in the ~tick~ 101 | function? 102 | 103 | ** Continuous time 104 | While the interpolating scaffold is a neat trick, it's not perfect because 105 | the collision detection logic is now out-of-sync with what's going on 106 | visually. Extend the interface, game logic and scaffold to produce a 107 | smoothly-animated Frogger that also plays right. 108 | -------------------------------------------------------------------------------- /03-frogger/assets/background.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/background.png -------------------------------------------------------------------------------- /03-frogger/assets/buggy-left.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/buggy-left.png -------------------------------------------------------------------------------- /03-frogger/assets/buggy-right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/buggy-right.png -------------------------------------------------------------------------------- /03-frogger/assets/camel-down.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/camel-down.png -------------------------------------------------------------------------------- /03-frogger/assets/camel-left.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/camel-left.png -------------------------------------------------------------------------------- /03-frogger/assets/camel-right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/camel-right.png -------------------------------------------------------------------------------- /03-frogger/assets/camel-up.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/camel-up.png -------------------------------------------------------------------------------- /03-frogger/assets/carpet_blue.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/carpet_blue.png -------------------------------------------------------------------------------- /03-frogger/assets/carpet_green.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/carpet_green.png -------------------------------------------------------------------------------- /03-frogger/assets/carpet_red.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/carpet_red.png -------------------------------------------------------------------------------- /03-frogger/assets/confetti.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/confetti.png -------------------------------------------------------------------------------- /03-frogger/assets/police-car-left.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/police-car-left.png -------------------------------------------------------------------------------- /03-frogger/assets/police-car-right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/police-car-right.png -------------------------------------------------------------------------------- /03-frogger/assets/red-pickup-left.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/red-pickup-left.png -------------------------------------------------------------------------------- /03-frogger/assets/red-pickup-right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/red-pickup-right.png -------------------------------------------------------------------------------- /03-frogger/assets/skull.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/skull.png -------------------------------------------------------------------------------- /03-frogger/assets/truck-left.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/truck-left.png -------------------------------------------------------------------------------- /03-frogger/assets/truck-right.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/janestreet/learn-ocaml-workshop/1ba9576b48b48a892644eb20c201c2c4aa643c32/03-frogger/assets/truck-right.png -------------------------------------------------------------------------------- /03-frogger/config.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Import 3 | 4 | open Scaffold 5 | 6 | type t = 7 | { num_cols : int 8 | ; num_rows : int 9 | ; grid_size_in_px : int 10 | ; render_interval_ms : float 11 | ; logic_interval_ms : float 12 | } 13 | 14 | let default = 15 | { num_rows = List.length Board.rows 16 | ; num_cols = Board.num_cols 17 | ; grid_size_in_px = 50 18 | ; render_interval_ms = 50. 19 | ; logic_interval_ms = 1000. 20 | } 21 | 22 | let width t = t.num_cols * t.grid_size_in_px 23 | let height t = t.num_rows * t.grid_size_in_px 24 | 25 | 26 | -------------------------------------------------------------------------------- /03-frogger/draw.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Js_of_ocaml 3 | open! Import 4 | 5 | open Scaffold 6 | 7 | module Screen = struct 8 | type t = 9 | { context : Html.canvasRenderingContext2D Js.t 10 | ; width : int 11 | ; height : int 12 | } 13 | end 14 | 15 | module Image_impl = struct 16 | type t = 17 | { image_element : Html.imageElement Js.t 18 | } 19 | 20 | let create path = 21 | let image_element = Html.createImg document in 22 | image_element##.src := Js.string path; 23 | { image_element 24 | } 25 | ;; 26 | 27 | (* If we were using a concurrency library like [Async] or [Lwt], we would want 28 | to make [width] and [height] members of the record. But they can only be 29 | read after the image has loaded. *) 30 | let width t = jsoptdef_value_exn (t.image_element##.naturalWidth ) 31 | let height t = jsoptdef_value_exn (t.image_element##.naturalHeight) 32 | 33 | let draw (screen : Screen.t) t x y img_width img_height = 34 | let f = Int.to_float in 35 | screen.context##drawImage_full 36 | t.image_element 37 | 0. 0. 38 | (width t |> f) (height t |> f) 39 | x y 40 | (f img_width) (f img_height) 41 | end 42 | 43 | module Wad = struct 44 | type t = 45 | { background : Image_impl.t 46 | ; skull_and_crossbones : Image_impl.t 47 | ; frog_up : Image_impl.t 48 | ; frog_down : Image_impl.t 49 | ; frog_left : Image_impl.t 50 | ; frog_right : Image_impl.t 51 | ; car1_left : Image_impl.t 52 | ; car2_left : Image_impl.t 53 | ; car1_right : Image_impl.t 54 | ; car2_right : Image_impl.t 55 | ; car3_left : Image_impl.t 56 | ; car3_right : Image_impl.t 57 | ; confetti : Image_impl.t 58 | ; log1 : Image_impl.t 59 | ; log2 : Image_impl.t 60 | ; log3 : Image_impl.t 61 | } 62 | [@@deriving fields] 63 | 64 | let create (_config : Config.t) = 65 | let background = Image_impl.create "assets/background.png" in 66 | let skull_and_crossbones = Image_impl.create "assets/skull.png" in 67 | let frog_up = Image_impl.create "assets/camel-up.png" in 68 | let frog_down = Image_impl.create "assets/camel-down.png" in 69 | let frog_left = Image_impl.create "assets/camel-left.png" in 70 | let frog_right = Image_impl.create "assets/camel-right.png" in 71 | let car1_left = Image_impl.create "assets/buggy-left.png" in 72 | let car1_right = Image_impl.create "assets/buggy-right.png" in 73 | let car2_left = Image_impl.create "assets/truck-left.png" in 74 | let car2_right = Image_impl.create "assets/truck-right.png" in 75 | let car3_left = Image_impl.create "assets/police-car-left.png" in 76 | let car3_right = Image_impl.create "assets/police-car-right.png" in 77 | let log1 = Image_impl.create "assets/carpet_blue.png" in 78 | let log2 = Image_impl.create "assets/carpet_green.png" in 79 | let log3 = Image_impl.create "assets/carpet_red.png" in 80 | let confetti = Image_impl.create "assets/confetti.png" in 81 | { background 82 | ; skull_and_crossbones 83 | ; frog_up 84 | ; frog_down 85 | ; frog_left 86 | ; frog_right 87 | ; car1_left 88 | ; car2_left 89 | ; car1_right 90 | ; car2_right 91 | ; car3_left 92 | ; car3_right 93 | ; confetti 94 | ; log1 95 | ; log2 96 | ; log3 97 | } 98 | ;; 99 | 100 | let lookup_image t (image : Image.t) = 101 | match image with 102 | | Frog_up -> t.frog_up 103 | | Frog_down -> t.frog_down 104 | | Frog_left -> t.frog_left 105 | | Frog_right -> t.frog_right 106 | 107 | | Car1_left -> t.car1_left 108 | | Car1_right -> t.car1_right 109 | | Car2_left -> t.car2_left 110 | | Car2_right -> t.car2_right 111 | | Car3_left -> t.car3_left 112 | | Car3_right -> t.car3_right 113 | 114 | | Log1 -> t.log1 115 | | Log2 -> t.log2 116 | | Log3 -> t.log3 117 | 118 | | Confetti -> t.confetti 119 | | Skull_and_crossbones -> t.skull_and_crossbones 120 | end 121 | -------------------------------------------------------------------------------- /03-frogger/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (modes byte exe) 3 | (name main) 4 | (preprocess 5 | (pps js_of_ocaml-ppx ppx_jane)) 6 | (modules_without_implementation suggested_frogger) 7 | (libraries base js_of_ocaml)) 8 | 9 | (alias 10 | (name DEFAULT) 11 | (deps 12 | main.bc.js 13 | index.html 14 | (glob_files assets/*.png) 15 | Dockerfile)) 16 | -------------------------------------------------------------------------------- /03-frogger/frogger.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Scaffold 3 | 4 | (* When you start the exercise, the compiler will complain that Frog.create, 5 | * World.create and create_frog are unused. You can remove this attribute once 6 | * you get going. *) 7 | [@@@warning "-32"] 8 | 9 | module Frog = struct 10 | type t = 11 | { position : Position.t 12 | } [@@deriving fields] 13 | 14 | let create = Fields.create 15 | end 16 | 17 | module World = struct 18 | type t = 19 | { frog : Frog.t 20 | } [@@deriving fields] 21 | 22 | let create = Fields.create 23 | end 24 | 25 | let create_frog () = 26 | failwith 27 | "Figure out how to initialize the [Frog.t] at the beginning of the game. \ 28 | Call [Frog.create] with some arguments." 29 | ;; 30 | 31 | let create () = 32 | failwith 33 | "Call [World.create] and [create_frog] to construct the initial state \ 34 | of the game. Try using [Random.int] -- variety is the spice of life!" 35 | ;; 36 | 37 | let tick (_ : World.t) = 38 | failwith 39 | "This function will end up getting called every timestep, which happens to \ 40 | be set to 1 second for this game in the scaffold (so you can easily see \ 41 | what's going on). For the first step (just moving the frog/camel around), \ 42 | you can just return [world] here. Later you'll want do interesting things \ 43 | like move all the cars and logs, detect collisions and figure out if the \ 44 | player has died or won. " 45 | ;; 46 | 47 | let handle_input (_ : World.t) (_ : Key.t) = 48 | failwith 49 | "This function will end up getting called whenever the player presses one of \ 50 | the four arrow keys. What should the new state of the world be? Create and \ 51 | return it based on the current state of the world (the [world] argument), \ 52 | and the key that was pressed ([key]). Use either [World.create] or the \ 53 | record update syntax: 54 | { world with frog = Frog.create ... } 55 | " 56 | ;; 57 | 58 | let draw (_ : World.t) = 59 | failwith 60 | "Return a list with a single item: a tuple consisting of one of the choices \ 61 | in [Images.t] in [scaffold.mli]; and the current position of the [Frog]." 62 | ;; 63 | 64 | let handle_event (_ : World.t) (_ : Event.t) = 65 | failwith 66 | "This function should probably be just 3 lines long: [match event with ...]" 67 | ;; 68 | 69 | let finished (_ : World.t) = 70 | failwith 71 | "This can probably just return [false] in the beginning." 72 | ;; 73 | -------------------------------------------------------------------------------- /03-frogger/frogger.mli: -------------------------------------------------------------------------------- 1 | open Scaffold 2 | 3 | module World : sig 4 | type t 5 | end 6 | 7 | val create : unit -> World.t 8 | val tick : World.t -> World.t 9 | val handle_input : World.t -> Key.t -> World.t 10 | val handle_event : World.t -> Event.t -> World.t 11 | val draw : World.t -> Display_list.t 12 | val finished : World.t -> bool 13 | -------------------------------------------------------------------------------- /03-frogger/import.ml: -------------------------------------------------------------------------------- 1 | open Js_of_ocaml 2 | 3 | module Html = Dom_html 4 | let document = Html.window##.document 5 | 6 | let jsopt_value_exn x = Js.Opt.get x (fun () -> assert false) 7 | let jsoptdef_value_exn x = Js.Optdef.get x (fun () -> assert false) 8 | -------------------------------------------------------------------------------- /03-frogger/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | Frogger 7 | 8 | 9 | 12 | 13 | 14 |
15 | 16 | -------------------------------------------------------------------------------- /03-frogger/scaffold.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Position = struct 4 | type t = 5 | { x : int 6 | ; y : int 7 | } [@@deriving fields, sexp] 8 | 9 | let create = Fields.create 10 | end 11 | 12 | module Image = struct 13 | type t = 14 | | Frog_up 15 | | Frog_down 16 | | Frog_left 17 | | Frog_right 18 | 19 | | Car1_left 20 | | Car1_right 21 | | Car2_left 22 | | Car2_right 23 | | Car3_left 24 | | Car3_right 25 | 26 | | Log1 27 | | Log2 28 | | Log3 29 | 30 | | Confetti 31 | | Skull_and_crossbones 32 | [@@deriving sexp, variants] 33 | end 34 | 35 | module Display_list = struct 36 | module Display_command = struct 37 | type nonrec t = Image.t * Position.t [@@deriving sexp] 38 | end 39 | 40 | type t = Display_command.t list [@@deriving sexp] 41 | end 42 | 43 | module Key = struct 44 | type t = 45 | | Arrow_up 46 | | Arrow_down 47 | | Arrow_left 48 | | Arrow_right 49 | end 50 | 51 | module Event = struct 52 | type t = 53 | | Tick 54 | | Keypress of Key.t 55 | end 56 | 57 | module Board = struct 58 | (** Every row of the game board is one of these three kinds. *) 59 | module Row = struct 60 | type t = 61 | | Safe_strip 62 | | Road 63 | | River 64 | end 65 | 66 | let num_cols = 10 67 | 68 | (** The first and last rows are guaranteed to be [Safe_strip]s. *) 69 | let rows = 70 | let open Row in 71 | [ Safe_strip 72 | ; River 73 | ; River 74 | ; River 75 | ; River 76 | ; River 77 | ; Safe_strip 78 | ; Road 79 | ; Road 80 | ; Road 81 | ; Road 82 | ; Safe_strip 83 | ] 84 | |> List.rev 85 | ;; 86 | end 87 | 88 | let console_log s = 89 | Js_of_ocaml.Firebug.console##log s 90 | ;; 91 | -------------------------------------------------------------------------------- /03-frogger/scaffold.mli: -------------------------------------------------------------------------------- 1 | (** The grid system: 2 | 3 | 0. The positions of all objects are snapped onto a coarse grid. 4 | 1. The frog is 1x1 5 | 2. Every car is 1x1 6 | 3. Every log is 1x1 7 | *) 8 | 9 | (** The playable area of the screen will be referred to as the [board]. *) 10 | module Board : sig 11 | (** Every row of the game board is one of these three kinds. *) 12 | module Row : sig 13 | type t = 14 | | Safe_strip 15 | | Road 16 | | River 17 | end 18 | 19 | val num_cols : int 20 | 21 | (** The first and last rows are guaranteed to be [Safe_strip]s. *) 22 | val rows : Row.t list 23 | end 24 | 25 | (** This is a position in the grid system of the game, not in screen pixels. *) 26 | module Position : sig 27 | type t = 28 | { x : int 29 | ; y : int 30 | } 31 | [@@deriving fields, sexp] 32 | 33 | val create : x:int -> y:int -> t 34 | end 35 | 36 | (** All these images are 1x1. *) 37 | module Image : sig 38 | type t = 39 | | Frog_up 40 | | Frog_down 41 | | Frog_left 42 | | Frog_right 43 | | Car1_left 44 | | Car1_right 45 | | Car2_left 46 | | Car2_right 47 | | Car3_left 48 | | Car3_right 49 | | Log1 50 | | Log2 51 | | Log3 52 | | Confetti 53 | | Skull_and_crossbones 54 | [@@deriving sexp, variants] 55 | end 56 | 57 | module Display_list : sig 58 | (** The [Display_command] [(image, pos)] represents a command to draw [image] 59 | with its leftmost grid point at [pos]. 60 | *) 61 | module Display_command : sig 62 | type nonrec t = Image.t * Position.t [@@deriving sexp] 63 | end 64 | 65 | type t = Display_command.t list [@@deriving sexp] 66 | end 67 | 68 | module Key : sig 69 | type t = 70 | | Arrow_up 71 | | Arrow_down 72 | | Arrow_left 73 | | Arrow_right 74 | end 75 | 76 | module Event : sig 77 | type t = 78 | | Tick 79 | | Keypress of Key.t 80 | end 81 | 82 | val console_log : string -> unit 83 | -------------------------------------------------------------------------------- /03-frogger/suggested_frogger.mli: -------------------------------------------------------------------------------- 1 | open Scaffold 2 | 3 | module Direction : sig 4 | type t 5 | end 6 | 7 | module Frog : sig 8 | type t 9 | 10 | val facing : t -> Direction.t 11 | val position : t -> Position.t 12 | end 13 | 14 | module Non_frog_character : sig 15 | module Kind : sig 16 | type t = 17 | | Car 18 | | Log 19 | end 20 | 21 | type t 22 | 23 | val kind : t -> Kind.t 24 | val position : t -> Position.t 25 | 26 | (** In units of grid-points/tick. Positive values indicate rightward motion, 27 | negative values leftward motion. *) 28 | val horizontal_speed : t -> int 29 | end 30 | 31 | module Game_state : sig 32 | type t = 33 | | Playing 34 | | Won 35 | | Dead 36 | end 37 | 38 | module World : sig 39 | type t 40 | 41 | val frog : t -> Frog.t 42 | val nfcs : t -> Non_frog_character.t list 43 | val state : t -> Game_state.t 44 | end 45 | 46 | val create : unit -> World.t 47 | val tick : World.t -> World.t 48 | val handle_input : World.t -> Key.t -> World.t 49 | val handle_event : World.t -> Event.t -> World.t 50 | val draw : World.t -> Display_list.t 51 | val finished : World.t -> bool 52 | -------------------------------------------------------------------------------- /03-frogger/test-js-of-ocaml-install/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build @DEFAULT 3 | echo "\nThe outputs (including index.html) go in the _build directory that's \ 4 | a couple directories up. Read more about what determined that here:\n \ 5 | http://dune.readthedocs.io/en/latest/usage.html#finding-the-root\n" 6 | echo "\nPoint your browser to\n ${PWD}/../../_build/default/03-frogger/test-js-of-ocaml-install/index.html" 7 | -------------------------------------------------------------------------------- /03-frogger/test-js-of-ocaml-install/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (executables 4 | (modes byte exe) 5 | (names main) 6 | (preprocess 7 | (pps js_of_ocaml-ppx)) 8 | (libraries base js_of_ocaml)) 9 | 10 | (alias 11 | (name DEFAULT) 12 | (deps main.bc.js index.html)) 13 | -------------------------------------------------------------------------------- /03-frogger/test-js-of-ocaml-install/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | Frogger 7 | 8 | 9 | 17 | 18 | 19 |
20 | 21 | -------------------------------------------------------------------------------- /03-frogger/test-js-of-ocaml-install/main.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Js_of_ocaml 3 | (* ## - method will get called as soon I deref. 4 | `##.prop_name := ` to set a property 5 | ##.prop_name to read (no deref) 6 | 7 | put a table here ; bg here ; each cell has an id 8 | *) 9 | 10 | let get_foo_div () = 11 | Option.value_exn ( 12 | (Js.Opt.to_option (Dom_html.document##getElementById (Js.string "foo")))) 13 | ;; 14 | 15 | let () = 16 | Dom_html.window##.onload := (Dom.handler (fun _ -> 17 | let foo_div = get_foo_div () in 18 | foo_div##.textContent := Js.Opt.return (Js.string "Hello, world!"); 19 | Js._true 20 | )); 21 | Dom_html.window##.onkeydown := (Dom.handler (fun key_event -> 22 | let foo_div = get_foo_div () in 23 | let key = Option.value_exn (Js.Optdef.to_option (key_event##.key)) in 24 | let () = 25 | match Js.to_string key with 26 | | "ArrowUp" 27 | | "ArrowDown" 28 | | "ArrowLeft" 29 | | "ArrowRight" -> foo_div##.textContent := Js.Opt.return key 30 | | _ -> () 31 | in 32 | Js._true)); 33 | let ticktock = ref "tick" in 34 | let _ = 35 | Dom_html.window##setInterval (Js.wrap_callback (fun () -> 36 | let foo_div = get_foo_div () in 37 | foo_div##.textContent := Js.Opt.return (Js.string !ticktock); 38 | ticktock := ( 39 | match !ticktock with 40 | | "tick" -> "tock" 41 | | "tock" -> "tick" 42 | | _ -> "error" 43 | ) 44 | )) 45 | 1000.0 46 | in 47 | () 48 | ;; 49 | -------------------------------------------------------------------------------- /03-lumines/README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Lumines 2 | 3 | * Introduction 4 | Lumines is a block-dropping game similar to Tetris, where the player uses 2x2 5 | tetrominos containing tiles of two different colors to attempt to make 6 | completely filled rectangular shapes of the same color on the playing field, 7 | with larger shapes earning more points. 8 | 9 | Like Tetris, Lumines proceeds via clock events called "ticks". At every tick, 10 | the currently active block moves down one row, if it can. If it can't move 11 | down, it becomes affixed to the board, and a new piece is generated at the top 12 | of the board. The game ends when the game board is in an invalid state after a 13 | tick. 14 | 15 | Users can interact with the game by shifting, rotating, or dropping the block. 16 | The controls are: 17 | - [w] -> rotate left (counterclockwise) 18 | - [s] -> rotate right (clockwise) 19 | - [a] -> shift left 20 | - [d] -> shift right 21 | - [space] -> drop to bottom 22 | 23 | For this exercise, we have implemented an event-loop that drives the game and 24 | handles keyboard input, a graphic module that deals with rendering the game 25 | onto the screen, and the logic for handling the "sweeper" for the game. 26 | 27 | You will have to implement the logic that keeps the game state correct and 28 | updates things based on those inputs! 29 | 30 | Feel free to play around with the working solutions demo before getting 31 | started. It will be helpful to understand the game's mechanisms when working 32 | on these exercises! 33 | 34 | * Code Overview 35 | We have implemented a simple event-loop that drives the game and handles 36 | graphic rendering as well as keyboard input in [[file:bin/lumines.ml][lumines.ml]]. Feel free to take a 37 | look to get a sense of how the game engine works under the hood. 38 | 39 | Here, we provide an overview of some important parts of the code. Even for the 40 | files that we don't cover here, it might be helpful to glance at its interface 41 | file to get a better sense of all of the pieces. 42 | 43 | ** ~Filled_square.t~ 44 | A [Filled_square.t] represents a square on the board that is currently 45 | occupied by a square. Make sure to read over [[file:lib/filled_square.mli][filled_square.mli]] and 46 | familiarize yourself with the different states of a [Filled_square.t] and 47 | what they represent. 48 | 49 | ** ~Sweeper.t~ 50 | A [Sweeper.t] contains the driving logic for clearing the board. It is 51 | already implemented, and will take care of calling the functions that will 52 | remove squares from the board. Go ahead and glance at [[file:lib/sweeper.mli][sweeper.mli]] to see its 53 | interface. 54 | 55 | ** ~Board.t~ 56 | A [Board.t] represents the grid of squares that constitutes the main plaing 57 | area, in which blocks can move around. It also contains the "landscape" of 58 | blocks that have fallen to the bottom and become affixed. 59 | 60 | A board is implemented as a 2-dimensional array containing [Filled_square.t 61 | option]s, which are [None] if the square is empty, and otherwise [Some 62 | filled_square]. 63 | 64 | Make sure to take a look at [[file:lib/board.mli][board.mli]] to understand its structure. 65 | 66 | ** ~Moving_piece.t~ 67 | A [Moving_piece.t] is a single tetromino (2x2 block) that is currently 68 | "active" (i.e. moving down) on the board. It will handle the logic for 69 | rotating the block. 70 | 71 | Make sure to take a look at [[file:lib/moving_piece.mli][moving_piece.mli]] to understand its structure. 72 | 73 | ** ~Game.t~ 74 | A [Game.t] represents the entire game state, including the current 75 | [moving_piece] and its position relative to the board, the [board], and some 76 | additional metadata. It handles the movement of the [moving_piece] relative 77 | to the board. It also holds a [Sweeper.t]. 78 | 79 | Make sure to take a look at [[file:lib/game.mli][game.mli]] to understand its structure. 80 | 81 | Please note! [Game.t] treats the origin of the [Board.t] as the lower left 82 | corner! 83 | 84 | * Getting Started 85 | The functions for you to implement are in 86 | - [[file:lib/moving_piece.ml][moving_piece.ml]] 87 | - [[file:lib/board.ml][board.ml]] 88 | - [[file:lib/game.ml][game.ml]] 89 | 90 | To compile the tests, run: 91 | #+BEGIN_SRC bash 92 | $ dune runtest 93 | #+END_SRC 94 | 95 | To run the game, run: 96 | #+BEGIN_SRC bash 97 | $ dune exec bin/lumines.exe 98 | #+END_SRC 99 | 100 | * Order of Implementation 101 | A suggested ordering for working through this (though feel free to do in a 102 | different order if you prefer) is: 103 | 104 | ** Phase 1: Piece rotation 105 | - [ ] [[file:lib/moving_piece.ml][moving_piece.ml]]: [rotate_left] 106 | - [ ] [[file:lib/moving_piece.ml][moving_piece.ml]]: [rotate_right] 107 | 108 | You can test the functions in phase 1 by running the game and rotating the piece 109 | even if you don't yet have a way to move the piece on the board. 110 | 111 | ** Phase 2: Game progression 112 | - [ ] [[file:lib/board.ml][board.ml]]: [add_piece_and_apply_gravity] 113 | - [ ] [[file:lib/game.ml][game.ml]]: [tick] 114 | 115 | Once you have these two functions, you'll be able run the game and see pieces fall 116 | down on the board. 117 | 118 | ** Phase 3: Piece movement 119 | - [ ] [[file:lib/game.ml][game.ml]]: [can_move] 120 | - [ ] [[file:lib/game.ml][game.ml]]: [move_left] 121 | - [ ] [[file:lib/game.ml][game.ml]]: [move_right] 122 | - [ ] [[file:lib/game.ml][game.ml]]: [drop] 123 | 124 | After completing phase 3, you can run the game and move pieces around. 125 | 126 | ** Phase 4: Clearing lines 127 | - [ ] [[file:lib/board.ml][board.ml]]: [mark_squares_that_are_sweepable] 128 | - [ ] [[file:lib/board.ml][board.ml]]: [remove_squares] 129 | 130 | You should now be able to play lumines! 131 | 132 | * Extensions 133 | Once your game is working, there are many fun extensions that you can try to implement! 134 | 135 | Some examples, for inspiration: 136 | - calculate and display a score 137 | - make the game speed up over time 138 | - change the color scheme after a certain number of blocks have been cleared 139 | - add blocks that have different abilities (e.g. one that clears adjacent blocks) 140 | -------------------------------------------------------------------------------- /03-lumines/bin/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (executables 4 | (modes byte exe) 5 | (names lumines) 6 | (libraries async graphics base lib)) 7 | -------------------------------------------------------------------------------- /03-lumines/bin/lumines.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open Lib 3 | 4 | (* This is the core logic that actually runs the game. We have implemented all 5 | of this for you, but feel free to read this as a reference. *) 6 | 7 | let every seconds ~f ~stop = 8 | let open Async in 9 | let open Core in 10 | let rec loop () = 11 | if !stop 12 | then return () 13 | else 14 | Clock.after (Time.Span.of_sec seconds) 15 | >>= fun () -> 16 | f (); 17 | loop () 18 | in 19 | don't_wait_for (loop ()) 20 | ;; 21 | 22 | (* run_sweeper sets up a loop that steps the sweeper forward 23 | and redraws the game *) 24 | let run_sweeper (game : Game.t) = 25 | every ~stop:game.game_over (Sweeper.seconds_per_step game.sweeper) ~f:(fun () -> 26 | Sweeper.step game.sweeper; 27 | Lumines_graphics.draw game) 28 | ;; 29 | 30 | let handle_keys (game : Game.t) = 31 | every ~stop:game.game_over 0.01 ~f:(fun () -> 32 | match Lumines_graphics.read_key () with 33 | | None -> () 34 | | Some key -> 35 | let update = 36 | match key with 37 | | 'a' -> 38 | Game.move_left game; 39 | true 40 | | 'd' -> 41 | Game.move_right game; 42 | true 43 | | 'w' -> 44 | Game.rotate_left game; 45 | true 46 | | 's' -> 47 | Game.rotate_right game; 48 | true 49 | | ' ' -> 50 | Game.drop game; 51 | true 52 | | _ -> false 53 | in 54 | if update && not !(game.game_over) then Lumines_graphics.draw game) 55 | ;; 56 | 57 | let handle_clock_tick (game : Game.t) = 58 | every ~stop:game.game_over 1. ~f:(fun () -> 59 | Game.tick game; 60 | Lumines_graphics.draw game) 61 | ;; 62 | 63 | (* this is the core loop that powers the game *) 64 | let run () = 65 | let game = Game.create ~height:14 ~width:16 ~seconds_per_sweep:3. in 66 | Lumines_graphics.init_exn game; 67 | handle_keys game; 68 | run_sweeper game; 69 | handle_clock_tick game 70 | ;; 71 | 72 | let () = 73 | run (); 74 | Core_kernel.never_returns (Async.Scheduler.go ()) 75 | ;; 76 | -------------------------------------------------------------------------------- /03-lumines/lib/board.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | { board : Filled_square.t option array array 5 | ; height : int 6 | ; width : int 7 | } 8 | 9 | let create ~height ~width = 10 | { board = Array.make_matrix ~dimx:width ~dimy:height None; height; width } 11 | ;; 12 | 13 | let get t { Point.col; row } = t.board.(col).(row) 14 | let set t { Point.col; row } value = t.board.(col).(row) <- value 15 | 16 | let mark_squares_that_are_sweepable t = 17 | (* TODO: at the end of this function, all filled_squares that are part of 18 | completed squares (i.e. four tiles in a square arrangement that are all of 19 | the same colors) should be in sweeper state [To_sweep], and all other 20 | squares should be [Unmarked]. 21 | 22 | Note that, for example, a 2x3 rectangle of all the same color should also 23 | be marked by these criteria. *) 24 | ignore t 25 | ;; 26 | 27 | let remove_squares t = 28 | (* TODO: remove any squares marked as [Swept] from the board. Gravity should 29 | be applied appropriately. This is the function that is called by the 30 | [Sweeper.t] to clear squares from the board. 31 | 32 | At the end of this function, we should call 33 | [mark_squares_that_are_sweepable] so that we ensure that we leave the board 34 | in a valid state. *) 35 | ignore (mark_squares_that_are_sweepable t) 36 | ;; 37 | 38 | let add_piece_and_apply_gravity t ~moving_piece ~col = 39 | (* TODO: insert (affix) the moving piece into the board, applying gravity 40 | appropriately. Make sure to leave the board in a valid state. *) 41 | ignore t; 42 | ignore moving_piece; 43 | ignore col; 44 | true 45 | ;; 46 | 47 | let is_empty t point = 48 | match get t point with 49 | | None -> true 50 | | Some _ -> false 51 | ;; 52 | 53 | (* Tests *) 54 | let is_filled_with_color t ~row ~col color = 55 | match get t { Point.row; col } with 56 | | None -> false 57 | | Some square -> Color.equal color square.color 58 | ;; 59 | 60 | let is_marked t ~row ~col = 61 | match get t { Point.row; col } with 62 | | None -> false 63 | | Some square -> 64 | Filled_square.Sweeper_state.equal 65 | square.Filled_square.sweeper_state 66 | Filled_square.Sweeper_state.To_sweep 67 | ;; 68 | 69 | let test_piece = 70 | { Moving_piece.top_left = Filled_square.create Color.Orange 71 | ; top_right = Filled_square.create Color.White 72 | ; bottom_left = Filled_square.create Color.White 73 | ; bottom_right = Filled_square.create Color.White 74 | } 75 | ;; 76 | 77 | let%test "Testing add_piece_and_apply_gravity add one..." = 78 | let t = create ~height:4 ~width:4 in 79 | add_piece_and_apply_gravity t ~moving_piece:test_piece ~col:0 80 | && is_filled_with_color t ~row:0 ~col:0 Color.White 81 | && is_filled_with_color t ~row:0 ~col:1 Color.White 82 | && is_filled_with_color t ~row:1 ~col:0 Color.Orange 83 | && is_filled_with_color t ~row:1 ~col:1 Color.White 84 | ;; 85 | 86 | let%test "Testing add_piece_and_apply_gravity add many..." = 87 | let t = create ~height:4 ~width:4 in 88 | add_piece_and_apply_gravity t ~moving_piece:test_piece ~col:0 89 | && add_piece_and_apply_gravity t ~moving_piece:test_piece ~col:0 90 | && not (add_piece_and_apply_gravity t ~moving_piece:test_piece ~col:0) 91 | ;; 92 | 93 | let test_removable_piece = 94 | { Moving_piece.top_left = Filled_square.create Color.White 95 | ; top_right = Filled_square.create Color.White 96 | ; bottom_left = Filled_square.create Color.White 97 | ; bottom_right = Filled_square.create Color.White 98 | } 99 | ;; 100 | 101 | let%test "Testing mark_squares_that_are_sweepable..." = 102 | let t = create ~height:4 ~width:4 in 103 | assert (add_piece_and_apply_gravity t ~moving_piece:test_removable_piece ~col:0); 104 | assert (add_piece_and_apply_gravity t ~moving_piece:test_piece ~col:0); 105 | mark_squares_that_are_sweepable t; 106 | is_marked t ~row:0 ~col:0 107 | && is_marked t ~row:0 ~col:1 108 | && is_marked t ~row:1 ~col:0 109 | && is_marked t ~row:1 ~col:1 110 | && is_marked t ~row:2 ~col:0 111 | && is_marked t ~row:2 ~col:1 112 | && (not (is_marked t ~row:3 ~col:0)) 113 | && not (is_marked t ~row:3 ~col:1) 114 | ;; 115 | 116 | let sweep_board t = 117 | Array.iter t.board ~f:(fun row -> 118 | Array.iter row ~f:(fun square -> 119 | Option.iter square ~f:(fun square -> ignore (Filled_square.sweep square)))) 120 | ;; 121 | 122 | let%test "Testing Remove_squares..." = 123 | let t = create ~height:4 ~width:4 in 124 | assert (add_piece_and_apply_gravity t ~moving_piece:test_removable_piece ~col:0); 125 | assert (add_piece_and_apply_gravity t ~moving_piece:test_piece ~col:0); 126 | mark_squares_that_are_sweepable t; 127 | sweep_board t; 128 | remove_squares t; 129 | is_filled_with_color t ~row:0 ~col:0 Color.Orange 130 | && is_filled_with_color t ~row:0 ~col:1 Color.White 131 | ;; 132 | -------------------------------------------------------------------------------- /03-lumines/lib/board.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* The board is a 2-dimensional array of [filled_square option]s. If the square 4 | is empty, we represent it with [None]. If it is filled, we represent it with 5 | [Some Filled_Square]. We have provided getter and setter functions to get 6 | and set values of the array *) 7 | type t = 8 | { board : Filled_square.t option array array 9 | ; height : int 10 | ; width : int 11 | } 12 | 13 | (* [create ~height ~width] creates a board of given height and width *) 14 | val create : height:int -> width:int -> t 15 | 16 | (* [get] returns the value of the board at a given row and col *) 17 | val get : t -> Point.t -> Filled_square.t option 18 | 19 | (* [set] sets the value of the board at a given row and col *) 20 | val set : t -> Point.t -> Filled_square.t option -> unit 21 | 22 | (* [remove_squares] will be called by the sweeper. It should delete any squares 23 | marked as [Swept] from the board and leave the board in a valid state *) 24 | val remove_squares : t -> unit 25 | 26 | (* [add_piece_and_apply_gravity] takes a piece and the column number of the left 27 | side of the piece and inserts it into the board. Returns: true if it was able 28 | to add the piece to the board false otherwise *) 29 | val add_piece_and_apply_gravity : t -> moving_piece:Moving_piece.t -> col:int -> bool 30 | 31 | (* [is_empty] takes a row and a col and returns: true if that square is empty 32 | false if that square is filled *) 33 | val is_empty : t -> Point.t -> bool 34 | -------------------------------------------------------------------------------- /03-lumines/lib/color.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | | Orange 5 | | White 6 | 7 | let compare t1 t2 = 8 | match t1, t2 with 9 | | White, White | Orange, Orange -> 0 10 | | White, Orange -> 1 11 | | Orange, White -> -1 12 | ;; 13 | 14 | let random () = if Random.int 2 = 0 then Orange else White 15 | let equal t1 t2 = compare t1 t2 = 0 16 | -------------------------------------------------------------------------------- /03-lumines/lib/color.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* We have a simple color scheme with two colors: Orange and White. *) 4 | type t = 5 | | Orange 6 | | White 7 | 8 | (* [compare] compares two colors, returning 0 if they are the same. *) 9 | val compare : t -> t -> int 10 | 11 | (* [random] returns a random color. *) 12 | val random : unit -> t 13 | val equal : t -> t -> bool 14 | -------------------------------------------------------------------------------- /03-lumines/lib/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (library 4 | (name lib) 5 | (libraries async graphics base) 6 | (inline_tests) 7 | (preprocess 8 | (pps ppx_jane))) 9 | 10 | (env 11 | (dev 12 | (flags 13 | (:standard -w -20 -w -27 -w -32 -w -34 -w -37 -w -39))) 14 | (release 15 | (flags (:standard)))) 16 | -------------------------------------------------------------------------------- /03-lumines/lib/filled_square.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | module Sweeper_state = struct 4 | type t = 5 | | Unmarked 6 | | To_sweep 7 | | Swept 8 | 9 | let equal t1 t2 = 10 | match t1, t2 with 11 | | Unmarked, Unmarked | To_sweep, To_sweep | Swept, Swept -> true 12 | | _ -> false 13 | ;; 14 | end 15 | 16 | type t = 17 | { color : Color.t 18 | ; mutable sweeper_state : Sweeper_state.t 19 | } 20 | 21 | let create color = { color; sweeper_state = Unmarked } 22 | let unmark t = t.sweeper_state <- Unmarked 23 | let to_sweep t = t.sweeper_state <- To_sweep 24 | 25 | let sweep t = 26 | match t.sweeper_state with 27 | | To_sweep -> 28 | t.sweeper_state <- Swept; 29 | true 30 | | Unmarked | Swept -> false 31 | ;; 32 | 33 | let equal t1 t2 = 34 | Color.equal t1.color t2.color && Sweeper_state.equal t1.sweeper_state t2.sweeper_state 35 | ;; 36 | -------------------------------------------------------------------------------- /03-lumines/lib/filled_square.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* A filled in square on the board has two pieces of state. The color 4 | that it is right now, and the "state" that it's currently in. 5 | 6 | The state is one of: 7 | - [Unmarked] : this means that it is not part of any completed square 8 | - [To_sweep] : this means it is part of a completed square and the sweeper will delete 9 | it when it passes all connected [Filled_square]s marked as [To_sweep] 10 | - [Swept] : this means that the sweeper has passed this, square and it is 'deleted' 11 | it will be actually removed from the board when the sweeper reaches the end of the 12 | 13 | blocks to delete *) 14 | module Sweeper_state : sig 15 | type t = 16 | | Unmarked 17 | | To_sweep 18 | | Swept 19 | 20 | val equal : t -> t -> bool 21 | end 22 | 23 | type t = 24 | { color : Color.t 25 | (* recall from our earlier exercise, by marking this as mutable we can change it in 26 | place rather than making a new one every time the state updates *) 27 | ; mutable sweeper_state : Sweeper_state.t 28 | } 29 | 30 | (* [create] takes a color and returns a filled_square. All squares start off with 31 | a state of Unmarked *) 32 | val create : Color.t -> t 33 | 34 | (* [unmark] sets the state to Unmarked *) 35 | val unmark : t -> unit 36 | 37 | (* [to_sweep] sets the state to To_sweep *) 38 | val to_sweep : t -> unit 39 | 40 | (* [sweep] checks the current state of t. 41 | if it is [To_sweep], it marks it as [Swept] and returns true 42 | otherwise it doesn't change the state and returns false *) 43 | val sweep : t -> bool 44 | val equal : t -> t -> bool 45 | -------------------------------------------------------------------------------- /03-lumines/lib/game.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* This module holds the entire game state. *) 4 | type t = 5 | { board : Board.t 6 | ; height : int 7 | ; width : int 8 | ; mutable moving_piece : Moving_piece.t 9 | ; (* We represent the location of the moving piece by the bottom left corner 10 | of the piece. Note that the origin of [board] is the lower left 11 | corner. *) 12 | mutable moving_piece_col : int 13 | ; mutable moving_piece_row : int 14 | ; game_over : bool ref 15 | ; sweeper : Sweeper.t 16 | } 17 | 18 | val create : height:int -> width:int -> seconds_per_sweep:float -> t 19 | 20 | (* [new_moving_piece] puts a random new block at the top of the board *) 21 | val new_moving_piece : t -> unit 22 | 23 | (* Functions to move the piece on the board *) 24 | val move_left : t -> unit 25 | val move_right : t -> unit 26 | val rotate_left : t -> unit 27 | val rotate_right : t -> unit 28 | val drop : t -> unit 29 | 30 | (* [tick] handles everything that needs to happen when the clock ticks once *) 31 | val tick : t -> unit 32 | -------------------------------------------------------------------------------- /03-lumines/lib/import.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (* this is hard-coded so that we can refer to in in a few places in the code *) 4 | let pixels_per_square = 28 5 | -------------------------------------------------------------------------------- /03-lumines/lib/lumines_graphics.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open! Import 3 | 4 | let only_one : bool ref = ref false 5 | let part_size = { Point.col = pixels_per_square; row = pixels_per_square } 6 | let extra_part_size_above = 2 7 | 8 | let dimensions (game : Game.t) = 9 | { Point.col = game.width * part_size.col 10 | ; row = 11 | (game.height + extra_part_size_above) * part_size.row 12 | (* We want 2 extra moving_pieces on top *) 13 | } 14 | ;; 15 | 16 | let init_exn game = 17 | (* Should raise if called twice *) 18 | if !only_one then failwith "Can only call init_exn once" else only_one := true; 19 | let { Point.col; row } = dimensions game in 20 | Graphics.open_graph (Printf.sprintf " %dx%d" row col) 21 | ;; 22 | 23 | let filled_square_to_rgb (filled_square : Filled_square.t) = 24 | let open Graphics in 25 | match filled_square.color, filled_square.sweeper_state with 26 | | Color.White, Unmarked -> rgb 230 242 230 27 | | Orange, Unmarked -> rgb 251 110 22 28 | | Orange, To_sweep -> rgb 252 159 53 29 | | White, To_sweep -> rgb 206 204 202 30 | | _, Swept -> rgb 60 60 60 31 | ;; 32 | 33 | let draw_part filled_square ~from = 34 | (* Make things look pretty *) 35 | (match filled_square.Filled_square.sweeper_state with 36 | | To_sweep | Swept -> 37 | Point.For_drawing.fill_rect 38 | Graphics.(rgb 198 197 196) 39 | from 40 | (Point.add from part_size) 41 | | Unmarked -> ()); 42 | Point.For_drawing.fill_rect 43 | (filled_square_to_rgb filled_square) 44 | (Point.add from { Point.col = 2; row = 2 }) 45 | (Point.add (Point.add from part_size) { Point.col = -2; row = -2 }) 46 | ;; 47 | 48 | let draw_moving_piece 49 | ~(draw_bottom_left : Point.t) 50 | { Moving_piece.top_left; top_right; bottom_left; bottom_right } 51 | = 52 | draw_part bottom_left ~from:draw_bottom_left; 53 | draw_part 54 | bottom_right 55 | ~from:(Point.add draw_bottom_left { Point.col = part_size.col; row = 0 }); 56 | draw_part 57 | top_left 58 | ~from:(Point.add draw_bottom_left { Point.col = 0; row = part_size.row }); 59 | draw_part top_right ~from:(Point.add draw_bottom_left part_size) 60 | ;; 61 | 62 | let draw_bg ~from = 63 | Point.For_drawing.fill_rect 64 | Graphics.(rgb 33 32 31) 65 | (Point.add from { Point.col = 1; row = 1 }) 66 | (Point.add (Point.add from part_size) { Point.col = -1; row = -1 }) 67 | ;; 68 | 69 | let draw_sweeper (game : Game.t) = 70 | let height = game.height * pixels_per_square in 71 | let pos = Sweeper.cur_pos game.sweeper in 72 | Point.For_drawing.fill_rect 73 | Graphics.(rgb 0 229 255) 74 | { Point.col = pos; row = 0 } 75 | { Point.col = pos + 1; row = height } 76 | ;; 77 | 78 | let draw game = 79 | let open Graphics in 80 | (* We want double-buffering. See 81 | https://caml.inria.fr/pub/docs/manual-ocaml/libref/Graphics.html 82 | for more info! 83 | 84 | So, we set [display_mode] to false, draw to the background buffer, 85 | set [display_mode] to true and then synchronize. This guarantees 86 | that there won't be flickering! 87 | *) 88 | Graphics.display_mode false; 89 | set_color black; 90 | let dims = dimensions game in 91 | Point.For_drawing.fill_rect black Point.For_drawing.origin dims; 92 | List.iter (List.range 0 game.Game.width) ~f:(fun col -> 93 | List.iter (List.range 0 game.Game.height) ~f:(fun row -> 94 | draw_bg ~from:{ col = part_size.col * col; row = part_size.row * row })); 95 | draw_moving_piece 96 | ~draw_bottom_left: 97 | { Point.col = game.Game.moving_piece_col * part_size.col 98 | ; row = game.Game.moving_piece_row * part_size.row 99 | } 100 | game.Game.moving_piece; 101 | List.iter (List.range 0 game.Game.width) ~f:(fun col -> 102 | List.iter (List.range 0 game.Game.height) ~f:(fun row -> 103 | match Board.get game.Game.board { row; col } with 104 | | None -> () 105 | | Some color -> 106 | draw_part 107 | color 108 | ~from:{ col = part_size.col * col; row = part_size.row * row })); 109 | draw_sweeper game; 110 | Graphics.display_mode true; 111 | Graphics.synchronize () 112 | ;; 113 | 114 | let read_key () = if Graphics.key_pressed () then Some (Graphics.read_key ()) else None 115 | -------------------------------------------------------------------------------- /03-lumines/lib/lumines_graphics.mli: -------------------------------------------------------------------------------- 1 | (* This module handles the graphics for the game. We have implemented this 2 | for you so you don't need to change anything here, but feel free to look around 3 | and once you have the game working, feel free to alter this to make things fancier *) 4 | 5 | (* Fails if called twice *) 6 | val init_exn : Game.t -> unit 7 | 8 | (* redraw the board *) 9 | val draw : Game.t -> unit 10 | 11 | (* return for keyboard input if it's available *) 12 | val read_key : unit -> char option 13 | -------------------------------------------------------------------------------- /03-lumines/lib/moving_piece.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | { top_left : Filled_square.t 5 | ; top_right : Filled_square.t 6 | ; bottom_left : Filled_square.t 7 | ; bottom_right : Filled_square.t 8 | } 9 | 10 | let create () = 11 | { top_left = Filled_square.create (Color.random ()) 12 | ; top_right = Filled_square.create (Color.random ()) 13 | ; bottom_left = Filled_square.create (Color.random ()) 14 | ; bottom_right = Filled_square.create (Color.random ()) 15 | } 16 | ;; 17 | 18 | let rotate_left t = 19 | (* TODO : rotate the piece to the left (counterclockwise). *) 20 | ignore t; 21 | t 22 | ;; 23 | 24 | let rotate_right t = 25 | (* TODO : rotate the piece to the right (clockwise). *) 26 | ignore t; 27 | t 28 | ;; 29 | 30 | let coords ~bottom_left:{ Point.col; row } : Point.t list = 31 | [ { col; row } 32 | ; { col = col + 1; row } 33 | ; { col; row = row + 1 } 34 | ; { col = col + 1; row = row + 1 } 35 | ] 36 | ;; 37 | 38 | let equal t1 t2 = 39 | Filled_square.equal t1.top_left t2.top_left 40 | && Filled_square.equal t1.top_right t2.top_right 41 | && Filled_square.equal t1.bottom_left t2.bottom_left 42 | && Filled_square.equal t1.bottom_right t2.bottom_right 43 | ;; 44 | 45 | (* Tests *) 46 | let%test "Testing Rotate Right..." = 47 | let piece = 48 | { top_left = Filled_square.create Color.Orange 49 | ; top_right = Filled_square.create Color.White 50 | ; bottom_left = Filled_square.create Color.White 51 | ; bottom_right = Filled_square.create Color.White 52 | } 53 | in 54 | let rotated = 55 | { top_left = Filled_square.create Color.White 56 | ; top_right = Filled_square.create Color.Orange 57 | ; bottom_left = Filled_square.create Color.White 58 | ; bottom_right = Filled_square.create Color.White 59 | } 60 | in 61 | equal (rotate_right piece) rotated 62 | ;; 63 | 64 | let%test "Testing Rotate Left..." = 65 | let piece = 66 | { top_left = Filled_square.create Color.Orange 67 | ; top_right = Filled_square.create Color.White 68 | ; bottom_left = Filled_square.create Color.White 69 | ; bottom_right = Filled_square.create Color.White 70 | } 71 | in 72 | let rotated = 73 | { top_left = Filled_square.create Color.White 74 | ; top_right = Filled_square.create Color.White 75 | ; bottom_left = Filled_square.create Color.Orange 76 | ; bottom_right = Filled_square.create Color.White 77 | } 78 | in 79 | equal (rotate_left piece) rotated 80 | ;; 81 | -------------------------------------------------------------------------------- /03-lumines/lib/moving_piece.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* A moving piece is made up of 4 squares. *) 4 | type t = 5 | { top_left : Filled_square.t 6 | ; top_right : Filled_square.t 7 | ; bottom_left : Filled_square.t 8 | ; bottom_right : Filled_square.t 9 | } 10 | 11 | (* [create] creates a new random piece *) 12 | val create : unit -> t 13 | 14 | (* [rotate_left] returns a new moving piece where the colors have been rotated 15 | left (counterclockwise). *) 16 | val rotate_left : t -> t 17 | 18 | (* [rotate_right] returns a new moving piece where the colors have been rotated 19 | right (clockwise). *) 20 | val rotate_right : t -> t 21 | 22 | (* given the column and row of the bottom left block of the pice, [coords] 23 | return a list of the coordinates of all four blocks in the piece *) 24 | val coords : bottom_left:Point.t -> Point.t list 25 | -------------------------------------------------------------------------------- /03-lumines/lib/point.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | { col : int 5 | ; row : int 6 | } 7 | 8 | let add t1 t2 = { col = t1.col + t2.col; row = t1.row + t2.row } 9 | let compare_by_row { col = _; row = row1 } { col = _; row = row2 } = row1 - row2 10 | let compare_by_col { col = col1; row = _ } { col = col2; row = _ } = col1 - col2 11 | 12 | module For_drawing = struct 13 | let for_rect ~f color { col = from_col; row = from_row } { col = to_col; row = to_row } 14 | = 15 | Graphics.set_color color; 16 | f from_col from_row (to_col - from_col) (to_row - from_row) 17 | ;; 18 | 19 | let fill_rect = for_rect ~f:Graphics.fill_rect 20 | let draw_rect = for_rect ~f:Graphics.draw_rect 21 | let origin = { col = 0; row = 0 } 22 | end 23 | -------------------------------------------------------------------------------- /03-lumines/lib/point.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* It is useful to refer to points in our grid using this record. This allows us 4 | to avoid making mistakes about which coordinate is the row and which is the 5 | column 6 | 7 | We have provided a selection of useful functions, but feel free to add any 8 | others you find you want *) 9 | type t = 10 | { col : int 11 | ; row : int 12 | } 13 | 14 | (* [add] takes two t's and returns the t that is the sum of their rows and columns *) 15 | val add : t -> t -> t 16 | 17 | (* [compare_by_row] returns: 18 | - 0 if the rows are equal 19 | - a positive number if the first is greater than the second 20 | - a negative number if the first is less than the second *) 21 | val compare_by_row : t -> t -> int 22 | 23 | (* [compare_by_col] returns: 24 | - 0 if the cols are equal 25 | - a positive number if the first is greater than the second 26 | - a negative number if the first is less than the second *) 27 | val compare_by_col : t -> t -> int 28 | 29 | (* [For_drawing] is a module that is useful for the graphics rendering part of 30 | the library. Feel free to ignore all these functions *) 31 | module For_drawing : sig 32 | val fill_rect : Graphics.color -> t -> t -> unit 33 | val draw_rect : Graphics.color -> t -> t -> unit 34 | val origin : t 35 | end 36 | -------------------------------------------------------------------------------- /03-lumines/lib/sweeper.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | open! Import 3 | 4 | type t = 5 | { board : Board.t 6 | ; seconds_per_sweep : float 7 | ; mutable cur_pos : int 8 | } 9 | 10 | let create board ~seconds_per_sweep = { board; seconds_per_sweep; cur_pos = 0 } 11 | let cur_pos t = t.cur_pos 12 | 13 | let seconds_per_step t = 14 | let steps = (pixels_per_square * t.board.Board.width) - 1 in 15 | let seconds_per_step = t.seconds_per_sweep /. Float.of_int steps in 16 | seconds_per_step 17 | ;; 18 | 19 | let step t = 20 | let steps = (pixels_per_square * t.board.Board.width) - 1 in 21 | (* Clear squares *) 22 | if t.cur_pos % pixels_per_square = 0 23 | then ( 24 | let check_col = t.cur_pos / pixels_per_square in 25 | let more_marked = 26 | List.fold_left (List.range 0 t.board.height) ~init:false ~f:(fun acc row -> 27 | let color = Board.get t.board { Point.row; col = check_col } in 28 | match color with 29 | | None -> acc 30 | | Some filled_square -> Filled_square.sweep filled_square || acc) 31 | in 32 | if (not more_marked) || t.cur_pos = steps then Board.remove_squares t.board); 33 | (* advance sweeper *) 34 | if t.cur_pos < steps then t.cur_pos <- t.cur_pos + 1 else t.cur_pos <- 0 35 | ;; 36 | -------------------------------------------------------------------------------- /03-lumines/lib/sweeper.mli: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | (* We have implemented the sweeper for you. 4 | Feel free to look at this code for reference, but you shouldn't need to change 5 | anything within this module unless you are making a different variant of the game. *) 6 | type t 7 | 8 | val create : Board.t -> seconds_per_sweep:float -> t 9 | 10 | (* [cur_pos] returns the current position (column) of the sweeper. *) 11 | val cur_pos : t -> int 12 | 13 | (* [seconds_per_step] returns how quickly the step function should be called to 14 | make it sweep the board in the time given by seconds per sweep. *) 15 | val seconds_per_step : t -> float 16 | 17 | (* step advances the sweeper one square and potentially removes squares from the board *) 18 | val step : t -> unit 19 | -------------------------------------------------------------------------------- /03-snake/bin/dune: -------------------------------------------------------------------------------- 1 | ;; -*- scheme -*- 2 | 3 | (executables 4 | (names snake) 5 | (libraries 6 | async 7 | graphics 8 | base 9 | snake_lib)) 10 | -------------------------------------------------------------------------------- /03-snake/bin/snake.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | 4 | (* This is the core logic that actually runs the game. We have implemented all of this for 5 | you, but feel free to read this file as a reference. *) 6 | let every seconds ~f ~stop = 7 | let open Async in 8 | let open Core in 9 | let rec loop () = 10 | if !stop 11 | then return () 12 | else 13 | Clock.after (Time.Span.of_sec seconds) 14 | >>= fun () -> 15 | f (); 16 | loop () 17 | in 18 | don't_wait_for (loop ()) 19 | ;; 20 | 21 | let handle_keys (game : Game.t) ~game_over = 22 | every ~stop:game_over 0.01 ~f:(fun () -> 23 | match Snake_graphics.read_key () with 24 | | None -> () 25 | | Some key -> 26 | let set_direction dir = Game.set_direction game dir in 27 | (match key with 28 | | 'w' -> set_direction Up 29 | | 'a' -> set_direction Left 30 | | 's' -> set_direction Down 31 | | 'd' -> set_direction Right 32 | | _ -> ())) 33 | ;; 34 | 35 | let handle_steps (game : Game.t) ~game_over = 36 | every ~stop:game_over 0.1 ~f:(fun () -> 37 | Game.step game; 38 | Snake_graphics.render game; 39 | match Game.game_state game with 40 | | Game_over _ | Win -> game_over := true 41 | | In_progress -> ()) 42 | ;; 43 | 44 | let run () = 45 | let game = Snake_graphics.init_exn () in 46 | Snake_graphics.render game; 47 | let game_over = ref false in 48 | handle_keys game ~game_over; 49 | handle_steps game ~game_over 50 | ;; 51 | 52 | let () = 53 | run (); 54 | Core_kernel.never_returns (Async.Scheduler.go ()) 55 | ;; 56 | -------------------------------------------------------------------------------- /03-snake/bin/snake.mli: -------------------------------------------------------------------------------- 1 | (* Snake! *) 2 | -------------------------------------------------------------------------------- /03-snake/lib/apple.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = { location : Position.t } [@@deriving sexp_of] 4 | 5 | let location t = t.location 6 | 7 | (* TODO: Implement [create]. 8 | 9 | Make sure to inspect the mli to understand the signature of[create]. [create] 10 | will take in the height and width of the board area, as well as a list of 11 | locations where the apple cannot be generated, and create a [t] with a random 12 | location on the board. 13 | 14 | Hint: 15 | - You can generate a random int up to [bound] via [Random.int bound]. 16 | - You can pick a random element out of a list using [List.random_element_exn list]. 17 | *) 18 | let create ~height ~width ~invalid_locations = failwith "For you to implement" 19 | -------------------------------------------------------------------------------- /03-snake/lib/apple.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t [@@deriving sexp_of] 4 | 5 | (** [create] takes in the [height] and [width] of the area in which an apple can be 6 | generated, as well as a list of [Position.t]s representing the locations on the board 7 | that the apple cannot be placed, and creates an [Apple.t]. 8 | 9 | [create] returns [None] if there are no valid positions for the apple. *) 10 | val create : height:int -> width:int -> invalid_locations:Position.t list -> t option 11 | 12 | (** [location] returns the location of the apple on the board. *) 13 | val location : t -> Position.t 14 | -------------------------------------------------------------------------------- /03-snake/lib/direction.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | | Left 5 | | Up 6 | | Right 7 | | Down 8 | [@@deriving sexp_of] 9 | 10 | (* TODO: Implement [next_position]. 11 | 12 | Make sure to take a look at the signature of this function to understand what it does. 13 | Recall that the origin of the board is in the lower left hand corner. *) 14 | let next_position t position = position 15 | -------------------------------------------------------------------------------- /03-snake/lib/direction.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | | Left 5 | | Up 6 | | Right 7 | | Down 8 | [@@deriving sexp_of] 9 | 10 | (** [next_position] takes a direction and a starting position and returns the 11 | next position after taking one step in the specified direction. *) 12 | val next_position : t -> Position.t -> Position.t 13 | -------------------------------------------------------------------------------- /03-snake/lib/dune: -------------------------------------------------------------------------------- 1 | ;; -*- mode: scheme; -*- 2 | 3 | (library 4 | (name snake_lib) 5 | (libraries 6 | async 7 | graphics 8 | base 9 | ) 10 | (inline_tests) 11 | (preprocess (pps ppx_jane))) 12 | 13 | (env 14 | (dev 15 | (flags (:standard 16 | -w -20 17 | -w -27 18 | -w -32 19 | -w -34 20 | -w -37 21 | -w -39))) 22 | (release 23 | (flags (:standard)))) 24 | -------------------------------------------------------------------------------- /03-snake/lib/game.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | { mutable snake : Snake.t 5 | ; mutable apple : Apple.t 6 | ; mutable game_state : Game_state.t 7 | ; height : int 8 | ; width : int 9 | ; amount_to_grow : int 10 | } 11 | [@@deriving sexp_of] 12 | 13 | (* TODO: Implement [in_bounds]. *) 14 | let in_bounds t position = failwith "For you to implement" 15 | 16 | (* TODO: Implement [create]. 17 | 18 | Make sure that the game returned by [create] is in a valid state. In particular, we 19 | should fail with the message "unable to create initial apple" if [Apple.create] is 20 | unsuccessful, and "unable to create initial snake" if the initial snake is invalid 21 | (i.e. goes off the board). *) 22 | let create ~height ~width ~initial_snake_length ~amount_to_grow = 23 | failwith "For you to implement" 24 | ;; 25 | 26 | let snake t = t.snake 27 | let apple t = t.apple 28 | let game_state t = t.game_state 29 | 30 | (* TODO: Implement [set_direction]. *) 31 | let set_direction t direction = () 32 | 33 | (* TODO: Implement [step]. 34 | 35 | [step] should: 36 | - move the snake forward one square 37 | - check for collisions (end the game with "Wall collision" or "Self collision") 38 | - if necessary: 39 | -- consume apple 40 | -- if apple cannot be regenerated, win game; otherwise, grow the snake *) 41 | let step t = () 42 | 43 | module For_testing = struct 44 | let create_apple_force_location_exn ~height ~width ~location = 45 | let invalid_locations = 46 | List.init height ~f:(fun row -> 47 | List.init width ~f:(fun col -> { Position.row; col })) 48 | |> List.concat 49 | |> List.filter ~f:(fun pos -> not ([%compare.equal: Position.t] location pos)) 50 | in 51 | match Apple.create ~height ~width ~invalid_locations with 52 | | None -> failwith "[Apple.create] returned [None] when [Some _] was expected!" 53 | | Some apple -> apple 54 | ;; 55 | 56 | let create_apple_and_update_game_exn t ~apple_location = 57 | let apple = 58 | create_apple_force_location_exn 59 | ~height:t.height 60 | ~width:t.width 61 | ~location:apple_location 62 | in 63 | t.apple <- apple 64 | ;; 65 | 66 | let create_game_with_apple_exn 67 | ~height 68 | ~width 69 | ~initial_snake_length 70 | ~amount_to_grow 71 | ~apple_location 72 | = 73 | let t = create ~height ~width ~initial_snake_length ~amount_to_grow in 74 | create_apple_and_update_game_exn t ~apple_location; 75 | t 76 | ;; 77 | end 78 | -------------------------------------------------------------------------------- /03-snake/lib/game.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (** A [t] represents the entire game state, including the current snake, apple, 4 | and game state. *) 5 | type t [@@deriving sexp_of] 6 | 7 | (** [create] creates a new game with specified parameters. *) 8 | val create 9 | : height:int 10 | -> width:int 11 | -> initial_snake_length:int 12 | (* [amount_to_grow] is the amount the snake's length should increase by 13 | each time it eats an apple. *) 14 | -> amount_to_grow:int 15 | -> t 16 | 17 | (** [snake] returns the snake that is currently in the game. *) 18 | val snake : t -> Snake.t 19 | 20 | (** [set_direction] updates the direction of the snake that is in the game. *) 21 | val set_direction : t -> Direction.t -> unit 22 | 23 | (** [apple] returns the apple that is currently in the game. *) 24 | val apple : t -> Apple.t 25 | 26 | (** [game_state] returns the state of the current game. *) 27 | val game_state : t -> Game_state.t 28 | 29 | (** [step] is called in a loop, and the game is re-rendered after each call. *) 30 | val step : t -> unit 31 | 32 | (** [in_bounds] returns [true] if the position references a valid square inside 33 | the game playing area. *) 34 | val in_bounds : t -> Position.t -> bool 35 | 36 | (** [For_testing] contains some utility functions to poke at the innards of a [Game.t] in 37 | a way to avoids non-determinism due to randomness. It should not be called in real 38 | code. *) 39 | module For_testing : sig 40 | (** [create_game_with_apple_exn] creates a [t] with an apple in a specific location. *) 41 | val create_game_with_apple_exn 42 | : height:int 43 | -> width:int 44 | -> initial_snake_length:int 45 | -> amount_to_grow:int 46 | -> apple_location:Position.t 47 | -> t 48 | 49 | (** [create_apple_and_update_game_exn] updates the apple of [t] to be in a specific 50 | location. *) 51 | val create_apple_and_update_game_exn : t -> apple_location:Position.t -> unit 52 | end 53 | -------------------------------------------------------------------------------- /03-snake/lib/game_state.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | | In_progress 5 | | Game_over of string 6 | | Win 7 | [@@deriving sexp_of] 8 | 9 | let to_string t = 10 | match t with 11 | | In_progress -> "" 12 | | Game_over x -> "Game over: " ^ x 13 | | Win -> "WIN!" 14 | ;; 15 | -------------------------------------------------------------------------------- /03-snake/lib/game_state.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (** A [t] represents the current state of the game. *) 4 | type t = 5 | | In_progress 6 | | Game_over of string (* The string is the reason the game ended. *) 7 | | Win 8 | [@@deriving sexp_of] 9 | 10 | (** [to_string] pretty-prints the current game state into a string. *) 11 | val to_string : t -> string 12 | -------------------------------------------------------------------------------- /03-snake/lib/position.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | { col : int 5 | ; row : int 6 | } 7 | [@@deriving compare, sexp] 8 | -------------------------------------------------------------------------------- /03-snake/lib/position.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (** A [t] represents a square on the playing area, identified by its row and 4 | column. *) 5 | type t = 6 | { col : int 7 | ; row : int 8 | } 9 | [@@deriving compare, sexp] 10 | -------------------------------------------------------------------------------- /03-snake/lib/snake.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | { (* [direction] represents the orientation of the snake's head. *) 5 | direction : Direction.t 6 | ; (* [extensions_remaining] represents how many more times we should extend the 7 | snake. *) 8 | extensions_remaining : int 9 | ; (* [locations] represents the current set of squares that the snake 10 | occupies. The first element of the list is the head of the snake. We hold 11 | as an invariant that [locations] is always non-empty. *) 12 | locations : Position.t list 13 | } 14 | [@@deriving sexp_of] 15 | 16 | (* TODO: Implement [create]. 17 | 18 | Note that at the beginning of the game, the snake will not need to grow at all, so 19 | [extensions_remaining] should be initialized to 0. *) 20 | let create ~length = failwith "For you to implement" 21 | 22 | (* TODO: Implement [grow_over_next_steps]. 23 | 24 | Read over the documentation of this function in the mli. 25 | 26 | Notice that this function should not actually grow the snake, but only record that we 27 | should grow the snake one block for the next [by_how_much] squares. *) 28 | let grow_over_next_steps t by_how_much = t 29 | 30 | (* TODO: Implement [locations]. *) 31 | let locations t = failwith "For you to implement" 32 | 33 | (* TODO: Implement [head_location]. *) 34 | let head_location t = { Position.row = 0; col = 0 } 35 | 36 | (* TODO: Implement [set_direction]. *) 37 | let set_direction t direction = t 38 | 39 | (* TODO: Implement [step]. 40 | 41 | Read over the documentation of this function in the mli. 42 | 43 | [step] should: 44 | - move the snake forward one block, growing it and updating [t.locations] if necessary 45 | - check for self collisions *) 46 | let step t = Some t 47 | -------------------------------------------------------------------------------- /03-snake/lib/snake.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (** A [t] represents a snake on the board. 4 | 5 | Note that this interface is immutable, meaning that when we want to change 6 | something about a [Snake.t], we will need to create a new [Snake.t]. This 7 | is why functions like [grow_over_next_steps] and [set_direction] return a 8 | [t] rather than a [unit]. *) 9 | type t [@@deriving sexp_of] 10 | 11 | (** [create] makes a new snake with the given length. The length must be 12 | positive. 13 | 14 | The snake will initially be occupy the (column, row) locations: 15 | (0,0), (1,0), (2,0), ..., (length - 1, 0) 16 | 17 | The head will be at position (length - 1, 0) and the initial direction 18 | should be towards the right. *) 19 | val create : length:int -> t 20 | 21 | (** [grow_over_next_steps t n] tells the snake to grow by [n] in length over 22 | the next [n] steps. *) 23 | val grow_over_next_steps : t -> int -> t 24 | 25 | (** [location] returns the current locations that the snake occupies. The first 26 | element of the list is the head of the snake. We hold as an invariant that 27 | [locations] is always non-empty. *) 28 | val locations : t -> Position.t list 29 | 30 | (** [head_location_exn] returns the location of the snake's head. *) 31 | val head_location : t -> Position.t 32 | 33 | (** [set_direction] tells the snake to move in a specific direction the next 34 | time [step] is called. *) 35 | val set_direction : t -> Direction.t -> t 36 | 37 | (** [step] moves the snake forward by 1. [step] returns [None] if the snake collided 38 | with itself. *) 39 | val step : t -> t option 40 | -------------------------------------------------------------------------------- /03-snake/lib/snake_graphics.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | module Colors = struct 4 | let black = Graphics.rgb 000 000 000 5 | let green = Graphics.rgb 000 255 000 6 | let head_color = Graphics.rgb 100 100 125 7 | let apple_color = Graphics.rgb 255 000 000 8 | let game_in_progress = Graphics.rgb 100 100 200 9 | let game_lost = Graphics.rgb 200 100 100 10 | let game_won = Graphics.rgb 100 200 100 11 | end 12 | 13 | module Constants = struct 14 | let play_area_height = 400 15 | let header_height = 50 16 | let play_area_width = 450 17 | let block_size = 18 18 | end 19 | 20 | let only_one : bool ref = ref false 21 | 22 | let init_exn () = 23 | let open Constants in 24 | (* Should raise if called twice *) 25 | if !only_one then failwith "Can only call init_exn once" else only_one := true; 26 | Graphics.open_graph 27 | (Printf.sprintf " %dx%d" (play_area_height + header_height) play_area_width); 28 | let height = play_area_height / block_size in 29 | let width = play_area_width / block_size in 30 | Game.create ~height ~width ~initial_snake_length:3 ~amount_to_grow:3 31 | ;; 32 | 33 | let draw_block { Position.row; col } ~color = 34 | let open Constants in 35 | let col = col * block_size in 36 | let row = row * block_size in 37 | Graphics.set_color color; 38 | Graphics.fill_rect (col + 1) (row + 1) (block_size - 1) (block_size - 1) 39 | ;; 40 | 41 | let draw_header ~game_state = 42 | let open Constants in 43 | let header_color = 44 | match (game_state : Game_state.t) with 45 | | In_progress -> Colors.game_in_progress 46 | | Game_over _ -> Colors.game_lost 47 | | Win -> Colors.game_won 48 | in 49 | Graphics.set_color header_color; 50 | Graphics.fill_rect 0 play_area_height play_area_width header_height; 51 | let header_text = Game_state.to_string game_state in 52 | Graphics.set_color Colors.black; 53 | Graphics.set_text_size 20; 54 | Graphics.moveto 0 (play_area_height + 25); 55 | Graphics.draw_string (Printf.sprintf " %s" header_text) 56 | ;; 57 | 58 | let draw_play_area () = 59 | let open Constants in 60 | Graphics.set_color Colors.black; 61 | Graphics.fill_rect 0 0 play_area_width play_area_height 62 | ;; 63 | 64 | let draw_apple apple = 65 | let apple_location = Apple.location apple in 66 | draw_block apple_location ~color:Colors.apple_color 67 | ;; 68 | 69 | let draw_snake snake_locations = 70 | List.iter snake_locations ~f:(draw_block ~color:Colors.green); 71 | (* Snake head is a different color *) 72 | draw_block ~color:Colors.head_color (List.hd_exn snake_locations) 73 | ;; 74 | 75 | let render game = 76 | let snake = Game.snake game in 77 | let apple = Game.apple game in 78 | let game_state = Game.game_state game in 79 | let snake_locations = Snake.locations snake in 80 | draw_header ~game_state; 81 | draw_play_area (); 82 | draw_apple apple; 83 | draw_snake snake_locations; 84 | Graphics.display_mode true; 85 | Graphics.synchronize () 86 | ;; 87 | 88 | let read_key () = if Graphics.key_pressed () then Some (Graphics.read_key ()) else None 89 | -------------------------------------------------------------------------------- /03-snake/lib/snake_graphics.mli: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | (** This module handles the graphics for the game. We have implemented this for 4 | you so you don't need to change anything here, but feel free to look around 5 | and once you have the game, feel free to alter this file to make things 6 | fancier! *) 7 | 8 | (** [init_exn] fails if called twice. *) 9 | val init_exn : unit -> Game.t 10 | 11 | (** [render] renders the entire playing area along with snakes and apples. *) 12 | val render : Game.t -> unit 13 | 14 | (** [read_key] returns a keyboard input, if it's available. *) 15 | val read_key : unit -> char option 16 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/apple_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Apple 4 | 5 | let%expect_test "Testing [Apple.create]..." = 6 | let apple = create ~height:10 ~width:10 ~invalid_locations:[] in 7 | match apple with 8 | | None -> failwith "[create] returned [None] when [Some _] was expected!" 9 | | Some apple -> 10 | let { Position.row; col } = location apple in 11 | if row < 0 || row >= 10 || col < 0 || col >= 10 12 | then failwith "[create] returned an invalid apple!" 13 | else () 14 | ;; 15 | 16 | let%expect_test "Testing [Apple.create]..." = 17 | let invalid_locations = 18 | List.init 10 ~f:(fun row -> List.init 10 ~f:(fun col -> { Position.row; col })) 19 | |> List.concat 20 | in 21 | let apple = create ~height:10 ~width:10 ~invalid_locations in 22 | Stdio.printf !"%{sexp: t option}\n%!" apple; 23 | [%expect {| () |}] 24 | ;; 25 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/apple_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/dune: -------------------------------------------------------------------------------- 1 | ;; -*- mode: scheme; -*- 2 | 3 | (library 4 | (name snake_tests_1) 5 | (libraries 6 | async 7 | graphics 8 | base 9 | snake_lib 10 | ) 11 | (inline_tests) 12 | (preprocess (pps ppx_jane))) 13 | 14 | (env 15 | (dev 16 | (flags (:standard 17 | -w -20 18 | -w -27 19 | -w -32 20 | -w -34 21 | -w -37 22 | -w -39))) 23 | (release 24 | (flags (:standard)))) 25 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/game_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Game 4 | open For_testing 5 | 6 | type nonrec t = Game.t [@@deriving sexp_of] 7 | 8 | let%expect_test "Testing [Game.in_bounds]..." = 9 | let t = create ~height:10 ~width:10 ~initial_snake_length:3 ~amount_to_grow:3 in 10 | let test ~row ~col = 11 | Stdio.printf "(%d, %d) in bounds? %b\n%!" row col (in_bounds t { Position.row; col }) 12 | in 13 | test ~row:5 ~col:5; 14 | [%expect {| (5, 5) in bounds? true |}]; 15 | test ~row:0 ~col:8; 16 | [%expect {| (0, 8) in bounds? true |}]; 17 | test ~row:(-5) ~col:3; 18 | [%expect {| (-5, 3) in bounds? false |}]; 19 | test ~row:7 ~col:12; 20 | [%expect {| (7, 12) in bounds? false |}] 21 | ;; 22 | 23 | let%expect_test "Testing [Game.create]..." = 24 | let t = 25 | create_game_with_apple_exn 26 | ~height:10 27 | ~width:10 28 | ~initial_snake_length:3 29 | ~amount_to_grow:3 30 | ~apple_location:{ Position.row = 8; col = 1 } 31 | in 32 | Stdio.printf !"%{sexp: t}\n%!" t; 33 | [%expect 34 | {| 35 | ((snake 36 | ((direction Right) (extensions_remaining 0) 37 | (locations (((col 2) (row 0)) ((col 1) (row 0)) ((col 0) (row 0)))))) 38 | (apple ((location ((col 1) (row 8))))) (game_state In_progress) (height 10) 39 | (width 10) (amount_to_grow 3)) |}] 40 | ;; 41 | 42 | let%expect_test "Testing [Game.create] failure..." = 43 | let t = 44 | Or_error.try_with (fun () -> 45 | create ~height:1 ~width:2 ~initial_snake_length:3 ~amount_to_grow:3) 46 | in 47 | Stdio.printf !"%{sexp: t Or_error.t}\n%!" t; 48 | [%expect {| (Error (Failure "unable to create initial apple")) |}] 49 | ;; 50 | 51 | let%expect_test "Testing [Game.create] failure..." = 52 | let t = 53 | Or_error.try_with (fun () -> 54 | create ~height:10 ~width:2 ~initial_snake_length:3 ~amount_to_grow:3) 55 | in 56 | Stdio.printf !"%{sexp: t Or_error.t}\n%!" t; 57 | [%expect {| (Error (Failure "unable to create initial snake")) |}] 58 | ;; 59 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/game_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/snake_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Snake 4 | 5 | let%expect_test "Testing [Snake.create]..." = 6 | let t = create ~length:5 in 7 | Stdio.printf !"%{sexp: t}\n%!" t; 8 | [%expect 9 | {| 10 | ((direction Right) (extensions_remaining 0) 11 | (locations 12 | (((col 4) (row 0)) ((col 3) (row 0)) ((col 2) (row 0)) ((col 1) (row 0)) 13 | ((col 0) (row 0))))) |}] 14 | ;; 15 | 16 | let%expect_test "Testing [Snake.locations]..." = 17 | let t = create ~length:5 in 18 | Stdio.printf !"%{sexp: Position.t list}\n%!" (locations t); 19 | [%expect 20 | {| 21 | (((col 4) (row 0)) ((col 3) (row 0)) ((col 2) (row 0)) ((col 1) (row 0)) 22 | ((col 0) (row 0))) |}] 23 | ;; 24 | -------------------------------------------------------------------------------- /03-snake/tests/phase1/snake_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/direction_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Direction 4 | 5 | let%expect_test "Testing [Direction.next_position]..." = 6 | let position = { Position.row = 5; col = 5 } in 7 | Stdio.printf !"%{sexp: Position.t}\n%!" (next_position Left position); 8 | [%expect {| ((col 4) (row 5)) |}]; 9 | Stdio.printf !"%{sexp: Position.t}\n%!" (next_position Right position); 10 | [%expect {| ((col 6) (row 5)) |}]; 11 | Stdio.printf !"%{sexp: Position.t}\n%!" (next_position Up position); 12 | [%expect {| ((col 5) (row 6)) |}]; 13 | Stdio.printf !"%{sexp: Position.t}\n%!" (next_position Down position); 14 | [%expect {| ((col 5) (row 4)) |}] 15 | ;; 16 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/direction_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/dune: -------------------------------------------------------------------------------- 1 | ;; -*- mode: scheme; -*- 2 | 3 | (library 4 | (name snake_tests_2) 5 | (libraries 6 | async 7 | graphics 8 | base 9 | snake_lib 10 | ) 11 | (inline_tests) 12 | (preprocess (pps ppx_jane))) 13 | 14 | (env 15 | (dev 16 | (flags (:standard 17 | -w -20 18 | -w -27 19 | -w -32 20 | -w -34 21 | -w -37 22 | -w -39))) 23 | (release 24 | (flags (:standard)))) 25 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/game_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Game 4 | open For_testing 5 | 6 | type nonrec t = Game.t [@@deriving sexp_of] 7 | 8 | let%expect_test "Testing [Game.set_direction]..." = 9 | let t = 10 | create_game_with_apple_exn 11 | ~height:10 12 | ~width:10 13 | ~initial_snake_length:3 14 | ~amount_to_grow:3 15 | ~apple_location:{ Position.row = 8; col = 1 } 16 | in 17 | set_direction t Direction.Down; 18 | Stdio.printf !"%{sexp: t}\n%!" t; 19 | [%expect 20 | {| 21 | ((snake 22 | ((direction Down) (extensions_remaining 0) 23 | (locations (((col 2) (row 0)) ((col 1) (row 0)) ((col 0) (row 0)))))) 24 | (apple ((location ((col 1) (row 8))))) (game_state In_progress) (height 10) 25 | (width 10) (amount_to_grow 3)) |}] 26 | ;; 27 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/game_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/snake_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Snake 4 | 5 | let%expect_test "Testing [Snake.grow_over_next_steps]..." = 6 | let t = grow_over_next_steps (create ~length:5) 5 in 7 | Stdio.printf !"%{sexp: t}\n%!" t; 8 | [%expect 9 | {| 10 | ((direction Right) (extensions_remaining 5) 11 | (locations 12 | (((col 4) (row 0)) ((col 3) (row 0)) ((col 2) (row 0)) ((col 1) (row 0)) 13 | ((col 0) (row 0))))) |}] 14 | ;; 15 | 16 | let%expect_test "Testing [Snake.head_location]..." = 17 | let t = create ~length:5 in 18 | Stdio.printf !"%{sexp: Position.t}\n%!" (head_location t); 19 | [%expect {| ((col 4) (row 0)) |}] 20 | ;; 21 | 22 | let%expect_test "Testing [Snake.set_direction]..." = 23 | let t = set_direction (create ~length:5) Direction.Up in 24 | Stdio.printf !"%{sexp: t}\n%!" t; 25 | [%expect 26 | {| 27 | ((direction Up) (extensions_remaining 0) 28 | (locations 29 | (((col 4) (row 0)) ((col 3) (row 0)) ((col 2) (row 0)) ((col 1) (row 0)) 30 | ((col 0) (row 0))))) |}] 31 | ;; 32 | -------------------------------------------------------------------------------- /03-snake/tests/phase2/snake_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase3/dune: -------------------------------------------------------------------------------- 1 | ;; -*- mode: scheme; -*- 2 | 3 | (library 4 | (name snake_tests_3) 5 | (libraries 6 | async 7 | graphics 8 | base 9 | snake_lib 10 | ) 11 | (inline_tests) 12 | (preprocess (pps ppx_jane))) 13 | 14 | (env 15 | (dev 16 | (flags (:standard 17 | -w -20 18 | -w -27 19 | -w -32 20 | -w -34 21 | -w -37 22 | -w -39))) 23 | (release 24 | (flags (:standard)))) 25 | -------------------------------------------------------------------------------- /03-snake/tests/phase3/game_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Game 4 | open For_testing 5 | 6 | type nonrec t = Game.t [@@deriving sexp_of] 7 | 8 | let step_n_times t n = List.iter (List.range 0 n) ~f:(fun _ -> step t) 9 | 10 | let%expect_test "Testing [Game.step] with wall collision..." = 11 | let t = 12 | create_game_with_apple_exn 13 | ~height:10 14 | ~width:10 15 | ~initial_snake_length:3 16 | ~amount_to_grow:3 17 | ~apple_location:{ Position.row = 8; col = 1 } 18 | in 19 | step_n_times t 7; 20 | Stdio.printf !"%{sexp: t}\n%!" t; 21 | [%expect 22 | {| 23 | ((snake 24 | ((direction Right) (extensions_remaining 0) 25 | (locations (((col 9) (row 0)) ((col 8) (row 0)) ((col 7) (row 0)))))) 26 | (apple ((location ((col 1) (row 8))))) (game_state In_progress) (height 10) 27 | (width 10) (amount_to_grow 3)) |}]; 28 | step_n_times t 1; 29 | Stdio.printf !"%{sexp: t}\n%!" t; 30 | [%expect 31 | {| 32 | ((snake 33 | ((direction Right) (extensions_remaining 0) 34 | (locations (((col 10) (row 0)) ((col 9) (row 0)) ((col 8) (row 0)))))) 35 | (apple ((location ((col 1) (row 8))))) 36 | (game_state (Game_over "Wall collision")) (height 10) (width 10) 37 | (amount_to_grow 3)) |}] 38 | ;; 39 | 40 | let%expect_test "Testing [Game.step] with apple consumption..." = 41 | let t = 42 | create_game_with_apple_exn 43 | ~height:10 44 | ~width:10 45 | ~initial_snake_length:3 46 | ~amount_to_grow:3 47 | ~apple_location:{ Position.row = 9; col = 5 } 48 | in 49 | step_n_times t 3; 50 | set_direction t Direction.Up; 51 | step_n_times t 9; 52 | create_apple_and_update_game_exn t ~apple_location:{ Position.row = 7; col = 6 }; 53 | Stdio.printf !"%{sexp: t}\n%!" t; 54 | [%expect 55 | {| 56 | ((snake 57 | ((direction Up) (extensions_remaining 3) 58 | (locations (((col 5) (row 9)) ((col 5) (row 8)) ((col 5) (row 7)))))) 59 | (apple ((location ((col 6) (row 7))))) (game_state In_progress) (height 10) 60 | (width 10) (amount_to_grow 3)) |}]; 61 | set_direction t Direction.Left; 62 | step_n_times t 3; 63 | Stdio.printf !"%{sexp: t}\n%!" t; 64 | [%expect 65 | {| 66 | ((snake 67 | ((direction Left) (extensions_remaining 0) 68 | (locations 69 | (((col 2) (row 9)) ((col 3) (row 9)) ((col 4) (row 9)) ((col 5) (row 9)) 70 | ((col 5) (row 8)) ((col 5) (row 7)))))) 71 | (apple ((location ((col 6) (row 7))))) (game_state In_progress) (height 10) 72 | (width 10) (amount_to_grow 3)) |}] 73 | ;; 74 | 75 | let%expect_test "Testing [Game.step] with self collision..." = 76 | let t = 77 | create_game_with_apple_exn 78 | ~height:10 79 | ~width:10 80 | ~initial_snake_length:3 81 | ~amount_to_grow:3 82 | ~apple_location:{ Position.row = 9; col = 5 } 83 | in 84 | step_n_times t 3; 85 | set_direction t Direction.Up; 86 | step_n_times t 9; 87 | create_apple_and_update_game_exn t ~apple_location:{ Position.row = 7; col = 6 }; 88 | set_direction t Direction.Left; 89 | step_n_times t 1; 90 | set_direction t Direction.Down; 91 | step_n_times t 1; 92 | Stdio.printf !"%{sexp: t}\n%!" t; 93 | [%expect 94 | {| 95 | ((snake 96 | ((direction Down) (extensions_remaining 1) 97 | (locations 98 | (((col 4) (row 8)) ((col 4) (row 9)) ((col 5) (row 9)) ((col 5) (row 8)) 99 | ((col 5) (row 7)))))) 100 | (apple ((location ((col 6) (row 7))))) (game_state In_progress) (height 10) 101 | (width 10) (amount_to_grow 3)) |}]; 102 | set_direction t Direction.Right; 103 | step_n_times t 1; 104 | Stdio.printf !"%{sexp: t}\n%!" t; 105 | [%expect 106 | {| 107 | ((snake 108 | ((direction Right) (extensions_remaining 1) 109 | (locations 110 | (((col 4) (row 8)) ((col 4) (row 9)) ((col 5) (row 9)) ((col 5) (row 8)) 111 | ((col 5) (row 7)))))) 112 | (apple ((location ((col 6) (row 7))))) 113 | (game_state (Game_over "Self collision")) (height 10) (width 10) 114 | (amount_to_grow 3)) |}] 115 | ;; 116 | 117 | let%expect_test "Testing [Game.step] with game winning..." = 118 | let t = 119 | create_game_with_apple_exn 120 | ~height:2 121 | ~width:3 122 | ~initial_snake_length:3 123 | ~amount_to_grow:3 124 | ~apple_location:{ Position.row = 1; col = 2 } 125 | in 126 | set_direction t Direction.Up; 127 | step_n_times t 1; 128 | set_direction t Direction.Left; 129 | step_n_times t 2; 130 | create_apple_and_update_game_exn t ~apple_location:{ Position.row = 0; col = 0 }; 131 | Stdio.printf !"%{sexp: t}\n%!" t; 132 | [%expect 133 | {| 134 | ((snake 135 | ((direction Left) (extensions_remaining 4) 136 | (locations 137 | (((col 0) (row 1)) ((col 1) (row 1)) ((col 2) (row 1)) ((col 2) (row 0)) 138 | ((col 1) (row 0)))))) 139 | (apple ((location ((col 0) (row 0))))) (game_state In_progress) (height 2) 140 | (width 3) (amount_to_grow 3)) |}]; 141 | set_direction t Direction.Down; 142 | step_n_times t 1; 143 | Stdio.printf !"%{sexp: t}\n%!" t; 144 | [%expect 145 | {| 146 | ((snake 147 | ((direction Down) (extensions_remaining 3) 148 | (locations 149 | (((col 0) (row 0)) ((col 0) (row 1)) ((col 1) (row 1)) ((col 2) (row 1)) 150 | ((col 2) (row 0)) ((col 1) (row 0)))))) 151 | (apple ((location ((col 0) (row 0))))) (game_state Win) (height 2) (width 3) 152 | (amount_to_grow 3)) |}] 153 | ;; 154 | -------------------------------------------------------------------------------- /03-snake/tests/phase3/game_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /03-snake/tests/phase3/snake_tests.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | open! Snake_lib 3 | open Snake 4 | 5 | let step_n_times t n = 6 | List.fold (List.range 0 n) ~init:(Some t) ~f:(fun t _ -> 7 | match t with 8 | | Some t -> step t 9 | | None -> failwith "can't call step when previous step returned [None]!") 10 | ;; 11 | 12 | let%expect_test "Testing [Snake.step]..." = 13 | let t = create ~length:5 in 14 | let t = step_n_times t 5 in 15 | Stdio.printf !"%{sexp: t option}\n%!" t; 16 | [%expect 17 | {| 18 | (((direction Right) (extensions_remaining 0) 19 | (locations 20 | (((col 9) (row 0)) ((col 8) (row 0)) ((col 7) (row 0)) ((col 6) (row 0)) 21 | ((col 5) (row 0)))))) |}] 22 | ;; 23 | 24 | let%expect_test "Testing [Snake.step] with growth..." = 25 | let t = grow_over_next_steps (create ~length:5) 5 in 26 | let t = step_n_times t 5 in 27 | Stdio.printf !"%{sexp: t option}\n%!" t; 28 | [%expect 29 | {| 30 | (((direction Right) (extensions_remaining 0) 31 | (locations 32 | (((col 9) (row 0)) ((col 8) (row 0)) ((col 7) (row 0)) ((col 6) (row 0)) 33 | ((col 5) (row 0)) ((col 4) (row 0)) ((col 3) (row 0)) ((col 2) (row 0)) 34 | ((col 1) (row 0)) ((col 0) (row 0)))))) |}] 35 | ;; 36 | 37 | let%expect_test "Testing [Snake.step] with growth and turn..." = 38 | let t = 39 | create ~length:5 40 | |> fun t -> 41 | grow_over_next_steps t 5 42 | |> fun t -> set_direction t Direction.Up |> fun t -> step_n_times t 5 43 | in 44 | Stdio.printf !"%{sexp: t option}\n%!" t; 45 | [%expect 46 | {| 47 | (((direction Up) (extensions_remaining 0) 48 | (locations 49 | (((col 4) (row 5)) ((col 4) (row 4)) ((col 4) (row 3)) ((col 4) (row 2)) 50 | ((col 4) (row 1)) ((col 4) (row 0)) ((col 3) (row 0)) ((col 2) (row 0)) 51 | ((col 1) (row 0)) ((col 0) (row 0)))))) |}] 52 | ;; 53 | 54 | let%expect_test "Testing [Snake.step] with self collision..." = 55 | let set_direction_if_some t dir = 56 | match t with 57 | | None -> failwith "tried to set direction, but previous step resulted in [None]!" 58 | | Some t -> set_direction t dir 59 | in 60 | let t = 61 | create ~length:10 62 | |> fun t -> 63 | step_n_times t 1 64 | |> fun t -> 65 | set_direction_if_some t Direction.Up 66 | |> fun t -> 67 | step_n_times t 1 68 | |> fun t -> 69 | set_direction_if_some t Direction.Left 70 | |> fun t -> 71 | step_n_times t 1 72 | |> fun t -> set_direction_if_some t Direction.Right |> fun t -> step_n_times t 1 73 | in 74 | Stdio.printf !"%{sexp: t option}\n%!" t; 75 | [%expect {| () |}] 76 | ;; 77 | -------------------------------------------------------------------------------- /03-snake/tests/phase3/snake_tests.mli: -------------------------------------------------------------------------------- 1 | (* Intentionally left empty. *) 2 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build @DEFAULT 3 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Write A Fuzzy Finder 2 | Recently many of us at Jane Street have taken a liking to [[https://github.com/junegunn/fzf][fzf]]. This utility 3 | makes it quick and easy for users to make a selection in a terminal pipeline, or 4 | as part of a shell script. 5 | 6 | E.g. 7 | #+BEGIN_EXAMPLE 8 | echo -e "blue pill\nred pill" | fzf 9 | #+END_EXAMPLE 10 | 11 | will present the user in their terminal with the choice between a "red pill" and 12 | "blue pill". The user can type in characters to narrow the selection, and hit 13 | the Enter key, at which point the selection will be sent to fzf's stdout. 14 | 15 | This is actually very useful, e.g. 16 | #+BEGIN_EXAMPLE 17 | function qcd(){ pushd $(echo -e "${HOME}\n/usr/local/bin\n/usr/bin" | fzf); } 18 | #+END_EXAMPLE 19 | which allows one to type 'qcd' and then quickly choose a directory to navigate to in the shell. 20 | 21 | 22 | Your task, in this project is to create your own fuzzy finder. 23 | 24 | * Fuzzy Finder Inputs & Outputs 25 | Have you ever considered how ~less~ can read from standard in, but also read 26 | PgUp/PgDwn inputs? Have you ever done something like the below? 27 | 28 | #+BEGIN_EXAMPLE 29 | tail ${FILE} | vim - | sed 's/hello/goodbye/g' 30 | #+END_EXAMPLE 31 | 32 | In these cases, the terminal can still be controlled by the user, but 33 | stdin/stdout are being redirected by the shell to other programs; so it's not 34 | possible for the keyboard input and terminal output to go to stdin/stdout. 35 | 36 | Instead, in these cases, the device ~/dev/tty~ is used for reading and writing 37 | directly to the terminal. So, fuzzy finding utilities should have two sets of 38 | inputs, and two sets of outputs: 39 | 40 | - Inputs : stdin, read from ~/dev/tty~ 41 | - Outputs: stdout, write to ~/dev/tty~ 42 | 43 | We have created the following scaffolding for you to use in this task: 44 | 45 | - ~Tty_text~: a tiny, primitive library for managing drawing to the terminal 46 | and reading user input 47 | - ~Render~: a helper module to limit how often rendering will occur per second 48 | - ~Spinner~: Useful for displaying to the user if stdin still contains more 49 | data 50 | - ~Fuzzy~: Boilerplate, the place to start writing your finder. 51 | 52 | You should start by thinking about the below: 53 | 54 | *** When and what you actually need to render things to the screen 55 | If you do this too often, the user will experience flickering. What actually 56 | needs to be written out to the screen? 57 | *** How you are going to process inputs 58 | A piece of advice is to structure the code so there is a loop that processes 59 | all of the events, and dispatches changes based on them. E.g. the user 60 | pressed a key, a new line arrived on stdin, etc. 61 | *** How will line editing work? 62 | The user input is there for you to consume, but there's no actual line 63 | editor provided. 64 | *** How you are going to store the data, filtered items, and user input? 65 | There are no data structures defined, that's up to you. 66 | *** How will the user input match what comes from stdin? 67 | A simple check if the input string is present in any of the input is 68 | probably reasonable to start with 69 | 70 | 71 | Here are some example commands that you may find useful for testing your 72 | finder: 73 | 74 | #+BEGIN_EXAMPLE 75 | seq 0 10000 | ./_build/default/fuzzy.exe 76 | #+END_EXAMPLE 77 | 78 | #+BEGIN_EXAMPLE 79 | seq 0 7 100000 | ./_build/default/fuzzy.exe 80 | #+END_EXAMPLE 81 | 82 | ** Extensions 83 | Once your finder is working, here are some things to try to do to improve it: 84 | *** Add colors 85 | The [[https://en.wikipedia.org/wiki/ANSI_escape_code][Wikipedia]] article on ANSI escape codes explains how to color things. This 86 | would allow you to highlight the current selection, for example. 87 | *** Process arrow keys 88 | The Tty_text module only processes single character inputs. Some inputs, like 89 | the arrow keys are > 2 bytes in length. Modify the =Tty_text= to determine if the escape key was hit, or if 90 | an escaped keypress occurred. The command `showkey -a` will likely aid in this task. 91 | *** Add more diagnostic info 92 | Add output for 93 | - How many items the program knows about 94 | - How many items match the current search 95 | *** Fuzzier finding 96 | Depending how you did your match (looking for a match with 97 | ~String.Search_pattern.create~, perhaps?), try and come up with a better 98 | fuzziness metric. 99 | *** Output sorting 100 | Try to come up with a good way to sort the output. Is lexicographic string 101 | comparison enough? 102 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names fuzzy) 4 | (libraries core async) 5 | (preprocess 6 | (pps ppx_jane))) 7 | 8 | (alias 9 | (name DEFAULT) 10 | (deps fuzzy.exe)) 11 | 12 | (alias 13 | (name all) 14 | (deps 15 | (glob_files *.exe))) 16 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/fuzzy.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | 4 | type t = { 5 | (* TODO: Fill me in *) 6 | todo : unit 7 | } 8 | 9 | let _compilation_fix_you_probably_want_to_use_this_module = (module Spinner : Unit) 10 | 11 | let run user_input tty_text stdin = 12 | let t = { todo = () } in 13 | let () = t |> (ignore : t -> unit) in 14 | let () = tty_text |> (ignore : Tty_text.t -> unit) in 15 | let () = stdin |> (ignore : Reader.t -> unit) in 16 | let () = user_input |> (ignore : Tty_text.User_input.t Pipe.Reader.t -> unit) in 17 | Render.every 18 | ~how_often_to_render:(Time.Span.of_sec 0.1) 19 | ~render:(fun () -> 20 | (* TODO: Determine when rendering actually needs to occur, and call render. *) 21 | Deferred.unit 22 | ) 23 | (fun () -> 24 | (* TODO : Process events from new lines on [stdin], as well as [user_input]. *) 25 | return (`Finished None) 26 | ) 27 | ;; 28 | 29 | let () = 30 | Command.run @@ 31 | let open Command.Let_syntax in 32 | Command.async ~summary:"Custom fzf" [%map_open 33 | let () = return () in 34 | fun () -> 35 | let open Deferred.Let_syntax in 36 | (* TODO: Determine if [stdin] is a tty (see [Unix.isatty],) and if it is, 37 | do not process anything from it. If this guard is not in place, 38 | when no stdin is provided to fzf, alternating keypresses will seem to 39 | disappear. *) 40 | let stdin = force Reader.stdin in 41 | match%bind 42 | Tty_text.with_rendering (fun (input, tty_text) -> 43 | run input tty_text stdin 44 | ) 45 | with 46 | | None -> Deferred.unit 47 | | Some output -> 48 | let stdout = force Writer.stdout in 49 | Writer.write_line stdout output; 50 | Writer.flushed stdout 51 | ] 52 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/render.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | 4 | let every ~how_often_to_render ~render f = 5 | let init = Deferred.unit in 6 | let next_render_time () = Clock.after how_often_to_render in 7 | Deferred.repeat_until_finished (init, f ()) (fun (next_render, f_call) -> 8 | match%bind 9 | Deferred.choose 10 | [ choice next_render (fun () -> `Render) 11 | ; choice f_call (fun x -> `F_call x) 12 | ] 13 | with 14 | | `Render -> 15 | let%map () = render () in 16 | `Repeat (next_render_time (), f_call) 17 | | `F_call (`Finished _ as x) -> return x 18 | | `F_call (`Repeat ()) -> 19 | let next_f = f () in 20 | return (`Repeat (next_render, next_f)) 21 | ) 22 | ;; 23 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/render.mli: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | 4 | (** Not every application solely relies on user input in order to 5 | change it's state (e.g. network connections, stdin.) 6 | 7 | [every how_often_to_call_render render f] is a simple 8 | helper function that allows users to call [render] at most 9 | [how_often_to_call_render] per second. 10 | 11 | This is a simple helper function so that users may limit 12 | how often screen rendering is performed, e.g. so that 13 | if stdin contains lots of input, rendering does not always 14 | occur on the event of a new line being read. 15 | *) 16 | val every 17 | : how_often_to_render:Time.Span.t 18 | -> render:(unit -> unit Deferred.t) 19 | -> (unit -> [ `Finished of 'a | `Repeat of unit ] Deferred.t) 20 | -> 'a Deferred.t 21 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/screen_dimensions.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | 4 | type t = 5 | { width : int 6 | ; height : int 7 | } 8 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/screen_dimensions.mli: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | 4 | type t = 5 | { width : int 6 | ; height : int 7 | } 8 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/spinner.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | 4 | module Spin_state = struct 5 | type t = 6 | | Vert_bar 7 | | Lower_left_to_top_right 8 | | Dash 9 | | Lower_right_to_top_left 10 | 11 | let advance = function 12 | | Vert_bar -> Lower_left_to_top_right 13 | | Lower_left_to_top_right -> Dash 14 | | Dash -> Lower_right_to_top_left 15 | | Lower_right_to_top_left -> Vert_bar 16 | 17 | let to_char = function 18 | | Vert_bar -> '|' 19 | | Lower_left_to_top_right -> '/' 20 | | Dash -> '-' 21 | | Lower_right_to_top_left -> '\\' 22 | end 23 | 24 | type t = Spin_state.t option ref 25 | 26 | let finish t = 27 | t := None 28 | ;; 29 | 30 | let to_char t = 31 | Option.map ~f:Spin_state.to_char !t 32 | ;; 33 | 34 | let advance t = 35 | t := Option.map ~f:Spin_state.advance !t 36 | ;; 37 | 38 | let create ~spin_every = 39 | let t = ref (Some (Spin_state.Vert_bar)) in 40 | Clock.every spin_every (fun () -> advance t); 41 | t 42 | ;; 43 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/spinner.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | type t 4 | 5 | val create : spin_every:Time.Span.t -> t 6 | val finish : t -> unit 7 | val to_char : t -> char option 8 | val advance : t -> unit 9 | -------------------------------------------------------------------------------- /04-bigger-projects/fuzzy-finder/bin/tty_text.mli: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | 4 | (** Represents interaction between a terminal and a user *) 5 | type t 6 | 7 | (** Widgets can be rendered to the screen. 8 | [horizontal_group] allows for horizontal grouping on a single line. 9 | [vertical_group] allows for there to be multiple lines printed. 10 | 11 | The types do not stop things like a [vertical_group] being placed 12 | inside of a [vertical_group], the library does not do anything 13 | clever to detect such situations. *) 14 | module Widget : sig 15 | type t 16 | 17 | val text : string -> t 18 | 19 | (** [horizontal_group ts] will perform a horizontal grouping without a line break 20 | (just a space) between each [t]. *) 21 | val horizontal_group : t list -> t 22 | 23 | (** [vertical_group ts] will insert line breaks between each [t] in [ts]. *) 24 | val vertical_group : t list -> t 25 | end 26 | 27 | module User_input : sig 28 | type t = 29 | | Ctrl_c 30 | | Escape 31 | | Backspace 32 | | Return (* Enter key *) 33 | | Char of char 34 | [@@deriving sexp_of] 35 | end 36 | 37 | (** [with_rendering f] will start rendering to the terminal, and 38 | will return a pipe for reading user input, as well as a [t]. 39 | When [f] becomes determined, the screen rendering will end. *) 40 | val with_rendering : (User_input.t Pipe.Reader.t * t -> 'a Deferred.t) -> 'a Deferred.t 41 | 42 | (** [screen_dimensions t] returns the terminal dimensions that were 43 | determined when [with_rendering] was invoked. *) 44 | val screen_dimensions : t -> Screen_dimensions.t 45 | 46 | (** [render t w] requests that the widget [w] be rendered upon the screen. 47 | There is no horizontal or vertical alignment performed; the screen 48 | is cleared, and then [w] is drawn. 49 | 50 | [render] will stop drawing immediately after the last horizontal element 51 | provided to it in [w], there is no guarantee that will be the last row 52 | in the terminal. 53 | 54 | Users are encouraged to pad their widgets with empty [text]s in order to 55 | pad height *) 56 | val render : t -> Widget.t -> unit Deferred.t 57 | -------------------------------------------------------------------------------- /04-bigger-projects/irc-bot/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build @DEFAULT 3 | 4 | test: 5 | dune runtest --dev 6 | -------------------------------------------------------------------------------- /04-bigger-projects/irc-bot/bin/bot.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | 4 | (** This is a simple client which takes a variety of command-line parameters for 5 | the purpose of connecting to a single channel on an IRC server, sending one 6 | message, and then disconnecting. No validation is done of the parameters. 7 | 8 | There are various TODO items below that are probably worth pursuing if you 9 | are going to reuse any of this code in your bot. *) 10 | let command () = 11 | let open Command.Let_syntax in 12 | Command.async 13 | ~summary:"Simple IRC bot which just sends a single message and disconnects" 14 | [%map_open 15 | let where_to_connect = 16 | let%map host_and_port = 17 | flag "server" (required host_and_port) 18 | ~doc:"HOST:PORT of IRC server" 19 | in 20 | Tcp.Where_to_connect.of_host_and_port host_and_port 21 | and nick = 22 | (* TODO: Check the RFC for valid characters and exit with an error if 23 | the NICK contains any of them. *) 24 | flag "nick" (required string) 25 | ~doc:"NICK nickname to use on the IRC server" 26 | and full_name = 27 | flag "full-name" (required string) 28 | ~doc:"NAME full name to register with the server" 29 | and channel = 30 | flag "channel" (required string) 31 | ~doc:"CHAN channel to send the message to, including the '#' if \ 32 | relevant" 33 | and message = 34 | anon ("MESSAGE" %: string) 35 | in 36 | fun () -> 37 | Tcp.with_connection where_to_connect 38 | (fun _socket reader writer -> 39 | (* TODO: Check that the total length of the message(s) being sent 40 | to the server never exceed the 512 character limit. *) 41 | let write_line line = 42 | (* Convenience wrapper to ensure we don't forget to end lines 43 | in \r\n. *) 44 | printf ">>> %s\n" line; 45 | Writer.write_line writer line ~line_ending:Writer.Line_ending.Dos 46 | in 47 | write_line (sprintf "NICK %s" nick); 48 | write_line (sprintf "USER %s * * :%s" nick full_name); 49 | write_line (sprintf "JOIN :%s" channel); 50 | write_line (sprintf "PRIVMSG %s :%s" channel message); 51 | write_line (sprintf "QUIT"); 52 | Writer.flushed writer 53 | >>= fun () -> 54 | (* TODO: In practice, you'll want to check that the replies you 55 | receive in response to sending each of the messages below 56 | indicate success before continuing on to additional 57 | commands.*) 58 | Pipe.iter 59 | (Reader.lines reader) 60 | ~f:(fun reply -> 61 | printf "<<< %s\n" reply; 62 | Deferred.unit); 63 | ) 64 | ] 65 | ;; 66 | 67 | let () = Command.run (command ()) 68 | -------------------------------------------------------------------------------- /04-bigger-projects/irc-bot/bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names bot) 4 | (libraries core async) 5 | (preprocess 6 | (pps ppx_jane))) 7 | 8 | (alias 9 | (name DEFAULT) 10 | (deps bot.exe)) 11 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build @DEFAULT 3 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Jane Street OCaml Workshop 2 | 3 | This repo contains exercises and build instructions to help you get started 4 | developing in OCaml. 5 | 6 | * Installing build tools and libraries 7 | See [[https://github.com/janestreet/install-ocaml/blob/master/README.org][README.org in install-ocaml]] for instructions. 8 | * Exercises 9 | The [[file:02-exercises][exercises]] directory contains a number of exercises to get you started with 10 | OCaml. Each one has some expect-tests embedded in it. The workflow is: 11 | 12 | #+BEGIN_SRC bash 13 | cd 02-exercises/$problem_dir 14 | 15 | dune runtest # builds and runs inline tests 16 | # Look at test output and compiler errors, edit problem.ml, rerun: 17 | dune runtest 18 | #+END_SRC 19 | * Snake, Lumines, and Frogger 20 | Once you're done with the exercises, you can also implement simplified clones 21 | of the following arcade games: 22 | 23 | - [[file:03-snake/README.org][snake]] (runs on your computer) 24 | - [[file:03-lumines/README.org][lumines]] (runs on your computer) 25 | - [[file:03-frogger/README.org][frogger]] (runs in a web browser) 26 | 27 | * ~Async~ 28 | The OCaml standard library has various low-level calls for working with 29 | sockets in the ~Unix~ module and Jane Street's ~Core~ library wraps all of 30 | those. But, if you want your program to be able to wait for multiple events at the 31 | same time, you likely want to be able to program /concurrently/. 32 | 33 | One library for writing code in this style is [[https://opensource.janestreet.com/async/][Async]]. [[https://ocaml.janestreet.com/ocaml-core/latest/doc/async/index.html][Async]] provides ~Reader~ 34 | and ~Writer~ abstractions for I/O which, paired with the [[https://ocaml.janestreet.com/ocaml-core/latest/doc/async_extra/Async_extra/Tcp/][Tcp]] module should 35 | have most of what you need for either of the projects below. 36 | 37 | Before proceeding, it would probably be a good idea to read [[https://dev.realworldocaml.org/18-concurrent-programming.html][Chapter 18]] of 38 | /Real World OCaml/. There is some example code in the next section which 39 | should set you on your way. 40 | * Bigger projects 41 | Once you've made it to this point, there are a few possible paths laid out for you: 42 | 43 | - You can work on writing a bot for a chat protocol called IRC. See the 44 | [[file:04-bigger-projects/irc-bot/README.org][irc-bot README]] to get started! 45 | - You can work on writing your very own version of [[https://github.com/junegunn/fzf][fzf]] in OCaml. See the 46 | [[file:04-bigger-projects/fuzzy-finder/README.org][fuzzy-finder README]] to get started! 47 | - Or, if you want, you can continue making improvements and extensions to your 48 | version of Frogger (see the [[file:03-frogger][frogger README]] for some ideas). 49 | 50 | * Documentation and resources 51 | ** OCaml 52 | - [[https://dev.realworldocaml.org/toc.html][Real World OCaml]] 53 | - [[http://caml.inria.fr/pub/docs/manual-ocaml/][OCaml manual]] 54 | ** Jane Street libraries and tools 55 | - [[https://opensource.janestreet.com/][An overview of Jane Street's open source things]] 56 | - [[https://ocaml.janestreet.com/ocaml-core/v0.10/doc/][Documentation for Core]] 57 | ** dune 58 | - [[https://www.youtube.com/watch?v=BNZhmMAJarw][Video tutorial]] 59 | - [[https://dune.readthedocs.io/en/latest/][Manual]] 60 | 61 | -------------------------------------------------------------------------------- /make_learn_ocaml_directory.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | mkdir ../learn-ocaml 4 | cp Makefile ../learn-ocaml/ 5 | 6 | dune clean 7 | cp -r 02-exercises/ ../learn-ocaml/01-exercises 8 | cp -r 03-lumines/ ../learn-ocaml/02-lumines 9 | 10 | dune build solutions/lumines/bin/lumines.exe 11 | cp _build/default/solutions/lumines/bin/lumines.exe ../learn-ocaml/lumines_demo.exe 12 | -------------------------------------------------------------------------------- /solutions/fuzzy-find/fuzzy.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | open Async 3 | 4 | type t = 5 | { mutable items : string list 6 | ; mutable filtered_items : string list 7 | ; mutable selected : string option 8 | ; spinner : Spinner.t 9 | ; mutable entered_text : string option 10 | } 11 | 12 | let create () = 13 | { items = [] 14 | ; filtered_items = [] 15 | ; selected = None 16 | ; spinner = Spinner.create ~spin_every:(sec 0.2) 17 | ; entered_text = None 18 | } 19 | ;; 20 | 21 | let filter_items_and_selection t entered_text = 22 | let { items; filtered_items = _; selected = _; spinner = _; entered_text = _} = t in 23 | t.entered_text <- entered_text; 24 | let filtered_items = 25 | match entered_text with 26 | | None -> items 27 | | Some text -> 28 | let pattern = String.Search_pattern.create text in 29 | items 30 | |> List.filter ~f:(fun item -> 31 | Option.is_some @@ String.Search_pattern.index ~in_:item pattern 32 | ) 33 | in 34 | let filtered_items, selected = 35 | match filtered_items with 36 | | selection :: filtered_items -> (filtered_items, Some selection) 37 | | [] -> ([], None) 38 | in 39 | t.filtered_items <- filtered_items; 40 | t.selected <- selected; 41 | ;; 42 | 43 | let widget t screen = 44 | let open Tty_text in 45 | let { items = _; filtered_items; selected; spinner; entered_text } = t in 46 | let prompt_size = 1 in 47 | let item_count = screen.Screen_dimensions.height - prompt_size in 48 | let everything_but_selection = 49 | List.take filtered_items item_count 50 | in 51 | let editor = 52 | Widget.text ("> " ^ (Option.value ~default:"" entered_text)) 53 | in 54 | let lines = 55 | List.map everything_but_selection ~f:(fun text -> 56 | Widget.text text 57 | ) 58 | in 59 | let selected = 60 | Option.map ~f:(Widget.text (*~background:Color.grey*)) selected 61 | in 62 | let spinner = 63 | Option.map 64 | (Spinner.to_char spinner) 65 | ~f:(fun c -> Widget.text (String.of_char_list [c])) 66 | in 67 | let prompt = 68 | [ spinner; Some editor] 69 | |> List.filter_opt 70 | |> Widget.horizontal_group 71 | in 72 | let padding = 73 | List.init (item_count - (List.length everything_but_selection)) 74 | ~f:(fun _ -> Widget.text "") 75 | in 76 | Widget.vertical_group 77 | (padding @ lines @ (List.filter_opt [selected]) @ [prompt]) 78 | ;; 79 | 80 | let handle_input t input = 81 | match input with 82 | | Tty_text.User_input.Backspace -> begin 83 | match t.entered_text with 84 | | None -> `Continue t 85 | | Some text -> 86 | let new_entered_text = 87 | if (Int.(=) (String.length text) 1) 88 | then None 89 | else (Some (String.sub text ~pos:0 ~len:(String.length text - 1))) 90 | in 91 | filter_items_and_selection t new_entered_text; 92 | `Continue t 93 | end 94 | | Ctrl_c -> `Finished None 95 | | Char x -> 96 | begin 97 | let text = 98 | match t.entered_text with 99 | | None -> String.of_char_list [x] 100 | | Some text -> String.(text ^ (of_char_list [x])) 101 | in 102 | filter_items_and_selection t (Some text); 103 | `Continue t 104 | end 105 | | Return -> (`Finished t.selected) 106 | | Escape -> (`Finished None) 107 | ;; 108 | 109 | let run user_input tty_text stdin = 110 | let stdin_reader = 111 | Pipe.map ~f:(fun x -> `Stdin x) (Reader.lines stdin) 112 | in 113 | let stdin_closed = 114 | Pipe.create_reader ~close_on_exception:true (fun w -> 115 | let%bind _ = Reader.close_finished stdin in 116 | Pipe.write w `Stdin_closed 117 | ) 118 | in 119 | let interleaved = 120 | Pipe.interleave 121 | [ stdin_reader 122 | ; Pipe.map user_input ~f:(fun x -> `Input x) 123 | ; stdin_closed 124 | ] 125 | in 126 | let t = create () in 127 | let last_rendered : (string option * (string list)) ref = ref (None, []) in 128 | Render.every 129 | ~how_often_to_render:(Time.Span.of_sec 10.) 130 | ~render:(fun () -> 131 | if ( 132 | [%compare.equal:string option * string list] 133 | !last_rendered (t.entered_text, t.filtered_items) 134 | ) 135 | then Deferred.unit 136 | else begin 137 | last_rendered := (t.entered_text, t.filtered_items); 138 | Tty_text.render tty_text (widget t (Tty_text.screen_dimensions tty_text)) 139 | end 140 | ) 141 | (fun () -> 142 | match%bind Pipe.read interleaved with 143 | | `Eof -> raise_s [%message "impossible?"] 144 | | `Ok `Stdin_closed -> 145 | Spinner.finish t.spinner; 146 | return (`Repeat ()); 147 | | `Ok `Stdin x -> 148 | t.items <- x :: t.items; 149 | filter_items_and_selection t t.entered_text; 150 | return (`Repeat ()); 151 | | `Ok `Input user_input -> 152 | match handle_input t user_input with 153 | | `Finished None -> 154 | return (`Finished None) 155 | | `Finished (Some x) -> 156 | return (`Finished (Some x)) 157 | | `Continue _ -> 158 | return (`Repeat ()) 159 | ) 160 | ;; 161 | 162 | let () = 163 | Command.run @@ 164 | let open Command.Let_syntax in 165 | Command.async ~summary:"Custom fzf" [%map_open 166 | let () = return () in 167 | fun () -> 168 | let open Deferred.Let_syntax in 169 | let stdin = force Reader.stdin in 170 | match%bind 171 | Tty_text.with_rendering (fun (input, tty_text) -> 172 | run input tty_text stdin 173 | ) 174 | with 175 | | None -> Deferred.unit 176 | | Some output -> 177 | let stdout = force Writer.stdout in 178 | Writer.write_line stdout output; 179 | Writer.flushed stdout 180 | ] 181 | -------------------------------------------------------------------------------- /solutions/irc-bot/bin/bot.ml: -------------------------------------------------------------------------------- 1 | open! Core 2 | open! Async 3 | open! Irc_protocol 4 | 5 | (** This is a simple bot which connects to a single channel on an IRC server, 6 | sends a greeting, and then watches for other nicks to join the channel. When 7 | someone joins, the bot sends a simple greeting. 8 | 9 | Not much effort has been made to validate the success of various commands. 10 | Similarly, no attention has been given to the idea of connecting to multiple 11 | channels. 12 | 13 | Most of the heavy lifting is done in the parser written using the Angstrom 14 | library in lib/parser.ml. *) 15 | module Config = struct 16 | type t = 17 | { nick : string 18 | ; full_name : string 19 | ; channel : string } 20 | ;; 21 | 22 | let param = 23 | let open Command.Let_syntax in 24 | [%map_open 25 | let nick = 26 | (* TODO: Check the RFC for valid characters and exit with an error if 27 | the NICK contains any of them. *) 28 | flag "nick" (required string) 29 | ~doc:"NICK nickname to use on the IRC server" 30 | and full_name = 31 | flag "full-name" (required string) 32 | ~doc:"NAME full name to register with the server" 33 | and channel = 34 | flag "channel" (required string) 35 | ~doc:"CHAN channel to send the message to, including the '#' if \ 36 | relevant" 37 | in 38 | { nick; full_name; channel } 39 | ] 40 | ;; 41 | end 42 | 43 | let write_message writer message = 44 | let s = Irc_message.to_string message in 45 | let truncated = String.prefix s 510 in 46 | printf ">>> %s\n" truncated; 47 | Writer.write_line writer truncated ~line_ending:Writer.Line_ending.Dos 48 | ;; 49 | 50 | let join_and_greet writer { Config. nick; full_name; channel } = 51 | let open Irc_message in 52 | let nick_ = create ~command:"NICK" ~params:[nick] () in 53 | let user = create ~command:"USER" ~params:[nick; "*"; "*"; full_name ] () in 54 | let join = create ~command:"JOIN" ~params:[channel] () in 55 | let privmsg = 56 | create 57 | ~command:"PRIVMSG" 58 | ~params:[channel; sprintf "Hi, I'm %s!" nick] 59 | () 60 | in 61 | write_message writer nick_; 62 | write_message writer user; 63 | write_message writer join; 64 | write_message writer privmsg; 65 | ;; 66 | 67 | let privmsg ~target message : Irc_message.t = 68 | { prefix = None; command = "PRIVMSG"; params = [ target; message ] } 69 | ;; 70 | 71 | let maybe_extract_nick_from_prefix : Irc_message.Prefix.t option -> string option = function 72 | | Some (Server _) | None -> None 73 | | Some (User { nickname; _ }) -> 74 | Some nickname 75 | ;; 76 | 77 | let handle_message writer (config : Config.t) (message : Irc_message.t) = 78 | printf "<<< %s\n" (Irc_message.to_string message); 79 | let () = 80 | match message.command with 81 | | "PING" -> 82 | write_message writer (Irc_message.create ~command:"PONG" ~params:[ config.nick ] ()) 83 | | "PRIVMSG" -> ( 84 | Option.iter 85 | (List.hd message.params) 86 | ~f:(fun nick -> 87 | if nick = config.nick 88 | then ( 89 | write_message writer 90 | (privmsg 91 | ~target:config.channel 92 | "Sorry, I'm shy: All I like to do is say hi.")))) 93 | | "JOIN" -> 94 | if message.params = [ config.channel ] 95 | then ( 96 | Option.iter (maybe_extract_nick_from_prefix message.prefix) 97 | ~f:(fun nick -> 98 | if (nick = config.nick) 99 | then () 100 | else ( 101 | write_message writer 102 | (privmsg ~target:config.channel (sprintf "Hi %s!" nick))))) 103 | | _ -> () 104 | in 105 | Writer.flushed writer 106 | ;; 107 | 108 | let command () = 109 | let open Command.Let_syntax in 110 | Command.async 111 | ~summary:"Simple IRC bot which connects to a channel, says hello, and then \ 112 | greets any new joiners." 113 | [%map_open 114 | let where_to_connect = 115 | let%map host_and_port = 116 | flag "server" (required host_and_port) 117 | ~doc:"HOST:PORT of IRC server" 118 | in 119 | Tcp.Where_to_connect.of_host_and_port host_and_port 120 | and config = Config.param 121 | in 122 | fun () -> 123 | Tcp.with_connection where_to_connect 124 | (fun _socket reader writer -> 125 | join_and_greet writer config; 126 | Writer.flushed writer 127 | >>= fun () -> 128 | let rec wait_for_message_and_reply () = 129 | Angstrom_async.parse_many Irc_message.parser_ (handle_message writer config) reader 130 | >>= function 131 | | Error error -> 132 | Log.Global.sexp ~level:`Error [%message 133 | "Failed to parse message, exiting" 134 | (error : string)]; 135 | Shutdown.exit 1 136 | | Ok () -> 137 | wait_for_message_and_reply () 138 | in 139 | wait_for_message_and_reply ()) 140 | ] 141 | ;; 142 | 143 | let () = Command.run (command ()) 144 | -------------------------------------------------------------------------------- /solutions/irc-bot/bin/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (modes byte exe) 3 | (names bot) 4 | (libraries core async irc_protocol) 5 | (preprocess 6 | (pps ppx_jane))) 7 | 8 | (alias 9 | (name DEFAULT) 10 | (deps bot.exe)) 11 | -------------------------------------------------------------------------------- /solutions/irc-bot/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name irc_protocol) 3 | (libraries async core angstrom angstrom-async) 4 | (inline_tests) 5 | (preprocess 6 | (pps ppx_jane))) 7 | -------------------------------------------------------------------------------- /solutions/irc-bot/lib/irc_protocol.ml: -------------------------------------------------------------------------------- 1 | module Irc_message = struct 2 | include Message 3 | let parser_ = Parser.message 4 | end 5 | -------------------------------------------------------------------------------- /solutions/irc-bot/lib/message.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | module Prefix = struct 4 | module Host = struct 5 | type t = 6 | | Hostname of string 7 | | Inet_addr of Unix.Inet_addr.Blocking_sexp.t 8 | [@@deriving variants, sexp] 9 | ;; 10 | 11 | let to_string = function 12 | | Hostname s -> s 13 | | Inet_addr addr -> Unix.Inet_addr.to_string addr 14 | ;; 15 | end 16 | 17 | module User = struct 18 | type t = 19 | { host : Host.t 20 | ; user : string option } 21 | [@@deriving sexp] 22 | ;; 23 | 24 | let to_string { host; user } = 25 | let user = 26 | match user with 27 | | Some u -> "!" ^ u 28 | | None -> "" 29 | in 30 | user ^ "@" ^ (Host.to_string host) 31 | ;; 32 | end 33 | 34 | type t = 35 | | Server of string 36 | | User of 37 | { nickname : string 38 | ; user : User.t option } 39 | [@@deriving sexp] 40 | ;; 41 | 42 | let to_string t = 43 | ":" ^ 44 | (match t with 45 | | Server s -> s 46 | | User { nickname; user = maybe_user } -> 47 | match maybe_user with 48 | | None -> nickname 49 | | Some user -> nickname ^ User.to_string user) 50 | ;; 51 | end 52 | 53 | module Command = struct 54 | type t = string [@@deriving sexp] 55 | 56 | (* TODO: Actually validate the commands here. *) 57 | let of_string s = s 58 | end 59 | 60 | module Params = struct 61 | type t = string list [@@deriving sexp] 62 | 63 | let to_string t = 64 | let rec loop acc rest = 65 | match rest with 66 | | [] -> acc 67 | | last :: [] -> acc ^ " :" ^ last 68 | | elem :: rest -> loop (acc ^ " " ^ elem) rest 69 | in 70 | loop "" t 71 | ;; 72 | end 73 | 74 | type t = 75 | { prefix : Prefix.t option 76 | ; command : Command.t 77 | ; params : Params.t 78 | } 79 | [@@deriving sexp, fields] 80 | ;; 81 | 82 | let create ?prefix ~command ~params () = 83 | Fields.create ~prefix ~command ~params 84 | ;; 85 | 86 | let to_string t = 87 | (match t.prefix with 88 | | Some prefix -> Prefix.to_string prefix ^ " " 89 | | None -> "") 90 | |> fun prefix -> 91 | prefix 92 | ^ t.command 93 | ^ (Params.to_string t.params) 94 | ;; 95 | -------------------------------------------------------------------------------- /solutions/irc-bot/lib/message.mli: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | module Prefix : sig 4 | module Host : sig 5 | type t = 6 | | Hostname of string 7 | | Inet_addr of Unix.Inet_addr.Blocking_sexp.t 8 | [@@deriving variants, sexp] 9 | ;; 10 | end 11 | 12 | module User : sig 13 | type t = 14 | { host : Host.t 15 | ; user : string option } 16 | [@@deriving sexp] 17 | ;; 18 | end 19 | 20 | type t = 21 | | Server of string 22 | | User of 23 | { nickname : string 24 | ; user : User.t option } 25 | [@@deriving sexp] 26 | ;; 27 | end 28 | module Command : sig 29 | type t = string 30 | [@@deriving sexp] 31 | 32 | val of_string : string -> t 33 | end 34 | 35 | module Params : sig 36 | type t = string list 37 | [@@deriving sexp] 38 | end 39 | 40 | type t = 41 | { prefix : Prefix.t option 42 | ; command : Command.t 43 | ; params : Params.t 44 | } 45 | [@@deriving sexp, fields] 46 | ;; 47 | 48 | val create 49 | : ?prefix:Prefix.t 50 | -> command:Command.t 51 | -> params:Params.t 52 | -> unit 53 | -> t 54 | 55 | val to_string : t -> string 56 | -------------------------------------------------------------------------------- /solutions/irc-bot/lib/parser.ml: -------------------------------------------------------------------------------- 1 | open Core 2 | 3 | module Angstrom = struct 4 | include Angstrom 5 | include Base.Monad.Make(struct 6 | type nonrec 'a t = 'a t 7 | let bind t ~f = t >>= f 8 | let map = `Define_using_bind 9 | let return = return 10 | end) 11 | end 12 | 13 | open Angstrom 14 | open Angstrom.Let_syntax 15 | 16 | module P = struct 17 | let is_space = function | ' ' -> true | _ -> false 18 | 19 | let is_letter = Char.is_alpha 20 | let is_digit = Char.is_digit 21 | let is_letter_or_digit = Char.is_alphanum 22 | 23 | let is_special = function 24 | | '[' | ']' | '\\' | '`' | '_' | '^' | '{' | '|' | '}' -> true 25 | | _ -> false 26 | ;; 27 | 28 | let is_nospcrlfcl = function 29 | | '\000' | '\r' | '\n' | ' ' | ':' -> false | _ -> true 30 | ;; 31 | end 32 | 33 | let letters = take_while1 P.is_letter 34 | let digits = take_while1 P.is_digit 35 | 36 | let (<||>) a b = take_while1 (fun char -> a char || b char) 37 | 38 | let space = string " " 39 | let crlf = string "\r\n" 40 | 41 | let rec at_most m p = 42 | if m = 0 43 | then return [] 44 | else 45 | (lift2 (fun x xs -> x :: xs) p (at_most (m - 1) p)) 46 | <|> return [] 47 | ;; 48 | 49 | let between ~lower ~upper p = 50 | lift2 (fun xs ys -> xs @ ys) 51 | (count lower p) 52 | (at_most upper p) 53 | ;; 54 | 55 | let user = 56 | take_while1 57 | (function | '\000' | '\r' | '\n' | ' ' | '@' -> false | _ -> true) 58 | "user" 59 | ;; 60 | 61 | let hostname = 62 | let shortname = 63 | lift2 (fun hd tl -> (Char.to_string hd) ^ tl) 64 | (satisfy P.is_letter_or_digit) 65 | (peek_char 66 | >>= function 67 | | None -> 68 | satisfy P.is_letter_or_digit >>| Char.to_string 69 | | Some _ -> 70 | P.is_letter_or_digit <||> (fun c -> c = '-')) 71 | "shortname" 72 | in 73 | lift2 (fun s1 s2 -> 74 | match s2 with 75 | | [] -> s1 76 | | s2 -> 77 | s1 ^ "." ^ String.concat ~sep:"." s2) 78 | shortname 79 | (many (string "." *> shortname)) 80 | "hostname" 81 | ;; 82 | 83 | let hostaddr = 84 | let ip4addr = 85 | (sep_by 86 | (char '.') 87 | (between ~lower:1 ~upper:3 digits >>| String.concat)) 88 | >>| List.intersperse ~sep:"." 89 | >>= fun l -> 90 | match 91 | Option.try_with (fun () -> Unix.Inet_addr.of_string (String.concat l)) 92 | with 93 | | None -> fail (sprintf "Failed to parse inet_addr %s" (String.concat l)) 94 | | Some inet_addr -> return inet_addr 95 | in 96 | let ip6addr = fail "IPv6 support unimplemented" in 97 | (ip4addr <|> ip6addr) 98 | "hostaddr" 99 | ;; 100 | 101 | let host = 102 | let open Message.Prefix in 103 | ((Host.hostname <$> hostname) <|> (Host.inet_addr <$> hostaddr)) 104 | "host" 105 | ;; 106 | 107 | let servername = hostname "servername" 108 | 109 | let prefix : Message.Prefix.t t = 110 | let open Message.Prefix in 111 | let server_prefix = lift (fun s -> Server s) servername <* space in 112 | let user_prefix = 113 | let nickname = 114 | lift2 (^) 115 | (P.is_letter <||> P.is_special) 116 | (between ~lower:0 ~upper:8 117 | (satisfy (function 118 | | '-' -> true 119 | | c -> 120 | P.is_letter c || P.is_digit c || P.is_special c)) 121 | >>| String.of_char_list) 122 | in 123 | let user = 124 | lift2 (fun user host -> { User. user; host }) 125 | (option None (Option.return <$> char '!' *> user)) 126 | (char '@' *> host) 127 | in 128 | (lift2 (fun nickname user -> User { nickname ; user }) 129 | nickname 130 | (option None (Option.return <$> user))) 131 | <* space 132 | in 133 | (string ":" *> (user_prefix <|> server_prefix)) 134 | "prefix" 135 | ;; 136 | 137 | let params = 138 | let middle = 139 | lift2 (fun first rest -> 140 | Char.to_string first ^ rest) 141 | (satisfy (P.is_nospcrlfcl)) 142 | (take_while (fun c -> c = ':' || P.is_nospcrlfcl c)) 143 | in 144 | let trailing = 145 | take_while1 (fun c -> P.is_space c || c = ':' || P.is_nospcrlfcl c) 146 | >>| List.return 147 | in 148 | let variant1 = 149 | lift2 (@) 150 | (at_most 14 (space *> middle)) 151 | (option [] (space *> char ':' *> trailing)) 152 | in 153 | let variant2 = 154 | lift2 (@) 155 | (count 14 (space *> middle)) 156 | (option [] 157 | (space 158 | *> (at_most 1 (char ':')) 159 | *> trailing)) 160 | in 161 | (variant1 <|> variant2) 162 | "params" 163 | ;; 164 | 165 | let command = 166 | let command = 167 | (lift2 (fun maybe_command peek -> 168 | match peek with 169 | | None -> maybe_command 170 | | Some c -> 171 | if c = ' ' 172 | then maybe_command 173 | else []) 174 | (many1 letters 175 | <|> (count 3 (satisfy P.is_digit) 176 | >>| String.of_char_list 177 | >>| List.return)) 178 | peek_char) 179 | "command" 180 | in 181 | String.concat 182 | <$> command 183 | >>| Message.Command.of_string 184 | ;; 185 | 186 | let message = 187 | let%bind maybe_prefix = 188 | option None (Option.return <$> prefix) 189 | in 190 | let%bind command = command in 191 | let%bind params = option [] params in 192 | crlf 193 | *> return 194 | { Message. 195 | prefix = maybe_prefix 196 | ; command 197 | ; params } 198 | "message" 199 | ;; 200 | -------------------------------------------------------------------------------- /solutions/lumines/moving_piece.ml: -------------------------------------------------------------------------------- 1 | open Base 2 | 3 | type t = 4 | { top_left : Filled_square.t 5 | ; top_right : Filled_square.t 6 | ; bottom_left : Filled_square.t 7 | ; bottom_right : Filled_square.t 8 | } 9 | 10 | let create () = 11 | { top_left = Filled_square.create (Color.random ()) 12 | ; top_right = Filled_square.create (Color.random ()) 13 | ; bottom_left = Filled_square.create (Color.random ()) 14 | ; bottom_right = Filled_square.create (Color.random ()) 15 | } 16 | ;; 17 | 18 | let rotate_left t = 19 | (* TODO : rotate the piece to the left (counterclockwise). *) 20 | let { top_left; top_right; bottom_left; bottom_right } = t in 21 | { top_left = top_right 22 | ; top_right = bottom_right 23 | ; bottom_left = top_left 24 | ; bottom_right = bottom_left 25 | } 26 | ;; 27 | 28 | let rotate_right t = 29 | (* TODO : rotate the piece to the right (clockwise). *) 30 | let { top_left; top_right; bottom_left; bottom_right } = t in 31 | { top_left = bottom_left 32 | ; top_right = top_left 33 | ; bottom_left = bottom_right 34 | ; bottom_right = top_right 35 | } 36 | ;; 37 | 38 | let coords ~bottom_left:{ Point.col; row } : Point.t list = 39 | [ { col; row } 40 | ; { col = col + 1; row } 41 | ; { col; row = row + 1 } 42 | ; { col = col + 1; row = row + 1 } 43 | ] 44 | ;; 45 | 46 | let equal t1 t2 = 47 | Filled_square.equal t1.top_left t2.top_left 48 | && Filled_square.equal t1.top_right t2.top_right 49 | && Filled_square.equal t1.bottom_left t2.bottom_left 50 | && Filled_square.equal t1.bottom_right t2.bottom_right 51 | ;; 52 | 53 | (* Tests *) 54 | let%test "Testing Rotate Right..." = 55 | let piece = 56 | { top_left = Filled_square.create (Color.Orange) 57 | ; top_right = Filled_square.create (Color.White) 58 | ; bottom_left = Filled_square.create (Color.White) 59 | ; bottom_right = Filled_square.create (Color.White) 60 | } 61 | in 62 | let rotated = 63 | { top_left = Filled_square.create (Color.White) 64 | ; top_right = Filled_square.create (Color.Orange) 65 | ; bottom_left = Filled_square.create (Color.White) 66 | ; bottom_right = Filled_square.create (Color.White) 67 | } 68 | in 69 | equal (rotate_right piece) rotated 70 | ;; 71 | 72 | let%test "Testing Rotate Left..." = 73 | let piece = 74 | { top_left = Filled_square.create (Color.Orange) 75 | ; top_right = Filled_square.create (Color.White) 76 | ; bottom_left = Filled_square.create (Color.White) 77 | ; bottom_right = Filled_square.create (Color.White) 78 | } 79 | in 80 | let rotated = 81 | { top_left = Filled_square.create (Color.White) 82 | ; top_right = Filled_square.create (Color.White) 83 | ; bottom_left = Filled_square.create (Color.Orange) 84 | ; bottom_right = Filled_square.create (Color.White) 85 | } 86 | in 87 | equal (rotate_left piece) rotated 88 | ;; 89 | -------------------------------------------------------------------------------- /solutions/snake/apple.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = { location : Position.t } [@@deriving sexp_of] 4 | 5 | let location t = t.location 6 | 7 | (* TODO: Implement [create]. 8 | 9 | Make sure to inspect the mli to understand the signature of [create]. [create] will 10 | take in the height and width of the board area, as well as a list of locations where 11 | the apple cannot be generated, and create a [t] with a random location on the board. *) 12 | let create ~height ~width ~invalid_locations = 13 | let possible_locations = 14 | List.concat_map (List.range 0 height) ~f:(fun row -> 15 | List.map (List.range 0 width) ~f:(fun col -> { Position.row; col })) 16 | |> List.filter ~f:(fun pos -> 17 | not (List.mem invalid_locations pos ~equal:[%compare.equal: Position.t])) 18 | in 19 | match possible_locations with 20 | | [] -> None 21 | | _ -> Some { location = List.random_element_exn possible_locations } 22 | ;; 23 | -------------------------------------------------------------------------------- /solutions/snake/direction.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | | Left 5 | | Up 6 | | Right 7 | | Down 8 | [@@deriving sexp_of] 9 | 10 | (* TODO: Implement [next_position]. 11 | 12 | Make sure to take a look at the signature of this function to understand what it does. 13 | Recall that the origin of the board is in the lower left hand corner. *) 14 | let next_position t { Position.row; col } : Position.t = 15 | match t with 16 | | Left -> { row; col = col - 1 } 17 | | Right -> { row; col = col + 1 } 18 | | Up -> { row = row + 1; col } 19 | | Down -> { row = row - 1; col } 20 | ;; 21 | -------------------------------------------------------------------------------- /solutions/snake/game.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | { mutable snake : Snake.t 5 | ; mutable apple : Apple.t 6 | ; mutable game_state : Game_state.t 7 | ; height : int 8 | ; width : int 9 | ; amount_to_grow : int 10 | } 11 | [@@deriving sexp_of] 12 | 13 | (* TODO: Implement [in_bounds]. *) 14 | let in_bounds t { Position.row; col } = 15 | col >= 0 && col < t.width && row >= 0 && row < t.height 16 | ;; 17 | 18 | (* TODO: Implement [create]. 19 | 20 | Make sure that the game returned by [create] is in a valid state. In particular, we 21 | should fail with the message "unable to create initial apple" if [Apple.create] is 22 | unsuccessful, and "unable to create initial snake" if the initial snake is invalid 23 | (i.e. goes off the board). *) 24 | let create ~height ~width ~initial_snake_length ~amount_to_grow = 25 | let snake = Snake.create ~length:initial_snake_length in 26 | let apple = Apple.create ~height ~width ~invalid_locations:(Snake.locations snake) in 27 | match apple with 28 | | None -> failwith "unable to create initial apple" 29 | | Some apple -> 30 | let t = { snake; apple; game_state = In_progress; height; width; amount_to_grow } in 31 | if List.exists (Snake.locations snake) ~f:(fun pos -> not (in_bounds t pos)) 32 | then failwith "unable to create initial snake" 33 | else t 34 | ;; 35 | 36 | let snake t = t.snake 37 | let apple t = t.apple 38 | let game_state t = t.game_state 39 | 40 | (* TODO: Implement [set_direction]. *) 41 | let set_direction t direction = t.snake <- Snake.set_direction t.snake direction 42 | 43 | (* TODO: Implement [step]. 44 | 45 | [step] should: 46 | - move the snake forward one square 47 | - check for collisions (end the game with "Wall collision" or "Self collision") 48 | - if necessary: 49 | -- consume apple 50 | -- if apple cannot be regenerated, win game; otherwise, grow the snake *) 51 | let maybe_consume_apple t head = 52 | if not ([%compare.equal: Position.t] head (Apple.location t.apple)) 53 | then () 54 | else ( 55 | let snake = Snake.grow_over_next_steps t.snake t.amount_to_grow in 56 | let apple = 57 | Apple.create 58 | ~height:t.height 59 | ~width:t.width 60 | ~invalid_locations:(Snake.locations snake) 61 | in 62 | match apple with 63 | | None -> t.game_state <- Win 64 | | Some apple -> 65 | t.snake <- snake; 66 | t.apple <- apple) 67 | ;; 68 | 69 | let step t = 70 | match Snake.step t.snake with 71 | | None -> t.game_state <- Game_over "Self collision" 72 | | Some snake -> 73 | t.snake <- snake; 74 | let head = Snake.head_location snake in 75 | if not (in_bounds t head) 76 | then t.game_state <- Game_over "Wall collision" 77 | else maybe_consume_apple t head 78 | ;; 79 | 80 | module For_testing = struct 81 | let create_apple_force_location_exn ~height ~width ~location = 82 | let invalid_locations = 83 | List.init height ~f:(fun row -> 84 | List.init width ~f:(fun col -> { Position.row; col })) 85 | |> List.concat 86 | |> List.filter ~f:(fun pos -> not ([%compare.equal: Position.t] location pos)) 87 | in 88 | match Apple.create ~height ~width ~invalid_locations with 89 | | None -> failwith "[Apple.create] returned [None] when [Some _] was expected!" 90 | | Some apple -> apple 91 | ;; 92 | 93 | let create_apple_and_update_game_exn t ~apple_location = 94 | let apple = 95 | create_apple_force_location_exn 96 | ~height:t.height 97 | ~width:t.width 98 | ~location:apple_location 99 | in 100 | t.apple <- apple 101 | ;; 102 | 103 | let create_game_with_apple_exn 104 | ~height 105 | ~width 106 | ~initial_snake_length 107 | ~amount_to_grow 108 | ~apple_location 109 | = 110 | let t = create ~height ~width ~initial_snake_length ~amount_to_grow in 111 | create_apple_and_update_game_exn t ~apple_location; 112 | t 113 | ;; 114 | end 115 | -------------------------------------------------------------------------------- /solutions/snake/snake.ml: -------------------------------------------------------------------------------- 1 | open! Base 2 | 3 | type t = 4 | { (* [direction] represents the orientation of the snake's head. *) 5 | direction : Direction.t 6 | ; (* [extensions_remaining] represents how many more times we should extend the 7 | snake. *) 8 | extensions_remaining : int 9 | ; (* [locations] represents the current set of squares that the snake 10 | occupies. *) 11 | locations : Position.t list 12 | } 13 | [@@deriving sexp_of] 14 | 15 | (* TODO: Implement [create]. 16 | 17 | Note that at the beginning of the game, the snake will not need to grow at all, so 18 | [extensions_remaining] should be initialized to 0. *) 19 | let create ~length = 20 | { direction = Right 21 | ; extensions_remaining = 0 22 | ; locations = List.init length ~f:(fun col -> { Position.row = 0; col }) |> List.rev 23 | } 24 | ;; 25 | 26 | (* TODO: Implement [grow_over_next_steps]. 27 | 28 | Read over the documentation of this function in the mli. 29 | 30 | Notice that this function should not actually grow the snake, but only record that we 31 | should grow the snake one block for the next [by_how_much] squares. *) 32 | let grow_over_next_steps t by_how_much = 33 | { t with extensions_remaining = t.extensions_remaining + by_how_much } 34 | ;; 35 | 36 | (* TODO: Implement [locations]. *) 37 | let locations t = t.locations 38 | 39 | (* TODO: Implement [head_location]. *) 40 | let head_location t = List.hd_exn t.locations 41 | 42 | (* TODO: Implement [set_direction]. *) 43 | let set_direction t direction = { t with direction } 44 | 45 | (* TODO: Implement [step]. 46 | 47 | Read over the documentation of this function in the mli. 48 | 49 | [step] should: 50 | - move the snake forward one block, growing it and updating [t.locations] if necessary 51 | - check for self collisions *) 52 | let remove_last_elt lst = 53 | match List.rev lst with 54 | | [] -> [] 55 | | _ :: xs -> List.rev xs 56 | ;; 57 | 58 | let step ({ direction; extensions_remaining; locations } as t) = 59 | let body, extensions_remaining = 60 | if extensions_remaining > 0 61 | then locations, extensions_remaining - 1 62 | else remove_last_elt locations, extensions_remaining 63 | in 64 | let new_head = Direction.next_position direction (head_location t) in 65 | match List.mem body new_head ~equal:[%compare.equal: Position.t] with 66 | | true -> None 67 | | false -> Some { t with locations = new_head :: body; extensions_remaining } 68 | ;; 69 | --------------------------------------------------------------------------------