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

IN: pong-basic

! The original: http://billmill.org/pong.html
! In shoes:     http://gist.github.com/26431

! What's up with all the locals?
!
! This is a pretty extreme style. Definately not what one would call
! 'idiomatic Factor'.
!
! However, it's an experiment:
!
!   Can one do a straitforward port of Ruby and Python code to Factor?
!
!   Can one port graphics demo code from systems like Shoes
!   and NodeBox?
!
! The refreshing thing about alot of NodeBox code is that it's written
! in a very "experimental" style. It looks like somebody started
! playing around with some small idea and kept tweaking it and it grew
! into something else.
!
! Getting all the factors and abstractions correct up front is one way
! to design and implement code. But it's also nice to have a language
! which allows you to just hack something out without having to get
! everything "right" up front.
!
! Classical Factor idioms are made for extreme factoring and producing
! small clean abstractions. But those idioms aren't (yet?) always the
! easiest to work with when you're exploring some new ideas.
!
! Sketching out new ideas (especially by beginners) is what systems
! like NodeBox and Processing excel at. I'm always on the lookout for
! ways to bridge the powertool world of Factor with the fluffy world
! of those great systems.
!
! That said, a version of the below in pure idiomatic Factor is
! welcome. In fact, if you're new to Factor and wanting to learn, this
! is a good exercise.

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

: 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   ] |
    
      [
        -50 PY < PY HEIGHT 50 + < and
          [

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

            PX VX + PX!    PY VY + PY!
  
            COMPUTER PADDLE-SIZE + PX < [ COMPUTER COMPSPEED + COMPUTER! ] when
            PX COMPUTER               < [ COMPUTER COMPSPEED - COMPUTER! ] when

            ! check if player blocked ball
            HEIGHT PY <  0 VY <  PLAYER PX <  PX PLAYER PADDLE-SIZE + <
            and and and
              [
                VY neg BOUNCE * MAX-VELOCITY min     VY! ! reverse vertical velocity
                PX PLAYER PADDLE-SIZE 2 / + - 0.25 * VX! ! reverse horizontal velocity
                HEIGHT PY!
              ]
            when

            ! check if computer blocked ball
            PY 0 <  VY 0 <  COMPUTER PX <  PX COMPUTER PADDLE-SIZE + <
            and and and
              [
                VY neg BOUNCE * MAX-VELOCITY min       VY! ! reverse vertical velocity
                PX COMPUTER PADDLE-SIZE 2 / + - 0.25 * VX! ! reverse horizontal velocity
                0 PY!
              ]
            when

            ! bounce off walls
            PX 0 < WIDTH PX < 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

  ] ;