autodefine "off"

$use "dx3d9r.lib"

'Declare timer
DECLARE "kernel32",GetTickCount(),INT
'Declare cylinder function
DECLARE cylinder(numberofsections:INT,topfacepresent:INT,bottomfacepresent:INT,smooth:INT)

DEF win:WINDOW
DEF imagefile:BFILE
DEF error,run:INT
DEF mult,wrap[13],brightnessmult,sunspeed:FLOAT
DEF scene,camera,light,light2,light3,ground,sun,sunpivot,sunlight,moon,moonlight:INT
DEF iscameratranslation,lastframetime,timesincelastframe,n,sunwasup:INT
DEF post[12],postshadow[12],postx[12],postz[12],shadowlength:INT
DEF lastcamerax,lastcameraz,camerax,cameraz,translation,sunangle:FLOAT

sunwasup=1
sunangle=0

CONST sunspeed=.002

'Open a window
OPENWINDOW win,0,0,640,480,@NOAUTODRAW,0,"Woodhenge",&mainwindow
STARTTIMER win,100
run=1

error=OPENFILE(imagefile,GETSTARTPATH+"grass-texture.bmp","R")
IF error
  'Bitmap does not exist.Create it
  PRINT win,"Generating texture"
  generategrasstextureimage()
ELSE
  CLOSEFILE imagefile
ENDIF

'Create a 3D screen
error=CREATE3DSCREEN(win,640,480,32)

IF error<>0
  MESSAGEBOX win, "Could not create Direct3D screen","Error"
  CLOSEWINDOW win
  END
ENDIF

'Hide cursor
SETCURSOR win,@CSCUSTOM,0

D3DSETQUALITY win,@LIGHTON | @FILLSOLID | @SHADEGOURAUD
FRONTPEN win,RGB(255,255,255)
BACKPEN win,0
DRAWMODE win,@TRANSPARENT

'The parent scene frame
scene = D3DSCENE(win)
D3DCOMMAND scene,@SETSCENEBACKCOLOR,.2,.2,1

'Create and position the camera
camera = D3DCAMERA(scene)
camerax=0:cameraz=-1000
D3DCOMMAND camera,@SETPOSITION,scene,0,80,-1000
D3DCOMMAND camera,@SETORIENTATION,scene,0,0,1,0,1,0

'Create and orient a light source
light = D3DLIGHT(scene,@LIGHTDIRECTIONAL,.8,.8,.8)
D3DCOMMAND light,@SETORIENTATION,scene,-1,-1,1, -1,1,1

'Create and orient a light source
light2 = D3DLIGHT(scene,@LIGHTDIRECTIONAL,.6,.6,.6)
D3DCOMMAND light2,@SETORIENTATION,scene,1,-1,1, 1,1,1

'Create and orient a light source
light3 = D3DLIGHT(scene,@LIGHTDIRECTIONAL,1,1,1)
D3DCOMMAND light3,@SETORIENTATION,scene,0,-1,-1, 0,1,1

'Create textured ground
DEF vertex1,vertex2,vertex3,vertex4,facedata[10],normal:INT
wrap=0,0,0, 0,1,0, 1,0,0, 0,0, .003,.003
ground=D3DSHAPE(scene,@SHAPECUSTOM)
vertex1=D3DCOMMAND (ground,@ADDVERTEX,-1000,0,1000)
vertex2=D3DCOMMAND (ground,@ADDVERTEX,1000,0,1000)
vertex3=D3DCOMMAND (ground,@ADDVERTEX,1000,0,-1000)
vertex4=D3DCOMMAND (ground,@ADDVERTEX,-1000,0,-1000)
normal=D3DCOMMAND (ground,@ADDNORMAL,0,1,0)
facedata=4,vertex1,normal,vertex2,normal,vertex3,normal,vertex4,normal,0
D3DCOMMAND ground,@ADDFACES,facedata
D3DCOMMAND ground,@CUSTOMINIT
D3DCOMMAND ground,@SETSHAPECOLOR,0,1,0
D3DCOMMAND ground,@CREATEWRAP,ground,@WRAPFLAT,wrap
D3DCOMMAND ground,@LOADTEXTURE,GETSTARTPATH+"grass-texture.bmp"

'Create posts and shadows
FOR n=0 TO 11
  'Create posts
  post[n]=cylinder(12,0,0,1)
  D3DCOMMAND post[n],@SETSHAPECOLOR,.6,.4,0
  D3DCOMMAND post[n],@SCALE,6,60,6
  postx[n]=200*SIN(n*6.283/12):postz[n]=200*COS(n*6.283/12)
  D3DCOMMAND post[n],@SETPOSITION,scene,postx[n],60,postz[n]
  'Create shadows
  postshadow[n]=D3DSHAPE(scene,@SHAPECUSTOM)
  vertex1=D3DCOMMAND (postshadow[n],@ADDVERTEX,0,0.1,-6)
  vertex2=D3DCOMMAND (postshadow[n],@ADDVERTEX,0,0.1,6)
  vertex3=D3DCOMMAND (postshadow[n],@ADDVERTEX,100,0.1,6)
  vertex4=D3DCOMMAND (postshadow[n],@ADDVERTEX,100,0.1,-6)
  normal=D3DCOMMAND (postshadow[n],@ADDNORMAL,0,1,0)
  facedata=4,vertex1,normal,vertex2,normal,vertex3,normal,vertex4,normal,0
  D3DCOMMAND postshadow[n],@ADDFACES,facedata
  D3DCOMMAND postshadow[n],@CUSTOMINIT
  D3DCOMMAND postshadow[n],@SETPOSITION,scene,postx[n],0,postz[n]
  'Set shadow colour to semitransparent black
  D3DCOMMAND postshadow[n],@SETSHAPECOLOR,0,0,0,.4
NEXT n

'Create sun
DEF material[10]:FLOAT
'Create sun pivot.As this is rotated the sun will circle
sunpivot=D3DSHAPE(scene,@SHAPECUSTOM)
sun=D3DSHAPE(sunpivot,@SHAPESPHERE,50,10)
D3DCOMMAND sun,@SETPOSITION,sunpivot,-3000,0,0
'Make sun emit yellow light and be unaffected by scene lights
D3DCOMMAND sun,@SETSHAPECOLOR,0,0,0
material=1, 0,0,0 ,1,1,0 ,0,0,0
D3DCOMMAND sun,@CREATEMATERIAL,material
'Attach light to sun
sunlight = D3DLIGHT(sun,@LIGHTDIRECTIONAL,.5,.5,.5)
D3DCOMMAND sunlight,@SETORIENTATION,scene,1,0,0, 0,1,0

'Create moon
moon=D3DSHAPE(sunpivot,@SHAPESPHERE,50,10)
D3DCOMMAND moon,@SETPOSITION,sunpivot,3000,0,0
'Make moon emit white light and be unaffected by scene lights
D3DCOMMAND moon,@SETSHAPECOLOR,0,0,0
material=1, 0,0,0 ,1,1,1 ,0,0,0
D3DCOMMAND moon,@CREATEMATERIAL,material
'Attach light to moon
moonlight = D3DLIGHT(moon,@LIGHTDIRECTIONAL,.3,.3,.3)
D3DCOMMAND moonlight,@SETORIENTATION,scene,-1,0,0, 0,1,0

'Set sunpivot at angle so sun and moon rise and set
D3DCOMMAND sunpivot,@ADDROTATION,1,0,0,-.3

lastframetime=GetTickCount()-1

'Process messages until somebody closes us
WAITUNTIL run=0
'Delete all the frames
FOR n=0 TO 11
  D3DDELETE post[n]
  D3DDELETE postshadow[n]
NEXT n
D3DDELETE sun
D3DDELETE sunpivot
D3DDELETE sunlight
D3DDELETE moon
D3DDELETE moonlight
D3DDELETE light
D3DDELETE light2
D3DDELETE light3
D3DDELETE camera
D3DDELETE ground
D3DDELETE scene
CLOSEWINDOW win
END

SUB mainwindow(),INT
  SELECT @MESSAGE
   CASE @IDCHAR
      IF (@CODE = ASC("Q")) | (@CODE = ASC("q")) THEN run = 0
   CASE @IDCREATE
      CENTERWINDOW win
   CASE @IDCLOSEWINDOW
      run=0
   CASE @IDDXUPDATE
      'Find time since last frame to make things run at a constant speed
      timesincelastframe=GetTickCount()-lastframetime
      IF timesincelastframe>1
        lastframetime=GetTickCount()
        mult=timesincelastframe/8
        iscameratranslation=0

        'Move sun
         D3DCOMMAND sunpivot,@ADDROTATION,0,1,0,mult*sunspeed
         sunangle=sunangle+mult*sunspeed
         IF sunangle>6.283 THEN sunangle=sunangle-6.283

         IF ((sunangle<20*6.283/360) | (sunangle>340*6.283/360) | ((sunangle>160*6.283/360) & (sunangle<200*6.283/360)))
           IF sunangle<20*6.283/360 THEN brightnessmult=.5+sunangle*1.432
           IF sunangle>340*6.283/360 THEN brightnessmult=.5-(6.283-sunangle)*1.432
           IF ((sunangle>160*6.283/360) & (sunangle<200*6.283/360)) THEN brightnessmult=1-(sunangle-2.793)*1.432
           'brightnessmult=0 for sunangle=340 and sunangle=200
           'brightnessmult=0.5 for sunangle=0 and sunangle=180
           'brightnessmult=1 for sunangle>20 and sunangle<160
           'Set light intensities
           D3DCOMMAND light,@SETLIGHTCOLOR,.2+.7*brightnessmult,.2+.7*brightnessmult,.2+.7*brightnessmult
           D3DCOMMAND light2,@SETLIGHTCOLOR,.1+.5*brightnessmult,.1+.5*brightnessmult,.1+.5*brightnessmult
           D3DCOMMAND light3,@SETLIGHTCOLOR,.3+.7*brightnessmult,.3+.7*brightnessmult,.3+.7*brightnessmult
           'Set sky colour
           D3DCOMMAND scene,@SETSCENEBACKCOLOR,.05+.15*brightnessmult,.05+.15*brightnessmult,.25+.75*brightnessmult
           'Set post shadow transparency
           FOR n=0 TO 11
             D3DCOMMAND postshadow[n],@SETSHAPECOLOR,0,0,0,.8*ABS(brightnessmult-.5)
           NEXT n
           IF ((sunangle<20*6.283/360) | ((sunangle>160*6.283/360) & (sunangle<180*6.283/360)))
              'Sun rising or setting
              'Set sunlight intensity
              D3DCOMMAND sunlight,@SETLIGHTCOLOR,.5*2*(brightnessmult-.5),.5*2*(brightnessmult-.5),.5*2*(brightnessmult-.5)
              'Set moonlight intensity
              D3DCOMMAND moonlight,@SETLIGHTCOLOR,.3-.3*2*(brightnessmult-.5),.3-.3*2*(brightnessmult-.5),.3-.3*2*(brightnessmult-.5)
           ENDIF
         ENDIF

        'Move post shadows and change length
         IF sunangle>3.142 & sunwasup
            sunwasup=0
            'Change shadow direction so moon shadow
            FOR n=0 TO 11
              D3DCOMMAND postshadow[n],@ADDROTATION,0,1,0,3.142
            NEXT n
         ENDIF
         IF sunangle<3.142 & sunwasup=0
            sunwasup=1
            'Change shadow direction so sun shadow
            FOR n=0 TO 11
              D3DCOMMAND postshadow[n],@ADDROTATION,0,1,0,3.142
            NEXT n
         ENDIF
        shadowlength=100/(2-ABS(COS(sunangle)))
        FOR n=0 TO 11
          D3DCOMMAND postshadow[n],@ADDROTATION,0,1,0,mult*sunspeed
          D3DCOMMAND (postshadow[n],@SETVERTEX,2,shadowlength,0.1,6)
          D3DCOMMAND (postshadow[n],@SETVERTEX,3,shadowlength,0.1,-6)
        NEXT n

      'The camera can move in the scene using the arrow keys
        'Up arrow
      IF(GETKEYSTATE(0x26))
         D3DCOMMAND camera,@ADDTRANSLATION,0,0,.7*mult
          translation=.7*mult
          iscameratranslation=1
      ENDIF
        'Down arrow
      IF(GETKEYSTATE(0x28))
          translation=-.7*mult
        D3DCOMMAND camera,@ADDTRANSLATION,0,0,-.7*mult
          iscameratranslation=1
      ENDIF
        'Left arrow
      IF(GETKEYSTATE(0x25))
         D3DCOMMAND camera,@ADDROTATION,0,1,0,(-.5 * (3.1415/180))*mult
      ENDIF
        'Right arrow
      IF(GETKEYSTATE(0x27))
         D3DCOMMAND camera,@ADDROTATION,0,1,0,(.5 * (3.1415/180))*mult
      ENDIF

        IF iscameratranslation
          'Check for collision with posts
          collisiondetection()
        ENDIF

        lastcamerax=camerax
		lastcameraz=cameraz

      'Render the scene to the DirectX surface
      D3DRENDER scene,camera
      'Add any 2D elements after the scene is rendered.
      MOVE win,5,5
      PRINT win,"Move around the scene with the arrow keys. Press Q to exit"
      'Show the DirectX surface   
      DXFLIP win,0,0
      ENDIF
  ENDSELECT
RETURN 0
ENDSUB

SUB cylinder(numberofsections,topfacepresent,bottomfacepresent,smooth)
'Function creates a cylinder with the given number of sections.Minimum number of sections is three.
'topfacepresent,bottomfacepresent and smooth should be 0 or 1.
'If smooth is set to one then cylinder sides will appear smooth if @SHADEGOURAUD used.
'If smooth set to zero then sides will appear flat even if @SHADEGOURAUD is used.
'Jolly Roger March 2003
DEF shape,numberofvertices:INT
DEF x,z:FLOAT
IF numberofsections>2
  shape=D3DSHAPE(scene,@SHAPECUSTOM)
  numberofvertices=numberofsections*2
  DEF vertex[numberofvertices],normal[numberofsections],facedata[((2*numberofsections)+5)]:INT
  'Create vertices and side face normals
  FOR section=0 TO numberofsections-1
    x=SIN(6.28*section/numberofsections)
    z=COS(6.28*section/numberofsections)
    IF smooth=0
      normal[section]=D3DCOMMAND(shape,@ADDNORMAL,SIN(6.28*(section+.5)/numberofsections),0,COS(6.28*(section+.5)/numberofsections))
    ELSE
      normal[section]=D3DCOMMAND(shape,@ADDNORMAL,x,0,z)
    ENDIF
    vertex[section]=D3DCOMMAND (shape,@ADDVERTEX,x,1,z)
    vertex[section+numberofsections]=D3DCOMMAND (shape,@ADDVERTEX,x,-1,z)
  NEXT section
  'Create faces
  IF topfacepresent=1
     'Top face
     facedata[0]=numberofsections
     topnormal=D3DCOMMAND(shape,@ADDNORMAL,0,1,0)
     FOR section=0 TO numberofsections-1
       facedata[section*2+1]=vertex[section],topnormal
     NEXT section
     facedata[2*numberofsections+1]=0
     D3DCOMMAND (shape,@ADDFACES,facedata)
  ENDIF
  IF bottomfacepresent=1
     'Bottom face
     facedata[0]=numberofsections
     bottomnormal=D3DCOMMAND(shape,@ADDNORMAL,0,-1,0)
     FOR section=0 TO numberofsections-1
       facedata[section*2+1]=vertex[2*numberofsections-section-1],bottomnormal
     NEXT section
     facedata[2*numberofsections+1]=0
     D3DCOMMAND (shape,@ADDFACES,facedata)
  ENDIF
  'Side faces
  facedata[0]=4
  FOR section=0 TO numberofsections-1
    facedata[1]=vertex[section],normal[section],vertex[section+numberofsections],normal[section]
    IF section<>numberofsections-1
      facedata[5]=vertex[section+1+numberofsections],normal[section+1],vertex[section+1],normal[section+1]
    ELSE
      facedata[5]=vertex[numberofsections],normal[0],vertex[0],normal[0]
    ENDIF
    IF smooth=0
      facedata[6]=normal[section]
      facedata[8]=normal[section]
    ENDIF
    facedata[9]=0
    D3DCOMMAND (shape,@ADDFACES,facedata)
  NEXT section
  D3DCOMMAND shape,@CUSTOMINIT
ENDIF
RETURN shape
ENDSUB

SUB collisiondetection()
  DEF dx,dz:INT
  DEF camerapos[3]:FLOAT
  'Get current camera position
   D3DCOMMAND camera,@GETPOSITION,scene,camerapos
   camerax=camerapos[0]:cameraz=camerapos[2]
   FOR n=0 TO 11
     dx=camerax-postx[n]:dz=cameraz-postz[n]
     IF dx*dx+dz*dz<49
       'Collided with post(within 7 units of centre of post)
       'Reset camera to position in previous frame
      D3DCOMMAND camera,@SETPOSITION,scene,lastcamerax,80,lastcameraz
       camerax=lastcamerax:cameraz=lastcameraz
       n=11
     ENDIF
   NEXT n
ENDSUB

SUB generategrasstextureimage()
  'Creates a 256x256 texture for the grass
  DEF byte:CHAR
  DEF twobytes:WORD
  DEF integer,filelength,width,height:INT
  TYPE threebytes
    DEF blue:CHAR
    DEF green:CHAR
    DEF red:CHAR
  ENDTYPE
  DEF colourdata:threebytes
  width=256:height=256
  error=OPENFILE(imagefile,GETSTARTPATH+"grass-texture.bmp","W")
  IF error=0
     'File opened successfully
     filelength=54+4*CEIL(3*width/4)*height
     'Write header
     byte=ASC("B"):WRITE imagefile,byte
     byte=ASC("M"):WRITE imagefile,byte
     WRITE imagefile,filelength
     integer=0:WRITE imagefile,integer
     integer=54:WRITE imagefile,integer
     integer=40:WRITE imagefile,integer
     WRITE imagefile,width
     WRITE imagefile,height
     twobytes=1:WRITE imagefile,twobytes
     twobytes=24:WRITE imagefile,twobytes
     integer=0:FOR n=1 TO 6:WRITE imagefile,integer:NEXT n
     'Write colour data
     FOR y=height-1 TO 0 STEP -1
       FOR x=0 TO width-1
          colourdata.red=0:colourdata.green=100+RND(155):colourdata.blue=0
          WRITE imagefile,colourdata
       NEXT x
       IF (width*3)%4<>0
         'Pad out so number of bytes in row is a multiple of four
         byte=0
         FOR n=1 TO 4-(width*3)%4
           WRITE imagefile,byte
         NEXT n
       ENDIF
     NEXT y
     CLOSEFILE imagefile
  ENDIF
ENDSUB