USING: accessors kernel locals math math.order namespaces processing.shapes sequences threads ui ui.gadgets ui.gestures ui.render ; IN: pong-internal ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : mouse-x ( -- x ) hand-loc get first ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! TUPLE: < gadget draw closed ; M: pref-dim* ( -- dim ) drop { 400 400 } ; M: draw-gadget* ( -- ) draw>> call ; M: ungraft* ( -- ) t >>closed drop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : play-pong ( -- ) [let | 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 < ] ball-moving-up? [ ( -- ? ) VY 0 > ] ball-moving-down? [ ( -- ? ) VY 0 < ] reverse-vertical-velocity [ ( -- ) VY neg BOUNCE * MAX-VELOCITY min VY! ] adjust-horizontal-velocity [ ( x -- ) PADDLE-SIZE 2 / + PX swap - 0.25 * VX! ] | [wlet | ball-in-bounds? [ ( -- ? ) -50 ball-above? HEIGHT 50 + ball-below? and ] align-paddle-with-mouse [ ( -- ) mouse-x 0 max WIDTH PADDLE-SIZE - min PLAYER! ] move-ball [ ( -- ) PX VX + PX! PY VY + PY! ] computer-reaction [ ( -- ) COMPUTER PADDLE-SIZE + ball-to-right? [ COMPUTER COMPSPEED + COMPUTER! ] when COMPUTER ball-to-left? [ COMPUTER COMPSPEED - COMPUTER! ] when ] player-blocked-ball? [ ( -- ? ) HEIGHT ball-above? ball-moving-up? PLAYER ball-to-right? PLAYER PADDLE-SIZE + ball-to-left? and and and ] computer-blocked-ball? [ ( -- ? ) 0 ball-below? ball-moving-down? COMPUTER ball-to-right? COMPUTER PADDLE-SIZE + ball-to-left? and and and ] bounce-off-wall? [ ( -- ? ) 0 ball-to-left? WIDTH ball-to-right? or ] reverse-horizontal-velocity [ ( -- ) VX neg VX! ] draw-computer-paddle [ ( -- ) COMPUTER 0 PADDLE-SIZE 4 rectangle* ] draw-player-paddle [ ( -- ) PLAYER HEIGHT 4 - PADDLE-SIZE 4 rectangle* ] draw-ball [ ( -- ) { PX PY } BALL-DIAMETER circle ] bounce-off-paddle [ ( base-y paddle-x -- ) reverse-vertical-velocity adjust-horizontal-velocity PY! ] | [wlet | bounce-off-player-paddle [ HEIGHT PLAYER bounce-off-paddle ] bounce-off-computer-paddle [ 0 COMPUTER bounce-off-paddle ] | [ ball-in-bounds? [ align-paddle-with-mouse move-ball computer-reaction player-blocked-ball? [ bounce-off-player-paddle ] when computer-blocked-ball? [ bounce-off-computer-paddle ] when bounce-off-wall? [ reverse-horizontal-velocity ] when draw-computer-paddle draw-player-paddle draw-ball ] when ] ] ] ] ] >>draw drop PONG "test" open-window [ [ PONG closed>> [ f ] [ PONG relayout-1 25 milliseconds sleep t ] if ] loop ] in-thread ] ( -- ) ;