From 9644964c7f88503a351f2f3a2c0ff65bd9c60f08 Mon Sep 17 00:00:00 2001 From: Denis Knauf Date: Sat, 25 Dec 2010 15:40:07 +0100 Subject: [PATCH] np-bug beseitigt --- presentation.fs | 125 +++++++++++++++++++++++++++--------------------- 1 file changed, 70 insertions(+), 55 deletions(-) diff --git a/presentation.fs b/presentation.fs index 7ca28e3..be677ee 100755 --- a/presentation.fs +++ b/presentation.fs @@ -1,7 +1,5 @@ #! /usr/bin/gforth -\ \ here-allokation wird als fifo verwendet. -\ : copy ( addrdst addrsrc len -- addrdstend ) over ( dst src len src ) + swap ( dst end src ) do ( dst+ ) @@ -10,69 +8,77 @@ loop ; -: ( -- 0 addr0 ) 0 here ; -: ( 0 -- faddr laddr paddr 0 ) - here .s \ 0 faddr - begin swap dup \ 0 addr0 faddr - while - s" New page at " type here . s" to " type dup . newline type - , \ 0 faddr - repeat .s - drop \ faddr - here dup 0 \ faddr laddr paddr 0 -; - : csi ( -- ) 27 emit 91 emit ; : sgr ( u -- ) csi 0 0 d.r 109 emit ; -: beep 7 type ; +: beep 7 emit s" *beep* " type ; \ Es folgen ein paar blockorientierte Kennzeichnungen. -: {h} ( addr -- addr ) ; +: {h} ( addr -- addr ) cell+ ; \ header : {/h} ( addr -- addr ) ; -: {p} ( addr -- addr ) ; +: {p} ( addr -- addr ) cell+ ; \ paragraph : {/p} ( addr -- addr ) ; -: ( -- addr u0 ) ['] {h} , here 0 ; +: ( -- addr u0 ) ['] {h} , here 0 ; : ( addr len -- ) ['] {/h} , swap ! ; -:

( -- addr u0 ) ['] {p} , here 0 ; +:

( -- addr u0 ) ['] {p} , here 0 ; :

( addr len -- ) ['] {/p} , swap ! ; \ Es folgen ein paar syntaktische Textauszeichnungen. : {i} ( addr -- addr ) 7 sgr ; : {/i} ( addr -- addr ) 27 sgr ; -: {b} ( addr -- addr ) 1 sgr ; +: {b} ( addr -- addr ) 1 sgr ; \ bold : {/b} ( addr -- addr ) 22 sgr ; -: {u} ( addr -- addr ) 4 sgr ; +: {u} ( addr -- addr ) 4 sgr ; \ underline : {/u} ( addr -- addr ) 24 sgr ; -: {fc} ( addr -- addr ) dup @ 30 + sgr 1 cells + ; +: {fc} ( addr -- addr ) dup @ 30 + sgr cell+ ; \ frontcolor : {/fc} ( addr -- addr ) 39 sgr ; -: {bc} ( addr -- addr ) dup @ 40 + sgr 1 cells + ; +: {bc} ( addr -- addr ) dup @ 40 + sgr cell+ ; \ backgroundcolor : {/bc} ( addr -- addr ) 49 sgr ; -: ( -- ) ['] {i} , ; -: ( -- ) ['] {/i} , ; -: ( -- ) ['] {u} , ; -: ( -- ) ['] {/u} , ; -: ( -- ) ['] {b} , ; -: ( -- ) ['] {/b} , ; -: ( -- ) ['] {fc} , ; +: ( -- ) ['] {i} , ; +: ( -- ) ['] {/i} , ; +: ( -- ) ['] {u} , ; +: ( -- ) ['] {/u} , ; +: ( -- ) ['] {b} , ; +: ( -- ) ['] {/b} , ; +: ( -- ) ['] {fc} , , ; : ( -- ) ['] {/fc} , ; -: ( -- ) ['] {bc} , ; +: ( -- ) ['] {bc} , , ; : ( -- ) ['] {/bc} , ; -: ( -- addr ) \ Wir legen jede Anfangsadresse einer Seite auf den Stack (Achtung, in umgekehrter Reihenfolge - here +: {np} ( -- ) + 0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen + \ csi s" 2J" type \ Bildschirm leeren ; -\ : <+> ( addr1 len1 addr2 len2 -- addrdst lendst ) -\ rot 2dup + here ( addr1 addr2 len2 len1 lendst addrdst ) -\ 2-rot -rot ( lendst addrdst addr1 len1 addr2 len2 ) -\ 2swap 2rot ( addr2 len2 addr1 len1 lendst addrdst ) -\ 2dup chars allot ( dst allocated ) -\ copy copy -\ ; -: !! ( len0 addr1 len1 -- len ) - 1 , +: ( -- addr ) \ Wir legen jede Anfangsadresse einer Seite auf den Stack (Achtung, in umgekehrter Reihenfolge + here ['] {np} , +; +: {!!} ( addr -- addr+2 ) + s" string-> " type .s newline type + dup @ \ addr straddr + cell+ \ straddr addr + tuck @ \ addr straddr strlen + type \ addr + cell+ + s" string<- " type .s newline type +; +: !! ( len0 addr1 len1 -- len !! '{!!} addr1 len1 ) + ['] {!!} , dup \ len0 addr1 len1 len1 rot , , \ len0 len1 len1 addr1 -> len0 len1 - + + + \ len0+len1 ; +: ( -- 0 addr0 !! '{np} ) 0 here ['] {np} , ; +: ( 0 -- faddr laddr paddr 0 !! endaddr 0 0 0 0 <...addr> ) + here \ 0 faddr + 0 , 0 , 0 , 0 , + begin swap dup \ 0 addr0 faddr + while , \ 0 faddr + repeat .s + drop \ faddr + here dup 0 \ faddr laddr paddr 0 +; +: pres_page_cur ( addr -- addr ) ; +: pres_page_from ( addr -- addr ) cell+ ; +: pres_page_to ( addr -- addr ) 2 cells + ; + \ faddr: erste Seitenzeigeradresse (letzte Presentationsseite) \ laddr: letzte Seitenzeigeradresse (erste Presentationsseite) \ paddr: derzeitige Seitenzeigeradresse @@ -80,29 +86,36 @@ : page_steps ( laddr paddr 0 [u] -- laddr naddr ) \ u muss ungleich 0 sein. falls u nicht vorhanden: 1 dup 0= if 1 then \ laddr paddr 0 u - nip cells - + nip cells - .s ; : validpage? ( faddr laddr paddr -- faddr laddr paddr u ) - 2dup > \ faddr laddr paddr u - 2over drop rot tuck < - rot and + 2dup < \ faddr laddr paddr u + 2over drop rot tuck >= + rot \ faddr laddr paddr u u + if drop cell - -1 \ faddr laddr paddr-1 -1 + else if cell+ -1 \ faddr laddr paddr+1 -1 + else 0 \ faddr laddr paddr 0 + then then ; : showpage' ( paddr -- ) - dup cell+ \ paddr paddr+cell + dup cell - .s \ paddr paddr+cell @ swap @ \ naddr addr \ Seiteninhaltsadressen - 0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen - \ csi s" 2J" type \ Bildschirm leeren - begin 2dup > + begin + s" ++ " type 2dup . . + 2dup > + dup . newline type while dup cell+ swap \ naddr xtaddr xtaddr @ \ naddr xtaddr xt + s" -> " type .s newline type execute \ verschiebt eventuell den Zeiger noch weiter, wenn es Parameter erwartet. + s" <- " type .s newline type repeat - drop drop + 2drop ; : showpage ( faddr laddr paddr -- faddr laddr paddr 0 ) validpage? - 0= if beep then + if beep then dup showpage' 0 ; : n ( faddr laddr paddr 0 [u] -- faddr laddr paddr 0 ) @@ -114,11 +127,13 @@ showpage ; : p ( faddr laddr paddr 0 [u] -- faddr laddr paddr 0 ) - negate n + page_steps negate + showpage ; +here . newline type - s" Dies ist eine Testpresentation" !! + s" Dies ist eine Testpresentation!" !!

s" Eines Tages hatten wir (" !! s" Harald Steinlechner" !! s" und" !! s" Denis Knauf" !!