diff --git a/presentation.fs b/presentation.fs index 1f5c426..1c4a2f7 100755 --- a/presentation.fs +++ b/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 ; -: 0 ; -: page_steps ( 0 [x] -- 0 x ) - \ x muss ungleich 0 sein. falls x nicht vorhanden: 1 - dup 0= if 1 then +: ( -- 0 addr0 ) 0 here ; +: ( 0 -- 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 +)