Commit 1e60a2c5 authored by Benoit Barbot's avatar Benoit Barbot
Browse files

add ta

parent 972a1468
../editor/Data.ml
\ No newline at end of file
../editor/Data.mli
\ No newline at end of file
../editor/DrawingGeom.ml
\ No newline at end of file
##----------------------------------------------------------------------
## DISCLAIMER
##
## This file contains the rules to make an Eliom project. The project is
## configured through the variables in the file Makefile.options.
##----------------------------------------------------------------------
include Makefile.options
##----------------------------------------------------------------------
## Internals
## Required binaries
ELIOMC := eliomc -ppx
ELIOMOPT := eliomopt -ppx
JS_OF_ELIOM := js_of_eliom -ppx
ELIOMDEP := eliomdep
OCSIGENSERVER := ocsigenserver
OCSIGENSERVER.OPT := ocsigenserver.opt
## Where to put intermediate object files.
## - ELIOM_{SERVER,CLIENT}_DIR must be distinct
## - ELIOM_CLIENT_DIR must not be the local dir.
## - ELIOM_SERVER_DIR could be ".", but you need to
## remove it from the "clean" rules...
export ELIOM_SERVER_DIR := _server
export ELIOM_CLIENT_DIR := _client
export ELIOM_TYPE_DIR := _server
DEPSDIR := _deps
ifeq ($(DEBUG),yes)
GENERATE_DEBUG ?= -g
RUN_DEBUG ?= "-v"
DEBUG_JS ?= -jsopt -pretty -jsopt -noinline -jsopt -debuginfo
endif
##----------------------------------------------------------------------
## General
.PHONY: all byte opt
all: byte opt
byte opt:: $(TEST_PREFIX)$(ELIOMSTATICDIR)/${PROJECT_NAME}.js
byte opt:: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf
byte opt:: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME)-test.conf
byte:: $(TEST_PREFIX)$(LIBDIR)/${PROJECT_NAME}.cma
opt:: $(TEST_PREFIX)$(LIBDIR)/${PROJECT_NAME}.cmxs
DIST_DIRS = $(ETCDIR) $(DATADIR) $(LIBDIR) $(LOGDIR) $(STATICDIR) $(ELIOMSTATICDIR) $(shell dirname $(CMDPIPE))
##----------------------------------------------------------------------
## Testing
DIST_FILES = $(ELIOMSTATICDIR)/$(PROJECT_NAME).js $(LIBDIR)/$(PROJECT_NAME).cma
.PHONY: test.byte test.opt
test.byte: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(DIST_FILES))
$(OCSIGENSERVER) $(RUN_DEBUG) -c $<
test.opt: $(addprefix $(TEST_PREFIX),$(ETCDIR)/$(PROJECT_NAME)-test.conf $(DIST_DIRS) $(patsubst %.cma,%.cmxs, $(DIST_FILES)))
$(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c $<
$(addprefix $(TEST_PREFIX), $(DIST_DIRS)):
mkdir -p $@
##----------------------------------------------------------------------
## Installing & Running
.PHONY: install install.byte install.byte install.opt install.static install.etc install.lib install.lib.byte install.lib.opt run.byte run.opt
install: install.byte install.opt
install.byte: install.lib.byte install.etc install.static | $(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(shell dirname $(CMDPIPE)))
install.opt: install.lib.opt install.etc install.static | $(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(shell dirname $(CMDPIPE)))
install.lib: install.lib.byte install.lib.opt
install.lib.byte: $(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cma | $(PREFIX)$(LIBDIR)
install $< $(PREFIX)$(LIBDIR)
install.lib.opt: $(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cmxs | $(PREFIX)$(LIBDIR)
install $< $(PREFIX)$(LIBDIR)
install.static: $(TEST_PREFIX)$(ELIOMSTATICDIR)/$(PROJECT_NAME).js | $(PREFIX)$(STATICDIR) $(PREFIX)$(ELIOMSTATICDIR)
cp -r $(LOCAL_STATIC)/* $(PREFIX)$(STATICDIR)
[ -z $(WWWUSER) ] || chown -R $(WWWUSER) $(PREFIX)$(STATICDIR)
install $(addprefix -o ,$(WWWUSER)) $< $(PREFIX)$(ELIOMSTATICDIR)
install.etc: $(TEST_PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf | $(PREFIX)$(ETCDIR)
install $< $(PREFIX)$(ETCDIR)/$(PROJECT_NAME).conf
.PHONY:
print-install-files:
@echo $(PREFIX)$(LIBDIR)
@echo $(PREFIX)$(STATICDIR)
@echo $(PREFIX)$(ELIOMSTATICDIR)
@echo $(PREFIX)$(ETCDIR)
$(addprefix $(PREFIX),$(ETCDIR) $(LIBDIR)):
install -d $@
$(addprefix $(PREFIX),$(DATADIR) $(LOGDIR) $(STATICDIR) $(ELIOMSTATICDIR) $(shell dirname $(CMDPIPE))):
install $(addprefix -o ,$(WWWUSER)) -d $@
run.byte:
$(OCSIGENSERVER) $(RUN_DEBUG) -c ${PREFIX}${ETCDIR}/${PROJECT_NAME}.conf
run.opt:
$(OCSIGENSERVER.OPT) $(RUN_DEBUG) -c ${PREFIX}${ETCDIR}/${PROJECT_NAME}.conf
##----------------------------------------------------------------------
## Aux
# Use `eliomdep -sort' only in OCaml>4
ifeq ($(shell ocamlc -version|cut -c1),4)
eliomdep=$(shell $(ELIOMDEP) $(1) -ppx -sort $(2) $(filter %.eliom %.ml,$(3))))
else
eliomdep=$(3)
endif
objs=$(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(3))))
depsort=$(call objs,$(1),$(2),$(call eliomdep,$(3),$(4),$(5)))
##----------------------------------------------------------------------
## Config files
FINDLIB_PACKAGES=$(patsubst %,\<extension\ findlib-package=\"%\"\ /\>,$(SERVER_PACKAGES))
EDIT_WARNING=DON\'T EDIT THIS FILE! It is generated from $(PROJECT_NAME).conf.in, edit that one, or the variables in Makefile.options
SED_ARGS := -e "/^ *%%%/d"
SED_ARGS += -e "s|%%PROJECT_NAME%%|$(PROJECT_NAME)|g"
SED_ARGS += -e "s|%%DATABASE_NAME%%|$(DATABASE_NAME)|g"
SED_ARGS += -e "s|%%DATABASE_USER%%|$(DATABASE_USER)|g"
SED_ARGS += -e "s|%%CMDPIPE%%|%%PREFIX%%$(CMDPIPE)|g"
SED_ARGS += -e "s|%%LOGDIR%%|%%PREFIX%%$(LOGDIR)|g"
SED_ARGS += -e "s|%%DATADIR%%|%%PREFIX%%$(DATADIR)|g"
SED_ARGS += -e "s|%%PERSISTENT_DATA_BACKEND%%|$(PERSISTENT_DATA_BACKEND)|g"
SED_ARGS += -e "s|%%LIBDIR%%|%%PREFIX%%$(LIBDIR)|g"
SED_ARGS += -e "s|%%WARNING%%|$(EDIT_WARNING)|g"
SED_ARGS += -e "s|%%PACKAGES%%|$(FINDLIB_PACKAGES)|g"
SED_ARGS += -e "s|%%ELIOMSTATICDIR%%|%%PREFIX%%$(ELIOMSTATICDIR)|g"
ifeq ($(DEBUG),yes)
SED_ARGS += -e "s|%%DEBUGMODE%%|\<debugmode /\>|g"
else
SED_ARGS += -e "s|%%DEBUGMODE%%||g"
endif
LOCAL_SED_ARGS := -e "s|%%PORT%%|$(TEST_PORT)|g"
LOCAL_SED_ARGS += -e "s|%%STATICDIR%%|$(LOCAL_STATIC)|g"
LOCAL_SED_ARGS += -e "s|%%USERGROUP%%||g"
GLOBAL_SED_ARGS := -e "s|%%PORT%%|$(PORT)|g"
GLOBAL_SED_ARGS += -e "s|%%STATICDIR%%|%%PREFIX%%$(STATICDIR)|g"
ifeq ($(WWWUSER)$(WWWGROUP),)
GLOBAL_SED_ARGS += -e "s|%%USERGROUP%%||g"
else
GLOBAL_SED_ARGS += -e "s|%%USERGROUP%%|<user>$(WWWUSER)</user><group>$(WWWGROUP)</group>|g"
endif
$(TEST_PREFIX)${ETCDIR}/${PROJECT_NAME}.conf: ${PROJECT_NAME}.conf.in Makefile.options | $(TEST_PREFIX)$(ETCDIR)
sed $(SED_ARGS) $(GLOBAL_SED_ARGS) $< | sed -e "s|%%PREFIX%%|$(PREFIX)|g" > $@
$(TEST_PREFIX)${ETCDIR}/${PROJECT_NAME}-test.conf: ${PROJECT_NAME}.conf.in Makefile.options | $(TEST_PREFIX)$(ETCDIR)
sed $(SED_ARGS) $(LOCAL_SED_ARGS) $< | sed -e "s|%%PREFIX%%|$(TEST_PREFIX)|g" > $@
##----------------------------------------------------------------------
## Server side compilation
SERVER_INC := ${addprefix -package ,${SERVER_PACKAGES}}
${ELIOM_TYPE_DIR}/%.type_mli: %.eliom
${ELIOMC} -infer ${SERVER_INC} $<
$(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cma: $(call objs,$(ELIOM_SERVER_DIR),cmo,$(SERVER_FILES)) | $(TEST_PREFIX)$(LIBDIR)
${ELIOMC} -a -o $@ $(GENERATE_DEBUG) \
$(call depsort,$(ELIOM_SERVER_DIR),cmo,-server,$(SERVER_INC),$(SERVER_FILES))
$(TEST_PREFIX)$(LIBDIR)/$(PROJECT_NAME).cmxa: $(call objs,$(ELIOM_SERVER_DIR),cmx,$(SERVER_FILES)) | $(TEST_PREFIX)$(LIBDIR)
${ELIOMOPT} -a -o $@ $(GENERATE_DEBUG) \
$(call depsort,$(ELIOM_SERVER_DIR),cmx,-server,$(SERVER_INC),$(SERVER_FILES))
%.cmxs: %.cmxa
$(ELIOMOPT) -shared -linkall -o $@ $(GENERATE_DEBUG) $<
${ELIOM_SERVER_DIR}/%.cmi: %.mli
${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
${ELIOM_SERVER_DIR}/%.cmi: %.eliomi
${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
${ELIOM_SERVER_DIR}/%.cmo: %.ml
${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
${ELIOM_SERVER_DIR}/%.cmo: %.eliom
${ELIOMC} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
${ELIOM_SERVER_DIR}/%.cmx: %.ml
${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
${ELIOM_SERVER_DIR}/%.cmx: %.eliom
${ELIOMOPT} -c ${SERVER_INC} $(GENERATE_DEBUG) $<
##----------------------------------------------------------------------
## Client side compilation
CLIENT_LIBS := ${addprefix -package ,${CLIENT_PACKAGES}}
CLIENT_INC := ${addprefix -package ,${CLIENT_PACKAGES}}
CLIENT_OBJS := $(filter %.eliom %.ml, $(CLIENT_FILES))
CLIENT_OBJS := $(patsubst %.eliom,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS})
CLIENT_OBJS := $(patsubst %.ml,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS})
$(TEST_PREFIX)$(ELIOMSTATICDIR)/$(PROJECT_NAME).js: $(call objs,$(ELIOM_CLIENT_DIR),cmo,$(CLIENT_FILES)) | $(TEST_PREFIX)$(ELIOMSTATICDIR)
${JS_OF_ELIOM} -o $@ $(GENERATE_DEBUG) $(CLIENT_INC) $(DEBUG_JS) \
$(call depsort,$(ELIOM_CLIENT_DIR),cmo,-client,$(CLIENT_INC),$(CLIENT_FILES))
${ELIOM_CLIENT_DIR}/%.cmi: %.mli
${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $<
${ELIOM_CLIENT_DIR}/%.cmo: %.eliom
${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $<
${ELIOM_CLIENT_DIR}/%.cmo: %.ml
${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $<
${ELIOM_CLIENT_DIR}/%.cmi: %.eliomi
${JS_OF_ELIOM} -c ${CLIENT_INC} $(GENERATE_DEBUG) $<
##----------------------------------------------------------------------
## Dependencies
include .depend
.depend: $(patsubst %,$(DEPSDIR)/%.server,$(SERVER_FILES)) $(patsubst %,$(DEPSDIR)/%.client,$(CLIENT_FILES))
cat $^ > $@
$(DEPSDIR)/%.server: % | $(DEPSDIR)
$(ELIOMDEP) -server -ppx $(SERVER_INC) $< > $@
$(DEPSDIR)/%.client: % | $(DEPSDIR)
$(ELIOMDEP) -client -ppx $(CLIENT_INC) $< > $@
$(DEPSDIR):
mkdir $@
##----------------------------------------------------------------------
## Clean up
clean:
-rm -f *.cm[ioax] *.cmxa *.cmxs *.o *.a *.annot
-rm -f *.type_mli
-rm -f ${PROJECT_NAME}.js
-rm -rf ${ELIOM_CLIENT_DIR} ${ELIOM_SERVER_DIR}
distclean: clean
-rm -rf $(TEST_PREFIX) $(DEPSDIR) .depend
#----------------------------------------------------------------------
# SETTINGS FOR THE ELIOM PROJECT cosmosweb
#----------------------------------------------------------------------
PROJECT_NAME := cosmosweb
# Source files for the server
SERVER_FILES := $(wildcard *.eliomi *.eliom)
# Source files for the client
CLIENT_FILES := $(wildcard *.eliomi *.eliom) graphDrawing.ml utilsWeb.ml SimpleGraph.ml Data.ml TikzGraph.ml MarkovChain.ml layout.ml genericSerializer.ml tikzLexer.ml tikzParser.ml DrawingGeom.ml
# OCamlfind packages for the server
SERVER_PACKAGES := lwt.ppx js_of_ocaml-ppx.deriving xml-light
# OCamlfind packages for the client
CLIENT_PACKAGES := lwt.ppx js_of_ocaml-ppx js_of_ocaml-ppx.deriving xml-light
# Directory with files to be statically served
LOCAL_STATIC = static
# The backend for persistent data. Can be dbm or sqlite.
# Make sure you have the following packages installed
# - *dbm* if you use dbm --> opam install dbm.
# - *sqlite3* if you use sqlite --> opam install sqlite3.
PERSISTENT_DATA_BACKEND = sqlite
# Debug application (yes/no): Debugging info in compilation,
# JavaScript, ocsigenserver
DEBUG := no
# User to run server with (make run.*)
WWWUSER := www-data
WWWGROUP := www-data
# Port for running the server (make run.*)
PORT := 80
# Port for testing (make test.*)
TEST_PORT := 8080
# Root of installation (must end with /)
PREFIX := /usr/local/
# Local folder for make test.* (must end with /)
# Do not add files manually in this directory.
# It is just here to test your installation before installing in /
TEST_PREFIX := local/
# The installation tree (relative to $(PREFIX) when
# installing/running or $(TEST_PREFIX) when testing).
# Configuration file $(PROJECT_NAME).conf
ETCDIR := etc/${PROJECT_NAME}
# Project's library $(PROJECT_NAME).cma (cmxs)
LIBDIR := lib/${PROJECT_NAME}
# Command pipe, eg. $ echo reload > $(INSTALL_PREFIX)$(CMDPIPE)
CMDPIPE := var/run/${PROJECT_NAME}-cmd
# Ocsigenserver's logging files
LOGDIR := var/log/${PROJECT_NAME}
# Ocsigenserver's persistent data files
DATADIR := var/data/${PROJECT_NAME}
# Copy of $(LOCAL_STATIC)
STATICDIR := var/www/${PROJECT_NAME}/static
# Project's JavaScript file
ELIOMSTATICDIR := var/www/${PROJECT_NAME}/eliom
type def = unit
type state = string * (string list)
type arc = float
type attribute_id = int
type attribute = [ `Choice of string list
| `ControlPoint of DrawingGeom.point
| `String of string
| `Color of string ]
let init_def () = ()
let init_arc _ _ = Some 1.0
let state_id = ref 0
let init_state () = incr state_id;
("s"^(string_of_int !state_id), ["toto"])
let draw_state (s,_) p = [
`RoundedRectangle (p,10.0,0.75,5.0);
`Text(p,s);
]
let draw_arc arc (source_sh,target_sh) =
let open DrawingGeom in
let pos1 = center_shape source_sh in
let pos2 = projection_shape pos1 target_sh in
let pos3 = projection_shape pos2 source_sh in
let text = string_of_float arc in
let middle = mult 0.5 (pos3 +.. pos2) in
let rho = angle (pos3 -..pos2) in
let textvect = middle +.. rot rho (0.0,8.0) in
[`Line (pos1,pos3); `Arrow (pos2,pos1) ; `Text(textvect, text)]
let get_state_attr (s, at) =
"Node", ((0,"content",`String s) ::
(List.mapi (fun i sv -> (i+1),"attribute "^(string_of_int (i+1)),(`String sv )) at))
let update_state_attr (s,at) attr_id = function
| None ->
if attr_id = 0 then Some ("",at)
else
let _,listat = List.fold_left (fun (i,l) at ->
if attr_id = i+1 then
(i+1, l) else (i+1, at::l)) (0,[]) at in
Some (s,listat)
| Some (`String newv) ->
if attr_id = 0 then Some (newv,at)
else
let _,listat = List.fold_left (fun (i,l) at ->
if attr_id = i+1 then
(i+1, newv::l) else (i+1, at::l)) (0,[]) at in
Some (s,listat)
| _ -> None
let get_new_state_attr (s,at) _ = []
let get_arc_attr prob =
"Arc", [(0,"Probability",`String (string_of_float prob)) ]
let update_arc_attr _ _ = function
| None ->
begin try let p = 1.0 in
if p>= 0.0 && p<= 1.0 then Some p else None
with _ -> None
end
| Some (`String v) ->
begin try let p = float_of_string v in
if p>= 0.0 && p<= 1.0 then Some p else None
with _ -> None
end
| _ -> None
let get_new_arc_attr atlist _ = []
let string_of_attribute = function
| `Prob arc -> string_of_float arc
| `StringExpr s -> s
| `Choice (t::_) -> t
| `Choice [] -> ""
| `ControlPoint _ -> ""
let download_file_name = "markovChain.dot"
let print f stateit arcit =
Format.fprintf f "digraph {\n";
stateit (fun _ (s,_) (x,y) -> Format.fprintf f "%s [pos=\"%f,%f\"];\n" s (x) (y));
arcit (fun _ _ ((_,(source,_),_),(_,(target,_),_)) ->
Format.fprintf f "%s -> %s;\n" source target);
Format.fprintf f "}"
let parse_file _ add_node add_arc = ()
Instructions
============
This project is (initially) generated by eliom-distillery as the basic
project "cosmosweb".
Generally, you can compile it and run ocsigenserver on it by
$ make test.byte (or test.opt)
See below for other useful targets for make.
Generated files
---------------
The following files in this directory have been generated by
eliom-distillery:
- cosmosweb.eliom
This is your initial source file.
- static/
The content of this folder is statically served. Put your CSS or
additional JavaScript files here!
- Makefile.options
Configure your project here!
- cosmosweb.conf.in
This file is a template for the configuration file for
ocsigenserver. You will rarely have to edit itself - it takes its
variables from the Makefile.options. This way, the installation
rules and the configuration files are synchronized with respect to
the different folders.
- Makefile
This contains all rules necessary to build, test, and run your
Eliom application. You better don't touch it ;) See below for the
relevant targets.
- local/
This directory is the target of the temporary installation of
your application, to test locally before doing a system-wide
installation in /. Do not put anything manually here.
- README
Not completely describable here.
Makefile targets
----------------
Here's some help on how to work with this basic distillery project:
- Test your application by compiling it and running ocsigenserver locally
$ make test.byte (or test.opt)
- Compile it only
$ make all (or byte or opt)
- Deploy your project on your system
$ sudo make install (or install.byte or install.opt)
- Run the server on the deployed project
$ sudo make run.byte (or run.opt)
If WWWUSER in the Makefile.options is you, you don't need the
`sudo'. If Eliom isn't installed globally, however, you need to
re-export some environment variables to make this work:
$ sudo PATH=$PATH OCAMLPATH=$OCAMLPATH LD_LIBRARY_PATH=$LD_LIBRARY_PATH make run.byte/run.opt
- If you need a findlib package in your project, add it to the
variables SERVER_PACKAGES and/or CLIENT_PACKAGES. The configuration
file will be automatically updated.
../editor/SimpleGraph.ml
\ No newline at end of file
type def = unit
type state = string * (string list)
type arc = string list * DrawingGeom.path_elem list
type attribute_id = A | B of int | C of int | D of int
type attribute = [ `Choice of string list
| `ControlPoint of DrawingGeom.point
| `String of string
| `Color of string ]
let init_def () = ()
let state_id = ref 0
let init_state () = incr state_id;
("s"^(string_of_int !state_id), ["draw"])
let is_prefix s t =
let n = String.length t in
if String.length s >= n then
if String.sub s 0 n = t then Some (String.sub s n (String.length s-n))
else None
else None
let get_attribute t l =
List.fold_left (fun v at ->
(match is_prefix at t with Some x -> Some x | _ ->v);
) None l
let replace_list id v l =
let _,listat = List.fold_left (fun (i,l) at ->
if id = i then
(i+1, match v with Some v -> v::l | None -> l)
else (i+1, at::l)) (0,[]) l in
List.rev listat
let draw_state (s,at) p =
let draw = ref false
and shape = ref (`Rectangle (p,0.75,7.0,0.0))
and color = ref (0,0,0)
and fill = ref (255,255,255) in
List.iter (function
"draw" -> draw := true
| "circle" -> shape := `Circle (p,10.0)
| "rounded corners" -> shape := `RoundedRectangle (p,10.0,0.75,5.0)
| at ->
(match is_prefix at "color=" with Some x -> color:= DrawingGeom.Color.parse x; |_ ->());
(match is_prefix at "fill=" with Some x -> fill:= DrawingGeom.Color.parse x; |_ ->());
) at;
if not !draw then shape := `Circle (p,1.2);
(*`RoundedRectangle (p,10.0,0.75,5.0);*)
[ `Colors (!color,!fill);
!shape;
(*`Circle (p,10.0);*)
`Text(p,s);
`Colors ((0,0,0),(255,255,255));
]
let get_state_attr (s, at) =
"Node", ((A,"content",`String s) ::
(List.mapi (fun i sv ->
(match is_prefix sv "color=" with
Some x -> B i,"Color",`Color x
| None -> (match is_prefix sv "fill=" with
| Some x -> C i, "Fill", `Color x
| None ->
(B i),"Attribute", (`String sv )))) at))
let update_state_attr (s,at) attr_id = function
| None -> begin match attr_id with
A -> Some ("",at)
| B id -> Some (s,replace_list id None at)
| _-> None
end
| Some (`String newv) -> begin
match attr_id with
A -> Some (newv,at)
| B id -> Some (s,replace_list id (Some newv) at)
| _-> None
end
| Some (`Color newv) -> begin
match attr_id with
A -> Some (newv,at)
| B id -> Some (s,replace_list id (Some ("color="^newv)) at)
| C id -> Some (s,replace_list id (Some ("fill="^newv)) at)
| _ -> None
end
| _ -> None
let get_new_state_attr (s,at) _ = [
"Attribute", (fun (s,at) -> (s, at@[""]), B (List.length at)) ;
"Color", (fun (s,at) -> (s, at@["color=black"]), B (List.length at)) ;
"Fill", (fun (s,at) -> (s, at@["fill=black"]), C (List.length at)) ;
]
let init_arc n1 n2 =
if n1 <> n2 then Some (["draw";"->"],[])
else Some (["draw";"->";"loop"],[])
let draw_arc (at,cn) (source_sh,target_sh) =
let open DrawingGeom in
let pos1 = center_shape source_sh
and pos2 = center_shape target_sh in
let lcol = at
|> List.map (fun a -> is_prefix a "color=")
|> List.filter (function None -> false | _ -> true)
|> List.map (function Some x -> `Colors (DrawingGeom.Color.parse x,(255,255,255))
| None -> `Colors ((0,0,0),(255,255,255))) in
let l = if source_sh<>target_sh || cn<>[] then begin
shapes_of_path source_sh cn ~arrow2:(Some (fun x y -> `SimpleArrow (x,y))) target_sh
end else begin
let p1 = pos1 +.. (40.0 , -.25.0)
and p2 = pos2 +.. (40.0 , 25.0) in
shapes_of_path source_sh [`ControlPoint p1; `ControlPoint p2] ~arrow2:(Some (fun x y -> `Arrow (x,y))) target_sh
end in
lcol @ l
(* let _,bline = List.fold_left (fun (pi,l) pip -> (pip, `Bezier2 (pi,(0.0,0.0),pip) :: l))
(pos1,[`Arrow (pos2,List.hd (List.rev point_list)) ;`Colors ("black","black") ; `Text(textvect, text); `Colors ("black","white")] )
(point_list@[pos2]) in
bline*)
let get_arc_attr (atlist,controllist) =
"Arc", (
(List.mapi (fun i sv ->
(match is_prefix sv "color=" with
Some x -> D i,"Color",`Color x
| None -> (B i),"Attribute", (`String sv ))) atlist)
@ (List.mapi (fun i sv -> (match