schleifen-makros fuer das farbendemo

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

View file

@ -31,9 +31,12 @@
: typewriter-type ( addr len -- ) over + swap +do 10 ms i @ emit loop ;
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 )
-rot \ c addrw addrc
dup -rot over - type \ c addrc
dup -rot over - ptype-type \ c addrc
swap emit 1+ \ addrc+1
;
: 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
if \ Wort ist laenger als eine Zeile -> muss umgebrochen werden.
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.
nip 2dup - negate -rot \ lenm addrc-addrw addrw addrc
then
@ -120,6 +123,9 @@ ptype-reset \ ptype-lenl sollte von Anfang an 0 sein
: </bc> ( -- ) ['] {/bc} , ;
: {br} ( addr -- addr ) cr ptype-reset ;
: <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.
: {h} ( addr , len -- addr )
cr

View file

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