USING: accessors kernel locals math math.order namespaces
       processing.shapes sequences threads ui ui.gadgets ui.gestures
       ui.render ;

IN: pong-internal

! This version demonstrates the use of "internal words".
!
! Internal words are introduced using the '[wlet' form.
!
! With code which does not utilize locals, you only name top level
! words. And your factors are in terms of these only.
!
! With locals, you name intermedia values. Internal words let you
! factor out expressions involving these named intermediate values.
!
! Take a look at this version which uses locals, but whos main body is
! totally unfactored:
! 
!     http://paste.factorcode.org/paste?id=195
!
! Now consider some expressions that we factored.
! 
! This bit of code establishes four new internal words:
!
!       [wlet | ball-to-left?  [ ( x -- ? ) PX > ]
!               ball-to-right? [ ( x -- ? ) PX < ]
!               ball-below?    [ ( y -- ? ) PY > ]
!               ball-above?    [ ( y -- ? ) PY < ]
! 
! They simply give clearer names to expressions involving the
! position of the ball.
!
! So this expression which requires a bit of thought:
! 
!     HEIGHT PY <  0 VY <  PLAYER PX <  PX PLAYER PADDLE-SIZE + <
!
! Can now be:
! 
!     HEIGHT               ball-above?
!     VY 0 >
!     PLAYER               ball-to-right?
!     PLAYER PADDLE-SIZE + ball-to-left?   and and and
!
! The factoring doesn't have to stop there
! (although the code below does). That second expression could be named:
! 
!     ball-moving-up? [ VY 0 > ]
! 
! We could give the paddle edges more symmetrical names. And write a
! word for checking if the ball is "between" two values. Then our
! expression would become:
!
!     HEIGHT                   ball-above?
!                              ball-moving-up?
!     PLAYER-LEFT PLAYER-RIGHT ball-between?
! 
! So you can take factoring as far as you want to.
! 
! Here's a more advanced example.
! 
! Here's the code for when the ball bounces off the player's paddle:
! 
!     VY neg BOUNCE * MAX-VELOCITY min     VY! ! reverse vertical velocity
!     PX PLAYER PADDLE-SIZE 2 / + - 0.25 * VX! ! reverse horizontal velocity
!     HEIGHT PY!
! 
! And the code for bouncing off the computer's paddle:
! 
!     VY neg BOUNCE * MAX-VELOCITY min       VY! ! reverse vertical velocity
!     PX COMPUTER PADDLE-SIZE 2 / + - 0.25 * VX! ! reverse horizontal velocity
!     0 PY!
!     
! We've got some code duplication here. Let's take it line by line.
! 
! The first step in each of those blocks can be factored out:
! 
!     reverse-vertical-velocity [ ( -- ) VY neg BOUNCE * MAX-VELOCITY min VY! ]
! 
! The second step abstracts over the paddle's x position:
! 
!     reverse-horizontal-velocity [ ( x -- ) PADDLE-SIZE 2 / + PX swap - 0.25 * VX! ]
! 
! Now we can write a new word in terms of those factors:
! 
!     bounce-off-paddle [ ( base-y paddle-x -- )
!       reverse-vertical-velocity
!       reverse-horizontal-velocity
!       PY! ]
! 
! So the two original blocks are now simply (respectively):
! 
!     HEIGHT PLAYER   bounce-off-paddle
! 
!     0      COMPUTER bounce-off-paddle    
!
! One of the core principles of the Factor programming language is to
! factor code as much as possible into short words. As you can see
! here, using locals does not prevent the application of this
! principle. In fact, factoring is right at home in a lexical
! environment, if you have the right constructs, such as let and wlet.

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: mouse-x ( -- x ) hand-loc get first ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

TUPLE: <pong> < gadget draw closed ;

M: <pong> pref-dim*    ( <pong> -- dim ) drop { 400 400 } ;
M: <pong> draw-gadget* ( <pong> --     ) draw>> call ;
M: <pong> ungraft*     ( <pong> --     ) t >>closed drop ;

! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

: play-pong ( -- )

  [let | PONG [ <pong> new-gadget ] |

    PONG

    [let | WIDTH         [ 400   ]
           HEIGHT        [ 400   ]
           BALL-DIAMETER [  20   ]
           PADDLE-SIZE   [  75   ]
           VX!           [   3   ] ! BALL VELOCITY
           VY!           [   4   ]
           PX!           [  50   ] ! BALL POSITION
           PY!           [  50   ]
           BOUNCE        [   1.2 ]
           COMPUTER!     [ 200   ]
           COMPSPEED!    [  10   ]
           PLAYER!       [   f   ]
           MAX-VELOCITY  [  10   ] |

      [wlet | ball-to-left?  [ ( x -- ? ) PX > ]
              ball-to-right? [ ( x -- ? ) PX < ]
              ball-below?    [ ( y -- ? ) PY > ]
              ball-above?    [ ( y -- ? ) PY < ]

              reverse-vertical-velocity   [ ( -- )   VY neg BOUNCE * MAX-VELOCITY min VY!   ]
              reverse-horizontal-velocity [ ( x -- ) PADDLE-SIZE 2 / + PX swap - 0.25 * VX! ] |

        [wlet | bounce-off-paddle [ ( base-y paddle-x -- )
                                    reverse-vertical-velocity
                                    reverse-horizontal-velocity
                                    PY! ]                       |
          
          [
            -50 ball-above?   HEIGHT 50 + ball-below?   and
              [

                mouse-x 0 max  WIDTH PADDLE-SIZE -  min  PLAYER!

                PX VX + PX!    PY VY + PY!
  
                COMPUTER PADDLE-SIZE + ball-to-right? [ COMPUTER COMPSPEED + COMPUTER! ] when
                COMPUTER               ball-to-left?  [ COMPUTER COMPSPEED - COMPUTER! ] when
                
                ! check if player blocked ball
                HEIGHT ball-above?   VY 0 >   PLAYER ball-to-right?   PLAYER PADDLE-SIZE + ball-to-left?   and and and
                 [ HEIGHT PLAYER bounce-off-paddle ]
                when
                
                ! check if computer blocked ball
                PY 0 <  VY 0 <  COMPUTER PX <  PX COMPUTER PADDLE-SIZE + <   and and and
                 [ 0 COMPUTER bounce-off-paddle ]
                when
                
                ! bounce off walls
                0 ball-to-left?   WIDTH ball-to-right?   or [ VX neg VX! ] when
                
                ! draw paddles
                COMPUTER 0           PADDLE-SIZE 4 rectangle*
                PLAYER   HEIGHT 4 -  PADDLE-SIZE 4 rectangle*
                
                { PX PY } BALL-DIAMETER circle
              ]
            when
          ] ] ] ]

    >>draw drop

    PONG "test" open-window

    [
      [
        PONG closed>>
          [ f ]
          [ PONG relayout-1 25 sleep t ]
        if
      ]
      loop
    ]
    in-thread

  ] ( -- ) ;