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

schleifen-makros fuer das farbendemo

Browse source
This commit is contained in:
Denis Knauf 2011-01-16 01:52:12 +01:00
parent 39ebc335e8
commit f65d5abc2c
2 changed files with 19 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
presentation.fs
View file

@ -31,9 +31,12 @@
: typewriter-type ( addr len -- ) over + swap +do 10 ms i @ emit loop ; : typewriter-type ( addr len -- ) over + swap +do 10 ms i @ emit loop ;
variable ptype-lenl \ Wieviele Zeichen bereits in dieser Zeile geschrieben wurden variable ptype-lenl \ Wieviele Zeichen bereits in dieser Zeile geschrieben wurden
defer ptype-type
' type is ptype-type
: ptype-word ( addrw addrc c -- addrc+1 ) : ptype-word ( addrw addrc c -- addrc+1 )
-rot \ c addrw addrc -rot \ c addrw addrc
dup -rot over - type \ c addrc dup -rot over - ptype-type \ c addrc
swap emit 1+ \ addrc+1 swap emit 1+ \ addrc+1
; ;
: ptype-init ( addr len lenm lenl -- addre lenm lenl addrw addre addr ) : ptype-init ( addr len lenm lenl -- addre lenm lenl addrw addre addr )
@ -63,7 +66,7 @@ variable ptype-lenl \ Wieviele Zeichen bereits in dieser Zeile geschrieben wurde
2over drop >= \ lenm addrw lenl addrc addrc-lenl>=addrw 2over drop >= \ lenm addrw lenl addrc addrc-lenl>=addrw
if \ Wort ist laenger als eine Zeile -> muss umgebrochen werden. if \ Wort ist laenger als eine Zeile -> muss umgebrochen werden.
1- -rot 1- -rot 2dup - \ lenm lenl addrc-1 addrw addrc-1-addrw 1- -rot 1- -rot 2dup - \ lenm lenl addrc-1 addrw addrc-1-addrw
type ." -" nip 1 swap dup \ lenm lenl addrw=addrc-1 addrc-1 ptype-type ." -" nip 1 swap dup \ lenm lenl addrw=addrc-1 addrc-1
else \ Word erst in der naechsten Zeile ausgeben. else \ Word erst in der naechsten Zeile ausgeben.
nip 2dup - negate -rot \ lenm addrc-addrw addrw addrc nip 2dup - negate -rot \ lenm addrc-addrw addrw addrc
then then
@ -120,6 +123,9 @@ ptype-reset \ ptype-lenl sollte von Anfang an 0 sein
: </bc> ( -- ) ['] {/bc} , ; : </bc> ( -- ) ['] {/bc} , ;
: {br} ( addr -- addr ) cr ptype-reset ; : {br} ( addr -- addr ) cr ptype-reset ;
: <br> ( -- , xt-{br} ) ['] {br} , ; : <br> ( -- , xt-{br} ) ['] {br} , ;
\ : {animation} ( addr -- addr ) cell+ @ is ptype-type ;
\ : <animation> ( -- addr u- , xt-{animation} 0 ) ['] {animation} , ' , ;
\ : </animation> ( -- ) ['] {/animation} , ;
\ Es folgen ein paar blockorientierte Kennzeichnungen. \ Es folgen ein paar blockorientierte Kennzeichnungen.
: {h} ( addr , len -- addr ) : {h} ( addr , len -- addr )
cr cr

22
presentation.p.fs
View file

@ -26,17 +26,17 @@
<li> <f> s\" <u> !\" Unterstrichen\" </u>" !! </f> !" : " <u> !" Unterstrichen" </u> </li> <li> <f> s\" <u> !\" Unterstrichen\" </u>" !! </f> !" : " <u> !" Unterstrichen" </u> </li>
; ;
: farbendemo : farbendemo'' <fc> !" ====" ;
0 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> : farbendemo'
1 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> 7 0 +do
2 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> i postpone literal postpone <bc>
3 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> 7 0 +do
4 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> i postpone literal postpone farbendemo''
5 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> loop
6 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" <br> postpone <br>
7 <bc> 0 <fc> !" ====" 1 <fc> !" ====" 2 <fc> !" ====" 3 <fc> !" ====" 4 <fc> !" ====" 5 <fc> !" ====" 6 <fc> !" ====" 7 <fc> !" ====" loop
</bc> </fc> ; immediate
; : farbendemo farbendemo' </bc> </fc> ;
<presentation> <presentation>
<h> !" Dies ist eine Testpraesentation!" </h> <h> !" Dies ist eine Testpraesentation!" </h>