aUCBLogo Demos and Tests / landscape2

to landscape2 [randomvalue -1]
   ; 70033224, 459159795 or 148549210 is nice
   allFullScreen
   perspective
   r=2^6      ;increase if you want to fly farer
   maxy=200
   sealevel=0
   rfactor=40
   yfactor=5
   minside=1
   miny=2
   ifelse randomvalue==-1
   [   seedvalue=random IntMax
      (reRandom seedvalue)
      pr seedvalue
   ][   (reRandom randomvalue)
   ]
   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

   peak=(max p)
   for [z -r r minside]
   [   py=p.(Int z)
      for [x -r r minside]
      [   if py.x==peak
         [   (drawcross rfactor*x yfactor*peak rfactor*z 4)
            x=r
            z=r
         ]
      ]
   ]
   repeat 50
   [   x=(rnd-0.5)*2*r  x=int x-mod x minside
      z=(rnd-0.5)*2*r  z=int z-mod z minside
      drawhouse x z
   ]
   repeat 100
   [   x=(rnd-0.5)*2*r  x=int x-mod x minside
      z=(rnd-0.5)*2*r  z=int z-mod z minside
      drawtree x z
   ]
   PenUp  home  setXYZ 0 (p.0).0+maxy 0    downPitch 90
   fly_around
   notFullScreen
end

to drawhouse x z
   if (p.z).x==sealevel [stop]
   hsize=30
   home
   leftroll random 360
   PenUp
   setXYZ rfactor*x yfactor*(p.z).x+hsize/2 rfactor*z
   (house hsize)
   csize=hsize*1.1
   bk hsize
   (pcube csize)
end

to drawtree x z
   if (p.z).x==sealevel [stop]
   tsize=40
   PenUp
   home
   setXYZ rfactor*x yfactor*(p.z).x rfactor*z
   disableRoundLineEnds
   setPenSize (list tsize/10 tsize/10)
   PenDown
   setPC "brown
   enableCylinderLines
   fd tsize/2
   disableCylinderLines
   PenUp
   fd tsize/2-3
   setPC "dark green
   Sphere tsize/2
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
   eyecenter2=eyecenter*2

   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
      back eyecenter2
      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]
      ]
      forward eyecenter2
      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

to house [size 300]
   local
   [   hsize hpos hori
      doorwitdh doorheight doorx doorstep doorpos doorori
   ]
   horizon=1e4
   hsize=size/2
   wall=hsize/10
   setLightAmbient rgb .4 .4 .4
;   perspective
   hpos=PosXYZ
   hori=Orientation
   green=hsb 60 0.4 0.1
   setPC green

   pu   down 180  fd hsize  up 90
;   draw_plane
   lt 180  fd hsize  rt 90  fd hsize  lr 90  rt 90
   openpos=[]
   openori=[]
   pink=hsb 0 0.3 0.7
   setpc pink
   double [draw_front]  down 90  fd size  up 90  lr 90
   double [draw_side]  down 90  fd size  up 90  lr 90
   double [draw_back]  down 90  fd size  up 90  lr 90
   double [draw_side]
   fd hsize  down 30  bk wall  lt 90  fd wall  rt 90
   draw_roof
   fd size+wall  down 120  fd size+wall  rt 90  fd size+2*wall  rt 90
   draw_roof
   setpc pink
   draw_openings
   setOrientation hori
   setPosXYZ hpos
;   rotateScene2
end

to double runlist
   double? = false
   run runlist
   down 90  fd wall  up 90
   double? = true
   run runlist
   down 90  bk wall  up 90
end

to add_open
   if not double?
   [   push "openpos posXYZ
      push "openori Orientation
      push "openheight height
      push "openwidth width
   ]
end

to save_pos
   opos=posXYZ
   oori=Orientation
end

to reset_pos
   pu
   setPosXYZ opos
   setOrientation oori
end

to draw_plane
   save_pos
      fd horizon  rt 90  fd horizon  rt 90
   setpc hsb 60 0.3 0.7
   pd  PolyStart  repeat 4 [fd horizon*2  rt 90]  PolyEnd
   reset_pos
end

to draw_openings
   while [not empty? openpos]
   [   setPosXYZ pop "openpos
      setOrientation pop "openori
      width=pop "openwidth
      height=pop "openheight
      rr 90
      pd
      repeat 2
      [   PolyStart
            fd height  rt 90  fd wall  rt 90
            fd height  rt 90  fd wall  rt 90
         PolyEnd
         pu fd height  up 90  pd
         PolyStart
            fd width  rt 90  fd wall  rt 90
            fd width  rt 90  fd wall  rt 90
         PolyEnd
         pu fd width  up 90  pd
      ]
      pu
   ]
end

to draw_front
   TessStart
   save_pos
   pd fd hsize  rt 30  fd size  rt 120  fd size  rt 30  fd hsize
      rt 90  fd size  rt 90

   TessContour
   height=size*3/8
   width=height*1/2
   doorx=size/4
   doorstep=height/8
   pu rt 90  fd doorx  lt 90  fd doorstep
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*9/16
   winsill=height*6/8
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*5/16
   winsill=hsize+winsill
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width
   TessEnd
   reset_pos
end

to draw_back
   TessStart
   save_pos
   pd fd hsize  rt 30  fd size  rt 120  fd size  rt 30  fd hsize
      rt 90  fd size

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*1/16
   winsill=height*6/8
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width

   TessContour
   winx=size*9/16
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*5/16
   winsill=hsize+winsill
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width
   TessEnd
   reset_pos
end

to draw_side
   TessStart
   save_pos
   pd fd hsize  rt 90  fd size  rt 90  fd hsize  rt 90  fd size  rt 90

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*1/16
   winsill=height*6/8
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width

   TessContour
   winx=size*9/16
   reset_pos
      rt 90  fd winx  lt 90  fd winsill
   add_open
   pd fd height  rt 90  fd width  rt 90
      fd height  rt 90  fd width
   TessEnd
   reset_pos
end

to draw_roof
   pd
   red=hsb 0 1 1
   setPC red
   PolyStart
      repeat 2 [fd size+wall  rt 90  fd size+2*wall  rt 90]
   PolyEnd
   pu
end