requires sdl

sdl_window window
sdl_renderer renderer
sdl_event e

640 constant win-w
480 constant win-h

20 constant ball-size
20 constant paddle-w
100 constant paddle-h
30 constant p1-x-offset
win-w paddle-w - 30 - constant p2-x-offset

variable p1-y
variable p2-y
variable ball-x
variable ball-y
variable ball-x-vel
variable ball-y-vel
variable quit-flag
variable start-dir

variable p1-going-up
variable p2-going-up
variable p1-going-down
variable p2-going-down

variable p1-score
variable p2-score

: init
	sdl_init_video sdl_init
	if ." Failed to initalize SDL video" cr then ;

: set_hints
	sdl_hint_render_scale_quality z" 1" sdl_sethint
	0= if ." Linear filters not enabled" cr then ;

: create_window
	z" Pong" 100 100 win-w win-h sdl_window_shown
	sdl_createwindow to window
	window 0= if ." Failed to create window" cr then ;

: create_renderer
	window -1 SDL_RENDERER_ACCELERATED sdl_createrenderer
	to renderer
	renderer 0= if ." Failed to create renderer" cr then ;

: start_ball
	win-w 2/ ball-size 2/ - ball-x !
	win-h 2/ ball-size 2/ - ball-y !
	start-dir @ -1 = if
		-6 ball-x-vel !
	else	 6 ball-x-vel ! then
	0 ball-y-vel !
	start-dir @ invert start-dir ! ;

: put_score cr p1-score ? ." - " p2-score ? ;

: collide_p1
	ball-x @ p1-x-offset paddle-w + >
	ball-x @ ball-size + p1-x-offset <
	ball-y @ p1-y @ paddle-h + >
	ball-y @ ball-size + p1-y @ <
	or or or invert
	if
		6 ball-x-vel !
		p1-y @ paddle-h 2/ + ball-y @ ball-size 2/ + - -20 /
			ball-y-vel @ + ball-y-vel !
	then ;
: collide_p2
	ball-x @ p2-x-offset paddle-w + >
	ball-x @ ball-size + p2-x-offset <
	ball-y @ p2-y @ paddle-h + >
	ball-y @ ball-size + p2-y @ <
	or or or invert
	if 	-6 ball-x-vel !
		p2-y @ paddle-h 2/ + ball-y @ ball-size 2/ + - -20 /
			ball-y-vel @ + ball-y-vel ! then ;
: collide_walls
	ball-y @ 0 < if
		0 ball-y ! ball-y-vel @ -1 * ball-y-vel ! then
	ball-y @ ball-size + win-h > if
		win-h ball-size - ball-y ! ball-y-vel @ -1 * ball-y-vel ! then
	ball-x @ 0 < if
		p2-score @ +1 p2-score !
		put_score
		start_ball then
	ball-x @ ball-size + win-w > if
		p1-score @ +1 p1-score !
		put_score
		start_ball then ;
: ball_collide    collide_p1 collide_p2 collide_walls ;

: pong_setup
	win-h 2/ paddle-h 2/ - p1-y !
	p1-y @ p2-y !
	-1 start-dir !
	start_ball
	0 0 0 0 p1-going-up ! p2-going-up ! p1-going-down ! p2-going-down !
	0 0 p1-score ! p2-score ! ;

: p1_up   0 p1-y @ -5 + max p1-y ! ;
: p2_up   0 p2-y @ -5 + max p2-y ! ;
: p1_down   win-h paddle-h - p1-y @ 5 + min p1-y ! ;
: p2_down   win-h paddle-h - p2-y @ 5 + min p2-y ! ;
: ball_move    ball-x-vel @ ball-x +! ball-y-vel @ ball-y +! ;

sdl_rect rect
: render-rect   ( x y w h -- )
	rect sdl_rect:h !
	rect sdl_rect:w !
	rect sdl_rect:y !
	rect sdl_rect:x !
	renderer rect sdl_renderfillrect drop ;

: pong_render_p1
	p1-x-offset p1-y @ paddle-w paddle-h render-rect ;
: pong_render_p2
	p2-x-offset p2-y @ paddle-w paddle-h render-rect ;
: pong_render_ball
	ball-x @ ball-y @ ball-size ball-size render-rect ;

: pong_render
	pong_render_p1 pong_render_p2 pong_render_ball ;

: go
	init set_hints create_window create_renderer
	pong_setup
	0 quit-flag !
	begin
		begin
			e sdl_pollevent
		while
			e SDL_CommonEvent:type sdl_quitevent = if
				-1 quit-flag !
			else e SDL_CommonEvent:type sdl_keydown = if
				e SDL_KeyboardEvent:keysym @ sdl_scancode_w = if
					-1 p1-going-up !
				else e SDL_KeyboardEvent:keysym @ sdl_scancode_s = if
					-1 p1-going-down !
				else e SDL_KeyboardEvent:keysym @ sdl_scancode_up = if
					-1 p2-going-up !
				else e SDL_KeyboardEvent:keysym @ sdl_scancode_down = if
					-1 p2-going-down !
				then then then then
			else e SDL_CommonEvent:type sdl_keyup if
				e SDL_KeyboardEvent:keysym @ sdl_scancode_w = if
					0 p1-going-up !
				else e SDL_KeyboardEvent:keysym @ sdl_scancode_s = if
					0 p1-going-down !
				else e SDL_KeyboardEvent:keysym @ sdl_scancode_up = if
					0 p2-going-up !
				else e SDL_KeyboardEvent:keysym @ sdl_scancode_down = if
					0 p2-going-down !
				then then then then
			then then then
		repeat

		p1-going-up @ if p1_up then
		p2-going-up @ if p2_up then
		p1-going-down @ if p1_down then
		p2-going-down @ if p2_down then

		ball_move
		ball_collide
		renderer $00 $00 $00 $ff sdl_setrenderdrawcolor
		renderer sdl_renderclear
		renderer $ff $ff $ff $ff sdl_setrenderdrawcolor
		pong_render
		renderer sdl_renderpresent
		15 sdl_delay
	quit-flag @ until
	sdl_quit cr ;