Tron 5mx

Description of the page content

A game written in Forth for the Psion 5mx computer.

Tags:

Tron 5mx is a remake I wrote in 2005 of a game I had written in 1985 in fig-Forth for ZX Spectrum. The motivation was just to test my Forth 5mx, that was under development at the time.

Forth 5mx is not totally ANS Forth compatible, but probably the required changes are trivial. The Psion 5mx specific words are documented and would be easy to convert.

Source code

\ tron5mx

\ Copyright (C) 2005, 2008, 2009 Marcos Cruz (http://programandala.net)
\ License: http://programandala.net/license

\ History:
\ 2005-05-28 First draft. Port of the Sinclair Spectrum Forth version.
\ 2008-04-10 First working version.
\ 2008-05-07 Improved to be used with any number of  players. Other improvements.
\ 2009-05-24 Layout changes in the source code.

\ Bugs:
\ - When both players cause the collision, the score calculation is wrong and the explosion is repeated.

marker tron5mx

\ ..................................................................
\ Arena

screeninfo  \ system dependent; it leaves 10 cells on the stack that describe the current screen
2drop
constant screen-heigth
constant screen-width
2drop 2drop 2drop

screen-heigth 1- constant x-max
screen-width 1- constant y-max

screen-heigth screen-width * constant #arena  \ number of arena tiles
create arena  #arena chars allot  \ arena data space

: clear-arena  ( -- )  arena #arena erase  ;
: >arena  ( x y -- c-addr )  screen-heigth * + arena +  ;
: arena@  ( x y -- b )  >arena C@  ;
: arena!  ( b x y -- )  >arena C!  ;

: plot  ( c x y -- )
	\ Put a character on the arena.
	2>r dup 2R@ arena! \ update the arena map
	2r> at-xy emit \ print the char
	;

\ ..................................................................
\ Players

2 constant #players  \ max number of players
10 constant /player  \ data bytes per player

create players #players /player * chars allot  \ players data space

: player  ( u -- c-addr )

	\ u = player number
	\ c-addr = player data address
	
	/player * players +
	
	;

variable offset

: [+offset]  ( -- )

	\ Compile the offset calculation.

	offset @  case
	0 of  endof
	1 of  postpone 1+  endof
	2 of  postpone 2+  endof
	offset @ postpone literal postpone +
	endcase
	1 offset +!

	; immediate

0 offset !
: x  ( u -- c-addr )  player [+offset]  ;
: y  ( u -- c-addr )  player [+offset]  ;
: xi  ( u -- c-addr )  player [+offset]  ;
: yi  ( u -- c-addr )  player  [+offset]  ;
: img  ( u -- c-addr )  player [+offset]  ;
: score  ( u -- c-addr )  player [+offset]  ;
: left-key ( u -- c-addr )  player [+offset]  ;
: down-key  ( u -- c-addr )  player [+offset]  ;
: up-key  ( u -- c-addr )  player [+offset]  ;
: right-key  ( u -- c-addr )  player [+offset]  ;
: pitch  ( u -- c-addr )  player [+offset]  ;

: x@  ( u -- b )  x C@  ;
: x!  ( b u -- )  x C!  ;
: y@  ( u -- b )  y C@  ;
: y!  ( b u -- )  y C@  ;
: xi@  ( u -- b )  xi C@  ;
: xi!  ( b u -- )  xi C@  ;
: yi@  ( u -- b )  yi C@  ;
: yi!  ( b u -- )  yi C!  ;
: img@  ( u -- b )  img C@  ;
: img!  ( b u -- )  img C!  ;
: score@  ( u -- b )  score C@  ;
: score!  ( b u -- )  score C!  ;
: left-key@  ( u -- b )  left-key C@  ;
: left-key!  ( b u -- )  left-key C!  ;
: right-key@  ( u -- b )  right-key C@  ;
: right-key!  ( b u -- )  right-key C!  ;
: up-key@  ( u -- b )  up-key C@  ;
: up-key!  ( b u -- )  up-key C!  ;
: down-key@  ( u -- b )  down-key C@  ;
: down-key!  ( b u -- )  down-key C!  ;
: pitch@  ( u -- b )  pitch C@  ;
: pitch!  ( b u -- )  pitch C!  ;

: future-position  ( u -- x y )

	\ Return the future position of a player.
	
	\ u = number of player

	>r r@ xi@ r@ x@ +
	r@ yi@ r> y@ +

	;

\ ..................................................................
\ Keys

char e value abort-key
\ System dependent cursor codes:
258 constant cursor-right
256 constant cursor-up
257 constant cursor-down
259 constant cursor-left

: cursor  ( -- u1 u2 u3 u4 )

	\ u1 = right key code
	\ u2 = up key code
	\ u3 = down key code
	\ u4 = left key code

	cursor-right cursor-up cursor-down cursor-left
	
	;

: qwerty-left    ( -- u1 u2 u3 u4 )

	\ Keys to play on the left of a QWERTY keyboard.

	\ u1 = right key code
	\ u2 = up key code
	\ u3 = down key code
	\ u4 = left key code

	[char] x [char] q [char] a [char] c

	;

: es-qwerty-right    ( -- u1 u2 u3 u4 )

	\ Keys to play on the right of a Spanish QWERTY keyboard.

	\ u1 = right key code
	\ u2 = up key code
	\ u3 = down key code
	\ u4 = left key code

	[char] , [char] p [char]  [char] .

	;

: es-dvorak-left    ( -- u1 u2 u3 u4 )

	\ Keys to play on the left of a Spanish Dvorak keyboard.

	\ u1 = right key code
	\ u2 = up key code
	\ u3 = down key code
	\ u4 = left key code

	[char] q [char] a [char] . [char] j

	;

: keys!  ( u1 u2 u3 u4 u5 -- )

	\ u1 = right key code
	\ u2 = up key code
	\ u3 = down key code
	\ u4 = left key code
	\ u5 = player

	dup >r left-key!
	r@ down-key!
	r@ up-key!
	r> right-key!

	;
	

\ ..................................................................
\ Player data

cursor 0 keys!  \ player 0 keys
char  0 img!
100 0 pitch!

es-dvorak-left 1 keys!  \ player 1 keys
char * 1 img!
100 0 pitch!

\ ..................................................................
\ Game data

3 constant init-score

\ ..................................................................
\ Screen

: .scores  ( -- )

	0 dup at-xy
	#players 0 do
		." Player " I . ." (" I img@ emit ." ): " I score@ . SPACE
	loop

	;

: crash  ( x y -- )

	\ Make an awesome 2D visual crash effect at x y...

	8 0 do
		2dup at-xy [char] \ emit 1 100 beep
		2dup at-xy [char] | emit 1 200 beep
		2dup at-xy [char] / emit 1 300 beep
		2dup at-xy [char] - emit 1 400 beep
	loop
	2drop
	
	;

: player-sound  ( u -- )

	\ Make the sound of a player.

	\ u = player number

	pitch@ 1 SWAP beep  \ system dependent

	;

: .player  ( u -- )

	\ Print one player.
	
	\ u = number of player
	
	dup >r img@ r@ x@ r@ y@ plot
	r> player-sound
	
	;

: .players  ( -- )

	\ Print all players.

	#players 0 do
		I .player
	loop
	
	;

\ ..................................................................
\ Collisions

: collision  ( u x y -- )

	\ Make a collision effect and decrement the score of the player.
	
	\ x y = collision coordinates
	\ u = player number
	
	crash  score -1 C+!
	
	;

: collision?  ( u -- flag )

	\ Is the future screen position of a player already occupied?
	\ If so, show it and decrement its score.
	
	\ u = player number

	dup future-position 2dup arena@
	if collision true
	else 2drop drop false
	then
	
	;

: collisions?  ( -- flag )

	\ Check possible collisions.

	false
	#players 0 do
		I collision? OR
	loop
	
	;

\ ..................................................................
\ Arena limits

: out-of-arena? ( x y -- flag )

	\ Is a screen position outside the arena?

	2dup
	0< swap 0< or >r
	y-max > swap x-max > or
	r> or

	;

: outside?  ( u -- flag )

	\ Is the future position of a player outside the arena?
	\ If so, show it and decrement its score.
	
	\ u = number of player
	
	dup future-position 2dup out-of-arena?
	if  collision true
	else  2drop false
	then
	
	;

: outsides?  ( -- flag )

	\ Check possible outsides.

	false
	#players 0 do
		I outside? or
	loop
	
	;

\ ..................................................................
\ Movement

: init-positions  ( -- )

	y-max 2 / dup
	#players 0 do
		I y!
	loop
	x-max 20 / dup 0 x!
	x-max swap - 1 x!
	1 0 xi ! 0 0 yi !  \ init direction
	-1 1 xi ! 0 1 yi !  \ init direction

	;

: steer-player ( b u -- )

	\ b = key presed
	\ u = player number to check
	
	to player
	case
		player down-key@ of  0 player xi ! 1 player yi ! endof
		player up-key@ of 0 player xi ! -1 player yi ! endof
		player left-key@ of -1 player xi ! 0 player yi ! endof
		player right-key@ of 1 player xi ! 0 player yi ! endof
	endcase

	;

: steer  ( -- )

	key?
	if  key  else  false  then

	dup abort-key = abort" Game aborted"
	
	#players 0 do
		dup i steer-player
	loop

	;

: update-positions  ( -- )

	#players 0 do
		i xi@ i x C+!
		i yi@ i y C+!
	loop
	
	;

\ ..................................................................
\ Round
	
: init-round  ( -- )

	page clear-arena init-positions .scores

	;
	
: round  ( -- )

	init-round
	begin
		steer
		collisions? 0= outsides? 0= and
	while
		update-positions  .players
	repeat
	.scores

	;
	
\ ..................................................................
\ Game

: game-over?  ( -- f )

	false
	#players 0 do
		i score@ 0= or
	loop
	
	;

: init-scores  ( -- )

	#players 0 do
		init-score i score!
	loop

	;

: init-game  ( -- )

	init-scores
	10 5 2dup at-xy ." Press SPACE to play"
	key bl <>  if  quit  then
	at-xy 18 spaces
	
	;

: game  ( -- )

	init-game
	begin
		round  game-over?
	until
	cr ." GAME OVER"

	;

\ ..................................................................
\ Instructions

: .key  ( b -- )

	\ b = key
	
	space
	case
		cursor-left of ." Cursor " endof
		cursor-down of ." Cursor " endof
		cursor-up of ." Cursor " endof
		cursor-right of ." Cursor " endof
		dup emit
	endcase
	[char] , emit space
	
	;

: .player-keys  ( u -- )

	\ Print keys of a player.
	
	\ u = player number.

	cr >r ." Player " r@ .
	." (" r@ img@ emit ." ): "
	r@ left-key@ .key ." Left"
	r@ down-key@ .key ." Down"
	r@ up-key@ .key ." Up"
	r> right-key@ .key ." Right"

	;
	
: .keys  ( -- )

	cr abort-key emit ."  Abort" 
	#players 0 do
		i .player-keys
	loop
	
	;

: instructions  ( -- )
	page
	." Tron 5mx" cr 
	." ********"
	.keys
	;

\ ..................................................................
\ Start

: tron  ( -- )
	instructions game
	;

cr .( Type TRON to start. )

Downloads

tron5mx.fs (9.49 KiB)

Related pages

Forth 5mx
Forth 5mx, un Forth para la computadora Psion 5mx, escrito en OPL+.
Tron
Game written in fig-Forth for ZX Spectrum.
Tron 0xF
Game written in fig-Forth for ZX Spectrum.