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 -
      
PenDown
      
Surface
      
[   for [-r r minside]
         [   
py=p.(Int z)
            
for [-r r minside]
            [   
setPenColor mypal.(Int 1+255*(0.5+py.x/maxy))
               
if py.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 (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/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 [leftrightup and down rotatesx c rollsa y changes speedESC 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 vmax
         
[   dv+=a/(1+0.1*Norm v)
         
]
      
]
      
if kbreak
      
[   if 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 < (p.z).x+miny
         
[   setY yfactor*((p.z).x+miny)
            (
pr [Ooops!] bf gensym)
            
dispatchMessages
         
]
      ][   
if >  [setX rfactorr]
         
if < -[setX rfactor*-r]
         
if >  [setZ rfactorr]
         
if < -[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 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.3m.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 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.3m.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 [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    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    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/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/rt 90
   
down 90 fd size/up 90
   
repeat 4
   
[   face
      
fd size up 90
   
]
   
leftroll 90
   
repeat 2
   
[   face
      
repeat [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