rem ---------------------------------------------------
rem
rem ---------------------------------------------------

open window 640,512
setrgb 0,255,255,255
clear window

rem ---------------------------------------------------
rem
rem ---------------------------------------------------

tabsize=512
dim sintab(tabsize)

sizebits=4
size=2^sizebits

max_map_height=255
number_of_colors=255
roughness=255
waterlevel=16
roughscale=0.85

dim array(size,size)
dim tarray(size,size,3)

dim viewmatrix(9)
viewmatrix(1)=1
viewmatrix(2)=0
viewmatrix(3)=0
viewmatrix(4)=0
viewmatrix(5)=1
viewmatrix(6)=0
viewmatrix(7)=0
viewmatrix(8)=0
viewmatrix(9)=1

dim camerapos(3)
dim cameraorient(3)

'position
camerapos(1)=0
camerapos(2)=0
camerapos(3)=0

'tilt,turn,roll
cameraorient(1)=0
cameraorient(2)=0
cameraorient(3)=0

z_cull=0.01

dim mapcolours(max_map_height,3)

rem ---------------------------------------------------
rem
rem ---------------------------------------------------

gosub buildmap
gosub showflatmap
gosub buildsintable
gosub setupcolours

camerapos(2)=64
autocontrol=1

draw=0
repeat
 setdispbuf 1-draw
 setdrawbuf draw

 gosub settransform

 clear window

 gosub landscape3d

 if (autocontrol=1) then
rem  cameraorient(1)=cameraorient(1)+1
  cameraorient(2)=cameraorient(2)+2
rem  cameraorient(3)=cameraorient(3)+3
 fi

 gosub cameracontrol

 draw=1-draw
until (1=0)

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label buildmap
 array(1,1)=ran(number_of_colors)
 array(size,1)=ran(number_of_colors)
 array(1,size)=ran(number_of_colors)
 array(size,size)=ran(number_of_colors)

 for p=sizebits to 0 step -1
  twotop=2^p
  twotop1=2^(p+1)

  pmask=twotop1-1

  for x=1 to size step twotop
   for y=1 to size step twotop

    xand=and(x-1,pmask)
    yand=and(y-1,pmask)

    if (xand=0 and yand=0) goto nxt

    if (xand=0) then
     yplus=y+twotop
     ymind=y-twotop
     if (yplus>size) yplus=1
     if (ymins<1) ymins=size
     average=(array(x,yplus)+array(x,ymins))*0.5
     col=average+roughness*(ran()-0.5)
     goto nxt
    fi

    if (yand=0) then
     xplus=x+twotop
     xmins=x-twotop
     if (xplus>size) xplus=1
     if (xmins<1) xmins=size
     average=(array(xplus,y)+array(xmins,y))*0.5
     col=average+roughness*(ran()-0.5)
     goto nxt
    fi

    if (xand>0 and yand>0) then
     yplus=y+twotop
     ymins=y-twotop
     if (yplus>size) yplus=1
     if (ymins<1) ymins=size

     xplus=x+twotop
     xmins=x-twotop
     if (xplus>size) xplus=1
     if (xmins<1) xmins=size

     average=array(xplus,yplus)+array(xplus,ymins)
     average=average+array(xmins,yplus)+array(xmins,ymins)
     average=average*0.25
     col=average+roughness*(ran()-0.5)
    fi

label nxt

    if (col>max_map_height) col=max_map_height
    if (col<waterlevel) col=waterlevel
    array(x,y)=col
   next y
  next x

  roughness=roughness*roughscale
 next p
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label showflatmap
 w=640/size
 h=480/size
 for y=1 to size-1
  for x=1 to size-1
   setrgb 1,array(x,y),array(x,y),array(x,y)
   setrgb 2,array(x+1,y),array(x+1,y),array(x+1,y)
   setrgb 3,array(x,y+1),array(x,y+1),array(x,y+1)

   gtriangle x*w,y*h to x*w+w,y*h to x*w,y*h+h

   setrgb 1,array(x+1,y),array(x+1,y),array(x+1,y)
   setrgb 2,array(x+1,y+1),array(x+1,y+1),array(x+1,y+1)
   setrgb 3,array(x,y+1),array(x,y+1),array(x,y+1)

   gtriangle x*w+w,y*h to x*w+w,y*h+h to x*w,y*h+h
  next x
 next y
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label setupcolours
 r=0:g=0:b=255:i=1
 r1=0:g1=0:b1=255
 s=waterlevel
 gosub spread

 r=r1:g=g1:b=b1:i=i+s
 r1=192:g1=192:b1=0
 s=32
 gosub spread

 r=r1:g=g1:b=b1:i=i+s
 r1=0:g1=255:b1=0
 s=48
 gosub spread

 r=r1:g=g1:b=b1:i=i+s
 r1=192:g1=128:b1=0
 s=64
 gosub spread

 r=r1:g=g1:b=b1:i=i+s
 r1=255:g1=255:b1=255
 s=255-i
 gosub spread
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label spread
 d=1.0/(s-1)

 dr=(r1-r)*d
 dg=(g1-g)*d
 db=(b1-b)*d

 rr=r
 gg=g
 bb=b

 for x=i to i+s
  mapcolours(x,0)=rr
  mapcolours(x,1)=gg
  mapcolours(x,2)=bb
  rr=rr+dr
  gg=gg+dg
  bb=bb+db
 next x
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label buildsintable
 cozoff=tabsize*0.25
 tabmask=tabsize-1

 scale=3.141592653589/(tabsize*0.5)

 for x=1 to tabsize
  sintab(x)=sin(x*scale)
 next x
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
sub zin(a)
 return sintab(and(a,tabmask)+1)
end sub

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
sub coz(a)
 return sintab(and(a-cozoff,tabmask)+1)
end sub

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label settransform
 A=coz(cameraorient(1))
 B=zin(cameraorient(1))
 C=coz(cameraorient(2))
 D=zin(cameraorient(2))
 E=coz(cameraorient(3))
 F=zin(cameraorient(3))

 AD=A*D
 BD=B*D

 viewmatrix(1)=C*E
 viewmatrix(2)=-C*F
 viewmatrix(3)=D
 viewmatrix(4)=BD*E+A*F
 viewmatrix(5)=-BD*F+A*E
 viewmatrix(6)=-B*C
 viewmatrix(7)=-AD*E+B*F
 viewmatrix(8)=AD*F+B*E
 viewmatrix(9)=A*C

 viewscale_x=320
 viewaspect=viewscale_x/240

 view_origin_x=320
 view_origin_y=240
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label transform
 x1=x*viewmatrix(1)+y*viewmatrix(4)+z*viewmatrix(7)
 y1=x*viewmatrix(2)+y*viewmatrix(5)+z*viewmatrix(8)
 z1=x*viewmatrix(3)+y*viewmatrix(6)+z*viewmatrix(9)
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label invtransform
 x1=x*viewmatrix(1)+y*viewmatrix(2)+z*viewmatrix(3)
 y1=x*viewmatrix(4)+y*viewmatrix(5)+z*viewmatrix(6)
 z1=x*viewmatrix(7)+y*viewmatrix(8)+z*viewmatrix(9)
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label perspective
 z2=1.0/z1
 sx=x1*z2
 sy=y1*z2
 sx=320+sx
 sy=240-sy
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label transformperspective
 z1=x*viewmatrix(3)+y*viewmatrix(6)+z*viewmatrix(9)
 z1=viewscale_x/z1
 sx=(x*viewmatrix(1)+y*viewmatrix(4)+z*viewmatrix(7))*z1
 sy=(x*viewmatrix(2)+y*viewmatrix(5)+z*viewmatrix(8))*z1*viewaspect
 sx=view_origin_x+sx
 sy=view_origin_y-sy
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label transformparallel
rem z1=x*viewmatrix(3)+y*viewmatrix(6)+z*viewmatrix(9)
 sx=(x*viewmatrix(1)+y*viewmatrix(4)+z*viewmatrix(7))
 sy=(x*viewmatrix(2)+y*viewmatrix(5)+z*viewmatrix(8))
 sx=view_origin_x+sx
 sy=view_origin_y-sy
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label fulltransformperspective
 xt=x-camerapos(1)
 yt=y-camerapos(2)
 zt=z-camerapos(3)

 z1=xt*viewmatrix(3)+yt*viewmatrix(6)+zt*viewmatrix(9)

 if (z1<z_cull) then
  clip=1
 else
  z1=viewscale_x/z1
  sx=(xt*viewmatrix(1)+yt*viewmatrix(4)+zt*viewmatrix(7))*z1
  sy=(xt*viewmatrix(2)+yt*viewmatrix(5)+zt*viewmatrix(8))*z1*viewaspect
  sx=view_origin_x+sx
  sy=view_origin_y-sy
  clip=0
 fi
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label landscape3d
 halfsize=size*0.5
 xscale=20
 yscale=1.0/5.0
 zscale=20

 for yy=1 to size
  for xx=1 to size

   x=xscale*(xx-halfsize)
   y=yscale*array(xx,yy)
   z=zscale*(yy-halfsize)

rem   gosub transformperspective
rem   gosub transformparallel
   gosub fulltransformperspective

   tarray(xx,yy,1)=sx
   tarray(xx,yy,2)=sy
   tarray(xx,yy,3)=clip
  next xx
 next yy

 for y=1 to size-1
  for x=1 to size-1
   if (tarray(x,y,3)=1 or tarray(x+1,y,3)=1 or tarray(x,y+1,3)=1 or tarray(x+1,y+1,3)=1) goto clipped

   c00=array(x,y)
   c10=array(x+1,y)
   c01=array(x,y+1)
   c11=array(x+1,y+1)

   c00r=mapcolours(c00,0)
   c00g=mapcolours(c00,1)
   c00b=mapcolours(c00,2)

   c10r=mapcolours(c10,0)
   c10g=mapcolours(c10,1)
   c10b=mapcolours(c10,2)
   
   c01r=mapcolours(c01,0)
   c01g=mapcolours(c01,1)
   c01b=mapcolours(c01,2)

   c11r=mapcolours(c11,0)
   c11g=mapcolours(c11,1)
   c11b=mapcolours(c11,2)

   setrgb 1,c00r,c00g,c00b
   setrgb 2,c10r,c10g,c10b
   setrgb 3,c01r,c01g,c01b

   x1=tarray(x,y,1)
   x2=tarray(x+1,y,1)
   x3=tarray(x,y+1,1)
   x4=tarray(x+1,y+1,1)

   y1=tarray(x,y,2)
   y2=tarray(x+1,y,2)
   y3=tarray(x,y+1,2)
   y4=tarray(x+1,y+1,2)

   if ((x2-x1)*(y3-y1)-(x3-x1)*(y2-y1)<=0) then
    gtriangle x1,y1 to x2,y2 to x3,y3
   fi

   setrgb 1,c10r,c10g,c10b
   setrgb 2,c11r,c11g,c11b
   setrgb 3,c01r,c01g,c01b

   if ((x4-x2)*(y3-y2)-(x3-x2)*(y4-y2)<=0) then
    gtriangle x2,y2 to x4,y4 to x3,y3
   fi

label clipped

  next x
 next y
return

rem ---------------------------------------------------
rem
rem ---------------------------------------------------
label cameracontrol
 bits=peek("port1")
 if (bits<>0) then
  if (autocontrol=1) goto autoonly

rem x
  if (and(bits,16384)<>0) then
   camerapos(1)=camerapos(1)-viewmatrix(3)
   camerapos(2)=camerapos(2)-viewmatrix(6)
   camerapos(3)=camerapos(3)-viewmatrix(9)
  fi

rem /\
  if (and(bits,4096)<>0) then
   camerapos(1)=camerapos(1)+viewmatrix(3)
   camerapos(2)=camerapos(2)+viewmatrix(6)
   camerapos(3)=camerapos(3)+viewmatrix(9)
  fi

rem LEFT
  if (and(bits,128)<>0) then
   cameraorient(2)=cameraorient(2)-1
  fi

rem RIGHT
  if (and(bits,32)<>0) then
   cameraorient(2)=cameraorient(2)+1
  fi

rem UP
  if (and(bits,16)<>0) then
   cameraorient(1)=cameraorient(1)+1
  fi

rem DOWN
  if (and(bits,64)<>0) then
   cameraorient(1)=cameraorient(1)-1
  fi

rem R1
  if (and(bits,2048)<>0) then
   cameraorient(3)=cameraorient(3)+1
  fi

rem L1
  if (and(bits,1024)<>0) then
   cameraorient(3)=cameraorient(3)-1
  fi

rem O
  if (and(bits,8192)<>0) then
   camerapos(1)=0
   camerapos(2)=64
   camerapos(3)=0
   cameraorient(1)=0
   cameraorient(2)=0
   cameraorient(3)=0
   autocontrol=1
  fi

rem [_]
label autoonly
  if (and(bits,32768)<>0) then
   autocontrol=0
  fi
 fi
return


