GOSUB userfunctions

bxU =0
byU =0
bwU =800
bhU =600

x1 =-1.1
x2 =1.2
y1 =-1
y2 =0.7
z1 =-1
z2 =1

sx =0.02
sy =0.03
sz =0.1

ebene =0
prozy =-4
prozx =0
prozz =0

stx =0.8
sty =-0.9
stz =0.8

bbx            = -1
bby            = 1
bbz            = -1


pi             = 3.14159
nwink          = 0.0
zwink          = sgn( bby )*SGN( bbx ) *ATAN( ABS( bbx/bby ) )+PI * ABS( bby<0 )
xwink          =-SGN( bbz )*ATAN( ABS( bbz/SQR( bbz^2+bby^2 ) ) )

lichtx         = 0.0
lichty         = -0.8
lichtz         = SQR(1-lichty^2)

lichtr         = 50000 /65535*255
lichtg         = 65535 /65535*255
lichtb         = 65535 /65535*255

GOSUB            get3d


GR.OPEN          255, 50, 0, 0, 1 ,0
GR.SET.STROKE    3
DIM              poly [9999]
DIM              res [4, 2]


GR.COLOR         255, 128, 128, 128, 1
GR.RECT          nn, 0,0,bwU,bhU

GR.COLOR         255, 255 , 255, 255, 1

CALL           kxy (x1 ,y2 ,z1/2 , _3d[], res [] , 1 )
CALL           kxy (x2 ,y2 ,z1/2 , _3d[], res [] , 2 )
CALL           kxy (x2 ,y2 ,z2/2 , _3d[], res [] , 3 )
CALL           kxy (x1 ,y2 ,z2/2 , _3d[], res [] , 4 )
ctrP++
LIST.CREATE    n, poly [ctrP]
LIST.ADD.ARRAY poly [ctrP] , res []
GR.POLY          nn, poly [ctrP]

CALL           kxy (x1 ,y2 ,z1/2 , _3d[], res [] , 1 )
CALL           kxy (x1 ,y2 ,z2/2 , _3d[], res [] , 2 )
CALL           kxy (x1 ,y1 ,z2/2 , _3d[], res [] , 3 )
CALL           kxy (x1 ,y1 ,z1/2 , _3d[], res [] , 4 )
ctrP++
LIST.CREATE    n, poly [ctrP]
LIST.ADD.ARRAY poly [ctrP] , res []
GR.POLY          nn, poly [ctrP]

GR.SET.STROKE    2
GR.COLOR         255, 0 , 0, 255, 1
FOR i          = z1/2 TO z2/2 STEP (z2-z1)/12
 CALL            kxy (x1 ,y2 ,i , _3d[], res [] , 1 )
 CALL            kxy (x1 ,y1 ,i , _3d[], res [] , 2 )
 GR.LINE         nn, res [1, 1] , res [1, 2] , res [2, 1] , res [2, 2]
 CALL            kxy (x1 ,y2 ,i , _3d[], res [] , 1 )
 CALL            kxy (x2 ,y2 ,i , _3d[], res [] , 2 )
 GR.LINE         nn, res [1, 1] , res [1, 2] , res [2, 1] , res [2, 2]
 GR.LINE         nn, tmpx1, tmpy1, tmpx2, tmpy2
NEXT i

GR.COLOR         255, 0, 0, 0, 0
GR.SET.STROKE    3
GR.POLY          nn, poly [1]
GR.POLY          nn, poly [2]

GR.COLOR         255, 255 , 255 , 0 , 1
GR.TEXT.SIZE     18
tmp$           = "3D -Flaechengrafik mit X11-Basic  (c)Markus Hoffmann"
GR.TEXT.DRAW     txt, bxU+20,byU+50, tmp$ +"...adapted by brochi"

GR.RENDER




tic = CLOCK()

FOR y          = y2 TO y1 STEP -sy
 FOR x         = x1 TO x2 STEP  sx
  z            = f1(x,y)
  zz           = f1(x+sx,y)
  zzz          = f1(x,y+sy)
  zzzz         = f1(x+sx,y+sy)

  !print x, y, z
  CALL           kxy (x    ,y   ,z    , _3d[], res [] , 1 )
  CALL           kxy (x+sx ,y   ,zz   , _3d[], res [] , 2 )
  CALL           kxy (x+sx ,y+sy,zzzz , _3d[], res [] , 3 )
  CALL           kxy (x    ,y+sy,zzz  , _3d[], res [] , 4 )
  ctrP++
  LIST.CREATE    n, poly [ctrP]
  LIST.ADD.ARRAY poly [ctrP] , res []

  nx           = (y-y)*(zzz-z)-(zz-z)*(y+sy-y)
  ny           = (zz-z)*(x-x)-(x+sx-x)*(zzz-z)
  nz           = (x+sx-x)*(y+sy-y)-(y-y)*(x-x)

  nnx          = nx/SQR(nx^2+ny^2+nz^2)
  nny          = ny/SQR(nx^2+ny^2+nz^2)
  nnz          = nz/SQR(nx^2+ny^2+nz^2)

  cwink        = nnx*lichtx+nny*lichty+nnz*lichtz
  IF cwink<0     THEN GR.COLOR  255,0,0,0,1 ELSE GR.COLOR  255,cwink*lichtr,cwink*lichtg,cwink*lichtb,1

  GR.POLY        nn, poly [ctrP]

 NEXT x

 tmp$           = "t= " + STR$(ROUND((CLOCK()-tic)/100)/10) + " sec"
 GR.MODIFY        txt, "text",  "nPoly= "+ STR$(ctrP) + " / " + tmp$
 GR.RENDER

NEXT y

PRINT            clock ()-tic

DO
UNTIL 0

END



get3d:

DIM _3d[99]

_3d[1]         = bxU
_3d[2]         = byU
_3d[3]         = bwU
_3d[4]         = bhU

_3d[11]        = x1
_3d[12]        = x2
_3d[13]        = y1
_3d[14]        = y2
_3d[15]        = z1
_3d[16]        = z2

_3d[21]        = sx
_3d[22]        = sy
_3d[23]        = sz

_3d[31]        = ebene
_3d[32]        = prozx
_3d[33]        = prozy
_3d[34]        = prozz

_3d[41]        = stx
_3d[42]        = sty
_3d[43]        = stz

_3d[51]        = nwink
_3d[52]        = xwink
_3d[53]        = zwink

RETURN


userfunctions:


FN.DEF   f1 (x,y)
  FN.RTN 0.8*EXP(-2*(x^2+y^2))*COS((x^2+y^2)*10)
! fn.rtn -0.1*(exp (-x^2) - exp (-y^2))
! FN.RTN sqr (1-x^2-y^2)
FN.END


FN.DEF            kxy( x,y,z, _3[] , re [], point )

 x              = x- _3[41]
 y              = y- _3[42]
 z              = z- _3[43]

 xx             = x
 x              = COS( _3[53] )*x -SIN( _3[53] )*y
 y              = SIN( _3[53] )*xx+COS( _3[53] )*y
 z              = COS( _3[52] )*z +SIN( _3[52] )*y
 y              =-SIN( _3[52] )*z +COS( _3[52] )*y

 x1             = COS( _3[51] )*x +SIN( _3[51] )*z
 px             = ( x1- _3[32] )*( _3[31] - _3[33] )/( y- _3[33] )
 re[point,1]    = _3[1] + _3[3]/2 + px * _3[3] / ( _3[12] - _3[11] )

 z1             =-SIN( _3[51] )*x +COS( _3[51] )*z
 py             = ( z1- _3[32] )*( _3[31] - _3[33] )/( y- _3[33] )
 re[point,2]    = _3[2] + _3[4]/2 - py * _3[4] / ( _3[16] - _3[15] )

FN.END



FN.DEF sgn ( val )
 IF val> 0 THEN FN.RTN 1
 IF val< 0 THEN FN.RTN -1
 FN.RTN 0
FN.END

RETURN