speichern der struktur fertig.

presentation.fs

@@ -1,5 +1,7 @@
 #! /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+ )
@@ -8,25 +10,50 @@
 	loop
 ;
 
-: </presentation> 0 ;
-: page_steps ( 0 [x] -- 0 x )
-	\ x muss ungleich 0 sein. falls x nicht vorhanden: 1
-	dup 0= if 1 then
+: <presentation> ( -- 0 addr0 ) 0 here ;
+: </presentation> ( 0 <addr...> -- faddr paddr 0 )
+	0 ,
+	dup begin swap dup , 0= until
+	here 0
 ;
-: n ( 0 [x] -- 0 )
-	page_steps
-	( ... x seiten weiterspringen ... )
+
+: csi ( -- ) 27 emit 91 emit ;
+: sgr ( u -- ) csi 0 0 d.r 109 emit ;
+: beep 7 type ;
+\ Es folgen ein paar blockorientierte Kennzeichnungen.
+: [h]  ( addr -- addr ) ;
+: [/h] ( addr -- addr ) ;
+: [p]  ( addr -- addr ) ;
+: [/p] ( addr -- addr ) ;
+: <h>  ( -- addr u0 ) ['] [h] , here 0 ;
+: </h> ( addr len -- ) ['] [/h] , swap ! ;
+: <p>  ( -- addr u0 ) ['] [p] , here 0 ;
+: </p> ( 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 ) 22 sgr ;
+: [u]   ( addr -- addr )  4 sgr ;
+: [/u]  ( addr -- addr ) 24 sgr ;
+: [fc]  ( addr -- addr ) dup @ 30 + sgr 1 cells + ;
+: [/fc] ( addr -- addr ) 39 sgr ;
+: [bc]  ( addr -- addr ) dup @ 40 + sgr 1 cells + ;
+: [/bc] ( addr -- addr ) 49 sgr ;
+: <i>   ( -- ) ['] [i]   , ;
+: </i>  ( -- ) ['] [/i]  , ;
+: <u>   ( -- ) ['] [u]   , ;
+: </u>  ( -- ) ['] [/u]  , ;
+: <b>   ( -- ) ['] [b]   , ;
+: </b>  ( -- ) ['] [/b]  , ;
+: <fc>  ( -- ) ['] [fc]  , ;
+: </fc> ( -- ) ['] [/fc] , ;
+: <bc>  ( -- ) ['] [bc]  , ;
+: </bc> ( -- ) ['] [/bc] , ;
+
+: <np> ( -- addr ) \ Wir legen jede Anfangsadresse einer Seite auf den Stack (Achtung, in umgekehrter Reihenfolge
+	here
 ;
-: csi 27 91 ;
-: <h> ( -- addr 0 ) 2 c, here 0 ;
-: </h> ( addr len -- ) 3 c, swap ! ;
-: <p> ( -- addr 0 ) 4 c, here 0 ;
-: </p> ( addr len -- ) 5 c, swap ! ;
-: <i> ( -- ) 6 c, ;
-: </i> ( -- ) 7 c, ;
-: <b> ( -- ) 8 c, ;
-: </b> ( -- ) 9 c, ;
-\ : <np> begin , 0<> until ;
 \ : <+> ( addr1 len1 addr2 len2 -- addrdst lendst )
 \	rot 2dup + here ( addr1 addr2 len2 len1 lendst addrdst )
 \	2-rot -rot ( lendst addrdst addr1 len1 addr2 len2 )
@@ -34,9 +61,55 @@
 \	2dup chars allot ( dst allocated )
 \	copy copy
 \ ;
-: !! ( len addr len -- len ) 1 c, dup rot , , + ;
+: !! ( len0 addr1 len1 -- len )
+	1 ,
+	dup \ len0 addr1 len1 len1
+	rot , , \ len0 len1 len1 addr1 -> len0 len1
+	+
+;
 
-bye
+\ faddr: erste Seitenzeigeradresse (letzte Presentationsseite)
+\ laddr: letzte Seitenzeigeradresse (erste Presentationsseite)
+\ paddr: derzeitige Seitenzeigeradresse
+
+: page_steps ( laddr paddr 0 [u] -- laddr naddr )
+	\ u muss ungleich 0 sein. falls u nicht vorhanden: 1
+	dup 0= if 1 then nip cells -
+;
+: validpage? ( faddr laddr paddr -- faddr laddr paddr u )
+	2dup > \ faddr laddr paddr u
+	2over drop over \ faddr laddr paddr x faddr x )
+	>= and
+;
+: showpage' ( paddr -- )
+		dup 1 cells + @ swap @ swap \ paddr naddr addr
+		0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen
+		csi s" 2J" type \ Bildschirm leeren
+		begin 2dup >
+		while
+			dup 1 cells + swap \ ... xtaddr+1 xtaddr
+			@ \ ... xtaddr xt
+			execute \ verschiebt eventuell den Zeiger noch weiter, da es Parameter erwartet.
+		repeat
+		drop drop
+;
+: showpage ( faddr laddr paddr -- faddr laddr paddr 0 )
+	validpage?
+	if showpage'
+	else beep
+	then 0
+;
+: p ( faddr laddr paddr 0 [u] -- faddr laddr paddr 0 )
+	page_steps \ faddr paddr x
+	showpage
+;
+: g ( faddr laddr paddr 0 u -- faddr laddr paddr 0 )
+	cells
+	showpage
+;
+: p ( faddr paddr 0 [u] -- faddr paddr 0 )
+	negate n
+;
 
 <presentation>
 <h> s" Dies ist eine Testpresentation" !! </h>
@@ -52,7 +125,9 @@ bye
 <p> s" Sieht doch garnicht so schlecht aus" !! </p>
 </presentation>
 
+( bye
 \ presentation ist gestartet: erste Seite wird angezeigt
 n \ zweite Seite
 p \ erste Seite
 2 n \ dritte Seite
+)