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 >>grid player new { 20 20 } >>pos { :up :down :left :right } random >>dir 1 >>len >>player f >>game-over? ; DEFER: on-tick : ( -- gadget ) snake-gadget new initial-state COLOR: gray50 >>interior dup '[ _ on-tick ] f 16667 microseconds >>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 } } } >>gadgets ;