USING: accessors arrays assocs combinators kernel math 
sequences vectors literals
   juere-engine.stage
   juere-engine.utils ;
IN: juere-engine.level-editor

TUPLE: lv-editor < stage 
   active-mat mat-atlas ;

GENERIC#: push-active-mat 1 ( subject index -- )
M: object push-active-mat 2drop ;
M: lv-editor push-active-mat 
   >>active-mat drop ;

GENERIC#: next-mat 1 ( subject val -- )
M: object next-mat 2drop ;
M: lv-editor next-mat 
   dupd '[ active-mat>> _ + ] [ mat-atlas>> ] bi
   dupd ?nth [ drop 0 ] unless >>active-mat drop ;

: @mat ( lv-editor -- material )
   [ active-mat>> ] [ mat-atlas>> ] bi nth ;

GENERIC#: push-tile 1 ( subject xz -- )
M: object push-tile 2drop ;
M: lv-editor push-tile 
   over [ tiles>> ] [ @mat ] bi 
   [ >>material ] curry ?change-at drop ;

GENERIC#: raise-tile 2 ( subject xz h -- )
M: object raise-tile 3drop ;
M: lv-editor raise-tile 
   [ first2 ] dip [ [ + ] curry change-height ] 
   curry with-tile drop ;

GENERIC#: newtile 1 ( subject xz -- )
M: object newtile 2drop ;
M: lv-editor newtile 
   dup pick tiles>> key? not [ 
      0 pick @mat V{ } tile boa 2array
      [ suffix ] curry change-tiles drop
   ] [ 2drop ] if ;

GENERIC#: delete-tile 1 ( subject xz -- )
M: object delete-tile 2drop ;
M: lv-editor delete-tile over tiles>> delete-at drop ;

TUPLE: cursor < entity
   raise-by delete@? push@? ;

M:: cursor entity-action ( entity stage quots -- quots )
   { { [ entity raise-by>> ] [
           entity raise-by>> 
              :> raise-by
           entity f >>raise-by
              clipped-pos :> pos
           { [ pos newtile ] [ pos raise-by raise-tile ] }
     ] }
     { [ entity delete@?>> ] [
           entity f >>delete@?
              clipped-pos :> pos
          { [ pos delete-tile ] }  
     ] } 
     { [ entity push@?>> ] [
           entity f >>push@?
              clipped-pos :> pos
          { [ pos push-tile ] }  
     ] } 
     [ { [ drop ] } ] 
   } cond :> quots'
   entity stage 
      quots quots' append 
   call-next-method ;

GENERIC#: raise@cursor 1 ( subject h -- )
M: object raise@cursor 2drop ;
M: cursor raise@cursor >>raise-by drop ;

GENERIC#: del@cursor 0 ( subject -- )
M: object del@cursor drop ;
M: cursor del@cursor t >>delete@? drop ;

GENERIC#: push-tile@cursor 0 ( subject -- )
M: object push-tile@cursor drop ;
M: cursor push-tile@cursor t >>push@? drop ;

CONSTANT: base-atlas ${ 
   <default-mat>
      "gimp-bluegrid.bmp" "watersq.bmp"
   <mat> }

M: lv-editor substage drop ${ 0 base-atlas } ;

CONSTANT: putit-ani {
   { "idle" { ${  0 "tank-putit-b.bmp" <rsrc> }
              ${ 20 "tank-putit-a.bmp" <rsrc> }
               { 40 end-animation }
   } } 
   { "boom" { ${  0 "tank-putit-boom-a.bmp" <rsrc> }
              ${ 20 "tank-putit-boom-b.bmp" <rsrc> }
              ${ 40 "tank-putit-boom-c.bmp" <rsrc> }
               { 60 end-animation }
   } }
   }

: tank-putit ( -- animated )
   1 "tank-putit-a.bmp" <rsrc> 0.015 { 1.5 1.5 }
   0 { } { } 
   putit-ani "idle" "boom" 1
   animated boa ;

! Well this gets tedious fast. Animation editor when?
CONSTANT: chicken-up-ani {
      { "idle" { ${  0 "chicken/up-a.png" <rsrc> }
                 ${ 10 "chicken/up-b.png" <rsrc> }
                 ${ 20 "chicken/up-c.png" <rsrc> }
                  { 30 end-animation }
   } } }

CONSTANT: chicken-side-ani {
      { "idle" { ${  0 "chicken/side-a.png" <rsrc> }
                 ${ 10 "chicken/side-b.png" <rsrc> }
                 ${ 20 "chicken/side-c.png" <rsrc> }
                  { 30 end-animation }
   } } }

CONSTANT: chicken-r-side-ani {
      { "idle" { ${  0 "chicken/r-side-a.png" <rsrc> }
                 ${ 10 "chicken/r-side-b.png" <rsrc> }
                 ${ 20 "chicken/r-side-c.png" <rsrc> }
                  { 30 end-animation }
   } } }

CONSTANT: chicken-down-ani {
      { "idle" { ${  0 "chicken/down-a.png" <rsrc> }
                 ${ 10 "chicken/down-b.png" <rsrc> }
                 ${ 20 "chicken/down-c.png" <rsrc> }
                  { 30 end-animation }
   } } }

CONSTANT: chicken-angles {
   ${ 315 360 chicken-up-ani }
   ${   0  45 chicken-up-ani }
   ${  45 135 chicken-side-ani }
   ${ 135 225 chicken-down-ani }
   ${ 225 315 chicken-r-side-ani }
   }

TUPLE: turntable < angled ;
M: turntable entity-action ( entity stage quots -- quots )
   pick [ ticks>> ] [ ] bi angle<< 
   call-next-method ;

: chicken ( -- angled )
   1 "blank.bmp" <rsrc> 0.015 { 0.5 0.5 }
   0 { } { }
   chicken-up-ani "idle" "idle" 1
   chicken-angles { 1 0 chicken-down-ani } -45
   angled boa ;

: test-stage ( -- stage )
   3 ramped-tiles V{ }
   V{ }
!      1 "deadangel.bmp" <rsrc>
!      0.015 { 1.5 1.5 } boa suffix
      2 "liveangel.bmp" <rsrc>
      0.015 { -0.5 -0.5 } entity boa suffix
!      tank-putit suffix
      chicken suffix
   V{ } V{ }
   { 0 8 8 } 30 150
   stage boa ;