История изменений

Исправление MOPKOBKA, 13.07.23 02:41 (текущая версия) :

Вот консольный Pong, в 186 строк, без определения системных констант и сисколов будет где то 150 строк. Есть простой AI, работает на любом разрешении экрана, можно выбрать пункт игры без AI с другом. Игра идет до 10, потом показывает кто выиграл.

0x5413 constant TIOCGWINSZ
0x5401 constant TCGETS  
0x5404 constant TCSETSF
10 constant ECHO
1 constant POOLIN
: ioctl 3 16 syscall ;
: nanosleep 2 35 syscall ;
: pool 3 7 syscall ;
: 1ms 0 pad ! 1000000 pad cell+ ! pad 0 nanosleep drop ;
: ms for 1ms next ;
: -1/1 -? if 1 else -1 then ;
: xxyy ( x y x y -- x x y y ) rot swap ;

here constant termio 64 allot
1 TCGETS termio ioctl drop 
termio 12 + dup l@ ECHO not and swap l!
1 TCSETSF termio ioctl drop 
27 emit ." [?25l"
27 emit ." [H" 27 emit ." [J"

: quit 
  27 emit ." [?25h"
  termio 12 + dup l@ ECHO or swap l!
  1 TCSETSF termio ioctl drop 
  bye ;

1 TIOCGWINSZ pad ioctl drop
pad w@         constant height 
pad word+ w@   constant width
width height * constant size 
here           constant screen size allot
0   constant  MENU
1   constant  COMPUTER
2   constant  FRIEND
3   constant  WIN
0   variable  mode
0   variable  cursor
9   variable  player1
9   variable  player2
0   variable  score1
0   variable  score2
0 0 variable2 velocity
0 0 variable2 ball

: new-round
  score1 @ 10 >= 
  score2 @ 10 >= 
  or if WIN mode ! then
  score1 @ score2 @ > if -1 else 1 then 
  -1 velocity !2 
  width 2 / height 2 / ball !2 ;

: new-game
  0 score1 !
  0 score2 !
  new-round ;

: target ( -- x y ) ball @2 velocity @2 xxyy + -rot + swap ;  
: flight target ball !2 ;
: collision? ( y -- f ) dup height >= swap 0 < or ;
: rebound ( -- ) velocity @2 negate velocity !2 ;

: walls 
  target swap drop 
  collision? if rebound then ;

: racket-x? ( x px -- f ) if width >= else 0 <= then ;
: racket-y? ( y py -- f ) 2 + - abs 2 <= ;
: racket? ( x y px py -- f ) xxyy racket-y? -rot racket-x? and ;
: power* ( n -- n ) player1 @ player2 @ + 4 mod 1 max * -3 max 3 min ;
: hit velocity @2 swap power* negate swap velocity !2 ;

: players 
  target 0 player1 @ racket? 
  target 1 player2 @ racket? 
  or if hit then ; 
  
: check-goal 
  target drop dup 
  width >= if drop 1 score1 !+ new-round leave then 
  0 <= if 1 score2 !+ new-round then ;

: physics walls players check-goal flight ;

: key ( -- n )
  0 pad
  pad long+ POOLIN swap w!
  pad 1 0 pool drop
  pad long+ word+ w@ POOLIN and if 
    0 pad 100 accept drop pad c@
  else 0 then ;

: moving ( n player -- ) dup @ rot + 0 max height 4 - min swap ! ;

: input 
  key 
  [char] q case -3 player1 moving end
  [char] a case 3 player1 moving end
  [char] p case -3 player2 moving end
  [char] l case 3 player2 moving end
  [char] e case quit end
  drop ;

: visible? 
  velocity @ 0 >
  ball @ width 2 / > and 
  mode @ COMPUTER = and ;
  
: ai 
  visible? if 
    ball cell+ @ player2 @ - negate 
    -1/1 player2 moving 
  then ;

: clear screen size 32 fill ;
: flush screen size .s ;
: point ( x y c -- ) -rot width * + screen + c! ;
: draw-ball ball @2 [char] @ point ;

: draw-player ( x y -- ) 
  4 for 
    dup2 [char] # point 1+ 
  next drop2 ;

: draw-players 
  0 player1 @ draw-player 
  width 1- player2 @ draw-player ;

: draw-border 
  width 2 / 0 height for 
    dup2 [char] | point 1+ 
  next drop2 ;

: draw-score ( score x -- ) 
  3 width * + screen + swap <# #u #> rot swap move ;

: draw-scores 
  score1 @ width 2 / 7 - draw-score 
  score2 @ width 2 / 7 + draw-score ;

: draw draw-border draw-scores draw-ball draw-players ;

: label ( str u )
  dup 2 / width 2 / swap -
  cursor @ width * + screen + swap move
  1 cursor !+ ;

: win 
  height 2 / 4 - cursor !
  score1 @ score2 @ > if
    " Player1 WIN!"
  else
    " Player2 WIN!"
  then
  label
  " Press C to continue" label
  key 
  [char] c case 0 mode ! end
  [char] e case quit end
  drop ;

: menu 
  height 2 / 4 - cursor !
  " PONG" label
  " Q - Player 1 Up, A - Player 1 Down" label
  " P - Player 2 Up, L - Player 2 Down" label
  " E - Exit" label
  " " label
  " " label
  " 1. Play with computer" label
  " 2. Play with friend" label
  key 
  [char] 1 case new-game COMPUTER mode ! end
  [char] 2 case new-game FRIEND mode ! end
  [char] e case quit end
  drop ;
 
: game input ai physics draw ;

: pong 
  @:> clear mode @
    dup MENU = if menu then
    dup dup COMPUTER = swap FRIEND = or if game then
    WIN = if win then
    60 ms
  flush <@ ; pong

Исходная версия MOPKOBKA, 13.07.23 02:38:

0x5413 constant TIOCGWINSZ
0x5401 constant TCGETS  
0x5404 constant TCSETSF
10 constant ECHO
1 constant POOLIN
: ioctl 3 16 syscall ;
: nanosleep 2 35 syscall ;
: pool 3 7 syscall ;
: 1ms 0 pad ! 1000000 pad cell+ ! pad 0 nanosleep drop ;
: ms for 1ms next ;
: -1/1 -? if 1 else -1 then ;
: xxyy ( x y x y -- x x y y ) rot swap ;

here constant termio 64 allot
1 TCGETS termio ioctl drop 
termio 12 + dup l@ ECHO not and swap l!
1 TCSETSF termio ioctl drop 
27 emit ." [?25l"
27 emit ." [H" 27 emit ." [J"

: quit 
  27 emit ." [?25h"
  termio 12 + dup l@ ECHO or swap l!
  1 TCSETSF termio ioctl drop 
  bye ;

1 TIOCGWINSZ pad ioctl drop
pad w@         constant height 
pad word+ w@   constant width
width height * constant size 
here           constant screen size allot
0   constant  MENU
1   constant  COMPUTER
2   constant  FRIEND
3   constant  WIN
0   variable  mode
0   variable  cursor
9   variable  player1
9   variable  player2
0   variable  score1
0   variable  score2
0 0 variable2 velocity
0 0 variable2 ball

: new-round
  score1 @ 10 >= 
  score2 @ 10 >= 
  or if WIN mode ! then
  score1 @ score2 @ > if -1 else 1 then 
  -1 velocity !2 
  width 2 / height 2 / ball !2 ;

: new-game
  0 score1 !
  0 score2 !
  new-round ;

: target ( -- x y ) ball @2 velocity @2 xxyy + -rot + swap ;  
: flight target ball !2 ;
: collision? ( y -- f ) dup height >= swap 0 < or ;
: rebound ( -- ) velocity @2 negate velocity !2 ;

: walls 
  target swap drop 
  collision? if rebound then ;

: racket-x? ( x px -- f ) if width >= else 0 <= then ;
: racket-y? ( y py -- f ) 2 + - abs 2 <= ;
: racket? ( x y px py -- f ) xxyy racket-y? -rot racket-x? and ;
: power* ( n -- n ) player1 @ player2 @ + 4 mod 1 max * -3 max 3 min ;
: hit velocity @2 swap power* negate swap velocity !2 ;

: players 
  target 0 player1 @ racket? 
  target 1 player2 @ racket? 
  or if hit then ; 
  
: check-goal 
  target drop dup 
  width >= if drop 1 score1 !+ new-round leave then 
  0 <= if 1 score2 !+ new-round then ;

: physics walls players check-goal flight ;

: key ( -- n )
  0 pad
  pad long+ POOLIN swap w!
  pad 1 0 pool drop
  pad long+ word+ w@ POOLIN and if 
    0 pad 100 accept drop pad c@
  else 0 then ;

: moving ( n player -- ) dup @ rot + 0 max height 4 - min swap ! ;

: input 
  key 
  [char] q case -3 player1 moving end
  [char] a case 3 player1 moving end
  [char] p case -3 player2 moving end
  [char] l case 3 player2 moving end
  [char] e case quit end
  drop ;

: visible? 
  velocity @ 0 >
  ball @ width 2 / > and 
  mode @ COMPUTER = and ;
  
: ai 
  visible? if 
    ball cell+ @ player2 @ - negate 
    -1/1 player2 moving 
  then ;

: clear screen size 32 fill ;
: flush screen size .s ;
: point ( x y c -- ) -rot width * + screen + c! ;
: draw-ball ball @2 [char] @ point ;

: draw-player ( x y -- ) 
  4 for 
    dup2 [char] # point 1+ 
  next drop2 ;

: draw-players 
  0 player1 @ draw-player 
  width 1- player2 @ draw-player ;

: draw-border 
  width 2 / 0 height for 
    dup2 [char] | point 1+ 
  next drop2 ;

: draw-score ( score x -- ) 
  3 width * + screen + swap <# #u #> rot swap move ;

: draw-scores 
  score1 @ width 2 / 7 - draw-score 
  score2 @ width 2 / 7 + draw-score ;

: draw draw-border draw-scores draw-ball draw-players ;

: label ( str u )
  dup 2 / width 2 / swap -
  cursor @ width * + screen + swap move
  1 cursor !+ ;

: win 
  height 2 / 4 - cursor !
  score1 @ score2 @ > if
    " Player1 WIN!"
  else
    " Player2 WIN!"
  then
  label
  " Press C to continue" label
  key 
  [char] c case 0 mode ! end
  [char] e case quit end
  drop ;

: menu 
  height 2 / 4 - cursor !
  " PONG" label
  " Q - Player 1 Up, A - Player 1 Down" label
  " P - Player 2 Up, L - Player 2 Down" label
  " E - Exit" label
  " " label
  " " label
  " 1. Play with computer" label
  " 2. Play with friend" label
  key 
  [char] 1 case new-game COMPUTER mode ! end
  [char] 2 case new-game FRIEND mode ! end
  [char] e case quit end
  drop ;
 
: game input ai physics draw ;

: pong 
  @:> clear mode @
    dup MENU = if menu then
    dup dup COMPUTER = swap FRIEND = or if game then
    WIN = if win then
    60 ms
  flush <@ ; pong