-- 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 ) ;
+: ( -- addr u0 ) ['] [h] , here 0 ;
+: ( addr len -- ) ['] [/h] , swap ! ;
+: ( -- 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 ) 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] , ;
+: ( -- ) ['] [u] , ;
+: ( -- ) ['] [/u] , ;
+: ( -- ) ['] [b] , ;
+: ( -- ) ['] [/b] , ;
+: ( -- ) ['] [fc] , ;
+: ( -- ) ['] [/fc] , ;
+: ( -- ) ['] [bc] , ;
+: ( -- ) ['] [/bc] , ;
+
+: ( -- addr ) \ Wir legen jede Anfangsadresse einer Seite auf den Stack (Achtung, in umgekehrter Reihenfolge
+ here
;
-: csi 27 91 ;
-: ( -- addr 0 ) 2 c, here 0 ;
-: ( addr len -- ) 3 c, swap ! ;
-: ( -- addr 0 ) 4 c, here 0 ;
-:
( addr len -- ) 5 c, swap ! ;
-: ( -- ) 6 c, ;
-: ( -- ) 7 c, ;
-: ( -- ) 8 c, ;
-: ( -- ) 9 c, ;
-\ : 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
+;
s" Dies ist eine Testpresentation" !!
@@ -52,7 +125,9 @@ bye
s" Sieht doch garnicht so schlecht aus" !!
+( bye
\ presentation ist gestartet: erste Seite wird angezeigt
n \ zweite Seite
p \ erste Seite
2 n \ dritte Seite
+)