From edc8520ddcbe035fe12b55b299f588d51fe79698 Mon Sep 17 00:00:00 2001 From: Georgi Kirilov <> Date: Tue, 1 Oct 2024 11:32:50 +0800 Subject: [PATCH] Initial commit --- .gitignore | 7 +++ Makefile | 22 ++++++++++ TODO | 1 + default.map | 7 +++ main.sml | 3 ++ mlr.cm | 6 +++ mlr.mlb | 12 ++++++ mlr.sml | 127 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ rawmode-ffi.sml | 5 +++ rawmode-stty.sml | 19 +++++++++ rawmode.c | 20 +++++++++ 11 files changed, 229 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 TODO create mode 100644 default.map create mode 100644 main.sml create mode 100644 mlr.cm create mode 100644 mlr.mlb create mode 100644 mlr.sml create mode 100644 rawmode-ffi.sml create mode 100644 rawmode-stty.sml create mode 100644 rawmode.c diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c9e5b6d --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +mlr +*.amd64-linux +*.d +*.o +*.du +*.ud +.cm/ diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..8c3cff4 --- /dev/null +++ b/Makefile @@ -0,0 +1,22 @@ +mlr: mlr.amd64-linux + heap2exec $< $@ + +mlr.amd64-linux: export CM_VERBOSE := false +mlr.amd64-linux: mlr.cm + $(MM) + ml-build $< + +release: mlr.mlb rawmode.o + $(MM) + mlton -link-opt rawmode.o $< + +# poor-man's -MM: +MM = @awk '$$1 ~ /\.sml$$/ {DEPS = DEPS " " $$1; } END {print "$@:" DEPS}' $< > $@.d + +clean: + -rm -f mlr mlr.d mlr.amd64-linux mlr.amd64-linux.d rawmode.o + +.PHONY: release clean + +-include mlr.d +-include mlr.amd64-linux.d diff --git a/TODO b/TODO new file mode 100644 index 0000000..55ef1cd --- /dev/null +++ b/TODO @@ -0,0 +1 @@ +make it possible to read a command during animated travel diff --git a/default.map b/default.map new file mode 100644 index 0000000..7d71964 --- /dev/null +++ b/default.map @@ -0,0 +1,7 @@ +######+############ +#.................# +#.................# +#.................# +#..>..............# +#.................+ +################### diff --git a/main.sml b/main.sml new file mode 100644 index 0000000..6c5d3f6 --- /dev/null +++ b/main.sml @@ -0,0 +1,3 @@ +(*) for MLton: +val _ = Test.main ("mlr", []) + diff --git a/mlr.cm b/mlr.cm new file mode 100644 index 0000000..585a693 --- /dev/null +++ b/mlr.cm @@ -0,0 +1,6 @@ +group +is + $/basis.cm + $/smlnj-lib.cm + rawmode-stty.sml : succ-ml + mlr.sml : succ-ml diff --git a/mlr.mlb b/mlr.mlb new file mode 100644 index 0000000..70cf5e6 --- /dev/null +++ b/mlr.mlb @@ -0,0 +1,12 @@ +$(SML_LIB)/basis/basis.mlb +$(SML_LIB)/smlnj-lib/Util/smlnj-lib.mlb + +ann + "allowFFI true" + "allowLineComments true" + "allowOptBar true" +in + rawmode-ffi.sml + mlr.sml + main.sml +end diff --git a/mlr.sml b/mlr.sml new file mode 100644 index 0000000..0ccada4 --- /dev/null +++ b/mlr.sml @@ -0,0 +1,127 @@ +(* for SML/NJ: *) +structure Test : +sig + val main : string * string list -> OS.Process.status +end = +struct + + val clrscr = "\^[[2J" + val cursorhome = "\^[[H" + val invisiblecursor = "\^[[?25l" + val visiblecursor = "\^[[?25h" + + fun cursorpos(x, y) = + concat ["\^[[", Int.toString y, ";", Int.toString x, "H"] + + fun find_walls str = + let + fun helper (i, x, y, acc) = + if i >= String.size str then + acc + else + case String.sub (str, i) of + #"\n" => helper (i + 1, 0, y + 1, acc) + (* map coordinates are 1-based *) + | #"#" => helper (i + 1, x + 1, y, (x + 1, y + 1) :: acc) + | _ => helper (i + 1, x + 1, y, acc) + in + helper (0, 0, 0, []) + end + + fun contains (_, []) = false + | contains (x, y::rest) = (x = y) orelse contains (x, rest) + + datatype direction = LEFT | DOWN | UP | RIGHT | LEFTUP | RIGHTUP | LEFTDOWN | RIGHTDOWN + + fun draw_move (p1, p2) = + cursorpos p1 ^ "." ^ cursorpos p2 ^ "@" + + fun move (walls, pawns, point as (x, y), direction) = + let + val (dx, dy) = case direction of + | LEFT => (~1, 0) + | DOWN => ( 0, 1) + | UP => ( 0, ~1) + | RIGHT => ( 1, 0) + | LEFTUP => (~1, ~1) + | RIGHTUP => ( 1, ~1) + | LEFTDOWN => (~1, 1) + | RIGHTDOWN => ( 1, 1) + val newpoint as (newx, newy) = (x + dx, y + dy) + in + if newx >= 1 andalso newy >= 1 andalso not(contains(newpoint, walls)) andalso + not(contains(newpoint, pawns)) then + (print (draw_move(point, newpoint)); + {point = newpoint, quit = false}) + else + {point = point, quit = false} + end + + fun travel (walls, pawns, point, direction) = + let + val state = move(walls, pawns, point, direction) + val {point = newpoint, ...} = state + in + if newpoint = point then state else + (OS.Process.sleep(Time.fromMilliseconds 15); travel (walls, pawns, newpoint, direction)) + end + + fun readCommand (walls, pawns, instream) = + let + fun loop curr = + case TextIO.input1 instream of + SOME byte => + let + val {point=curpoint, quit=_} = curr + val next = case byte of + | #"h" => move(walls, pawns, curpoint, LEFT) + | #"j" => move(walls, pawns, curpoint, DOWN) + | #"k" => move(walls, pawns, curpoint, UP) + | #"l" => move(walls, pawns, curpoint, RIGHT) + | #"y" => move(walls, pawns, curpoint, LEFTUP) + | #"u" => move(walls, pawns, curpoint, RIGHTUP) + | #"b" => move(walls, pawns, curpoint, LEFTDOWN) + | #"n" => move(walls, pawns, curpoint, RIGHTDOWN) + | #"H" => travel(walls, pawns, curpoint, LEFT) + | #"J" => travel(walls, pawns, curpoint, DOWN) + | #"K" => travel(walls, pawns, curpoint, UP) + | #"L" => travel(walls, pawns, curpoint, RIGHT) + | #"Y" => travel(walls, pawns, curpoint, LEFTUP) + | #"U" => travel(walls, pawns, curpoint, RIGHTUP) + | #"B" => travel(walls, pawns, curpoint, LEFTDOWN) + | #"N" => travel(walls, pawns, curpoint, RIGHTDOWN) + | #"q" => {point = curpoint, quit = true} + | _ => {point = curpoint, quit = false} + val {point, quit} = next + in + if not quit then + loop next + else + () + end + | NONE => () (*) EOF is not possible in raw mode + in + loop {point = (9,4), quit = false} + end + + fun main (prgname, argv) = + let + val instream = TextIO.stdIn + val mapfile = TextIO.openIn "default.map" + val map = TextIO.input mapfile + val _ = TextIO.closeIn mapfile + val pawns = [(3, 5), (4, 4), (9, 2)] + val walls = find_walls map + in + ( + print (clrscr ^ cursorhome ^ invisiblecursor ^ map); + print (concat(List.map(fn e => cursorpos e ^ "&") pawns)); + RM.enable (); + readCommand (walls, pawns, instream); + print (clrscr ^ cursorhome ^ visiblecursor); + RM.disable (); + OS.Process.success + ) + end + +end diff --git a/rawmode-ffi.sml b/rawmode-ffi.sml new file mode 100644 index 0000000..ef67f06 --- /dev/null +++ b/rawmode-ffi.sml @@ -0,0 +1,5 @@ +structure RM = +struct + val enable = _import "enable_raw_mode" private: unit -> unit; + val disable = _import "disable_raw_mode" private: unit -> unit; +end diff --git a/rawmode-stty.sml b/rawmode-stty.sml new file mode 100644 index 0000000..d461e0e --- /dev/null +++ b/rawmode-stty.sml @@ -0,0 +1,19 @@ +structure RM : +sig + val enable : unit -> OS.Process.status + val disable : unit -> OS.Process.status +end = +struct + val orig = ref "" + + fun enable () = + let + val stty = Unix.execute("/usr/bin/stty", ["-F", "/dev/tty", "-g"]) + val _ = orig := TextIO.input (Unix.textInstreamOf stty) + val _ = Unix.reap stty + in + OS.Process.system "stty raw -echo" + end + + fun disable () = OS.Process.system ("stty " ^ !orig) +end diff --git a/rawmode.c b/rawmode.c new file mode 100644 index 0000000..a6c128a --- /dev/null +++ b/rawmode.c @@ -0,0 +1,20 @@ +#include +#include + +struct termios orig_termios; + +void disable_raw_mode() { + tcsetattr(STDIN_FILENO, TCSANOW, &orig_termios); +} + +void enable_raw_mode() { + struct termios raw; + + tcgetattr(STDIN_FILENO, &orig_termios); + + raw = orig_termios; + raw.c_iflag &= ~(IXON); + raw.c_lflag &= ~(ECHO | ICANON | ISIG); + + tcsetattr(STDIN_FILENO, TCSANOW, &raw); +} -- 2.11.4.GIT