elm_playground_web index
elm_playground_native index
Module Keyboard
elm_system index
Module Playground_platform
val run_app : ('a, 'b) Playground.app -> unitelm_core index
Module Time
12 |
27 | README
13 | 14 |OCaml package documentation
15 |The most important module below is elm_playground. 16 |
-
17 |
- elm_core 0.1.7 18 |
- elm_playground 0.1.7 19 |
- elm_playground_native 0.1.7 20 |
- elm_playground_web 0.1.7 21 |
- elm_system 0.1.7 22 |
Examples
23 |See examples for very basic examples. 24 |
See toy for the toy example used in the README. 25 |
See also games for more complex examples. 26 |
Module Cmd
val none : 'a tModule Set
Module Color
val rgb : int -> int -> int -> tval white : tval black : tval red : tval green : tval blue : tval yellow : tval brown : tval lightYellow : tval lightPurple : tval gray : tval darkGray : telm_playground
OCaml Elm Playground
Create pictures, animations, and games with OCaml!
This is a port of the excellent Elm playground package to OCaml.
This is the package I wanted when I was learning programming. Start by putting shapes on screen and work up to making games. I hope this package will be fun for a broad range of ages and backgrounds!
Pictures
A picture is a list of shapes. For example, this picture combines a brown rectangle and a green circle to make a tree
open Playground
3 |
4 | let app =
5 | picture [
6 | rectangle brown 40. 200.;
7 | circle green 100.
8 | |> move_up 100.;
9 | ]
10 |
11 | let main = Playground_platform.run_app appPlay around to get familiar with all the different shapes and transformations in the library.
Animations
An animation is a list of shapes that changes over time. For example, here is a spinning triangle:
open Playground
12 |
13 | let view time = [
14 | triangle orange 50.
15 | |> rotate (spin 8. time);
16 | ]
17 |
18 | let app = animation view
19 |
20 | let main = Playground_platform.run_app appIt will do a full spin every 8 seconds.
Maybe try making a car with spinning octogons as wheels? Try using Playground.wave to move things back-and-forth? Try using Playground.zigzag to fade things in-and-out?
Games
A game lets you use input from the mouse and keyboard to change your picture. For example, here is a square that moves around based on the arrow keys:
open Playground
21 |
22 | let view _computer (x, y) = [
23 | square blue 40.
24 | |> move x y
25 | ]
26 |
27 | let update computer (x, y) =
28 | (x +. to_x computer.keyboard, y +. to_y computer.keyboard)
29 |
30 | let app =
31 | game view update (0., 0.)
32 |
33 | let main = Playground_platform.run_app appEvery game has three important parts:
memory- Store information. Our example stores(x,y)coordinates.update- Update the memory based on mouse movements, key presses, etc. Our example moves the(x,y)coordinate around based on the arrow keys.view- Turn the memory into a picture. Our example just shows one blue square at the(x,y)coordinate we have been tracking in memory.
When you start making fancier games, you will store fancier things in memory. There is a lot of room to develop your programming skills here: Making lists, using records, creating custom types, etc.
I started off trying to make Pong, then worked on games like Breakout and Space Invaders as I learned more and more. It was really fun, and I hope it will be for you as well!
Index of modules
Module Basics
3 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | OCaml Elm Playground
2 | =======================
3 |
4 | Create pictures, animations, and video games with OCaml!
5 |
6 | This is a port of the excellent Elm playground package
7 | https://github.com/evancz/elm-playground to OCaml.
8 |
9 | > This is the package I wanted when I was learning programming. Start by
10 | > putting shapes on screen and work up to making games. I hope this
11 | > package will be fun for a broad range of ages and backgrounds!
12 | > *- Evan Czaplicki*
13 |
14 |
15 | Documentation
16 | ---------------------------------------------------
17 |
18 | * [Getting started](https://github.com/aryx/ocaml-elm-playground?tab=readme-ov-file#ocaml-elm-playground) (this file)
19 | * [Tutorial](https://aryx.github.io/ocaml-elm-playground/elm_playground/)
20 | * [Basic examples](https://aryx.github.io/ocaml-elm-playground/examples/)
21 | * [Basic games](https://aryx.github.io/ocaml-elm-playground/games/)
22 | * [API reference](https://aryx.github.io/ocaml-elm-playground/elm_playground/Playground/)
23 | * [Index](https://aryx.github.io/ocaml-elm-playground)
24 |
25 | Features
26 | --------------
27 |
28 | The OCaml `elm_playground` package allows you to easily create
29 | *pictures*, *animations*, and even *video games* in a portable way using an API that
30 | really simplifies how to view the computer and its devices (the screen,
31 | keyboard, and mouse).
32 |
33 | The goal is similar to the old [`graphics` package](https://github.com/ocaml/graphics)
34 | but goes even further in terms of simplification.
35 |
36 | The main API is defined in a single
37 | [Playground.mli](https://github.com/aryx/ocaml-elm-playground/blob/master/playground/Playground.mli) module and is implemented by two backends:
38 | - a *native* (SDL-based) backend to run your game on your desktop from a terminal
39 | - a *web* (vdom-based) backend to run your game in a browser
40 |
41 | Here is for example a simple [Snake game](https://aryx.github.io/ocaml-elm-playground/games/Snake.html) you can run from your browser (use the arrow keys to change the direction of the snake and eat the ball to grow your length). You can run the same game
42 | on your desktop *without changing a line of code*.
43 |
44 | Install
45 | --------------
46 |
47 | To install the playground, run `opam install elm_playground` and then
48 | install one or both backends with `opam install elm_playground_native`
49 | and/or `opam install elm_playground_web`.
50 |
51 | Simple native application
52 | --------------------------
53 |
54 | Here is a very simple application using the playground:
55 | ```ocaml
56 | open Playground
57 |
58 | (* the (x, y) position of the blue square *)
59 | type model = (float * float)
60 |
61 | let initial_state : model = (0., 0.)
62 |
63 | let view _computer (x, y) = [
64 | square blue 40.
65 | |> move x y
66 | ]
67 |
68 | let update computer (x, y) =
69 | (x +. to_x computer.keyboard, y +. to_y computer.keyboard)
70 |
71 | let app =
72 | game view update initial_state
73 |
74 | let main = Playground_platform.run_app app
75 | ```
76 |
77 |
78 | It is a very simple `game` defining a `model` type, a `view` function, and an `update` function to specify how the game behaves. It is using the
79 | "Model-View-Update" architecture to organize the code of a graphical
80 | interactive application
81 | (see https://guide.elm-lang.org/architecture/ for more information).
82 |
83 | To compile this application, simply do:
84 | ```bash
85 | $ cd docs/toy-native-example
86 | $ opam install --deps-only --yes .
87 | $ dune exec --root . ./Toy.exe
88 | ```
89 | You should then see on your desktop:
90 |
91 |
93 |
94 | If you type on the arrow keys on your keyboard the blue square should move in the
95 | corresponding direction. If you type `q` it will exit the game.
96 |
97 | Note that with the Playground API the center of the screen is at `(0, 0)`.
98 |
99 | Simple web application
100 | --------------------------
101 |
102 | To compile this same application for the web, simply do:
103 |
104 | ```bash
105 | $ cd docs/toy-web-example
106 | $ opam install --deps-only --yes .
107 | $ dune build --root .
108 | $ cp _build/default/Toy.bc.js static/
109 | ```
110 | You should then be able to use the web app by going to:
111 | https://aryx.github.io/ocaml-elm-playground/toy-web-example/static/Toy.html
112 |
113 | By default the generated javascript file can be big so to get a smaller one
114 | you can do instead:
115 | ```bash
116 | $ dune build --root . --profile=release
117 | $ cp _build/default/Toy.bc.js static/
118 | ```
119 |
120 | Next steps
121 | ------------
122 |
123 | Read the tutorial at:
124 | https://aryx.github.io/ocaml-elm-playground/elm_playground/index.html
125 |
126 | Look at the code under [examples/](examples/) and [games/](games/).
127 |
128 | Here is a screenshot of the [Tetris](games/Tetris.ml) Playgound game running:
129 | 
131 |
132 | You can see a few more screenshots [here](docs/screenshots/).
133 |
134 | Limitations
135 | ------------
136 |
137 | The web backend is not fully finished yet. Many of the examples and games
138 | do not work fully yet on the web. You've been warned.
139 | Contributions are welcome!
140 |
--------------------------------------------------------------------------------
/tests/Test_ocamlsdl2.ml:
--------------------------------------------------------------------------------
1 | (* from ocamlsdl2/examples/ex_event.ml *)
2 | [@@@warning "-9"]
3 |
4 | open Sdlevent
5 | open Sdl
6 |
7 | let print_keyboard_event e st =
8 | Printf.printf "
9 | keyboard_event ((
10 | timestamp: %ld
11 | window_id: %lX
12 | state: %s / %s
13 | repeat: %d
14 | scancode: %s
15 | keycode: %s
16 | keymod: %s
17 | ))\n%!"
18 | e.ke_timestamp
19 | e.ke_window_id
20 | (Sdlevent.string_of_state e.ke_state) st
21 | e.ke_repeat
22 | (Sdlscancode.to_string e.scancode)
23 | (Sdlkeycode.to_string e.keycode)
24 | (String.concat " "
25 | (List.map Sdlkeymod.to_string e.keymod))
26 |
27 | let print_mouse_motion_event e =
28 | Printf.printf "
29 | mouse_motion_event ((
30 | timestamp: %ld
31 | window_id: %lX
32 | buttons: %s
33 | x: %d
34 | y: %d
35 | xrel: %d
36 | yrel: %d
37 | ))\n%!"
38 | e.mm_timestamp
39 | e.mm_window_id
40 | (String.concat " "
41 | (List.map string_of_int e.mm_buttons))
42 | e.mm_x
43 | e.mm_y
44 | e.mm_xrel
45 | e.mm_yrel
46 |
47 | let print_mouse_button_event e s =
48 | Printf.printf "
49 | mouse_button_event ((
50 | timestamp: %ld
51 | window_id: %lX
52 | button: %d
53 | state: %s %s
54 | x: %d
55 | y: %d
56 | ))\n%!"
57 | e.mb_timestamp
58 | e.mb_window_id
59 | e.mb_button
60 | (Sdlevent.string_of_state e.mb_state) s
61 | e.mb_x
62 | e.mb_y
63 |
64 | let print_mouse_wheel_event e =
65 | Printf.printf "
66 | mouse_wheel_event ((
67 | timestamp: %ld
68 | window_id: %lX
69 | x: %d
70 | y: %d
71 | ))\n%!"
72 | e.mw_timestamp
73 | e.mw_window_id
74 | e.mw_x
75 | e.mw_y
76 |
77 | let print_joy_axis_event e =
78 | Printf.printf "
79 | joy_axis_event ((
80 | timestamp: %ld
81 | which: %d
82 | axis: %d
83 | value: %d
84 | ))\n%!"
85 | e.ja_timestamp
86 | e.ja_which
87 | e.ja_axis
88 | e.ja_value
89 |
90 | let print_joy_button_event e s =
91 | Printf.printf "
92 | joy_button_event ((
93 | timestamp: %ld
94 | which: %d
95 | button: %d
96 | state: %s %s
97 | ))\n%!"
98 | e.jb_timestamp
99 | e.jb_which
100 | e.jb_button
101 | (Sdlevent.string_of_state e.jb_state) s
102 |
103 | let print_joy_hat_event e =
104 | Printf.printf "
105 | joy_hat_event ((
106 | timestamp: %ld
107 | which: %d
108 | hat: %d
109 | pos: \t left:%b \t right:%b \t up:%b \t down:%b
110 | # %s
111 | # %s
112 | ))\n%!"
113 | e.jh_timestamp
114 | e.jh_which
115 | e.jh_hat
116 | e.jh_pos.Hat.left
117 | e.jh_pos.Hat.right
118 | e.jh_pos.Hat.up
119 | e.jh_pos.Hat.down
120 | (Sdlhat.string_of_pos e.jh_pos)
121 | (Sdlhat.string_of_dir e.jh_dir)
122 |
123 | let print_joy_device_event e ch =
124 | Printf.printf "
125 | joy_device_event ((
126 | timestamp: %ld
127 | which: %d
128 | device_change: %s %s
129 | ))\n%!"
130 | e.jd_timestamp
131 | e.jd_which
132 | (Sdlevent.string_of_joy_device_change e.jd_change) ch
133 |
134 | let print_window_event e =
135 | Printf.printf "
136 | window_event ((
137 | timestamp: %ld
138 | window_ID: %ld
139 | kind: %s
140 | ))\n%!"
141 | e.we_timestamp
142 | e.window_ID
143 | (Sdlevent.string_of_window_event_kind e.kind)
144 |
145 |
146 | let proc_events = function
147 | | KeyDown { scancode = Sdlscancode.ESCAPE } ->
148 | print_endline "Goodbye";
149 | exit 0
150 | | KeyDown { keycode = Sdlkeycode.Escape } ->
151 | print_endline "Fuck you!";
152 | exit 0
153 | | KeyDown e -> print_keyboard_event e "down"
154 | | KeyUp e -> print_keyboard_event e "up"
155 | | Mouse_Motion e -> print_mouse_motion_event e
156 | | Mouse_Button_Down e -> print_mouse_button_event e "down"
157 | | Mouse_Button_Up e -> print_mouse_button_event e "up"
158 | | Mouse_Wheel e -> print_mouse_wheel_event e
159 | | Joy_Axis_Motion e -> print_joy_axis_event e
160 | | Joy_Button_Down e -> print_joy_button_event e "down"
161 | | Joy_Button_Up e -> print_joy_button_event e "up"
162 | | Joy_Hat_Motion e -> print_joy_hat_event e
163 | | Joy_Device_Removed e -> print_joy_device_event e "Removed"
164 | | Joy_Device_Added e -> print_joy_device_event e "Added";
165 | ignore(Sdljoystick.j_open e.jd_which);
166 | | Window_Event { kind = WindowEvent_Resized p } ->
167 | Printf.printf "### WINDOW_RESIZED => %d x %d\n" p.win_x p.win_y
168 | | Window_Event e -> print_window_event e
169 | | Quit e ->
170 | Printf.printf "Quit(timestamp:%ld)\n%!" e.quit_timestamp;
171 | Sdl.quit ();
172 | exit 0
173 | | e ->
174 | print_endline (Sdlevent.to_string e)
175 |
176 |
177 | let () =
178 | let width, height = (640, 480) in
179 | Sdl.init [`VIDEO; `JOYSTICK];
180 | at_exit print_newline;
181 | (*
182 | let window, renderer =
183 | Sdlrender.create_window_and_renderer ~width ~height
184 | in
185 | ignore (window, renderer);
186 | *)
187 | let window =
188 | Sdlwindow.create2
189 | ~title:"SDL Event"
190 | ~x:`undefined ~y:`undefined
191 | ~width ~height
192 | ~flags:[
193 | (*
194 | Sdlwindow.FullScreen;
195 | Sdlwindow.OpenGL;
196 | Sdlwindow.Shown;
197 | Sdlwindow.Hidden;
198 | Sdlwindow.Borderless;
199 | Sdlwindow.Resizable;
200 | Sdlwindow.Minimized;
201 | Sdlwindow.Maximized;
202 | Sdlwindow.Input_Grabbed;
203 | Sdlwindow.Input_Focus;
204 | Sdlwindow.Mouse_Focus;
205 | Sdlwindow.FullScreen_Desktop;
206 | Sdlwindow.Foreign;
207 | *)
208 | ]
209 | in
210 | ignore (window);
211 |
212 | let joy_num = Sdljoystick.num_joysticks () in
213 | for i = 0 to pred joy_num do
214 | ignore(Sdljoystick.j_open i);
215 | let name = Sdljoystick.name_for_index i in
216 | Printf.printf "Joy-name: %s\n" name;
217 | done;
218 |
219 | let rec event_loop () =
220 | match Sdlevent.poll_event () with
221 | | Some ev -> proc_events ev; event_loop ()
222 | | None -> ()
223 | in
224 | let rec main_loop () =
225 | event_loop ();
226 | Printf.printf ".%!";
227 | Sdltimer.delay 20;
228 | main_loop ()
229 | in
230 | main_loop ()
231 |
--------------------------------------------------------------------------------
/games/Snake.ml:
--------------------------------------------------------------------------------
1 | open Playground
2 |
3 | (*****************************************************************************)
4 | (* Prelude *)
5 | (*****************************************************************************)
6 | (* Port of the Snake clone https://github.com/amarantedaniel/snek,
7 | * but using OCaml instead of Elm, and using Playground instead of HTML/SVG.
8 | *
9 | * See https://en.wikipedia.org/wiki/Snake_(video_game_genre) for more info.
10 | *
11 | * TODO:
12 | * - two players (like in original Snake game called Blockade)
13 | * - display score
14 | * - accelerate games as times goes
15 | * - high score table
16 | *)
17 |
18 | (*****************************************************************************)
19 | (* Model *)
20 | (*****************************************************************************)
21 |
22 | (* The origin of the grid (0, 0) is at the bottom left of the screen.
23 | * This is different from the coordinate system of Playground where the
24 | * origin is at the center of the screen, but it allows to use 'mod'
25 | * to easily move the snake around the edges.
26 | *)
27 | type position = (int * int) (* x, y *)
28 |
29 | type grid_size = {
30 | g_width: int;
31 | g_height: int;
32 | }
33 | (* less: could be changed *)
34 | let grid_size = { g_width = 20; g_height = 20 }
35 |
36 | let cell_size screen =
37 | int_of_float screen.width / grid_size.g_width
38 |
39 | (* TODO: do not return a position already used by the snake *)
40 | let random_position () =
41 | (Random.int (grid_size.g_width - 1), Random.int (grid_size.g_height - 1))
42 |
43 | type direction = Up | Down | Left | Right
44 |
45 | (* using mutable so easier to update subparts of the model *)
46 | type snake = {
47 | mutable head: position;
48 | mutable body: position list;
49 | mutable direction: direction;
50 | }
51 | let initial_snake = {
52 | head = (3, 0);
53 | body = [(2, 0); (1, 0); (1, 0)];
54 | direction = Right;
55 | }
56 |
57 |
58 | type model = {
59 | snake: snake;
60 | mutable food: position;
61 | mutable game_over: bool;
62 | mutable last_tick: Time.posix;
63 | }
64 | let initial_model = {
65 | snake = initial_snake;
66 | food = (grid_size.g_width / 2, grid_size.g_height / 2);
67 | game_over = false;
68 | last_tick = 0.;
69 | }
70 |
71 | (*****************************************************************************)
72 | (* Helpers *)
73 | (*****************************************************************************)
74 |
75 | let rec list_init = function
76 | | [] -> raise Not_found
77 | | [ _x ] -> []
78 | | x :: y :: xs -> x :: list_init (y :: xs)
79 |
80 | (*****************************************************************************)
81 | (* View *)
82 | (*****************************************************************************)
83 | let f = float
84 | let i = int_of_float
85 | let smaller size = f size *. 0.90
86 |
87 | let movei a b shape = move (f a) (f b) shape
88 |
89 | (* TODO: this currently assumes a square screen *)
90 | let translate (x,y) screen shape =
91 | let cell_size = cell_size screen in
92 | shape
93 | |> move screen.left screen.bottom
94 | |> movei (x * cell_size) (y * cell_size)
95 | |> movei (cell_size / 2) (cell_size / 2)
96 |
97 |
98 | let view_background screen =
99 | [rectangle (Color.Hex "#8cbf00") screen.width screen.height]
100 |
101 | let view_food screen pos =
102 | let size = cell_size screen in
103 | let radius = size / 3 in
104 | [circle gray (f radius) |> translate pos screen;
105 | circle black (smaller radius) |> translate pos screen;
106 | ]
107 |
108 | let view_snake_part screen pos =
109 | let size = cell_size screen in
110 | [square gray (f size) |> translate pos screen;
111 | square black (smaller size) |> translate pos screen;
112 | ]
113 |
114 | let view_snake screen snake =
115 | List.map (view_snake_part screen) (snake.head::snake.body) |> List.flatten
116 |
117 | let view_game_over _screen =
118 | [ words red "GAME OVER" |> scale 10. ]
119 |
120 | let view computer model =
121 | let screen = computer.screen in
122 |
123 | view_background screen @
124 | view_snake screen model.snake @
125 | view_food screen model.food @
126 | (if model.game_over then view_game_over screen else [])
127 |
128 |
129 | (*****************************************************************************)
130 | (* Update *)
131 | (*****************************************************************************)
132 | let compute_new_head snake =
133 | let (x, y) = snake.head in
134 | let h = grid_size.g_height in
135 | let w = grid_size.g_width in
136 | match snake.direction with
137 | | Up -> (x, (y + 1 ) mod h)
138 | | Down -> (x, (y - 1 + h) mod h)
139 | | Right -> ((x + 1) mod w, y)
140 | | Left -> ((x - 1 + w) mod w, y)
141 |
142 | let update_direction kbd snake =
143 | let new_dir =
144 | match () with
145 | | _ when kbd.kup -> Up
146 | | _ when kbd.kdown -> Down
147 | | _ when kbd.kleft -> Left
148 | | _ when kbd.kright -> Right
149 | | _ -> snake.direction
150 | in
151 | let new_dir =
152 | match new_dir, snake.direction with
153 | (* invalid transitions *)
154 | | Left, Right | Right, Left
155 | | Up, Down | Down, Up
156 | -> snake.direction
157 | | x, _ -> x
158 | in
159 | snake.direction <- new_dir
160 |
161 | let update computer model =
162 | let (Time now) = computer.time in
163 | (* operate by side effect on the model; simpler *)
164 | if now -. model.last_tick > 0.5
165 | then begin
166 | model.last_tick <- now;
167 | let snake = model.snake in
168 | let new_head = compute_new_head snake in
169 | let ate_food = new_head = model.food in
170 | let new_body =
171 | if ate_food
172 | then snake.body
173 | else list_init snake.body
174 | in
175 | snake.body <- snake.head::new_body;
176 | snake.head <- new_head;
177 | if ate_food
178 | then model.food <- random_position ();
179 | model.game_over <- List.mem new_head new_body;
180 | end;
181 | update_direction computer.keyboard model.snake;
182 |
183 | model
184 |
185 | (*****************************************************************************)
186 | (* Entry point *)
187 | (*****************************************************************************)
188 |
189 | let app =
190 | game view update initial_model
191 |
192 | let main =
193 | Random.self_init ();
194 | Playground_platform.run_app app
195 |
--------------------------------------------------------------------------------
/core/Set_.mli:
--------------------------------------------------------------------------------
1 | (*pad: taken from set.ml from stdlib ocaml, functor sux: module Make(Ord: OrderedType) = *)
2 | (* with some addons such as from list *)
3 | (***********************************************************************)
4 | (* *)
5 | (* Objective Caml *)
6 | (* *)
7 | (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
8 | (* *)
9 | (* Copyright 1996 Institut National de Recherche en Informatique et *)
10 | (* en Automatique. All rights reserved. This file is distributed *)
11 | (* under the terms of the GNU Library General Public License, with *)
12 | (* the special exception on linking described in file ../LICENSE. *)
13 | (* *)
14 | (***********************************************************************)
15 |
16 | (* set.mli 1.32 2004/04/23 10:01:54 xleroy Exp $ *)
17 |
18 | (** Sets over ordered types.
19 |
20 | This module implements the set data structure, given a total ordering
21 | function over the set elements. All operations over sets
22 | are purely applicative (no side-effects).
23 | The implementation uses balanced binary trees, and is therefore
24 | reasonably efficient: insertion and membership take time
25 | logarithmic in the size of the set, for instance.
26 | *)
27 |
28 | (* pad:
29 | module type OrderedType =
30 | sig
31 | type t
32 | (** The type of the set elements. *)
33 | val compare : t -> t -> int
34 | (** A total ordering function over the set elements.
35 | This is a two-argument function [f] such that
36 | [f e1 e2] is zero if the elements [e1] and [e2] are equal,
37 | [f e1 e2] is strictly negative if [e1] is smaller than [e2],
38 | and [f e1 e2] is strictly positive if [e1] is greater than [e2].
39 | Example: a suitable ordering function is the generic structural
40 | comparison function {!Pervasives.compare}. *)
41 | end
42 | (** Input signature of the functor {!Set.Make}. *)
43 | *)
44 | (*
45 | module type S =
46 | sig
47 | *)
48 | (* type elt *)
49 | (** The type of the set elements. *)
50 |
51 | type 'elt t
52 | (** The type of sets. *)
53 |
54 | val empty : 'elt t
55 | (** The empty set. *)
56 |
57 | val is_empty : 'elt t -> bool
58 | (** Test whether a set is empty or not. *)
59 |
60 | val mem : 'elt -> 'elt t -> bool
61 | (** [mem x s] tests whether [x] belongs to the set [s]. *)
62 |
63 | val add : 'elt -> 'elt t -> 'elt t
64 | (** [add x s] returns a set containing all elements of [s],
65 | plus [x]. If [x] was already in [s], [s] is returned unchanged. *)
66 |
67 | val singleton : 'elt -> 'elt t
68 | (** [singleton x] returns the one-element set containing only [x]. *)
69 |
70 | val remove : 'elt -> 'elt t -> 'elt t
71 | (** [remove x s] returns a set containing all elements of [s],
72 | except [x]. If [x] was not in [s], [s] is returned unchanged. *)
73 |
74 | val union : 'elt t -> 'elt t -> 'elt t
75 | (** Set union. *)
76 |
77 | val inter : 'elt t -> 'elt t -> 'elt t
78 | (** Set intersection. *)
79 |
80 | val diff : 'elt t -> 'elt t -> 'elt t
81 | (** Set difference. *)
82 |
83 | val compare : 'elt t -> 'elt t -> int
84 | (** Total ordering between sets. Can be used as the ordering function
85 | for doing sets of sets. *)
86 |
87 | val equal : 'elt t -> 'elt t -> bool
88 | (** [equal s1 s2] tests whether the sets [s1] and [s2] are
89 | equal, that is, contain equal elements. *)
90 |
91 | val subset : 'elt t -> 'elt t -> bool
92 | (** [subset s1 s2] tests whether the set [s1] is a subset of
93 | the set [s2]. *)
94 |
95 | val iter : ('elt -> unit) -> 'elt t -> unit
96 | (** [iter f s] applies [f] in turn to all elements of [s].
97 | The elements of [s] are presented to [f] in increasing order
98 | with respect to the ordering over the type of the elements. *)
99 |
100 | val fold : ('elt -> 'a -> 'a) -> 'elt t -> 'a -> 'a
101 | (** [fold f s a] computes [(f xN ... (f x2 (f x1 a))...)],
102 | where [x1 ... xN] are the elements of [s], in increasing order. *)
103 |
104 | val for_all : ('elt -> bool) -> 'elt t -> bool
105 | (** [for_all p s] checks if all elements of the set
106 | satisfy the predicate [p]. *)
107 |
108 | val exists : ('elt -> bool) -> 'elt t -> bool
109 | (** [exists p s] checks if at least one element of
110 | the set satisfies the predicate [p]. *)
111 |
112 | val filter : ('elt -> bool) -> 'elt t -> 'elt t
113 | (** [filter p s] returns the set of all elements in [s]
114 | that satisfy predicate [p]. *)
115 |
116 | val partition : ('elt -> bool) -> 'elt t -> 'elt t * 'elt t
117 | (** [partition p s] returns a pair of sets [(s1, s2)], where
118 | [s1] is the set of all the elements of [s] that satisfy the
119 | predicate [p], and [s2] is the set of all the elements of
120 | [s] that do not satisfy [p]. *)
121 |
122 | val cardinal : 'elt t -> int
123 | (** Return the number of elements of a set. *)
124 |
125 | val elements : 'elt t -> 'elt list
126 | (** Return the list of all elements of the given set.
127 | The returned list is sorted in increasing order with respect
128 | to the ordering [Ord.compare], where [Ord] is the argument
129 | given to {!Set.Make}. *)
130 |
131 | val min_elt : 'elt t -> 'elt
132 | (** Return the smallest element of the given set
133 | (with respect to the [Ord.compare] ordering), or raise
134 | [Not_found] if the set is empty. *)
135 |
136 | val max_elt : 'elt t -> 'elt
137 | (** Same as {!Set.S.min_elt}, but returns the largest element of the
138 | given set. *)
139 |
140 | val choose : 'elt t -> 'elt
141 | (** Return one element of the given set, or raise [Not_found] if
142 | the set is empty. Which element is chosen is unspecified,
143 | but equal elements will be chosen for equal sets. *)
144 |
145 | val split : 'elt -> 'elt t -> 'elt t * bool * 'elt t
146 | (** [split x s] returns a triple [(l, present, r)], where
147 | [l] is the set of elements of [s] that are
148 | strictly less than [x];
149 | [r] is the set of elements of [s] that are
150 | strictly greater than [x];
151 | [present] is [false] if [s] contains no element equal to [x],
152 | or [true] if [s] contains an element equal to [x]. *)
153 |
154 | val of_list : 'elt list -> 'elt t
155 | (*
156 | end
157 | (** Output signature of the functor {!Set.Make}. *)
158 |
159 | module Make (Ord : OrderedType) : S with type elt = Ord.t
160 | (** Functor building an implementation of the set structure
161 | given a totally ordered type. *)
162 | *)
163 |
164 | (* Pretty-print a set as e.g. {1, 2, 3} *)
165 | val pp :
166 | (Format.formatter -> 'elt -> unit) -> Format.formatter -> 'elt t -> unit
167 |
--------------------------------------------------------------------------------
/games/Pong.ml:
--------------------------------------------------------------------------------
1 | open Playground
2 | open Basics (* float arithmetic operators by default *)
3 |
4 | (*****************************************************************************)
5 | (* Prelude *)
6 | (*****************************************************************************)
7 | (* Port of the Pong clone described at https://elm-lang.org/news/making-pong
8 | * but using OCaml instead of Elm, and using Playground instead of Collage.
9 | *
10 | * See https://en.wikipedia.org/wiki/Pong for more information on Pong.
11 | *
12 | * TODO:
13 | * - http://mathieu.agopian.info/blog/making-a-pong-game-in-elm.html (2019)
14 | * - https://github.com/einars/skapong ocaml one
15 | * - https://www.awesomeinc.org/tutorials/unity-pong/ unity! with
16 | * physics engine (friction, bounciness)
17 | * - https://en.scratch-wiki.info/wiki/Pong
18 | * - https://www.101computing.net/pong-tutorial-using-pygame-getting-started/
19 | *
20 | * TODO: extensions listed at the end of the making-pong blog post:
21 | * - dotted line mid field
22 | * - ability to pause the game
23 | * - ability to reset the game (menu somewhere? restart button between
24 | * the score)
25 | * - make ball collisions more complicated:
26 | * * when the ball hits the corner of a paddle, it changes direction
27 | * * if the ball hits a moving paddle, it adds spin to the ball, making it
28 | * rebound in a different direction
29 | * - add a second ball to the game
30 | * - write a simple AI for a paddle (easy but boring = AI that try to
31 | * stay at the same y than the ball; but could design less boring but
32 | * more fun AI too).
33 | *)
34 |
35 | (*****************************************************************************)
36 | (* Model *)
37 | (*****************************************************************************)
38 |
39 | (* was time in Pong.elm, but playground defines time as Time of posix *)
40 | type delta = float
41 |
42 | type obj = {
43 | x: number;
44 | y: number;
45 | vx: number;
46 | vy: number;
47 | }
48 |
49 | type ball = obj
50 |
51 | type player = {
52 | obj: obj;
53 | score: int;
54 | }
55 | let player x =
56 | { obj = { (* should remain constant *)
57 | x;
58 | y = 0.;
59 | (* will remain 0 *)
60 | vx = 0.;
61 | vy = 0. };
62 | score = 0 }
63 |
64 | type state = Play | Pause
65 |
66 | type game = {
67 | state: state;
68 | ball: ball;
69 | player1: player;
70 | player2: player;
71 | }
72 |
73 | (* coupling: with Playground.initial_computer.screen at 600 x 600 *)
74 | let (game_width, game_height) = (600., 400.)
75 | let (half_width, half_height) = (300., 200.)
76 |
77 | (* This means that in 1 second, the object will move 200 pixels.
78 | * note: was duplicated many times in the blog post, better to factorize.
79 | * note that this is both the velocity of the ball and the paddle, so the
80 | * paddle can not move faster than the ball :)
81 | *)
82 | let default_velocity = 200.
83 |
84 | let default_game = {
85 | state = Pause;
86 | ball = { x = 0.; y = 0.; vx = default_velocity; vy = default_velocity };
87 | (* player1 is on the left, player2 on the right *)
88 | player1 = player (-. half_width + 20.);
89 | player2 = player ( half_width - 20.);
90 | }
91 |
92 | (*****************************************************************************)
93 | (* View *)
94 | (*****************************************************************************)
95 | let pong_green = Color.Rgb (60, 100, 60)
96 | let text_green = Color.Rgb (160, 200, 160)
97 |
98 | let msg = "SPACE to start, w/s and up/down to move"
99 |
100 | let display_obj obj shape =
101 | shape |> move (obj.x) (obj.y)
102 |
103 | let view _computer (game, _last_tick) =
104 | [ rectangle pong_green game_width game_height;
105 |
106 | display_obj game.ball (oval white 15. 15.);
107 |
108 | display_obj game.player1.obj (rectangle white 10. 40.);
109 | display_obj game.player2.obj (rectangle white 10. 40.);
110 |
111 | (let s = Printf.sprintf "%d %d" game.player1.score game.player2.score in
112 | words text_green s |> scale 10. |> move 0. (game_height / 2. - 40.));
113 |
114 | (let s = if game.state = Play then "" else msg in
115 | words text_green s |> scale 2. |> move 0. (40. - game_height / 2.));
116 | ]
117 |
118 | (*****************************************************************************)
119 | (* Update *)
120 | (*****************************************************************************)
121 | (* are n and m near each other, specifically are they within c of each other *)
122 | let near n c m =
123 | m >= n - c && m <= n + c
124 |
125 | (* Is the ball within a paddle?
126 | * coupling: 8 is (a little more than) half of oval width (15) of the ball
127 | * and 20 is half the height of the player paddle (40)
128 | *)
129 | let (within: ball -> player -> bool) = fun ball player ->
130 | near player.obj.x 8. ball.x &&
131 | near player.obj.y 20. ball.y
132 |
133 | (* change the direction of a velocity (vx, or vy) based on collisions *)
134 | let (step_v: number -> bool -> bool -> number) =
135 | fun v lower_collision upper_collision ->
136 | match () with
137 | (* bottom or left collision *)
138 | | _ when lower_collision -> abs_float v
139 | (* top or right collision *)
140 | | _ when upper_collision -> -. (abs_float v)
141 | | _ -> v
142 |
143 | let (step_obj: delta -> obj -> obj) = fun t ({ x; y; vx; vy} as obj) ->
144 | { obj with x = x + vx * t; y = y + vy * t }
145 |
146 | (* move a ball forward, detecting collisions with either paddle *)
147 | let (step_ball: delta -> ball -> player -> player -> ball) =
148 | fun t ({x = _; y; vx; vy} as ball) player1 player2 ->
149 | (* put back at the center of the screen when reach player side *)
150 | if not (near 0. half_width ball.x)
151 | then { ball with x = 0.; y = 0. }
152 | else
153 | step_obj t { ball with
154 | vx = step_v vx (within ball player1) (within ball player2);
155 | (* coupling: 7. =~ half size of ball *)
156 | vy = step_v vy (y < -. half_height + 7.) (y > half_height - 7.);
157 | }
158 |
159 | (* step a player forward, making sure it does not fly off the screen *)
160 | let (step_player: delta -> number -> int -> player -> player) =
161 | fun t dir points player ->
162 | let obj' =
163 | (* bugfix: vy here! not vx *)
164 | step_obj t { player.obj with vy = dir * default_velocity } in
165 | let y' = Basics.clamp (-. half_height + 22.) (half_height - 22.) obj'.y in
166 | let score' = player.score +.. points in
167 | { obj = { obj' with y = y'}; score = score' }
168 |
169 | type input = {
170 | space: bool;
171 |
172 | (* -1, 0, 1 *)
173 | paddle1: number;
174 | paddle2: number;
175 |
176 | delta: delta;
177 | }
178 |
179 | let input_of_computer computer =
180 | let kbd = computer.keyboard in
181 | { space = kbd.kspace;
182 | (* bugfix: player2 is on the right, so the arrows or for player2 *)
183 | paddle1 = to_y2 kbd;
184 | paddle2 = to_y kbd;
185 | delta = 0.;
186 | }
187 |
188 | let (step_game: input -> game -> game) = fun input game ->
189 | let { space; paddle1; paddle2; delta} = input in
190 | let {state; ball; player1; player2} = game in
191 |
192 | (* ball on the right of player2 => score for player 1 *)
193 | let score1 = if ball.x > half_width then 1 else 0 in
194 | (* ball on left of player1 => score for player 2 *)
195 | let score2 = if ball.x < -. half_width then 1 else 0 in
196 |
197 | let state' =
198 | match () with
199 | | _ when space -> Play
200 | | _ when score1 <> score2 -> Pause
201 | | _ -> state
202 | in
203 | let ball' =
204 | if state = Pause
205 | then ball
206 | else step_ball delta ball player1 player2
207 | in
208 | let player1' = step_player delta paddle1 score1 player1 in
209 | let player2' = step_player delta paddle2 score2 player2 in
210 | { state = state'; ball = ball'; player1 = player1'; player2 = player2' }
211 |
212 | let update computer (game, last_tick) =
213 | let input = input_of_computer computer in
214 | let (Time now) = computer.time in
215 | let delta = now - last_tick in
216 | let game' = step_game { input with delta } game in
217 | game', now
218 |
219 | (*****************************************************************************)
220 | (* Entry point *)
221 | (*****************************************************************************)
222 |
223 | let app =
224 | game view update (default_game, Unix.gettimeofday())
225 |
226 | let main =
227 | Playground_platform.run_app app
228 |
--------------------------------------------------------------------------------
/docs/elm_system/Sub/index.html:
--------------------------------------------------------------------------------
1 |
2 | Module Sub
type 'msg onesub = | SubTick of Time.posix -> 'msg| SubMouseMove of (float * float) -> 'msg| SubMouseDown of unit -> 'msg| SubMouseUp of unit -> 'msg| SubKeyDown of Keyboard.key -> 'msg| SubKeyUp of Keyboard.key -> 'msg
type 'msg t = 'msg onesub listval on_animation_frame : (Time.posix -> 'msg) -> 'msg tval on_mouse_move : ((float * float) -> 'msg) -> 'msg tval on_mouse_down : (unit -> 'msg) -> 'msg tval on_mouse_up : (unit -> 'msg) -> 'msg tval on_key_down : (Keyboard.key -> 'msg) -> 'msg tval on_key_up : (Keyboard.key -> 'msg) -> 'msg ttype event = | ETick of float| EMouseMove of int * int| EMouseButton of bool| EKeyChanged of bool * Keyboard.key