Commit 45a26e14 authored by Vivien Kraus's avatar Vivien Kraus
Browse files

Implement the Command-line interface

parent 89f795d7
......@@ -638,7 +638,8 @@ named =tarot-header.arff= in the shared resources.
** Running in interactive mode
If you do not specify a command, then the program enters interactive
mode.
mode. You can then execute interactive commands.
*** TODO List of interactive commands
* Bringing tarot to your program
This section serves as libtarot API documentation, tutorial for
integration in your favorite platform, and implementation of the
......@@ -2135,7 +2136,7 @@ custom application class.
This class is trivial to instanciate, since it does not accept
command-line arguments.
#+name: scm-define-tarot-application-generate-init
#+name: scm-define-tarot-application-features-init
#+BEGIN_SRC scheme :eval no :noweb yes
(define (tarot-application-features-init args)
(let* ((option-spec `((version (single-char #\V) (value #f))
......@@ -3234,6 +3235,385 @@ Now that we can learn from a set of experiences, we are going to:
rm -f $FINAL_MODEL
#+END_SRC
** The command-line interface
The command-line interface consists of reading tarot command from the
standard input (with for instance, readline), and then executing these
commands.
There are different types of commands, but there is no definite list
in the API.
#+name: scm-define-tarot-command
#+caption: Class definition: =<tarot-command>=
#+BEGIN_SRC scheme :eval no
(define-class <tarot-command> ())
(define-class <tarot-command-help> (<tarot-command>))
(define-class <tarot-command-version> (<tarot-command>))
(define-class <tarot-command-license> (<tarot-command>))
(define-class <tarot-command-error> (<tarot-command>)
(error-string #:init-keyword #:error-string))
(define-class <tarot-command-status> (<tarot-command>))
(define-class <tarot-command-load> (<tarot-command>)
(filename #:init-keyword #:filename))
(define-class <tarot-command-save> (<tarot-command>)
(filename #:init-keyword #:filename))
(define-class <tarot-command-check> (<tarot-command>)
(event #:init-keyword #:event))
(define-class <tarot-command-event> (<tarot-command>)
(event #:init-keyword #:event))
(define-class <tarot-command-unknown> (<tarot-command>))
#+END_SRC
Now, we can define the CLI class.
#+name: scm-define-tarot-cli
#+caption: Class definition: =<tarot-cli>=
#+BEGIN_SRC scheme :eval no
(define tarot-cli-has-command
(pointer->procedure int
(dynamic-func "tarot_cli_has_command"
(dynamic-link "libtarot"))
'(*)))
(define tarot-cli-is-help
(pointer->procedure int
(dynamic-func "tarot_cli_is_help"
(dynamic-link "libtarot"))
'(*)))
(define tarot-cli-is-version
(pointer->procedure int
(dynamic-func "tarot_cli_is_version"
(dynamic-link "libtarot"))
'(*)))
(define tarot-cli-is-license
(pointer->procedure int
(dynamic-func "tarot_cli_is_license"
(dynamic-link "libtarot"))
'(*)))
(define tarot-cli-is-error
(pointer->procedure int
(dynamic-func "tarot_cli_is_error"
(dynamic-link "libtarot"))
'(* *)))
(define tarot-cli-is-status
(pointer->procedure int
(dynamic-func "tarot_cli_is_status"
(dynamic-link "libtarot"))
'(*)))
(define tarot-cli-is-load
(pointer->procedure int
(dynamic-func "tarot_cli_is_load"
(dynamic-link "libtarot"))
'(* *)))
(define tarot-cli-is-save
(pointer->procedure int
(dynamic-func "tarot_cli_is_save"
(dynamic-link "libtarot"))
'(* *)))
(define tarot-cli-is-check
(pointer->procedure int
(dynamic-func "tarot_cli_is_check"
(dynamic-link "libtarot"))
'(* *)))
(define tarot-cli-is-event
(pointer->procedure int
(dynamic-func "tarot_cli_is_event"
(dynamic-link "libtarot"))
'(* *)))
(define tarot-cli-is-continuation
(pointer->procedure int
(dynamic-func "tarot_cli_is_continuation"
(dynamic-link "libtarot"))
'(*)))
(define-class <tarot-cli> ()
(ptr #:getter get-ptr #:init-keyword #:ptr)
(continuation? #:getter get-continuation?
#:allocation #:virtual
#:slot-ref (lambda (cli)
(let* ((cli-ptr (get-ptr cli))
(is-cont (tarot-cli-is-continuation cli-ptr)))
(not (eq? is-cont 0))))
#:slot-set! (lambda (cli v)
(error "Use the parsing")))
(command #:getter get-command
#:allocation #:virtual
#:slot-ref (lambda (cli)
(let* ((cli-ptr (get-ptr cli))
(arg-bv (make-bytevector (sizeof '*)))
(arg-ptr (bytevector->pointer arg-bv)))
(define (arg-as-ptr)
(let* ((addresses (bytevector->uint-list arg-bv
(native-endianness)
(sizeof '*)))
(address (car addresses))
(ptr (make-pointer address)))
ptr))
(define (arg-string)
(let* ((ptr (arg-as-ptr))
(len (strlen ptr))
(bv (pointer->bytevector ptr len))
(copy (u8e:substring bv 0 len)))
copy))
(define (arg-event)
(let* ((ptr (arg-as-ptr))
(event (pointer->event ptr)))
event))
(and (not (eq? (tarot-cli-has-command cli-ptr) 0))
(cond ((not (eq? (tarot-cli-is-help cli-ptr) 0))
(make <tarot-command-help>))
((not (eq? (tarot-cli-is-version cli-ptr) 0))
(make <tarot-command-version>))
((not (eq? (tarot-cli-is-license cli-ptr) 0))
(make <tarot-command-license>))
((not (eq? (tarot-cli-is-error cli-ptr arg-ptr)
0))
(make <tarot-command-error>
#:error-string (arg-string)))
((not (eq? (tarot-cli-is-status cli-ptr)
0))
(make <tarot-command-status>))
((not (eq? (tarot-cli-is-load cli-ptr arg-ptr)
0))
(make <tarot-command-load>
#:filename (arg-string)))
((not (eq? (tarot-cli-is-save cli-ptr arg-ptr)
0))
(make <tarot-command-save>
#:filename (arg-string)))
((not (eq? (tarot-cli-is-check cli-ptr arg-ptr)
0))
(make <tarot-command-check>
#:event (arg-event)))
((not (eq? (tarot-cli-is-event cli-ptr arg-ptr)
0))
(make <tarot-command-event>
#:event (arg-event)))
(else
(make <tarot-command-unknown>))))))
#:slot-set! (lambda (cli c) (error "Use the parsing mechanism"))))
#+END_SRC
The allocation of a CLI is a little bit frustrating: you have to
define a maximum memory pool for the lexer, and a maximum for the
parser, but due to problems with bison you cannot control the growth
of these.
#+name: scm-define-cli-alloc
#+caption: Create a new CLI
#+BEGIN_SRC scheme :eval no
(define tarot-cli-sizeof
(pointer->procedure size_t
(dynamic-func "tarot_cli_sizeof"
(dynamic-link "libtarot"))
(list size_t size_t)))
(define tarot-cli-init
(pointer->procedure '*
(dynamic-func "tarot_cli_init"
(dynamic-link "libtarot"))
(list size_t size_t '*)))
(define-method (cli-alloc max-lexer max-parser)
(let* ((size (tarot-cli-sizeof max-lexer max-parser))
(memory (make-bytevector size))
(ptr (bytevector->pointer memory))
(initialized (tarot-cli-init max-lexer max-parser ptr))
(object (make <tarot-cli> #:ptr ptr)))
object))
#+END_SRC
In order to get a command from a string, we pass the buffered stream
to the cli, that will eat some prefix from the string, update the
internal state, and return the number of bytes that have been
processed. Then the function should be called again without these
first bytes.
#+name: scm-define-next
#+caption: Consider the next command
#+BEGIN_SRC scheme :eval no
(define tarot-cli-next
(pointer->procedure int
(dynamic-func "tarot_cli_next"
(dynamic-link "libtarot"))
(list '* int '* '*)))
(define-method (next (cli <tarot-cli>) available eof?)
(let ((cli-ptr (get-ptr cli))
(eof-int (if eof? 1 0))
(null-terminated (u8e:string-join (list available #vu8(0))))
(bv-end (make-bytevector (sizeof '*))))
(let* ((ptr-end (bytevector->pointer bv-end))
(ptr-start (bytevector->pointer null-terminated))
(has-nomem (tarot-cli-next cli-ptr eof-int ptr-start ptr-end)))
(if (not (eq? has-nomem 0))
(error "Command too complex.")
(let ((address-end (car (bytevector->uint-list bv-end
(native-endianness)
(sizeof '*))))
(address-beginning (pointer-address ptr-start)))
(- address-end address-beginning))))))
#+END_SRC
The CLI must be fed with text, and will produce a sequence of
commands. The easiest way to do that is through an infinite loop. We
read some text in a line of readline, then process the command(s)
parsed, and continue. The first prompt is a primary prompt, then it
is only a primary prompt if there is a finished command. Otherwise it
is a secundary prompt.
#+name: scm-define-run-interactive
#+caption: Run in interactive mode
#+BEGIN_SRC scheme :eval no
(define (run-interactive command-handler)
(define (aux cli remaining-bytes eof?)
(let ((n-to-discard (next cli remaining-bytes eof?)))
(let ((next-command
(get-command cli))
(remaining-remaining
(u8e:substring remaining-bytes
n-to-discard
(u8e:string-length remaining-bytes))))
(cond (next-command
(and (command-handler next-command)
(aux cli remaining-remaining eof?)))
((and (eq? n-to-discard 0)
eof?
(eq? (u8e:string-length remaining-bytes) 0))
#t)
((eq? n-to-discard 0)
(begin (set-buffered-input-continuation?!
(current-input-port)
(slot-ref cli 'continuation?))
(let* ((appended (get-bytevector-some (current-input-port)))
(new-eof? (or (eof-object? appended)
(eq? (u8e:string-length appended) 0)))
(str (if new-eof? #vu8() appended))
(new-remaining (u8e:string-join
(list remaining-remaining str))))
(aux cli new-remaining new-eof?))))
(else
(aux cli remaining-remaining eof?))))))
(aux (cli-alloc 4096 4096) #vu8() #f))
#+END_SRC
Now it is time to implement the logic of the interactive mode,
i.e. the definition of the =command-handler= function.
#+name: scm-define-make-command-handler
#+caption: Process a stream of commands
#+BEGIN_SRC scheme :eval no :noweb yes
(define (process-commands)
(define game (game-alloc))
(define-method (apply-command (cmd <tarot-command-help>))
(format #t (_ "Tarot help commands:
- help : print this help
- version : print the version information (~a)
- license : state that the program is under GPLv3+
- status : print the status of the game
- load \"/file/name\" : load the game from /file/name
- save \"/file/name\" : save the game to /file/name
- check <event> : check that this event is correct
- <event> : add this event to the game.
The events are:
- setup N : create a game for N players
- setup N with call : create a game for N players, with call
- deal <cards...> to <player> : Deal the cards to this player
- deal <owners...> : define the 78 owners, one for each card
- bid <bid> : a bid
- decl pass : do not declare slam
- decl slam : declare slam
- call <card> : call a card
- dog <cards...> : reveal the dog
- discard <cards...> : discard some cards (may be empty)
- handful <cards...> : show a handful
- play <card> : play a card.
The syntax for the cards is EXC, or at most 2 digits for the numbers
and a letter for the suit. Example:
- EXC : the excuse
- 1T : the petit
- 10H : the ten of hearts
- AC, JC, CC, QC, KC : the ace, jack, knight, queen and king of
clubs
The syntax for the players is P followed by a digit between 1 and the
number of players (included). Example: P1 for the first player, P5
for the fifth.
The bids are 'pass', 'take', 'push', 'straight keep', and 'double
keep'.
") "<<el-package-version()>>"))
(define-method (apply-command (cmd <tarot-command-version>))
(format #t "TODO: Print version\n"))
(define-method (apply-command (cmd <tarot-command-license>))
(format #t "TODO: Print the license\n"))
(define-method (apply-command (cmd <tarot-command-error>))
(format #t "ERROR: ~a\n" (utf8->string (slot-ref cmd 'error-string))))
(define-method (apply-command (cmd <tarot-command-status>))
(format #t "TODO: Print the status\n"))
(define-method (apply-command (cmd <tarot-command-load>))
(format #t "TODO: Load from ~a\n" (utf8->string (slot-ref cmd 'filename))))
(define-method (apply-command (cmd <tarot-command-save>))
(format #t "TODO: Save to ~a\n" (utf8->string (slot-ref cmd 'filename))))
(define-method (apply-command (cmd <tarot-command-check>))
(format #t "TODO: Check event ~y\n" (slot-ref cmd 'event)))
(define-method (apply-command (cmd <tarot-command-event>))
(format #t "TODO: Apply-Command event ~y\n" (slot-ref cmd 'event)))
(define-method (apply-command (cmd <tarot-command>))
(format #t "ERROR: Could not process this command\n"))
(lambda (cmd) (apply-command cmd)))
#+END_SRC
The command-line argument parser is implemented below.
#+name: scm-define-tarot-application-interactive-class
#+caption: Class definition =<tarot-application-features>=
#+BEGIN_SRC scheme :eval no
(define-class <tarot-application-interactive> (<tarot-application>))
#+END_SRC
#+name: scm-define-tarot-application-interactive-init
#+BEGIN_SRC scheme :eval no :noweb yes
(define (tarot-application-interactive-init args)
(let* ((option-spec `((version (single-char #\V) (value #f))
(help (single-char #\h) (value #f))))
(options (getopt-long args option-spec))
(help-wanted (option-ref options 'help #f))
(version-wanted (option-ref options 'version #f))
(work (not (or help-wanted version-wanted))))
(if (or help-wanted version-wanted)
(begin
(if version-wanted
(display (_ "tarot version <<el-package-version()>>")))
(if help-wanted
(format #t (_ "\
tarot features [OPTIONS]
-h, --help Print this help and exit
-V, --version Print the package version number (~a) and exit
") "<<el-package-version()>>"))
(exit 0))
(let* ((ret (make <tarot-application-interactive>)))
ret))))
#+END_SRC
Finally, running the interactive application is trivial.
#+name: scm-define-tarot-application-features-run
#+caption: Run the interactive application
#+BEGIN_SRC scheme :noweb no-export :eval no
(define-method (run (app <tarot-application-interactive>))
(activate-readline)
(set-readline-prompt! "> " "+ ")
(format #t (_ "tarot version ~a
Copyright (C) 2017, 2018 Vivien Kraus <vivien@planete-kraus.eu>
Tarot comes with ABSOLUTELY NO WARRANTY.
This program is free software, and you are welcome to redistribute it
under certain conditions.
Type 'license' for details.
")
"<<el-package-version()>>")
(run-interactive (process-commands)))
#+END_SRC
** UTF-8 everywhere
:PROPERTIES:
:header-args: :tangle ../src/scm/tarot/utf8-everywhere.scm :noweb no-export :eval no
......@@ -3405,13 +3785,18 @@ runs the app.
#:use-module (ice-9 match)
#:use-module (tarot utf8-everywhere)
#:use-module (sxml simple)
#:use-module (sxml match))
#:use-module (sxml match)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 buffered-input)
#:use-module (ice-9 readline))
(define _ gettext)
<<scm-define-tarot-application-class>>
<<scm-define-tarot-application-generate-class>>
<<scm-define-tarot-application-generate-init>>
<<scm-define-tarot-application-features-class>>
<<scm-define-tarot-application-features-init>>
<<scm-define-tarot-application-interactive-class>>
<<scm-define-tarot-application-interactive-init>>
<<scm-define-tarot-card>>
<<scm-define-tarot-player>>
<<scm-define-tarot-game>>
......@@ -3446,18 +3831,25 @@ runs the app.
<<scm-define-minus-game>>
<<scm-define-export-features>>
<<scm-define-print-features>>
<<scm-define-tarot-command>>
<<scm-define-tarot-cli>>
<<scm-define-cli-alloc>>
<<scm-define-next>>
<<scm-define-run-interactive>>
<<scm-define-make-command-handler>>
<<scm-define-tarot-application-generate-run>>
<<scm-define-tarot-application-features-run>>
<<scm-define-tarot-application-interactive-run>>
(define args (command-line))
(define app
(cond ((string=? (cadr args) "generate")
(cond ((and (not (null? (cdr args))) (string=? (cadr args) "generate"))
(tarot-application-generate-init (cons "tarot-generate" (cddr args))))
((string=? (cadr args) "features")
((and (not (null? (cdr args))) (string=? (cadr args) "features"))
(tarot-application-features-init (cons "tarot-features" (cddr args))))
(else
(error "The interactive program is not implemented yet"))))
(tarot-application-interactive-init (cons "tarot" (cdr args))))))
(run app)
#+END_SRC
......
#!/bin/sh
exit 0
./pre-inst-env tarot < $1 > $1.actual || exit 1
diff -q $1.actual $1.expected
......@@ -43,6 +43,7 @@ LIBTAROT_VERSION_INFO=0:0:0
%reldir%/generator/libtarot-generator.la \
%reldir%/lexer/libtarot-lexer.la \
%reldir%/parser/libtarot-parser.la \
%reldir%/cli/libtarot-cli.la \
lib-library/libgnulibrary.la
pkgconfig_DATA += %reldir%/libtarot.pc
......@@ -58,4 +59,5 @@ include %reldir%/ai/Makefile.am
include %reldir%/generator/Makefile.am
include %reldir%/lexer/Makefile.am
include %reldir%/parser/Makefile.am
include %reldir%/cli/Makefile.am
include %reldir%/scm/Makefile.am
# Makefile.am
#
# Copyright (C) 2018 Vivien Kraus <vivien@planete-kraus.eu>
#
# This program is free software: you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see
# <http://www.gnu.org/licenses/>.
noinst_LTLIBRARIES += %reldir%/libtarot-cli.la
tarotinclude_HEADERS += %reldir%/tarot/cli.h
%canon_reldir%_libtarot_cli_la_SOURCES = \
%reldir%/cli.c \
%reldir%/tarot/cli_private.h \
%reldir%/tarot/cli_private_impl.h
%canon_reldir%_libtarot_cli_la_CFLAGS = \
$(AM_CFLAGS)
%canon_reldir%_libtarot_cli_la_CXXFLAGS = \
$(AM_CXXFLAGS)
%canon_reldir%_libtarot_cli_la_CPPFLAGS = \
$(AM_CPPFLAGS)
%canon_reldir%_libtarot_cli_la_LDFLAGS = \
-no-undefined $(AM_LDADD)
AM_CPPFLAGS += -I $(srcdir)/%reldir% -I %reldir%
INDENTED += $(%canon_reldir%_libtarot_cli_la_SOURCES) \
$(%canon_reldir%_check_SOURCES)
LIBTAROT_CLI_LA = %reldir%/libtarot-cli.la
/**
* file tarot/cli.c
*
* Copyright (C) 2018 Vivien Kraus <vivien@planete-kraus.eu>
*
* This program is free software: you can redistribute it and/or
* modify it under the terms of the GNU General Public License as
* published by the Free Software Foundation, either version 3 of the
* License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful, but
* WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program. If not, see
* <http://www.gnu.org/licenses/>.
*/
#include <config.h>
#include <tarot/cli_private.h>
size_t
tarot_cli_sizeof (size_t maxt, size_t maxv)
{
return cli_sizeof (maxt, maxv);
}
TarotCli *
tarot_cli_init (size_t maxt, size_t maxv, void *mem)
{
return cli_init (maxt, maxv, mem);
}
int
tarot_cli_next (TarotCli * cli, int eof, const char *data, char **end)
{
return cli_next (cli, eof, data, end);
}
int
tarot_cli_has_command (const TarotCli * cli)
{
return cli_has_command (cli);
}
int
tarot_cli_is_continuation (const TarotCli * cli)
{
return cli_is_continuation (cli);
}
int
tarot_cli_is_help (const TarotCli * cli)
{
return cli_is_help (cli);
}
int
tarot_cli_is_version (const TarotCli * cli)
{
return cli_is_version (cli);
}
int
tarot_cli_is_license (const TarotCli * cli)
{
return cli_is_license (cli);
}
int
tarot_cli_is_error (const TarotCli * cli, char **error)
{
return cli_is_error (cli, error);
}
int
tarot_cli_is_status (const TarotCli * cli)
{
return cli_is_status (cli);
}
int
tarot_cli_is_load (const TarotCli * cli, char **filename)
{
return cli_is_load (cli, filename);
}
int
tarot_cli_is_save (const TarotCli * cli, char **filename)
{
return cli_is_save (cli, filename);
}
int
tarot_cli_is_check (const TarotCli * cli, TarotGameEvent ** event)
{
return cli_is_check (cli, event);
}
int
tarot_cli_is_event (const TarotCli * cli, TarotGameEvent ** event)