mlr.sml

   1 (* for SML/NJ: *)
   2 structure Test :
   3 sig
   4   val main : string * string list -> OS.Process.status
   5 end =
   6 struct
   7
   8   val clrscr = "\^[[2J"
   9   val cursorhome = "\^[[H"
  10   val invisiblecursor = "\^[[?25l"
  11   val visiblecursor = "\^[[?25h"
  12
  13   fun cursorpos(x, y) =
  14     concat ["\^[[", Int.toString y, ";", Int.toString x, "H"]
  15
  16   fun find_walls str =
  17     let
  18       fun helper (i, x, y, acc) =
  19         if i >= String.size str then
  20           acc
  21         else
  22           case String.sub (str, i) of
  23                #"\n" => helper (i + 1, 0, y + 1, acc)
  24                (* map coordinates are 1-based *)
  25              | #"#" => helper (i + 1, x + 1, y, (x + 1, y + 1) :: acc)
  26              | _ => helper (i + 1, x + 1, y, acc)
  27     in
  28       helper (0, 0, 0, [])
  29     end
  30
  31   fun contains (_, []) = false
  32     | contains (x, y::rest) = (x = y) orelse contains (x, rest)
  33
  34   datatype direction = LEFT | DOWN | UP | RIGHT | LEFTUP | RIGHTUP | LEFTDOWN | RIGHTDOWN
  35
  36   fun draw_move (p1, p2) =
  37     cursorpos p1 ^ "." ^ cursorpos p2 ^ "@"
  38
  39   fun move (walls, pawns, point as (x, y), direction) =
  40     let
  41       val (dx, dy) = case direction of
  42                         | LEFT      => (~1,  0)
  43                         | DOWN      => ( 0,  1)
  44                         | UP        => ( 0, ~1)
  45                         | RIGHT     => ( 1,  0)
  46                         | LEFTUP    => (~1, ~1)
  47                         | RIGHTUP   => ( 1, ~1)
  48                         | LEFTDOWN  => (~1,  1)
  49                         | RIGHTDOWN => ( 1,  1)
  50       val newpoint as (newx, newy) = (x + dx, y + dy)
  51     in
  52       if newx >= 1 andalso newy >= 1 andalso not(contains(newpoint, walls)) andalso
  53       not(contains(newpoint, pawns)) then
  54         (print (draw_move(point, newpoint));
  55          {point = newpoint, quit = false})
  56       else
  57         {point = point, quit = false}
  58     end
  59
  60   fun travel (walls, pawns, point, direction) =
  61     let
  62       val state = move(walls, pawns, point, direction)
  63       val {point = newpoint, ...} = state
  64     in
  65       if newpoint = point then state else
  66         (OS.Process.sleep(Time.fromMilliseconds 15); travel (walls, pawns, newpoint, direction))
  67     end
  68
  69   fun start_turns (walls, pawns) =
  70     let
  71       fun get_command (curpoint) =
  72         case TextIO.input1 TextIO.stdIn of
  73                  SOME byte =>
  74                  let
  75                    val next = case byte of
  76                                  | #"h" => move(walls, pawns, curpoint, LEFT)
  77                                  | #"j" => move(walls, pawns, curpoint, DOWN)
  78                                  | #"k" => move(walls, pawns, curpoint, UP)
  79                                  | #"l" => move(walls, pawns, curpoint, RIGHT)
  80                                  | #"y" => move(walls, pawns, curpoint, LEFTUP)
  81                                  | #"u" => move(walls, pawns, curpoint, RIGHTUP)
  82                                  | #"b" => move(walls, pawns, curpoint, LEFTDOWN)
  83                                  | #"n" => move(walls, pawns, curpoint, RIGHTDOWN)
  84                                  | #"q" => {point = curpoint, quit = true}
  85                                  | _ => {point = curpoint, quit = false}
  86                  in
  87                    next
  88                  end
  89                | NONE => {point=curpoint, quit=true}  (* EOF is not possible in raw mode *)
  90
  91       fun do_turn {point, quit} =
  92         let
  93           val next = case TextIO.canInput (TextIO.stdIn, 1) of
  94                        | NONE => {point=point, quit=true}
  95                        | SOME 0 => {point=point, quit=false}
  96                        | SOME _ => get_command (point)
  97         in
  98           case next of
  99              | {quit=true, ...} => ()
 100              | _ =>
 101               (OS.Process.sleep(Time.fromMilliseconds 500);
 102                print "a";
 103                do_turn next)
 104         end
 105     in
 106        do_turn {point = (9,4), quit = false}
 107     end
 108
 109   fun main (prgname, argv) =
 110     let
 111       val mapfile = TextIO.openIn "default.map"
 112       val map = TextIO.input mapfile
 113       val _ = TextIO.closeIn mapfile
 114       val pawns = [(3, 5), (4, 4), (9, 2)]
 115       val walls = find_walls map
 116     in
 117       (
 118       print (clrscr ^ cursorhome ^ invisiblecursor ^ map);
 119       print (concat(List.map(fn e => cursorpos e ^ "&") pawns));
 120       RM.enable ();
 121       start_turns (walls, pawns);
 122       print (clrscr ^ cursorhome ^ visiblecursor);
 123       RM.disable ();
 124       OS.Process.success
 125       )
 126     end
 127
 128 end