<commit_before>USING: accessors alien.c-types alien.data arrays calendar colors
combinators combinators.short-circuit flatland generalizations
grouping kernel locals math math.intervals math.order
math.rectangles math.vectors namespaces opengl opengl.gl
opengl.glu processing.shapes sequences sequences.generalizations
shuffle threads ui ui.gadgets ui.gestures ui.render ;
FROM: multi-methods => GENERIC: METHOD: ;
FROM: syntax => M: ;
IN: pong

! Inspired by this Ruby/Shoes version by why: http://gist.github.com/26431
!
! Which was based on this Nodebox version: http://billmill.org/pong.html
! by <NAME>.

: clamp-to-interval ( x interval -- x )
    [ from>> first max ] [ to>> first min ] bi ;

TUPLE: play-field < rectangle ;

TUPLE: paddle < rectangle ;

TUPLE: computer < paddle { speed initial: 10 } ;

: computer-move-left  ( computer -- ) dup speed>> move-left-by  ;

: computer-move-right ( computer -- ) dup speed>> move-right-by ;

TUPLE: ball < vel
    { diameter   initial: 20   }
    { bounciness initial:  1.2 }
    { max-speed  initial: 10   } ;

: above-lower-bound? ( ball field -- ? ) bottom 50 - above? ;

: below-upper-bound? ( ball field -- ? ) top    50 + below? ;

: in-bounds? ( ball field -- ? )
    {
        [ above-lower-bound? ]
        [ below-upper-bound? ]
    } 2&& ;

:: bounce-change-vertical-velocity ( BALL -- )
    BALL vel>> y neg
    BALL bounciness>> *
    BALL max-speed>> min
    BALL vel>> (y!) ;

:: bounce-off-paddle ( BALL PADDLE -- )
   BALL bounce-change-vertical-velocity
   BALL x   PADDLE center x   -   0.25 *   BALL vel>> (x!)
   PADDLE top   BALL pos>> (y!) ;

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

:: valid-paddle-interval ( PADDLE PLAY-FIELD -- interval )
   PLAY-FIELD [ left ] [ right ] bi PADDLE width - [a,b] ;

:: align-paddle-with-mouse ( PADDLE PLAY-FIELD -- )
   mouse-x
   PADDLE PLAY-FIELD valid-paddle-interval
   clamp-to-interval
   PADDLE pos>> (x!) ;

! Protocol for drawing PONG objects

GENERIC: draw ( obj -- )

METHOD: draw { paddle } [ bottom-left ] [ dim>> ] bi draw-rectangle ;

METHOD: draw { ball } [ pos>> ] [ diameter>> 2 / ] bi draw-circle ;

TUPLE: pong-gadget < gadget paused field ball player computer ;

: pong ( -- gadget )
    pong-gadget new
        T{ play-field { pos {   0   0 } } { dim { 400 400 } } } clone >>field<commit_msg>pong: no need for multi-methods.<commit_after>USING: accessors alien.c-types alien.data arrays calendar colors
combinators combinators.short-circuit flatland generalizations
grouping kernel locals math math.intervals math.order
math.rectangles math.vectors namespaces opengl opengl.gl
opengl.glu processing.shapes sequences sequences.generalizations
shuffle threads ui ui.gadgets ui.gestures ui.render ;
IN: pong

! Inspired by this Ruby/Shoes version by why: http://gist.github.com/26431
!
! Which was based on this Nodebox version: http://billmill.org/pong.html
! by <NAME>.

: clamp-to-interval ( x interval -- x )
    [ from>> first ] [ to>> first ] bi clamp ;

TUPLE: play-field < rectangle ;

TUPLE: paddle < rectangle ;

TUPLE: computer < paddle { speed initial: 10 } ;

: computer-move-left  ( computer -- ) dup speed>> move-left-by  ;

: computer-move-right ( computer -- ) dup speed>> move-right-by ;

TUPLE: ball < vel
    { diameter   initial: 20   }
    { bounciness initial:  1.2 }
    { max-speed  initial: 10   } ;

: above-lower-bound? ( ball field -- ? ) bottom 50 - above? ;

: below-upper-bound? ( ball field -- ? ) top    50 + below? ;

: in-bounds? ( ball field -- ? )
    {
        [ above-lower-bound? ]
        [ below-upper-bound? ]
    } 2&& ;

:: bounce-change-vertical-velocity ( BALL -- )
    BALL vel>> y neg
    BALL bounciness>> *
    BALL max-speed>> min
    BALL vel>> (y!) ;

:: bounce-off-paddle ( BALL PADDLE -- )
   BALL bounce-change-vertical-velocity
   BALL x   PADDLE center x   -   0.25 *   BALL vel>> (x!)
   PADDLE top   BALL pos>> (y!) ;

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

:: valid-paddle-interval ( PADDLE PLAY-FIELD -- interval )
   PLAY-FIELD [ left ] [ right ] bi PADDLE width - [a,b] ;

:: align-paddle-with-mouse ( PADDLE PLAY-FIELD -- )
   mouse-x
   PADDLE PLAY-FIELD valid-paddle-interval
   clamp-to-interval
   PADDLE pos>> (x!) ;

! Protocol for drawing PONG objects

GENERIC: draw ( obj -- )

M: paddle draw [ bottom-left ] [ dim>> ] bi draw-rectangle ;

M: ball draw [ pos>> ] [ diameter>> 2 / ] bi draw-circle ;

TUPLE: pong-gadget < gadget paused field ball player computer ;

: pong ( -- gadget )
    pong-gadget new
        T{ play-field { pos {   0   0 } } { dim { 400 400 } } } clone >>field
{'fraction_non_alphanumeric': 0.13735306922072268, 'fraction_numerical': 0.013060513713539399, 'mean_word_length': 2.7540849673202614, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 67, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3269564', 'n_tokens_mistral': 1653, 'n_tokens_neox': 1576, 'n_words': 449}