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

moved <source> to core presentation.fs

master
stucco 2011-01-16 19:06:02 +01:00
parent 29ec338934
commit 6a3e2788c9
2 changed files with 35 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
presentation.fs
View File

@ -226,6 +226,41 @@ variable enumerationCount ( -- addr )
: {/en} ( -- ) ;
: </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} ( -- ) ;
: <source> ( -- , xt-{source} ) ['] {source} , ;
: {/source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * +
@ swap cell 3 * + @ printCodeHeader 4 cells + ;
: </source> ( -- , xt-{/source} ) ['] {/source} , , , , , ;
: {np} ( -- )
0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen

35
presentation.p.fs
View File

@ -38,41 +38,6 @@
; immediate
: farbendemo farbendemo' </bc> </fc> ;
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} ( -- ) ;
: <source> ( -- , xt-{source} ) ['] {source} , ;
: {/source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * +
@ swap cell 3 * + @ printCodeHeader 4 cells + ;
: </source> ( -- , xt-{/source} ) ['] {/source} , , , , , ;
<presentation>
<h> !" Dies ist eine Testpraesentation!" </h>
<p>