#! /usr/bin/env gforth
: print-first-usage
." Tapez 'aide' pour la liste des commandes" cr cr ;
print-first-usage
warnings off
vocabulary <fex>
: only-fex only <fex> also <fex> definitions
get-order 2drop nip 1 set-order ;
: fex-and-forth only forth also <fex> also forth definitions ;
: debug .s cr ;
: next-word
0 begin bl word dup count nip
if swap exit then
swap 1+ swap refill
while drop repeat swap ;
: append
over over >r >r count chars + swap chars move
r> r> dup >r c@ + r> c! ;
: N>S DUP >R ABS S>D <# #S R> SIGN #> ;
0 constant (view-documentation)
1 constant (store-documentation)
-1 constant (no-documentation)
variable (documentation-state) (no-documentation) (documentation-state) !
: (treat-doc)
(documentation-state) @ case
(view-documentation) of type cr r> drop exit endof
(store-documentation) of r> drop exit endof
2drop
endcase
;
: view-documentation (view-documentation) (documentation-state) ! ;
: store-documentation (store-documentation) (documentation-state) ! ;
: no-documentation (no-documentation) (documentation-state) ! ;
: ->documentation (documentation-state) @ view-documentation ;
: documentation-> (documentation-state) ! ;
: documentation
->documentation
bl word find if execute else drop then
documentation-> ;
: doc"
postpone s\" postpone (treat-doc)
; immediate
: wordlist-words-documentation [ has? ec 0= [IF] ] wordlist-id [ [THEN] ]
BEGIN
@ dup
WHILE
dup name>string 2dup 2 spaces type ." : " evaluate
REPEAT
drop ;
: syntaxe
get-order only-fex
->documentation
context @ wordlist-words-documentation
documentation->
set-order ;
: find-in-arg?
false -rot
argc @ 0 do I arg 2over compare 0= if rot drop true -rot then loop 2drop ;
: usage
cr ." <---------------------------------------------------------------------------->"
cr ." < Usage: bye, make-dvi, make-ps, view-ps, make-pdf, view-pdf, >"
cr ." < save-ps, save-pdf, clean, clean-all, print >"
cr ." <---------------------------------------------------------------------------->"
cr ;
: help
." Command line arguments are:" cr
." -h, --help This help" cr
." -a, --aide Cette aide et les mots prédéfinis" cr
." -f Output to file" cr
." -t Output to stdin" cr
." -q Quit after processing" cr
." -pdf Make a pdf" cr
." -view-pdf View the generated pdf" cr
." -save-ps Save the ps file" cr
." -save-pdf Save the pdf file" cr
." -clean Clean the output directory" cr
." -clean-all Clean the output directory and 'output'.ps/.pdf" cr
;
: aide
help
cr ." Mots prédéfinis :" cr
syntaxe ;
variable (need-space) false (need-space) !
: +space true (need-space) ! ;
: -space false (need-space) ! ;
0 value fd-out
create ps-name$ 5000 chars allot
create pdf-name$ 5000 chars allot
create cmd$ 5000 chars allot
: exec-cmd$ cmd$ count 2dup system type cr ;
: i->cmd$ cmd$ place ;
: ->cmd$ cmd$ append ;
: basename argc @ 1- arg 3 - ;
: ps-name basename ps-name$ place s" ps" ps-name$ append ps-name$ count ;
: pdf-name basename pdf-name$ place s" pdf" pdf-name$ append pdf-name$ count ;
: clean s" rm -rf ./output" system ;
: create-dir s" mkdir ./output" system ;
: open-file s" ./output/output.tex" w/o create-file throw to fd-out ;
: close-file fd-out close-file throw ;
: make-dvi
s" cp ./*.eps output/" system
s" cd ./output && latex output.tex" system ;
: make-ps s" cd ./output && dvips output.dvi -o -t a4" system ;
: view-ps s" gv --nocenter ./output/output.ps" system ;
: make-pdf s" cd ./output && ps2pdf output.ps" system ;
: view-pdf s" xpdf ./output/output.pdf" system ;
: print s" lpr ./output/output.ps" system ;
: save-ps
s" cp output/output.ps " i->cmd$ ps-name ->cmd$ exec-cmd$ ;
: save-pdf
s" cp output/output.pdf " i->cmd$ pdf-name ->cmd$ exec-cmd$ ;
: pdf make-pdf save-pdf view-pdf ;
: clean-all
s" rm -rf ./output " i->cmd$ ps-name ->cmd$ s" " ->cmd$ pdf-name ->cmd$ exec-cmd$ ;
: make-pdf? s" -pdf" find-in-arg? if make-pdf then ;
: view-pdf? s" -view-pdf" find-in-arg? if view-pdf then ;
: save-ps? s" -save-ps" find-in-arg? if save-ps then ;
: save-pdf? s" -save-pdf" find-in-arg? if save-pdf then ;
: clean? s" -clean" find-in-arg? if clean then ;
: clean-all? s" -clean-all" find-in-arg? if clean-all then ;
: proceed-document make-dvi make-ps view-ps
make-pdf? view-pdf? save-ps? save-pdf? clean? clean-all?
usage ;
variable (->file?) false (->file?) !
variable (->file-futur?) false (->file-futur?) !
: ->file? (->file?) @ ;
: =>stdin false (->file-futur?) ! ;
: =>file true (->file-futur?) ! ;
: set-output (->file-futur?) @ (->file?) ! ;
: reset-output false (->file?) ! ;
: (file-open) clean create-dir open-file ;
: (file-close) close-file proceed-document ;
: (file-type) fd-out write-file throw ;
: (file-cr) s" " fd-out write-line throw ;
: (file-.) N>S fd-out write-line throw ;
: open set-output ->file? if (file-open) then ;
: close ->file? if (file-close) then reset-output ;
: type ->file? if (file-type) else type then ;
: space s" " type ;
: cr ->file? if (file-cr) else cr then ;
: o." postpone ." ; immediate
: ." postpone s" postpone type ; immediate
: . ->file? if (file-.) else . then ;
: print-space
(need-space) @ if space then ;
: print-word
print-space count type +space ;
: execute-or-print
find if execute else print-word then ;
: treat-newlines
dup 0 > if 0 do cr loop -space else drop then ;
: treat-word
treat-newlines execute-or-print ;
: treat-EOL
begin BL word dup count nip while execute-or-print repeat drop ;
: generic-space print-space type bl parse type ." }" ;
: generic-complex
print-space ." \underline{" type ." }_{" bl parse type ." }" ;
: header
." \documentclass[a4paper,french,12pt]{article}" cr
." %\documentclass[a4paper,twocolumn,french,12pt]{article}" cr
." \usepackage[latin1]{inputenc}" cr
." %\usepackage{ucs}" cr
." %\usepackage[utf8]{inputenc}" cr
." \usepackage[T1]{fontenc}" cr
." \usepackage[french]{}" cr
." \usepackage[french]{babel}" cr
." \usepackage[]{indentfirst}" cr
." \usepackage[]{graphicx}" cr
." \usepackage{epsfig}" cr
." \usepackage{psfrag}" cr
." \usepackage{multido}" cr
." \usepackage{latexsym} % for \psfrag{sg}{$\rhd\infty$}" cr
." \usepackage[margin=2cm, noheadfoot, portrait]{geometry}" cr
." %\addtolength{\columnsep}{0.5cm}" cr
." %\setlength{\columnseprule}{1pt}" cr
." \pagestyle{empty}" cr cr
." \begin{document}" cr cr
;
: footer
cr cr ." \end{document}" cr cr ;
: (|->|) ." |" ;
: (|->&) ." &" ;
defer (|)
' (|->|) is (|)
: (normal--) ." --" ;
: (tabular--) ." \\ \hline " ;
defer (--)
' (normal--) is (--)
: normal-)( ." )(" ;
: ignore-)( ;
defer [)(]
' normal-)( is [)(]
: open-document open header only-fex ;
: close-document fex-and-forth footer close ;
: call >r ;
: ==> 2over compare 0= if 2drop r> call rdrop exit then rdrop ;
: or-f s" -f" ==> =>file ;
: or-t s" -t" ==> =>stdin ;
: or-h s" -h" ==> help bye ;
: or-help s" --help" ==> help bye ;
: or-aide s" --aide" ==> aide bye ;
: or-a s" -a" ==> aide bye ;
: treat-arg
or-f or-t or-help or-h or-aide or-a 2drop ;
: analyse-args argc @ 0 do I arg treat-arg loop ;
: quit-if-needed s" -q" find-in-arg? if bye then ;
2variable simple-taille s" 1" simple-taille 2!
2variable double-taille s" 2.5" double-taille 2!
2variable taille-reponse simple-taille 2@ taille-reponse 2!
: (->reponse-boite)
doc" Affiche une boite reponse"
." \fbox{\parbox{15cm}{ \vspace{" taille-reponse 2@ type ." cm} ~}} % " ;
: (->reponse)
doc" Met la reponse dans une boite reponse"
." \fbox{\parbox{15cm}{ " treat-EOL ." }}" ;
variable (done) 0 (done) !
: done -1 (done) ! ;
: not-done 0 (done) ! ;
: done? (done) @ ;
: main-loop
begin next-word treat-word done? until ;
<fex> definitions
: document(
doc" Commence un nouveau document"
open-document not-done main-loop ;
: )document
doc" Fin du document"
done close-document quit-if-needed ;
: forth(
doc" Execute le code forth"
done fex-and-forth ;
: )forth
doc" Fin de l'execution du code. Revient à fex"
not-done only-fex main-loop ;
: _(
doc" Début de soulignement"
print-space ." \underline{" -space ;
: )_
doc" Fin de soulignement"
." }" ;
: *(
doc" Début de mots en gras"
print-space ." \textbf{" -space ;
: )*
doc" Fin de mots en gras"
." }" ;
: /(
doc" Début de mots en italique"
print-space ." \textit{" -space ;
: )/
doc" Fin de mots en italique"
." }" ;
: titre:
doc" Défini le reste de la ligne comme un titre"
." \begin{center} \fbox{ \Large{\textbf{" -space treat-EOL
." }}} \end{center}" -space ;
: section:
doc" Défini le reste de la ligne comme une nouvelle section"
." \subsection*{" -space treat-EOL
." }" -space ;
: image:
doc" Insert une image"
." \psfig{file=" -space treat-EOL
." }" -space ;
: numerote(
doc" Début de numérotation"
." \begin{enumerate}" -space ;
: )numerote
doc" Fin de numérotation"
." \end{enumerate}" -space ;
: =>
doc" Nouvel item"
." \item" +space ;
: (ligne)
doc" Insère une nouvelle ligne"
cr -space ;
: (paragraphe)
doc" Insère un nouveau paragraphe"
cr cr -space ;
: (page)
doc" Insère une nouvelle page"
cr cr ." \newpage" cr cr -space ;
: tableau(
doc" Début d'un tableau\n Syntaxe : tableau( Ncolonnes )(\n case1 | case2 | ...\n --\n case3 | case4 | ...\n )tableau"
." \begin{tabular}{"
['] (|->&) is (|) ['] (tabular--) is (--)
['] ignore-)( is [)(]
bl word number drop 0 do ." |c" loop ." |} \hline" -space ;
: )tableau
doc" Fin d'un tableau"
." \\ \hline \end{tabular}" -space
['] (|->|) is (|) ['] (normal--) is (--)
['] normal-)( is [)(] ;
: --
doc" Nouvelle ligne d'un tableau"
(--) ;
: |
doc" Nouvelle colonne d'un tableau"
print-space (|) ;
: )(
doc" Fin d'une option pour tableau ou boite"
[)(] ;
: hspace=
doc" Ajoute un espace horizontal\n syntaxe : hspace= Ncm"
s" \hspace{" generic-space ;
: vspace=
doc" Ajoute un espace vertical\n syntaxe : vspace= Ncm"
s" \vspace{" generic-space ;
: centre(
doc" Centre le texte"
print-space ." \begin{center}" -space ;
: )centre
doc" Centre le texte"
print-space ." \end{center}" -space ;
: gauche(
doc" Aligne le texte à gauche"
print-space ." \begin{flushleft}" -space ;
: )gauche
doc" Aligne le texte à gauche"
print-space ." \end{flushleft}" -space ;
: droite(
doc" Aligne le texte à droite"
print-space ." \begin{flushright}" -space ;
: )droite
doc" Aligne le text à droite"
print-space ." \end{flushright}" -space ;
: encadre(
doc" Début de texte encadré"
print-space ." \fbox{" -space ;
: )encadre
doc" Fin de texte encadré"
." }" -space ;
: boite(
doc" Début d'une boite\n Syntaxe : boite( Ncm )( bla bla )boite"
['] ignore-)( is [)(]
print-space ." \parbox{" bl word count type ." }{" -space ;
: )boite
doc" Fin d'une boite"
['] normal-)( is [)(]
." }" -space ;
: marge:
doc" Affiche le prochain mot dans la marge à droite"
print-space ." \marginpar{" bl word count type ." }" -space ;
: Z_
doc" Une impedance" s" Z" generic-complex ;
: U_
doc" Une tension" s" U" generic-complex ;
: I_
doc" Un courant" s" I" generic-complex ;
: Y_
doc" Une admittance" s" Y" generic-complex ;
: _Ohm
doc" Affiche le signe Omega" ." \Omega" ;
defer ->reponse:
: (reponse->visible)
doc" Les réponses deviennent visibles"
['] (->reponse) is ->reponse: ;
: (reponse->invisible)
doc" Les réponses deviennent invisibles"
['] (->reponse-boite) is ->reponse: ;
: (simple-reponse)
doc" Simple taille de reponse"
simple-taille 2@ taille-reponse 2! ;
: (double-reponse)
doc" Double la taille de la reponse"
double-taille 2@ taille-reponse 2! ;
: (entete-nom)
doc" Affiche une entête avec nom, prénom et note"
." \parbox{3cm}{Prénom : \\ Nom :} \hspace{4cm} Classe : \hspace{3cm} \framebox[3.8cm][l]{Note : \hspace{1.5cm} / 20 }" ;
fex-and-forth =>file
analyse-args