deac/presentation.fs
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

<text> tag hinzugefuegt; wie <source> nur ohne fuehrende zeilennummern; printsource dafeur angepasst

Browse source
This commit is contained in:
stucco 2011-01-20 21:56:15 +01:00
parent a5f040edf8
commit fd16244a04
1 changed files with 14 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
presentation.fs
View file

@ -218,8 +218,10 @@ Create line-buffer max-line 2 + allot
: open-input ( addr u -- ) r/o open-file throw to fd-in ; : open-input ( addr u -- ) r/o open-file throw to fd-in ;
: printsource ( from to addr u -- ) : printsource ( from to addr u -- )
{ showLines }
open-input open-input
cr cr
\ showLines 0 U.R
0 0
begin begin
1+ 1+
@ -227,7 +229,9 @@ Create line-buffer max-line 2 + allot
while while
swap 2over rot swap over >= if swap 2over rot swap over >= if
swap over <= if swap over <= if
dup 0 U.R s" -> " type swap line-buffer swap type cr showLines if dup 0 U.R s" -> " type swap line-buffer swap type cr
else swap line-buffer swap type cr
endif
else swap drop else swap drop
endif endif
else swap drop swap drop else swap drop swap drop
@ -237,15 +241,22 @@ Create line-buffer max-line 2 + allot
fd-in close-file throw ; fd-in close-file throw ;
: printCodeHeader ( end start namelen addr -- ) \ prints source code header containing line numbers : printCodeHeader ( end start namelen addr -- ) \ prints source code header containing line numbers
{ showLines }
swap 2dup type 2swap \ s" (" type 0 U.R s" -" type 0 U.R s" ): " type cr cr type ; 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 ; swap 2swap cr showLines printsource cr ; \ type emit emit ;
: {source} ( -- ) ; : {source} ( -- ) ;
: <source> ( -- , xt-{source} ) ['] {source} , ; : <source> ( -- , xt-{source} ) ['] {source} , ;
: {/source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * + : {/source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * +
@ swap cell 3 * + @ printCodeHeader 4 cells + ; @ swap cell 3 * + @ 1 printCodeHeader 4 cells + ;
: </source> ( -- , xt-{/source} ) ['] {/source} , , , , , ; : </source> ( -- , xt-{/source} ) ['] {/source} , , , , , ;
: {file} ( -- ) ;
: <file> ( -- , xt-{file} ) ['] {file} , ;
: {/file} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * +
@ swap cell 3 * + @ 0 printCodeHeader 4 cells + ;
: </file> ( -- , xt-{/file} ) ['] {/file} , , , , , ;
: {np} ( -- ) : {np} ( -- )
0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen 0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen
page \ Bildschirm leeren page \ Bildschirm leeren