diff --git a/presentation.fs b/presentation.fs index ce51fcb..d7bb42d 100755 --- a/presentation.fs +++ b/presentation.fs @@ -150,19 +150,24 @@ ptype-reset : beep 0 term-height 2 - cursor! 7 emit s" *beep* not" type ; +variable ok- +: block? ok- @ 0= throw ; +: block! ( i -- ) ok- dup @ throw ! ; +: !block ( i -- ) ok- @ <> throw 0 ok- ! ; + \ Es folgen ein paar syntaktische Textauszeichnungen. -: {i} ( addr -- addr ) 7 sgr ; -: ( -- ) ['] {i} , ; +: {i} ( addr -- addr ) 7 sgr ; +: ( -- ) block? ['] {i} , ; : {/i} ( addr -- addr ) 27 sgr ; -: ( -- ) ['] {/i} , ; +: ( -- ) block? ['] {/i} , ; : {b} ( addr -- addr ) 1 sgr ; \ bold -: ( -- ) ['] {b} , ; +: ( -- ) block? ['] {b} , ; : {/b} ( addr -- addr ) 22 sgr ; -: ( -- ) ['] {/b} , ; +: ( -- ) block? ['] {/b} , ; : {u} ( addr -- addr ) 4 sgr ; \ underline -: ( -- ) ['] {u} , ; +: ( -- ) block? ['] {u} , ; : {/u} ( addr -- addr ) 24 sgr ; -: ( -- ) ['] {/u} , ; +: ( -- ) block? ['] {/u} , ; : {fc} ( addr -- addr ) dup @ 30 + sgr cell+ ; \ frontcolor : ( -- ) ['] {fc} , , ; : {/fc} ( addr -- addr ) 39 sgr ; @@ -188,7 +193,7 @@ ptype-reset dup ptype-curx ! cursor> cell+ {b} ; \ header -: ( -- addr 0 , xt-{h} 0 ) ['] {h} , here 0 , 0 ; +: ( -- addr 0 , xt-{h} 0 ) [char] h block! ['] {h} , here 0 , 0 ; : {/h} ( addr , len -- addr1 ) {/b} cursorx@ 1+ \ addr x cr @@ -197,19 +202,19 @@ ptype-reset cursorx@ +do ." =" loop \ addr cr cell+ ; -: ( addr len -- , xt-{/h} len0 ) ['] {/h} , dup , swap ! ; +: ( addr len -- , xt-{/h} len0 ) ['] {/h} , dup , swap ! [char] h !block ; : {p} ( addr -- addr ) cr ptype-reset cell+ ; \ paragraph -:

( -- addr u0 , xt-{p} 0 ) ['] {p} , here 0 , 0 ; +:

( -- addr u0 , xt-{p} 0 ) [char] p block! ['] {p} , here 0 , 0 ; : {/p} ( addr -- addr ) cr ; -:

( addr len -- , xt-{/p} ) ['] {/p} , swap ! ; +:

( addr len -- , xt-{/p} ) ['] {/p} , swap ! [char] p !block ; : {li} ( addr -- addr ) - 2 cursor> space 1 cursor> - 6 dup ptype-indent ! ptype-curx ! + 2 cursor> 32 sgr ." *" 39 sgr + 4 ptype-indent ! 3 ptype-curx ! cell+ ; -:
  • ( -- addr u0 , xt-{li} 0 ) ['] {li} , here 0 , 0 ; +:
  • ( -- addr u0 , xt-{li} 0 ) [char] l block! ['] {li} , here 0 , 0 ; : {/li} ( addr -- addr ) cr ; -:
    • ( addr len -- , xt-{/li} ) ['] {/li} , swap ! ; +: ( addr len -- , xt-{/li} ) ['] {/li} , swap ! [char] l !block ; 33 constant table-color : {|} ( addr -- addr ) dup @ dup ptype-cursorx@ - \ addr > >-i @@ -220,27 +225,28 @@ ptype-reset endif ptype-curx ! table-color sgr ." |" 39 sgr cell+ ; -: <|> ( i -- addr , xt-{|} i ) ['] {|} , , ; +: <|> ( i -- addr , xt-{|} i ) block? ['] {|} , , ; : {-} ( addr -- addr ) cr dup @ 0 table-color sgr +do [char] - emit loop 39 sgr cell+ cr ; -: <-> ( i -- addr , xt-{-} i ) ['] {-} , , ; +: <-> ( i -- addr , xt-{-} i ) block? ['] {-} , , ; variable enumerationCount ( -- addr ) : {||} ( addr -- addr ) \ increments enumeration count and prints prefix enumerationCount dup @ 1+ dup rot ! - 2 cursor> 0 u.r ." ." 1 cursor> - 6 dup ptype-indent ! ptype-curx ! + 2 cursor> 0 u.r ." ." space + 5 ptype-curx ! ; -: <||> ( -- , xt-{||} 0 ) ['] {||} , ; -: {/||} ( addr -- addr ) cr ; -: ( -- , xt-{/||} ) ['] {/||} , ; +: <||> ( -- , xt-{||} ) [char] e ok- @ <> throw ['] {||} , ; +: {/||} ( -- ) cr ; +: ( -- , xt-{/||} ) ['] {/||} , ; \ [char] e ok- @ 2dup emit emit <> throw ; : {en} ( -- ) + cr 5 ptype-indent ! \ 6 Zeichen weit einruecken 0 enumerationCount ! \ resets enumeration count ; -: ( -- , xt-{en} ) ['] {en} , ; +: ( -- , xt-{en} ) [char] e block! ['] {en} , ; : {/en} ( -- ) ptype-reset ; -: ( -- , xt-{/en} ) ['] {en} , ; +: ( -- , xt-{/en} ) ['] {en} , [char] e !block ; 256 Constant max-line Create line-buffer max-line 2 + allot @@ -250,9 +256,7 @@ Create line-buffer max-line 2 + allot : printsource ( from to addr u 1/0 -- ) { showLines } - open-input - cr - 0 + open-input cr 0 begin 1+ line-buffer max-line fd-in read-line throw while @@ -263,7 +267,7 @@ Create line-buffer max-line 2 + allot dup ptype-curx ! 1- \ i str l l indent swap - dup 0< if drop else cursor> then \ i str l showLines if - type ." |" \ ... i \ Eingerueckt Zahl ausgeben + 33 sgr type ." |" 39 sgr \ ... i \ Eingerueckt Zahl ausgeben else 2drop \ Eingerueckt keine Zahl ausgeben endif swap line-buffer swap ptype cr @@ -282,27 +286,26 @@ Create line-buffer max-line 2 + allot 2dup > if swap then \ addr namelen start/end end/start showLines if dup 0 <# #s #> nip else 0 then ptype-reset 1+ ptype-indent ! 2swap \ start end addr namelen - showLines printsource cr + showLines printsource ; -: {source} ( -- ) ; -: ( -- , xt-{source} ) ['] {source} , ; -: {/source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * + - @ swap cell 3 * + @ 1 printCodeHeader 4 cells + ; -: ( -- , xt-{/source} ) ['] {/source} , , , , , ; +: {source} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * + + @ swap cell 3 * + @ 1 printCodeHeader 4 cells + ptype-reset ; +: ( addr len from to -- , xt-{source} ) ['] {source} , , , , , ; -: {file} ( -- ) ; -: ( -- , xt-{file} ) ['] {file} , ; -: {/file} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * + - @ swap cell 3 * + @ 0 printCodeHeader 4 cells + ; -: ( -- , xt-{/file} ) ['] {/file} , , , , , ; +: {file} ( -- ) dup dup dup dup @ swap cell + @ 2swap cell 2 * + + @ swap cell 3 * + @ 0 printCodeHeader 4 cells + ptype-reset ; +: ( addr len from to -- , xt-{file} ) ['] {file} , , , , , ; : {np} ( -- ) 0 sgr \ Alle Bildschirmeigenschaften zuruecksetzen page \ Bildschirm leeren ; +variable np-sign +0 np-sign ! : {/np} ( -- ) \ 30 sgr 40 sgr + np-sign @ dup if execute 0 np-sign ! else drop then 0 term-height dup cursory@ - 2 / dup 0< if drop else screen_ then 2 - cursor! ; : ( -- addr , xt-{/np} xt-{np} ) @@ -385,6 +388,10 @@ variable pres-restore 3 cells allot 0 ; +variable psee_ +: psee' 20 0 +do [char] - emit loop cr psee_ @ xt-see ; +: psee ['] psee' np-sign ! ' psee_ ! u ; + : ( -- addr0 0 addr1 , xt-{np} ) here 0 here ['] {np} , ; : ( 0 -- faddr laddr paddr 0 !! endaddr 0 0 0 0 <...addr> ) diff --git a/presentation.p.fs b/presentation.p.fs index cd7fd67..e82aa64 100644 --- a/presentation.p.fs +++ b/presentation.p.fs @@ -46,32 +46,27 @@ 71 <-> 1 <|> !" Speicheraufbau" 18 <|> s\" {p} 5 {i} {!!} addr len {/i} {/p} " !! 56 <|> s\" here-\"stack\"" !! 71 <|>
    - 1 <|> a b !! 18 <|> c d !! 56 <|> 71 <|> + 1 <|> a b !! 18 <|> c d !! 56 <|> 71 <|> 71 <->

    ; -

    - s" header.txt" 0 100 -
    - \ !" Denis Knauf & Harald Steinlechner" -

    +

    s" header.txt" 0 100

    - !" Präsentationssoftware in Forth" + !" Präsentationssoftware in Forth -- "

    -
    -
    !" Die flexible Forth-Syntax erlaubt die deklarative Representation von formatierten Text in Forth." -
    +

    +

    !" Die Präsentation selbst sowie ihre Seiten werden mittels artigen Tags implementiert."

    !" Grundstruktur " -

    s" example.p.fs" 0 100

    +

    s" example.p.fs" 0 100

    !" Grundstruktur " -

    s" example.p.fs" 0 100

    +

    s" example.p.fs" 0 100

    !" Ergebnis" !" Dies ist eine Testpraesentation!"

    @@ -80,35 +75,37 @@

    ( !" Mit den wichtigsten Wörtern:" -

    -

  • !" " !" : damit beginnt die praesentation"
    • -
  • !" " !" : Eine Ueberschrift"
    • -
  • !"

    " !" : Ein Paragraph"

    • -
  • !" " !" : Fettdruck"
    • -
  • !"
    "     !" : Zeilenumbruch"
    • -
  • !\" !\"" !" : Ein String"
    • -

    ) +
  • !" " !" : damit beginnt die praesentation"
    • +
  • !" " !" : Eine Ueberschrift"
    • +
  • !"

    " !" : Ein Paragraph"

    • +
  • !" " !" : Fettdruck"
    • +
  • !"
    "     !" : Zeilenumbruch"
    • +
  • !\" !\"" !" : Ein String"
    • +) - !" Benutzer Interaktion" -

    - !" Die Präsentation liegt im Speicher" -

    -

    - !" ==> Dadurch wird die Navigation über Forth Wörter möglich." -

    + !" Benutzerinteraktion" +

    !" Präsentation liegt im Speicher."

    +

    !" eigener Interpreter (showpage, executiontokens)"

    +

    !" ==> Dadurch wird die Navigation über Forth Wörter möglich."

    +
  • !" n => nächste Seite"
  • !" p => vorige Seite"
  • !" u => seite aktualisieren"
  • !" 3 g => Zur dritten Seite springen"
  • !" 3 n => 3 Seiten vor springen"
    • + +

    + !" Features" +
    + !" Features" +

    p4-1 p4-1 p4-2 p4-1 p4-2 p4-3 p4-1 p4-2 p4-3 -

    !" Eine neue Seite definieren: " !" " +

    !" Eine neue Seite definieren: " !" "

    !" Und Farben" -
  • !" Hintergrundfarbe: " s\" Yellow !\" text\" " !! !" : " Yellow !\" text"
  • !" Vordergrundfarbe: " s\" Brown !\" text\" " !! !" : " Brown !\" text"

    • !" 8 Farben sind moeglich:"

    @@ -160,41 +157,31 @@ s" Execute" s" ^" interner-ablauf -

    - !" Zeit für Makros!!" - s" presentation.p.fs" 29 39 -

    farbendemo

    -

    + !" Zeit für Makros!!" +

    s" presentation.p.fs" 29 39

    +

    farbendemo

    -

    - !" Beliebige Wörter können Inhalte erzeugen!!" -

    - !" So kann man Aufzaehlungen erstellen" -

    - - <||> !" Das erstellen von Präsentationen und Formatierungen wirkt natürlich" - <||> !" Unsere Sprache erbt die gesamte Funktionalität von Forth persönlich. " - <||> !" Makros generieren Inhalte" - - s" presentation.p.fs" 112 116 -
    !" Die Operatoren sehen so aus:"
    - s" presentation.fs" 214 221 -

    + !" Beliebige Wörter können Inhalte erzeugen!!" + (

    !" So kann man Aufzaehlungen erstellen"

    + + <||> !" Das erstellen von Präsentationen und Formatierungen wirkt natürlich" + <||> !" Unsere Sprache erbt die gesamte Funktionalität von Forth persönlich. " + <||> !" Makros generieren Inhalte" + ) +

    s" presentation.p.fs" 112 116

    +

    !" Die Operatoren sehen so aus:"

    +

    s" presentation.fs" 214 221

    -

    - !" Spezielle (verwendete) Features von Forth" -

    -

  • !" * Compiler VS Interpreter"
    • -
  • !" * Execution Tokens"
    • -
  • !" * Here , ,"
    • -
  • !" * Makros"
    • -

    + !" Spezielle (verwendete) Features von Forth" +
    +
  • !" Compiler VS Interpreter"
    • +
  • !" Execution Tokens"
    • +
  • !" Here, ,"
    • +
  • !" Makros"
    • +
  • !" Exception (beim Parsen)"

    • - s" nochFragen.txt" 0 100 - - !" denis.knauf@gmail.com | haraldsteinlechner@gmail.com" - + s" nochFragen.txt" 0 100 + !" denis.knauf@gmail.com | haraldsteinlechner@gmail.com"

    -