deac
/
presentation.fs
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ptype: langsamer aber intelligenter. unterstuetzt indent und erkennung der position

master
Denis Knauf 2011-01-19 22:13:45 +01:00
parent 29ec338934
commit ece1351c38
2 changed files with 45 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
presentation.fs
View File

@ -1,12 +1,4 @@
#! /usr/bin/gforth #! /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+ )
i ( dst+ src+ ) c@ ( dst+ chr )
over ( dst+ chr dst+ ) c! ( dst+ ) 1+
loop
;
\ 2-rot ist bei gforth anscheinend nicht definiert \ 2-rot ist bei gforth anscheinend nicht definiert
: 2-rot { a1 a2 b1 b2 c1 c2 } c1 c2 a1 a2 b1 b2 ; : 2-rot { a1 a2 b1 b2 c1 c2 } c1 c2 a1 a2 b1 b2 ;
@ -42,10 +34,11 @@ needs ansi.fs
: cursory@ ( -- y ) cursor@ nip ; : cursory@ ( -- y ) cursor@ nip ;
: cursorx! ( x -- ) cursory@ cursor! ; : cursorx! ( x -- ) cursory@ cursor! ;
: cursory! ( x -- ) cursorx@ swap cursor! ; : cursory! ( x -- ) cursorx@ swap cursor! ;
: cursor^ ( i -- ) ESC[ 0 .r ." A" ; : cursor' ( i c -- ) swap dup if ESC[ 0 .r emit else 2drop then ;
: cursor_ ( i -- ) ESC[ 0 .r ." B" ; : cursor^ ( i -- ) [char] A cursor' ;
: cursor> ( i -- ) ESC[ 0 .r ." C" ; : cursor_ ( i -- ) [char] B cursor' ;
: cursor< ( i -- ) ESC[ 0 .r ." D" ; : cursor> ( i -- ) [char] C cursor' ;
: cursor< ( i -- ) [char] D cursor' ;
: isnewline? ( c -- i ) dup 10 = swap 13 = or ; : isnewline? ( c -- i ) dup 10 = swap 13 = or ;
: isspace? ( c -- i ) dup 9 = over 11 = or swap 32 = or ; : isspace? ( c -- i ) dup 9 = over 11 = or swap 32 = or ;
@ -82,7 +75,7 @@ variable scroll-delay
; ;
1 scroll-delay ! 1 scroll-delay !
variable ptype-lenl \ Wieviele Zeichen bereits in dieser Zeile geschrieben wurden variable ptype-indent \ Zeile Einruecken
defer ptype-type defer ptype-type
' type is ptype-type ' type is ptype-type
: ptype-word ( addrw addrc c -- addrc+1 ) : ptype-word ( addrw addrc c -- addrc+1 )
@ -90,18 +83,12 @@ defer ptype-type
dup -rot over - ptype-type \ c addrc dup -rot over - ptype-type \ c addrc
swap emit 1+ \ addrc+1 swap emit 1+ \ addrc+1
; ;
: ptype-init ( addr len lenm lenl -- addre lenm lenl addrw addre addr ) : ptype-init ( addr len lenm x -- addre lenm lenl addrw addre addr )
{ addr len lenm lenl } addr len + lenm lenl addr addr len + addr { addr len lenm x } addr len + lenm x dup cursorx! addr addr len + addr
( 2over + \ addr len lenm lenl addre
rot swap tuck 2-rot \ addre lenm addr len lenl addre
2over drop rot swap \ addre lenm addr len addre lenl addr
dup -rot 2-rot \ addre lenm lenl addrw addr len addre addr
2nip \ addre lenm lenl addrw addre addr
)
; ;
: ptype-newline ( lenm lenl addrw addrc -- lenm 0 addrw ) : ptype-newline ( lenm lenl addrw addrc -- lenm lenl addrw )
10 ptype-word \ lenm lenl addrw=addrc+1 10 ptype-word \ lenm lenl addrw=addrc+1
nip 0 swap \ lenm lenl=0 addrw ptype-indent @ dup cursor> swap \ lenm lenl0 addrw
; ;
: ptype-space ( lenm lenl addrw addrc -- lenm lenl1 addrw ) : ptype-space ( lenm lenl addrw addrc -- lenm lenl1 addrw )
32 ptype-word \ lenm lenl addrw=addrc+1 32 ptype-word \ lenm lenl addrw=addrc+1
@ -111,19 +98,20 @@ defer ptype-type
2over <= 2over <=
if if
\ lenm lenl addrw addrc \ lenm lenl addrw addrc
rot tuck over swap - \ lenm addrw lenl addrc addrc-lenl \ m w l c c-l rot tuck over swap - \ lenm addrw lenl addrc addrc-lenl
2over drop >= \ lenm addrw lenl addrc addrc-lenl>=addrw 2over drop >= \ lenm addrw lenl addrc addrc-lenl>=addrw
if \ Wort ist laenger als eine Zeile -> muss umgebrochen werden. if \ Wort ist laenger als eine Zeile -> muss umgebrochen werden.
1- -rot 1- -rot 2dup - \ lenm lenl addrc-1 addrw addrc-1-addrw 1- -rot 1- -rot 2dup - \ lenm lenl addrc-1 addrw addrc-1-addrw
ptype-type ." -" nip 1 swap dup \ lenm lenl addrw=addrc-1 addrc-1 ptype-type ." -" nip 1 swap dup \ lenm lenl addrw=addrc-1 addrc-1
else \ Word erst in der naechsten Zeile ausgeben. else \ Wort erst in der naechsten Zeile ausgeben.
nip 2dup - negate -rot \ lenm addrc-addrw addrw addrc nip 2dup - negate -rot \ lenm addrc-addrw addrw addrc
then then
10 emit cr
rot ptype-indent @ dup cursor> + -rot
then then
rot 1+ -rot rot 1+ -rot
; ;
: ptype' ( addre lenm 0 addrw addre addr -- ) : ptype' ( addre lenm lenl addrw addre addr -- )
\ addre ist fuer die schleife unwichtig \ addre ist fuer die schleife unwichtig
+do \ lenm lenl addrw +do \ lenm lenl addrw
i dup c@ \ lenm lenl addrw addrc c i dup c@ \ lenm lenl addrw addrc c
@ -131,20 +119,16 @@ defer ptype-type
case \ lenm lenl addrw addrc c case \ lenm lenl addrw addrc c
10 of ptype-newline endof 10 of ptype-newline endof
32 of ptype-space endof 32 of ptype-space endof
drop ptype-anychar drop ptype-anychar
endcase endcase
loop \ addre lenm lenl addrw loop \ addre lenm lenl addrw
over ptype-lenl !
nip nip tuck - ptype-type nip nip tuck - ptype-type
; ;
: ptype ( addr len -- ) term-width ptype-lenl @ ptype-init ptype' ; : ptype ( addr len -- ) term-width 1- cursorx@ ptype-init ptype' ;
: ptype-reset ( -- ) 0 ptype-lenl ! ; : ptype-reset ( -- ) 0 ptype-indent ! ; \ Nicht einruecken
ptype-reset \ ptype-lenl sollte von Anfang an 0 sein ptype-reset
: beep : beep 0 term-height 2 - cursor! 7 emit s" *beep* not" type ;
0 term-height 2 - at-xy
7 emit s" *beep* not" type
;
\ Es folgen ein paar syntaktische Textauszeichnungen. \ Es folgen ein paar syntaktische Textauszeichnungen.
: {i} ( addr -- addr ) 7 sgr ; : {i} ( addr -- addr ) 7 sgr ;
@ -181,21 +165,17 @@ ptype-reset \ ptype-lenl sollte von Anfang an 0 sein
: {h} ( addr , len -- addr ) : {h} ( addr , len -- addr )
cr cr
term-width over @ - 2 / \ addr width-twidth/2 term-width over @ - 2 / \ addr width-twidth/2
dup ptype-lenl ! dup cursor> ptype-indent !
1 +do 32 emit loop cell+ {b}
cell+
{b}
; \ header ; \ header
: <h> ( -- addr 0 , xt-{h} 0 ) ['] {h} , here 0 , 0 ; : <h> ( -- addr 0 , xt-{h} 0 ) ['] {h} , here 0 , 0 ;
: {/h} ( addr , len -- addr1 ) : {/h} ( addr , len -- addr1 )
{/b} {/b} cursorx@ 1+ \ addr x
cr cr
term-width over @ - 2 / \ addr width-twidth/2 over @ term-width swap - 2 / 1- \ addr x indent
dup cursor> \ addr x
2 +do 32 emit loop cursorx@ +do ." =" loop \ addr
ptype-lenl @ swap 2 - +do 61 ( = ) emit loop cr cell+
cr
cell+
; ;
: </h> ( addr len -- , xt-{/h} len0 ) ['] {/h} , dup , swap ! ; : </h> ( addr len -- , xt-{/h} len0 ) ['] {/h} , dup , swap ! ;
: {p} ( addr -- addr ) cr ptype-reset cell+ ; \ paragraph : {p} ( addr -- addr ) cr ptype-reset cell+ ; \ paragraph
@ -203,8 +183,8 @@ ptype-reset \ ptype-lenl sollte von Anfang an 0 sein
: {/p} ( addr -- addr ) cr ; : {/p} ( addr -- addr ) cr ;
: </p> ( addr len -- , xt-{/p} ) ['] {/p} , swap ! ; : </p> ( addr len -- , xt-{/p} ) ['] {/p} , swap ! ;
: {li} ( addr -- addr ) : {li} ( addr -- addr )
s\" * " type 2 cursor> space 1 cursor>
4 ptype-lenl ! 6 ptype-indent !
cell+ cell+
; ;
: <li> ( -- addr u0 , xt-{li} 0 ) ['] {li} , here 0 , 0 ; : <li> ( -- addr u0 , xt-{li} 0 ) ['] {li} , here 0 , 0 ;
@ -213,20 +193,21 @@ ptype-reset \ ptype-lenl sollte von Anfang an 0 sein
variable enumerationCount ( -- addr ) variable enumerationCount ( -- addr )
: {||} ( addr -- addr ) \ increments enumeration count and prints prefix : {||} ( addr -- addr ) \ increments enumeration count and prints prefix
enumerationCount dup @ 1+ dup rot ! enumerationCount dup @ 1+ dup rot !
s" " type 0 U.R s" ) " type 2 cursor> 0 U.R ." ." 1 cursor>
5 ptype-lenl !
; ;
: <||> ( -- , xt-{||} 0 ) ['] {||} , ; : <||> ( -- , xt-{||} 0 ) ['] {||} , ;
: {/||} ( addr -- addr ) cr ; : {/||} ( addr -- addr ) cr ;
: </||> ( -- , xt-{/||} ) ['] {/||} , ; : </||> ( -- , xt-{/||} ) ['] {/||} , ;
: {en} ( -- ) 0 enumerationCount ! ; \ resets enumeration count : {en} ( -- )
5 ptype-indent ! \ 6 Zeichen weit einruecken
0 enumerationCount ! \ resets enumeration count
;
: <en> ( -- , xt-{en} ) ['] {en} , ; : <en> ( -- , xt-{en} ) ['] {en} , ;
: {/en} ( -- ) ; : {/en} ( -- ) ptype-reset ;
: </en> ( -- , xt-{/en} ) ['] {en} , ; : </en> ( -- , xt-{/en} ) ['] {en} , ;
: {np} ( -- ) : {np} ( -- )
0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen 0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen
page \ Bildschirm leeren page \ Bildschirm leeren

16
presentation.p.fs
View File

@ -54,7 +54,7 @@ Create line-buffer max-line 2 + allot
while while
swap 2over rot swap over >= if swap 2over rot swap over >= if
swap over <= if swap over <= if
dup 0 U.R s" -> " type swap line-buffer swap type cr dup 0 U.R s" -> " ptype-type swap line-buffer swap ptype-type {br}
else swap drop else swap drop
endif endif
else swap drop swap drop else swap drop swap drop
@ -76,15 +76,15 @@ Create line-buffer max-line 2 + allot
<presentation> <presentation>
<h> !" Dies ist eine Testpraesentation!" </h> <h> !" Dies ist eine Testpraesentation!" </h>
<p> <p>
!" Eines Tages hatten wir [" <b> <tw> !" Harald Steinlechner" </tw> </b> !" Eines Tages hatten wir [" ( <b> <tw> ) !" Harald Steinlechner" </tw> </b>
!" und " <b> <tw> !" Denis Knauf" </tw> </b> !" und " ( <b> <tw> ) !" Denis Knauf" </tw> </b>
!" ] die tolle Idee, eine Praesentationssoftware zu schreiben." !" ] die tolle Idee, eine Praesentationssoftware zu schreiben."
</p> </p>
<p> <en> \ <p> <en>
<||> !" Forth eignet sich gut für Domain specific languages." </||> \ <||> !" Forth eignet sich gut für Domain specific languages." </||>
<||> !" Makros sind ein Heidenspass." </||> \ <||> !" Makros sind ein Heidenspass." </||>
<||> !" Execution tokens erzeugen unseren Code." </||> \ <||> !" 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> \ </en> </p>
<np> <np>
<h> !" Ergebnis" </h> <h> !" Ergebnis" </h>
<p> <b> !" Das hier" </b> </p> <p> <b> !" Das hier" </b> </p>