aUCBLogo Demos and Tests / landscape4


to landscape4 [randomvalue -1]
   ; 70033224, 459159795 or 148549210, 1617112103 are nice
   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
         ]
      ]
comment [      
      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
   v=0+1.0
   dv=0.0
   a=v/300
   vmax=3
      Ï‚={0 0 0}
   dς=0.05
   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]
   WXK_A=ASCII upperCase "A
   WXK_Y=ASCII upperCase "Y
   WXK_X=ASCII upperCase "X
   WXK_C=ASCII upperCase "C
   WXK_S=ASCII upperCase "S
   maingraph=GraphCurrent
   WindowSetFocus maingraph
   WindowOnKeyDown maingraph
   [   k=KeyboardValue
      case k
      [   [WXK_UP    kup   =true]
         [WXK_DOWN  kdown =true]
         [WXK_RIGHT kright=true]
         [WXK_LEFT  kleft =true]
         [WXK_A     kacc  =true]
         [WXK_Y     kbreak=true]
         [WXK_X     klr   =true]
         [WXK_C     krr   =true]
         [WXK_ESCAPE running=false]
      ]
   ]
   WindowOnKeyUp maingraph
   [   k=KeyboardValue
      case k
      [   [WXK_UP    kup   =false]
         [WXK_DOWN  kdown =false]
         [WXK_RIGHT kright=false]
         [WXK_LEFT  kleft =false]
         [WXK_A     kacc  =false]
         [WXK_Y     kbreak=false]
         [WXK_X     klr   =false]
         [WXK_C     krr   =false]
      ]
   ]
   kup   =false
   kdown =false
   kright=false
   kleft =false
   kacc   =false
   kbreak=false
   klr   =false
   krr   =false
   
   dispatchMessages
   running=true
   while [running]
   [   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
      dςv=dς/(1+0.1*Norm v)
      if kup 
      [   Ï‚.1=ς.1+dςv
      ]
      if kdown  
      [   Ï‚.1=ς.1-dςv
      ]
      if kright 
      [   Ï‚.1=ς.1+dςv*0.4
         Ï‚.2=ς.2+dςv
         Ï‚.3=ς.3+dςv
      ]
      if kleft  
      [   Ï‚.1=ς.1+dςv*0.4
         Ï‚.2=ς.2-dςv
         Ï‚.3=ς.3-dςv
      ]
      if krr 
      [   Ï‚.3=ς.3+dςv
      ]
      if klr  
      [   Ï‚.3=ς.3-dςv
      ]
      Ï‚=ς*0.95
      up Ï‚.1
      right Ï‚.2
      rightroll Ï‚.3
      
      up 90
      p0=PosXYZ
      forward 1
      p1=PosXYZ
      back 1
      down 90
      d=p1-p0
      forward 1
      p2=PosXYZ
      back 1
      setTowardsXYZup 
         p2
         p0+(p1-p0)*0.98+[0 1 0]*0.02
      
      if kacc    
      [   if v < vmax
         [   dv+=a/(1+0.1*Norm v)
         ]
      ]
      if kbreak
      [   if v > 0
         [   dv-=a/(1+0.1*Norm v)
         ]
      ]
      dv*=0.95
      v+=dv
      if key? 
      [   dispatchMessages
         local [ch]
         ch=readChar
         if ch=="s [shadows=not shadows]
      ]
      forward v
      z=Int ZCor/rfactor
      y=Int YCor/yfactor
      x=Int 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

be 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
   
   be quad2 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
   
      be 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
   end

   be 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
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

to tcube [size 100]   ;Textured Cube
   pu
   local [p]
   p=PosXYZ
   bk size/2
   left 90 fd size/2 rt 90
   down 90 fd size/2 up 90
   repeat 4
   [   face
      fd size up 90
   ]
   leftroll 90
   repeat 2
   [   face
      repeat 2 [fd size down 90]
   ]
   setPosXYZ p
end

to face
   pd 
   polyStart 
   setTexXY 0 0   fd size rt 90
   setTexXY 0 1   fd size rt 90
   setTexXY 1 1   fd size rt 90
   setTexXY 1 0   fd size rt 90
   polyEnd 
   pu
end