Paste: Snake

Author: haze
Mode: factor
Date: Wed, 19 Jul 2023 17:56:21
Plain Text | 
USING: accessors arrays calendar colors
combinators.short-circuit fonts kernel literals math math.matrices
math.order math.vectors namespaces opengl random ranges sequences
timers ui ui.commands ui.gadgets ui.gadgets.worlds ui.gestures
ui.pens.solid ui.render ui.text ;

IN: snake

CONSTANT: CELLS 40
CONSTANT: SCREEN-SIZE 400

TUPLE: player pos dir len ;

TUPLE: snake-gadget < gadget grid player game-over? timer ;

SYMBOLS: :empty :apple :snake ;
SYMBOLS: :up :down :left :right ;

: initial-state ( gadget -- gadget )
  CELLS CELLS :empty <matrix> >>grid
  player new
    { 20 20 } >>pos
    { :up :down :left :right } random >>dir
    1 >>len
  >>player
  10 .
  
  f >>game-over? ;

DEFER: on-tick

: <snake-gadget> ( -- gadget )
  snake-gadget new initial-state
    COLOR: gray50 <solid> >>interior
    dup '[ _ on-tick ] f 16667 microseconds <timer> >>timer ;

M: snake-gadget pref-dim* drop ${ SCREEN-SIZE SCREEN-SIZE } ;

M:: snake-gadget draw-gadget* ( SNAKE -- )
  COLOR: red gl-color
  SNAKE player>> pos>> 10 v*n { 10 10 } gl-fill-rect ;

:: on-tick ( GADGET -- )
  GADGET relayout-1 ;

:: move-up ( GADGET -- )
  GADGET player>> pos>> { 0 -1 } v+ :> c
  GADGET player>> c >>pos drop ;

: print-10 ( g -- ) drop 10 . ;

snake-gadget "gestures" f {
  { T{ key-down { sym "UP" } }    print-10 }
!   { T{ key-down { sym "DOWN" } }  move-down }
!   { T{ key-down { sym "LEFT" } }  move-left }
!   { T{ key-down { sym "RIGHT" } } move-right }
!   { T{ key-down { sym " " } }     new-game }
} define-command-map

MAIN-WINDOW: snake-window {
  { title "SNAKE" }
  { window-controls
    { normal-title-bar close-button minimize-button } }
} <snake-gadget> >>gadgets ;

Annotation: fixed

Author: mrjbq7
Mode: factor
Date: Wed, 19 Jul 2023 18:17:28
Plain Text | 
USING: accessors arrays calendar colors
combinators.short-circuit fonts kernel literals math math.matrices
math.order math.vectors namespaces opengl random ranges sequences
timers ui ui.commands ui.gadgets ui.gadgets.worlds ui.gestures
ui.pens.solid ui.render ui.text ;

IN: snake-game2

CONSTANT: CELLS 40
CONSTANT: SCREEN-SIZE 400

TUPLE: player pos dir len ;

TUPLE: snake-gadget < gadget grid player game-over? timer ;

SYMBOLS: :empty :apple :snake ;
SYMBOLS: :up :down :left :right ;

: initial-state ( gadget -- gadget )
  CELLS CELLS :empty <matrix> >>grid
  player new
    { 20 20 } >>pos
    { :up :down :left :right } random >>dir
    1 >>len
  >>player
  f >>game-over? ;

DEFER: on-tick

: <snake-gadget> ( -- gadget )
  snake-gadget new initial-state
    COLOR: gray50 <solid> >>interior
    dup '[ _ on-tick ] f 16667 microseconds <timer> >>timer ;

M: snake-gadget pref-dim* drop ${ SCREEN-SIZE SCREEN-SIZE } ;

M:: snake-gadget draw-gadget* ( SNAKE -- )
  COLOR: red gl-color
  SNAKE player>> pos>> 10 v*n { 10 10 } gl-fill-rect ;

M: snake-gadget graft*
    [ timer>> start-timer ] [ call-next-method ] bi ;

M: snake-gadget ungraft*
    [ timer>> stop-timer ] [ call-next-method ] bi ;

:: on-tick ( GADGET -- )
  GADGET relayout-1 ;

: move-player ( gadget vector -- )
   [ player>> ] dip '[ _ v+ ] change-pos drop ;

: move-up ( GADGET -- ) { 0 -1 } move-player ;
: move-down ( GADGET -- ) { 0 1 } move-player ;
: move-left ( GADGET -- ) { -1 0 } move-player ;
: move-right ( GADGET -- ) { 1 0 } move-player ;

snake-gadget "gestures" f {
  { T{ key-down { sym "UP" } }    move-up }
  { T{ key-down { sym "DOWN" } }  move-down }
  { T{ key-down { sym "LEFT" } }  move-left }
  { T{ key-down { sym "RIGHT" } } move-right }
!  { T{ key-down { sym " " } }     new-game }
} define-command-map

MAIN-WINDOW: snake-window {
  { title "SNAKE" }
  { window-controls
    { normal-title-bar close-button minimize-button } }
} <snake-gadget> >>gadgets ;

New Annotation

Summary:
Author:
Mode:
Body: