fecs functional geometry Escher fishes

(set 'NICE-FISH '((-16233631 15267945 -108251967 97505071 -185971069 166792885 -247133988 252853570 -247133988 256629064 -241713861 270485981 -235089272 ....points elided... 369777563 473055002 369777563 473055002 369777563 473055002 369777563) T) ) (put 'BLANK 'LINES '()) (set 'concat '((A B) (make (loop (NIL A) (link (car A)) (set 'A (cdr A)) ) (loop (NIL B) (link (car B)) (set 'B (cdr B)) ) ))) (set 'scale '((C V) (let ((VX VY) V) (list (* C VX) (* C VY) ) ) )) (set '/V '((V N) (let ((X Y) V) (list (/ X N) (/ Y N)) ) )) (set '+V '((A B) (let ((AX AY) A (BX BY) B) (list (+ AX BX) (+ AY BY)) ) )) (set 'negV '((V) (let ((X Y) V) (list (- X) (- Y)) ) )) (set 'scale-factor 1000000000) (set 'proj-line '((LINE A B C) (make (loop (NIL LINE) (let ((X Y . MORE-LINE) LINE vec-scale 1000 A (scale vec-scale A) B (scale vec-scale B) C (scale vec-scale C) (SX SY) (+V A (+V (/V (scale X B) scale-factor) (/V (scale Y C) scale-factor))) ) (link SX) (link SY) (set 'LINE MORE-LINE) ) ) ))) (set 'close-const '(FX (let ((SYMS FN) FX (_Q FNARGS . FNEXPRS) FN) (eval (list 'quote FNARGS (apply list 'let (make (loop (link (car SYMS)) (link (cons 'quote (eval (car SYMS)))) (NIL (set 'SYMS (cdr SYMS))))) FNEXPRS)) ) ))) (set 'scale-lines '((LINES) (close-const (LINES) '((A B C) (let (LS LINES) (make (loop (NIL LS) (let (LINE (car LS)) (cond (= T LINE) ;; keep T as end of single figure marker (link T) T (link (proj-line LINE A B C)))) (NIL (set 'LS (cdr LS))) ) ) )) ) )) (set 'BSHAPE (scale-lines (get 'BLANK 'LINES))) (set 'TRIANGLE (scale-lines '((0 1000000 1000000 0) ;;(10000 900000 900000 10) (0 1000000 0 0) (0 0 1000000 0)))) (set 'over '((P Q) (close-const (P Q) '((A B C) (concat (P A B C) (Q A B C)))))) (set 'flip '((P) (close-const (P) '((A B C) (P (+V A B) (negV B) C))))) (set 'rot '((P) (close-const (P) '((A B C) (P (+V A B) C (negV B)))))) (set 'rot45 '((P) (close-const (P) '((A B C) (P (+V A (/V (+V B C) 2)) (/V (+V B C) 2) (/V (+V C (negV B)) 2)))))) (set 'beside '((P Q) (close-const (P Q) '((A B C) (concat (P A (/V B 2) C) (Q (+V A (/V B 2)) (/V B 2) C) ))))) (set 'above '((P Q) (close-const (P Q) '((A B C) (concat (P (+V A (/V C 2)) B (/V C 2)) (Q A B (/V C 2)) ))))) (set 'beside-ratio '((M N P Q) (close-const (M N P Q) '((A B C) (concat (P A (/V (scale M B) (+ M N)) C) (Q (+V A (/V (scale M B) (+ M N))) (/V (scale N B) (+ M N)) C) ))))) (set 'above-ratio '((M N P Q) (close-const (M N P Q) '((A B C) (concat (P (+V A (/V (scale N C) (+ M N))) B (/V (scale M C) (+ M N))) (Q A B (/V (scale N C) (+ M N))) ))))) (set 'quartet '((P Q R S) (above (beside P Q) (beside R S))) ) (set 'cycle '((P) (quartet P (rot P) (rot (rot P)) (rot (rot (rot P))) ))) (set 'SIDE '((P N) (cond (= N 0) BSHAPE T (let (SIDE-MINUS-1 (SIDE P (- N 1))) (quartet SIDE-MINUS-1 SIDE-MINUS-1 (rot P) P)) ) )) (set 'CORNER '((T U N) (cond (= N 0) BSHAPE T (let (N-DEC (- N 1) SIDE-N-DEC (SIDE T N-DEC)) (quartet (CORNER T U N-DEC) SIDE-N-DEC (rot SIDE-N-DEC) U))))) (set 'nonet '((P Q R S T U V W X) (above-ratio 1 2 (beside-ratio 1 2 P (beside Q R)) (above (beside-ratio 1 2 S (beside T U)) (beside-ratio 1 2 V (beside W X)))) )) (set 'squarelimit-N '((T U N) (let (CORNER (CORNER T U N) SIDE (SIDE T N)) (nonet CORNER SIDE (rot (rot (rot CORNER))) (rot SIDE) U (rot (rot (rot SIDE))) (rot CORNER) (rot (rot SIDE)) (rot (rot CORNER)) ) ) )) (set 'FISH (scale-lines NICE-FISH)) (set 'FISH2 (flip (rot45 FISH))) (set 'FISH3 (rot (rot (rot FISH2)))) (set 'FISH-T (over FISH (over FISH2 FISH3)) ) (set 'FISH-U (over (over FISH2 (rot FISH2)) (over (rot (rot FISH2)) FISH3) ) ) (set 'FISH-M (over FISH (flip FISH))) (draw-poly-curve ((squarelimit-N FISH-T FISH-U 3) (0 0) (600 0) (0 600)))