diff --git a/presentation.fs b/presentation.fs index aff8cd0..b61e5d4 100755 --- a/presentation.fs +++ b/presentation.fs @@ -226,6 +226,41 @@ variable enumerationCount ( -- addr ) : {/en} ( -- ) ; : ( -- , xt-{/en} ) ['] {en} , ; +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} , , , , , ; + : {np} ( -- ) 0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen diff --git a/presentation.p.fs b/presentation.p.fs index 126074a..6d6f04f 100644 --- a/presentation.p.fs +++ b/presentation.p.fs @@ -38,41 +38,6 @@ ; 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!"