├── .github ├── dependabot.yml └── workflows │ └── build.yml ├── .gitignore ├── .ocamlformat ├── .ocp-indent ├── CHANGES ├── CODE_OF_CONDUCT.md ├── LICENSE ├── META.in ├── Makefile ├── Makefile.options ├── README.md ├── css ├── ot_buttons.css ├── ot_carousel.css ├── ot_color_picker.css ├── ot_datetime.css ├── ot_drawer.css ├── ot_icons.css ├── ot_page_transition.css ├── ot_picture_uploader.css ├── ot_popup.css ├── ot_pull_to_refresh.css ├── ot_spinner.css ├── ot_sticky.css ├── ot_tip.css └── ot_tongue.css ├── doc ├── indexdoc.client ├── indexdoc.server └── manual-wiki │ └── intro.wiki ├── ocsigen-toolkit.install ├── opam └── src └── widgets ├── ot_buttons.eliom ├── ot_buttons.eliomi ├── ot_calendar.eliom ├── ot_calendar.eliomi ├── ot_carousel.eliom ├── ot_carousel.eliomi ├── ot_color_picker.eliom ├── ot_color_picker.eliomi ├── ot_drawer.eliom ├── ot_drawer.eliomi ├── ot_form.eliom ├── ot_form.eliomi ├── ot_icons.eliom ├── ot_lib.eliom ├── ot_lib.eliomi ├── ot_nodeready.eliom ├── ot_nodeready.eliomi ├── ot_noderesize.eliom ├── ot_noderesize.eliomi ├── ot_page_transition.eliom ├── ot_page_transition.eliomi ├── ot_picture_uploader.eliom ├── ot_picture_uploader.eliomi ├── ot_popup.eliom ├── ot_popup.eliomi ├── ot_pulltorefresh.eliom ├── ot_pulltorefresh.eliomi ├── ot_range.eliom ├── ot_range.eliomi ├── ot_size.eliom ├── ot_size.eliomi ├── ot_spinner.eliom ├── ot_spinner.eliomi ├── ot_sticky.eliom ├── ot_sticky.eliomi ├── ot_style.eliom ├── ot_style.eliomi ├── ot_swipe.eliom ├── ot_swipe.eliomi ├── ot_time_picker.eliom ├── ot_time_picker.eliomi ├── ot_tip.eliom ├── ot_tip.eliomi ├── ot_toggle.eliom ├── ot_toggle.eliomi ├── ot_tongue.eliom └── ot_tongue.eliomi /.github/dependabot.yml: -------------------------------------------------------------------------------- 1 | version: 2 2 | updates: 3 | - package-ecosystem: github-actions 4 | directory: / 5 | schedule: 6 | interval: weekly 7 | -------------------------------------------------------------------------------- /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | 3 | on: 4 | pull_request: 5 | push: 6 | branches: 7 | - master 8 | schedule: 9 | # Prime the caches every Monday 10 | - cron: 0 1 * * MON 11 | 12 | jobs: 13 | build: 14 | strategy: 15 | fail-fast: false 16 | matrix: 17 | os: 18 | - ubuntu-latest 19 | ocaml-compiler: 20 | - "4.13" 21 | - "4.14" 22 | - "5.0" 23 | - "5.1" 24 | - "5.2" 25 | include: 26 | - os: macos-latest 27 | ocaml-compiler: "4.14" 28 | - os: macos-latest 29 | ocaml-compiler: "5.2" 30 | 31 | runs-on: ${{ matrix.os }} 32 | 33 | steps: 34 | - name: Checkout tree 35 | uses: actions/checkout@v4 36 | 37 | - name: Set-up OCaml 38 | uses: ocaml/setup-ocaml@v3 39 | with: 40 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 41 | opam-pin: false 42 | 43 | - name: Re-install OpenSSL on macOS 44 | if: runner.os == 'macOS' 45 | run: brew update && brew reinstall openssl@3 46 | 47 | - run: opam pin add -n eliom https://github.com/ocsigen/eliom.git 48 | 49 | - run: opam install . --deps-only 50 | 51 | - run: opam exec -- make 52 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .depend 2 | _client 3 | _deps 4 | _server 5 | lib 6 | _opam 7 | doc/client 8 | doc/server 9 | -------------------------------------------------------------------------------- /.ocamlformat: -------------------------------------------------------------------------------- 1 | break-cases = fit 2 | break-collection-expressions = fit-or-vertical 3 | break-fun-decl = wrap 4 | break-fun-sig = wrap 5 | break-infix = wrap 6 | break-infix-before-func = false 7 | break-sequences = false 8 | break-separators = before 9 | break-string-literals = never 10 | break-struct = force 11 | cases-matching-exp-indent = compact 12 | doc-comments = after-when-possible 13 | dock-collection-brackets = false 14 | indicate-multiline-delimiters = no 15 | infix-precedence = indent 16 | let-and = compact 17 | let-binding-spacing = compact 18 | module-item-spacing = compact 19 | parens-tuple = multi-line-only 20 | parens-tuple-patterns = multi-line-only 21 | sequence-style = terminator 22 | sequence-blank-line = compact 23 | single-case = compact 24 | type-decl = compact 25 | if-then-else = keyword-first 26 | field-space = loose 27 | space-around-arrays = false 28 | space-around-records = false 29 | space-around-lists = false 30 | space-around-variants = false 31 | ocp-indent-compat = true 32 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | normal 2 | with=0 3 | syntax=lwt mll 4 | max_indent=2 5 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | ===== 4.1.0 ===== 2 | * Compatibility with WASM 3 | 4 | ===== 4.0.0 ===== 5 | * Compatibility with Ocsigen Server 6 6 | 7 | ===== 2.8.0 (2020-07-28) ===== 8 | 9 | * rework Ot_page_transition 10 | 11 | ===== 2.7.0 (2020-04-29) ===== 12 | 13 | * New widget: ot_tongue 14 | 15 | ===== 2.5.0 (2020-01-28) ===== 16 | * ot_popup : Add parameter to toggle scroll hack 17 | * Compatibility with Js_of_ocaml 3.5 18 | 19 | ===== 2.4.1 (2019-08-16) ===== 20 | * compatibility with Js_of_ocaml 3.5 21 | * carousel: make it possible to use it when less than 1 page is visible 22 | * spinner: more customization possibilities for spinner 23 | 24 | ===== 2.3.2 (2019-08-16) ===== 25 | 26 | * pulltorefresh and drawer fixes 27 | 28 | ===== 2.3.1 (2019-06-24) ===== 29 | 30 | * New widget: pull to refresh 31 | 32 | ===== 2.2 (2019-06-13) ===== 33 | 34 | * Updated color picker 35 | 36 | ===== 2.1 (2019-02-08) ===== 37 | 38 | * compatibility with eliom's DOM caching functionality 39 | 40 | ===== 2.0.0 (2018-12-19) ===== 41 | 42 | * carousel improvements: lazy loading, performance 43 | * split Ot_popup into Ot_popup/Ot_form modules 44 | * close popups on hitting the ESC key 45 | * Ot_page_transition: widget for implementing page transition animations (beta) 46 | * Ot_spinner.replace_content: load new content into existing div 47 | * Ot_tip: display hovering boxes of content 48 | * vertical drawer 49 | * Ot_nodeready: avoid memory leaks 50 | * Automatically generate documentation (html_of_wiki) 51 | 52 | ===== 1.1 (2017-02-08) ===== 53 | 54 | * Compatibility with Eliom 6.3 and OCaml 4.06 55 | * Ot_page_transition widget 56 | * Various small fixes and improvements 57 | 58 | ===== 1.0 (2017-02-07) ===== 59 | 60 | * Fixes in drawer widget 61 | 62 | ===== 0.99 (2016-12-09) ===== 63 | 64 | * Initial version (beta) 65 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Code of Conduct 2 | 3 | This project has adopted the [OCaml Code of Conduct](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md). 4 | 5 | # Enforcement 6 | 7 | This project follows the OCaml Code of Conduct [enforcement policy](https://github.com/ocaml/code-of-conduct/blob/main/CODE_OF_CONDUCT.md#enforcement). 8 | 9 | To report any violations, please contact Jérôme 10 | Vouillon, Raphael Proust, Vincent Balat, Hugo Heuzard and Gabriel 11 | Radanne at 12 | (or some of them individually). 13 | -------------------------------------------------------------------------------- /META.in: -------------------------------------------------------------------------------- 1 | names = "@@PKG_NAME@@" 2 | version = "@@PKG_VERS@@" 3 | description = "@@PKG_DESC@@" 4 | 5 | package "server" ( 6 | requires = "@@SERVER_REQUIRES@@" 7 | directory = "server" 8 | archive(byte) = "@@SERVER_ARCHIVES_BYTE@@" 9 | archive(byte, plugin) = "@@SERVER_ARCHIVES_BYTE@@" 10 | archive(native) = "@@SERVER_ARCHIVES_NATIVE@@" 11 | archive(native, plugin) = "@@SERVER_ARCHIVES_NATIVE_PLUGIN@@" 12 | ) 13 | 14 | package "client" ( 15 | requires = "@@CLIENT_REQUIRES@@" 16 | directory = "client" 17 | archive(byte) = "@@CLIENT_ARCHIVES_BYTE@@" 18 | archive(byte, plugin) = "@@CLIENT_ARCHIVES_BYTE@@" 19 | ) 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | ##---------------------------------------------------------------------- 3 | ## DISCLAIMER 4 | ## 5 | ## This file contains the rules to make an ocsigen package. The project 6 | ## is configured through the variables in the file Makefile.options. 7 | ##---------------------------------------------------------------------- 8 | 9 | include Makefile.options 10 | 11 | ##---------------------------------------------------------------------- 12 | ## Internals 13 | 14 | ## Required binaries 15 | ELIOMC := eliomc -ppx ${WARNING_FLAGS} 16 | ELIOMOPT := eliomopt -ppx ${WARNING_FLAGS} 17 | JS_OF_ELIOM := js_of_eliom -ppx 18 | ELIOMDEP := eliomdep 19 | OCAMLFIND := ocamlfind 20 | 21 | ## Where to put intermediate object files. 22 | ## - ELIOM_{SERVER,CLIENT}_DIR must be distinct 23 | ## - ELIOM_CLIENT_DIR must not be the local dir. 24 | ## - ELIOM_SERVER_DIR could be ".", but you need to 25 | ## remove it from the "clean" rules... 26 | export ELIOM_SERVER_DIR := _server 27 | export ELIOM_CLIENT_DIR := _client 28 | export ELIOM_TYPE_DIR := _server 29 | 30 | ifeq ($(DEBUG),yes) 31 | GENERATE_DEBUG ?= -g 32 | endif 33 | 34 | ifeq ($(NATIVE),yes) 35 | OPT_RULE = opt 36 | endif 37 | 38 | ##---------------------------------------------------------------------- 39 | ## General 40 | 41 | .PHONY: all byte opt doc 42 | all: byte $(OPT_RULE) 43 | byte:: $(LIBDIR)/${PKG_NAME}.server.cma $(LIBDIR)/${PKG_NAME}.client.cma 44 | opt:: $(LIBDIR)/${PKG_NAME}.server.cmxs 45 | 46 | ##---------------------------------------------------------------------- 47 | ## Aux 48 | 49 | eliomdep=$(shell $(ELIOMDEP) $(1) -ppx -sort $(2) $(filter %.eliom %.ml,$(3)))) 50 | objs=$(patsubst %.ml,$(1)/%.$(2),$(patsubst %.eliom,$(1)/%.$(2),$(filter %.eliom %.ml,$(3)))) 51 | depsort=$(call objs,$(1),$(2),$(call eliomdep,$(3),$(4),$(5))) 52 | 53 | $(LIBDIR): 54 | mkdir $(LIBDIR) 55 | 56 | ##---------------------------------------------------------------------- 57 | ## Server side compilation 58 | 59 | ## make it more elegant ? 60 | SERVER_DIRS := $(shell echo $(foreach f, $(SERVER_FILES), $(dir $(f))) | tr ' ' '\n' | sort -u | tr '\n' ' ') 61 | SERVER_DEP_DIRS := ${addprefix -eliom-inc ,${SERVER_DIRS}} 62 | SERVER_INC_DIRS := ${addprefix -I $(ELIOM_SERVER_DIR)/, ${SERVER_DIRS}} 63 | 64 | SERVER_INC := ${addprefix -package ,${SERVER_PACKAGES} ${SERVER_PPX_PACKAGES}} 65 | 66 | ${ELIOM_TYPE_DIR}/%.type_mli: %.eliom 67 | ${ELIOMC} -infer ${SERVER_INC} ${SERVER_INC_DIRS} $< 68 | 69 | $(LIBDIR)/$(PKG_NAME).server.cma: $(call objs,$(ELIOM_SERVER_DIR),cmo,$(SERVER_FILES)) | $(LIBDIR) 70 | ${ELIOMC} -a -o $@ $(GENERATE_DEBUG) \ 71 | $(call depsort,$(ELIOM_SERVER_DIR),cmo,-server,$(SERVER_INC),$(SERVER_FILES)) 72 | 73 | $(LIBDIR)/$(PKG_NAME).server.cmxa: $(call objs,$(ELIOM_SERVER_DIR),cmx,$(SERVER_FILES)) | $(LIBDIR) 74 | ${ELIOMOPT} -a -o $@ $(GENERATE_DEBUG) \ 75 | $(call depsort,$(ELIOM_SERVER_DIR),cmx,-server,$(SERVER_INC),$(SERVER_FILES)) 76 | 77 | %.cmxs: %.cmxa 78 | $(ELIOMOPT) -shared -linkall -o $@ $(GENERATE_DEBUG) $< 79 | 80 | ${ELIOM_SERVER_DIR}/%.cmi: %.mli 81 | ${ELIOMC} -c ${SERVER_INC} ${SERVER_INC_DIRS} $(GENERATE_DEBUG) $< 82 | 83 | ${ELIOM_SERVER_DIR}/%.cmi: %.eliomi 84 | ${ELIOMC} -c ${SERVER_INC} ${SERVER_INC_DIRS} $(GENERATE_DEBUG) $< 85 | 86 | ${ELIOM_SERVER_DIR}/%.cmo: %.ml 87 | ${ELIOMC} -c ${SERVER_INC} ${SERVER_INC_DIRS} $(GENERATE_DEBUG) $< 88 | ${ELIOM_SERVER_DIR}/%.cmo: %.eliom 89 | ${ELIOMC} -c ${SERVER_INC} ${SERVER_INC_DIRS} $(GENERATE_DEBUG) $< 90 | 91 | ${ELIOM_SERVER_DIR}/%.cmx: %.ml 92 | ${ELIOMOPT} -c ${SERVER_INC} ${SERVER_INC_DIRS} $(GENERATE_DEBUG) $< 93 | ${ELIOM_SERVER_DIR}/%.cmx: %.eliom 94 | ${ELIOMOPT} -c ${SERVER_INC} ${SERVER_INC_DIRS} $(GENERATE_DEBUG) $< 95 | 96 | 97 | ##---------------------------------------------------------------------- 98 | ## Client side compilation 99 | 100 | ## make it more elegant ? 101 | CLIENT_DIRS := $(shell echo $(foreach f, $(CLIENT_FILES), $(dir $(f))) | tr ' ' '\n' | sort -u | tr '\n' ' ') 102 | CLIENT_DEP_DIRS := ${addprefix -eliom-inc ,${CLIENT_DIRS}} 103 | CLIENT_INC_DIRS := ${addprefix -I $(ELIOM_CLIENT_DIR)/,${CLIENT_DIRS}} 104 | 105 | CLIENT_LIBS := ${addprefix -package ,${CLIENT_PACKAGES} ${CLIENT_PPX_PACKAGES}} 106 | CLIENT_INC := ${addprefix -package ,${CLIENT_PACKAGES} ${CLIENT_PPX_PACKAGES}} 107 | 108 | CLIENT_OBJS := $(filter %.eliom %.ml, $(CLIENT_FILES)) 109 | CLIENT_OBJS := $(patsubst %.eliom,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS}) 110 | CLIENT_OBJS := $(patsubst %.ml,${ELIOM_CLIENT_DIR}/%.cmo, ${CLIENT_OBJS}) 111 | 112 | $(LIBDIR)/$(PKG_NAME).client.cma: $(call objs,$(ELIOM_CLIENT_DIR),cmo,$(CLIENT_FILES)) | $(LIBDIR) 113 | ${JS_OF_ELIOM} -a -o $@ $(GENERATE_DEBUG) \ 114 | $(call depsort,$(ELIOM_CLIENT_DIR),cmo,-client,$(CLIENT_INC),$(CLIENT_FILES)) 115 | 116 | ${ELIOM_CLIENT_DIR}/%.cmi: %.mli 117 | ${JS_OF_ELIOM} -c ${CLIENT_INC} ${CLIENT_INC_DIRS} $(GENERATE_DEBUG) $< 118 | 119 | ${ELIOM_CLIENT_DIR}/%.cmo: %.eliom 120 | ${JS_OF_ELIOM} -c ${CLIENT_INC} ${CLIENT_INC_DIRS} $(GENERATE_DEBUG) $< 121 | ${ELIOM_CLIENT_DIR}/%.cmo: %.ml 122 | ${JS_OF_ELIOM} -c ${CLIENT_INC} ${CLIENT_INC_DIRS} $(GENERATE_DEBUG) $< 123 | 124 | ${ELIOM_CLIENT_DIR}/%.cmi: %.eliomi 125 | ${JS_OF_ELIOM} -c ${CLIENT_INC} ${CLIENT_INC_DIRS} $(GENERATE_DEBUG) $< 126 | 127 | ##---------------------------------------------------------------------- 128 | ## Installation 129 | 130 | CLIENT_CMO=$(wildcard $(addsuffix /$(MODULE_PREFIX)*.cmo,$(addprefix $(ELIOM_CLIENT_DIR)/,$(CLIENT_DIRS)))) 131 | CLIENT_CMI=$(wildcard $(addsuffix /$(MODULE_PREFIX)*.cmi,$(addprefix $(ELIOM_CLIENT_DIR)/,$(CLIENT_DIRS)))) 132 | SERVER_CMI=$(wildcard $(addsuffix /$(MODULE_PREFIX)*.cmi,$(addprefix $(ELIOM_SERVER_DIR)/,$(SERVER_DIRS)))) 133 | SERVER_CMX=$(wildcard $(addsuffix /$(MODULE_PREFIX)*.cmx,$(addprefix $(ELIOM_SERVER_DIR)/,$(SERVER_DIRS)))) 134 | 135 | basename_for_each = $(shell echo $(foreach f,$(1),$(shell basename $(f)))) 136 | CLIENT_CMO_META=$(call basename_for_each, $(call depsort,$(ELIOM_CLIENT_DIR),cmo,-client,$(CLIENT_INC),$(CLIENT_FILES))) 137 | 138 | META: META.in 139 | sed -e 's#@@PKG_NAME@@#$(PKG_NAME)#g' \ 140 | -e 's#@@PKG_VERS@@#$(PKG_VERS)#g' \ 141 | -e 's#@@PKG_DESC@@#$(PKG_DESC)#g' \ 142 | -e 's#@@CLIENT_REQUIRES@@#$(CLIENT_PACKAGES)#g' \ 143 | -e 's#@@CLIENT_ARCHIVES_BYTE@@#$(CLIENT_CMO_META)#g' \ 144 | -e 's#@@SERVER_REQUIRES@@#$(SERVER_PACKAGES)#g' \ 145 | -e 's#@@SERVER_ARCHIVES_BYTE@@#$(PKG_NAME).server.cma#g' \ 146 | -e 's#@@SERVER_ARCHIVES_NATIVE@@#$(PKG_NAME).server.cmxa#g' \ 147 | -e 's#@@SERVER_ARCHIVES_NATIVE_PLUGIN@@#$(PKG_NAME).server.cmxs#g' \ 148 | $< > $@ 149 | 150 | install: all META 151 | $(OCAMLFIND) install $(PKG_NAME) META 152 | mkdir -p `$(OCAMLFIND) query $(PKG_NAME)`/client 153 | mkdir -p `$(OCAMLFIND) query $(PKG_NAME)`/server 154 | cp $(CLIENT_CMI) `$(OCAMLFIND) query $(PKG_NAME)`/client 155 | cp $(CLIENT_CMO) `$(OCAMLFIND) query $(PKG_NAME)`/client 156 | cp $(SERVER_CMI) `$(OCAMLFIND) query $(PKG_NAME)`/server 157 | cp $(SERVER_CMX) `$(OCAMLFIND) query $(PKG_NAME)`/server 158 | cp $(LIBDIR)/$(PKG_NAME).server.cm* `$(OCAMLFIND) query $(PKG_NAME)`/server 159 | cp $(LIBDIR)/$(PKG_NAME).server.a `$(OCAMLFIND) query $(PKG_NAME)`/server 160 | 161 | uninstall: 162 | rm -rf `$(OCAMLFIND) query $(PKG_NAME)`/client 163 | rm -rf `$(OCAMLFIND) query $(PKG_NAME)`/server 164 | $(OCAMLFIND) remove $(PKG_NAME) 165 | 166 | reinstall: uninstall install 167 | 168 | ##---------------------------------------------------------------------- 169 | ## Dependencies 170 | 171 | ifneq ($(MAKECMDGOALS),distclean) 172 | ifneq ($(MAKECMDGOALS),clean) 173 | ifneq ($(MAKECMDGOALS),depend) 174 | include .depend 175 | endif 176 | endif 177 | endif 178 | 179 | DEPSDIR := _deps 180 | 181 | .depend: $(patsubst %,$(DEPSDIR)/%.server,$(SERVER_FILES)) $(patsubst %,$(DEPSDIR)/%.client,$(CLIENT_FILES)) 182 | cat $^ > $@ 183 | 184 | $(DEPSDIR)/%.server: % | $(DEPSDIR) 185 | $(ELIOMDEP) -server -ppx $(SERVER_INC) $(SERVER_DEP_DIRS) $< > $@ 186 | 187 | $(DEPSDIR)/%.client: % | $(DEPSDIR) 188 | $(ELIOMDEP) -client -ppx $(CLIENT_INC) $(CLIENT_DEP_DIRS) $< > $@ 189 | 190 | $(DEPSDIR): 191 | mkdir -p $@ 192 | mkdir -p $(addprefix $@/, ${CLIENT_DIRS}) 193 | mkdir -p $(addprefix $@/, ${SERVER_DIRS}) 194 | 195 | ##---------------------------------------------------------------------- 196 | ## Documentation 197 | 198 | COMMON_OPTIONS := -colorize-code -stars -sort 199 | 200 | eliomdoc_wiki = ODOC_WIKI_SUBPROJECT="$(1)" eliomdoc -$(1) -ppx -intro doc/indexdoc.$(1) $(COMMON_OPTIONS) -i $(shell ocamlfind query wikidoc) -g odoc_wiki.cma -d doc/$(1)/wiki $(2) 201 | eliomdoc_html = ODOC_WIKI_SUBPROJECT="$(1)" eliomdoc -$(1) -ppx -intro doc/indexdoc.$(1) $(COMMON_OPTIONS) -html -d doc/$(1)/html $(2) 202 | 203 | doc: doc-clean 204 | mkdir -p doc/client/html 205 | mkdir -p doc/client/wiki 206 | mkdir -p doc/server/html 207 | mkdir -p doc/server/wiki 208 | $(call eliomdoc_html,client, $(CLIENT_INC) $(CLIENT_INC_DIRS) $(CLIENT_FILES_DOC)) 209 | $(call eliomdoc_wiki,client, $(CLIENT_INC) $(CLIENT_INC_DIRS) $(CLIENT_FILES_DOC)) 210 | $(call eliomdoc_html,server, $(SERVER_INC) $(SERVER_INC_DIRS) $(SERVER_FILES_DOC)) 211 | $(call eliomdoc_wiki,server, $(SERVER_INC) $(SERVER_INC_DIRS) $(SERVER_FILES_DOC)) 212 | 213 | doc-clean: 214 | rm -rf doc/client 215 | rm -rf doc/server 216 | 217 | ##---------------------------------------------------------------------- 218 | ## Clean up 219 | 220 | clean: 221 | -rm -f .depend 222 | -rm -f *.cm[ioax] *.cmxa *.cmxs *.o *.a *.annot 223 | -rm -f *.type_mli 224 | -rm -f META 225 | -rm -rf ${ELIOM_CLIENT_DIR} ${ELIOM_SERVER_DIR} ${LIBDIR} ${DEPSDIR} 226 | 227 | distclean: clean 228 | -rm -rf $(DEPSDIR) .depend 229 | -------------------------------------------------------------------------------- /Makefile.options: -------------------------------------------------------------------------------- 1 | #---------------------------------------------------------------------- 2 | # SETTINGS FOR YOUR PACKAGE 3 | #---------------------------------------------------------------------- 4 | 5 | # Package name for your 6 | PKG_NAME := ocsigen-toolkit 7 | PKG_VERS := 1.1 8 | PKG_DESC := reusable UI components meant for Eliom applications 9 | 10 | # Source files for the server 11 | SERVER_FILES := $(wildcard \ 12 | src/*.ml* \ 13 | src/*.eliom* \ 14 | src/widgets/*.eliom* \ 15 | ) 16 | 17 | # Source files for the client 18 | CLIENT_FILES := $(wildcard \ 19 | src/*.eliom* \ 20 | src/widgets/*.eliom* \ 21 | ) 22 | 23 | # Source files for the server 24 | SERVER_FILES_DOC := $(wildcard \ 25 | src/*.eliomi \ 26 | src/*.mli \ 27 | src/widgets/*.eliomi \ 28 | ) 29 | 30 | # Source files for the client 31 | CLIENT_FILES_DOC := $(wildcard \ 32 | src/*.eliomi \ 33 | src/widgets/*.eliomi \ 34 | ) 35 | 36 | # Template directory (used when installing template with distillery) 37 | TEMPLATE_DIR := template.distillery 38 | 39 | # Template name (name used by distillery) 40 | TEMPLATE_NAME := none.pgocaml 41 | 42 | # OCamlfind packages for the server 43 | SERVER_PACKAGES := calendar 44 | SERVER_PPX_PACKAGES := js_of_ocaml-ppx_deriving_json 45 | # OCamlfind packages for the client 46 | CLIENT_PACKAGES := calendar js_of_ocaml js_of_ocaml-lwt 47 | CLIENT_PPX_PACKAGES := js_of_ocaml-ppx js_of_ocaml-ppx_deriving_json 48 | 49 | # Debug package (yes/no): Debugging info in compilation 50 | DEBUG := yes 51 | 52 | # Native mode (yes/no): Compile also with native mode (it will always 53 | # compile with byte mode) 54 | NATIVE := yes 55 | 56 | # Package's library $(PKG_NAME).{client,server}.cma (a,cmxa,cmxs only 57 | # server side) 58 | LIBDIR := lib/ 59 | 60 | WARNING_FLAGS=-w +A@3-4@5..16@20..43-44@45..68-69-70 61 | 62 | MODULE_PREFIX = ot 63 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ocsigen Toolkit [![Build](https://github.com/ocsigen/ocsigen-toolkit/actions/workflows/build.yml/badge.svg)](https://github.com/ocsigen/ocsigen-toolkit/actions/workflows/build.yml) 2 | 3 | ## Introduction 4 | 5 | The Ocsigen Toolkit is a set of user interface widgets that facilitate 6 | the development of Eliom applications. The toolkit is in beta state. 7 | 8 | ## Installation 9 | 10 | Use `opam` to install: 11 | 12 | ``` 13 | opam install ocsigen-toolkit 14 | ``` 15 | 16 | **NB:** you may want to include the provided CSS in you own project. 17 | Take a look at the `css` directory for the style files that correspond 18 | to the modules you use. 19 | -------------------------------------------------------------------------------- /css/ot_buttons.css: -------------------------------------------------------------------------------- 1 | .ot-dropdown:hover { 2 | background-color: gray; 3 | } 4 | 5 | .ot-dropdown { 6 | position: relative; 7 | transition: background-color .3s; 8 | } 9 | 10 | .ot-dropdown-background { 11 | position: fixed; 12 | background-color: black; 13 | opacity: 0; 14 | left: 0; right: 0; top: 0; bottom: 0; 15 | visibility: hidden; 16 | transition: opacity .1s, visibility .1s; 17 | z-index: 1 18 | } 19 | 20 | .ot-dropdown-button { 21 | position: relative; 22 | width: 100%; 23 | height: 100%; 24 | z-index: 5; 25 | } 26 | 27 | .ot-dropdown-menu { 28 | position: absolute ; 29 | top: 100% ; 30 | right: 0 ; 31 | min-width: max-content ; 32 | overflow: hidden ; 33 | z-index: 10 ; 34 | box-shadow: 0px 0px 5px 0px rgba(0,0,0,0.15) ; 35 | visibility: hidden; 36 | opacity: 0; 37 | transition: opacity .2s, visibility .2s; 38 | } 39 | 40 | .ot-dropdown:hover > .ot-dropdown-background { 41 | visibility: visible; 42 | opacity: 0.2; 43 | } 44 | 45 | .ot-dropdown > .ot-dropdown-background:hover { 46 | visibility: hidden; 47 | opacity: 0; 48 | } 49 | 50 | .ot-dropdown:hover > .ot-dropdown-menu { 51 | visibility: visible; 52 | opacity: 1; 53 | } 54 | 55 | // not strictly necessary, but without this the menu will disappear a little 56 | // after once the background is completely gone (even without a transition) 57 | .ot-dropdown-background:hover ~ .ot-dropdown-menu { 58 | visibility: hidden; 59 | opacity: 0; 60 | } 61 | -------------------------------------------------------------------------------- /css/ot_carousel.css: -------------------------------------------------------------------------------- 1 | /* Ocsigen widget: carousel */ 2 | 3 | .ot-carousel { 4 | 5 | overflow: hidden ; 6 | width: 200px; /* default size. Override this in your own stylesheet */ 7 | height: 150px; /* default size. Override this in your own stylesheet */ 8 | 9 | } 10 | 11 | .ot-carousel > .ot-car2 { 12 | display: flex ; 13 | flex-wrap: nowrap ; 14 | 15 | // transform: translate3d(0,0,0); 16 | transition-property: transform, -webkit-transform; 17 | transition-timing-function: cubic-bezier(.03,.84,.56,1); 18 | 19 | height: 100%; 20 | width: 100%; 21 | } 22 | .ot-carousel > .ot-car2.ot-swiping { will-change: transform; } 23 | 24 | .ot-carousel > .ot-car2 .ot-carpage { 25 | width: 100% ; 26 | height: 100% ; 27 | margin-left: 0 ; 28 | margin-right: 0 ; 29 | flex-shrink: 0 ; 30 | flex-grow: 0 ; 31 | } 32 | 33 | .ot-carousel.ot-horizontal { 34 | touch-action: pan-y; 35 | } 36 | 37 | .ot-carousel.ot-horizontal > .ot-car2 { 38 | flex-direction: row ; 39 | } 40 | 41 | .ot-carousel.ot-vertical { 42 | touch-action: pan-x; 43 | } 44 | 45 | .ot-carousel.ot-vertical > .ot-car2 { 46 | flex-direction: column ; 47 | } 48 | 49 | .ot-bullet-nav { 50 | list-style-type: none ; 51 | display: flex ; 52 | flex-direction: row ; 53 | justify-content: center ; 54 | } 55 | 56 | .ot-bullet-nav-item { 57 | 58 | flex: 1 1 0 ; 59 | cursor: pointer; 60 | border: 1px solid rgba(255, 255, 255, 0.8);; 61 | border-radius: 50%; 62 | width: 8px; 63 | height: 8px; 64 | margin: 4px; 65 | 66 | } 67 | 68 | .ot-bullet-nav-item.ot-active { background-color: rgba(255, 255, 255, 0.8); } 69 | 70 | .ot-car-ribbon { 71 | position: relative; 72 | user-select: none; 73 | cursor: pointer; 74 | touch-action: pan-x; 75 | } 76 | 77 | .ot-car-ribbon::after { 78 | z-index: 1; 79 | content: ''; 80 | position: absolute; 81 | width: 100%; 82 | bottom: -6px; 83 | height: 6px; 84 | background-image: 85 | linear-gradient(to bottom, rgba(100,100,100, .3), rgba(100,100,100,0)); 86 | } 87 | 88 | .ot-car-ribbon-list { 89 | position: relative; 90 | width: 100% ; 91 | display: flex ; 92 | left: 0; 93 | width: 100% ; 94 | 95 | white-space: nowrap; 96 | padding: 20px 0; 97 | margin: 0; 98 | } 99 | 100 | 101 | .ot-car-ribbon-list:not(.ot-notransition) { 102 | transition-property: left; 103 | transition-timing-function: cubic-bezier(.03,.84,.56,1); 104 | } 105 | 106 | .ot-car-ribbon-list-item { 107 | 108 | display: inline-block; 109 | cursor: pointer; 110 | padding: 0 1rem; 111 | flex-grow: 1; 112 | flex-shrink: 0; 113 | text-align: center; 114 | 115 | } 116 | 117 | 118 | .ot-car-prev, .ot-car-next { 119 | background-color: transparent; 120 | } 121 | .ot-car-next.ot-blurred::before, 122 | .ot-car-prev.ot-blurred::before { 123 | visibility: hidden; 124 | } 125 | .ot-car-prev::before { 126 | content: '❬'; 127 | } 128 | .ot-car-next::before { 129 | content: '❭'; 130 | } 131 | 132 | .ot-car-cursor { 133 | box-sizing: border-box; 134 | position: absolute; 135 | height: 3px; 136 | bottom: 0; 137 | background-color: #66aaff; 138 | transition-property: transform, width; 139 | will-change: transform, width; 140 | } 141 | 142 | .ot-carousel.ot-full-height > .ot-car2:not(.ot-swiping) 143 | > .ot-carpage:not(.ot-active) { 144 | max-height: 100vh; /* We limit the size of non visible columns to avoid 145 | scrolling too much in small columns 146 | But NOT during swipe, as swiping might change the 147 | scroll position in page. */ 148 | } 149 | 150 | .ot-carousel.ot-wheel { 151 | height: 25px; 152 | width: 200px; 153 | overflow: visible; 154 | margin: 100px auto; 155 | perspective: 500px; 156 | } 157 | .ot-carousel.ot-wheel > .ot-car2 { 158 | position: absolute; 159 | transform-style: preserve-3d; 160 | } 161 | .ot-carousel.ot-wheel > .ot-car2 > .ot-carpage { 162 | backface-visibility: hidden; 163 | position: absolute; 164 | height: 25px; 165 | line-height: 25px; 166 | vertical-align: middle; 167 | transition: opacity 2s; 168 | opacity: 1; 169 | } 170 | .ot-carousel.ot-wheel .ot-carpage.ot-hidden-wheel-face { 171 | opacity: 0; 172 | } 173 | -------------------------------------------------------------------------------- /css/ot_color_picker.css: -------------------------------------------------------------------------------- 1 | .ot-color-picker-selected-cell { 2 | z-index: 2; 3 | border: 2px solid black; 4 | margin: -2px -2px -2px -2px; 5 | box-shadow: 0 0 15px white; 6 | } 7 | 8 | .ot-color-picker-hue-picker { 9 | display: flex; 10 | width: 100%; 11 | flex-direction: row; 12 | margin-bottom: 10px; 13 | flex: 1; 14 | } 15 | 16 | .ot-color-picker-hue-picker-cell { 17 | flex: 1; 18 | height: 100%; 19 | } 20 | 21 | .ot-color-picker-sl-picker { 22 | display: flex; 23 | flex-direction: column; 24 | flex: 9; 25 | margin: 1px; 26 | } 27 | 28 | .ot-color-picker-sl-picker-row { 29 | display: flex; 30 | flex-direction: row; 31 | flex: 1; 32 | } 33 | 34 | .ot-color-picker-sl-picker-cell { 35 | flex: 1; 36 | height: 100%; 37 | } 38 | 39 | .ot-color-picker { 40 | display: flex; 41 | flex-direction: column; 42 | height: 200px; 43 | } 44 | -------------------------------------------------------------------------------- /css/ot_datetime.css: -------------------------------------------------------------------------------- 1 | div.ot-toggle { 2 | display: inline; 3 | padding: 5px 1px 5px 1px; 4 | border-radius: 5px 5 | } 6 | 7 | div.ot-inactive { 8 | color: white; 9 | display: inline; 10 | padding: 3px; 11 | border: solid 1px transparent; 12 | cursor: pointer; 13 | } 14 | 15 | div.ot-active.ot-up { 16 | color: green; 17 | display: inline; 18 | padding: 3px; 19 | border: solid 1px green; 20 | border-radius: 5px; 21 | } 22 | 23 | div.ot-active.ot-down { 24 | color: red; 25 | display: inline; 26 | padding: 3px; 27 | border: solid 1px red; 28 | border-radius: 5px; 29 | } 30 | 31 | svg.ot-tp-clock { 32 | width: 120px; 33 | background-color: #eee; 34 | border-radius: 50%; 35 | display: inline-block; 36 | } 37 | 38 | svg.ot-tp-clock.ot-tp-clock-24h { 39 | width: 160px; 40 | border-radius: 80px; 41 | } 42 | 43 | svg.ot-tp-clock text { 44 | font-size: 11px; 45 | } 46 | 47 | svg.ot-tp-clock.ot-tp-clock-24h text { 48 | font-size: 9px; 49 | } 50 | 51 | svg.ot-tp-clock path { 52 | stroke: #333333; 53 | stroke-width: 2px; 54 | } 55 | 56 | svg.ot-tp-clock path.ot-tp-hand { 57 | stroke: #990000; 58 | stroke-width: 1px; 59 | } 60 | 61 | svg.ot-tp-clock circle.ot-tp-hand-circle { 62 | stroke: #ff5d55; 63 | stroke-width: 1px; 64 | fill: #ff5d55; 65 | fill-opacity: 1; 66 | } 67 | 68 | svg.ot-tp-clock.ot-tp-click-anywhere { 69 | cursor: pointer; 70 | } 71 | 72 | div.ot-tp-container { 73 | padding: 16px; 74 | display: block; 75 | text-align: center; 76 | -webkit-touch-callout: none; 77 | -webkit-user-select: none; 78 | -khtml-user-select: none; 79 | -moz-user-select: none; 80 | -ms-user-select: none; 81 | user-select: none; 82 | -webkit-tap-highlight-color: transparent; 83 | } 84 | 85 | .ot-tp-text { 86 | cursor: pointer; 87 | } 88 | 89 | div.ot-tp-container div.ot-toggle { 90 | display: inline; 91 | padding: 5px 1px 5px 1px; 92 | margin: 4px 0px 0px 0px; 93 | border: solid 1px #333333; 94 | border-radius: 5px 95 | } 96 | 97 | div.ot-tp-container div.ot-inactive { 98 | color: black; 99 | display: inline; 100 | padding: 3px; 101 | border: solid 1px transparent; 102 | cursor: pointer; 103 | } 104 | 105 | div.ot-tp-container div.ot-active { 106 | color: black; 107 | background-color: #fafafa; 108 | display: inline; 109 | padding: 3px; 110 | border: solid 1px #333333; 111 | border-radius: 5px; 112 | } 113 | 114 | div.ot-tp-container div.ot-toggle { 115 | display: inline-block; 116 | padding: 5px 1px 5px 1px; 117 | background-color: white; 118 | border: 1px solid #333333; 119 | } 120 | 121 | div.ot-tp-container div.ot-tp-display { 122 | display: block; 123 | margin-left: 4px; 124 | padding: 6px; 125 | font-size: 22px; 126 | } 127 | .ot-c-next-year-button{ 128 | position: absolute; 129 | right: 0px; 130 | top: 10px; 131 | } 132 | .ot-c-next-button { 133 | position: absolute; 134 | right: 50px; 135 | top: 10px; 136 | } 137 | .ot-c-prev-year-button{ 138 | position: absolute; 139 | left: 0px; 140 | top: 10px; 141 | } 142 | .ot-c-prev-button { 143 | position: absolute; 144 | left: 50px; 145 | top: 10px; 146 | } 147 | .ot-c-select-month { 148 | border: 0px; 149 | outline: 0px; 150 | width: 60px; 151 | text-align-last:center; 152 | background: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' width='16' height='16' viewBox='-5 0 24 24' fill='none' stroke='%23000' stroke-width='2' stroke-linecap='round' stroke-linejoin='round'%3E%3Cpolyline points='6 9 12 15 18 9'/%3E%3C/svg%3E"); 153 | background-position: right 0px center; 154 | background-repeat: no-repeat; 155 | -webkit-appearance: none; 156 | -moz-appearance: none; 157 | font-weight: bold; 158 | position: absolute; 159 | z-index:1; 160 | right: 200px; 161 | top: 14px; 162 | } 163 | .ot-c-select-year { 164 | border: 0px; 165 | outline: 0px; 166 | width: 60px; 167 | text-align-last:center; 168 | background: url("data:image/svg+xml,%3Csvg xmlns='http://www.w3.org/2000/svg' width='16' height='16' viewBox='-5 0 24 24' fill='none' stroke='%23000' stroke-width='2' stroke-linecap='round' stroke-linejoin='round'%3E%3Cpolyline points='6 9 12 15 18 9'/%3E%3C/svg%3E"); 169 | background-position: right 0px center; 170 | background-repeat: no-repeat; 171 | -webkit-appearance: none; 172 | -moz-appearance: none; 173 | font-weight: bold; 174 | position: absolute; 175 | z-index:1; 176 | right: 140px; 177 | top: 14px; 178 | } 179 | .ot-c-select-month option, .ot-c-select-year option{ 180 | background: white; 181 | } 182 | .ot-c-out-period { 183 | background-color: #fcfcfc; 184 | color: rgb(200, 200, 200); 185 | pointer-events: none; 186 | } 187 | .ot-c-table { 188 | font-size: 14px; 189 | line-height: 22px; 190 | table-layout: fixed; 191 | } 192 | .ot-c-table th:not(.ot-c-header) { 193 | vertical-align: middle; 194 | font-weight: bold; 195 | text-align: center; 196 | text-transform: uppercase; 197 | padding: 0 22px; 198 | height: 36px; 199 | } 200 | .ot-c-table th.ot-c-header { 201 | height: 43px; 202 | font-size: 19px; 203 | position: relative; 204 | text-transform: capitalize; 205 | } 206 | .ot-c-table td { 207 | vertical-align: middle; 208 | text-align: center; 209 | padding: 0; 210 | height: 36px; 211 | cursor: pointer; 212 | } 213 | .ot-c-table td:not(:empty):hover { 214 | background-color: #eee; 215 | border-radius: 5px; 216 | } 217 | .ot-c-clicked { 218 | background-color: #990000; 219 | border-radius: 50%; 220 | } 221 | .ot-c-prev-year-button, 222 | .ot-c-next-year-button, 223 | .ot-c-prev-button, 224 | .ot-c-next-button { 225 | padding: 0 28px; 226 | cursor: pointer; 227 | } 228 | th.ot-c-header { 229 | text-align:center; 230 | } 231 | 232 | @keyframes shake-animation { 233 | 0% {transform: translateX(0)} 234 | 25% {transform: translateX(-5px)} 235 | 75% {transform: translateX(5px)} 236 | 100% {transform: translateX(0)} 237 | } 238 | 239 | .ot-tp-clock-min { 240 | animation-name: shake-animation; 241 | animation-duration: .1s; 242 | } 243 | .ot-c-current>div { 244 | color: white; 245 | background-color: #ff5d55; 246 | width: 27px; 247 | line-height: 27px; 248 | border-radius: 50%; 249 | display: inline-block; 250 | } -------------------------------------------------------------------------------- /css/ot_drawer.css: -------------------------------------------------------------------------------- 1 | /* Generic drawer stylesheet. */ 2 | 3 | html.ot-drawer-open, html.ot-drawer-open > body { 4 | overflow: hidden; 5 | position: fixed ; /* To prevent scroll on mobile devices. 6 | One must also set top property manually 7 | to prevent scrolling page to top. */ 8 | } 9 | 10 | /* .ot-dr-container.open .ot-dr-toggle-button { */ 11 | /* display: none; */ 12 | /* } */ 13 | 14 | /* @include media-screen-m-l { */ 15 | /* .ot-dr-toggle-button { */ 16 | /* top: 1rem; */ 17 | /* } */ 18 | /* } */ 19 | 20 | /* .ot-dr-toggle-button::before { */ 21 | /* font-family: 'FontAwesome'; */ 22 | /* content: '\f0c9'; */ 23 | /* padding: 1rem; */ 24 | /* } */ 25 | 26 | /* .ot-dr-toggle-button.login::before { */ 27 | /* font-family: 'Ubuntu'; */ 28 | /* content: 'login'; */ 29 | /* } */ 30 | 31 | 32 | .ot-drawer-bckgrnd { 33 | background-color: rgba(0,0,0,0); 34 | transition: background-color .2s; 35 | } 36 | 37 | .ot-drawer-bckgrnd.ot-dr-closing, 38 | .ot-drawer-bckgrnd.ot-dr-opening, 39 | .ot-drawer-bckgrnd.ot-dr-open { 40 | position: fixed; 41 | width: 100vw; 42 | height: 100vh; 43 | top: 0; 44 | left: 0; 45 | z-index: 1; 46 | } 47 | 48 | .ot-drawer-bckgrnd.ot-dr-open { 49 | background-color: rgba(0,0,0,0.5); 50 | } 51 | 52 | .ot-drawer { 53 | 54 | position: fixed; 55 | width: 100%; 56 | height: 100%; 57 | z-index: 1; 58 | 59 | /* [ overflow: visible ; ] is needed for the button 60 | * to be displayed 61 | * if the drawer needs to be scrollable, you probably will want 62 | * to wrap the content into a wrapper 63 | * with overflow-y: auto ; touch-action: pan-y; */ 64 | overflow: visible ; 65 | 66 | transition: -webkit-transform .2s ease-out; 67 | transition: transform .2s ease-out; 68 | 69 | /* We set up drawer so that the default transform is the identity 70 | * Otherwise, with Firefox, a transition is performed on page 71 | * change. */ 72 | 73 | background-color: white; 74 | } 75 | 76 | @media (min-width: 720px) { 77 | .ot-drawer.ot-dr-left, .ot-drawer.ot-dr-right { 78 | width: 300px; 79 | } 80 | 81 | .ot-drawer.ot-dr-top, .ot-drawer.ot-dr-bottom { 82 | height: 300px; 83 | } 84 | } 85 | 86 | @media (max-width: 720px) { 87 | .ot-drawer.ot-dr-left, .ot-drawer.ot-dr-right { 88 | width: calc(100% - 50px); 89 | } 90 | 91 | .ot-drawer.ot-dr-top, .ot-drawer.ot-dr-bottom { 92 | height: calc(100% - 50px); 93 | } 94 | } 95 | 96 | .ot-drawer.ot-dr-top { bottom: 100% ; } 97 | .ot-drawer.ot-dr-right { left: 100% ; top: 0 } 98 | .ot-drawer.ot-dr-bottom { top: 100% ; } 99 | .ot-drawer.ot-dr-left { right: 100% ; top: 0 } 100 | 101 | .ot-dr-toggle-button::before { content: "≡"; } 102 | 103 | .ot-drawer-bckgrnd.ot-dr-open .ot-dr-top .ot-dr-toggle-button::before { 104 | content: "︿" ; 105 | } 106 | 107 | .ot-drawer-bckgrnd.ot-dr-open .ot-dr-right .ot-dr-toggle-button::before { 108 | content: "⟩" ; 109 | } 110 | 111 | .ot-drawer-bckgrnd.ot-dr-open .ot-dr-bottom .ot-dr-toggle-button::before { 112 | content: "﹀" ; 113 | } 114 | 115 | .ot-drawer-bckgrnd.ot-dr-open .ot-dr-left .ot-dr-toggle-button::before { 116 | content: "⟨" ; 117 | } 118 | 119 | .ot-drawer-bckgrnd.ot-dr-open .ot-dr-toggle-button { 120 | background-color: #445; 121 | } 122 | 123 | .ot-drawer > .ot-dr-toggle-button { 124 | position: absolute ; 125 | cursor: pointer ; 126 | height: 50px; 127 | width: 50px; 128 | padding: 0; 129 | background-color: transparent; 130 | border: none; 131 | font-size: 30px; 132 | outline: none; 133 | } 134 | 135 | .ot-drawer.ot-dr-top > .ot-dr-toggle-button { 136 | top: 100% ; 137 | right: calc(50% - 25px) ; 138 | } 139 | 140 | .ot-drawer.ot-dr-right > .ot-dr-toggle-button, 141 | .ot-drawer.ot-dr-left > .ot-dr-toggle-button { 142 | top: 0 ; 143 | } 144 | 145 | .ot-drawer.ot-dr-bottom > .ot-dr-toggle-button { 146 | bottom: 100% ; 147 | left: calc(50% - 25px) ; 148 | } 149 | 150 | .ot-drawer.ot-dr-left > .ot-dr-toggle-button { left: 100% ; } 151 | .ot-drawer.ot-dr-right > .ot-dr-toggle-button { right: 100% ; } 152 | 153 | 154 | .ot-drawer-bckgrnd.ot-dr-open .ot-drawer.ot-dr-left { 155 | -webkit-transform: translateX(100%); 156 | transform: translateX(100%); 157 | } 158 | 159 | .ot-drawer-bckgrnd.ot-dr-open .ot-drawer.ot-dr-right { 160 | -webkit-transform: translateX(-100%); 161 | transform: translateX(-100%); 162 | } 163 | 164 | .ot-drawer-bckgrnd.ot-dr-open .ot-drawer.ot-dr-top { 165 | -webkit-transform: translateY(100%); 166 | transform: translateY(100%); 167 | } 168 | 169 | .ot-drawer-bckgrnd.ot-dr-open .ot-drawer.ot-dr-bottom { 170 | -webkit-transform: translateY(-100%); 171 | transform: translateY(-100%); 172 | } 173 | -------------------------------------------------------------------------------- /css/ot_icons.css: -------------------------------------------------------------------------------- 1 | @keyframes ot-icon-animation-spinning { 2 | 0% { transform: rotate(0deg) ; } 3 | 100% { transform: rotate(360deg) ; } 4 | } 5 | 6 | @keyframes ot-icon-animation-shake { 7 | 10%, 90% { transform: translate3d(-.05em, 0, 0); } 8 | 20%, 80% { transform: translate3d(.1em, 0, 0); } 9 | 30%, 50%, 70% { transform: translate3d(-.2em, 0, 0); } 10 | 40%, 60% { transform: translate3d(.2em, 0, 0); } 11 | } 12 | 13 | .ot-icon-animation-shaking { 14 | animation: ot-icon-animation-shake 1s cubic-bezier(.36,.07,.19,.97) both ; 15 | } 16 | 17 | .ot-icon-animation-once { animation-iteration-count: 1 ; } 18 | 19 | .ot-icon { 20 | display: inline-block ; 21 | width: 1em ; 22 | height: 1em ; 23 | overflow: hidden ; 24 | position: relative ; 25 | } 26 | 27 | .ot-icon, 28 | .ot-icon::before, 29 | .ot-icon::after { 30 | box-sizing: border-box ; 31 | display: inline-block ; 32 | } 33 | 34 | .ot-icon::before, 35 | .ot-icon::after { 36 | content: '' ; 37 | } 38 | 39 | .ot-icon-user { 40 | text-align: center ; 41 | } 42 | .ot-icon-user::before, .ot-icon-user::after { 43 | display: block ; 44 | margin: auto ; 45 | } 46 | .ot-icon-user::before { 47 | width: .5em ; 48 | height: .5em ; 49 | margin-bottom: .05em ; 50 | border-radius: 50% ; 51 | background-color: black ; 52 | } 53 | .ot-icon-user::after { 54 | box-sizing: border-box; 55 | width: 1em; 56 | height: 1em; 57 | border-radius: 50% 50% 0% 0%; 58 | background-color: black ; 59 | } 60 | 61 | .ot-icon-error::before, 62 | .ot-icon-question::before { 63 | content: '?' ; 64 | display: block ; 65 | font-weight: bold ; 66 | width: 1em ; 67 | height: 1em ; 68 | line-height: 1em ; 69 | border-radius: 50% ; 70 | background-color: rgb(0, 0, 0) ; 71 | color: rgb(255, 255, 255) ; 72 | text-align: center ; 73 | } 74 | 75 | .ot-icon-plus::before { 76 | position: absolute ; 77 | left: .15em ; 78 | right: .15em ; 79 | top: .4em ; 80 | bottom: .4em ; 81 | background-color: #000 ; 82 | } 83 | .ot-icon-plus::after { 84 | position: absolute ; 85 | top: .15em ; 86 | bottom: .15em ; 87 | left: .4em ; 88 | right: .4em ; 89 | background-color: #000 ; 90 | } 91 | 92 | .ot-icon-power { 93 | text-align: center ; 94 | } 95 | .ot-icon-power::before { 96 | display: block ; 97 | position: absolute ; 98 | bottom: 0 ; 99 | top: .1em ; 100 | left: .05em ; 101 | right: .05em ; 102 | border: .1em solid #000 ; 103 | border-top: .1em solid transparent ; 104 | border-radius: 50% ; 105 | } 106 | .ot-icon-power::after { 107 | position: absolute ; 108 | top: 0 ; 109 | bottom: .5em ; 110 | left: .45em ; 111 | right: .45em ; 112 | background-color: #000 ; 113 | } 114 | 115 | .ot-icon-sign-in::after, 116 | .ot-icon-sign-out::after { 117 | position: absolute; 118 | width: .5em; 119 | height: .5em; 120 | top: .25em; 121 | border: .1em solid #000; 122 | border-bottom: none; 123 | border-left: none; 124 | transform: rotate(45deg); 125 | border-radius: 0 .1rem 0 0; 126 | } 127 | .ot-icon-sign-in::after { left: -.075em ; } 128 | .ot-icon-sign-out::after { right: .15em ; } 129 | 130 | .ot-icon-sign-in::before, 131 | .ot-icon-sign-out::before { 132 | width: .75em; 133 | margin-left: .125em ; 134 | height: 1em; 135 | border: .1em solid #000; 136 | } 137 | 138 | .ot-icon-sign-in::before { border-left: none ; } 139 | .ot-icon-sign-out::before { border-right: none ; } 140 | 141 | .ot-icon-gear::before { 142 | width: 1em ; 143 | height: 1em ; 144 | border-radius: 50% ; 145 | border: .2em dotted #000 ; 146 | } 147 | 148 | .ot-icon-gear::after { 149 | position:absolute ; 150 | width: .8em ; 151 | height: .8em ; 152 | left: .2rem ; 153 | top: .2rem ; 154 | border: .5rem solid #000 ; 155 | border-radius: 50% ; 156 | } 157 | 158 | .ot-icon-close::before { 159 | position: absolute ; 160 | left: .4em ; 161 | width: .2em ; 162 | height: 1em ; 163 | background: #000 ; 164 | transform: rotate(-45deg); 165 | } 166 | .ot-icon-close::after { 167 | position: absolute ; 168 | width: .2em ; 169 | height: 1em ; 170 | left: .4em ; 171 | background: #000 ; 172 | transform: rotate(45deg) ; 173 | } 174 | -------------------------------------------------------------------------------- /css/ot_page_transition.css: -------------------------------------------------------------------------------- 1 | .ot-page-transition-wrapper { 2 | position: fixed; 3 | overflow: hidden; 4 | z-index: 1000; 5 | top: 0; 6 | height: 100vh; 7 | width: 100vw; 8 | background-color: white; 9 | } 10 | 11 | .ot-page-transition-wrapper-backward { 12 | left: 0; 13 | } 14 | 15 | .ot-page-transition-wrapper-forward { 16 | right: 100vw; 17 | } 18 | 19 | .ot-page-transition-ss-container { 20 | width: 100vw; 21 | height: 100vh; 22 | background-size: contain; 23 | background-repeat: no-repeat; 24 | background-color: lightgrey; 25 | } 26 | 27 | .ot-page-transition-wrapper-post-backward { 28 | transform: translateX(100vw); 29 | } 30 | 31 | .ot-page-transition-body-pre-forward { 32 | transform: translateX(100vw); 33 | height: 100vh; 34 | } 35 | 36 | .ot-page-transition-screenshot-post-forward { 37 | transform: translateX(100vw); 38 | } 39 | -------------------------------------------------------------------------------- /css/ot_picture_uploader.css: -------------------------------------------------------------------------------- 1 | .ot-pup-ctrls { 2 | position: absolute ; 3 | overflow: visible ; 4 | top: 0px ; 5 | left: 0px ; 6 | right: 0px ; 7 | bottom: 0px ; 8 | cursor: move ; 9 | will-change: bottom, left, right, top ; 10 | border: 1px solid black; 11 | } 12 | 13 | .ot-no-file .ot-pup-ctrls { 14 | border: none; 15 | } 16 | 17 | .ot-pup-ctrl { position: absolute ; } 18 | 19 | .ot-pup-ctrl-t { 20 | top: 0px ; 21 | left: 10px ; 22 | right: 10px ; 23 | height: 10px ; 24 | cursor: n-resize ; 25 | } 26 | .ot-pup-ctrl-tr { 27 | right: 0px ; 28 | top: 0px ; 29 | width: 10px ; 30 | height: 10px ; 31 | cursor: ne-resize ; 32 | } 33 | .ot-pup-ctrl-r { 34 | right: 0px ; 35 | top: 10px ; 36 | bottom: 10px ; 37 | width: 10px ; 38 | cursor: e-resize ; 39 | } 40 | .ot-pup-ctrl-br { 41 | right: 0px ; 42 | bottom: 0px ; 43 | width: 10px ; 44 | height: 10px ; 45 | cursor: se-resize ; 46 | } 47 | .ot-pup-ctrl-b { 48 | bottom: 0px ; 49 | left: 10px ; 50 | right: 10px ; 51 | height: 10px ; 52 | cursor: s-resize ; 53 | } 54 | .ot-pup-ctrl-bl { 55 | left: 0px ; 56 | bottom: 0px ; 57 | width: 10px ; 58 | height: 10px ; 59 | cursor: sw-resize ; 60 | } 61 | .ot-pup-ctrl-l { 62 | left: 0px ; 63 | top: 10px ; 64 | bottom: 10px ; 65 | width: 10px ; 66 | cursor: w-resize ; 67 | } 68 | .ot-pup-ctrl-tl { 69 | left: 0px ; 70 | top: 0px ; 71 | width: 10px ; 72 | height: 10px ; 73 | cursor: nw-resize ; 74 | } 75 | 76 | .ot-pup-fltr { 77 | background-color: rgba(255, 255, 255, .5) ; 78 | position: absolute ; 79 | will-change: top,bottom,right,left,width,height ; 80 | } 81 | .ot-pup-fltr-t { top: 0px ; cursor: n-resize ; } 82 | .ot-pup-fltr-tr { top: 0px ; right: 0px ; cursor: ne-resize ; } 83 | .ot-pup-fltr-tl { top: 0px ; left: 0px ; cursor: nw-resize ; } 84 | .ot-pup-fltr-b { bottom: 0px ; cursor: s-resize ; } 85 | .ot-pup-fltr-br { bottom: 0px ; right: 0px ; cursor: se-resize ; } 86 | .ot-pup-fltr-bl { bottom: 0px ; left: 0px ; cursor: sw-resize ; } 87 | .ot-pup-fltr-l { left: 0px ; cursor: w-resize ; } 88 | .ot-pup-fltr-r { right: 0px ; cursor: e-resize ; } 89 | 90 | .ot-pup-crop-container { 91 | position: absolute ; 92 | top:0px ; 93 | left:0px ; 94 | right:0px ; 95 | bottom:0px ; 96 | } 97 | 98 | .ot-pup-preview { 99 | width: 100% ; 100 | display: block ; 101 | } 102 | 103 | .ot-pup-container { 104 | position: relative ; 105 | width: 100% ; 106 | } 107 | -------------------------------------------------------------------------------- /css/ot_popup.css: -------------------------------------------------------------------------------- 1 | html.ot-with-popup, html.ot-with-popup > body { 2 | overflow: hidden; 3 | position: fixed ; /* To prevent scroll on mobile devices. 4 | One must also set top property manually 5 | to prevent scrolling page to top. */ 6 | } 7 | .ot-popup-background { 8 | position: fixed ; 9 | right: 0 ; 10 | left: 0 ; 11 | top: 0 ; 12 | bottom: 0 ; 13 | z-index: 1 ; 14 | background-color: rgba(0, 0, 0, 0.6) ; 15 | display: flex ; 16 | } 17 | .ot-popup { 18 | position: relative ; 19 | margin: auto ; 20 | z-index: 2 ; 21 | display: flex ; 22 | max-height: 100% ; 23 | min-height: 2em ; /* .ot-popup-close button */ 24 | overflow: auto ; 25 | background-color: #FFFFFF ; 26 | padding: .5em; 27 | border-radius: 2px; 28 | } 29 | .ot-popup-close { 30 | position: absolute ; 31 | top: 0 ; 32 | right: 0 ; 33 | background: transparent ; 34 | border: none ; 35 | cursor: pointer; 36 | z-index: 2 ; 37 | padding: 5px ; 38 | } 39 | 40 | .ot-popup-content { 41 | width: 100% ; 42 | flex: 1 1 auto ; 43 | overflow: auto ; 44 | display: flex ; 45 | } 46 | .ot-hcf { 47 | width: 100% ; 48 | display: flex ; 49 | flex-direction: column ; 50 | flex-wrap: nowrap ; 51 | align-items: stretch ; 52 | overflow: auto ; 53 | } 54 | .ot-hcf-header, 55 | .ot-hcf-footer { 56 | flex-shrink: 0 ; 57 | } 58 | .ot-hcf-header:empty, 59 | .ot-hcf-footer:empty { 60 | display: none ; 61 | } 62 | .ot-hcf-content { 63 | flex-grow: 1; 64 | overflow: auto; 65 | } 66 | -------------------------------------------------------------------------------- /css/ot_pull_to_refresh.css: -------------------------------------------------------------------------------- 1 | .ot-pull-refresh-wrapper{ 2 | overflow: hidden ; 3 | } 4 | 5 | .ot-pull-refresh-head-container { 6 | margin-top: -85px; 7 | height: 85px; 8 | padding: 15px; 9 | } 10 | 11 | .ot-pull-refresh-container .ot-pull-refresh-display-none { 12 | display: none ; 13 | } 14 | 15 | .ot-pull-refresh-transition-on { 16 | transition: 1000ms; 17 | } 18 | -------------------------------------------------------------------------------- /css/ot_spinner.css: -------------------------------------------------------------------------------- 1 | .ot-spn-error, 2 | .ot-spn-spinning { 3 | display: flex ; 4 | justify-content: center ; 5 | align-items: center ; 6 | } 7 | 8 | .ot-icon-animation-spinning { 9 | display: flex !important; 10 | align-items: center; 11 | justify-content: center; 12 | } 13 | 14 | .ot-icon-animation-spinning::before { 15 | content: ""; 16 | margin: 1rem; 17 | padding: 10px ; 18 | background-position: center ; 19 | background-repeat: no-repeat ; 20 | background-size:contain; 21 | background-image: url("data:image/svg+xml,%3Csvg xmlns:xlink='http://www.w3.org/1999/xlink' xmlns='http://www.w3.org/2000/svg' viewBox='-256 -256 512 512'%3E%3Cg fill='%23ccc'%3E%3Crect id='r' ry='19' height='143' width='52' transform='translate(-26,108)'/%3E%3Cuse xlink:href='%23r' transform='rotate(30)'/%3E%3Cuse xlink:href='%23r' transform='rotate(-30)'/%3E%3Cuse xlink:href='%23r' transform='rotate(60)'/%3E%3Cuse xlink:href='%23r' transform='rotate(-60)'/%3E%3Cuse xlink:href='%23r' transform='rotate(-90)'/%3E%3Cuse xlink:href='%23r' transform='rotate(-120)'/%3E%3Cuse xlink:href='%23r' transform='rotate(-150)'/%3E%3C/g%3E%3Cuse xlink:href='%23r' transform='rotate(90)' fill='%23c5c5c5'/%3E%3Cuse xlink:href='%23r' transform='rotate(120)' fill='%23999'/%3E%3Cuse xlink:href='%23r' transform='rotate(150)' fill='%23878787'/%3E%3Cuse xlink:href='%23r' transform='rotate(180)' fill='%23626262'/%3E%3C/svg%3E"); 22 | animation: ot-icon-animation-spinning 1s steps(12) infinite; 23 | } 24 | .ot-icon-animation-spinning::after { content: normal !important; } 25 | -------------------------------------------------------------------------------- /css/ot_sticky.css: -------------------------------------------------------------------------------- 1 | .ot-sticky-fixed { 2 | position: fixed; 3 | } 4 | .ot-sticky-fixed:not(.ot-stuck) { 5 | visibility: hidden; 6 | } 7 | 8 | .ot-sticky-inline.ot-stuck { 9 | visibility: hidden; 10 | } 11 | -------------------------------------------------------------------------------- /css/ot_tip.css: -------------------------------------------------------------------------------- 1 | /* Ocsigen widget: tip */ 2 | 3 | .ot-tip-bottom > .ot-tip-src { top: 100% ; } 4 | .ot-tip-top > .ot-tip-src { bottom: 100% ; } 5 | .ot-tip-left > .ot-tip-src { left: 0 ; } 6 | .ot-tip-right > .ot-tip-src { right: 0 ; } 7 | .ot-tip-center > .ot-tip-src { left: auto ; right: calc(50% - 14px) ; } 8 | .ot-tip-src { position: absolute ; } 9 | 10 | .ot-tip-filter { 11 | position: fixed ; 12 | top: 0 ; 13 | left: 0 ; 14 | bottom: 0 ; 15 | right: 0 ; 16 | } 17 | 18 | .ot-tip-menu { 19 | position: absolute ; 20 | min-width: max-content ; 21 | } 22 | -------------------------------------------------------------------------------- /css/ot_tongue.css: -------------------------------------------------------------------------------- 1 | .ot-tongue { 2 | position: fixed; 3 | will-change: transform; 4 | z-index: 1; 5 | background-color: white; 6 | box-shadow: 0 2px 9px 0 rgba(173, 173, 173, 0.5); 7 | overflow: hidden; 8 | } 9 | .ot-tongue::after { 10 | content: ""; 11 | position: absolute; 12 | background-color: #eee; 13 | border-radius: 2px; 14 | z-index: 1; 15 | } 16 | .ot-tongue-left { 17 | height: 100%; 18 | padding-right: 70px; 19 | border-radius: 0 5px 5px 0; 20 | top: 0; 21 | right: 100%; 22 | } 23 | .ot-tongue-left::after { 24 | right: 4px; 25 | width: 4px; 26 | top: calc(50% - 10px); 27 | height: 20px; 28 | } 29 | .ot-tongue-right { 30 | height: 100%; 31 | padding-left: 70px; 32 | border-radius: 5px 0 0 5px; 33 | top: 0; 34 | left: 100%; 35 | } 36 | .ot-tongue-right::after { 37 | left: 4px; 38 | width: 4px; 39 | top: calc(50% - 10px); 40 | height: 20px; 41 | } 42 | .ot-tongue-top { 43 | width: 100%; 44 | padding-bottom: 70px; 45 | border-radius: 0 0 5px 5px; 46 | bottom: 100%; 47 | left: 0; 48 | } 49 | .ot-tongue-top::after { 50 | bottom: 4px; 51 | height: 4px; 52 | left: calc(50% - 10px); 53 | width: 20px; 54 | } 55 | .ot-tongue-bottom { 56 | width: 100%; 57 | padding-top: 70px; 58 | border-radius: 5px 5px 0 0; 59 | top: 0; 60 | transform: translateY(100vh); 61 | left: 0; 62 | } 63 | .ot-tongue-bottom::after { 64 | top: 4px; 65 | height: 4px; 66 | left: calc(50% - 10px); 67 | width: 20px; 68 | } 69 | .ot-tongue:not(.notransition) { 70 | transition: transform 0.4s cubic-bezier(0.1, 1, 0.8, 1); 71 | } 72 | -------------------------------------------------------------------------------- /doc/indexdoc.client: -------------------------------------------------------------------------------- 1 | {1 Ocsigen-toolkit client API} 2 | 3 | {!modules: 4 | Ot_popup 5 | Ot_spinner 6 | Ot_drawer 7 | Ot_carousel 8 | Ot_swipe 9 | Ot_range 10 | Ot_lib 11 | Ot_size 12 | Ot_calendar 13 | Ot_time_picker 14 | Ot_toggle 15 | Ot_picture_uploader 16 | Ot_nodeready 17 | Ot_noderesize 18 | Ot_color_picker 19 | } 20 | 21 | {1 Index} 22 | 23 | {!indexlist} 24 | -------------------------------------------------------------------------------- /doc/indexdoc.server: -------------------------------------------------------------------------------- 1 | {1 Ocsigen-toolkit server API} 2 | 3 | {!modules: 4 | Ot_popup 5 | Ot_spinner 6 | Ot_drawer 7 | Ot_carousel 8 | Ot_swipe 9 | Ot_range 10 | Ot_lib 11 | Ot_size 12 | Ot_calendar 13 | Ot_time_picker 14 | Ot_toggle 15 | Ot_picture_uploader 16 | Ot_nodeready 17 | Ot_noderesize 18 | Ot_color_picker 19 | } 20 | 21 | {1 Index} 22 | 23 | {!indexlist} 24 | -------------------------------------------------------------------------------- /doc/manual-wiki/intro.wiki: -------------------------------------------------------------------------------- 1 | =Introduction= 2 | 3 | Ocsigen Toolkit provides various user interface widgets and related 4 | utilities that assist in the rapid development of interactive Web 5 | applications. 6 | 7 | Ocsigen Toolkit is built with [[wiki("eliom"):|Eliom]]. 8 | 9 | ==Installation and getting started 10 | 11 | You can install Ocsigen Toolkit via OPAM: 12 | 13 | {{{ 14 | opam install ocsigen-toolkit 15 | }}} 16 | 17 | You may want to use Ocsigen Toolkit in conjunction with 18 | [[wiki("ocsigen-start"):|Ocsigen Start]], which provides an application 19 | template for quickly getting started with Ocsigen. The template 20 | provides various runnable examples of Ocsigen Toolkit widgets. See the 21 | <> for details. 23 | 24 | ==Programming style 25 | 26 | Most of the Ocsigen Toolkit widgets can be produced invariably on the 27 | server or on the client (with the same code). This enables a 28 | mobile-friendly programming paradigm, where most code lies in shared 29 | sections. The server instance of the code can be used to produce pages 30 | (with Ocsigen Toolkit widgets) during traditional Web interaction, 31 | while the client instance can be used to render the same pages and 32 | widgets on a mobile device without contacting the server. See the 33 | <> of the Eliom manual for details. 35 | 36 | The widgets generally follow a reactive programming style. We use 37 | <> 38 | extensively, which allows us to produce this reactive content on both 39 | sides. 40 | See 41 | <> 42 | for more info. 43 | <> 44 | signals and events appear in the Ocsigen Toolkit APIs, and can be used 45 | as a mechanism for composing different widgets. 46 | 47 | ==CSS 48 | 49 | Most widgets need appropriate CSS to display properly. We provide 50 | default CSS files, normally installed in 51 | 52 | {{{~/.opam/${SWITCH}/share/ocsigen-toolkit/css/}}} 53 | 54 | Ocsigen Start uses these files by default. If your application does 55 | not use Ocsigen Start, you will need to include the CSS manually. 56 | 57 | Of course, you are free to modify the style to suit the desired look. 58 | 59 | ==Widgets overview 60 | 61 | * <>: 62 | provides a dropdown menu widget 63 | * <>: 64 | calendar widget, allowing the user to pick dates 65 | * <>: 66 | container for blocks, only one of which is displayed at a time, 67 | with various ways to move between them (buttons, swipe, keyboard arrows) 68 | * <>: 69 | a drawer menu that typically appears on an edge of the screen. 70 | It can appear/disappear via buttons or by swiping. 71 | * <>: 72 | user interface for uploading pictures 73 | * <>: 74 | popup windows that can be controlled in various ways 75 | * <>: 76 | widget for picking one among a range of values 77 | * <>: 78 | a spinner that appears while we wait for "slow" HTML content to be 79 | generated 80 | * <>: 81 | make element swipeable on touch screens 82 | * <>: 83 | clock-like widget that allows the user to pick a time 84 | * <>: 85 | binary toggle widget 86 | * <>: 87 | color picker widget 88 | 89 | === Non-widget utilities 90 | 91 | * <>: 92 | produces an Lwt thread allowing one to wait for a node to be 93 | inserted in the DOM 94 | * <>: 95 | listen to element resize events 96 | * <>: 97 | utilities to deal with DOM element dimensions 98 | * <>: 99 | extract social meta tags from documents 100 | * <>: 101 | functions useful for other widgets 102 | * <>: 103 | make elements "sticky", i.e., do not let them go out of sight 104 | * <>: 105 | an interface to {{{Window.getComputedStyle()}}} 106 | -------------------------------------------------------------------------------- /ocsigen-toolkit.install: -------------------------------------------------------------------------------- 1 | share: [ 2 | "css/ot_carousel.css" {"css/ot_carousel.css"} 3 | "css/ot_spinner.css" {"css/ot_spinner.css"} 4 | "css/ot_popup.css" {"css/ot_popup.css"} 5 | "css/ot_datetime.css" {"css/ot_datetime.css"} 6 | "css/ot_picture_uploader.css" {"css/ot_picture_uploader.css"} 7 | "css/ot_icons.css" {"css/ot_icons.css"} 8 | "css/ot_drawer.css" {"css/ot_drawer.css"} 9 | "css/ot_buttons.css" {"css/ot_buttons.css"} 10 | "css/ot_sticky.css" {"css/ot_sticky.css"} 11 | "css/ot_page_transition.css" {"css/ot_page_transition.css"} 12 | "css/ot_color_picker.css" {"css/ot_color_picker.css"} 13 | "css/ot_pull_to_refresh.css" {"css/ot_pull_to_refresh.css"} 14 | "css/ot_tongue.css" {"css/ot_tongue.css"} 15 | ] 16 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "ocsigen-toolkit" 3 | version: "4.1.0" 4 | maintainer: "dev@ocsigen.org" 5 | synopsis: "Reusable UI components for Eliom applications (client only, or client-server)" 6 | description: "The Ocsigen Toolkit is a set of user interface widgets that facilitate the development of Eliom applications." 7 | authors: "dev@ocsigen.org" 8 | homepage: "http://www.ocsigen.org" 9 | bug-reports: "https://github.com/ocsigen/ocsigen-toolkit/issues/" 10 | dev-repo: "git+https://github.com/ocsigen/ocsigen-toolkit.git" 11 | license: "LGPL-2.1-only WITH OCaml-LGPL-linking-exception" 12 | build: [ make "-j%{jobs}%" ] 13 | install: [ make "install" ] 14 | available: arch != "x86_32" & arch != "arm32" 15 | depends: [ 16 | "ocaml" {>= "4.08.0"} 17 | "js_of_ocaml" {>= "6.0.0"} 18 | "eliom" {>= "11.0.0"} 19 | "calendar" {>= "2.0.0"} 20 | ] 21 | -------------------------------------------------------------------------------- /src/widgets/ot_buttons.eliom: -------------------------------------------------------------------------------- 1 | [%%shared.start] 2 | 3 | open Eliom_content.Html 4 | open Eliom_content.Html.F 5 | 6 | [%%client open Js_of_ocaml_lwt] 7 | 8 | let%shared dropdown ?(a = []) ~menu content = 9 | let dropdown = 10 | D.div 11 | ~a:(a_class ["ot-dropdown"] :: a) 12 | [ div ~a:[a_class ["ot-dropdown-button"]] content 13 | ; div ~a:[a_class ["ot-dropdown-background"]] [] 14 | ; div ~a:[a_class ["ot-dropdown-menu"]] menu ] 15 | in 16 | (* the following does nothing, but still fixes hover anomalies on iPad *) 17 | ignore 18 | [%client 19 | (Lwt.async @@ fun () -> 20 | Lwt_js_events.clicks (To_dom.of_element ~%dropdown) (fun ev _ -> 21 | Lwt.return_unit) 22 | : _)]; 23 | dropdown 24 | -------------------------------------------------------------------------------- /src/widgets/ot_buttons.eliomi: -------------------------------------------------------------------------------- 1 | [%%shared.start] 2 | 3 | open Html_types 4 | open Eliom_content.Html 5 | 6 | (* [dropdown ~menu content] creates a dropdown button with [content] as the 7 | button's content and [menu] as the menu's content. Note that the menu is 8 | displayed when the button is being hovered over with the mouse (on mobile 9 | devices: when tapped on) and functions purely by CSS. *) 10 | val dropdown : 11 | ?a:div_attrib attrib list 12 | -> menu:div_content elt list 13 | -> div_content elt list 14 | -> div_content elt 15 | -------------------------------------------------------------------------------- /src/widgets/ot_calendar.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2015 4 | * Jerome Vouillon and Vasilis Papavasileiou 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (** Calendar widget *) 22 | 23 | [%%shared.start] 24 | 25 | type intl = 26 | { i_days : string list 27 | ; i_months : string list 28 | ; i_start : [`Sun | `Mon | `Tue | `Wed | `Thu | `Fri | `Sat] } 29 | (** [intl] is the type of internationalization specifiers. [i_days] 30 | contains the names of the weekdays, starting with 31 | Sunday. [i_months] contains the names of the months, starting with 32 | January. [i_start] specifies the first day of the week. *) 33 | 34 | type button_labels = 35 | { b_prev_year : string 36 | ; b_prev_month : string 37 | ; b_next_month : string 38 | ; b_next_year : string } 39 | (** An instance of [button_labels] is used to customize the button 40 | labels. The defaults are "<<", "<", ">", and ">>". *) 41 | 42 | val make : 43 | ?init:int * int * int 44 | -> ?highlight:(int -> int -> int list Lwt.t) Eliom_client_value.t 45 | -> ?click_non_highlighted:bool 46 | -> ?update:(int * int * int) React.E.t Eliom_client_value.t 47 | -> ?action:(int -> int -> int -> unit Lwt.t) Eliom_client_value.t 48 | -> ?period: 49 | CalendarLib.Date.field CalendarLib.Date.date 50 | * CalendarLib.Date.field CalendarLib.Date.date 51 | -> ?button_labels:button_labels 52 | -> ?intl:intl 53 | -> unit 54 | -> [> `Div] Eliom_content.Html.elt 55 | (** [make ?highlight ?click_any ?action] produces a calendar. 56 | 57 | If a client-side function [highlight] is provided, [highlight y m] 58 | needs to produce the list of days for the month [m] of the year 59 | [y] that need to be visually denoted. 60 | 61 | If [click_non_highlighted] is [true], every date is clickable; 62 | otherwise, only the dates that [highlight] returns (if [highlight] 63 | is provided) are clickable. 64 | 65 | If a client-side function [action] is provided, when the user 66 | clicks on the date [d]:[m]:[y], [action y m d] is called. 67 | 68 | If [period] is provided, the calendar will have a period restriction 69 | between the two dates given contained in [update]. 70 | *) 71 | 72 | val make_date_picker : 73 | ?init:int * int * int 74 | -> ?update:(int * int * int) React.E.t Eliom_client_value.t 75 | -> ?button_labels:button_labels 76 | -> ?intl:intl 77 | -> ?period: 78 | CalendarLib.Date.field CalendarLib.Date.date 79 | * CalendarLib.Date.field CalendarLib.Date.date 80 | -> unit 81 | -> [> `Div] Eliom_content.Html.elt * (int * int * int) Eliom_shared.React.S.t 82 | (** [make_date_picker ?init ()] returns a client-side reactive signal 83 | [(y, m, d)] corresponding to the date [d]:[m]:[y] that the user 84 | clicks on. The optional parameter [init] provides an initial value 85 | for the signal. 86 | [?intl] is used to internationalize the calendar (see {!intl}). The default 87 | behavior is for English. 88 | *) 89 | -------------------------------------------------------------------------------- /src/widgets/ot_carousel.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015-09 5 | * Vincent Balat 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%client.start] 23 | 24 | open Js_of_ocaml 25 | 26 | [%%shared.start] 27 | 28 | (** {2 Carousel} 29 | 30 | This is a widget containing blocks. One or several blocks are 31 | displayed at a time, depending on the size of the carousel. User 32 | can display the next/previous items by pressing buttons, by 33 | swiping on touch screens, or by pressing arrow keys. 34 | 35 | It is possible to put a carousel inside another carousel. 36 | 37 | A carousel can be horizontal or vertical. 38 | 39 | This module also defines two other widgets related to the carousel: 40 | 41 | - bullets displays the current position in the carousel (as a set 42 | of bullets), 43 | 44 | - ribbon: display a swipeable horizontal menu to navigate the 45 | carousel. 46 | 47 | You can use all these widgets in client or server OCaml side 48 | programs. *) 49 | 50 | type 'a t = 51 | { elt : 'a Eliom_content.Html.elt 52 | ; pos : int Eliom_shared.React.S.t 53 | ; pos_post : int Eliom_shared.React.S.t 54 | ; vis_elts : int Eliom_shared.React.S.t 55 | ; swipe_pos : float React.S.t Eliom_client_value.t } 56 | (** see [make] *) 57 | 58 | val make : 59 | ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list 60 | -> ?vertical:bool 61 | -> ?position:int 62 | -> ?transition_duration:float 63 | -> ?inertia:float 64 | -> ?swipeable:bool 65 | -> ?allow_overswipe:bool 66 | -> ?update:[`Goto of int | `Next | `Prev] React.event Eliom_client_value.t 67 | -> ?disabled:bool Eliom_shared.React.S.t 68 | -> ?full_height: 69 | [`No | `No_header | `Header of (unit -> int) Eliom_client_value.t] 70 | -> ?make_transform: 71 | (vertical:bool -> ?delta:int -> int -> string) Eliom_shared.Value.t 72 | -> ?make_page_attribute: 73 | (vertical:bool 74 | -> int 75 | -> Html_types.div_attrib Eliom_content.Html.D.attrib list) 76 | Eliom_shared.Value.t 77 | -> [< Html_types.div_content] Eliom_content.Html.elt list 78 | -> [> `Div] t 79 | (** 80 | Creates a carousel from the elements of a list. 81 | [?position] is the initial position (default 0). 82 | [?update] is a react event you can use to command the carousel from outside. 83 | [?disabled] is always [false] by default. When [true], it is not possible 84 | to change carousel position. 85 | [?transition_duration] allows to adjust the 86 | transition duration (which is currently constant). Default is 0.6s. 87 | [?inertia] makes it possible to reduce (or increase) inertia. 88 | Default is [1.0]. No inertia is [0.0]. 89 | Set [?swipeable] to [false] if you want to disable swiping. 90 | [?allow_overswipe] is [false] by default. It [true], it is possible to 91 | swipe before first page and after last page. 92 | 93 | Use optional parameter [?full_height] 94 | if you don't want scroll bars in carousel 95 | pages. Carousel will expand as necessary in the page, and swiping 96 | to another page will automatically update the scroll position of the 97 | whole page. Use this for example if you want a page with several tabs. 98 | [`No_header] means that the top of the screen will be used for the 99 | default position. Use [`Header f] if you want to add some extra space 100 | for a header (for example a tabbar). [f] is the function which returns 101 | the height of this header. 102 | 103 | Optional parameter [?make_transform] makes it possible to 104 | customize the transformation applied to the carousel when it moves. 105 | The default is a translation, but you may want for example a rotation 106 | for a circular carousel. Function [make_transform] takes [~vertical] 107 | (whether the carousel is vertical or horizontal), the current move 108 | ([?delta], in pixels) if the carousel is currently being 109 | dragged using fingers on touch screens, and the current position 110 | (before starting moving the carousel if it is currently being dragged). 111 | It must return the CSS value of the [transform] property for the 112 | page container (which has class ["car2"]). 113 | 114 | Optional parameter [?make_page_attribute] allows to add html attributes 115 | to each page of the carousel. It takes the page number as parameter. 116 | 117 | Function [make] returns a value of type [t] that contains: 118 | - the HTML element [elt], 119 | - the current position [pos] (as a react signal), 120 | - the current position [pos_post] which is updated after the tab change is 121 | completed 122 | - the number of fully visible elements [vis_elts]. 123 | It is more than 1 if element 124 | width ([div.car2]) is set, in CSS, to a value smaller than carousel width 125 | (for example 50% or 33.33%). The width of all elements is supposed to be 126 | equal. 127 | - the current swipe position. Value -1.0 corresponds to previous page, 128 | and +1.0 to next page. 129 | *) 130 | 131 | val make_lazy : 132 | ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list 133 | -> ?vertical:bool 134 | -> ?position:int 135 | -> ?transition_duration:float 136 | -> ?inertia:float 137 | -> ?swipeable:bool 138 | -> ?allow_overswipe:bool 139 | -> ?update:[`Goto of int | `Next | `Prev] React.event Eliom_client_value.t 140 | -> ?disabled:bool Eliom_shared.React.S.t 141 | -> ?full_height: 142 | [`No | `No_header | `Header of (unit -> int) Eliom_client_value.t] 143 | -> ?make_transform: 144 | (vertical:bool -> ?delta:int -> int -> string) Eliom_shared.Value.t 145 | -> ?make_page_attribute: 146 | (vertical:bool 147 | -> int 148 | -> Html_types.div_attrib Eliom_content.Html.D.attrib list) 149 | Eliom_shared.Value.t 150 | -> ?spinner:(unit -> Html_types.div_content Eliom_content.Html.elt) 151 | -> (unit -> [< Html_types.div_content] Eliom_content.Html.elt Lwt.t) 152 | Eliom_shared.Value.t 153 | list 154 | -> [> `Div] t Lwt.t 155 | (** same as [make] except for the last argument. Instead of supplying the 156 | contents for each page directly, supply a for each page a shared content 157 | generator function. Contents will be generated and filled lazily, i.e. when 158 | switching to a page for the first time. The initial page (defined by 159 | [position] is directly generated on the server side (if [make_lazy] is 160 | invoked on the server). 161 | Parameter [?spinner] make it possible to customize the element 162 | that is displayed while page is loading. 163 | *) 164 | 165 | val wheel : 166 | ?a:[< Html_types.div_attrib > `Class] Eliom_content.Html.attrib list 167 | -> ?vertical:bool 168 | -> ?position:int 169 | -> ?transition_duration:float 170 | -> ?inertia:float 171 | -> ?allow_overswipe:bool 172 | -> ?update:[`Goto of int | `Next | `Prev] React.event Eliom_client_value.t 173 | -> ?disabled:bool Eliom_shared.React.S.t 174 | -> ?faces:int 175 | -> ?face_size:int 176 | -> [< Html_types.div_content] Eliom_content.Html.elt list 177 | -> [> `Div] Eliom_content.Html.elt 178 | * int Eliom_shared.React.S.t 179 | * float React.S.t Eliom_client_value.t 180 | (** Carousel with 3D effect. Faces are displayed on a cylinder. 181 | Give the number of faces you want as parameter [faces] (default: 20). 182 | The size of the faces (height for vertical carousel, width for horizontal) 183 | must be given as parameter [face_size] 184 | and must match the size given in the CSS (in pixel, default is 25). 185 | This carousel is vertical by default. 186 | 187 | Function [make] returns: 188 | - the element, 189 | - the current position (as a react signal), 190 | - the current swipe position. Value -1.0 corresponds to previous page, 191 | and +1.0 to next page. 192 | *) 193 | 194 | val bullets : 195 | ?a:[< Html_types.ul_attrib] Eliom_content.Html.attrib list 196 | -> ?attributes:[< Html_types.li_attrib] Eliom_content.Html.attrib list list 197 | -> change:([`Goto of int | `Next | `Prev] -> unit) Eliom_client_value.t 198 | -> pos:int Eliom_shared.React.S.t 199 | -> length:int 200 | -> ?size:int Eliom_shared.React.S.t 201 | -> ?content:[< Html_types.li_content_fun] Eliom_content.Html.elt list list 202 | -> unit 203 | -> [> `Ul] Eliom_content.Html.elt 204 | (** List of bullets for carousel. Current page has class ["active"]. 205 | [pos] is a signal corresponding to current position. 206 | [change] is a function to change position of carousel. 207 | This is usually the function to trigger the event given as 208 | parameter to [make]. 209 | [length] must be exactly the number of elements in the carousel. 210 | Optional parameter [attributes] makes possible to give an HTML attribute 211 | to each bullet (for example a reactive class). 212 | Optional parameter [size] is the number of elements visible at the same time 213 | in the carousel (return by function [make]). 214 | Optional parameter [content] makes it possible to fill the bullets with Html 215 | elements. 216 | *) 217 | 218 | val ribbon : 219 | ?a:[< Html_types.ul_attrib] Eliom_content.Html.attrib list 220 | -> change:([`Goto of int | `Next | `Prev] -> unit) Eliom_client_value.t 221 | -> pos:int Eliom_shared.React.S.t 222 | -> ?size:int Eliom_shared.React.S.t 223 | -> ?initial_gap:int 224 | -> ?transition_duration:float 225 | -> ?cursor:float React.S.t Eliom_client_value.t 226 | -> [< Html_types.li_content_fun] Eliom_content.Html.elt list list 227 | -> [> `Div] Eliom_content.Html.elt 228 | (** Menu (or tabs) for carousel. Current page has class ["active"]. 229 | [pos] is a signal corresponding to current position. 230 | [change] is a function to change position of carousel. 231 | This is usually the function to trigger the event given as 232 | parameter to [make]. 233 | Optional parameter [size] is the number of elements visible at the same time 234 | in the carousel (return by function [make]). 235 | Optional parameter [gap] is the default gap on the left, in pixels. 236 | The last argument is the list of titles, for each carousel page, 237 | that will be included in [
  • ] tags. 238 | 239 | If [cursor] is present, an element is added below the ribbon 240 | to visualize the current position. It corresponds to the float 241 | signal returned by [make]. 242 | *) 243 | 244 | val previous : 245 | ?a:[< Html_types.button_attrib] Eliom_content.Html.attrib list 246 | -> change:([> `Prev | `Goto of int] -> unit) Eliom_client_value.t 247 | -> ?offset:int Eliom_shared.React.S.t 248 | -> pos:int Eliom_shared.React.S.t 249 | -> Html_types.button_content Eliom_content.Html.elt list 250 | -> [> `Button] Eliom_content.Html.elt 251 | (** Button to go to the previous page (or mores page if [offset] is present). *) 252 | 253 | val next : 254 | ?a:[< Html_types.button_attrib] Eliom_content.Html.attrib list 255 | -> change:([> `Next | `Goto of int] -> unit) Eliom_client_value.t 256 | -> ?offset:int Eliom_shared.React.S.t 257 | -> pos:int Eliom_shared.React.S.t 258 | -> vis_elts:int Eliom_shared.React.S.t 259 | -> length:int 260 | -> Html_types.button_content Eliom_content.Html.elt list 261 | -> [> `Button] Eliom_content.Html.elt 262 | (** Button to go to the next page (or more pages if [offset] is present). *) 263 | 264 | (* (\** Menu + prev/next buttons *\) *) 265 | (* val nav : *) 266 | (* ?a:[< Html_types.ul_attrib > `Class `OnClick ] *) 267 | (* Eliom_content.Html.F.attrib list -> *) 268 | (* change: ([> `Goto of int | `Next | `Prev ] -> unit) Eliom_client_value.t -> *) 269 | (* pos:int Eliom_shared.React.S.t -> *) 270 | (* ?size:int Eliom_shared.React.S.t -> *) 271 | (* [< Html_types.li_content_fun ] Eliom_content.Html.F.elt list list -> *) 272 | (* [> Html_types.div ] Eliom_content.Html.F.elt *) 273 | 274 | [%%client.start] 275 | 276 | (* Make arrow keys cause event change. 277 | Returns a thread that never stops until you call [Lwt.cancel] on it. *) 278 | val bind_arrow_keys : 279 | ?use_capture:bool 280 | -> ?vertical:bool 281 | -> change:([> `Goto of int | `Next | `Prev] -> unit) 282 | -> #Dom_html.eventTarget Js.t 283 | -> unit Lwt.t 284 | 285 | val set_default_fail : 286 | (exn -> [< Html_types.div_content] Eliom_content.Html.elt) 287 | -> unit 288 | (** Change the default function used to display error messages *) 289 | -------------------------------------------------------------------------------- /src/widgets/ot_color_picker.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen-widgets 2 | * http://www.ocsigen.org/ocsigen-widgets 3 | * 4 | * Copyright (C) 2014 Université Paris Diderot 5 | * Enguerrand Decorne 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%shared.start] 23 | 24 | open Eliom_shared.React.S.Infix 25 | 26 | let hsv_to_rgb h s v = 27 | let h = float_of_int h in 28 | let c = v *. s in 29 | let h1 = h /. 60. in 30 | let x = c *. (1. -. abs_float (mod_float h1 2. -. 1.)) in 31 | let m = v -. c in 32 | let r, g, b = 33 | match h1 with 34 | | _ when h1 < 1. -> c, x, 0. 35 | | _ when h1 < 2. -> x, c, 0. 36 | | _ when h1 < 3. -> 0., c, x 37 | | _ when h1 < 4. -> 0., x, c 38 | | _ when h1 < 5. -> x, 0., c 39 | | _ when h1 <= 6. -> c, 0., x 40 | | _ -> 0., 0., 0. 41 | in 42 | 255. *. (r +. m), 255. *. (g +. m), 255. *. (b +. m) 43 | 44 | let rgb_to_css (r, g, b) = 45 | Printf.sprintf "rgb(%d, %d, %d)" (int_of_float r) (int_of_float g) 46 | (int_of_float b) 47 | 48 | let display_hue_selector ~setter (sel_hue, sel_sat, sel_ltn) = 49 | let open Eliom_content.Html in 50 | let dim = 111 in 51 | let irange = Array.init dim (fun x -> x) in 52 | let step = 360.0 /. float_of_int dim in 53 | let cells = 54 | Array.map 55 | (fun i -> 56 | let hue = float_of_int i *. step in 57 | let is_selected = 58 | hue >= float_of_int sel_hue && hue -. step < float_of_int sel_hue 59 | in 60 | let bgcolor = 61 | Printf.sprintf "hsl(%.3f, %.3f%%, %.3f%%)" hue 100.0 50.0 62 | in 63 | let open D in 64 | div 65 | ~a: 66 | [ a_class 67 | (if is_selected 68 | then 69 | [ "ot-color-picker-hue-picker-cell" 70 | ; "ot-color-picker-selected-cell" ] 71 | else ["ot-color-picker-hue-picker-cell"]) 72 | ; a_style ("background-color: " ^ bgcolor) 73 | ; a_onmousedown 74 | [%client 75 | fun _ -> 76 | let hue = int_of_float ~%hue in 77 | ~%setter (hue, ~%sel_sat, ~%sel_ltn)] ] 78 | []) 79 | irange 80 | in 81 | D.(div ~a:[a_class ["ot-color-picker-hue-picker"]] (Array.to_list cells)) 82 | 83 | (** 84 | * TODO: use a CSS3 gradient in each cell to make the grid look smoother 85 | *) 86 | let display_sl_grid ~setter (sel_hue, sel_sat, sel_ltn) = 87 | let open Eliom_content.Html in 88 | let hue = float_of_int sel_hue in 89 | let dim = 51 in 90 | let irange = Array.init (dim * dim) (fun x -> x) in 91 | let rows = Array.init dim (fun _ -> []) in 92 | let () = 93 | Array.iter 94 | (fun i -> 95 | let row = i / dim in 96 | let col = i mod dim in 97 | let saturation = float_of_int row /. float_of_int dim in 98 | let lightness = 1.0 -. (float_of_int col /. float_of_int dim) in 99 | let is_selected = saturation = sel_sat && lightness = sel_ltn in 100 | let style' = 101 | Printf.sprintf 102 | "display: inline-block; background-color: %s; height: 100%%" 103 | (rgb_to_css (hsv_to_rgb (int_of_float hue) saturation lightness)) 104 | in 105 | let el = 106 | let open D in 107 | div 108 | ~a: 109 | [ a_class 110 | (if is_selected 111 | then 112 | [ "ot-color-picker-sl-picker-cell" 113 | ; "ot-color-picker-selected-cell" ] 114 | else ["ot-color-picker-sl-picker-cell"]) 115 | ; a_style style' 116 | ; a_onmousedown 117 | [%client 118 | fun _ -> ~%setter (~%sel_hue, ~%saturation, ~%lightness)] 119 | ] 120 | [] 121 | in 122 | rows.(row) <- el :: rows.(row)) 123 | irange 124 | in 125 | let rows = 126 | Array.map 127 | (fun r -> D.(div ~a:[a_class ["ot-color-picker-sl-picker-row"]] r)) 128 | rows 129 | in 130 | D.(div ~a:[a_class ["ot-color-picker-sl-picker"]] (Array.to_list rows)) 131 | 132 | let display_aux ?(a = []) ~setter sel = 133 | let open Eliom_content.Html in 134 | D.div 135 | ~a:(D.a_class ["ot-color-picker"] :: a) 136 | [display_hue_selector ~setter sel; display_sl_grid ~setter sel] 137 | 138 | let display ?a cp_sig = 139 | let setter = snd cp_sig in 140 | fst cp_sig 141 | >|= [%shared display_aux ?a:~%a ~setter:~%setter] 142 | |> Eliom_content.Html.R.node 143 | 144 | let make ?a ?hsv 145 | ?(update = [%client (React.E.never : (int * float * float) React.E.t)]) () 146 | = 147 | let ((cp_sig, cp_set) as cp_react) = 148 | Eliom_shared.React.S.create (Option.value hsv ~default:(255, 1.0, 0.0)) 149 | in 150 | let elt, signal = display ?a cp_react, cp_sig in 151 | let elt = Eliom_content.Html.D.div [elt] in 152 | ignore 153 | [%client 154 | (* /!\ How to avoid the effectful signal ? *) 155 | (Eliom_lib.Dom_reference.retain 156 | (Eliom_content.Html.To_dom.of_element ~%elt) 157 | ~keep: 158 | (React.E.map (fun update -> ~%cp_set update) ~%update 159 | : unit React.event) 160 | : unit)]; 161 | elt, signal 162 | -------------------------------------------------------------------------------- /src/widgets/ot_color_picker.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen-widgets 2 | * http://www.ocsigen.org/ocsigen-widgets 3 | * 4 | * Copyright (C) 2014 Université Paris Diderot 5 | * Enguerrand Decorne 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%shared.start] 23 | 24 | (** This module implements a color picker. *) 25 | 26 | val hsv_to_rgb : int -> float -> float -> float * float * float 27 | (** [hsv_to_rgb h s v] converts HS(V/L) colors to RGB. *) 28 | 29 | val make : 30 | ?a:[< Html_types.div_attrib > `Class] Eliom_content.Html.attrib list 31 | -> ?hsv:int * float * float 32 | -> ?update:(int * float * float) React.E.t Eliom_client_value.t 33 | -> unit 34 | -> [> `Div] Eliom_content.Html.D.elt 35 | * (int * float * float) Eliom_shared.React.S.t 36 | (** [make ()] produces a color picker. 37 | [?a] is an optional parameter to add html attributes to main element, by default 38 | it is the empty list 39 | [?hsv] hue, saturation and value of the initial color displayed by the color 40 | picker 41 | [?update] is an optional React event that allows to change the selected color 42 | from outside *) 43 | -------------------------------------------------------------------------------- /src/widgets/ot_drawer.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015-09 5 | * Vincent Balat 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%shared.start] 23 | 24 | (** {2 Drawer menu for mobile and Web applications} *) 25 | 26 | val drawer : 27 | ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list 28 | -> ?position:[`Top | `Right | `Bottom | `Left] 29 | -> ?opened:bool 30 | -> ?swipe:bool 31 | -> ?onclose:(unit -> unit) Eliom_client_value.t 32 | -> ?onopen:(unit -> unit) Eliom_client_value.t 33 | -> ?wrap_close: 34 | ((unit -> unit) Eliom_client_value.t 35 | -> (unit -> unit) Eliom_client_value.t) 36 | -> ?wrap_open: 37 | ((unit -> unit) Eliom_client_value.t 38 | -> (unit -> unit) Eliom_client_value.t) 39 | -> [< Html_types.div_content] Eliom_content.Html.elt list 40 | -> [> `Div] Eliom_content.Html.elt 41 | * (unit -> unit) Eliom_client_value.t 42 | * (unit -> unit) Eliom_client_value.t 43 | (** Build a drawer menu on the left, right, top or bottom of the screen. 44 | Returns the DOM element, and functions to open and close the menu. 45 | It is also possible to open or close the menu by clicking on a button, 46 | and to swipe the menu to close it. 47 | 48 | If [opened] is true (false by default), the drawer is initialized in its 49 | opened state. 50 | 51 | If [swipe] is true (default), the user can swipe to open or close the 52 | drawer. 53 | 54 | If present, function [onclose] is called just after the drawer is closed, 55 | and function [onopen] just before it starts opening. 56 | 57 | [wrap_close] and [wrap_open] can be used to customize calls to [close] and 58 | [open_] functions when the drawer closing or opening is triggered. For 59 | example, drawer closing can be disabled using [wrap_close]. 60 | *) 61 | -------------------------------------------------------------------------------- /src/widgets/ot_form.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | [%%client.start] 20 | 21 | open Js_of_ocaml 22 | 23 | [%%client open Js_of_ocaml_lwt] 24 | 25 | open Eliom_content.Html 26 | open Eliom_content.Html.F 27 | 28 | class type tabbable = object 29 | inherit Dom_html.element 30 | method tabIndex : int Js.prop 31 | end 32 | 33 | let only_if_active' elt v = if Ot_style.invisible elt then None else Some v 34 | 35 | let only_if_active elt v = 36 | if elt##.disabled = Js._true || Ot_style.invisible elt then None else Some v 37 | 38 | let coerce_to_tabbable x = 39 | let x = Dom_html.element x in 40 | match Dom_html.tagged x with 41 | | Dom_html.A x -> only_if_active' x (x :> tabbable Js.t) 42 | (* | Dom_html.Link x -> Some (x :> tabbable Js.t) *) 43 | | Dom_html.Button x -> only_if_active x (x :> tabbable Js.t) 44 | | Dom_html.Input x -> only_if_active x (x :> tabbable Js.t) 45 | | Dom_html.Select x -> only_if_active x (x :> tabbable Js.t) 46 | | Dom_html.Textarea x -> only_if_active x (x :> tabbable Js.t) 47 | (* | Dom_html.Menuitem x -> Some (x :> tabbable Js.t) *) 48 | | _ -> None 49 | 50 | (* https://www.w3.org/TR/html5/editing.html#sequential-focus-navigation-and-the-tabindex-attribute *) 51 | let tabbable_elts_of elt = 52 | elt##querySelectorAll 53 | (Js.string 54 | "a[href],link[href],button,input:not([type=\"hidden\"]),select,textarea,[ot-form-focusable]") 55 | |> Dom.list_of_nodeList 56 | |> List.map coerce_to_tabbable 57 | |> List.fold_left (fun a -> function Some x -> x :: a | _ -> a) [] 58 | |> List.rev 59 | 60 | let setup_tabcycle (elts : #tabbable Js.t list) : unit = 61 | let rec fn n = function 62 | | [x] -> 63 | x##.tabIndex := n; 64 | (let open Lwt_js_events in 65 | async @@ fun () -> 66 | focuses x @@ fun _ _ -> 67 | x##.tabIndex := 1; 68 | Lwt.return_unit); 69 | let open Lwt_js_events in 70 | async @@ fun () -> 71 | blurs x @@ fun _ _ -> 72 | x##.tabIndex := n; 73 | Lwt.return_unit 74 | | hd :: tl -> 75 | hd##.tabIndex := n; 76 | fn (n + 1) tl 77 | | [] -> () 78 | in 79 | fn 2 elts 80 | 81 | let setup_tabcycle_auto x = setup_tabcycle (tabbable_elts_of x) 82 | let focus_first = function x :: _ -> (Js.Unsafe.coerce x)##focus | [] -> () 83 | 84 | let prevent_tab elt = 85 | let save_and_set_tabindex idx elt = 86 | let old = elt##.tabIndex in 87 | elt##.tabIndex := idx; 88 | elt, old 89 | in 90 | let restore_tabindex (elt, i) = elt##.tabIndex := i in 91 | let elts = List.map (save_and_set_tabindex (-1)) (tabbable_elts_of elt) in 92 | fun () -> List.iter restore_tabindex elts 93 | 94 | let setup_form element = 95 | let elts = tabbable_elts_of element in 96 | setup_tabcycle elts; focus_first elts 97 | -------------------------------------------------------------------------------- /src/widgets/ot_form.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * This program is free software; you can redistribute it and/or modify 5 | * it under the terms of the GNU Lesser General Public License as published by 6 | * the Free Software Foundation, with linking exception; 7 | * either version 2.1 of the License, or (at your option) any later version. 8 | * 9 | * This program is distributed in the hope that it will be useful, 10 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 11 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 | * GNU Lesser General Public License for more details. 13 | * 14 | * You should have received a copy of the GNU Lesser General Public License 15 | * along with this program; if not, write to the Free Software 16 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 17 | *) 18 | 19 | [%%client.start] 20 | 21 | open Js_of_ocaml 22 | open Eliom_content.Html 23 | open Html_types 24 | 25 | (** An HTML element which can be selected by pressing the tab key *) 26 | class type tabbable = object 27 | inherit Dom_html.element 28 | method tabIndex : int Js.prop 29 | end 30 | 31 | val setup_tabcycle : #tabbable Js.t list -> unit 32 | (** [setup_tabcycle] makes tab key loop over child elements of an element and 33 | only these elements. *) 34 | 35 | val setup_tabcycle_auto : Dom_html.element Js.t -> unit 36 | (** [setup_tabcycle_auto] scans an element for tabbable elements (buttons, inputs) 37 | and feeds them to [setup_tabcycle] *) 38 | 39 | val setup_form : Dom_html.element Js.t -> unit 40 | (** Scan for focusable elements apply [setup_tabcycle_auto] to them and 41 | focus the first. *) 42 | 43 | val prevent_tab : Dom_html.element Js.t -> unit -> unit 44 | (** [prevent_tab e] prevents [e] (and its children) to be focused with tab key. 45 | A function to restore the initial status is returned. *) 46 | -------------------------------------------------------------------------------- /src/widgets/ot_icons.eliom: -------------------------------------------------------------------------------- 1 | (** This module defines an interface to create icons with predefined 2 | * style/value. You need the CSS file "ot_icons.css" which defines the ot-icon 3 | * and other used CSS classes for predefined icons. 4 | *) 5 | 6 | [%%shared 7 | module Make (A : module type of Eliom_content.Html.F) = struct 8 | (** [icon classes] create an icon HTML attribute with "ot-icon" and [classes] 9 | * as CSS classes. 10 | * The optional parameter is at the end to be able to add other CSS classes 11 | * with predefined icons. 12 | *) 13 | let icon classes 14 | ?(a = ([] : Html_types.i_attrib Eliom_content.Html.attrib list)) () 15 | = 16 | A.i ~a:(A.a_class ("ot-icon" :: classes) :: a) [] 17 | 18 | (* Predefined icons. See ot-icons.css *) 19 | let user = icon ["ot-icon-user"] 20 | let plus = icon ["ot-plus"] 21 | let spinner = icon ["ot-icon-spinner"; "ot-icon-animation-spinning"] 22 | let shutdown = icon ["ot-icon-power"] 23 | let config = icon ["ot-icon-gear"] 24 | let signout = icon ["ot-icon-sign-out"] 25 | let close = icon ["ot-icon-close"] 26 | let question = icon ["ot-icon-question"] 27 | end 28 | 29 | module F = Make (Eliom_content.Html.F) 30 | module D = Make (Eliom_content.Html.D)] 31 | -------------------------------------------------------------------------------- /src/widgets/ot_lib.eliom: -------------------------------------------------------------------------------- 1 | [%%client 2 | (* Ocsigen 3 | * http://www.ocsigen.org 4 | * 5 | * Copyright (C) 2015-09 6 | * Vincent Balat 7 | * 8 | * This program is free software; you can redistribute it and/or modify 9 | * it under the terms of the GNU Lesser General Public License as published by 10 | * the Free Software Foundation, with linking exception; 11 | * either version 2.1 of the License, or (at your option) any later version. 12 | * 13 | * This program is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | * GNU Lesser General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU Lesser General Public License 19 | * along with this program; if not, write to the Free Software 20 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 21 | *) 22 | open Js_of_ocaml 23 | open Lwt.Syntax] 24 | 25 | [%%client open Js_of_ocaml_lwt] 26 | 27 | let%client onloads handler = 28 | let rec loop () = Eliom_client.onload @@ fun () -> handler (); loop () in 29 | loop () 30 | 31 | let%client onresizes handler = 32 | let stop, stop_thread = React.E.create () in 33 | Eliom_client.Page_status.while_active ~stop (fun () -> 34 | Lwt_js_events.onresizes handler); 35 | Lwt.finalize 36 | (fun () -> fst @@ Lwt.wait ()) 37 | (fun () -> stop_thread (); Lwt.return_unit) 38 | 39 | let%client window_scroll ?use_capture () = 40 | Lwt_js_events.make_event Dom_html.Event.scroll ?use_capture Dom_html.window 41 | 42 | let%client window_scrolls ?(ios_html_scroll_hack = false) ?use_capture handler = 43 | let stop, stop_thread = React.E.create () in 44 | let cur = ref Lwt.return_unit in 45 | Eliom_client.Page_status.while_active ~stop (fun () -> 46 | cur := 47 | if ios_html_scroll_hack 48 | then 49 | let rec loop () = 50 | let* e = 51 | Lwt.pick 52 | (List.map 53 | (* We listen to several elements because scroll events are 54 | not happening on the same element on every platform. *) 55 | (fun element -> Lwt_js_events.scroll ?use_capture element) 56 | [ (Dom_html.window :> Dom_html.eventTarget Js.t) 57 | ; (Dom_html.document##.documentElement 58 | :> Dom_html.eventTarget Js.t) 59 | ; (Dom_html.document##.body :> Dom_html.eventTarget Js.t) ]) 60 | in 61 | let continue = ref true in 62 | let w = 63 | Lwt.catch 64 | (fun () -> fst (Lwt.task ())) 65 | (function 66 | | Lwt.Canceled -> 67 | continue := false; 68 | Lwt.return_unit 69 | | exc -> Lwt.reraise exc) 70 | in 71 | let* () = handler e w in 72 | if !continue then loop () else Lwt.return_unit 73 | in 74 | loop () 75 | else 76 | Lwt_js_events.seq_loop 77 | (Lwt_js_events.make_event Dom_html.Event.scroll) 78 | ?use_capture Dom_html.window handler; 79 | !cur); 80 | Lwt.finalize 81 | (fun () -> fst @@ Lwt.task ()) 82 | (fun () -> stop_thread (); Lwt.cancel !cur; Lwt.return_unit) 83 | 84 | let%client rec in_ancestors ~elt ~ancestor = 85 | Js.strict_equals elt (ancestor : Dom_html.element Js.t) 86 | || (not (Js.strict_equals elt Dom_html.document##.body)) 87 | && Js.Opt.case elt##.parentNode 88 | (fun () -> false) 89 | (fun parent -> 90 | Js.Opt.case 91 | (Dom_html.CoerceTo.element parent) 92 | (fun () -> false) 93 | (fun elt -> in_ancestors ~elt ~ancestor)) 94 | 95 | let%client rec click_outside ?use_capture 96 | ?(inside = (Dom_html.document##.body :> Dom_html.element Js.t)) elt 97 | = 98 | let* ev = Lwt_js_events.click ?use_capture inside in 99 | Js.Opt.case ev##.target 100 | (fun () -> click_outside ?use_capture elt) 101 | (fun target -> 102 | if in_ancestors ~elt:target ~ancestor:(elt :> Dom_html.element Js.t) 103 | then click_outside ?use_capture ~inside elt 104 | else Lwt.return ev) 105 | 106 | [%%shared 107 | module List = struct 108 | let iteri2 f l1 l2 = 109 | let rec aux i l1 l2 = 110 | match l1, l2 with 111 | | a :: ll1, b :: ll2 -> 112 | f i a b; 113 | aux (i + 1) ll1 ll2 114 | | _ -> () 115 | in 116 | aux 0 l1 l2 117 | end] 118 | -------------------------------------------------------------------------------- /src/widgets/ot_lib.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015-09 5 | * Vincent Balat 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%client.start] 23 | 24 | open Js_of_ocaml 25 | 26 | val in_ancestors : 27 | elt:Dom_html.element Js.t 28 | -> ancestor:Dom_html.element Js.t 29 | -> bool 30 | 31 | val onloads : (unit -> unit) -> unit 32 | 33 | val onresizes : (Dom_html.event Js.t -> unit Lwt.t -> unit Lwt.t) -> unit Lwt.t 34 | (** NOTE: be careful when using the functions [onresizes], 35 | [window_scroll], and [window_scrolls]. They may be called before 36 | the new document is displayed (and thus the new window is there) 37 | and therefore may be attached to the window that is about to be 38 | replaced. In most use-cases you should have a line as follows 39 | before: let%lwt () = Ot_nodeready.nodeready @@ To_dom.of_element 40 | some_elt in *) 41 | 42 | val window_scroll : ?use_capture:bool -> unit -> Dom_html.event Js.t Lwt.t 43 | 44 | val window_scrolls : 45 | ?ios_html_scroll_hack:bool 46 | -> ?use_capture:bool 47 | -> (Dom_html.event Js.t -> unit Lwt.t -> unit Lwt.t) 48 | -> unit Lwt.t 49 | (** If [ios_html_scroll_hack] then listen on window + html + body 50 | instead of only window. On iOS (8 and 9), in WkWebView and in 51 | Safari, some CSS properties (e.g. html{overflow:scroll; 52 | -webkit-overflow-scrolling: touch;}) may move the scroll event 53 | from window to html or to body. For instance, with (ON) or 54 | without (OFF) the following CSS: 55 | [html{overflow:scroll;-webkit-overflow-scrolling: touch;}] 56 | we may observe this: 57 | 58 | {[ 59 | | capture | elements receiving the scroll events 60 | -----+---------+------------------------------------- 61 | OFF | true | window 62 | -----+---------+------------------------------------- 63 | OFF | false | window 64 | -----+---------+------------------------------------- 65 | ON | true | window + html + body 66 | -----+---------+------------------------------------- 67 | ON | false | body 68 | ----------------------------------------------------- 69 | ]} 70 | 71 | (Also, note that pure JavaScript "onscroll" attribute might be 72 | broken when ON.) It's useful to listen on html even if it's only 73 | relevant when ON + capture=true, because we probably want, when 74 | capture=true, to capture the event as early as possible. *) 75 | 76 | val click_outside : 77 | ?use_capture:bool 78 | -> ?inside:Dom_html.element Js.t 79 | -> #Dom_html.element Js.t 80 | -> Dom_html.mouseEvent Js.t Lwt.t 81 | (** [click_outside e] returns when user clicks outside element [e]. 82 | Will only catch clicks inside the element given as optional 83 | parameter [?inside] (default is [Dom_html.document##.body]). *) 84 | 85 | [%%shared.start] 86 | 87 | module List : sig 88 | val iteri2 : (int -> 'a -> 'b -> unit) -> 'a list -> 'b list -> unit 89 | end 90 | -------------------------------------------------------------------------------- /src/widgets/ot_nodeready.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015 BeSport, Julien Sagot 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%client.start] 22 | 23 | open Js_of_ocaml 24 | 25 | let debug = false 26 | 27 | let rec node_in_document node = 28 | Js.strict_equals node (Dom_html.document :> Dom.node Js.t) 29 | || Js.Opt.case node##.parentNode (fun () -> false) node_in_document 30 | 31 | type t = 32 | { node : Dom.node Js.t 33 | ; thread : unit Lwt.t 34 | ; resolver : unit Lwt.u 35 | ; stop_ondead : unit -> unit } 36 | 37 | let watched = ref [] 38 | 39 | let log ~n:node s = 40 | if not debug 41 | then () 42 | else ( 43 | (* Console.console##log(node); *) 44 | ignore node; 45 | print_endline 46 | @@ Printf.sprintf "Ot_nodeready: %s; watching %n elements" s 47 | (List.length !watched)) 48 | 49 | let handler records observer = 50 | let changes = ref false in 51 | for i = 0 to records##.length - 1 do 52 | Js.Optdef.iter (Js.array_get records i) (fun r -> 53 | if r##.addedNodes##.length > 0 then changes := true) 54 | done; 55 | if !changes 56 | then ( 57 | let ready, not_ready = 58 | List.partition (fun {node} -> node_in_document node) !watched 59 | in 60 | watched := not_ready; 61 | if not_ready = [] then observer##disconnect; 62 | ready 63 | |> List.iter (fun {resolver; stop_ondead} -> 64 | stop_ondead (); Lwt.wakeup resolver ())) 65 | 66 | let observer = 67 | new%js MutationObserver.mutationObserver (Js.wrap_callback handler) 68 | 69 | let config = 70 | let cfg = MutationObserver.empty_mutation_observer_init () in 71 | cfg##.childList := true; 72 | cfg##.subtree := true; 73 | cfg 74 | 75 | let nodeready n = 76 | let n = (n :> Dom.node Js.t) in 77 | if node_in_document n 78 | then ( 79 | log ~n "already in document"; 80 | Lwt.return_unit) 81 | else ( 82 | if !watched = [] then observer##observe Dom_html.document config; 83 | try 84 | let {thread} = 85 | List.find (fun {node} -> Js.strict_equals n node) !watched 86 | in 87 | log ~n "already being watched"; 88 | thread 89 | with Not_found -> 90 | let t, s = Lwt.wait () in 91 | let stop, stop_ondead = React.E.create () in 92 | let stop_ondead () = 93 | log ~n "put node in document"; 94 | stop_ondead () 95 | in 96 | Eliom_client.Page_status.ondead ~stop (fun () -> 97 | let instances_of_node, rest = 98 | List.partition (fun {node} -> Js.strict_equals n node) !watched 99 | in 100 | watched := rest; 101 | instances_of_node 102 | |> List.iter (fun {resolver} -> 103 | log ~n "deinstalled"; Lwt.wakeup resolver ())); 104 | watched := {node = n; thread = t; resolver = s; stop_ondead} :: !watched; 105 | log ~n "installed"; 106 | t) 107 | -------------------------------------------------------------------------------- /src/widgets/ot_nodeready.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015 BeSport, Julien Sagot 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%client.start] 22 | 23 | open Js_of_ocaml 24 | 25 | val nodeready : #Dom.node Js.t -> unit Lwt.t 26 | (** Wait for a node to be inserted in the DOM. 27 | 28 | {3 Example} 29 | 30 | [let _ = nodeready node in Console.console##debug node] 31 | 32 | {3 Known issues} 33 | 34 | Using it on a node that is never actually added in the DOM will 35 | make the node and the thread wakener kept in memory. Also, note 36 | that nodeready is fired only once (except if you add a new 37 | listener to it after triggering the first one). *) 38 | -------------------------------------------------------------------------------- /src/widgets/ot_noderesize.eliom: -------------------------------------------------------------------------------- 1 | [%%client 2 | (* Ocsigen 3 | * http://www.ocsigen.org 4 | * 5 | * Copyright (C) 2015 BeSport, Julien Sagot 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | open Js_of_ocaml] 22 | 23 | [%%client open Eliom_content.Html] 24 | [%%client open Eliom_content.Html.F] 25 | 26 | type%client resize_sensor = 27 | { watched : Dom_html.element Js.t 28 | ; grow : Dom_html.element Js.t 29 | ; mutable grow_listener_id : Dom.event_listener_id option 30 | ; grow_child : Dom_html.element Js.t 31 | ; shrink : Dom_html.element Js.t 32 | ; mutable shrink_listener_id : Dom.event_listener_id option 33 | ; sensor : Dom_html.element Js.t } 34 | 35 | let%client attach watched = 36 | let style = 37 | "display:block; position: absolute; left: 0; top: 0; right: 0; bottom: 0; overflow: hidden; z-index: -1000; visibility: hidden;" 38 | in 39 | let style_child = "position: absolute; left: 0; top: 0; transition: 0s;" in 40 | let grow_child = D.div ~a:[a_style style_child] [] in 41 | let grow = 42 | D.div ~a:[a_class ["resize-sensor-grow"]; a_style style] [grow_child] 43 | in 44 | let shrink = 45 | D.div 46 | ~a:[a_class ["resize-sensor-shrink"]; a_style style] 47 | [div ~a:[a_style (style_child ^ " width: 200%; height: 200%;")] []] 48 | in 49 | let sensor = 50 | D.div ~a:[a_class ["resize-sensor"]; a_style style] [grow; shrink] 51 | in 52 | let grow_child = To_dom.of_element grow_child in 53 | let grow = To_dom.of_element grow in 54 | let shrink = To_dom.of_element shrink in 55 | let sensor = To_dom.of_element sensor in 56 | if (Dom_html.window##getComputedStyle watched)##.position = Js.string "static" 57 | then watched##.style##.position := Js.string "relative"; 58 | Dom.appendChild watched sensor; 59 | { watched :> Dom_html.element Js.t 60 | ; grow 61 | ; grow_child 62 | ; shrink 63 | ; sensor 64 | ; grow_listener_id = None 65 | ; shrink_listener_id = None } 66 | 67 | let%client detach {watched; sensor; shrink_listener_id; grow_listener_id; _} = 68 | Dom.removeChild watched sensor; 69 | (match grow_listener_id with Some x -> Dom.removeEventListener x | _ -> ()); 70 | match shrink_listener_id with Some x -> Dom.removeEventListener x | _ -> () 71 | 72 | let%client reset {grow; grow_child; shrink; _} = 73 | shrink##.scrollLeft := Js.float (float shrink##.scrollWidth); 74 | shrink##.scrollTop := Js.float (float shrink##.scrollHeight); 75 | grow_child##.style##.width 76 | := Js.string (string_of_int (grow##.offsetWidth + 1) ^ "px"); 77 | grow_child##.style##.height 78 | := Js.string (string_of_int (grow##.offsetHeight + 1) ^ "px"); 79 | grow##.scrollLeft := Js.float (float grow##.scrollWidth); 80 | grow##.scrollTop := Js.float (float grow##.scrollHeight) 81 | 82 | let%client reset_opt {grow; grow_child; shrink; _} = 83 | shrink##.scrollLeft := Js.float 9999.; 84 | shrink##.scrollTop := Js.float 9999.; 85 | grow##.scrollLeft := Js.float 9999.; 86 | grow##.scrollTop := Js.float 9999. 87 | 88 | let%client noderesize_aux reset sensor f = 89 | let bind element = 90 | let w = ref element##.offsetWidth in 91 | let h = ref element##.offsetHeight in 92 | let throttle = ref false in 93 | Dom.addEventListener element Dom_html.Event.scroll 94 | (Dom.handler (fun _ -> 95 | if not !throttle 96 | then ( 97 | throttle := true; 98 | ignore 99 | (Dom_html.window##requestAnimationFrame 100 | ( Js.wrap_callback @@ fun _ -> 101 | let w' = element##.offsetWidth in 102 | let h' = element##.offsetHeight in 103 | if w' <> !w || h' <> !h then f (); 104 | w := w'; 105 | h := h'; 106 | reset sensor; 107 | throttle := false ))); 108 | Js.bool true)) 109 | (Js.bool false) 110 | in 111 | reset sensor; 112 | sensor.grow_listener_id <- Some (bind sensor.grow); 113 | sensor.shrink_listener_id <- Some (bind sensor.shrink) 114 | 115 | let%client noderesize ?(safe = false) ({grow_child; _} as sensor) = 116 | if safe 117 | then noderesize_aux reset sensor 118 | else ( 119 | grow_child##.style##.width := Js.string "9999px"; 120 | grow_child##.style##.height := Js.string "9999px"; 121 | noderesize_aux reset_opt sensor) 122 | -------------------------------------------------------------------------------- /src/widgets/ot_noderesize.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015 BeSport, Julien Sagot 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | (* This is a redo of [ResizeSensor.js] which is MIT licensed, with few 22 | patches 23 | https://github.com/marcj/css-element-queries/blob/master/src/ResizeSensor.js 24 | *) 25 | 26 | [%%client.start] 27 | 28 | open Js_of_ocaml 29 | 30 | (** {2 Get an event when an element's size changes} 31 | 32 | {3 Known issues} 33 | 34 | This only work with elements in the DOM (maybe that the element 35 | has to be displayd, need to check this). In case of a content 36 | loaded dynamically with js, watch a parent already thereif 37 | possible or use a [onnodeready] event to attach [noderesize] 38 | listener. 39 | 40 | Also, if the element is removed, then re-inserted in the DOM, sensor 41 | will not work anymore. 42 | 43 | If the element to be watched is not positionned, a [position: 44 | relative] will be applied. 45 | 46 | {3 Example} 47 | 48 | {[Lwt.async (fun () -> 49 | let div' = (To_dom.of_element div) in 50 | let%lwt () = Ot_nodeready.nodeready div' in 51 | Ot_noderesize.noderesize (ot_noderesize.attach div) (fun () -> 52 | Console.console##log (Js.string "Resized") ) )]} *) 53 | 54 | type resize_sensor 55 | 56 | val attach : #Dom_html.element Js.t -> resize_sensor 57 | 58 | val noderesize : ?safe:bool -> resize_sensor -> (unit -> unit) -> unit 59 | (** When [safe] is set to [true], [noderesize] will work whatever sized is 60 | the watched element. When set to [false] (which is the default), 61 | elements bigger than 9999px (width or height) will not detect resize, 62 | but noderesize will be more efficient (less computation/reading). *) 63 | 64 | val detach : resize_sensor -> unit 65 | -------------------------------------------------------------------------------- /src/widgets/ot_page_transition.eliom: -------------------------------------------------------------------------------- 1 | [%%client.start] 2 | 3 | open Js_of_ocaml 4 | open Js_of_ocaml_lwt 5 | open Eliom_content 6 | open Html 7 | open Html.D 8 | open Lwt.Syntax 9 | 10 | type animation = Nil | Forward | Backward 11 | 12 | module type PAGE_TRANSITION_CONF = sig 13 | type screenshot 14 | 15 | val screenshot_container : 16 | screenshot option 17 | -> Html_types.div_content Eliom_content.Html.elt 18 | end 19 | 20 | module URI : PAGE_TRANSITION_CONF with type screenshot = string = struct 21 | type screenshot = string 22 | 23 | let screenshot_container uri = 24 | let container = div ~a:[a_class ["ot-page-transition-ss-container"]] [] in 25 | let str = 26 | match uri with None -> "" | Some u -> Printf.sprintf "url(%s)" u 27 | in 28 | Manip.SetCss.backgroundImage container str; 29 | container 30 | end 31 | 32 | let set_transition_duration elt t = 33 | let s = Js.string (Printf.sprintf "%.2fs" t) in 34 | let container_style = Js.Unsafe.coerce (To_dom.of_element elt)##.style in 35 | container_style##.transitionDuration := s 36 | 37 | let cl_body_pre_forward = "ot-page-transition-body-pre-forward" 38 | let cl_wrapper_post_backward = "ot-page-transition-wrapper-post-backward" 39 | let cl_wrapper = "ot-page-transition-wrapper" 40 | let cl_screenshot_post_forward = "ot-page-transition-screenshot-post-forward" 41 | 42 | module Option = struct 43 | let may f = function Some x -> f x | None -> () 44 | end 45 | 46 | module Make (Conf : PAGE_TRANSITION_CONF) = struct 47 | type screenshot = Conf.screenshot 48 | 49 | let wrap_screenshot ?(a = []) ~transition_duration ~screenshot = 50 | let container = Conf.screenshot_container screenshot in 51 | let wrapper = div ~a:(a_class [cl_wrapper] :: a) [container] in 52 | set_transition_duration wrapper transition_duration; 53 | set_transition_duration container transition_duration; 54 | wrapper, container 55 | 56 | let forward_animation_ transition_duration screenshot = 57 | let body = Of_dom.of_body Dom_html.document##.body in 58 | let style = Js.Unsafe.coerce Dom_html.document##.body##.style in 59 | let initial_transition_duration = style##.transitionDuration in 60 | let screenshot_wrapper, screenshot_container = 61 | match screenshot with 62 | | Some screenshot -> 63 | let screenshot_wrapper, screenshot_container = 64 | wrap_screenshot 65 | ~a:[a_class ["ot-page-transition-wrapper-forward"]] 66 | ~transition_duration ~screenshot:(Some screenshot) 67 | in 68 | Some screenshot_wrapper, Some screenshot_container 69 | | None -> None, None 70 | in 71 | Eliom_client.lock_request_handling (); 72 | Option.may Manip.appendToBody screenshot_wrapper; 73 | Manip.Class.add body cl_body_pre_forward; 74 | let* () = Lwt_js_events.request_animation_frame () in 75 | let* () = Lwt_js_events.request_animation_frame () in 76 | set_transition_duration body transition_duration; 77 | Option.may 78 | (fun sc -> Manip.Class.add sc cl_screenshot_post_forward) 79 | screenshot_container; 80 | Manip.Class.remove body cl_body_pre_forward; 81 | let* () = Lwt_js.sleep transition_duration in 82 | Option.may Manip.removeSelf screenshot_wrapper; 83 | style##.transitionDuration := initial_transition_duration; 84 | Eliom_client.unlock_request_handling (); 85 | Lwt.return_unit 86 | 87 | let forward_animation ?(transition_duration = 0.5) take_screenshot = 88 | let wait_for_page_change, trigger_page_change = Lwt.wait () in 89 | Eliom_client.Page_status.oninactive ~once:true (fun () -> 90 | Lwt.wakeup trigger_page_change ()); 91 | let fa ss = 92 | Lwt.async @@ fun () -> 93 | let* () = wait_for_page_change in 94 | forward_animation_ transition_duration ss 95 | in 96 | let f screenshot = fa @@ Some screenshot in 97 | (try take_screenshot f with _ -> fa None); 98 | Lwt.return_unit 99 | 100 | let backward_animation_ transition_duration screenshot = 101 | let screenshot_wrapper, _ = 102 | wrap_screenshot 103 | ~a:[a_class ["ot-page-transition-wrapper-backward"]] 104 | ~transition_duration ~screenshot 105 | in 106 | Eliom_client.lock_request_handling (); 107 | Manip.appendToBody screenshot_wrapper; 108 | let* () = Lwt_js_events.request_animation_frame () in 109 | let* () = Lwt_js_events.request_animation_frame () in 110 | Manip.Class.add screenshot_wrapper cl_wrapper_post_backward; 111 | let* () = Lwt_js.sleep transition_duration in 112 | Manip.removeSelf screenshot_wrapper; 113 | Eliom_client.unlock_request_handling (); 114 | Lwt.return_unit 115 | 116 | let backward_animation ?(transition_duration = 0.5) take_screenshot = 117 | let wait_for_page_change, trigger_page_change = Lwt.wait () in 118 | Eliom_client.Page_status.oninactive ~once:true (fun () -> 119 | Lwt.wakeup trigger_page_change ()); 120 | let ba ss = 121 | Lwt.async @@ fun () -> 122 | let* () = wait_for_page_change in 123 | backward_animation_ transition_duration ss 124 | in 125 | let f screenshot = ba @@ Some screenshot in 126 | (try take_screenshot f with _ -> ba None); 127 | Lwt.return_unit 128 | 129 | let install_global_handler ?transition_duration ~take_screenshot 130 | ~animation_type 131 | = 132 | let rec hc_handler ev = 133 | Eliom_client.onchangepage hc_handler; 134 | match animation_type ev with 135 | | Nil -> Lwt.return_unit 136 | | Forward -> forward_animation ?transition_duration take_screenshot 137 | | Backward -> backward_animation ?transition_duration take_screenshot 138 | in 139 | Eliom_client.onchangepage hc_handler 140 | end 141 | 142 | let install_global_handler_withURI = 143 | let module Pt = Make (URI) in 144 | Pt.install_global_handler 145 | -------------------------------------------------------------------------------- /src/widgets/ot_page_transition.eliomi: -------------------------------------------------------------------------------- 1 | [%%client.start] 2 | (** This widget helps realize page transition with screenshots. *) 3 | 4 | (** The type of animation. [Nil] means there is no animation. 5 | [Forward] means going forward in history or loading a new page. 6 | Normally we will see a page come from the right side and cover 7 | the current page. [Backward] means going backward in history. In 8 | this case, the current page moves to the right side in order to 9 | display the page covered by it. *) 10 | type animation = Nil | Forward | Backward 11 | 12 | (** Suppose that screenshots are stored in objects of type [screenshot]. 13 | Users need to provide a module which specifies the type screenshot 14 | (e.g. string) and a function [screenshot_container] that creates 15 | a html element from the screenshot. 16 | *) 17 | module type PAGE_TRANSITION_CONF = sig 18 | type screenshot 19 | 20 | val screenshot_container : 21 | screenshot option 22 | -> Html_types.div_content Eliom_content.Html.elt 23 | end 24 | 25 | (** [install_global_handler t take_screenshot animation_type] 26 | creates a global onchangepage handler which is registered 27 | recursively and applies to all pages. [t] is the transition duration 28 | of the animation. [take_screenshot callback] takes a screenshot 29 | of the current page and then calls [callback]. A callback function 30 | is used here because [take_screenshot] is usually asynchronous. 31 | [animation_type ev] decides the type of the animation of page 32 | transition in an onchangepage event. 33 | 34 | TODO: we can avoid the callback function by transforming 35 | [take_screenshot] to a function of type [unit -> screenshot Lwt.t]*) 36 | module Make 37 | (Conf : PAGE_TRANSITION_CONF) : sig 38 | type screenshot 39 | 40 | val install_global_handler : 41 | ?transition_duration:float 42 | -> take_screenshot:((screenshot -> unit) -> unit) 43 | -> animation_type:(Eliom_client.changepage_event -> animation) 44 | -> unit 45 | end 46 | with type screenshot = Conf.screenshot 47 | 48 | val install_global_handler_withURI : 49 | ?transition_duration:float 50 | -> take_screenshot:((string -> unit) -> unit) 51 | -> animation_type:(Eliom_client.changepage_event -> animation) 52 | -> unit 53 | (** [install_global_handler_withURI] enables you to skip the step of 54 | creating a module of type [PAGE_TRANSITION_CONF] when screenshots 55 | are stored as a data uri. *) 56 | -------------------------------------------------------------------------------- /src/widgets/ot_picture_uploader.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015 BeSport, Julien Sagot 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%shared.start] 22 | 23 | open Js_of_ocaml 24 | 25 | (** {2 Picture uploader widget} 26 | 27 | [Ot_picture_uploader] allows the user to see a picture he wants to 28 | send to the before sending it server. Also, controllers can be 29 | added to allow the user to specify a cropping area. No cropping is 30 | actually done on the client side, it MUST be handled on server 31 | side. *) 32 | 33 | type cropping = (float * float * float * float) React.S.t 34 | 35 | type 'a upload = 36 | ?progress:(int -> int -> unit) 37 | -> ?cropping:cropping 38 | -> File.file Js.t 39 | -> 'a Lwt.t 40 | 41 | type ('a, 'b) service = 42 | ( unit 43 | , 'a * ((float * float * float * float) option * Eliom_lib.file_info) 44 | , Eliom_service.post 45 | , Eliom_service.non_att 46 | , Eliom_service.co 47 | , Eliom_service.non_ext 48 | , Eliom_service.reg 49 | , [`WithoutSuffix] 50 | , unit 51 | , [`One of 'a Eliom_parameter.ocaml] Eliom_parameter.param_name 52 | * ([`One of (float * float * float * float) option Eliom_parameter.ocaml] 53 | Eliom_parameter.param_name 54 | * [`One of Eliom_lib.file_info] Eliom_parameter.param_name) 55 | , 'b Eliom_service.ocaml ) 56 | Eliom_service.t 57 | (** a service that implements a function with type ['a -> 'b] *) 58 | 59 | [%%client.start] 60 | 61 | val ocaml_service_upload : service:('a, 'b) service -> arg:'a -> 'b upload 62 | 63 | val cropper : 64 | image:Dom_html.element Js.t Eliom_client_value.t 65 | -> ?ratio:float 66 | -> unit 67 | -> (unit -> unit) * cropping * [> `Div] Eliom_content.Html.elt 68 | (** [ let (reset, cropping, cropper_dom) = cropper ~image () ] 69 | [ reset ] is function to call to reset the current cropper status 70 | [ cropping ] are current cropping parameters 71 | [ cropper_dom ] is the div containing cropping controllers *) 72 | 73 | val bind_input : 74 | Dom_html.inputElement Js.t Eliom_client_value.t 75 | -> Dom_html.imageElement Js.t Eliom_client_value.t 76 | -> ?container:#Dom_html.element Js.t Eliom_client_value.t 77 | -> ?reset:(unit -> unit) 78 | -> unit 79 | -> unit 80 | (** [bind_input input preview ?container ?reset ()] 81 | Bind [input] and [preview] so the file selected in [input] is the 82 | image displayed in [preview]. 83 | [?container] is used to toggle [ot-no-file] class. 84 | [?reset] is called when the [input] value changes. *) 85 | 86 | val do_submit : 87 | Dom_html.inputElement Js.t Eliom_client_value.t 88 | -> ?progress:(int -> int -> unit) 89 | -> ?cropping:cropping 90 | -> upload:'a upload 91 | -> unit 92 | -> unit Lwt.t 93 | (** [ do_submit input ?cropping ~upload () ] 94 | [input] is the input with file loaded 95 | [cropping] are cropping info 96 | [upload] function to upload the file *) 97 | 98 | val bind_submit : 99 | Dom_html.inputElement Js.t Eliom_client_value.t 100 | -> #Dom_html.eventTarget Js.t Eliom_client_value.t 101 | -> ?cropping:cropping 102 | -> upload:'a upload 103 | -> after_submit:(unit -> unit Lwt.t) 104 | -> unit 105 | -> unit 106 | (** [ bind_submit input button ?cropping ~upload ~after_submit () ] 107 | binds the following two actions to [ button ] when it is being clicked: 108 | call [ do_submit ] which uploads the file; then call [ after_submit ] *) 109 | 110 | val bind : 111 | ?container:#Dom_html.element Js.t Eliom_client_value.t 112 | -> input:Dom_html.inputElement Js.t Eliom_client_value.t 113 | -> preview:Dom_html.imageElement Js.t 114 | -> ?crop:(unit -> unit) * cropping 115 | -> submit:#Dom_html.eventTarget Js.t Eliom_client_value.t 116 | -> upload:'a upload 117 | -> after_submit:(unit -> unit Lwt.t) 118 | -> unit 119 | -> unit 120 | (** [bind] is a shortcut for [bind_input] and [bind_submit] actions *) 121 | 122 | [%%shared.start] 123 | 124 | val input : 125 | ?a:[< Html_types.label_attrib > `Class] Eliom_content.Html.attrib list 126 | -> [< Html_types.label_content_fun] Eliom_content.Html.elt list 127 | -> [> `Input] Eliom_content.Html.elt * [> `Label] Eliom_content.Html.elt 128 | (** Create a file input element with good input type [ot-pup-input] class 129 | and wrap it into a label. 130 | Return (input node, label node) *) 131 | 132 | val preview : 133 | ?a:[< Html_types.img_attrib > `Class] Eliom_content.Html.attrib list 134 | -> unit 135 | -> [> `Img] Eliom_content.Html.elt 136 | (** Create a img element with no src, no alt and [ot-pup-preview] class. *) 137 | 138 | val submit : 139 | ?a:[< Html_types.button_attrib > `Class] Eliom_content.Html.attrib list 140 | -> [< Html_types.button_content] Eliom_content.Html.elt list 141 | -> [> `Button] Eliom_content.Html.elt 142 | (** Create a button with [ot-pup-sumit] clas *) 143 | 144 | val mk_form : 145 | ?after_submit:(unit -> unit Lwt.t) 146 | -> ?crop:float option 147 | -> ?input: 148 | [< Html_types.label_attrib > `Class] Eliom_content.Html.attrib list 149 | * [< Html_types.label_content_fun] Eliom_content.Html.elt list 150 | -> ?submit: 151 | [< Html_types.button_attrib > `Class] Eliom_content.Html.attrib list 152 | * [< Html_types.button_content_fun] Eliom_content.Html.elt list 153 | -> 'a upload 154 | -> [> `Form] Eliom_content.Html.elt Lwt.t 155 | (** Ready-to-use form. Customizable with 156 | [input], the input button content, [submit], the submit button content. 157 | If [crop] is present, cropping is enable, with the optional ratio it is. 158 | The last argument determines the method by which the file is uploaded. 159 | *) 160 | 161 | [%%server.start] 162 | 163 | val mk_service : string -> 'a Deriving_Json.t -> ('a, 'b) service 164 | (** [mk_service name arg_deriver] Create a named service taking 165 | [(arg_deriver, (cropping, file))] parameter *) 166 | -------------------------------------------------------------------------------- /src/widgets/ot_popup.eliom: -------------------------------------------------------------------------------- 1 | [%%shared 2 | (* Ocsigen 3 | * http://www.ocsigen.org 4 | * 5 | * Copyright (C) 2015 6 | * Vincent Balat 7 | * 8 | * This program is free software; you can redistribute it and/or modify 9 | * it under the terms of the GNU Lesser General Public License as published by 10 | * the Free Software Foundation, with linking exception; 11 | * either version 2.1 of the License, or (at your option) any later version. 12 | * 13 | * This program is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | * GNU Lesser General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU Lesser General Public License 19 | * along with this program; if not, write to the Free Software 20 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 21 | *) 22 | open Eliom_content.Html] 23 | 24 | [%%shared open Eliom_content.Html.F] 25 | open%client Js_of_ocaml 26 | open%client Lwt.Syntax 27 | [%%client open Js_of_ocaml_lwt] 28 | 29 | let%shared hcf ?(a = []) ?(header = []) ?(footer = []) content = 30 | D.section 31 | ~a:(a_class ["ot-hcf"] :: (a :> Html_types.div_attrib attrib list)) 32 | [ F.header ~a:[a_class ["ot-hcf-header"]] header 33 | ; div ~a:[a_class ["ot-hcf-content"]] content 34 | ; F.footer ~a:[a_class ["ot-hcf-footer"]] footer ] 35 | 36 | let%client disable_page_scroll, enable_page_scroll = 37 | let scroll_pos = ref None in 38 | let html () = 39 | Js.Opt.to_option 40 | @@ Js.Opt.map 41 | (Dom_html.CoerceTo.html Dom_html.document##.documentElement) 42 | Of_dom.of_html 43 | in 44 | let html_ManipClass_add html cl = 45 | match html with Some html -> Manip.Class.add html cl | None -> () 46 | in 47 | let html_ManipClass_remove html cl = 48 | match html with Some html -> Manip.Class.remove html cl | None -> () 49 | in 50 | ( (fun () -> 51 | if !scroll_pos = None 52 | then ( 53 | let pos = (Js.Unsafe.coerce Dom_html.window)##.pageYOffset in 54 | scroll_pos := Some pos; 55 | html_ManipClass_add (html ()) "ot-with-popup"; 56 | Dom_html.document##.body##.style##.top 57 | := Js.string (Printf.sprintf "%dpx" (-pos)))) 58 | , fun () -> 59 | match !scroll_pos with 60 | | None -> () 61 | | Some pos -> 62 | html_ManipClass_remove (html ()) "ot-with-popup"; 63 | Dom_html.document##.body##.style##.top := Js.string ""; 64 | Dom_html.window##scrollTo (Js.float 0.) (Js.float (float pos)); 65 | scroll_pos := None ) 66 | 67 | let%client popup ?(a = []) ?(enable_scrolling_hack = true) ?close_button 68 | ?confirmation_onclose ?(onclose = fun () -> Lwt.return_unit) 69 | ?(close_on_background_click = false) 70 | ?(close_on_escape = close_button <> None) gen_content 71 | = 72 | let a = (a :> Html_types.div_attrib attrib list) in 73 | let gen_content = 74 | (gen_content :> (unit -> unit Lwt.t) -> Html_types.div_content elt Lwt.t) 75 | in 76 | let popup = ref None in 77 | let stop, stop_thread = React.E.create () in 78 | Eliom_client.Page_status.onactive ~stop (fun () -> 79 | if enable_scrolling_hack then disable_page_scroll ()); 80 | let reset () = if enable_scrolling_hack then enable_page_scroll () in 81 | let do_close () = 82 | if (Dom_html.document##getElementsByClassName (Js.string "ot-popup"))##.length 83 | = 1 84 | then reset (); 85 | let () = Eliom_lib.Option.iter Manip.removeSelf !popup in 86 | stop_thread (); onclose () 87 | in 88 | Eliom_client.Page_status.oninactive ~stop reset; 89 | let close () = 90 | match confirmation_onclose with 91 | | None -> do_close () 92 | | Some f -> 93 | Lwt.bind (f ()) (function 94 | | true -> do_close () 95 | | false -> Lwt.return_unit) 96 | in 97 | (* FIXME: use a list for gen_content return type *) 98 | let* c = 99 | Ot_spinner.with_spinner 100 | ~a:[a_class ["ot-popup-content"]] 101 | (Lwt.map (fun x -> [x]) (gen_content do_close)) 102 | in 103 | let content = [c] in 104 | let content = 105 | match close_button with 106 | | Some but -> 107 | button 108 | ~a: 109 | [ a_button_type `Button 110 | ; a_class ["ot-popup-close"] 111 | ; a_onclick (fun ev -> Lwt.async (fun () -> close ())) ] 112 | but 113 | :: content 114 | | None -> content 115 | in 116 | let pop = D.div ~a:[a_class ["ot-popup"]] content in 117 | let box = D.div ~a:(a_class ["ot-popup-background"] :: a) [pop] in 118 | let box_dom = Eliom_content.Html.To_dom.of_element box in 119 | if close_on_background_click 120 | then 121 | Eliom_client.Page_status.while_active ~stop (fun () -> 122 | (* Close the popup when user clicks on background *) 123 | let* event = Lwt_js_events.click box_dom in 124 | if event##.target = Js.some box_dom then close () else Lwt.return_unit); 125 | if close_on_escape 126 | then 127 | Eliom_client.Page_status.while_active ~stop (fun () -> 128 | Lwt_js_events.keydowns Dom_html.window @@ fun ev _ -> 129 | if ev##.keyCode = 27 then close () else Lwt.return_unit); 130 | popup := Some box; 131 | Manip.appendToBody box; 132 | Lwt.return box 133 | 134 | let%client ask_question ?a ?a_hcf ~header ~buttons contents = 135 | let t, w = Lwt.wait () in 136 | let* _ = 137 | popup ?a (fun do_close -> 138 | let answers = 139 | List.map 140 | (fun (content, action, btn_class) -> 141 | let btn = D.Raw.button ~a:[a_class btn_class] content in 142 | (* Onlick, give t the selected value 143 | and close question popup. *) 144 | Lwt.async (fun () -> 145 | Lwt_js_events.clicks (To_dom.of_element btn) (fun _ _ -> 146 | let* r = action () in 147 | let* result = do_close () in 148 | Lwt.wakeup w r; Lwt.return result)); 149 | btn) 150 | buttons 151 | in 152 | Lwt.return (hcf ?a:a_hcf ~header ~footer:answers contents)) 153 | in 154 | t 155 | 156 | let%client confirm ?(a = []) question yes no = 157 | let a = (a :> Html_types.div_attrib attrib list) in 158 | ask_question 159 | ~a:(a_class ["ot-popup-confirmation"] :: a) 160 | ~header:question 161 | ~buttons: 162 | [ yes, (fun () -> Lwt.return_true), ["ot-popup-yes"] 163 | ; no, (fun () -> Lwt.return_false), ["ot-popup-no"] ] 164 | [] 165 | -------------------------------------------------------------------------------- /src/widgets/ot_popup.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * 4 | * Copyright (C) 2015 5 | * Vincent Balat 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%shared.start] 23 | 24 | (** Popup widget *) 25 | 26 | open Eliom_content.Html 27 | open Html_types 28 | 29 | val hcf : 30 | ?a:[< div_attrib] attrib list 31 | -> ?header:[< header_content_fun] elt list 32 | -> ?footer:[< footer_content_fun] elt list 33 | -> [< div_content] elt list 34 | -> [> `Section] elt 35 | (** Section with header, content and footer. 36 | [header] and [footer] are empty by default 37 | This is just a short 38 | Header and footer can be empty (default) and 39 | have fix size. Content has scrollbar if too high. *) 40 | 41 | [%%client.start] 42 | 43 | val popup : 44 | ?a:[< div_attrib] attrib list 45 | -> ?enable_scrolling_hack:bool 46 | -> ?close_button:button_content elt list 47 | -> ?confirmation_onclose:(unit -> bool Lwt.t) 48 | -> ?onclose:(unit -> unit Lwt.t) 49 | -> ?close_on_background_click:bool 50 | -> ?close_on_escape:bool 51 | -> ((unit -> unit Lwt.t) -> [< div_content] elt Lwt.t) 52 | -> [> `Div] elt Lwt.t 53 | (** [ popup ?a ?enable_scrolling_hack 54 | ?close_button ?confirmation_onclose ?onclose gen_content ] 55 | Display a modal popup. 56 | Returns the popup container, in case you need it. 57 | 58 | [enable_scrolling_hack] (default: [true]) toggle the hack setting 59 | popup background (body) to [fixed] when popups open 60 | 61 | Use [close_button] if you want to add a button to close the popup. 62 | 63 | [confirmation_on_close] is used to ask confirmation to the user 64 | when closing the popup with the close button. Only relevant if 65 | one of [close_button], [close_on_background_click], [close_on_escape] 66 | is supplied. 67 | 68 | [onclose] is a hook called just after the popup has been actually closed. 69 | 70 | [gen_content] is a function taking the function closing the popup as 71 | parameter, and returning the popup content. 72 | 73 | If [close_on_background_click] (default: false) is true then clicking on the 74 | background of the popup closes it. 75 | 76 | If [close_on_escape] (default: true if [close_button] is supplied) then 77 | hitting the escape key will close the popup. 78 | *) 79 | 80 | val ask_question : 81 | ?a:[< div_attrib] attrib list 82 | -> ?a_hcf:[< div_attrib] attrib list 83 | -> header:[< header_content] elt list 84 | -> buttons: 85 | ([< button_content_fun] elt list * (unit -> 'a Lwt.t) * string list) list 86 | -> [< div_content] elt list 87 | -> 'a Lwt.t 88 | (** [ask_question ?a ?a_hcf question buttons] 89 | Prompt a user, wait for its response and return the selected value. 90 | [question] is the content of the popup header 91 | [buttons] is the list of available answers. Each button is a triple 92 | of [(content, action, classes)]. [action ()] is called to return the 93 | value when the corresponding button is clicked. *) 94 | 95 | val confirm : 96 | ?a:[< div_attrib] attrib list 97 | -> [< header_content_fun] elt list 98 | -> ([< button_content_fun] as 'a) elt list 99 | -> 'a elt list 100 | -> bool Lwt.t 101 | (** Shortcut using [ask_question] for prompting the user with a question 102 | and returning a boolean. 103 | [confirm ?a question yes no] 104 | [a] is a traditional optional attributes to add to the popup 105 | [question] is the content of the popup header 106 | [yes] is the content of the 'yes' button (returning true) 107 | [no] is the content of the 'no' button (returning false) *) 108 | 109 | val enable_page_scroll : unit -> unit 110 | (** Allows to fix the body manually (see [?enable_scrolling_hack] above) *) 111 | 112 | val disable_page_scroll : unit -> unit 113 | (** Disable body scrolling hack *) 114 | -------------------------------------------------------------------------------- /src/widgets/ot_pulltorefresh.eliom: -------------------------------------------------------------------------------- 1 | [%%shared.start] 2 | 3 | type state = Pulling | Ready | Loading | Succeeded | Failed 4 | 5 | [%%client open Eliom_content.Html] 6 | 7 | open Eliom_content.Html.D 8 | 9 | let%shared default_header = 10 | let open Eliom_content.Html in 11 | function 12 | | Some Loading -> [F.div ~a:[F.a_class ["ot-icon-animation-spinning"]] []] 13 | | _ -> [] 14 | 15 | [%%client 16 | open Js_of_ocaml 17 | open Lwt.Syntax 18 | 19 | module type CONF = sig 20 | val dragThreshold : float 21 | val scale : float 22 | val container : Html_types.div Eliom_content.Html.D.elt 23 | val set_state : ?step:React.step -> state option -> unit 24 | val timeout : float 25 | val afterPull : unit -> bool Lwt.t 26 | end 27 | 28 | module Make (Conf : CONF) = struct 29 | let dragThreshold = Conf.dragThreshold 30 | let dragStart = ref (-1.) 31 | let scrollXStart = ref (-1.) 32 | let distance = ref 0. 33 | let scale = Conf.scale 34 | let top = ref true 35 | let scrollingX = ref false 36 | let joinRefreshFlag = ref false 37 | let refreshFlag = ref false 38 | let first_move = ref false 39 | let container = Conf.container 40 | let js_container = To_dom.of_element container 41 | 42 | let scroll_handler () = 43 | let _, y = Dom_html.getDocumentScroll () in 44 | if y > 0. then top := false else top := true 45 | 46 | let touchstart_handler ev _ = 47 | Dom_html.stopPropagation ev; 48 | (if !refreshFlag || !joinRefreshFlag 49 | then Dom.preventDefault ev 50 | else 51 | let touch = ev##.changedTouches##item 0 in 52 | Js.Optdef.iter touch (fun touch -> 53 | dragStart := Js.to_float touch##.clientY; 54 | scrollXStart := Js.to_float touch##.clientX); 55 | first_move := true; 56 | Manip.Class.remove container "ot-pull-refresh-transition-on"); 57 | Lwt.return_unit 58 | 59 | let touchmove_handler_ ev = 60 | Dom.preventDefault ev; 61 | let translateY = !distance in 62 | joinRefreshFlag := true; 63 | if !distance > dragThreshold 64 | then Conf.set_state @@ Some Ready 65 | else Conf.set_state @@ Some Pulling; 66 | js_container##.style##.transform 67 | := Js.string ("translateY(" ^ string_of_float translateY ^ "px)") 68 | 69 | let touchmove_handler ev _ = 70 | scroll_handler (); 71 | if not !scrollingX 72 | then ( 73 | Dom_html.stopPropagation ev; 74 | if !dragStart >= 0. 75 | then 76 | if !refreshFlag 77 | then Dom.preventDefault ev 78 | else if ev##.touches##.length = 1 79 | then ( 80 | let target = ev##.changedTouches##item 0 in 81 | Js.Optdef.iter target (fun target -> 82 | let dY = -. !dragStart +. Js.to_float target##.clientY in 83 | distance := Float.sqrt dY *. scale; 84 | if !first_move 85 | then 86 | scrollingX := 87 | abs_float (!scrollXStart -. Js.to_float target##.clientX) 88 | > abs_float dY); 89 | (*move the container if and only if at the top of the document and 90 | the page is scrolled down*) 91 | if !top && !distance > 0. && not !scrollingX 92 | then touchmove_handler_ ev 93 | else joinRefreshFlag := false)); 94 | first_move := false; 95 | Lwt.return_unit 96 | 97 | let refresh () = 98 | Conf.set_state @@ Some Loading; 99 | Manip.Class.add container "ot-pull-refresh-transition-on"; 100 | js_container##.style##.transform 101 | := Js.string 102 | ("translateY(" ^ (string_of_float @@ Conf.dragThreshold) ^ "px)"); 103 | refreshFlag := true; 104 | Lwt.async (fun () -> 105 | let* b = 106 | Lwt.pick 107 | [ Conf.afterPull () 108 | ; (let* () = Js_of_ocaml_lwt.Lwt_js.sleep Conf.timeout in 109 | Lwt.return_false) ] 110 | in 111 | if b 112 | then 113 | (*if page refresh succeeds*) 114 | ignore 115 | (Dom_html.window##setTimeout 116 | (Js.wrap_callback (fun () -> 117 | Conf.set_state @@ Some Succeeded; 118 | js_container##.style##.transform := Js.string "translateY(0)"; 119 | refreshFlag := false)) 120 | (Js.float 700.)) 121 | (*if the page refreshing finishes instantaneously, 122 | setTimeout is used to show the animation*) 123 | else ( 124 | (*if page refresh fails*) 125 | Conf.set_state @@ Some Failed; 126 | js_container##.style##.transform := Js.string "translateY(0)"; 127 | ignore 128 | (Dom_html.window##setTimeout 129 | (Js.wrap_callback (fun () -> refreshFlag := false)) 130 | (Js.float 500.))); 131 | Lwt.return_unit) 132 | 133 | let scroll_back () = 134 | Conf.set_state None; 135 | (*scroll back to top if |percentage| < dragThreshold*) 136 | if !joinRefreshFlag 137 | then ( 138 | Manip.Class.add container "ot-pull-refresh-transition-on"; 139 | js_container##.style##.transform := Js.string "translateY(0)"; 140 | ignore 141 | (Dom_html.window##setTimeout 142 | (Js.wrap_callback (fun () -> refreshFlag := false)) 143 | (Js.float 500.))) 144 | 145 | let touchend_handler ev _ = 146 | if !top && !distance > 0. && !dragStart >= 0. 147 | then 148 | if !refreshFlag 149 | then Dom.preventDefault ev 150 | else ( 151 | if !distance > dragThreshold && !joinRefreshFlag 152 | then refresh () 153 | else scroll_back (); 154 | (*reinitialize paramaters*) 155 | joinRefreshFlag := false; 156 | dragStart := -1.; 157 | distance := 0.); 158 | scrollXStart := -1.; 159 | scrollingX := false; 160 | Lwt.return_unit 161 | 162 | let init () = 163 | let open Js_of_ocaml_lwt.Lwt_js_events in 164 | Lwt.async (fun () -> touchstarts js_container touchstart_handler); 165 | Lwt.async (fun () -> touchmoves js_container touchmove_handler); 166 | Lwt.async (fun () -> touchends js_container touchend_handler); 167 | Lwt.async (fun () -> touchcancels js_container touchend_handler) 168 | end] 169 | 170 | let make ?(a = []) ?(app_only = true) ?(scale = 5.) ?(dragThreshold = 80.) 171 | ?(refresh_timeout = 20.) ?(header = [%shared default_header]) ~content 172 | (afterPull : (unit -> bool Lwt.t) Eliom_client_value.t) 173 | = 174 | if app_only && not (Eliom_client.is_client_app ()) 175 | then div ~a [content] 176 | else 177 | let state_s, set_state = Eliom_shared.React.S.create None in 178 | let headContainer = 179 | Eliom_content.Html.R.node 180 | @@ Eliom_shared.React.S.map 181 | [%shared 182 | let open Eliom_content.Html in 183 | fun s -> 184 | D.div ~a:[D.a_class ["ot-pull-refresh-head-container"]] 185 | @@ Eliom_shared.Value.local ~%header 186 | @@ s] 187 | state_s 188 | in 189 | let container = 190 | div ~a:[a_class ["ot-pull-refresh-container"]] [headContainer; content] 191 | in 192 | ignore 193 | [%client 194 | (let module Ptr_conf = struct 195 | let set_state = ~%set_state 196 | let scale = ~%scale 197 | let dragThreshold = ~%dragThreshold 198 | let timeout = ~%refresh_timeout 199 | let container = ~%container 200 | let afterPull = ~%afterPull 201 | end 202 | in 203 | let module Ptr = Make (Ptr_conf) in 204 | Ptr.init () 205 | : unit)]; 206 | let open Eliom_content.Html in 207 | F.div ~a:(F.a_class ["ot-pull-refresh-wrapper"] :: a) [container] 208 | -------------------------------------------------------------------------------- /src/widgets/ot_pulltorefresh.eliomi: -------------------------------------------------------------------------------- 1 | [%%shared.start] 2 | 3 | (** Pull to refresh 4 | This widget can handle any element that needs to be refreshed 5 | after being pulled down. 6 | *) 7 | 8 | (** Represents the state of the gesture behavior. 9 | `Pulling` happens while the motion hasn't reached the threshold. 10 | `Ready` happens while releasing the fingers will trigger the event. 11 | `Succeeded` happens for a short time after a sucessfull event. 12 | `Failed` happens for a short time after a failed event. 13 | *) 14 | type state = Pulling | Ready | Loading | Succeeded | Failed 15 | 16 | val make : 17 | ?a:[< Html_types.div_attrib > `Class] Eliom_content.Html.attrib list 18 | -> ?app_only:bool 19 | -> ?scale:float 20 | -> ?dragThreshold:float 21 | -> ?refresh_timeout:float 22 | -> ?header: 23 | (state option 24 | -> ([< Html_types.div_content_fun > `Div] as 'a) Eliom_content.Html.elt 25 | list) 26 | Eliom_shared.Value.t 27 | -> content:'a Eliom_content.Html.elt 28 | -> (unit -> bool Lwt.t) Eliom_client_value.t 29 | -> 'a Eliom_content.Html.elt 30 | (** 31 | Creates a pull-to-refresh container from an html element. 32 | [?a] is the attribute array of the returned element 33 | [?app_only] specifies whether to activate the behavior only in the mobile app 34 | or also do it in a browser. Useful if you want refreshable contents 35 | in your page that should also work inside a mobile browser. 36 | (default true) 37 | [?scale] is the scaling factor of the drag motion. 38 | Higher values means the page will follow the motion of the finger 39 | more closely. 40 | (default 5) 41 | [?dragThreshold] is a threshold. The container will be refreshed if the 42 | motion distance goes above the specified threshold 43 | (default 80px). 44 | [?refresh_timeout] is the maximum amount of seconds 45 | to wait for the reload to happen. 46 | If there is a connection error or some other error, 47 | this duration is how long to wait for a response. 48 | (default 20s) 49 | [?header] is a function defining what to display in 50 | the space revealed when pulling the page down, depending on the state of 51 | the gesture. 52 | IMPORTANT NOTE: Because of the way this module is implemented, 53 | that space needs a fixed height. 54 | If you want to give a custom display function, you also need to 55 | re-style the class `ot-pull-refresh-head-container` 56 | to override its height and top-margin. 57 | (default displays a spinner until success or failure) 58 | [content] is the html element from which the container is created. 59 | Finally, user needs to provide an [afterPull] function to refresh the 60 | container. 61 | *) 62 | -------------------------------------------------------------------------------- /src/widgets/ot_range.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2015 4 | * Vasilis Papavasileiou 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%shared.start] (* shared by default, override as necessary *) 22 | 23 | open Eliom_content.Html 24 | open Eliom_shared.React.S.Infix 25 | 26 | let display_aux (_, _, a) v = 27 | let v = match a with Some a -> a.(v) | None -> string_of_int v 28 | and a = [D.a_class ["ot-r-value"]] in 29 | D.div ~a [D.txt v] 30 | 31 | let%client go_up (lb, ub, a) r (f : ?step:_ -> _) = 32 | let v = Eliom_shared.React.S.value r in 33 | assert (v <= ub - 1); 34 | f (if v = ub - 1 then lb else v + 1) 35 | 36 | let%client go_down (lb, ub, a) r (f : ?step:_ -> _) = 37 | let v = Eliom_shared.React.S.value r in 38 | assert (v >= lb); 39 | f (if v = lb then ub - 1 else v - 1) 40 | 41 | let display_aux e r = r >|= [%shared display_aux ~%e] |> R.node 42 | 43 | let display ?(txt_up = "up") ?(txt_down = "down") e (v, f) = 44 | let open D in 45 | div 46 | ~a:[a_class ["ot-range"]] 47 | [ div 48 | ~a: 49 | [ a_class ["ot-r-up"] 50 | ; a_onclick [%client (fun _ -> go_up ~%e ~%v ~%f : _ -> _)] ] 51 | [txt txt_up] 52 | ; display_aux e v 53 | ; div 54 | ~a: 55 | [ a_class ["ot-r-down"] 56 | ; a_onclick [%client (fun _ -> go_down ~%e ~%v ~%f : _ -> _)] ] 57 | [txt txt_down] ] 58 | 59 | let make ?txt_up ?txt_down ?f ?(lb = 0) ub = 60 | assert (ub > lb); 61 | let ((v, _) as rp) = Eliom_shared.React.S.create lb 62 | and a = 63 | match f with 64 | | Some f -> 65 | let f i = f (i + lb) in 66 | Some (Array.init (ub - lb) f) 67 | | None -> None 68 | in 69 | display ?txt_up ?txt_down (lb, ub, a) rp, v 70 | -------------------------------------------------------------------------------- /src/widgets/ot_range.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2015 4 | * Vasilis Papavasileiou 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%shared.start] 22 | 23 | (** Range selection widget *) 24 | 25 | val make : 26 | ?txt_up:string 27 | -> ?txt_down:string 28 | -> ?f:(int -> string) 29 | -> ?lb:int 30 | -> int 31 | -> [> `Div] Eliom_content.Html.elt * int Eliom_shared.React.S.t 32 | (** [make ?txt_up ?txt_down ~f ~lb ub] produces a widget for picking 33 | one of the values in [\[lb, ub)] via "up" and "down" buttons marked 34 | with the text [txt_up] and [txt_down]. [f i] provides the text 35 | displayed for the [i]-th value, for [i] in [\[lb, ub)]. *) 36 | -------------------------------------------------------------------------------- /src/widgets/ot_size.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen-toolkit 2 | * http://www.ocsigen.org/ocsigen-toolkit 3 | * 4 | * Copyright (C) 2014 Université Paris Diderot 5 | * Charly Chevalier 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%client.start] 23 | 24 | open Js_of_ocaml 25 | open Js_of_ocaml_lwt 26 | 27 | (* size and orientation *) 28 | type orientation = Portrait | Landscape 29 | 30 | let get_screen_size () = 31 | let scr = Dom_html.window##.screen in 32 | scr##.width, scr##.height 33 | 34 | let get_screen_orientation () = 35 | let width, height = get_screen_size () in 36 | if width <= height then Portrait else Landscape 37 | 38 | let get_size dom_html = dom_html##.clientWidth, dom_html##.clientHeight 39 | let get_document_size () = get_size Dom_html.document##.documentElement 40 | 41 | (* No: this must be recomputed every time, 42 | otherwise it won't work after a change page 43 | -- Vincent 44 | let page = Dom_html.document##documentElement 45 | *) 46 | 47 | let wh, set_wh = 48 | let page = Dom_html.document##.documentElement in 49 | React.S.create (page##.clientWidth, page##.clientHeight) 50 | 51 | let update_width_height () = 52 | let page = Dom_html.document##.documentElement in 53 | let w = page##.clientWidth in 54 | let h = page##.clientHeight in 55 | set_wh (w, h) 56 | 57 | let width_height, width, height = 58 | (* TODO: MutationObserver? *) 59 | (let open Lwt_js_events in 60 | async @@ fun () -> 61 | onresizes @@ fun _ _ -> Lwt.return @@ update_width_height ()); 62 | let w = React.S.l1 fst wh in 63 | let h = React.S.l1 snd wh in 64 | (* Make sure the signals are not destroyed indirectly 65 | by a call to React.S.stop *) 66 | ignore (React.S.map (fun _ -> ()) w); 67 | ignore (React.S.map (fun _ -> ()) h); 68 | wh, w, h 69 | 70 | let set_adaptative_width elt f = 71 | Eliom_lib.Dom_reference.retain elt 72 | ~keep: 73 | (React.S.map 74 | (fun w -> 75 | elt##.style##.width := Js.string (string_of_int (f w) ^ "px")) 76 | height) 77 | 78 | let set_adaptative_height elt f = 79 | Eliom_lib.Dom_reference.retain elt 80 | ~keep: 81 | (React.S.map 82 | (fun w -> 83 | elt##.style##.height := Js.string (string_of_int (f w) ^ "px")) 84 | height) 85 | 86 | let of_opt elt = Js.Opt.case elt (fun () -> failwith "of_opt") (fun x -> x) 87 | 88 | let height_to_bottom offset elt = 89 | let page = Dom_html.document##.documentElement in 90 | let h = page##.clientHeight in 91 | try 92 | let top = Js.to_float (of_opt elt ## getClientRects ## (item 0))##.top in 93 | h - int_of_float top - offset 94 | with Failure _ -> h - offset 95 | 96 | let client_top ?(with_margin = false) elt = 97 | Js.to_float elt##getBoundingClientRect##.top 98 | -. if with_margin then Ot_style.marginTop elt else 0.0 99 | 100 | let client_bottom ?(with_margin = false) elt = 101 | Js.to_float elt##getBoundingClientRect##.bottom 102 | +. if with_margin then Ot_style.marginBottom elt else 0.0 103 | 104 | let client_left ?(with_margin = false) elt = 105 | Js.to_float elt##getBoundingClientRect##.left 106 | -. if with_margin then Ot_style.marginLeft elt else 0.0 107 | 108 | let client_right ?(with_margin = false) elt = 109 | Js.to_float elt##getBoundingClientRect##.right 110 | +. if with_margin then Ot_style.marginRight elt else 0.0 111 | 112 | let client_height ?(with_margin = false) elt = 113 | client_bottom ~with_margin elt -. client_top ~with_margin elt 114 | 115 | let client_width ?(with_margin = false) elt = 116 | client_right ~with_margin elt -. client_left ~with_margin elt 117 | 118 | let client_page_top ?with_margin elt = 119 | client_top ?with_margin elt 120 | -. Js.to_float Dom_html.document##.body##getBoundingClientRect##.top 121 | 122 | let client_page_left ?with_margin elt = 123 | client_left elt ?with_margin 124 | -. Js.to_float Dom_html.document##.body##getBoundingClientRect##.left 125 | 126 | let client_page_bottom ?with_margin elt = 127 | Js.to_float Dom_html.document##.body##getBoundingClientRect##.bottom 128 | -. client_bottom ?with_margin elt 129 | 130 | let client_page_right ?with_margin elt = 131 | Js.to_float Dom_html.document##.body##getBoundingClientRect##.left 132 | -. client_right elt ?with_margin 133 | 134 | let pageYOffset () = 135 | (* absolute vertical scroll position *) 136 | let get_clientHeight () = 137 | Dom_html.document##.documentElement##.clientHeight 138 | in 139 | (* on some browsers innerHeight is not available -> fall back to clientHeight *) 140 | let get_innerHeight () = 141 | try (Js.Unsafe.coerce Dom_html.window)##.innerHeight 142 | with _ -> get_clientHeight () 143 | in 144 | max 0 145 | @@ (* overscroll at the top *) 146 | min (* overscroll at the bottom *) 147 | (Dom_html.document##.documentElement##.scrollHeight - get_innerHeight ()) 148 | (Js.Unsafe.coerce Dom_html.window)##.pageYOffset 149 | -------------------------------------------------------------------------------- /src/widgets/ot_size.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen-toolkit 2 | * http://www.ocsigen.org/ocsigen-toolkit 3 | * 4 | * Copyright (C) 2014 Université Paris Diderot 5 | * Charly Chevalier 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%client.start] 23 | 24 | open Js_of_ocaml 25 | 26 | (** {2 Size functions for Dom elements} 27 | 28 | {3 Size and orientation} *) 29 | 30 | type orientation = Portrait | Landscape 31 | 32 | val get_screen_size : unit -> int * int 33 | val get_screen_orientation : unit -> orientation 34 | 35 | val get_size : 36 | < clientHeight : < get : int ; .. > Js.gen_prop 37 | ; clientWidth : < get : int ; .. > Js.gen_prop 38 | ; .. > 39 | Js.t 40 | -> int * int 41 | 42 | val get_document_size : unit -> int * int 43 | 44 | val width_height : (int * int) React.signal 45 | (** NOTE: mind to stop any signals derived from the following signals (using 46 | [React.S.stop]) on unload. *) 47 | 48 | val width : int React.signal 49 | val height : int React.signal 50 | val update_width_height : unit -> unit 51 | 52 | val set_adaptative_width : #Dom_html.element Js.t -> (int -> int) -> unit 53 | (** [set_adaptative_width elt f] will make the width of the element 54 | recomputed using [f] everytime the width of the window changes. *) 55 | 56 | val set_adaptative_height : #Dom_html.element Js.t -> (int -> int) -> unit 57 | (** [set_adaptative_height elt f] will make the width of the element 58 | recomputed using [f] everytime the height of the window changes. *) 59 | 60 | val height_to_bottom : int -> #Dom_html.element Js.t -> int 61 | (** Compute the height of an element to the bottom of the page *) 62 | 63 | val client_top : ?with_margin:bool -> #Dom_html.element Js.t -> float 64 | (** position of an element relative to the inner window; 65 | getClientBoundingRect does not include borders by default, use [with_margin] 66 | to take them into account. 67 | *) 68 | 69 | val client_bottom : ?with_margin:bool -> #Dom_html.element Js.t -> float 70 | val client_left : ?with_margin:bool -> #Dom_html.element Js.t -> float 71 | val client_right : ?with_margin:bool -> #Dom_html.element Js.t -> float 72 | 73 | val client_height : ?with_margin:bool -> #Dom_html.element Js.t -> float 74 | (** size of an element *) 75 | 76 | val client_width : ?with_margin:bool -> #Dom_html.element Js.t -> float 77 | 78 | val client_page_top : ?with_margin:bool -> #Dom_html.element Js.t -> float 79 | (** position of an element relative to the document *) 80 | 81 | val client_page_left : ?with_margin:bool -> #Dom_html.element Js.t -> float 82 | val client_page_bottom : ?with_margin:bool -> #Dom_html.element Js.t -> float 83 | val client_page_right : ?with_margin:bool -> #Dom_html.element Js.t -> float 84 | 85 | val pageYOffset : unit -> int 86 | (** Current vertical scroll position of the page. *) 87 | -------------------------------------------------------------------------------- /src/widgets/ot_spinner.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen Toolkit 2 | * http://www.ocsigen.org/ocsigen-toolkit 3 | * 4 | * Copyright (C) 2014 5 | * Vincent Balat 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | open%client Js_of_ocaml 23 | [%%shared open Eliom_content.Html] 24 | [%%shared open Lwt.Syntax] 25 | [%%shared open Eliom_content.Html.F] 26 | [%%client open Eliom_shared] 27 | 28 | let%shared default_fail_fun e = 29 | [ (if Eliom_config.get_debugmode () 30 | then em [txt (Printexc.to_string e)] 31 | else 32 | let e = Printexc.to_string e in 33 | ignore 34 | [%client 35 | (Console.console##error 36 | (Js.string ("Ot_spinner content failed with " ^ ~%e)) 37 | : unit)]; 38 | em ~a:[a_class ["ot-icon-error"]] []) ] 39 | 40 | let%shared default_fail_ref : 41 | (exn -> Html_types.div_content Eliom_content.Html.elt list) ref 42 | = 43 | ref default_fail_fun 44 | 45 | let%shared default_fail e = 46 | (!default_fail_ref e 47 | : Html_types.div_content Eliom_content.Html.elt list 48 | :> [< Html_types.div_content] Eliom_content.Html.elt list) 49 | 50 | let%client set_default_fail f = 51 | default_fail_ref := 52 | (f 53 | : exn -> [< Html_types.div_content] Eliom_content.Html.elt list 54 | :> exn -> Html_types.div_content Eliom_content.Html.elt list) 55 | 56 | let%server with_spinner ?(a = []) ?spinner:_ ?fail thread = 57 | let a = (a :> Html_types.div_attrib attrib list) in 58 | let fail = 59 | ((match fail with 60 | | Some fail -> (fail :> exn -> Html_types.div_content elt list Lwt.t) 61 | | None -> fun e -> Lwt.return (default_fail e)) 62 | :> exn -> Html_types.div_content elt list Lwt.t) 63 | in 64 | let* v = 65 | Lwt.catch 66 | (fun () -> 67 | let* v = thread in 68 | Lwt.return (v :> Html_types.div_content_fun F.elt list)) 69 | (fun e -> 70 | let* v = fail e in 71 | Lwt.return (v :> Html_types.div_content_fun F.elt list)) 72 | in 73 | Lwt.return (D.div ~a:(a_class ["ot-spinner"] :: a) v) 74 | 75 | [%%client 76 | let num_active_spinners, set_num_active_spinners = React.S.create 0 77 | let onloaded, set_onloaded = React.E.create () 78 | 79 | (* Make sure the signal is not destroyed indirectly 80 | by a call to React.E.stop *) 81 | let _ = ignore (React.E.map (fun _ -> ()) onloaded) 82 | 83 | let _ = 84 | Ot_lib.onloads @@ fun () -> 85 | if React.S.value num_active_spinners = 0 then set_onloaded () 86 | 87 | let inc_active_spinners () = 88 | set_num_active_spinners @@ (React.S.value num_active_spinners + 1) 89 | 90 | let dec_active_spinners () = 91 | set_num_active_spinners @@ (React.S.value num_active_spinners - 1); 92 | if React.S.value num_active_spinners = 0 then set_onloaded () 93 | 94 | let cl_spinning = "ot-icon-animation-spinning" 95 | let cl_spinner = "ot-icon-spinner" 96 | 97 | let replace_content ?fail elt thread = 98 | let fail = 99 | match fail with 100 | | Some fail -> 101 | (fail 102 | : exn -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t 103 | :> exn -> Html_types.div_content Eliom_content.Html.elt list Lwt.t) 104 | | None -> fun e -> Lwt.return (default_fail e) 105 | in 106 | inc_active_spinners (); 107 | Manip.replaceChildren elt []; 108 | Manip.Class.add elt cl_spinning; 109 | Manip.Class.add elt cl_spinner; 110 | let* new_content = Lwt.catch (fun () -> thread) (fun e -> fail e) in 111 | Manip.replaceChildren elt new_content; 112 | Manip.Class.remove elt cl_spinning; 113 | Manip.Class.remove elt cl_spinner; 114 | dec_active_spinners (); 115 | Lwt.return_unit 116 | 117 | module Make (A : sig 118 | type +'a t 119 | 120 | val bind : 'a t -> ('a -> 'b t) -> 'b t 121 | val bind2 : 'a t -> ('a -> 'b Lwt.t) -> 'b Lwt.t 122 | val return : 'a -> 'a t 123 | end) = 124 | struct 125 | let with_spinner ?(a = []) ?spinner ?fail thread = 126 | let a = (a :> Html_types.div_attrib attrib list) in 127 | let fail = 128 | match fail with 129 | | Some fail -> 130 | (fail 131 | : exn -> [< Html_types.div_content] elt list A.t 132 | :> exn -> Html_types.div_content elt list A.t) 133 | | None -> fun e -> A.return (default_fail e) 134 | in 135 | match Lwt.state thread with 136 | | Lwt.Return v -> A.return (D.div ~a:(a_class ["ot-spinner"] :: a) v) 137 | | Lwt.Sleep -> 138 | inc_active_spinners (); 139 | let cl = ["ot-spinner"] in 140 | let cl = 141 | if spinner = None then cl_spinner :: cl_spinning :: cl else cl 142 | in 143 | let d = 144 | D.div ~a:(a_class cl :: a) 145 | (match spinner with None -> [] | Some s -> s) 146 | in 147 | Lwt.async (fun () -> 148 | let* v = 149 | Lwt.catch 150 | (fun () -> 151 | let* v = thread in 152 | Lwt.return (v :> Html_types.div_content_fun F.elt list)) 153 | (fun e -> 154 | A.bind2 (fail e) (fun v -> 155 | dec_active_spinners (); 156 | Lwt.return (v :> Html_types.div_content_fun F.elt list))) 157 | in 158 | Manip.replaceChildren d v; 159 | Manip.Class.remove d cl_spinning; 160 | Manip.Class.remove d cl_spinner; 161 | dec_active_spinners (); 162 | Lwt.return_unit); 163 | A.return d 164 | | Lwt.Fail e -> A.bind (fail e) (fun c -> A.return (D.div ~a c)) 165 | end 166 | 167 | module N = Make (struct 168 | type +'a t = 'a 169 | 170 | let bind a f = f a 171 | let bind2 a f = f a 172 | let return a = a 173 | end) 174 | 175 | module L = Make (struct 176 | include Lwt 177 | 178 | let bind2 = bind 179 | end) 180 | 181 | let with_spinner_no_lwt = N.with_spinner 182 | let with_spinner = L.with_spinner] 183 | -------------------------------------------------------------------------------- /src/widgets/ot_spinner.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen Toolkit 2 | * http://www.ocsigen.org/ocsigen-toolkit 3 | * 4 | * Copyright (C) 2014 5 | * Vincent Balat 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%shared.start] 23 | 24 | (** {2 Spinner widget} *) 25 | 26 | val with_spinner : 27 | ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list 28 | -> ?spinner:[< Html_types.div_content] Eliom_content.Html.elt list 29 | -> ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t) 30 | -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t 31 | -> [> `Div] Eliom_content.Html.elt Lwt.t 32 | (** On client side, [with_spinner th] returns immediately a spinner 33 | while Lwt thread [th] is not finished, that will automatically 34 | be replaced by the result of [th] when finished. 35 | 36 | On server side, it will wait for [th] to be finished before 37 | returning its result (and never display a spinner). 38 | 39 | If you want the spinner on both sides, you can use [with_spinner_no_lwt] 40 | and [Eliom_content.Html.C.node]. 41 | 42 | Function [fail] will be used to display block in case an exception is 43 | raised. 44 | 45 | Use optional argument [spinner] on client side to customize the spinner. 46 | By default it is a [div] element with classes 47 | [ot-icon-spinner] and [ot-icon-animation-spinning]. 48 | (see default stylesheet). 49 | *) 50 | 51 | [%%client.start] 52 | 53 | val with_spinner_no_lwt : 54 | ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list 55 | -> ?spinner:[< Html_types.div_content] Eliom_content.Html.elt list 56 | -> ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list) 57 | -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t 58 | -> [> `Div] Eliom_content.Html.elt 59 | (** Same as [with_spinner] but returns immediately. 60 | Client only (as we must wait for the thread to terminate on server 61 | before sending the page). *) 62 | 63 | val replace_content : 64 | ?fail:(exn -> [< Html_types.div_content] Eliom_content.Html.elt list Lwt.t) 65 | -> 'a Eliom_content.Html.elt 66 | -> Html_types.div_content Eliom_content.Html.elt list Lwt.t 67 | -> unit Lwt.t 68 | (** [replace_content elt thread] replaces the contents of [elt] by the content 69 | generated by [thread]. The [elt] has be a D-node. Until [thread] is 70 | finished [elt] is transformed into a spinner. *) 71 | 72 | val num_active_spinners : int Eliom_shared.React.S.t 73 | (** the number of spinners currently spinning *) 74 | 75 | val onloaded : unit Eliom_shared.React.E.t 76 | (** [onloaded] is an event that fires when all spinners have finished loading. 77 | This can occur multiple times. *) 78 | 79 | val set_default_fail : 80 | (exn -> [< Html_types.div_content] Eliom_content.Html.elt list) 81 | -> unit 82 | (** Change the default function used to display error messages *) 83 | -------------------------------------------------------------------------------- /src/widgets/ot_sticky.eliom: -------------------------------------------------------------------------------- 1 | [%%client.start] 2 | 3 | open Eliom_content.Html 4 | open Html_types 5 | open Js_of_ocaml 6 | open Js_of_ocaml_lwt 7 | open Lwt.Syntax 8 | 9 | (* This is about the real "position: sticky" *) 10 | 11 | let is_position_sticky elt = 12 | let pos = 13 | Js.to_string 14 | (Dom_html.window##getComputedStyle (To_dom.of_element elt))##.position 15 | in 16 | pos = "-webkit-sticky" || pos = "sticky" 17 | 18 | let set_position_sticky elt = 19 | is_position_sticky elt 20 | || 21 | let old_pos = Manip.Css.position elt in 22 | Manip.SetCss.position elt "-webkit-sticky"; 23 | is_position_sticky elt 24 | || 25 | (Manip.SetCss.position elt "sticky"; 26 | is_position_sticky elt 27 | || 28 | (Manip.SetCss.position elt old_pos; 29 | false)) 30 | 31 | let supports_position_sticky elt = 32 | let old_pos = Manip.Css.position elt in 33 | let res = 34 | (* Don't use [set_position_sticky] here because if it 35 | fails to set the "effective position" to sticky, it doesn't mean that 36 | the web engine doesn't support it. *) 37 | (Manip.SetCss.position elt "-webkit-sticky"; 38 | Js.to_string (To_dom.of_element elt)##.style##.position = "-webkit-sticky") 39 | || 40 | (Manip.SetCss.position elt "sticky"; 41 | Js.to_string (To_dom.of_element elt)##.style##.position = "sticky") 42 | in 43 | Manip.SetCss.position elt old_pos; 44 | res 45 | 46 | (* This is about the "position: sticky" polyfill *) 47 | 48 | let is_sticky elt = 49 | is_position_sticky elt 50 | || Manip.Class.contain elt "ot-sticky-inline" 51 | || Manip.Class.contain elt "ot-sticky-fixed" 52 | 53 | type glue = 54 | { fixed : div_content D.elt 55 | ; inline : div_content D.elt 56 | ; dir : [`Top | `Left] 57 | ; (*TODO: support `Bottom and `Right*) 58 | scroll_thread : unit Lwt.t 59 | ; resize_thread : (int * int) React.S.t 60 | ; dissolve : unit -> unit } 61 | 62 | let move_content ~from to_elt = 63 | if (Ot_style.style @@ To_dom.of_element to_elt)##.display <> Js.string "none" 64 | then ( 65 | let children = Manip.children from in 66 | Manip.removeChildren from; 67 | Manip.appendChildren to_elt children) 68 | 69 | let stick ?(force = false) g = 70 | if force || (not @@ Manip.Class.contain g.fixed "ot-stuck") 71 | then ( 72 | Ot_style.set_width g.inline 73 | @@ Ot_size.client_width (To_dom.of_element g.inline); 74 | Ot_style.set_height g.inline 75 | @@ Ot_size.client_height (To_dom.of_element g.inline); 76 | move_content ~from:g.inline g.fixed; 77 | Manip.Class.add g.fixed "ot-stuck"; 78 | Manip.Class.add g.inline "ot-stuck") 79 | 80 | let unstick ?(force = false) g = 81 | if force || Manip.Class.contain g.fixed "ot-stuck" 82 | then ( 83 | Manip.SetCss.width g.inline ""; 84 | Manip.SetCss.height g.inline ""; 85 | move_content ~from:g.fixed g.inline; 86 | Manip.Class.remove g.fixed "ot-stuck"; 87 | Manip.Class.remove g.inline "ot-stuck") 88 | 89 | let synchronise g = 90 | let sync_values () = 91 | Ot_style.set_width g.fixed 92 | @@ Ot_size.client_width (To_dom.of_element g.inline); 93 | Ot_style.set_height g.fixed 94 | @@ Ot_size.client_height (To_dom.of_element g.inline); 95 | match g.dir with 96 | | `Top -> 97 | Ot_style.set_left g.fixed 98 | @@ Ot_size.client_page_left (To_dom.of_element g.inline) 99 | | `Left -> 100 | Ot_style.set_top g.fixed 101 | @@ Ot_size.client_page_top (To_dom.of_element g.inline) 102 | in 103 | if Manip.Class.contain g.fixed "ot-stuck" 104 | then (unstick g; sync_values (); stick g) 105 | else sync_values () 106 | 107 | let update_state ?force g = 108 | let fixed = To_dom.of_element g.fixed in 109 | let inline = To_dom.of_element g.inline in 110 | match g.dir with 111 | | `Top -> 112 | if Ot_size.client_top fixed > Ot_size.client_top inline 113 | then stick ?force g 114 | else unstick ?force g 115 | | `Left -> 116 | if Ot_size.client_left fixed > Ot_size.client_left inline 117 | then stick ?force g 118 | else unstick ?force g 119 | 120 | (* TODO: ensure compatibility with DOM caching *) 121 | let make_sticky ~dir (* TODO: detect based on CSS attribute? *) 122 | ?((*TODO: `Bottom and `Right *) 123 | ios_html_scroll_hack = false) ?(force = false) elt 124 | = 125 | let* () = Ot_nodeready.nodeready (To_dom.of_element elt) in 126 | if (not force) && supports_position_sticky elt 127 | then Lwt.return_none 128 | else 129 | let fixed_dom = 130 | Js.Opt.case 131 | (Dom.CoerceTo.element @@ (To_dom.of_element elt)##cloneNode Js._false) 132 | (fun () -> failwith "could not clone element to make it sticky") 133 | (fun x -> x) 134 | in 135 | let fixed = Of_dom.of_element @@ Dom_html.element fixed_dom in 136 | Manip.insertBefore ~before:elt fixed; 137 | let* () = Ot_nodeready.nodeready fixed_dom in 138 | Manip.Class.add fixed "ot-sticky-fixed"; 139 | Manip.Class.add elt "ot-sticky-inline"; 140 | let glue = 141 | { fixed 142 | ; inline = elt 143 | ; dir 144 | ; scroll_thread = Lwt.return_unit 145 | ; (* updated below *) 146 | resize_thread = React.S.const (0, 0) 147 | ; (* updated below *) 148 | dissolve = (fun () -> failwith "undefined") } 149 | in 150 | let init () = 151 | unstick ~force:true glue; synchronise glue; update_state glue 152 | in 153 | init (); 154 | let onloaded_thread = Ot_spinner.onloaded |> React.E.map init in 155 | Eliom_lib.Dom_reference.retain (To_dom.of_element fixed) 156 | ~keep:onloaded_thread; 157 | let scroll_thread = 158 | Ot_lib.window_scrolls ~ios_html_scroll_hack @@ fun _ _ -> 159 | update_state glue; Lwt.return_unit 160 | in 161 | let resize_thread = 162 | Ot_size.width_height 163 | |> React.S.map @@ fun (width, height) -> 164 | synchronise glue; update_state glue; width, height 165 | in 166 | Eliom_lib.Dom_reference.retain (To_dom.of_element fixed) ~keep:resize_thread; 167 | let dissolve () = 168 | Lwt.cancel scroll_thread; 169 | React.S.stop resize_thread; 170 | React.E.stop onloaded_thread; 171 | unstick ~force:true glue; 172 | Manip.removeSelf glue.fixed; 173 | Manip.Class.remove glue.inline "ot-sticky-inline" 174 | in 175 | Eliom_client.onunload (fun () -> dissolve ()); 176 | Lwt.return_some {glue with scroll_thread; resize_thread; dissolve} 177 | 178 | (* This is about functionality built on top of position:sticky / the polyfill *) 179 | 180 | (* TODO: ensure compatibility with DOM caching *) 181 | let keep_in_sight ~dir ?ios_html_scroll_hack elt = 182 | let* () = Ot_nodeready.nodeready (To_dom.of_element elt) in 183 | let* glue = make_sticky ?ios_html_scroll_hack ~dir elt in 184 | let elt = match glue with None -> elt | Some g -> g.fixed in 185 | match Manip.parentNode elt with 186 | | None -> Lwt.return (fun () -> ()) 187 | | Some parent -> 188 | let* () = Ot_nodeready.nodeready (To_dom.of_element parent) in 189 | let compute_top_left (_, win_height) = 190 | match dir with 191 | | `Top -> 192 | (* sleep, as this should run after make_sticky's handlers *) 193 | let win_height = float_of_int win_height in 194 | let parent_top = 195 | Ot_size.client_page_top (To_dom.of_element parent) 196 | in 197 | let elt_height = Ot_size.client_height (To_dom.of_element elt) in 198 | if elt_height > win_height -. parent_top 199 | then Ot_style.set_top elt (win_height -. elt_height) 200 | else Ot_style.set_top elt parent_top 201 | | _ -> 202 | failwith 203 | "Ot_sticky.keep_in_sight only supports ~dir:`Top right now." 204 | in 205 | let resize_thread = 206 | React.S.map compute_top_left 207 | @@ 208 | match glue with 209 | | None -> Ot_size.width_height 210 | | Some glue -> glue.resize_thread 211 | in 212 | Eliom_lib.Dom_reference.retain (To_dom.of_element elt) ~keep:resize_thread; 213 | let init () = 214 | let doIt () = compute_top_left @@ React.S.value Ot_size.width_height in 215 | (* the additional initialisation after some delay is due to the inexplicable 216 | behaviour on Chrome where the initialisation happens too early. *) 217 | Lwt.async (fun () -> 218 | let* _ = Lwt_js.sleep 0.5 in 219 | Lwt.return @@ doIt ()); 220 | doIt () 221 | in 222 | init (); 223 | let onload_thread = React.E.map init Ot_spinner.onloaded in 224 | Eliom_lib.Dom_reference.retain (To_dom.of_element elt) ~keep:onload_thread; 225 | let stop () = 226 | React.E.stop onload_thread; 227 | React.S.stop resize_thread; 228 | match glue with Some g -> g.dissolve () | None -> () 229 | in 230 | Eliom_client.onunload (fun () -> stop ()); 231 | Lwt.return stop 232 | -------------------------------------------------------------------------------- /src/widgets/ot_sticky.eliomi: -------------------------------------------------------------------------------- 1 | [%%client.start] 2 | 3 | open Eliom_content.Html 4 | open Html_types 5 | 6 | val is_position_sticky : 'a elt -> bool 7 | (** whether computed CSS attribute "position" equals "sticky" *) 8 | 9 | val set_position_sticky : 'a elt -> bool 10 | (** try to set CSS attribute "position" to "sticky". [false] if 11 | unsuccessful *) 12 | 13 | val supports_position_sticky : 'a elt -> bool 14 | 15 | val is_sticky : 'a elt -> bool 16 | (** whether element is sticky, either due to CSS attribute position:sticky or 17 | due to position:sticky polyfill [make_sticky] *) 18 | 19 | type glue = 20 | { fixed : div_content D.elt 21 | ; inline : div_content D.elt 22 | ; dir : [`Top | `Left] 23 | ; scroll_thread : unit Lwt.t 24 | ; resize_thread : (int * int) React.S.t 25 | ; dissolve : unit -> unit } 26 | (** returned by [make sticky] (if position:sticky is not supported). You only 27 | need this value if you want to manipulate the stickiness later (as 28 | [keep_in_sight] does. 29 | [fixed]: element cloned from the element supplied to [make_sticky]; 30 | [inline]: original element supplied to [make_sticky]; 31 | [dir]: see [make_sticky]; 32 | [scroll_thread]: thread that makes either [fixed] or [inline] visible, 33 | depending on the scroll position; 34 | [resize_thread]: thread that resizes the fixed element according to the 35 | inline element on window resize; 36 | [dissolve]: undo [make_sticky] i.e. kill [scroll_thread] and [resize_thread] 37 | and remove [fixed] from the DOM tree. 38 | *) 39 | 40 | val make_sticky : 41 | dir:[`Left | `Top] 42 | -> ?ios_html_scroll_hack:bool 43 | -> ?force:bool 44 | -> div_content elt 45 | -> glue option Lwt.t 46 | (** position:sticky polyfill which is not supported by some browsers. It 47 | functions by making a clone with position:fixed of the designated 48 | element and continuously (window scroll/resize) monitoring the 49 | position of the element and the clone. The contents of the element 50 | is shifted back and forth between the two elements. Make sure to 51 | also apply the CSS code "position: sticky" to the element as this 52 | function has no effect if "position: sticky" is supported by the 53 | browser. The supplied element should be a D-element. 54 | [dir] determines whether it sticks to the top on vertical scroll or the the 55 | left on horizontal scroll. 56 | 57 | NOTE: Do not forget to include the CSS attributes as defined in the file 58 | css/ot_sticky.css. 59 | 60 | If [?force] is [true], will apply the polyfill even if the browser supports 61 | sticky position (default is [false]). 62 | 63 | See in {!Ot_lib} for documentation of [~ios_html_scroll_hack]. 64 | *) 65 | 66 | val keep_in_sight : 67 | dir:[`Left | `Top] 68 | -> ?ios_html_scroll_hack:bool 69 | -> div_content elt 70 | -> (unit -> unit) Lwt.t 71 | (** make sure an element gets never out of sight while scrolling by 72 | continuously (window scroll/resize) monitoring the position of the 73 | element and adjusting the top/left value. Calls 74 | [make_sticky]. Make sure to also apply the CSS code "position: 75 | sticky" to the element. The element's absolute position is 76 | determined by the parents position (which is not sticky but 77 | inline), so you probably want to wrap your element in a dedicated 78 | div. (It has to be the parent and not the element itself because 79 | when the element floats (is in its fixed state) we can't use its 80 | position for computing the right values. Returns a function by 81 | which the [keep_in_sight] functionality can be stopped. *) 82 | -------------------------------------------------------------------------------- /src/widgets/ot_style.eliom: -------------------------------------------------------------------------------- 1 | (*TODO: interface file*) 2 | (*TODO: reactive programming*) 3 | 4 | (* This module is all about easier access to getComputedStyle *) 5 | (* See: https://developer.mozilla.org/en-US/docs/Web/API/CSSStyleDeclaration *) 6 | (* See: https://ocsigen.org/js_of_ocaml/latest/api/js_of_ocaml/Js_of_ocaml/Dom_html/class-type-cssStyleDeclaration/index.html *) 7 | 8 | (* 9 | val marginTop : Dom_html.element Js.t -> float 10 | val marginBottom : Dom_html.element Js.t -> float 11 | val marginLeft : Dom_html.element Js.t -> float 12 | val marginRight : Dom_html.element Js.t -> float 13 | 14 | (** [parse_px "118.64px" = Some 118.64] *) 15 | val parse_px : Js.js_string Js.t -> float option 16 | *) 17 | 18 | [%%client.start] 19 | 20 | open Js_of_ocaml 21 | open Eliom_content.Html 22 | 23 | let parse_px str = 24 | let str = Js.to_string str in 25 | let len = String.length str in 26 | try 27 | let num = String.sub str 0 (len - 2) in 28 | match String.sub str (len - 2) 2 with 29 | | "px" -> Some (float_of_string num) 30 | | _ -> None 31 | with Invalid_argument _ | Match_failure _ -> None 32 | 33 | let float_of_px str = match parse_px str with None -> 0.0 | Some x -> x 34 | let px_of_float px = Printf.sprintf "%gpx" px 35 | let style elt = Dom_html.window##getComputedStyle elt 36 | 37 | (* -------------------------------------------------------------------------- *) 38 | (* Sum type for the display property. A value of this type is returned by 39 | * display'. 40 | *) 41 | type display = 42 | | Block 43 | | Compact 44 | | Flex 45 | | Inherit 46 | | Inline 47 | | Inline_block 48 | | Inline_flex 49 | | Inline_table 50 | | Initial 51 | | List_item 52 | | Marker 53 | | None 54 | | Run_in 55 | | Table 56 | | Table_caption 57 | | Table_cell 58 | | Table_column 59 | | Table_column_group 60 | | Table_footer_group 61 | | Table_header_group 62 | | Table_row 63 | | Table_row_group 64 | | Unknown 65 | 66 | let display_of_str d = 67 | match d with 68 | | "block" -> Block 69 | | "compact" -> Compact 70 | | "flex" -> Flex 71 | | "inherit" -> Inherit 72 | | "inline" -> Inline 73 | | "inline-block" -> Inline_block 74 | | "inline-flex" -> Inline_flex 75 | | "inline-table" -> Inline_table 76 | | "initial" -> Initial 77 | | "list-item" -> List_item 78 | | "marker" -> Marker 79 | | "none" -> None 80 | | "run-in" -> Run_in 81 | | "table" -> Table 82 | | "table-caption" -> Table_caption 83 | | "table-cell" -> Table_cell 84 | | "table-column" -> Table_column 85 | | "table-column-group" -> Table_column_group 86 | | "table-footer-group" -> Table_footer_group 87 | | "table-header-group" -> Table_header_group 88 | | "table-row" -> Table_row 89 | | "table-row-group" -> Table_row_group 90 | | _ -> Unknown 91 | 92 | let display_to_str d = 93 | match d with 94 | | Block -> "block" 95 | | Compact -> "compact" 96 | | Flex -> "flex" 97 | | Inherit -> "inherit" 98 | | Inline -> "inline" 99 | | Inline_block -> "inline-block" 100 | | Inline_flex -> "inline-flex" 101 | | Inline_table -> "inline-table" 102 | | Initial -> "initial" 103 | | List_item -> "list-item" 104 | | Marker -> "marker" 105 | | None -> "none" 106 | | Run_in -> "run-in" 107 | | Table -> "table" 108 | | Table_caption -> "table-caption" 109 | | Table_cell -> "table-cell" 110 | | Table_column -> "table-column" 111 | | Table_column_group -> "table-column-group" 112 | | Table_footer_group -> "table-footer-group" 113 | | Table_header_group -> "table-header-group" 114 | | Table_row -> "table-row" 115 | | Table_row_group -> "table-row-group" 116 | | Unknown -> "" 117 | 118 | (* -------------------------------------------------------------------------- *) 119 | 120 | let display elt = Js.to_string (style elt)##.display 121 | 122 | (* display' elt returns a display type instead of a string *) 123 | let display' elt = display_of_str (display elt) 124 | let visibility elt = Js.to_string (style elt)##.visibility 125 | 126 | (*TODO: not well-tested! does this work on all browsers? *) 127 | let invisible elt = 128 | (*https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/offsetParent*) 129 | elt##.offsetParent = Js.null 130 | || display elt = "none" 131 | || visibility elt = "hidden" 132 | 133 | let top elt = parse_px (style elt)##.top 134 | let bottom elt = parse_px (style elt)##.bottom 135 | let left elt = parse_px (style elt)##.left 136 | let right elt = parse_px (style elt)##.right 137 | let marginTop e = float_of_px (style e)##.marginTop 138 | let marginBottom e = float_of_px (style e)##.marginBottom 139 | let marginLeft e = float_of_px (style e)##.marginLeft 140 | let marginRight e = float_of_px (style e)##.marginRight 141 | let set_top e v = Manip.SetCss.top e @@ px_of_float v 142 | let set_bottom e v = Manip.SetCss.bottom e @@ px_of_float v 143 | let set_left e v = Manip.SetCss.left e @@ px_of_float v 144 | let set_right e v = Manip.SetCss.right e @@ px_of_float v 145 | let set_width e v = Manip.SetCss.width e @@ px_of_float v 146 | let set_height e v = Manip.SetCss.height e @@ px_of_float v 147 | -------------------------------------------------------------------------------- /src/widgets/ot_style.eliomi: -------------------------------------------------------------------------------- 1 | [%%client.start] 2 | 3 | (** This module is an interface to getComputedStyle. *) 4 | 5 | open Js_of_ocaml 6 | open Eliom_content.Html 7 | 8 | val parse_px : Js.js_string Js.t -> float option 9 | val float_of_px : Js.js_string Js.t -> float 10 | val px_of_float : float -> string 11 | val style : #Dom_html.element Js.t -> Dom_html.cssStyleDeclaration Js.t 12 | 13 | (* -------------------------------------------------------------------------- *) 14 | (* Sum type for the display property. 15 | * See http://www.w3schools.com/jsref/prop_style_display.asp. 16 | *) 17 | type display = 18 | | Block 19 | | Compact 20 | | Flex 21 | | Inherit 22 | | Inline 23 | | Inline_block 24 | | Inline_flex 25 | | Inline_table 26 | | Initial 27 | | List_item 28 | | Marker 29 | | None 30 | | Run_in 31 | | Table 32 | | Table_caption 33 | | Table_cell 34 | | Table_column 35 | | Table_column_group 36 | | Table_footer_group 37 | | Table_header_group 38 | | Table_row 39 | | Table_row_group 40 | | Unknown 41 | 42 | val display_to_str : display -> string 43 | val display_of_str : string -> display 44 | 45 | (* -------------------------------------------------------------------------- *) 46 | 47 | val display : #Dom_html.element Js.t -> string 48 | val display' : #Dom_html.element Js.t -> display 49 | val visibility : #Dom_html.element Js.t -> string 50 | 51 | val invisible : #Dom_html.element Js.t -> bool 52 | (** whether an element is currently invisible in the DOM (not the screen); 53 | you might want to do a [Ot_nodeready.nodeready] before. *) 54 | 55 | val top : #Dom_html.element Js.t -> float option 56 | val bottom : #Dom_html.element Js.t -> float option 57 | val left : #Dom_html.element Js.t -> float option 58 | val right : #Dom_html.element Js.t -> float option 59 | val marginTop : #Dom_html.element Js.t -> float 60 | val marginBottom : #Dom_html.element Js.t -> float 61 | val marginLeft : #Dom_html.element Js.t -> float 62 | val marginRight : #Dom_html.element Js.t -> float 63 | val set_top : 'a elt -> float -> unit 64 | val set_bottom : 'a elt -> float -> unit 65 | val set_left : 'a elt -> float -> unit 66 | val set_right : 'a elt -> float -> unit 67 | val set_width : 'a elt -> float -> unit 68 | val set_height : 'a elt -> float -> unit 69 | -------------------------------------------------------------------------------- /src/widgets/ot_swipe.eliom: -------------------------------------------------------------------------------- 1 | (** Swiping an element *) 2 | 3 | [%%shared open Js_of_ocaml] 4 | [%%client open Js_of_ocaml_lwt] 5 | open%client Eliom_content.Html 6 | open%client Lwt.Syntax 7 | [%%shared open Eliom_content.Html.F] 8 | 9 | (** sensibility for detecting swipe left/right or up/down *) 10 | 11 | let%client threshold = 0. 12 | let%client px_of_int v = Js.string (string_of_int v ^ "px") 13 | 14 | let%client identifier ev = 15 | Js.Optdef.case 16 | ev ##. changedTouches ## (item 0) 17 | (fun () -> 0) 18 | (fun a -> a##.identifier) 19 | 20 | let%client clX ev = 21 | Js.Optdef.case 22 | ev ##. changedTouches ## (item 0) 23 | (fun () -> 0.) 24 | (fun a -> Js.to_float a##.clientX) 25 | 26 | let%client clY ev = 27 | Js.Optdef.case 28 | ev ##. changedTouches ## (item 0) 29 | (fun () -> 0.) 30 | (fun a -> Js.to_float a##.clientY) 31 | 32 | let%client add_transition transition_duration = 33 | let s = Js.string (Printf.sprintf "%.2fs" transition_duration) in 34 | fun elt -> (Js.Unsafe.coerce elt##.style)##.transitionDuration := s 35 | 36 | let%client remove_transition elt = 37 | (Js.Unsafe.coerce elt##.style)##.transitionDuration := Js.string "0s" 38 | 39 | type%client status = Stopped | Start | Below | Above | Aborted | In_progress 40 | 41 | let%client dispatch_event ~ev elt name x y = 42 | Js.Opt.iter elt##.parentNode (fun target -> 43 | let event = 44 | try 45 | (* Better version, but unsupported on iOS and Android: *) 46 | let touchevent = Js.Unsafe.global ##. TouchEvent in 47 | let touch = Js.Unsafe.global ##. Touch in 48 | let touch = 49 | new%js touch 50 | (object%js 51 | val identifier = identifier ev 52 | val target = target 53 | val clientX = x 54 | val clientY = y 55 | end) 56 | in 57 | if touch##.target = Js.null then failwith "new Touch() not supported"; 58 | let opt = 59 | object%js 60 | val bubbles = Js._true 61 | val changedTouches = Js.array [|touch|] 62 | end 63 | in 64 | new%js touchevent (Js.string name) opt 65 | with e -> 66 | Printf.eprintf "%s\n" 67 | ("exn: " ^ Printexc.to_string e ^ " - switching to workaround. "); 68 | (* HACK *) 69 | let customEvent = Js.Unsafe.global ##. CustomEvent in 70 | let opt = 71 | object%js 72 | val bubbles = Js._true 73 | end 74 | in 75 | let event = new%js customEvent (Js.string name) opt in 76 | let touch = 77 | object%js 78 | val identifier = identifier ev 79 | val target = target 80 | val clientX = x 81 | val clientY = y 82 | end 83 | in 84 | let touches = 85 | object%js 86 | val item = Js.wrap_callback (fun _ -> Js.def touch) 87 | end 88 | in 89 | (Js.Unsafe.coerce event)##.changedTouches := touches; 90 | (* END HACK *) 91 | event 92 | in 93 | (Js.Unsafe.coerce target)##dispatchEvent event) 94 | 95 | let%shared bind ?(transition_duration = 0.3) 96 | ?(min : (unit -> int) Eliom_client_value.t option) 97 | ?(max : (unit -> int) Eliom_client_value.t option) 98 | ~(compute_final_pos : 99 | (Dom_html.touchEvent Js.t -> int -> int) Eliom_client_value.t) 100 | ?(onstart : 101 | (Dom_html.touchEvent Js.t -> int -> unit) Eliom_client_value.t option) 102 | ?(onmove : 103 | (Dom_html.touchEvent Js.t -> int -> unit) Eliom_client_value.t option) 104 | ?(onend : 105 | (Dom_html.touchEvent Js.t -> int -> unit) Eliom_client_value.t option) 106 | (elt : _ elt) 107 | = 108 | ignore 109 | [%client 110 | (let elt = ~%elt in 111 | let elt' = To_dom.of_element elt in 112 | let startx = ref 0. (* position when touch starts *) in 113 | let starty = ref 0. (* position when touch starts *) in 114 | let status = ref Stopped in 115 | let onpanend ev aa = 116 | if !status <> Start 117 | then ( 118 | add_transition ~%transition_duration elt'; 119 | let left = ~%compute_final_pos ev (truncate (clX ev -. !startx)) in 120 | elt'##.style##.left := px_of_int left; 121 | Eliom_lib.Option.iter (fun f -> f ev left) ~%onend; 122 | Lwt.async (fun () -> 123 | let* _ = Lwt_js_events.transitionend elt' in 124 | Manip.Class.remove elt "ot-swiping"; 125 | Lwt.return_unit)); 126 | status := Stopped; 127 | Lwt.return_unit 128 | in 129 | let onpanstart0 () = status := Start in 130 | let onpanstart ev _ = 131 | startx := clX ev -. float elt'##.offsetLeft; 132 | starty := clY ev; 133 | onpanstart0 (); 134 | Lwt.return_unit 135 | in 136 | let onpan ev aa = 137 | let left = clX ev -. !startx in 138 | let do_pan left = elt'##.style##.left := px_of_int left in 139 | if !status = Start 140 | then 141 | status := 142 | if abs_float (clY ev -. !starty) >= abs_float left 143 | then Aborted (* vertical scrolling *) 144 | else if abs_float left > threshold 145 | then ( 146 | (* We decide to take the event *) 147 | Manip.Class.add elt "ot-swiping"; 148 | remove_transition elt'; 149 | Eliom_lib.Option.iter (fun f -> f ev (truncate left)) ~%onstart; 150 | (* We send a touchcancel to the parent (who received the start) *) 151 | dispatch_event ~ev elt' "touchcancel" (clX ev) (clY ev); 152 | In_progress) 153 | else !status; 154 | let min = Eliom_lib.Option.map (fun f -> f ()) ~%min in 155 | let max = Eliom_lib.Option.map (fun f -> f ()) ~%max in 156 | if !status = In_progress 157 | then ( 158 | match min, max with 159 | | Some min, _ when left < float min -> 160 | (* min reached. 161 | We stop the movement of this element 162 | and dispatch it to the parent. *) 163 | status := Below; 164 | Eliom_lib.Option.iter (fun f -> f ev min) ~%onmove; 165 | do_pan min; 166 | (* We send a touchstart event to the parent *) 167 | dispatch_event ~ev elt' "touchstart" 168 | (float min +. !startx) 169 | (clY ev); 170 | (* We propagate *) 171 | Lwt.return_unit 172 | | _, Some max when left > float max -> 173 | (* max reached. 174 | We stop the movement of this element 175 | and dispatch it to the parent. *) 176 | status := Above; 177 | Eliom_lib.Option.iter (fun f -> f ev max) ~%onmove; 178 | do_pan max; 179 | (* We send a touchstart event to the parent *) 180 | dispatch_event ~ev elt' "touchstart" 181 | (float max +. !startx) 182 | (clY ev); 183 | (* We propagate *) 184 | Lwt.return_unit 185 | | _ -> 186 | Dom_html.stopPropagation ev; 187 | Dom.preventDefault ev; 188 | Eliom_lib.Option.iter (fun f -> f ev (truncate left)) ~%onmove; 189 | do_pan (int_of_float (left +. 0.5)); 190 | Lwt.return_unit) 191 | else 192 | (* Shall we restart swiping this element? *) 193 | let restart_pos = 194 | match !status, min, max with 195 | | Below, Some min, _ when left >= float min -> Some min 196 | | Above, _, Some max when left <= float max -> Some max 197 | | _ -> None 198 | in 199 | match restart_pos with 200 | | Some restart_pos -> 201 | (* We restart the movement of this element *) 202 | (* We send a touchmove event to the parent to fix 203 | its position precisely, 204 | but no touchend because it would possibly trigger a transition. *) 205 | dispatch_event ~ev elt' "touchmove" 206 | (float restart_pos +. !startx) 207 | (clY ev); 208 | onpanstart0 ( (* restart_pos + !startx *) ); 209 | Dom_html.stopPropagation ev; 210 | do_pan (int_of_float (left +. 0.5)); 211 | Lwt.return_unit 212 | | None -> (* We propagate *) Lwt.return_unit 213 | in 214 | Lwt.async (fun () -> Lwt_js_events.touchstarts elt' onpanstart); 215 | Lwt.async (fun () -> Lwt_js_events.touchmoves elt' onpan); 216 | Lwt.async (fun () -> Lwt_js_events.touchends elt' onpanend); 217 | Lwt.async (fun () -> Lwt_js_events.touchcancels elt' onpanend) 218 | : unit)] 219 | -------------------------------------------------------------------------------- /src/widgets/ot_swipe.eliomi: -------------------------------------------------------------------------------- 1 | [%%shared.start] 2 | 3 | open Js_of_ocaml 4 | 5 | val bind : 6 | ?transition_duration:float 7 | -> ?min:(unit -> int) Eliom_client_value.t 8 | -> ?max:(unit -> int) Eliom_client_value.t 9 | -> compute_final_pos: 10 | (Dom_html.touchEvent Js.t -> int -> int) Eliom_client_value.t 11 | -> ?onstart:(Dom_html.touchEvent Js.t -> int -> unit) Eliom_client_value.t 12 | -> ?onmove:(Dom_html.touchEvent Js.t -> int -> unit) Eliom_client_value.t 13 | -> ?onend:(Dom_html.touchEvent Js.t -> int -> unit) Eliom_client_value.t 14 | -> 'a Eliom_content.Html.elt 15 | -> unit 16 | (** 17 | [bind ~compute_final_pos elt] makes [elt] left-right 18 | swipable on touch screens. 19 | [compute_final_pos] is a function that will compute the final position 20 | of the element w.r.t. the position where it has been released (in pixels). 21 | Use [(fun _ p -> p)] if you want it to stay where it was released. 22 | 23 | Use [?min] and [?max] if you want to limit the move. 24 | If outside range, events will be propagated to parent 25 | (which makes it possible to have a swipeable element inside another one). 26 | 27 | [?onstart] and [?onmove] and [?onend] 28 | can be used to execute some side effect on touch start, touch move and 29 | touch end. The second parameter is the current move. 30 | *) 31 | 32 | (**/**) 33 | 34 | [%%client.start] 35 | 36 | val clX : Dom_html.touchEvent Js.t -> float 37 | val clY : Dom_html.touchEvent Js.t -> float 38 | val threshold : float 39 | 40 | val dispatch_event : 41 | ev:Dom_html.touchEvent Js.t 42 | -> Dom_html.element Js.t 43 | -> string 44 | -> float 45 | -> float 46 | -> unit 47 | -------------------------------------------------------------------------------- /src/widgets/ot_time_picker.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2015 4 | * Vasilis Papavasileiou 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%shared.start] 22 | 23 | (** This module implements a clock-style time picker. *) 24 | 25 | val make : 26 | ?action:(int * int -> unit Lwt.t) Eliom_client_value.t 27 | -> ?init:int * int 28 | -> ?update:(int * int) React.E.t Eliom_client_value.t 29 | -> ?round_5:bool 30 | -> ?h24:bool 31 | -> unit 32 | -> [> `Div] Eliom_content.Html.elt 33 | * (int * int) Eliom_shared.React.S.t 34 | * (unit -> unit) Eliom_client_value.t 35 | (** [make ?action ?round_5 ?h24 ()] produces a clock-style time picker 36 | for hours and minutes. The user is first asked to pick hours, then 37 | minutes with a separate clock. 38 | 39 | If [action] is provided, it is called when a new time is 40 | available. 41 | 42 | [init] (if provided) is the default displayed time. 43 | 44 | [update] is a React event that can be used to trigger updates from 45 | outside. 46 | 47 | If [round_5] is true (default: false), the output for the minutes 48 | is rounded to multiples of 5. 49 | 50 | If [h24] is true (default: true), a 24-hour hour picker is 51 | used. 52 | 53 | The first part of the output is the clock. The second part of the 54 | output is a reactive signal [(h, m)] where [h] are the hours and 55 | [m] the minutes that the user picked. The third part of the output 56 | is a function that can be called to go back to hours selection. *) 57 | 58 | val make_hours_minutes_seq : 59 | ?action:(int * int -> unit Lwt.t) Eliom_client_value.t 60 | -> ?init:int * int 61 | -> ?update:(int * int) React.E.t Eliom_client_value.t 62 | -> ?round_5:bool 63 | -> ?h24:bool 64 | -> unit 65 | -> [> `Div] Eliom_content.Html.elt 66 | * (int * int) Eliom_shared.React.S.t 67 | * (unit -> unit) Eliom_client_value.t 68 | (** Alias of [make]. Deprecated. *) 69 | -------------------------------------------------------------------------------- /src/widgets/ot_tip.eliom: -------------------------------------------------------------------------------- 1 | [%%client 2 | (* Ocsigen Toolkit 3 | * http://www.ocsigen.org/ocsigen-toolkit 4 | * 5 | * Copyright (C) 2017 6 | * Julien Sagot 7 | * 8 | * This program is free software; you can redistribute it and/or modify 9 | * it under the terms of the GNU Lesser General Public License as published by 10 | * the Free Software Foundation, with linking exception; 11 | * either version 2.1 of the License, or (at your option) any later version. 12 | * 13 | * This program is distributed in the hope that it will be useful, 14 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | * GNU Lesser General Public License for more details. 17 | * 18 | * You should have received a copy of the GNU Lesser General Public License 19 | * along with this program; if not, write to the Free Software 20 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 21 | *) 22 | open Js_of_ocaml] 23 | 24 | [%%client open Eliom_content.Html] 25 | [%%client open Eliom_content.Html.F] 26 | 27 | let%client display ?(container_a = [a_class ["ot-tip-container"]]) 28 | ?(filter_a = [a_class ["ot-tip-filter"]]) 29 | ?(position : 30 | [`Forced_top | `Top | `Ratio of float | `Bottom | `Forced_bottom] = 31 | `Ratio 0.5) ?(side : [`Center | `Left | `Right] = `Center) 32 | ~(origin : Dom_html.element Js.t) ?(onopen = fun _ _ -> ()) 33 | ?(onclose = fun _ _ -> ()) 34 | ~(content : 35 | (unit -> unit) 36 | -> [< Html_types.div_content_fun > `Div] Eliom_content.Html.elt list) () 37 | = 38 | let close = ref @@ fun () -> () in 39 | let container = 40 | D.div ~a:container_a 41 | @@ (div ~a:[a_class ["ot-tip-src"]] [] :: content (fun () -> !close ())) 42 | in 43 | let container_elt = To_dom.of_element container in 44 | let d_height = float @@ Dom_html.window##.innerHeight in 45 | let d_width = float Dom_html.document##.documentElement##.clientWidth in 46 | let o_bounds = origin##getBoundingClientRect in 47 | let o_left = Js.to_float o_bounds##.left in 48 | let o_right = Js.to_float o_bounds##.right in 49 | let o_to_right = d_width -. o_right in 50 | let o_top = Js.to_float o_bounds##.top in 51 | let o_to_top = d_height -. o_top in 52 | let o_bottom = Js.to_float o_bounds##.bottom in 53 | let o_to_bottom = d_height -. o_bottom in 54 | let o_width = o_right -. o_left in 55 | let o_center_to_left = (o_right +. o_left) /. 2. in 56 | let o_center_to_right = d_width -. o_center_to_left in 57 | let container_ready = Ot_nodeready.nodeready container_elt in 58 | let when_container_ready get_from_container use_it = 59 | Lwt.(async @@ fun () -> container_ready >|= get_from_container >|= use_it) 60 | in 61 | let get_c_height () = float container_elt##.offsetHeight in 62 | let get_half_c_width () = float (container_elt##.offsetWidth / 2) in 63 | let c_style = container_elt##.style in 64 | let print_px x = Js.string (Printf.sprintf "%gpx" x) in 65 | let c_add_class class_ = Manip.Class.add container class_ in 66 | c_style##.minWidth := print_px o_width; 67 | let put_on_top () = 68 | c_style##.top := print_px 0.; 69 | c_add_class "ot-tip-bottom" 70 | in 71 | let put_c_below_o () = 72 | c_style##.top := print_px o_bottom; 73 | c_add_class "ot-tip-top" 74 | in 75 | let put_c_above_o () = 76 | c_style##.bottom := print_px o_to_top; 77 | c_add_class "ot-tip-bottom" 78 | in 79 | let when_container_ready_and_in f = 80 | when_container_ready get_c_height @@ fun c_height -> 81 | let enough_space_below_o = c_height < o_to_bottom in 82 | let enough_space_above_o = c_height < o_top in 83 | match enough_space_below_o, enough_space_above_o with 84 | | false, false -> put_on_top () 85 | | false, true -> put_c_above_o () 86 | | true, false -> put_c_below_o () 87 | | true, true -> f () 88 | in 89 | (match position with 90 | | `Forced_top -> put_c_above_o () 91 | | `Top -> when_container_ready_and_in put_c_above_o 92 | | `Ratio r -> 93 | when_container_ready_and_in (fun () -> 94 | if (1. -. r) *. o_top < r *. o_to_bottom 95 | then put_c_below_o () 96 | else put_c_above_o ()) 97 | | `Bottom -> when_container_ready_and_in put_c_below_o 98 | | `Forced_bottom -> put_c_below_o ()); 99 | (match side with 100 | | `Left -> 101 | c_style##.right := print_px o_to_right; 102 | c_add_class "ot-tip-left" 103 | | `Right -> 104 | c_style##.left := print_px o_left; 105 | c_add_class "ot-tip-right" 106 | | `Center -> 107 | if o_to_right < o_left 108 | then ( 109 | c_style##.right := print_px o_center_to_right; 110 | when_container_ready get_half_c_width (fun half_c_width -> 111 | if half_c_width <= o_center_to_right -. 1. 112 | then ( 113 | c_style##.right := print_px (o_center_to_right -. half_c_width); 114 | c_add_class "ot-tip-center") 115 | else c_add_class "ot-tip-left")) 116 | else ( 117 | c_style##.left := print_px o_center_to_left; 118 | when_container_ready get_half_c_width (fun half_c_width -> 119 | if half_c_width <= o_center_to_left -. 1. 120 | then ( 121 | c_style##.left := print_px (o_center_to_left -. half_c_width); 122 | c_add_class "ot-tip-center") 123 | else c_add_class "ot-tip-right"))); 124 | let filter = 125 | D.div ~a:(a_onclick (fun _ -> !close ()) :: filter_a) [container] 126 | in 127 | let scroll_handler = 128 | Dom.addEventListener Dom_html.document Dom_html.Event.scroll 129 | (Dom_html.handler (fun _ -> !close (); Js._true)) 130 | Js._false 131 | in 132 | (close := 133 | fun () -> 134 | Dom.removeEventListener scroll_handler; 135 | Manip.removeSelf filter; 136 | onclose filter container); 137 | Manip.appendToBody filter; onopen filter container; filter, !close 138 | -------------------------------------------------------------------------------- /src/widgets/ot_tip.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen Toolkit 2 | * http://www.ocsigen.org/ocsigen-toolkit 3 | * 4 | * Copyright (C) 2017 5 | * Julien Sagot 6 | * 7 | * This program is free software; you can redistribute it and/or modify 8 | * it under the terms of the GNU Lesser General Public License as published by 9 | * the Free Software Foundation, with linking exception; 10 | * either version 2.1 of the License, or (at your option) any later version. 11 | * 12 | * This program is distributed in the hope that it will be useful, 13 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | * GNU Lesser General Public License for more details. 16 | * 17 | * You should have received a copy of the GNU Lesser General Public License 18 | * along with this program; if not, write to the Free Software 19 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 20 | *) 21 | 22 | [%%client.start] 23 | 24 | open Js_of_ocaml 25 | 26 | (** {2 Tip widget} *) 27 | 28 | (** This module implement a [display] function which actually display a tip 29 | (i.e. a box over the page content). 30 | 31 | It appends an element (which is called here "the filter") to body. The filter is 32 | meant take the whole page space, in order to capture clicks to close the tip. 33 | The filter also contains another element, called the menu which is the container 34 | for content to be displayed. 35 | 36 | [filter_a]: filter attributes default is [ a_class ["ot-drp-filter"] ] 37 | and will be overriden if you provide this argument. 38 | 39 | [menu_a]: menu attributes default is [ [ a_class ["ot-drp-menu"] ] ] 40 | and will be overriden if you provide this argument. 41 | 42 | [position]: specify how the tip whould be positioned horizontally with respect 43 | to the [origin] element. By default, the tip is above the [origin] element 44 | when there is more space above than below the [origin] element and vice versa. 45 | When position is [`Forced_top] or [`Forced_bottom], the tip is always 46 | above (resp. the below) the [origin] element. 47 | When position is [`Top] or [`Bottom], the tip is above (resp. the below) 48 | the [origin] element unless the tip is off the screen and in this case 49 | the tip will be below (resp. the above) the [origin] element. 50 | When position is [`Ratio r], the tip is below the [origin] element if 51 | the [origin] element is on the top [r] part of the screen otherwise the tip 52 | will be above the [origin] element. 53 | 54 | [side]: specify how the tip whould be positioned vertically with respect to 55 | the [origin] element. By default, the tip is centered; if it would 56 | not fit on screen, its right hand side or left hand side is aligned 57 | with the middle of the [origin] element. When side is [`Left] or 58 | [`Right], the tip and the [origin] element are aligned on the 59 | right (resp. the left). 60 | 61 | [origin] is the element from which the tip is supposed to pop out. 62 | 63 | [onopen filter menu side] is called after the filter is append to body. 64 | 65 | [onclose filter menu side] is called after the tip has been closed. 66 | 67 | [content] is the function generating the main content. It takes the function 68 | to close the tip as parameter 69 | 70 | *) 71 | 72 | val display : 73 | ?container_a:[< Html_types.div_attrib > `Class] Eliom_content.Html.attrib list 74 | -> ?filter_a: 75 | [< Html_types.div_attrib > `Class `OnClick] Eliom_content.Html.attrib 76 | list 77 | -> ?position:[`Forced_top | `Top | `Ratio of float | `Bottom | `Forced_bottom] 78 | -> ?side:[`Left | `Right | `Center] 79 | -> origin:Dom_html.element Js.t 80 | -> ?onopen: 81 | ([> Html_types.div] Eliom_content.Html.elt 82 | -> [> Html_types.div] Eliom_content.Html.elt 83 | -> unit) 84 | -> ?onclose: 85 | ([> Html_types.div] Eliom_content.Html.elt 86 | -> [> Html_types.div] Eliom_content.Html.elt 87 | -> unit) 88 | -> content: 89 | ((unit -> unit) 90 | -> [< Html_types.div_content_fun > `Div] Eliom_content.Html.elt list) 91 | -> unit 92 | -> [> Html_types.div] Eliom_content.Html.elt * (unit -> unit) 93 | -------------------------------------------------------------------------------- /src/widgets/ot_toggle.eliom: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2015 4 | * Vasilis Papavasileiou 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%shared.start] (* shared by default, override as necessary *) 22 | 23 | open Eliom_content.Html 24 | open Eliom_shared.React.S.Infix 25 | 26 | type t = T_Up | T_Down 27 | 28 | let%client up_for_true = function true -> T_Up | _ -> T_Down 29 | 30 | let display_toggle ?(up_txt = "up") ?(down_txt = "down") f = 31 | let open D in 32 | function 33 | | T_Up -> 34 | div 35 | ~a:[a_class ["ot-toggle"]] 36 | [ div ~a:[a_class ["ot-active"; "ot-up"]] [txt up_txt] 37 | ; div 38 | ~a: 39 | [ a_class ["ot-inactive"; "ot-down"] 40 | ; a_onclick [%client (fun _ -> ~%f T_Down : _ -> _)] ] 41 | [txt down_txt] ] 42 | | T_Down -> 43 | div 44 | ~a:[a_class ["ot-toggle"]] 45 | [ div 46 | ~a: 47 | [ a_class ["ot-inactive"; "ot-up"] 48 | ; a_onclick [%client (fun _ -> ~%f T_Up : _ -> _)] ] 49 | [txt up_txt] 50 | ; div ~a:[a_class ["ot-active"; "ot-down"]] [txt down_txt] ] 51 | 52 | let make ?(init_up = false) ?up_txt ?down_txt 53 | ?(update : bool React.E.t Eliom_client_value.t option) () 54 | = 55 | let e, f = Eliom_shared.React.S.create (if init_up then T_Up else T_Down) in 56 | let elt = 57 | D.div 58 | [ e 59 | >|= [%shared display_toggle ~%f ?up_txt:~%up_txt ?down_txt:~%down_txt] 60 | |> R.node ] 61 | in 62 | (match update with 63 | | Some update -> 64 | ignore 65 | @@ [%client 66 | (let f b = ~%f (up_for_true b) in 67 | Eliom_lib.Dom_reference.retain (To_dom.of_element ~%elt) 68 | ~keep:(Eliom_shared.React.E.map f ~%update) 69 | : unit)] 70 | | None -> ()); 71 | elt, e >|= [%shared function T_Up -> true | _ -> false] 72 | -------------------------------------------------------------------------------- /src/widgets/ot_toggle.eliomi: -------------------------------------------------------------------------------- 1 | (* Ocsigen 2 | * http://www.ocsigen.org 3 | * Copyright (C) 2015 4 | * Vasilis Papavasileiou 5 | * 6 | * This program is free software; you can redistribute it and/or modify 7 | * it under the terms of the GNU Lesser General Public License as published by 8 | * the Free Software Foundation, with linking exception; 9 | * either version 2.1 of the License, or (at your option) any later version. 10 | * 11 | * This program is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU Lesser General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU Lesser General Public License 17 | * along with this program; if not, write to the Free Software 18 | * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 19 | *) 20 | 21 | [%%shared.start] 22 | 23 | (** {2 Binary toggle widget} *) 24 | 25 | val make : 26 | ?init_up:bool 27 | -> ?up_txt:string 28 | -> ?down_txt:string 29 | -> ?update:bool React.E.t Eliom_client_value.t 30 | -> unit 31 | -> [> `Div] Eliom_content.Html.elt * bool Eliom_shared.React.S.t 32 | (** [make ?init_up ?up_txt ?down_txt ()] produces a binary toggle. If 33 | [init_up] is true, the toggle is originally up (default: down). The 34 | buttons for the "up" and "down" positions are marked with [up_txt] 35 | and [down_txt]. The first part of the output is the toggle, and the 36 | second part is a Boolean reactive signal, where true means "up". *) 37 | -------------------------------------------------------------------------------- /src/widgets/ot_tongue.eliomi: -------------------------------------------------------------------------------- 1 | [%%shared.start] 2 | 3 | type simple_stop = [`Percent of int | `Px of int | `Full_content] 4 | 5 | type stop = 6 | [ `Percent of int 7 | | `Px of int 8 | | `Full_content 9 | | `Interval of simple_stop * simple_stop ] 10 | 11 | type tongue = 12 | { elt : Html_types.div Eliom_content.Html.D.elt 13 | ; stop_signal_before : simple_stop React.S.t Eliom_client_value.t 14 | ; stop_signal_after : simple_stop React.S.t Eliom_client_value.t 15 | ; swipe_pos : int React.S.t Eliom_client_value.t 16 | ; px_signal_before : int React.S.t Eliom_client_value.t 17 | ; px_signal_after : int React.S.t Eliom_client_value.t } 18 | (** Signals contain the current 19 | position of the tongue, as a [simple_stop] or as [int]. 20 | Before (resp. after) signals are triggered before (resp. after) transition. 21 | [swipe_pos] represents the position during the swipe of the user *) 22 | 23 | val tongue : 24 | ?a:[< Html_types.div_attrib] Eliom_content.Html.attrib list 25 | -> ?side:[`Bottom | `Left | `Right | `Top] 26 | -> ?stops:stop list 27 | -> ?init:simple_stop 28 | -> ?handle:[> `Div] Eliom_content.Html.elt 29 | -> ?update:simple_stop React.event Eliom_client_value.t 30 | -> [< Html_types.div_content_fun] Eliom_content.Html.elt list 31 | -> tongue 32 | (** 33 | A tongue is an expandable panel that can appear from a side of the screen 34 | (usually top or bottom). It is usually intended for touchscreen interfaces. 35 | It takes its content as main parameter. 36 | 37 | This function takes the content of the tongue and returns a value of type 38 | [tongue]. 39 | 40 | [?side] is the side of the screen where the tongue is attached. 41 | By default [`Bottom]. 42 | 43 | [?stops] is the list of positions you want the tongue to stick to. 44 | By default, 45 | it is [[`Px 70; `Percent 100; `Interval (`Percent 100, `Full_content)]], 46 | which means: only 70 pixels visible, 47 | screen size, and any value between screen size 48 | and content size. 49 | 50 | The percentage is given w.r.t. windows height or width. 51 | Size of the tongue will never exceed content size. 52 | 53 | [?init] is the initial position of the tongue. Usually element of [~stops]. 54 | By default [`Px 70]. 55 | 56 | [?handle] is the element that will we used as handle to move the tongue 57 | (usually an element of the content). 58 | It must be a D element. 59 | By default, it is the whole tongue. 60 | 61 | [?update] is a react event you can use to command the tongue position 62 | from outside. 63 | 64 | *) 65 | --------------------------------------------------------------------------------