{- drawing polynomials with turtle graphics -} define poly(n) = turtle(sides(360/n,n)); define sides(a,0) = [] | sides(a,n) = ahead(100):left(a):sides(a,n-1); define randompoly() = let n = 3 + int(15 * random()) in poly(n); {- alternative definition using repeat -} define polygon(n) = let xs = [ahead(100),left(360/n)] in turtle(repeat(n,xs)); {- draw star or polyons -} {- draws a line followed by an angle a and repeats this n times -} define stars(n,a) = let xs = [ahead(1000),left(a)] in turtle(repeat(n,xs)); {- draws a star polygon with p points -} define starpoly(p,q) = let xs = [ahead(1000),left((360*q)/p)] in turtle(repeat(p,xs)); {- produces a list with n copies of xs -} define repeat(0,xs) = [] | repeat(n,xs) = xs @ repeat(n-1,xs); {- mystic rose -} define rose(n) = turtle(rosepoints(n,360/n,n)); define rosepoints(n,a,0) = [] | rosepoints(n,a,s) = ahead(1000):left(180):roseline(n,a,n-2)@(rosepoints(n,a,s-1)); define roseline(n,a,0) = [] | roseline(n,a,s) = let r = 500*sidelength(n,s) in right(a/2):ahead(r):right(180):ahead(r):right(180):roseline(n,a,s-1); define polywithstar(p,q) = turtle(repeat(p,[ahead(1000*sidelength(p,q)),right(360*q/p)]) @[left(360*(q-1)/(2*p))]@repeat(p,[ahead(1000),right(360/p)])); {- need to compute diagonal lengths using sine rule -} define sidelength(n,s) = let a = 360/(2*n) in let b = s*a in (sin(b)/sin(a)); {- make a random tile -} define randomtile() = let n = int(4*random()) in pos([man,woman,tree,star],n); define randomesher() = let n = int(6*random()) in colour(pos([A,B,C,D,E,F],n)); define pos(xs,0) = head(xs) | pos(xs,n) = pos(tail(xs),n-1); {- random numbers -} define randomInt(m,n) = int(m+(n-m+1)*random()); define dice() = randomInt(1,6); {- row and grid functions -} define row(n,p) = p $ row(n-1,p) when n>1 | row(1,p) = p; define grid(1,c,p) = row(c,p) | grid(r,c,p) = row(c,p) & grid(r-1,c,p); {- using solid and colours -} define randomblock() = colour(solid(1,4*random())); {- can't use grid to draw a random block -} define rowblock(0) = null | rowblock(n) = randomblock() $ rowblock(n-1); define gridblock(0,c) = null | gridblock(r,c) = rowblock(c) & gridblock(r-1,c); {- now we make a more general function -} define rowfn(0,f) = null | rowfn(n,f) = f() $ rowfn(n-1,f); define gridfn(0,c,f) = null | gridfn(r,c,f) = rowfn(c,f) & gridfn(r-1,c,f); {- gridfn needs a function as argument -} {- so need to make a function that turns a picture into a function -} define makefn(p) = let f() = p in f; {- alternative which passes functions as parameters -} define recursive(0,p,f) = null | recursive(n,p,f) = f(p(), recursive(n-1,p,f)); define newgrid(r,c,p) = recursive(r,makefn(recursive(c,p,op$)),op&); {- plants -} {- first version: rule replaces the character "F" in the string -} define plant1(start,rule,0) = bush(start) | plant1(start,rule,n) = plant1(implode(apply1(explode(start),rule)),rule, n-1); define apply1([], rule) = [] | apply1((x:xs), rule) = (if x = "F" then rule else x) : (apply1(xs,rule)) ; define demoplant(n) = plant1("FF","CFF-[-F+F]+[+F-F]",n); {- second version: rule is a list of pairs of the form [char, replacement] -} define step([],rules) = [] | step((x:xs), rules) = apply(x,rules):(step(xs,rules)); define apply(ch,[]) = ch | apply(ch,([u,v]:ws)) = if ch = u then v else apply(ch,ws); define string(start,rules,0) = start | string(start,rules,n) = string(implode(step(explode(start),rules)),rules,n-1); define plant(s,r,n) = bush(string(s,r,n)); {- some demo plants -} define d1(n) = string("FF", [["F", "CCFF-[-F+F]+[+F-F]"]],n); define d2(n) = string("F", [["F","F[--F][++F]cc<-F[-F][+F]"]],n); define d3(n) = string("X", [["X","F-[X][+X]+F[+FX]-X"],["F","FF"]],n); {- d1,d2,d3 produce the strings and demo1 etc draw the plant -} define demo1(n) = bush(d1(n)); define demo2(n) = bush(d2(n)); define demo3(n) = bush(d3(n)); {- some random plants -} define randomplant() = let n = int(9*random()) in let p = (n mod 3)+1 in pos([demo1(p),demo2(p),demo3(p)],n div 3); {- koch snowflake -} define flake(n) = let xs = (oneside(n,6561))@[left(120)] in turtle(xs @ xs @ xs) ; define oneside(0,l) = [ahead(l)] | oneside(n,l) = oneside(n-1,l/3) @ gen(n,l) @ oneside(n-1,l/3); define gen(0,l) = [ahead(l)] | gen(n,l) = [right(60)] @ oneside(n-1,l/3) @ [left(120)] @ oneside(n-1,l/3) @ [right(60)]; {- sierpinski triangle -} define sierp(n) = turtle(tri(n,16384)); define tri(0,s) = [] | tri(n,s) = let xs = [ahead(s)]@(tri(n-1,s/2))@[ahead(s),left(120)] in xs @ xs @ xs; {- two versions of sierpinski's carpet -} define carpet1(n) = turtlecarpet(n,10000); define turtlecarpet(0,s) = let xs = [ahead(s),right(90)] in turtle(xs@xs@xs@xs) | turtlecarpet(n,s) = let xs = turtlecarpet(n-1,s/3) in (xs $ xs $ xs) & (xs $ turtlecarpet(0,s) $ xs) & (xs $ xs $ xs); define carpet2(n) = colour(solidcarpet(n)); define solidcarpet(0) = solid(1,1) | solidcarpet(n) = let xs = solidcarpet(n-1) in let ys = solid(1,3) in (xs $ xs $ xs) & (xs $ ys $ xs) & (xs $ xs $ xs); define treecarpet(0) = star | treecarpet(n) = let xs = treecarpet(n-1) in let ys = tree in (xs $ xs $ xs) & (xs $ ys $ xs) & (xs $ xs $ xs); {- some functions that use rot -} define four(p) = (blank $ p $ blank ) & (rot(p) $ blank $ rot3(p)) & (blank $ rot2(p) $ blank); define four2(p,q) = (q $ p $ rot(q) ) & (rot(p) $ blank $ rot3(p)) & (rot3(q) $ rot2(p) $ rot2(q)); define four3(p,q,r) = (q $ p $ rot(q) ) & (rot(p) $ r $ rot3(p)) & (rot3(q) $ rot2(p) $ rot2(q)); {- function which produces a list of conseq numbers -} define consec(m,n) = if m>n then [] else m:consec(m+1,n); _opdef("to","+"); define op to(x,y) = consec(x,y);