#!/usr/bin/env sim

  Copyright (C) 2009 by
  Dipl.-Ing. Michael Niederle

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License, version 2.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  GNU General Public License for more details.

  For details of the GNU General Public License see
  http://www.gnu.org/copyleft/gpl.html
  or write to the
  Free Software Foundation, Inc.,
  59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

<require system/x11>

writeln "Cave 3D"

declare $$landscape $$ship $$shot $$cannon

$ambient_colour float_array(0 0 0 1)
$light_0_colour float_array(1 1 1 1)
$light_0_position float_array(0 0 0 1)

$CAVE_DEPTH 1000

$$cave_x array()
$$cave_y array()
$$cave_normal array()

$$tick 0 # virtual time

set_seed 76
do:
  # compute cave dimensions
  $$x 0
  $$y 0
  $$dx 0
  $$dy 0
  $$drw 0
  $$drh 0
  $$rw 10+2*random()
  $$rh 10+2*random()
  $$roughness 0.5
  2->down_to -(CAVE_DEPTH+2): [z]
    dx=>reduce_to 0.3
    dx=>extend_to -0.3
    dy=>reduce_to 0.3
    dy=>extend_to -0.3
    dx=>inc 0.1*(random()-0.5)
    dy=>inc 0.1*(random()-0.5)
    drw=>inc 0.1*(random()-0.5)
    drh=>inc 0.1*(random()-0.5)
    drw=>reduce_to 0.3
    drw=>extend_to -0.3
    drh=>reduce_to 0.3
    drh=>extend_to -0.3
    rw=>inc drw
    rh=>inc drh
    if rw < 8 || rw > 16: !drw -drw
    if rh < 8 || rh > 16: !drh -drh
    roughness=>inc (random()-0.5)*0.1
    roughness=>reduce_to 2
    roughness=>extend_to 0.2
    x=>inc 3*random()*dx
    y=>inc 3*random()*dy
    $$cave_line_x array()
    $$cave_line_y array()
    0->to 35: [a]
      $alpha a*PI/18
      $rw0 rw+random()*roughness
      $rh0 rh+random()*roughness
      !cave_line_x(a) x+rw0*cos(alpha)
      !cave_line_y(a) y+rh0*sin(alpha)
    !cave_x(z) cave_line_x
    !cave_y(z) cave_line_y

  # compute normal vectors
  1->down_to -(CAVE_DEPTH+1): [z]
    $$cave_line_normal array()
    0->to 35: [a]
      $next_a (a+1)->mod(36)
      $prev_a (a-1)->mod(36)
      $v1 vector(cave_x(z+1)(a)-cave_x(z)(a) cave_y(z+1)(a)-cave_y(z)(a) -1)
      $v2 vector(cave_x(z)(prev_a)-cave_x(z)(a) cave_y(z)(prev_a)-cave_y(z)(a) 0)
      $v3 vector(cave_x(z-1)(a)-cave_x(z)(a) cave_y(z-1)(a)-cave_y(z)(a) -1)
      $v4 vector(cave_x(z)(next_a)-cave_x(z)(a) cave_y(z)(next_a)-cave_y(z)(a) 0)
      !cave_line_normal(a)
	(
	  (v2*v1)->normalize()+
	  (v3*v2)->normalize()+
	  (v4*v3)->normalize()+
	  (v1*v4)->normalize()
	)->normalize()
    !cave_normal(z) cave_line_normal

$$autopilot true
$$pause false

$normal_vector: [z a]
  #$next_a (a+1)->mod(36)
  #$prev_a (a-1)->mod(36)
  $nv cave_normal(z)(a)
  #$nv
    cave_normal(z)(a)+
    cave_normal(z)(prev_a)*0.5+
    cave_normal(z)(next_a)*0.5+
    cave_normal(z+1)(a)*0.5+
    cave_normal(z-1)(a)*0.5
  glNormal3f nv'x nv'y nv'z

$init_scene:
  generate_display_lists !landscape !ship !shot !cannon

  define_display_list landscape:
    scene:
      $$red 0.2
      $$green 0.8
      $$blue 0.2
      (-1)->down_to -CAVE_DEPTH: [z]
	if random() > 0.97: # create crystal
	  $a 6+random(5)
	  at cave_x(z)(a) cave_y(z)(a)+0.5 z:
	    rotate_z 180
	    rotate_y 90*random()
	    colour 0.2 0.2 0.8
	    pyramid 2 3 2
	if random() > 0.99: # wall
	  colour 0.8 0 0.3
	  draw_cuboid cave_x(z)(27)-20 cave_y(z)(27)-2 z 40 6 1
	triangle_strip:
	  red=>inc (random()-0.5)*0.02
	  green=>inc (random()-0.5)*0.02
	  blue=>inc (random()-0.5)*0.02
	  red=>reduce_to 0.5
	  red=>extend_to 0.1
	  green=>reduce_to 0.9
	  green=>extend_to 0.5
	  blue=>reduce_to 0.5
	  blue=>extend_to 0.1
	  colour red green blue
	  0->to 36: [$a]
	    if a == 36: !a 0
	    normal_vector z a
	    glVertex3f cave_x(z)(a) cave_y(z)(a) z
	    normal_vector z+1 a
	    glVertex3f cave_x(z+1)(a) cave_y(z+1)(a) z+1
    #scene: # test scene (e.g. for lighting effects)
      at 0 0 -50: box 10 5 10
      at 0 5 -50: sphere 5 20
      colour 0.2 0.8 0.2
      100->times:
	at 300*random()-150 0 -300*random():
	  box 1+3*random() 1+3*random() 1+3*random()

  define_display_list ship:
    scene:
      colour 0.5 0.01 0.01
      at -1 0 -1: box 0.3 0.2 3
      at 1 0 -1: box 0.3 0.2 3

  define_display_list shot:
    scene:
      colour 1 0 0
      sphere 0.2 12

  define_display_list cannon:
    scene:
      colour 0 0 0
      box 0.6 1.5 0.6

$draw_scene: [win]
  set_camera_angle 35
  set_camera_z_clipping 1 200
  set_camera win

  glEnable GL'DEPTH_TEST
  glEnable GL'COLOR_MATERIAL
  glEnable GL'LIGHTING
  glLightModelfv GL'LIGHT_MODEL_AMBIENT ambient_colour
  glEnable GL'LIGHT0
  glLightfv GL'LIGHT0 GL'POSITION light_0_position
  glLightf GL'LIGHT0 GL'SPOT_CUTOFF 35
  glLightf GL'LIGHT0 GL'SPOT_EXPONENT 10
  glLightf GL'LIGHT0 GL'CONSTANT_ATTENUATION 0
  glLightf GL'LIGHT0 GL'LINEAR_ATTENUATION 0
  glLightf GL'LIGHT0 GL'QUADRATIC_ATTENUATION 0.0005
  glEnable GL'NORMALIZE

  at_camera:
    apply_display_list landscape
    do:
      $z floor(camera_z()/200)*200
      if z < 0 && z > -CAVE_DEPTH:
	$$h tick->mod(30)
	at cave_x(z)(27) cave_y(z)(27) z:
	  apply_display_list cannon
	  move 0.1 h -0.1
	  apply_display_list shot

  glLoadIdentity
  apply_display_list ship

!X11_display XOpenDisplay(NULL)
if X11_display->address() == 0: raise "Connection to X-Server failed!"
!X11_screen XDefaultScreen()
$root XDefaultRootWindow()

$attributes int_array(GLX'RGBA GLX'DEPTH_SIZE 24 GLX'DOUBLEBUFFER X'None)

$$vi glXChooseVisual(X11_screen attributes)
if vi->address() == 0: raise "Connection to X-Server failed!"

$colormap root->create_colormap(vi'visual X'AllocNone)

$$set_window_attributes allocate_memory('XSetWindowAttributes)
!set_window_attributes'colormap colormap
$wanted_events X'ExposureMask | X'KeyPressMask | X'ButtonPressMask
!set_window_attributes'event_mask wanted_events

$$win
  root->create
    0 0 1280 960 0 vi'depth
    X'InputOutput
    vi'visual
    X'CWColormap | X'CWEventMask
    set_window_attributes

win->store_name "Cave 3D"
win->map

$glx_context glXCreateContext(vi NULL GL'TRUE)
glXMakeCurrent win glx_context

init_scene

$finalize_openGL:
  glXMakeCurrent X'None NULL
  glXDestroyContext glx_context
  win->destroy
  XCloseDisplay

$$roll 0
$$turn 0
$$pull 0

$ROLL_STEP 1
$TURN_STEP 1
$PULL_STEP 1

$INITIAL_SPEED 1


$start_game:
  set_camera_position 0 0 30
  set_camera_heading vector(0 0 -1)
  set_camera_upright vector(0 1 0)
  set_camera_speed INITIAL_SPEED

start_game

$distance_2d: [x1 y1 x2 y2 sx sy]
  # x1/x2 and x2/y2 define a line within the z-plane
  # sx/sy defines a point within the z-plane
  # the distance between point and line is returned

  $vx sx-x1
  $vy sy-y1

  $nx y2-y1
  $ny x1-x2

  [abs((vx*nx+vy*ny)/sqrt(nx*nx+ny*ny))]

$event allocate_memory('XEvent)
forever:
  if
    event->check_mask(wanted_events):
      case event'type
	X'Expose:
	  if event'xexpose'count == 0:
	    update_window_attributes &win
	    draw_scene win
	    glXSwapBuffers win
	X'KeyPress:
	  case event'keycode
	    9: # escape
	      finalize_openGL
	      terminate
	    25: # 'w' - accelerate
	      !autopilot false
	      $$speed camera_speed()+0.01
	      speed=>reduce_to 1
	      set_camera_speed speed
	    39: # 's' - decelerate
	      !autopilot false
	      $$speed camera_speed()-0.01
	      speed=>extend_to 0.3
	      set_camera_speed speed
	    33: # 's' - pause
	      !pause not(pause)
	    52: # 'y
	      !autopilot false
	      roll=>dec 2
	    53: # 'x'
	      !autopilot false
	      roll=>inc 2
	    98: # cursor up - nose down
	      !autopilot false
	      pull=>dec 2
	    100: # cursor left - turn left
	      !autopilot false
	      turn=>dec 2
	    102: # cursor right - turn right
	      !autopilot false
	      turn=>inc 2
	    104: # cursor down - nose up
	      !autopilot false
	      pull=>inc 2
	    :
	      writeln event'keycode
	X'ButtonPress:
	  finalize_openGL
	  terminate
    :
      $t1 current_time()
      ifdef win.width: # ready to draw?
	unless pause:
	  camera_step
	  $$cx camera_x()
	  $$cy camera_y()
	  $cz camera_z()
	  $z floor(cz)
	  if z <= 0 && z >= -CAVE_DEPTH:
	    do: [-> break]
	      # check for collision with cave walls
	      0->to 35: [a1]
		$a2 (a1+1)->mod(36)
		if
		  (
		    distance_2d
		      cave_x(z)(a1) cave_y(z)(a1)
		      cave_x(z)(a2) cave_y(z)(a2)
		      cx
		      cy
		  ) < 1:
		    writeln "wall collision"
		    start_game
		    break
	    if autopilot:
	      $$dx (cave_x(z)(0)+cave_x(z)(18))/2-cx
	      $$dy (cave_y(z)(9)+cave_y(z)(27))/2-cy
	      dx=>reduce_to 0.1
	      dx=>extend_to -0.1
	      dy=>reduce_to 0.1
	      dy=>extend_to -0.1
	      cx=>inc dx
	      cy=>inc dy
	      set_camera_position cx cy cz
	  if roll > 0:
	    roll_right ROLL_STEP
	    roll=>dec ROLL_STEP
	    roll=>extend_to 0
	  if roll < 0:
	    roll_left ROLL_STEP
	    roll=>inc ROLL_STEP
	    roll=>reduce_to 0
	  if turn > 0:
	    turn_right TURN_STEP
	    turn=>dec TURN_STEP
	    turn=>extend_to 0
	  if turn < 0:
	    turn_left TURN_STEP
	    turn=>inc TURN_STEP
	    turn=>reduce_to 0
	  if pull > 0:
	    pull_up PULL_STEP
	    pull=>dec PULL_STEP
	    pull=>extend_to 0
	  if pull < 0:
	    pull_down PULL_STEP
	    pull=>inc PULL_STEP
	    pull=>reduce_to 0
	  if camera_z() < -CAVE_DEPTH+20:
	    writeln "level successful"
	    start_game
	  draw_scene win
	  glXSwapBuffers win
	  tick=>inc
      $t2 current_time()
      $dt t2-t1
      # display a maximum of 25 frames per second
      if dt < 0.04: sleep 0.04-dt