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

This commit is contained in:
Denis Knauf 2011-01-20 22:15:28 +01:00
parent a5f040edf8
commit fee5fbb9a6
2 changed files with 56 additions and 29 deletions

View file

@ -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-reset ( -- ) 0 ptype-indent ! ; \ Nicht einruecken
: ptype ( addr len -- ) term-width 1- ptype-cursorx@ ptype-init ptype' ;
: 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
cr
0
begin
1+
line-buffer max-line fd-in read-line throw
while
swap 2over rot swap over >= if
swap over <= if
dup 0 U.R s" -> " type swap line-buffer swap type cr
else swap drop
open-input
cr
0
begin
1+ line-buffer max-line fd-in read-line throw
while
swap 2over rot tuck >= if
tuck <= if
dup 0 <# #s #> \ ... i str l
dup ptype-indent @ \ i str l l indent
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
endif
repeat
2drop 2drop
fd-in close-file throw ;
repeat
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 cr printsource cr ; \ type emit emit ;
swap 2swap \ addr namelen end start
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)

View file

@ -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>