00_robots_ReadMe.md

• 01_robots.lisp
  古典的Robot Game.
  本(Land of Lisp)にあるオリジナル(http://landoflisp.com/robots.lisp) は、
  わずか42行の圧縮気味のコードなのを、読みやすく refactorしたもの.

• 02a_robots.fs, 02b_prelude.fs
  上記 01_robots.lisp を GForthに移植したもの.

• 04_robots.go
  上記 01_robots.lisp を Go言語に移植してみたもの(筆者が初めて書いたGoのコード).
  慣れていないので不要に長くなっている気がしないでもない. => ツッコミ歓迎
  尤も、このお題では 型に対するメソッドやインタフェースとか channel〜selectとか
  使っておらず、全然Goの得意な領域に踏み込んでいない.
  Pos型(type Pos int)のように、基底型をwrapして型定義できるのは悪くない感.

01_robots.lisp

;;;; Classic Robot Game in Land-of-Lisp Chapter-11
;;;;   refactored by @nfunato

(defconstant +WIDTH+        64)
(defconstant +HEIGHT+       16)
(defconstant +POS-NUMBER+ 1024)  ; (* +HEIGHT+ +WIDTH+)
(defconstant +CENTER-POS+  544)  ; (coord-to-pos (/ +HEIGHT+ 2) (/ +WIDTH+ 2))

(defmacro with-coord ((y x) p &body body)
  `(multiple-value-bind (,y ,x) (floor ,p +WIDTH+)
     ,@body))

(defun coord-to-pos (y x)
  (+ (* (mod y +HEIGHT+) +WIDTH+)
     (mod x +WIDTH+)))

(defun new-pos (pos offset)
  (with-coord (y x) pos
    (destructuring-bind (dy dx) offset
      ;; Overhang from the screen is handled by MOD in coord-to-pos.
      (coord-to-pos (+ y dy) (+ x dx)))))

(defun distance (p1 p2)
  (with-coord (y1 x1) p1
    (with-coord (y2 x2) p2
      (+ (abs (- y1 y2)) (abs (- x1 x2))))))

(defvar +DIRECTIONS+    ; list of ( sym . (y-offset x-offset) )
  '((q . (-1 -1)) (w . (-1 0)) (e . (-1 +1))
    (a . ( 0 -1))              (d . ( 0 +1))
    (z . (+1 -1)) (x . (+1 0)) (c . (+1 +1))))

(defun dir-offset (sym)
  (let ((asc (assoc sym +DIRECTIONS+)))
    (if asc (cdr asc) '(0 0))))

(defun init-my-pos () +CENTER-POS+)

;; note: you may want to use trivial-raw-io library for unbuffered read-char.
;; (https://stackoverflow.com/questions/20276738/reading-a-character-without-requiring-the-enter-button-pressed)
(defun update-my-pos (pos)
  (flet ((read-command (prompt)
           (format t prompt)
           (finish-output)
           (read)))
    (let ((c (read-command "~%qwe/asd/zxc to move, (t)eleport, (l)eave: ")))
      (cond ((eq 'l c) (throw 'robots 'BYE))
            ((eq 't c) (random +POS-NUMBER+))
            (t         (new-pos pos (dir-offset c)))))))

(defparameter +MONSTER-NUMBER+ 10)

(defun init-monsters ()
  (loop repeat +MONSTER-NUMBER+ collect (random +POS-NUMBER+)))

(defun monster-stuck-p (mpos monsters)
  (> (count mpos monsters) 1))

(defun all-monsters-stuck-p (monsters)
  (every (lambda (m) (monster-stuck-p m monsters)) monsters))

;; Using REDUCE, instead of SORT, unlike the original
(defun new-mpos (mpos pos)
  (cdr (reduce (lambda (acc x) (if (< (car acc) (car x)) acc x))
               (loop for (k . d) in +DIRECTIONS+
                     for new-mpos = (new-pos mpos d)
                     collect (cons (distance pos new-mpos) new-mpos)))))

(defun update-monsters (pos monsters)
  (loop for m in monsters
        collect (if (monster-stuck-p m monsters) m (new-mpos m pos))))

(defvar *screen*
  (make-list +POS-NUMBER+ :initial-element #\space))

(defun display-screen (pos monsters)
  (flet ((char-at (p)
           (cond ((member p monsters) (if (monster-stuck-p p monsters) #\# #\A))
                 ((= p pos)           #\@)
                 (t                   #\space))))
    ;; Since the screen buffer is big, we re-use it by assignments
    (loop for p below +POS-NUMBER+
          for c on *screen*
          do (setf (car c) (char-at p)))
    (format t "~%|~{~<|~%|~,65:;~A~>~}|" *screen*)))

(defun robots ()
  (setf *random-state* (make-random-state t))
  (catch 'robots
    (loop for pos = (init-my-pos)        then (update-my-pos pos)
          for monsters = (init-monsters) then (update-monsters pos monsters)
          when (member pos monsters)           return 'PLAYER-LOSES
          when (all-monsters-stuck-p monsters) return 'PLAYER-WINS
          do (display-screen pos monsters))))

02a_robots.fs

\ Robots.fs:  Classic Robot Game in Land-of-Lisp Chapter-11
\                                                      ported by @nfunato

\ Usage on gforth:
\
\   $ gforth prelude.fs robots.fs
\
\ You may also load these files one by one under gforth prompt, i.e.
\   include prelude.fs
\   include robots.fs
\
\ For playing the game, execute the word ROBOTS under gforth prompt.
\ You can also invoke an editor by the word EDIT which is given by prelude.fs.

anew --robots--                 \ Wil Baden's famous utility word ANEW

: this-file s" robots.fs" ;     \ EDIT lauchues an editor that edit this file.
' this-file is editor-target

\ -------------------------------------------------------------------
\ general utils

: cell- ( v -- v' ) 1 cells - ;

: not ( v -- f )  0= ;

: clear-input  begin key? while key drop repeat ;

\ A copy of the COMMENTED-OUT old implementation of RANDOM that comes with
\ the Gforth distribution (github.com/forth42/gforth/random.fs). It is a
\ naive linear congruence method, but it's handy -- and I dare to use it as is.
variable seed
$10450405 Constant generator            \ 272958459
: rnd  ( -- n )  seed @ generator um* drop 1+ dup seed ! ;
: random ( n -- 0..n-1 )  rnd um* nip ;
: randomize  utime drop seed ! ;

\ -------------------------------------------------------------------
\ screen-related definitions

  64 constant SCR_WIDTH
  16 constant SCR_HEIGHT

1024 constant POS#              \ 1024=64x16
 544 constant SCR_CENTER_POS    \ 64*8 + 32

\ Gforth's MOD uses FM/MOD(Floored-Mod), so we don't need to redefine MOD.
\ (cf. section 3.2.2.1 of https://forth-standard.org/standard/usage)
\ : mod  ( n1 n2 -- n3 )        \ this MOD certainly uses fm/mod, not sm/rem
\    >r s>d r> fm/mod drop ;

: coord-to-pos ( x y -- pos )   \ screen overhang is handled with Floored-Mod
    SCR_HEIGHT mod SCR_WIDTH * >r
    SCR_WIDTH mod r> + ;

: pos-to-coord ( pos -- x y )
    s>d SCR_WIDTH fm/mod ;

: coord+ ( x1 y1 x2 y2 -- x1+x2 y1+y2 )  rot + >r + r> ;

: at-bottom  0 SCR_HEIGHT 2 + at-xy ;
: at-coord  ( x y -- )  1 1 coord+ at-xy ;
: goto ( pos -- ) pos-to-coord at-coord ;

\ ?-offset ( -- dx dy )
: q-offset -1 -1 ;  : w-offset  0 -1 ;  : e-offset  1 -1 ;
: a-offset -1  0 ;  : s-offset  0  0 ;  : d-offset  1  0 ;
: z-offset -1  1 ;  : x-offset  0  1 ;  : c-offset  1  1 ;

: new-pos ( pos ofsFn -- pos )
    >r pos-to-coord r> execute coord+ coord-to-pos ;

: distance ( pos1 pos2 -- manhattan-distance )
    >r pos-to-coord r> pos-to-coord rot - abs >r - abs r> + ;

SCR_WIDTH SCR_HEIGHT + 1+  constant SCR_DISTANCE_LIMIT

\ -------------------------------------------------------------------
\ new-my-pos, new-mpos

: new-my-pos ( pos ofsFn -- pos ) new-pos ;

0 value _best-mpos'
0 value _best-distance
0 value _pos0

: init-selection ( pos0 -- )
    to _pos0
    -1 to _best-mpos'
    SCR_DISTANCE_LIMIT to _best-distance ;

: eval-adjacent ( mpos' -- )
    dup _pos0 distance ( mpos' mpos'/pos0-distance )
    dup _best-distance < if
        to _best-distance
        to _best-mpos'
    else
        2drop
    then ;

: select-min-distance-adjacent ( mpos -- new-mpos )
    2 -1 do
        2 -1 do
            ( mpos ) dup pos-to-coord j i coord+ coord-to-pos
            ( mpos mpos' ) eval-adjacent
        loop
    loop
    drop    \ discard mpos
    _best-mpos' ;

: new-mpos ( mpos pos0 -- new-mpos )
    init-selection select-min-distance-adjacent ;

\ -------------------------------------------------------------------
\ init-my-pos, update-my-pos, init-monsters, update-monsters,
\ monster-stuck? all-monsters-stuck?

variable my-pos

: init-my-pos
    SCR_CENTER_POS my-pos ! ;

: dir-to-offsetFn ( ch -- ofsFn )
    case
        [char] q of ['] q-offset endof
        [char] w of ['] w-offset endof
        [char] e of ['] e-offset endof
        [char] a of ['] a-offset endof
        [char] d of ['] d-offset endof
        [char] z of ['] z-offset endof
        [char] x of ['] x-offset endof
        [char] c of ['] c-offset endof
        ['] s-offset swap
    endcase ;

-8191 constant BYE_THROW        \ users' throwVal must be less than -4095

: update-my-pos
    clear-input
    at-bottom ." qwe/asd/zxc to move, (t)eleport, (l)eave: "
    key dup [char] l = if  BYE_THROW throw else
        dup [char] t = if  POS# random     else
        dup dir-to-offsetFn >r my-pos @ r> new-my-pos
        then then
    nip my-pos ! ;


10 constant MONSTER#
create monsters MONSTER# cells allot does> swap cells + ;

: init-monster ( omit-pos -- pos )
    begin POS# random 2dup <> until nip ;

: init-monsters ( omit-pos -- )
    MONSTER# 0 do
        dup init-monster i monsters !
    loop drop ;


: captured? ( -- flg )
    my-pos @
    false
    MONSTER# 0 do
        over i monsters @ = if true or leave then
    loop
    nip ;

: monster-stuck? ( pos -- flg )
    0
    MONSTER# 0 do
        over i monsters @ = if 1+ then
    loop
    nip
    1 > ;

: all-monsters-stuck? ( -- flg )
    true
    MONSTER# 0 do
        i monsters @ monster-stuck? not if false and leave then
    loop ;

: update-monsters
    MONSTER# 0 do
        i monsters
        dup @ monster-stuck? if
            drop
        else
            dup >r @ my-pos @ new-mpos
            r> !
        then
    loop ;

\ -------------------------------------------------------------------
\ .screen

: .+  [char] + emit ;  : .-  [char] - emit ;  : .|  [char] | emit ;
: .@  [char] @ emit ;  : .A  [char] A emit ;  : .#  [char] # emit ;

: .me
    my-pos @ goto .@ ;

: .monster ( pos -- )
    dup goto monster-stuck? if .# else .A then ;

: .monsters
    MONSTER# 0 do i monsters @ .monster loop ;

: .frame-1 { x0 y0 xn yn -- }
    x0 y0 at-xy xn x0 do .- loop
    yn y0 1+ do x0 i at-xy .| xn i at-xy .| loop
    x0 yn at-xy xn x0 do .- loop
    xn yn x0 yn xn y0 x0 y0 4 0 do at-xy .+ loop ;

: .frame
    0 0 SCR_WIDTH 1+ SCR_HEIGHT 1+ .frame-1 ;

: .screen
    page .frame .me .monsters at-bottom ;

\ -------------------------------------------------------------------
\ robots

1 constant PLAYER_WIN
2 constant PLAYER_LOSE
3 constant PLAYER_LOSE2     \ PLAYER_WIN | PLAYER_LOSE

: robots-loop ( -- result )
    0 begin
        .screen
        captured?           if PLAYER_LOSE or then
        all-monsters-stuck? if PLAYER_WIN  or then
    dup 0= while
        update-my-pos
        update-monsters
\       assert( depth 1 = ) assert( dup 0= )
    repeat ;

: debug-init                \ just for debug
    639 my-pos !
    620 608 613 621 599 599 629 608 606 613
    10 0 do i monsters ! loop ;

: randomize' 1657267977886924 seed ! ;

: robots
    randomize   \ for replication test, use randomize' instead
    init-my-pos
    my-pos @ init-monsters
\   debug-init
    ['] robots-loop catch ( minusThrowVal | result 0 )
    at-bottom
    ?dup if
        case
            BYE_THROW of cr ." BYE" endof
            dup throw
        endcase
    else
        case
            PLAYER_WIN   of ." PLAYER WIN!"  endof
            PLAYER_LOSE  of ." PLAYER LOSE!" endof
            PLAYER_LOSE2 of ." PLAYER LOSE!" endof
            abort" robots"
        endcase
    then ;

cr .( Please type 'robots' to play the robots game.)
cr .( If you want to provide a turnkey system, uncomment the last line.)
cr
cr
\ ROBOTS

02b_prelude.fs

\ ANEW command (from Wil Baden's "ToolBelt 2002")
: possibly ( "name" -- )  bl word find ?dup and if execute then ;
: anew     ( "name" -- )  >in @ possibly >in ! marker ;


\ EDIT command
defer editor-target ( -- c-addr u )
\ : set-srcfile ( xt -- ) is editor-target ;
: edcmd0   s"  vim -S ~/home/vim/forth.vim " ;

: append' ( fr u2 to u1 -- to u1+u2 ) over >r tuck + -rot over + >r move 2r> ;
: concat  ( to u1 fr u2 -- to u1+u2 ) 2swap append' ;

: edcmd    pad 0 edcmd0 concat editor-target concat ;
: ZZ       editor-target included ;  \ load editor target
: edit     edcmd system ZZ ;         \ do ZZ after quiting the editor

03_compat.fs

\
\ Note for forth processors other than gforth.
\

\ The followings word definitions are written in ANSFORTH94.
\ Gforth already have these words, so this file is not needed by robots.fs
\ when you use Gforth.
: under+ ( a b c -- a+c b ) rot + swap ;
: on  ( adr -- ) true  swap ! ;
: off ( adr -- ) false swap ! ;
: bounds ( adr cnt -- adr+cnt adr ) over + swap ;
: sgn ( -n|0|+n -- -1|0|+1 ) dup if 0< 1 or then ;

\ The followings words are general utilities written in ANSFORTH94.
\ Feel free to use them. Robots.fs already uses clear-input.
: between ( n1 n2 n3 -- f ) 1+ within ;
: clump ( min max i1 -- i2 )     min max ;
: clear-input begin key? while key drop repeat ;
: scaling ( all scaled-all n -- scaled-n ) rot ( scaled-all n all ) */ ;
: cell- ( v -- v' )  1 cells - ;
: 3dup ( a b c -- a b c a b c )  dup 2over rot ;

04_robots.go

// Classic Robot Game in Land-of-Lisp Chapter-11
//    ported from CL version by @nfunato

package main

import (
	"bytes"
	"fmt"
	"log"
	"math"
	"math/rand"
	"unicode"

	"github.com/mattn/go-tty"
	"golang.org/x/exp/slices"
)

const (
	WIDTH          = 64
	HEIGHT         = 16
	POS_NUMBER     = 1024 // HEIGHT * WIDTH
	CENTER_POS_VAL = 544  // (HEIGHT/2, WIDTH/2)
	MONSTER_NUMBER = 10
)

type Pos int
type Offset []int

var quitPos = Pos(-1)

func coordToPos(y, x int) Pos {
	// golang's % uses SM/REM(remainder), not FM/MOD(Floored-Mod), so we need to redefine MOD.
	// (for example, cf. section 3.2.2.1 of https://forth-standard.org/standard/usage)
	//return Pos((y%HEIGHT)*WIDTH + x%WIDTH)
	return Pos(mod(y, HEIGHT)*WIDTH + mod(x, WIDTH))
}

func mod(a, b int) int {
	// adopt one in the following link:
	// https://stackoverflow.com/questions/13683563/whats-the-difference-between-mod-and-remainder
	if m := a % b; m >= 0 {
		return m
	} else if b < 0 {
		return m - b
	} else {
		return m + b
	}
}

func withCoord(p Pos) (int, int) {
	return int(p) / WIDTH, mod(int(p), WIDTH)
}

func abs(a int) int {
	return int(math.Abs(float64(a)))
}
func distance(p1, p2 Pos) int {
	var y1, x1 = withCoord(p1)
	var y2, x2 = withCoord(p2)
	return abs(y1-y2) + abs(x1-x2)
}

func newPos(p Pos, ofs Offset) Pos {
	y, x := withCoord(p)
	dy, dx := ofs[0], ofs[1]
	// Overhang from the screen is handled by MOD in coordToPos (hopefully)
	return coordToPos(y+dy, x+dx)
}

// Depending on newMpos implementation, 's':[]int{0,0} is not included here
var dirMap = map[byte]Offset{
	'q': []int{-1, -1}, 'w': []int{-1, 0}, 'e': []int{-1, 1},
	'a': []int{0, -1}, 'd': []int{0, 1},
	'z': []int{1, -1}, 'x': []int{1, 0}, 'c': []int{1, 1},
}

func dirOffset(ch byte) Offset {
	if val, ok := dirMap[ch]; ok {
		return val
	} else {
		return []int{0, 0}
	}
}

func initMyPos() Pos {
	return Pos(CENTER_POS_VAL)
}

func updateMyPos(p Pos) Pos {
	fmt.Printf("%s", "qwe/asd/zxc to move, (t)eleport, (l)eave: ")
	cmd := oneByteRead()
	fmt.Println()
	switch cmd {
	case 'l':
		return quitPos
	case 't':
		// selecting a blank position is better?
		return Pos(rand.Intn(POS_NUMBER))
	default:
		return newPos(p, dirOffset(cmd))
	}
}

func initMonsters(pos Pos) []Pos {
	randFn := func() Pos {
		for {
			if x := rand.Intn(POS_NUMBER); x != int(pos) {
				return Pos(x)
			}
		}
	}
	var monsters = make([]Pos, MONSTER_NUMBER)
	for i := range monsters {
		monsters[i] = randFn()
	}
	return monsters
}

func isSomeMonsterStuck(mpos Pos, monsters []Pos) bool {
	count := 0
	// 最初に移植した時、以下の行が for pos := 、その下行が int(mpos)==pos
	// となってバグっていた (Pos型は、剥かずにそのままの形で持ち運ぶのが良い)
	for _, pos := range monsters {
		if mpos == pos {
			count++
		}
	}
	return count > 1
}

func isAllMonstersStuck(monsters []Pos) bool {
	for _, pos := range monsters {
		if !isSomeMonsterStuck(pos, monsters) {
			return false
		}
	}
	return true
}

// TODO: convert it to local decl
type WPos struct {
	Weight   int
	Position Pos
}

// TODO: convert it to a local fn
func newMposList(mpos, myPos Pos) []WPos {
	var wposList = make([]WPos, len(dirMap))
	i := 0
	for _, ofs := range dirMap {
		newMpos := newPos(mpos, ofs)
		wposList[i] = WPos{distance(myPos, newMpos), newMpos}
		i++
	}
	return wposList
}

// TODO: convert it to a local fn ?
func newMpos(mpos, myPos Pos) Pos {
	wposList := newMposList(mpos, myPos)
	// reduce(fn(acc,wpos), wposList[0], wposList[1:])
	acc := wposList[0]
	for _, wpos := range wposList[1:] {
		// fn(acc, wpos): choose the smallest weight newMpos
		if wpos.Weight < acc.Weight {
			acc = wpos
		}
	}
	return acc.Position
}

func updateMonsters(pos Pos, monsters []Pos) []Pos {
	monsters2 := make([]Pos, len(monsters))
	for i, m := range monsters {
		if isSomeMonsterStuck(m, monsters) {
			monsters2[i] = m
		} else {
			monsters2[i] = newMpos(m, pos)
		}
	}
	return monsters2
}

var screen = bytes.Repeat([]byte(" "), POS_NUMBER)

// TODO: convert it to a local fn
func charAt(p Pos, myPos Pos, monsters []Pos) byte {
	switch true {
	case slices.Contains(monsters, p):
		if isSomeMonsterStuck(p, monsters) {
			return '#'
		} else {
			return 'A'
		}
	case p == myPos:
		return '@'
	default:
		return ' '
	}
}

func displayScreen(myPos Pos, monsters []Pos) {
	for i := range screen {
		screen[i] = charAt(Pos(i), myPos, monsters)
	}
	fmt.Printf("|")
	for i := range screen {
		fmt.Printf("%c", charAt(Pos(i), myPos, monsters))
		j := i + 1
		if j%WIDTH == 0 {
			if j != POS_NUMBER {
				fmt.Printf("|\n|")
			} else {
				fmt.Printf("|\n")
			}
		}
	}
}

var (
	AlphabetUpperCase = &unicode.RangeTable{
		R16: []unicode.Range16{
			{0x0041, 0x005A, 1},
		},
		LatinOffset: 1,
	}
	AlphabetLowerCase = &unicode.RangeTable{
		R16: []unicode.Range16{
			{0x0061, 0x007A, 1},
		},
		LatinOffset: 1,
	}
)

var console *tty.TTY

func oneByteRead() byte {
	for {
		// unbuffered ReadRune by mattn
		r, err := console.ReadRune()
		if err != nil {
			log.Fatal(err)
		}

		// cribbed from https://golang.hateblo.jp/entry/golang-unicode
		if unicode.In(r, AlphabetUpperCase, AlphabetLowerCase) {
			return byte(r)
		} else {
			return 's'
		}
	}
}

func main() {
	tty, err := tty.Open()
	if err != nil {
		log.Fatal(err)
	}
	console = tty
	defer tty.Close()

	fmt.Printf("Robot Game!\n")
	status := "now game is on going"
	myPos := initMyPos()
	monsters := initMonsters(myPos)
	for {
		displayScreen(myPos, monsters)
		if slices.Contains(monsters, myPos) {
			status = "playser loses!"
			break
		}
		if isAllMonstersStuck(monsters) {
			status = "player wins!"
			break
		}
		myPos = updateMyPos(myPos)
		if myPos == quitPos {
			status = "bye!"
			break
		}
		monsters = updateMonsters(myPos, monsters)
	}
	fmt.Printf("%s\n", status)
}