ptype wieder mit lenl - ist einfach schneller als cursorx@ source: | als trennzeichen zwischen nummer und zeile

presentation.fs

@@ -1,5 +1,10 @@
 #! /usr/bin/gforth
 
+\ variable cr-count
+\ : cr cr cr-count dup @ 1+ swap ! ;
+\ : cr-reset 0 cr-count ! ;
+\ : page page cr-reset ;
+
 \ 2-rot ist bei gforth anscheinend nicht definiert
 : 2-rot { a1 a2 b1 b2 c1 c2 } c1 c2 a1 a2 b1 b2 ;
 
@@ -35,7 +40,7 @@ needs ansi.fs
 : cursorx! ( x -- ) cursory@ cursor! ;
 : cursory! ( x -- ) cursorx@ swap cursor! ;
 
-: cursor' ( i c -- ) swap dup if ESC[ 0 .r emit else 2drop then ;
+: cursor' ( i c -- ) swap dup if ESC[ 0 u.r emit else 2drop then ;
 : cursor^ ( i -- ) [char] A cursor' ;
 : cursor_ ( i -- ) [char] B cursor' ;
 : cursor> ( i -- ) [char] C cursor' ;
@@ -79,6 +84,9 @@ variable scroll-delay
 1 scroll-delay !
 
 variable ptype-indent \ Zeile Einruecken
+variable ptype-curx \ cursorx@-emulation durch zaehlen.
+: ptype-cursorx@ ( -- i ) ptype-curx @ ;
+: ptype-curx@! ( -- ) cursorx@ ptype-curx ! ;
 defer ptype-type
 ' type is ptype-type
 : ptype-word ( addrw addrc c -- addrc+1 )
@@ -87,7 +95,12 @@ defer ptype-type
 	swap emit 1+ \ addrc+1
 ;
 : ptype-init ( addr len lenm x -- addre lenm lenl addrw addre addr )
-	{ addr len lenm x }  addr len +  lenm  x dup cursorx! addr  addr len +  addr
+	dup ptype-indent @ \ addr len lenm x x indent
+	swap - \ addr len lenm x indent-x
+	dup 0>= if
+		cursor> drop ptype-indent @
+	else drop then
+	{ addr len lenm x }  addr len +  lenm  x  addr  addr len +  addr
 ;
 : ptype-newline ( lenm lenl addrw addrc -- lenm lenl addrw )
 	10 ptype-word \ lenm lenl addrw=addrc+1
@@ -125,10 +138,13 @@ defer ptype-type
 			drop ptype-anychar
 		endcase
 	loop \ addre lenm lenl addrw
-	nip nip tuck - ptype-type
+	swap ptype-curx ! nip tuck - ptype-type
 ;
-: ptype ( addr len -- ) term-width 1- cursorx@ ptype-init ptype' ;
+: ptype ( addr len -- ) term-width 1- ptype-cursorx@ ptype-init ptype' ;
-: ptype-reset ( -- ) 0 ptype-indent ! ; \ Nicht einruecken
+: ptype-reset ( -- )
+	0 ptype-indent !
+	0 ptype-curx !
+; \ Nicht einruecken
 ptype-reset
 
 : beep 0 term-height 2 - cursor! 7 emit s" *beep* not" type ;
@@ -168,7 +184,7 @@ ptype-reset
 : {h}   ( addr , len -- addr )
 	cr
 	term-width over @ - 2 / \ addr width-twidth/2
-	cursor>
+	dup ptype-curx ! cursor>
 	cell+ {b}
 ; \ header
 : <h>   ( -- addr 0 , xt-{h} 0 )  ['] {h}  , here 0 , 0 ;
@@ -187,7 +203,7 @@ ptype-reset
 : </p>  ( addr len -- , xt-{/p} ) ['] {/p} , swap ! ;
 : {li}  ( addr -- addr )
 	2 cursor> space 1 cursor>
-	6 ptype-indent !
+	6 dup ptype-indent ! ptype-curx !
 	cell+
 ;
 : <li>  ( -- addr u0 , xt-{li} 0 ) ['] {li} , here 0 , 0 ;
@@ -197,7 +213,8 @@ ptype-reset
 variable enumerationCount ( -- addr )
 : {||}  ( addr -- addr )                \ increments enumeration count and prints prefix
 	enumerationCount dup @ 1+ dup rot !
-	2 cursor> 0 U.R ." ." 1 cursor>
+	2 cursor> 0 u.r ." ." 1 cursor>
+	6 dup ptype-indent ! ptype-curx !
 ;
 : <||>  ( -- , xt-{||} 0 ) ['] {||} , ;
 : {/||} ( addr -- addr ) cr ;
@@ -218,27 +235,36 @@ Create line-buffer  max-line 2 + allot
 : open-input ( addr u -- )  r/o open-file throw to fd-in ;
 
 : printsource ( from to addr u -- )
-   open-input
+	open-input
-   cr
+	cr
-   0
+	0
-   begin
+	begin
-      1+
+		1+ line-buffer max-line fd-in read-line throw
-      line-buffer max-line fd-in read-line throw
+	while
-   while
+		swap 2over rot tuck >= if
-	swap 2over rot swap over >= if
+			tuck <= if
-		swap over <= if
+				dup 0 <# #s #> \ ... i str l
-      			dup 0 U.R s" -> " type swap line-buffer swap type cr
+				dup ptype-indent @ \ i str l l indent
-		else swap drop
+				dup ptype-curx ! 1- \ i str l l indent
+				swap - cursor> \ i str l
+				type ." |" \ ... i \ Eingerueckt Zahl ausgeben
+				swap line-buffer swap ptype cr
+			else nip
+			endif
+		else nip nip
 		endif
-        else swap drop swap drop
+	repeat 
-	endif
+	2drop 2drop 
-   repeat 
+	fd-in close-file throw
-   2drop 2drop 
+;
-   fd-in close-file throw ;
 
 : printCodeHeader ( end start namelen addr -- )  \ prints source code header containing line numbers
-  swap 2dup type 2swap \ s" (" type 0 U.R  s" -" type 0 U.R  s" ): " type cr cr type ;
+  swap 2swap \ addr namelen end start
-  swap 2swap cr printsource cr ; \ type emit emit ;
+	2dup > if swap then \ addr namelen start/end end/start
+	dup 0 <# #s #> nip ptype-reset 1+ ptype-indent !
+  2swap \ start end addr namelen
+	printsource cr
+;
 
 : {source}  ( -- ) ;   
 : <source>  ( -- , xt-{source}  )  ['] {source} , ;
@@ -252,7 +278,7 @@ Create line-buffer  max-line 2 + allot
 ;
 : {/np} ( -- )
 	\ 30 sgr 40 sgr
-	0 term-height dup cursory@ - 2 / screen_ 2 - cursor!
+	0 term-height dup cursory@ - 2 / dup 0< if drop else screen_ then 2 - cursor!
 ;
 : <np> ( -- addr , xt-{/np} xt-{np} )
 	\ Wir legen jede Anfangsadresse einer Seite auf den Stack (Achtung, in umgekehrter Reihenfolge)

presentation.p.fs

@@ -43,9 +43,10 @@
 	<p>
 		!" Eines Tages hatten wir [Harald Steinlechner und Denis Knauf"
 		!" ] die tolle Idee, eine Praesentationssoftware zu schreiben."
+		!" text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text"
 	</p>
 	\ <p> <en>
-		\ <||> !" Forth eignet sich gut für Domain specific languages."  </||> 
+		\ <||> !" Forth eignet sich gut für Domain specific languages." </||> 
 		\ <||> !" Makros sind ein Heidenspass." </||> 
 		\ <||> !" Execution tokens erzeugen unseren Code. text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text" </||> 
 	\ </en> </p>
@@ -71,5 +72,5 @@
 <np>
 	<h> !" Und Source" </h>
 	<br>
-	<source> s" presentation.fs" 10 20 </source>
+	<source> s" presentation.fs" 0 20 </source>
 </presentation>