├── docs └── image │ ├── d.svg │ ├── d_flipped.svg │ ├── d_tossed.svg │ ├── d_turned.svg │ ├── d_above_b.svg │ ├── d_beside_b.svg │ ├── d_over_b.svg │ ├── d_quartet.svg │ ├── fish.svg │ └── escher0.svg ├── LICENSE ├── README.md └── geometry.pl /docs/image/d.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_flipped.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_tossed.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_turned.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_above_b.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_beside_b.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_over_b.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/image/d_quartet.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020 Fifth Postulate 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Functional Geometry in Prolog 2 | This project contains an exploration of the ideas found in the paper ["Functional Geometry"][henderson] by Peter Henderson, transposed to Prolog. 3 | 4 | ## Functional Geometry 5 | I learned about the paper and it's contents in a workshop by [Einar Høst][host] called: [Escher in Elm][escher-in-elm]. 6 | 7 | It is a wonderfull workshop that clearly explains the ideas of functional geometry. I.e. 8 | 9 | > that one could write an algebraic description, embed it in a functional program, and execute it directly 10 | 11 | ## Prolog 12 | These ideas can be expressed in various other languages as Einar Høst and others have shown. Examples include [F#][f#], [PostScript][postscript] and [Rust][rust]. 13 | 14 | This repository explores the ideas in [Prolog][swi-prolog]. 15 | 16 | Prolog seems well-suited to express the ideas of functional geometry. 17 | 18 | ## Usage 19 | Start SWI-Prolog and load the `geometry.pl` file with the following command. 20 | 21 | ```sh 22 | swipl geometry.pl 23 | ``` 24 | 25 | At the query prompt enter the following query. 26 | 27 | ```prolog 28 | escher(2, C), processTo('output.svg', C). 29 | ``` 30 | 31 | Where `output.svg` is the file you want to write the result to. 32 | 33 | Eschers level 2 Square Limit by Prolog 34 | 35 | [henderson]: https://eprints.soton.ac.uk/257577/1/funcgeo2.pdf 36 | [host]: https://twitter.com/einarwh 37 | [escher-in-elm]: https://github.com/einarwh/escher-workshop 38 | [postscript]: https://www.lambdadays.org/lambdadays2020/einar-host 39 | [f#]: https://www.lambdadays.org/lambdadays2018/einar-host 40 | [rust]: https://github.com/fifth-postulate/esche.rs 41 | [swi-prolog]: https://www.swi-prolog.org/ 42 | -------------------------------------------------------------------------------- /docs/image/fish.svg: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /geometry.pl: -------------------------------------------------------------------------------- 1 | /** # Functional Geometry 2 | 3 | The classic paper by Peter Henderson "Functional Geometry" explains how to create an algebra 4 | than can describe complex objects and shows how to use that to render Escher's Square Limit. 5 | 6 | This file will explore the concept in the context of Prolog. 7 | 8 | @author Daan van Berkel 9 | */ 10 | 11 | /* `procesTo` allows one to write out the resulting SVG to a file. 12 | 13 | Use it like 14 | 15 | ``` 16 | escher(2, C), processTo('output.svg', C). 17 | ``` 18 | */ 19 | processTo(Name, Complex) :- 20 | open(Name, write, Output), 21 | current_output(StandardOutput), 22 | set_output(Output), 23 | defaultBox(Box), 24 | defaultBound(Bound), 25 | render(Complex, Box, Rendering), 26 | phrase(paint(Bound, Rendering), Svg), 27 | format("~s", [Svg]), 28 | close(Output), 29 | set_output(StandardOutput). 30 | 31 | /* ## Stamp 32 | Eschers Square Limit is produced by stamping a base image. Here we define what it is. 33 | */ 34 | stamp(fish). 35 | 36 | 37 | /* ## Algebraic Terms 38 | Below we will describe the terms that we will use to describe complex pictures. They are 39 | divided in the following classes. 40 | 41 | ### Fundamental Terms 42 | These fundamental terms are the building blocks for more complex terms. See `box` for more 43 | information on that subject. 44 | 45 | * `scaleX(F, T)`, Scales the box horizontally by a factor of `F` and places `T` in that box. 46 | * `scaleY(F, T)`, Similar to `scaleX`, but scales vertically. 47 | * `moveX(F, T)`, Moves the box horizontally by an amount of `F` times the `b` vector of the box. 48 | * `moveY(F, T)`, Similar to `scaleY, but moves vertically. 49 | * `turn(T)`, rotates `T` counter-clockwise by 90 degrees in it's box. 50 | * `flip(T)`, flips `T` left to right in it's box. 51 | * `toss(T)`, tosses `T`, for a full description see the Functional Geometry paper. 52 | * `over(U, V)`, places `V` atop of `U` in the same box. 53 | 54 | ### Complex Terms 55 | The following complex terms all defined in terms of fundamental terms, and themselves. 56 | For a discription see the Functional Geometry paper. 57 | 58 | For each of these the terms, the last argument is the result of term. E.g. 59 | 60 | ``` 61 | above(d, d, C). 62 | ``` 63 | 64 | will unify `C` with `over(moveY(0.5, scaleY(0.5, d)), scaleY(0.5, d))`. 65 | 66 | * `escher(N, C)` 67 | * `corner(N, C)` 68 | * `side(N, C)` 69 | * `utile(C)` 70 | * `ttile(C)` 71 | * `nonet(P, Q, R, S, T, U, V, W, X, C)` 72 | * `quartet(U, V, W, X, C)` 73 | * `column(P, Q, R, C)` 74 | * `row(P, Q, R, C)` 75 | * `aboveRatio(M, N, U, V, C) 76 | * `besideRatio(M, N, U, V, C) 77 | * `above(U, V, C)` 78 | * `beside(U, V, C)` 79 | */ 80 | 81 | escher(N, C) :- 82 | corner(N, P), 83 | side(N, Q), 84 | utile(T), 85 | nonet(P, Q, turn(turn(turn(P))), 86 | turn(Q), T, turn(turn(turn(Q))), 87 | turn(P), turn(turn(Q)), turn(turn(P)), 88 | C). 89 | 90 | corner(0, C) :- 91 | utile(X), 92 | quartet(blank, blank, blank, X, C). 93 | corner(N, C) :- 94 | succ(M, N), 95 | corner(M, U), 96 | side(M, V), 97 | utile(X), 98 | quartet(U, V, turn(V), X, C). 99 | 100 | side(0, C) :- 101 | ttile(W), 102 | quartet(blank, blank, turn(W), W, C). 103 | side(N, C) :- 104 | succ(M, N), 105 | side(M, U), 106 | ttile(W), 107 | quartet(U, U, turn(W), W, C). 108 | 109 | utile(over(over(V, turn(turn(turn(V)))), over(turn(turn(V)), turn(V)))) :- 110 | stamp(U), 111 | V = flip(toss(U)). 112 | 113 | ttile(over(Stamp, over(U, turn(turn(turn(U)))))) :- 114 | stamp(Stamp), 115 | U=flip(toss(Stamp)). 116 | 117 | nonet(P, Q, R, S, T, U, V, W, X, C) :- 118 | column(P, S, V, Left), 119 | column(Q, T, W, Middle), 120 | column(R, U, X, Right), 121 | row(Left, Middle, Right, C). 122 | 123 | column(P, Q, R, PQR) :- 124 | above(Q, R, QR), 125 | aboveRatio(1, 2, P, QR, PQR). 126 | 127 | row(P, Q, R, PQR) :- 128 | beside(Q, R, QR), 129 | besideRatio(1, 2, P, QR, PQR). 130 | 131 | quartet(S, T, U, V, C) :- 132 | above(S, U, L), 133 | above(T, V, R), 134 | beside(L, R, C). 135 | 136 | above(U, V, C) :- 137 | aboveRatio(1, 1, U, V, C). 138 | 139 | beside(U, V, C) :- 140 | besideRatio(1, 1, U, V, C). 141 | 142 | aboveRatio(M, N, U, V, over(S, T)) :- 143 | F1 is float(M) / float(M+N), 144 | F2 is 1.0-F1, 145 | S = moveY(F2, scaleY(F1, U)), 146 | T = scaleY(F2, V). 147 | 148 | besideRatio(M, N, U, V, over(S, T)) :- 149 | F1 is float(M) / float(M+N), 150 | F2 is 1.0-F1, 151 | S = scaleX(F1, U), 152 | T = moveX(F1, scaleX(F2, V)). 153 | 154 | /* ## Box 155 | A box is a coordinate system of the infinite canvas to wich shapes are painted on. 156 | It is a term `box(A, B, C)`, where the `A`, `B` and `C` are 2 dimensional vectors. 157 | */ 158 | 159 | defaultBox(box(vec(50.0, 50.0), vec(400.0, 0), vec(0.0, 400.0))). 160 | unitBox(box(vec(0.0, 0.0), vec(1.0, 0.0), vec(0.0, 1.0))). 161 | 162 | /* ## Rendering 163 | A rendering is a list of drawing instructions. 164 | 165 | Given a description of a scene, a box to paint it in, `render` will a rendering. 166 | */ 167 | 168 | render(scaleX(F, T), box(A, B, C), Result) :- 169 | scale(F, B, B_), 170 | render(T, box(A, B_, C), Result). 171 | 172 | render(scaleY(F, T), box(A, B, C), Result) :- 173 | scale(F, C, C_), 174 | render(T, box(A, B, C_), Result). 175 | 176 | render(moveX(F, T), box(A, B, C), Result) :- 177 | scale(F, B, B_), 178 | add(A, B_, A_), 179 | render(T, box(A_, B, C), Result). 180 | 181 | render(moveY(F, T), box(A, B, C), Result) :- 182 | scale(F, C, C_), 183 | add(A, C_, A_), 184 | render(T, box(A_, B, C), Result). 185 | 186 | render(turn(T), box(A, B, C), Result) :- 187 | add(A, B, A_), 188 | negate(B, C_), 189 | render(T, box(A_, C, C_), Result). 190 | 191 | render(flip(T), box(A, B, C), Result) :- 192 | add(A, B, A_), 193 | negate(B, B_), 194 | render(T, box(A_, B_, C), Result). 195 | 196 | render(toss(T), box(A, B, C), Result) :- 197 | add(B, C, BC), 198 | scale(0.5, BC, B_), 199 | add(A, B_, A_), 200 | subtract(C, B, CB), 201 | scale(0.5, CB, C_), 202 | render(T, box(A_, B_, C_), Result). 203 | 204 | render(over(U, V), Box, Result) :- 205 | render(U, Box, UResult), 206 | render(V, Box, VResult), 207 | append(UResult, VResult, Result). 208 | 209 | render(Shape, Box, Result) :- 210 | shape(Shape, DrawingPrimitives), 211 | fit(DrawingPrimitives, Box, Result). 212 | 213 | /* ## Vector Algebra 214 | Vectors are an other term `vec(X, Y)` and represent a point in the coordinate system. 215 | 216 | These clauses help in doing vector algebra. 217 | */ 218 | 219 | add(vec(Ax, Ay), vec(Bx, By), vec(Cx, Cy)) :- 220 | Cx is Ax + Bx, 221 | Cy is Ay + By. 222 | 223 | subtract(vec(Ax, Ay), vec(Bx, By), vec(Cx, Cy)) :- 224 | Cx is Ax - Bx, 225 | Cy is Ay - By. 226 | 227 | negate(vec(Ax, Ay), vec(Cx, Cy)) :- 228 | Cx is -Ax, 229 | Cy is -Ay. 230 | 231 | rotate90(vec(Ax, Ay), vec(Cx, Cy)) :- 232 | Cx is -Ay, 233 | Cy is Ax. 234 | 235 | scale(F, vec(Ax, Ay), vec(Cx, Cy)) :- 236 | Cx is F * Ax, 237 | Cy is F * Ay. 238 | 239 | /* ## Fit 240 | `fit` transform the drawing primitives to fit in the box. 241 | */ 242 | 243 | fit(DrawingPrimitives, Box, Result) :- fit(DrawingPrimitives, Box, [], Result). 244 | 245 | fit([], _, Result, Result). 246 | fit([polygon(Points)|Rest], Box, Accumulator, Result) :- 247 | transform(Points, Box, TransformedPoints), 248 | fit(Rest, Box, [polygon(TransformedPoints)|Accumulator], Result). 249 | fit([curve(Points)|Rest], Box, Accumulator, Result) :- 250 | transform(Points, Box, TransformedPoints), 251 | fit(Rest, Box, [curve(TransformedPoints)|Accumulator], Result). 252 | 253 | transform([], _, []). 254 | transform([P|Rest], Box, [Q|TransformedRest]) :- 255 | transform(P, Box, Q), 256 | transform(Rest, Box, TransformedRest). 257 | 258 | transform(U, box(A, B, C), W) :- 259 | U = vec(X, Y), 260 | scale(X, B, B_), 261 | scale(Y, C, C_), 262 | add(A, B_, V), 263 | add(V, C_, W). 264 | 265 | /* ## Shape 266 | 267 | * `blank` represents no picture 268 | * `fish` Escher fish. 269 | * `d` represents the letter d. It is a-symmetric so operations on it are clearly visible. 270 | * 'l' a stick-L used to see box transformation. 271 | */ 272 | 273 | shape(blank, []). 274 | shape(d, 275 | [ polygon([vec(0.3, 0.2), vec(0.3, 0.5), vec(0.4, 0.6), vec(0.6, 0.6), vec(0.6, 0.9), vec(0.7, 0.9), vec(0.7, 0.1), vec(0.4, 0.1)]) 276 | , polygon([vec(0.40, 0.24), vec(0.40, 0.46), vec(0.44, 0.50), vec(0.60, 0.50), vec(0.60, 0.20), vec(0.44, 0.20)])]). 277 | shape(fish, 278 | [ curve([ 279 | vec(0.116, 0.702), 280 | vec(0.260, 0.295), 281 | vec(0.330, 0.258), 282 | vec(0.815, 0.078) 283 | ]), 284 | curve([ 285 | vec(0.564, 0.032), 286 | vec(0.730, 0.056), 287 | vec(0.834, 0.042), 288 | vec(1.000, 0.000) 289 | ]), 290 | curve([ 291 | vec(0.250, 0.250), 292 | vec(0.372, 0.194), 293 | vec(0.452, 0.132), 294 | vec(0.564, 0.032) 295 | ]), 296 | curve([ 297 | vec(0.000, 0.000), 298 | vec(0.110, 0.110), 299 | vec(0.175, 0.175), 300 | vec(0.250, 0.250) 301 | ]), 302 | curve([ 303 | vec(-0.250, 0.250), 304 | vec(-0.150, 0.150), 305 | vec(-0.090, 0.090), 306 | vec(0.000, 0.000) 307 | ]), 308 | curve([ 309 | vec(-0.250, 0.250), 310 | vec(-0.194, 0.372), 311 | vec(-0.132, 0.452), 312 | vec(-0.032, 0.564) 313 | ]), 314 | curve([ 315 | vec(-0.032, 0.564), 316 | vec(0.055, 0.355), 317 | vec(0.080, 0.330), 318 | vec(0.250, 0.250) 319 | ]), 320 | curve([ 321 | vec(-0.032, 0.564), 322 | vec(-0.056, 0.730), 323 | vec(-0.042, 0.834), 324 | vec(0.000, 1.000) 325 | ]), 326 | curve([ 327 | vec(0.000, 1.000), 328 | vec(0.104, 0.938), 329 | vec(0.163, 0.893), 330 | vec(0.234, 0.798) 331 | ]), 332 | curve([ 333 | vec(0.234, 0.798), 334 | vec(0.368, 0.650), 335 | vec(0.232, 0.540), 336 | vec(0.377, 0.377) 337 | ]), 338 | curve([ 339 | vec(0.377, 0.377), 340 | vec(0.400, 0.350), 341 | vec(0.450, 0.300), 342 | vec(0.500, 0.250) 343 | ]), 344 | curve([ 345 | vec(0.500, 0.250), 346 | vec(0.589, 0.217), 347 | vec(0.660, 0.208), 348 | vec(0.766, 0.202) 349 | ]), 350 | curve([ 351 | vec(0.766, 0.202), 352 | vec(0.837, 0.107), 353 | vec(0.896, 0.062), 354 | vec(1.000, 0.000) 355 | ]), 356 | curve([ 357 | vec(0.234, 0.798), 358 | vec(0.340, 0.792), 359 | vec(0.411, 0.783), 360 | vec(0.500, 0.750) 361 | ]), 362 | curve([ 363 | vec(0.500, 0.750), 364 | vec(0.500, 0.625), 365 | vec(0.500, 0.575), 366 | vec(0.500, 0.500) 367 | ]), 368 | curve([ 369 | vec(0.500, 0.500), 370 | vec(0.460, 0.460), 371 | vec(0.410, 0.410), 372 | vec(0.377, 0.377) 373 | ]), 374 | curve([ 375 | vec(0.315, 0.710), 376 | vec(0.378, 0.732), 377 | vec(0.426, 0.726), 378 | vec(0.487, 0.692) 379 | ]), 380 | curve([ 381 | vec(0.340, 0.605), 382 | vec(0.400, 0.642), 383 | vec(0.435, 0.647), 384 | vec(0.489, 0.626) 385 | ]), 386 | curve([ 387 | vec(0.348, 0.502), 388 | vec(0.400, 0.564), 389 | vec(0.422, 0.568), 390 | vec(0.489, 0.563) 391 | ]), 392 | curve([ 393 | vec(0.451, 0.418), 394 | vec(0.465, 0.400), 395 | vec(0.480, 0.385), 396 | vec(0.490, 0.381) 397 | ]), 398 | curve([ 399 | vec(0.421, 0.388), 400 | vec(0.440, 0.350), 401 | vec(0.455, 0.335), 402 | vec(0.492, 0.325) 403 | ]), 404 | curve([ 405 | vec(-0.170, 0.237), 406 | vec(-0.125, 0.355), 407 | vec(-0.065, 0.405), 408 | vec(0.002, 0.436) 409 | ]), 410 | curve([ 411 | vec(-0.121, 0.188), 412 | vec(-0.060, 0.300), 413 | vec(-0.030, 0.330), 414 | vec(0.040, 0.375) 415 | ]), 416 | curve([ 417 | vec(-0.058, 0.125), 418 | vec(-0.010, 0.240), 419 | vec(0.030, 0.280), 420 | vec(0.100, 0.321) 421 | ]), 422 | curve([ 423 | vec(-0.022, 0.063), 424 | vec(0.060, 0.200), 425 | vec(0.100, 0.240), 426 | vec(0.160, 0.282) 427 | ]), 428 | curve([ 429 | vec(0.053, 0.658), 430 | vec(0.075, 0.677), 431 | vec(0.085, 0.687), 432 | vec(0.098, 0.700) 433 | ]), 434 | curve([ 435 | vec(0.053, 0.658), 436 | vec(0.042, 0.710), 437 | vec(0.042, 0.760), 438 | vec(0.053, 0.819) 439 | ]), 440 | curve([ 441 | vec(0.053, 0.819), 442 | vec(0.085, 0.812), 443 | vec(0.092, 0.752), 444 | vec(0.098, 0.700) 445 | ]), 446 | curve([ 447 | vec(0.130, 0.718), 448 | vec(0.150, 0.730), 449 | vec(0.175, 0.745), 450 | vec(0.187, 0.752) 451 | ]), 452 | curve([ 453 | vec(0.130, 0.718), 454 | vec(0.110, 0.795), 455 | vec(0.110, 0.810), 456 | vec(0.112, 0.845) 457 | ]), 458 | curve([ 459 | vec(0.112, 0.845), 460 | vec(0.150, 0.805), 461 | vec(0.172, 0.780), 462 | vec(0.187, 0.752) 463 | ]) 464 | ]). 465 | 466 | /* ## Generate SVG 467 | Below is a Domain Specific Language (DSL) using Definite Clause Grammers (DCG) 468 | for a small subset of Scalable Vector Graphics (SVG). 469 | 470 | It can be used to create a codes string that describes the drawing primitives. 471 | */ 472 | 473 | defaultBound([500, 500]). 474 | 475 | paint(Bound, Content) --> 476 | svg(["viewbox"=viewbox(Bound)], [ 477 | group(["stroke"="black", "fill"="none", "transform"=transformation(Bound)], Content) 478 | ]). 479 | 480 | viewbox([Width, Height]) --> 481 | { number_string(Width, W), number_string(Height, H)}, 482 | "0 0 ", W, " ", H. 483 | 484 | transformation([_, Height]) --> 485 | {number_string(Height, H)}, 486 | "scale(1, -1) translate(0, -" , H, ")". 487 | 488 | svg(Attributes, Content) --> 489 | node("svg", ["xmlns"="http://www.w3.org/2000/svg"|Attributes], Content). 490 | 491 | group(Attributes, Content) --> 492 | node("g", Attributes, Content). 493 | 494 | svg_polygon(Points) --> 495 | tag("polygon", ["points"=points(Points)]). 496 | 497 | svg_curve(Points) --> 498 | tag("path", ["d"=path(Points)]). 499 | 500 | path([vec(Sx, Sy)|Points]) --> 501 | {number_string(Sx, X), number_string(Sy, Y)}, 502 | "M", X, ",", Y, "C", points(Points). 503 | 504 | points([]) --> 505 | "". 506 | 507 | points([vec(Px, Py)|Points]) --> 508 | {number_string(Px, X), number_string(Py, Y)}, 509 | " ", X, ",", Y, 510 | points(Points). 511 | 512 | node(Type, Attributes, Content) --> 513 | "<", Type, attributes(Attributes), ">", 514 | content(Content), 515 | "". 516 | 517 | attributes([]) --> 518 | "". 519 | 520 | attributes([Key=Value|Attributes]) --> 521 | " ", Key, "=""", Value, """", 522 | attributes(Attributes). 523 | 524 | content([]) --> 525 | "". 526 | 527 | content([polygon(Points)|Rest]) --> 528 | svg_polygon(Points), 529 | content(Rest). 530 | 531 | content([curve(Points)|Rest]) --> 532 | svg_curve(Points), 533 | content(Rest). 534 | 535 | content([Content|Rest]) --> 536 | Content, 537 | content(Rest). 538 | 539 | tag(Type, Attributes) --> 540 | "<", Type, attributes(Attributes), "/>". -------------------------------------------------------------------------------- /docs/image/escher0.svg: -------------------------------------------------------------------------------- 1 | --------------------------------------------------------------------------------