aUCBLogo Demos and Tests / landscape

to landscape
   perspective
   r=2^6      ;increase if you want to fly farer
   maxy=200
   sealevel=0
   rfactor=40
   yfactor=5
   minside=1
   miny=2
   mypal=loadpalette "topograf.pal
   hideTurtle
   setScreenColor 1
   PenUp
   p=(mdarray List 2*r+1 2*r+1  -r)

   a=(List -r geny -r)
   b=(List -r geny  r)
   c=(List  r geny  r)
   d=(List  r geny -r)
   ignore new_edge a a
   ignore new_edge b b
   ignore new_edge c c
   ignore new_edge d d

   quad a b c d 0

   setX -r
   setZ -r
   PenDown
   SurfaceStart
   for [z -r r minside]
   [   py=p.(Int z)
      for [x -r r minside]
      [   setPenColor mypal.(Int 1+255*(0.5+py.x/maxy))
         if py.x < sealevel [py.x=sealevel]
         setXYZ rfactor*x yfactor*py.x rfactor*z
      ]
      SurfaceColumn
   ]
   SurfaceEnd

   PenUp  home  setXYZ 0 (p.0).0+maxy 0    downPitch 90
   fly_around
end

to fly_around
   local [eye light center upvector]
   center={0 0 0}
   upvector={0 1 0}
   eye=array 3
   light=array 3
   ang=3.6
   flyspeed=0+1.0
   dspeed=flyspeed/4
   eyecenter=100

   penUp
   eye=Array PosXYZ
   forward eyecenter
   center=Array PosXYZ
   back eyecenter

   print [left, right, up and down rotates, x c rolls, a y changes speed, ESC exits]
   dispatchMessages
   forever
   [   setEye eye center upvector
      setLightPos {100 100 0}
      redraw
      if key?
      [   dispatchMessages
         local [ch]
         ch=readChar
         ifelse ch==char 255
         [   ch=readCharExt
            if ch==WXK_RIGHT [right ang]
            if ch==WXK_LEFT  [ left ang]
            if ch==WXK_UP    [   up ang]
            if ch==WXK_DOWN  [ down ang]
         ][
            if ch==char 27 [stop]
            if ch=="a [flyspeed+=dspeed]
            if ch=="y [flyspeed-=dspeed]
            if ch=="x [ leftRoll ang]
            if ch=="c [rightRoll ang]
         ]
      ]
      forward flyspeed
      z=round ZCor/rfactor
      y=round YCor/yfactor
      x=round XCor/rfactor
      ifelse (abs z) <= r  and2  (abs x) <= r
      [   if y < (p.z).x+miny
         [   setY yfactor*((p.z).x+miny)
            (pr [Ooops!] bf gensym)
            dispatchMessages
         ]
      ][   if x >  r [setX rfactor* r]
         if x < -r [setX rfactor*-r]
         if z >  r [setZ rfactor* r]
         if z < -r [setZ rfactor*-r]
      ]
      eye=Array PosXYZ
      forward eyecenter
      center=Array PosXYZ
      back eyecenter
      up 90  fd 1
      upvector=(Array PosXYZ)-eye
      upvector/=Norm upvector
      bk 1 down 90
   ]
end

to geny
   output maxy*rnd-maxy/2
end

to quad a b c d depth
;(show a b c d)
   ac=a-c
   if (sqrt (sqr ac.1)+(sqr ac.3)) < minside [stop]
   local [m py]
   m=c+(a-c)/2
   m.2=m.2+(a.2-c.2)*(rnd-0.5)
   setItem int m.1 p.(int m.3) m.2

   ignore new_edge a b
   ignore new_edge b c
   ignore new_edge c d
   ignore new_edge d a

   q a b c d
   q b c d a
   q c d a b
   q d a b c
end

to q a b c d
   local [bn cn dn]
   bn=new_edge a b
   cn=new_edge a c
   dn=new_edge a d
   quad  a  bn  cn  dn  depth+1
end

to new_edge a b
   local [m py]
   m=b+(a-b)/2
   py=(p.(int m.3)).(int m.1)
   ifelse empty? py
   [   m.2=m.2+(a.2-b.2)*(rnd-0.5)
      setItem int m.1 p.(int m.3) m.2
   ][   m.2=py
   ]
   output m
end