aUCBLogo Demos and Tests / landscape4c

to landscape4c [randomvalue -1]
   ; 70033224, 459159795 or 148549210, 1617112103 are nice
   compile [quad2 1 2 3 4 5]
   link [new_edge q quad2]
   fullScreen
;   allFullScreen
   perspective
   setUpdateGraph false
   setLightAmbient RGB .3 .3 .3
   r=2^6      ;increase if you want to fly farer
   maxy=200
   sealevel=0
   rfactor=40
   yfactor=5
   minside=1
   miny=2
   hsize=30
   ifelse randomvalue==-1
   [   seedvalue=random IntMax
      (reRandom seedvalue)
      pr seedvalue
   ][   (reRandom randomvalue)
   ]
   mypal=loadpalette "topograf.pal
   hideTurtle
   setScreenColor 1
   cs   ;to delete all textures
   clearShadows
   enableShadows

   rock=loadImage "rockbricks.jpg
   texRock=Texture rock

   house_and_cube=Graphic
   [   (house hsize)
      csize=hsize*1.1
      bk hsize
      setPC "white
      Texture texrock
      (tcube csize)
      disableTexture
   ]

   landscapegraphic=Graphic
   [   PenUp
      p=quad r
      setX -r
      setZ -r
      PenDown
      Surface
      [   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
         ]
      ]

      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
   disableShadows
   fly_around
   notFullScreen
   splitScreen
end

to drawhouse x z
   if (p.z).x==sealevel [stop]
   home
   leftroll random 360
   PenUp
   setXYZ rfactor*x yfactor*(p.z).x+hsize/2 rfactor*z
   drawGraphic house_and_cube
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 eyepos eyeori]
   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
   shadows=false

   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 {1000 100 0}
      eyepos=PosXYZ
      eyeori=Orientation

      cs
      drawGraphic landscapegraphic

;      setPosXYZ eyepos
;      setOrientation eyeori
;      setPC rgba 1 1 1 0.2
;      (pcube 100)

      if shadows [enableShadows castShadows]
      updateGraph

      setPosXYZ eyepos
      setOrientation eyeori
      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]
            if ch=="s [shadows=not shadows]
         ]
      ]
      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 r
   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

   quad2 a b c d 0
   output p
end

to quad2 a b c d depth
   local [m py]
;   (show a b c d)
   ac=a-c
   if (sqrt (sqr ac.1)+(sqr ac.3)) < minside [stop]
   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
   quad2  a  bn  cn  dn  depth+1
end

to new_edge a b
   local [m py]
(pr a b m)
   m=b+(a-b)/2
(pr a b m)
   py=(p.(int m.3)).(int m.1)
pr "B
   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
   ]
   bricks=loadImage "bricks.png
   texBricks=Texture bricks
   rooftiles=loadImage "rooftiles.png
   texRooftiles=Texture rooftiles

   horizon=1e4
   hsize=size/2
   sizey=size/2*(1+sqrt 3)
   wall=hsize/10
   setLightAmbient rgb .4 .4 .4
;   perspective
   hpos=PosXYZ
   hori=Orientation

   pu   down 180  fd hsize  up 90
;   draw_plane
   lt 180  fd hsize  rt 90  fd hsize  lr 90  rt 90
   openpos=[]
   openori=[]
   setpc "white
   enableTexture
   Texture texBricks
   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
   Texture texRooftiles
   setPC hsb 0 0.5 1
   draw_roof
   fd size+wall  down 120  fd size+wall  rt 90  fd size+2*wall  rt 90
   draw_roof
   setPC "white
   Texture texBricks
   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
            myTexXY    0 height  fd height  rt 90
            myTexXY wall height  fd wall  rt 90
            myTexXY wall      0  fd height  rt 90
            myTexXY    0      0  fd wall  rt 90
         PolyEnd
         pu fd height  up 90  pd
         PolyStart
            myTexXY    0 width  fd width  rt 90
            myTexXY wall width  fd wall  rt 90
            myTexXY wall     0  fd width  rt 90
            myTexXY    0     0  fd wall  rt 90
         PolyEnd
         pu fd width  up 90  pd
      ]
      pu
   ]
end

to myTexXY x y
   setTexXY 5*x/size 5*y/sizey
end

to drawWindow
   reset_pos
      rt 90  fd winx  lt 90  fd winy
   add_open
   pd
   myTexXY winx       height+winy  fd height  rt 90
   myTexXY winx+width height+winy  fd width  rt 90
   myTexXY winx+width winy         fd height  rt 90
   myTexXY winx       winy         fd width
end

to drawFrontOut
   save_pos
   pd
   myTexXY 0      hsize  fd hsize  rt 30
   myTexXY size/2 sizey  fd size  rt 120
   myTexXY size   hsize  fd size  rt 30
   myTexXY size   0      fd hsize rt 90
   myTexXY 0      0      fd size  rt 90
end

to draw_front
   TessStart
   drawFrontOut

   TessContour
   height=size*3/8
   width=height*1/2
   winx=size/4
   winy=height/8
   drawWindow

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*9/16
   winy=height*6/8
   drawWindow

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*5/16
   winy=hsize+winy
   drawWindow
   TessEnd
   reset_pos
end

to draw_back
   TessStart
   drawFrontOut

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*1/16
   winy=height*6/8
   drawWindow

   TessContour
   winx=size*9/16
   drawWindow

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*5/16
   winy=hsize+winy
   drawWindow
   TessEnd
   reset_pos
end

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

   TessContour
   height=size*3/12
   width=height*3/2
   winx=size*1/16
   winy=height*6/8
   drawWindow

   TessContour
   winx=size*9/16
   drawWindow
   TessEnd
   reset_pos
end

to draw_roof
   pd
   PolyStart
      myTexXY 0           size+wall  fd size+wall    rt 90
      myTexXY size+2*wall size+wall  fd size+2*wall  rt 90
      myTexXY size+2*wall 0          fd size+wall    rt 90
      myTexXY 0           0          fd size+2*wall  rt 90
   PolyEnd
   pu
end