⍝ Turtle graphics:
⍝
⍝ NB: testing this script with option upper case 'V' displays the images:
⍝
⍝   'V'test'turtle'                         ⍝ view images: Esc to quit.

    :ReturnIf 1 0≡83 ⎕dr 256                ⍝ big-endian:

    tt←{⍺←⊢                                 ⍝ try turtle
        pts←('V'∊Alpha)↓'⌸'                 ⍝ ~'V'∊⍺: points only, no image
        chksum⌊0.5+⍺ turtle pts,⍵           ⍝ checksum of points
    }

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝ 2D turtle examples:
⍝ Escape (Esc) to close the graphics window.

    hilbert ←, ⊂'A' '-BF+AFA+FB-'           ⍝ Hilbert productions
    hilbert ,← ⊂'B' '+AF-BFB-FA+'           ⍝ (turtle ignores A and B)
    tt hilbert lsys⍣4 ⊢'A'                  ⍝ order-4 Hilbert curve
585648

    A60 ← 'A=↑1 B=↑1 +=⌽¯60 -=⌽60'          ⍝ A and B fwd; 60 degree turns

    koch ← 'A' 'A-A++A-A'                   ⍝ Koch curve production
    A60 tt koch lsys⍣3⊢'A++A++A'            ⍝ order-3 Koch curve
169411

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝

    :ReturnIf ~1∊'Vv'∊Alpha                 ⍝ not watching: save time

    peano ←, ⊂'A' 'AFBFA-F-BFAFB+F+AFBFA'   ⍝ Peano curve productions
    peano ,← ⊂'B' 'BFAFB+F+AFBFA-F-BFAFB'   ⍝ (turtle ignores A and B)
    tt peano lsys⍣3 ⊢'A'                    ⍝ order-3 Peano curve
529580

    dragon ←, ⊂'A' 'A+BF+'                  ⍝ Dragon curve productions
    dragon ,← ⊂'B' '-FA-B'                  ⍝ (turtle ignores A and B)
    tt dragon lsys⍣10 ⊢'FA'                 ⍝ order-10 Dragon curve
767677

    tt'⎕',('X' 'XFY+')('Y' 'FY')lsys⍣12⊢'X' ⍝ traced squiral
873548

    gosper ←, ⊂'A' 'A-B--B+A++AA+B-'        ⍝ Gosper curve productions
    gosper ,← ⊂'B' '+A-BB--B-A++A+B'        ⍝ (A and B are fwd 1)
    A60 tt gosper lsys⍣3 ⊢'A'               ⍝ order-3 Gosper curve
958083

    sierpinski ←, ⊂'A' '+B-A-B+'            ⍝ Sierpinski triangle productions
    sierpinski ,← ⊂'B' '-A+B+A-'            ⍝ (A and B are fwd 1)
    A60 tt sierpinski lsys⍣6 ⊢'A'           ⍝ order-6 Sierpinski curve
702288

    A30 ← 'A=↑1 B=↑1 +=⌽¯30 -=⌽30'          ⍝ A and B are fwd 1; 30° turns

    fern ←, ⊂'X' 'B-[[X]+X]+B[+BX]-X'       ⍝ Fractal plant
    fern ,← ⊂'B' 'BB'                       ⍝ (X is ignored)
    A30 tt fern lsys⍣3 ⊢'X'                 ⍝ order-3 fern
484820

    star←{                                  ⍝ ⍵-pointed star
        ⍺←⌊(⍵-1)÷2                          ⍝ winding number
        M←'F=↑1 T=⌽360÷',⍕⍵÷⍺               ⍝ macros
        P←'X' 'FTX'                         ⍝ production
        M tt P lsys⍣⍵⊢'X'                   ⍝ star drawing
    }

    stars←{(⍳⌊⍵÷2)star¨⍵}                   ⍝ all ⍵-stars

    stars 11                                ⍝ all 11-pointed stars
462785 471875 431132 433193 426821

⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝ 3D turtle examples:
⍝ Cursor keys ↑ ↓ ← → and keys z x to rotate.
⍝ Keys b and f to move image backwards and forwards.
⍝ Escape (Esc) to close the graphics window.

    hilb3 ← 'A' '∨×AF∨×AFA-F∨÷÷AFA∧F+÷÷AFA-F÷A-÷'
    tt¨ '' '⌹',¨⊂ hilb3 lsys⍣2 ⊢'A'         ⍝ order-2 3D Hilbert curve
464589 464589

⍝   Polyhedron      Schläfli    dihedral angle      approx
⍝   ---------       --------    --------------      ------
⍝   Tetrahedron     {3,3}       ¯2○÷3                70.53°
⍝   Cube            {4,3}        ○÷2                 90.00°
⍝   Octahedron      {3,4}       (○1)−¯2○÷3          109.47°
⍝   Dodecahedron    {5,3}       (○1)-¯3○2           116.56°
⍝   Icosahedron     {3,5}       (○1)-¯2○(5*0.5)÷3   138.19°
⍝
⍝   https://en.wikipedia.org/wiki/Table_of_polyhedron_dihedral_angles

    platonic←{⍺←''                                  ⍝ Platonic solids

        tetrahedron←{                               ⍝ Tetrahedron
            T←turn○÷6                               ⍝ 30° turn
            P←pitch ¯2○÷3*0.5                       ⍝ pitch
            S←'X' 'F++++[+∨F]X'                     ⍝ production
            (F,T,P)turtle ⍺,S lsys⍣3⊢'X'            ⍝ 3 turtle paths
        }

        cube←{                                      ⍝ Cube
            T←turn○÷2                               ⍝ 90° turn
            R←roll○÷2                               ⍝ roll
            S←'X' '[+FX×+F+F]'                      ⍝ production
            (F,T,R)turtle ⍺,S lsys⍣4⊢'X'            ⍝ 4 turtle paths
        }

        octahedron←{                                ⍝ Octahedron
            T←turn○÷4                               ⍝ 45° turn
            P←pitch○÷4                              ⍝ pitch
            S←'X' 'F++[+∧F][+∨F]X'                  ⍝ production
            (F,T,P)turtle ⍺,S lsys⍣4⊢'X'            ⍝ 4 turtle paths
        }

        dodecahedron←{                              ⍝ Dodecahedron
            T←turn○2÷5                              ⍝ 72° turn
            R←roll(○1)-¯3○2                         ⍝ roll
            S←'X' 'F[×+F+F[÷+F+F]+F]+X'             ⍝ production
            (F,T,R)turtle ⍺,S lsys⍣5⊢'X'            ⍝ 5 turtle paths
        }

        icosahedron←{                               ⍝ Icosahedron
            T←turn○÷3                               ⍝ 60° turn
            R←roll ¯2○(5*0.5)÷3                     ⍝ roll
            S←'X' '[F++F[---×+F-[-×+F×++F]-F]]+×X'  ⍝ production
            (F,T,R)turtle ⍺,S lsys⍣5⊢'X'            ⍝ 5 turtle paths
        }

            F←'F=↑1 '                               ⍝ forward 1 unit
         attd←{⍕(⍺⍺,¨⊂'=',⍵⍵),∘⍕¨⍵÷○÷180 ¯180}      ⍝ attitude change
         turn←'+-'attd'⌽'                           ⍝ left/right turn (radians)
         roll←'×÷'attd'⊖'                           ⍝ anti/clock roll
        pitch←'∧∨'attd'⍋'                           ⍝ up/down pitch

        turtle←⍺⍺                                   ⍝ (uses tt for test script)

        ⍵∊'Tt',33:⍺ tetrahedron ⍵                   ⍝ Schläfli: {3,3}
        ⍵∊'Cc',43:⍺ cube ⍵                          ⍝   ..      {4,3}
        ⍵∊'Oo',34:⍺ octahedron ⍵                    ⍝   ..      {3,4}
        ⍵∊'Dd',53:⍺ dodecahedron ⍵                  ⍝   ..      {5,3}
        ⍵∊'Ii',35:⍺ icosahedron ⍵                   ⍝   ..      {3,5}
    }

    '' '⌹' ∘.(tt platonic)'TCODI'                   ⍝ wire and anaglyph
121116 768030 504036 487883 894311
121116 768030 504036 487883 894311

⍝ The following function takes a vector of edge matrices and returns a vector of
⍝ face matrices. Using graph-searching techniques, it identifies and collects
⍝ the edges that constitute each face of the polyhedron:

    faces←{                                 ⍝ face polygons from edges

        faces←{                             ⍝ look for polygon faces
            pgns←⍺ holes ⍵                  ⍝ ⍺-holes in graph ⍵
            ~⍬≡(∊graph)~∊pgns:(⍺+1)∇ ⍵      ⍝ no luck: increase polygon size
            {↑(1+≢⍵)⍴↑⍵}¨pgns⌷¨¨⊂⊂verts     ⍝ polygon faces
        }

        holes←{                             ⍝ chordless (≤⍺)-cycles in graph ⍵
            spin←{(+/∧\⍵≠⌊/⍵)⌽⍵}            ⍝ rotation of lowest vertex to front
            flip←{{¯1⌽⌽⍵}⍣(</1 0 1/3↑¯1⌽⍵)⊢⍵}  ⍝ & ordering of adjacent vertices
            norm←flip∘spin                  ⍝ canonical orientation
            ⍺←≢⍵ ⋄ max←⍺                    ⍝ max cycle length
            ∪↑,/(⍳⍴⍵){                      ⍝ unique collected cycles
                max<≢⍺:⍬                    ⍝ path too long: quit
                nx←(⊃⌽⍺)⊃⍵                  ⍝ next vertices
                (⊃⍺)∊nx:⊂norm ⍺             ⍝ cycle: normalised orientation
                px←⍺∘,¨nx~⍺                 ⍝ extended paths
                gx←px{                      ⍝ reduced graphs
                    f t←¯2↑⍺                ⍝ latest from-to vertices
                    fm tm←f t≠⊂⍳⍴⍵          ⍝ from and to masks
                    (fm∧tm∨f≠⍵)/¨⍵          ⍝ graphs with removed edges
                }¨⊂⍵                        ⍝ unreduced graph
                ∪↑,/px ∇¨gx                 ⍝ unique cycles
            }¨⊂⍵                            ⍝ starting graph
        }

        rnd←{(10*-⍺)×⌊0.5+⍵×10*⍺}           ⍝ rounding to ⍺ decimal places
        edges←↓¨4 rnd ⍵                     ⍝ edges are vertex pairs
        verts←∪↑,/edges                     ⍝ vertices
        links←verts∘⍳¨edges                 ⍝ vertices per edge
        vids←⍳⍴verts                        ⍝ vertex ids
        masks←↓vids∘.∊links                 ⍝ edges per vertex
        graph←,∘↑¨(masks/¨⊂links)~¨¨vids    ⍝ graph of vertices
        3 faces graph                       ⍝ polyhedron faces
    }

    ⌊0.5+ '⌸' turtle platonic 'T'           ⍝ 6 edge lines of tetrahedron
┌─────────┬─────────┬─────────┬─────────┬──────────┬──────────┐
│22 ¯39 16│22 39  16│ 22 39 16│¯45 0  16│¯45   0 16│22 ¯39  16│
│22  39 16│ 0  0 ¯47│¯45  0 16│  0 0 ¯47│ 22 ¯39 16│ 0   0 ¯47│
└─────────┴─────────┴─────────┴─────────┴──────────┴──────────┘

    ⌊0.5+ faces '⌸' turtle platonic 'T'     ⍝ 4 face triangles of tetrahedron
┌──────────┬──────────┬───────────┬──────────┐
│22 ¯39  16│ 22 ¯39 16│ 22 ¯39  16│ 22 39  16│
│22  39  16│ 22  39 16│  0   0 ¯47│  0  0 ¯47│
│ 0   0 ¯47│¯45   0 16│¯45   0  16│¯45  0  16│
│22 ¯39  16│ 22 ¯39 16│ 22 ¯39  16│ 22 39  16│
└──────────┴──────────┴───────────┴──────────┘

⍝ We can display the faces with solid fill colours drawn in far-to-near order
⍝ so that the ones in front hide those behind.  The following little edits of
⍝ test's local copy of [turtle] do the trick.  Notice the call to  the  above
⍝ function [faces]:

    edit←{⎕fx ⍵ subs ⎕cr ⍺}                             ⍝ function editor

    'turtle' edit 'image lines' 'image faces lines'     ⍝ using face polygons
    'turtle' edit 'FCol' 'FillCol'   ⍝ ¯¯¯¯¯            ⍝ Fill colours
    'turtle' edit 'lwidth' 'fstyle'                     ⍝ property rename
    'turtle' edit '''Lwidth'' 4' '''FStyle'' 0'         ⍝ solid fill ...
    'turtle' edit '⍵×192' '240-⍵×80'                    ⍝ ... with light greys
    'turtle' edit 'greys depth' 'greys depth 1↓¨'       ⍝ without duplicated ...
    'turtle' edit '+/¨⊢/¨' '+/¨⊢/¨1↓¨'     ⍝ ¯¯¯        ⍝ ... vertices
                                ⍝ ¯¯¯
    tt platonic¨ 'TCODI'                                ⍝ solid polyhedra
121116 768030 504036 487883 894311

Back to: code

Back to: Workspaces