Paste: PONG FROM THE 5TH DIMENSION

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

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

TUPLE: <pong> < gadget draw ;

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

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

: play-pong ( -- )

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

  PONG

  [let | WIDTH  [ 400 ]
         HEIGHT [ 400 ] |

  [let | BALL-DIAMETER [ 20   ]
         PADDLE-SIZE   [ 75   ]
         VX!           [  3   ]
         VY!           [  4   ]
         PX!           [ 50   ]
         PY!           [ 50   ]
         BOUNCE        [  1.2 ]
         COMPUTER!     [ WIDTH 2 / ]
         COMPSPEED!    [ 10 ]        |
    
    [
      -50 PY < PY HEIGHT 50 + < and
      [

        [let | PADDLE-LEFT [ mouse-x 0 max   WIDTH PADDLE-SIZE -   min ]
               NY! [ PY VY + ]
               NX! [ PX VX + ] |
  
          COMPUTER PADDLE-SIZE + NX < [ COMPUTER COMPSPEED + COMPUTER! ] when
          NX COMPUTER               < [ COMPUTER COMPSPEED - COMPUTER! ] when
  
          COMPUTER 0 PADDLE-SIZE 4 rectangle*
  
          HEIGHT NY <
          0 VY <
          PADDLE-LEFT NX <
          NX PADDLE-LEFT PADDLE-SIZE + <
          and and and
          [
            VY neg BOUNCE * VY!
            PADDLE-LEFT   PADDLE-SIZE 2 /   +   NX -   0.25 *   VX!
            HEIGHT NY!
          ]
          when
  
          NY 0 <
          VY 0 <
          COMPUTER NX <
          NX   COMPUTER PADDLE-SIZE + <
          and and and
          [
            VY neg BOUNCE * VY!
            NX COMPUTER PADDLE-SIZE 2 / + - 0.25 * VX!
            0 NY!
          ]
          when
  
          NX 0 < WIDTH NX < or [ VX neg VX! ] when
  
          [let | MX [ mouse-x WIDTH PADDLE-SIZE - min 0 max ] |
  
            MX HEIGHT 4 - PADDLE-SIZE 4 rectangle* ]
  
          NX PX!
          NY PY!
  
          { PX PY } BALL-DIAMETER circle
        ]
      ]
      when
    ]

  ] ]

  >>draw drop

  PONG "test" open-window

  [ [ PONG relayout-1 100 sleep t ] loop ] in-thread

  ] ;