From 29ec3389347925453fc4f227168a526992d9e285 Mon Sep 17 00:00:00 2001 From: stucco Date: Sun, 16 Jan 2011 17:31:26 +0100 Subject: [PATCH] implemented --- presentation.p.fs | 45 ++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 42 insertions(+), 3 deletions(-) diff --git a/presentation.p.fs b/presentation.p.fs index 1a3a3f3..126074a 100644 --- a/presentation.p.fs +++ b/presentation.p.fs @@ -38,6 +38,41 @@ ; immediate : farbendemo farbendemo' ; +256 Constant max-line +Create line-buffer max-line 2 + allot + +0 Value fd-in +: open-input ( addr u -- ) r/o open-file throw to fd-in ; + +: printsource ( from to addr u -- ) + open-input + cr + 0 + begin + 1+ + line-buffer max-line fd-in read-line throw + while + swap 2over rot swap over >= if + swap over <= if + dup 0 U.R s" -> " type swap line-buffer swap type cr + else swap drop + endif + else swap drop swap drop + endif + repeat + 2drop 2drop + fd-in close-file throw ; + +: printCodeHeader ( end start namelen addr -- ) \ prints source code header containing line numbers + swap 2dup type 2swap \ s" (" type 0 U.R s" -" type 0 U.R s" ): " type cr cr type ; + swap 2swap cr printsource cr ; \ type emit emit ; + +: {source} ( -- ) ; +: ( -- , xt-{source} ) ['] {source} , ; +: {/source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * + + @ swap cell 3 * + @ printCodeHeader 4 cells + ; +: ( -- , xt-{/source} ) ['] {/source} , , , , , ; + !" Dies ist eine Testpraesentation!"

@@ -46,9 +81,9 @@ !" ] die tolle Idee, eine Praesentationssoftware zu schreiben."

- <||> !" erstens" - <||> !" zweitens" - <||> !" dann" + <||> !" Forth eignet sich gut für Domain specific languages." + <||> !" Makros sind ein Heidenspass." + <||> !" Execution tokens erzeugen unseren Code."

!" Ergebnis" @@ -69,4 +104,8 @@
  • !" Vordergrundfarbe: " s\" Brown !\" text\" " !! !" : " Brown !\" text"
  • !" 8 Farben sind moeglich:"

    farbendemo

    + + !" Und Source" +
    + s" presentation.fs" 10 20