USING: accessors arrays calendar combinators kernel literals 
math math.vectors memoize sequences threads ui ui.gadgets 
ui.gadgets.worlds ui.gestures ui.pens ui.pixel-formats unicode
classes generic namespaces math.functions generalizations
   juere-engine.utils
   juere-engine.stage
   juere-engine.physics
   juere-engine.level-editor
   juere-engine.shooting-gallery
   juere-engine.rendering ;
IN: juere-engine

CONSTANT: mouse-sens { 0.002 0.002 }

CONSTANT: camv 0.1
CONSTANT: -camv -0.1

! == Control Processing 
TUPLE: control-state
   cam-Xv cam-Yv cam-Zv
   player-Xv player-Zv 
   click-state ;

: <controls> ( -- control-state )
   0 0 0 f f f control-state boa ;

: add-action ( stage-gt quot -- )
   [ add-action* ] curry change-stage drop ;

: move-tangible ( yaw xv xz -- action )
   [ or ] [ [ [ 0 ] unless* ] bi@
            2array xz>angle nip - 
            '[ 0 _ footfall ] 
   ] [ 3drop [ drop ] ] 2if ;

: move-intangible ( yaw xv xz -- action )
   [ [ 0 ] unless* ] bi@ [ -1 * ] dip
   rot rot-vector 2array -1 v*n
   '[ 0 _ move-entity ] ;

: apply-control-state ( stage-gt -- stage-gt )
   dup control-state>>
      [ cam-Xv>> ] [ cam-Yv>> ] [ cam-Zv>> ] tri 3array
      dupd [ move-camera ] curry add-action

   dup control-state>> click-state>>
      [ dupd [ set-crosshair ] curry add-action ] when*

   dup [ stage>> camera-yaw>> ] [ control-state>> ] bi
       [ player-Xv>> ] [ player-Zv>> ] bi
     [ move-tangible dupd add-action ] 3keep
     move-intangible over stage>> physical?
     [ drop ] [ dupd add-action ] if ;

! == Stage Gadget ==

! Declared in .rendering:
! TUPLE: stage-gadget < gadget
!   stage yaw pitch camera-xyz 
!   control-state stop? ;

SINGLETON: stage-pen
M: stage-pen draw-interior ( gadget pen -- )
   drop dup [ draw-stage ] curry with-3dgl ;

M: stage-gadget pref-dim* drop ${ 600 600 } ;
: <stage-gadget> ( stage -- gadget )
   stage-gadget new
        swap >>stage
   stage-pen >>interior
           t >>clipped?
          45 >>fov
  <controls> >>control-state ;

! == Threads ==

CONSTANT: ticktime 25

: update-thread ( gadget -- )
   dup stop?>> [ drop ] 
   [ ticktime milliseconds sleep
     apply-control-state
     dup stage>> do-actions
     dup relayout-1
     update-thread
   ] if ;

M: stage-gadget graft* ( gadget -- ) 
   ! How do we get tracebacks and errors out from a thread?
   f >>stop? [ update-thread ] curry in-thread ;

M: stage-gadget ungraft* ( gadget -- ) 
   t >>stop? drop ;

! == Keyboard Processing ==

: k-toggle ( stage-gt gesture accessor states -- ? )
   rot key-down? [ first ] [ second ] if 
   swap curry change-control-state ; inline

: if-down ( gesture quot -- ? )
   [ key-down? ] dip [ drop ] if t ; inline

: do-keys ( stage-gt gesture -- ? ) 
! Factor out into lv-edit/phys/etc.
   dup sym>> >lower { 
   { "w" [ [ >>cam-Zv ] { -0.1 0 } k-toggle ] }
   { "s" [ [ >>cam-Zv ] { 0.1 0 } k-toggle ] }
   { "a" [ [ >>cam-Xv ] { -0.1 0 } k-toggle ] }
   { "d" [ [ >>cam-Xv ] { 0.1 0 } k-toggle ] }
   { " " [ [ >>cam-Yv ] { -0.1 0 } k-toggle ] }
   { "tab" [ [ >>cam-Yv ] { 0.1 0 } k-toggle ] }

   { "up"    [ [ >>player-Zv ] { 0.1 f } k-toggle ] }
   { "down"  [ [ >>player-Zv ] { -0.1 f } k-toggle ] }
   { "left"  [ [ >>player-Xv ] { -0.1 f } k-toggle ] }
   { "right" [ [ >>player-Xv ] { 0.1 f } k-toggle ] }
   
   { "z" [ [ [ 0.05 raise@cursor ] add-action ] if-down ] }
   { "x" [ [ [ -0.05 raise@cursor ] add-action ] if-down ] }
   { "c" [ [ [ 0 jump ] add-action ] if-down ] }
   { "delete" [ [ [ del@cursor ] add-action ] if-down ] }

   { "b" [ [ [  1 next-mat ] add-action ] if-down ] }
   { "n" [ [ [ -1 next-mat ] add-action ] if-down ] }
   { "m" [ [ [ push-tile@cursor ] add-action ] if-down ] }

   [ 3drop f ]
   } case ;

: do-drag ( stage-gt gesture -- ? )
   drop drag-loc mouse-sens v* first2
   [ rotate-camera ] 2curry add-action t ;

: click-axis ( stage-gt -- d-yaw d-pitch )
   [ fov>> ] [ dim>> ] bi hand-click-loc get-global
   swap [ v/ 0.5 v-n ] keep first2 / '{ _ -1 } v*
   swap v*n first2 neg ;

:: pt@angles ( yaw pitch length -- point )
    pitch deg>rad cos length * yaw -90 + angle>xyz
    pitch neg deg>rad sin length * '{ 0 _ 0 } v+ ;

: clicked ( stage-gt length -- point )
   [ dup stage>> [ camera-xyz>> ] [ camera-yaw>> ] 
                 [ camera-pitch>> ] tri 
     4 nrot click-axis swapd [ + ] 2bi@ 
   ] dip pt@angles v+ ;

M: stage-gadget handle-gesture ( gesture gadget -- ? ) 
   swap 
   { { [ dup key-gesture? ] [ do-keys ] }
     { [ dup drag? ] [ do-drag ] }
     { [ dup button-down? ] 
         [ dupd drop 10 clicked [ >>click-state ] 
           curry change-control-state
           request-focus t ] } 
     [ 2drop f ]
   } cond ;

M: stage-gadget handles-gesture? 2drop t ;

! == Windows ==

MEMO: w-attributes ( -- pixel-format-attributes )
 T{ world-attributes 
   { pixel-format-attributes { 
      windowed
      double-buffered
      T{ depth-bits { value 16 } }
     } }
   { title "Juere Engine" }
 } ;

: run-juere ( gadget -- gadget )
   \ (load-texture) reset-memoized
   [ w-attributes open-window ] dupd curry with-ui ;

: juere-engine* ( -- gadget )
   test-stage <stage-gadget> run-juere ;