```turtle←{⎕ML←1                               ⍝ Flying-turtle graphics.

⍺←'F=↑1 +=⌽¯90 -=⌽90 ×=⊖¯90 ÷=⊖90 ∧=⍋¯90 ∨=⍋90'     ⍝ default definitions

cmds←{                                  ⍝ turtle commands from macro vector
segs←{(~⍵∊⍺)⊆⍵}                     ⍝ ⍺-separated segments of vector ⍵
trim←~∘(⊂'')                        ⍝ without null segments
names vals←↓⍉↑'='segs¨trim' 'segs ⍺ ⍝ defs ⍺ separated at '=' after ' '
pair←{(⊃⍵)rads⍎1↓⍵}                 ⍝ command and its numeric argument
fms tos←(∊names)(pair¨vals),¨⊂'[]'  ⍝ turtle commands dictionary
(⊂fms⍳⍵∩fms)⌷tos                    ⍝ turtle commands from macro vector
}                                       ⍝ [tcmd] ← defns ∇ [mcmd]

draw←{                                  ⍝ polygons from turtle commands

step←{cmd arg←⍺                     ⍝ one turtle command:
'↑'≡cmd:arg move ⍵              ⍝ ↑⍵ forward move
'⌽'≡cmd:arg turn ⍵              ⍝ ⌽⍵ right turn
'⊖'≡cmd:arg roll ⍵              ⍝ ⊖⍵ clockwise roll
'⍋'≡cmd:arg pitch ⍵             ⍝ ⍋⍵ upwards pitch
'['≡cmd:push ⍵                  ⍝ [  turtle state push
']'≡cmd:pop ⍵                   ⍝  ] turtle state pop
}                                   ⍝ :: state ← cmd ∇ state

move←{(path paths)attd stack←⍵      ⍝ forward ⍺ units
next←(⊃path)+⍺×⊃attd            ⍝ next position
((next path)paths)attd stack    ⍝ extended path
}                                   ⍝ :: state ← units ∇ state

paths(hnew bank)stack           ⍝ new state
}                                   ⍝ :: state ← rads ∇ state

}                                   ⍝ :: state ← rads ∇ state

paths attd stack                ⍝ new state
}                                   ⍝ :: state ← rads ∇ state

push←{points attd stack←⍵           ⍝ push turtle state
(posn path)paths←points         ⍝ current path and posn
points attd(posn attd stack)    ⍝ stacked posn and attitude
}                                   ⍝ :: state ← ∇ state

pop←{paths _(posn attd stack)←⍵     ⍝ pop turtle state
((posn ⍬)paths)attd stack       ⍝ new path at popped state
}                                   ⍝ :: state ← ∇ state

paths←((0 0 0)⍬)0                   ⍝ first point on first path
attd←(0 1 0)(0 0 1)                 ⍝ heading and banking
stack←0                             ⍝ null branching-stack
⊃⊃step/(⌽⍵),⊂paths attd stack       ⍝ list of polygon paths lists
}                                       ⍝ :: paths ← state ∇ cmds

rotn←{40 bits ⍵}{                       ⍝ ⍺-rotation of points ⍵
sax←2 1≡+/0 1∘.=|1↓⍺                ⍝ rotation around single axis?
sax:⍺ rot2 ⍵ ⋄ ⍺ rot3 ⍵             ⍝ quick 2D, or slower 3d, rotation
}                                       ⍝ :: pmat ← dirn ∇ pmat

rot2←{                                  ⍝ quicker 2D complex rotation
a u←(⊃⍺)(1↓⍺)                       ⍝ angle and direction
msk nsk←0 1=⊂|u                     ⍝ masks for rotation plane
dir←0 J⊃nsk/1 ¯1 1×u                ⍝ rotation direction ±0J1
R←{⍉↑9 11○⊂⍵}                       ⍝ real from complex array
new←msk\R(J/msk/⍵)×*a×dir           ⍝ new orientation via complex arith
new+nsk\nsk/⍵                       ⍝ rotated points
}                                       ⍝ :: pmat ← dirn ∇ pmat

rot3←{                                  ⍝ slower 3D quaternion rotation
a u←(⊃⍺)(1↓⍺)                       ⍝ angle and direction
C←{J/2 2⍴(⍤1)⍵}                     ⍝ complex (S,2) from real (S,4)
R←{,⍤2⊢9 11∘.(○⍨)⍨⍵}                ⍝ R 3J4 → 3 4  real parts
conj←↑((+⊣),(-⊢))/                  ⍝ H-conjugate +⍵ :: [H] ← ∇ [H]
q←C(2○a÷2),u×1○a÷2                  ⍝ rotation quaternion
0 1 1 1/R q mul(C 0,⍵)mul conj q    ⍝ q×⍵×q*
}                                       ⍝ :: pmat ← dirn ∇ pmat

mul←{                                   ⍝ quaternion product ⍺×⍵
(a b)(c d)←1⊂¨⍺ ⍵                   ⍝ Caley-Dixon
⊃,/((a×c)-b×+d)((d×a)+b×+c)         ⍝   construction
}                                       ⍝ :: [H] ← [H] ∇ [H]

J←{⍺+⍵×0J1}                             ⍝ 3 J 4 → 3J4
bits←{(2*-⍺)×⌊0.5+⍵×2*⍺}                ⍝ rounded to ⍺ bits

points←{                                ⍝ poly Points matrices from lists

lines←{                             ⍝ vector of lines from list of lists
matr←{((≢⍵)÷⍺)⍺⍴⍵}              ⍝ ⍺-column matrix from vector
vect←{0≡h t←⍵:⍺ ⋄ (⍺,⊂h)∇ t}    ⍝ vector from list
trim←{(1<≢¨⍵)/⍵}                ⍝ without single-point polygons
line←{↑¨⊃,/⍵}{2,/(⊂¨)⌽↓⍵}¨      ⍝ individual poly lines
line trim 3 matr∘∊¨⌽⍬ vect ⍵    ⍝ vector of raw polygon lines
}                                   ⍝ :: [pmat] ← ∇ List posn

centred←{                           ⍝ centred in window
pts←⊃⍪/⍵                        ⍝ collected points matrix
0∧.=⊢/pts:⍵-⍤1¨⊂÷∘2(⌈⌿+⌊⌿)pts   ⍝ 2D: envelope centred
⍵-⍤1¨⊂pts⌹(≢pts)⍴1              ⍝ 3D: mid point centred
}                                   ⍝ :: [pmat] ← ∇ [pmat]

stretched←{                         ⍝ stretched to fit ⍺% of window
pts←⊃⍪/⍵                        ⍝ collected points matrix
0∧.=⊢/pts:⍵×⍺÷⌈/(⌈⌿-⌊⌿)pts      ⍝ 2D: size of enclosing square
⍵×⍺÷⌈/(+/(pts×2)*2)*0.5         ⍝ 3D: diameter of enclosing sphere
}                                   ⍝ :: [pmat] ← % ∇ [pmat]

⍺ stretched centred lines ⍵         ⍝ image adjusted to fit window
}                                       ⍝ :: [pmat] ← % ∇ List posn

image←{                                 ⍝ display of turtle path

poly←{                              ⍝ polygon object
pps←'Sizeable' 'Moveable' 'SysMenu' 'MaxButton' 'MinButton' 'Border'
f←⎕NEW'Form'({⍵ 0}¨pps)         ⍝ borderless containing-form
f.(Posn Size)←⍵                 ⍝ form placement: screen top right
f.Coord←'Pixel'                 ⍝ change prop
f.(Size←2/720⌊⌈/Size)           ⍝ make form square, max 720 pixels
f.Coord←'User'                  ⍝ restore proportional coords
f.onKeyPress←'twist'            ⍝ image-rotation callback
a←f.⎕NEW⊂'Static'               ⍝ white backdrop
a.(YRange XRange)←1 ¯1×⊂50 ¯50  ⍝ +/- 50 square
a.(Posn Size)←(0 0)(100 100)    ⍝ occupies whole form
points←'Points'(0 2⍴0)          ⍝ initially 0-sided polygon
lwidth←'Lwidth' 4               ⍝ slightly thicker lines
a.⎕NEW'Poly'(points lwidth)     ⍝ polygon object
}                                   ⍝ :: Static ← ∇ Posn Size

twist←(○÷¯180÷5){form msg key←3↑⍵   ⍝ 5° image-rotation callback
key≡'EP':⎕NQ form'Close'        ⍝ callback: Esc to quit
D=2:                            ⍝ 2D: no twisting or zooming
put←{pp.(Points FCol)←colour ⍺} ⍝ visible 2D projection
zoom←{PNTS put Z∘←50⌊Z+⍵×10}    ⍝ zoom ±10 units                 !!!
|z←('bf'⍳⊂key)⊃¯1 1 0:zoom z    ⍝ b:backwards f:forwards
keys←('UDLR',¨'C'),'zx'         ⍝ ijk-rotation keys
dirs←2/=∘⊂⍨⍳3                   ⍝ directions 1 0 0, 0 1 0, 0 0 1
0≡dirn←(keys⍳⊂key)⊃dirs,0:      ⍝ chosen direction ignoring bad key
PNTS put PNTS rot2¨⍨←⊂rads,dirn ⍝ display of updated 3D points   !!!
}                                   ⍝ :: Form ∇ msg

colour←{                            ⍝ coloured, orientated lines
proj←{⌽¨2↑⍤1¨pers ⍵}            ⍝ projection onto x-y plane
pers←{⍵×⍤1 0¨0.998*⊢/¨⍵-Z-50}   ⍝ hint of perspective
D=2:(proj ⍵)(0 0 0∘⊣¨⍵)         ⍝ 2D: all black lines
depth←(⊢-⌊/)((+⌿÷≢)⊢/)¨         ⍝ depth of line mid-points
greys←{3⍴¨⌊⍵×192÷⌈/⍵}           ⍝ grey lines: 0 to 192, near to far
~'⌹'∊S:(proj ⍵)(greys depth ⍵)  ⍝ mono: lines and grey shades
sepr←{(⊂¨yrot 7÷60)rot2¨¨⊂⍵}    ⍝ 7cm @ 60cm separation of images
yrot←{(¯3○⍵÷¯2 2),¨⊂0 1 0}      ⍝ rotations around y-axis
zoom←{⍵-⍤1¨⊂¯3↑⍺}               ⍝ zoomed in by ⍺ units
pnts←(-Z)zoom¨sepr Z zoom ⍵     ⍝ separated anaglyph-3D images
clrs←(0 255 255)(255 0 0)       ⍝ left and right colours
,∘↑¨(proj¨pnts)(pnts⊢¨∘⊂¨clrs)  ⍝ points and colours
}{                                  ⍝ :: [pnts] [colr] ← [mcmd] ∇ [pmat]
(⊂⍒+/¨⊢/¨⍵)⌷⍵                   ⍝ sorted far to near, unless tracing
}⍣(~'⎕'∊S)                          ⍝ :: [pmat] ← ∇ [pmat]

put←{pp.(FCol Points FCol)←(⊂⊂⍬),⍵} ⍝ rendering of polygon points
tcput←put⍨∘⎕DL∘(5÷≢⍵)               ⍝ puts spread over 5s if tracing
trace←{tcput∘{↓⍉↑,⍵}¨,\⊂¨↓⍉↑⍵}      ⍝ show turtle progress

D←3-0∧.=⊢/↑⍪/PNTS←⍵                 ⍝ image points and rank: 2 or 3D
Z←50                                ⍝ zoom distance for 3D anaglyph
pp←poly(1 50)(50 50)                ⍝ polygon in (top right) window
0⊣trace∘colour⍣('⎕'∊S)⊢⍵:           ⍝ optional display of progress
0⊣put colour ⍵:                     ⍝ poly lines and colours
PNTS⊣⎕DQ pp.##.##                   ⍝ ... until Esc to quit
}                                       ⍝ :: [pmat] ← trace ∇ [pmat]

S←'⎕⌹⌸'∩⍵                               ⍝ behaviour switches
lines←95 points draw ⍺ cmds ⍵~S         ⍝ vector of polygon lines
'⌸'∊S:lines                             ⍝ ⌸: points only, no display
1:PNTS←image lines                      ⍝ display of turtle path

⍝ state     :=  paths attd stack        ⍝ drawing state
⍝   paths   :=  List path               ⍝ list of polygon paths
⍝     path  :=  List posn               ⍝ list of point positions
⍝   attd    :=  head bank               ⍝ turtle attitude
⍝     bank  :=  dirn                    ⍝ banking: normal to heading
⍝   stack   :=  posn attd stack         ⍝ coordinates stack for branching
⍝ posn      :=  # # #                   ⍝ position in 3-space
⍝ dirn      :=  # # #                   ⍝ unit vector: direction in 3-space
⍝ dist      :=  #                       ⍝ scalar distance between points
⍝ colr      :=  # # #                   ⍝ colour: red green blue: 0-255
⍝ pmat      :=  [;# # #]                ⍝ n×3 positions matrix
⍝ pnts      :=  [;# #]                  ⍝ n×2 2D projection
⍝ List ⍵    :=  ⍵ (List ⍵) | 0          ⍝ 0-terminated cons list of ⍵s
⍝ cmds      :=  [tcmd arg | scmd]       ⍝ turtle commands vector
⍝ tcmd      :=  '↑' | '⌽' | '⊖' | '⍋'   ⍝ cmds: forward turn roll pitch
⍝   arg     :=  dist | rads             ⍝ turtle command argument
⍝ scmd      :=  '[' | ']'               ⍝ stack command: push or pop
}

code_colours

test script

Back to: notes

Back to: Workspaces
```