Verified Commit 8ee3e536 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Keep track of out in gl-terminal.fs

parent c5a33416

cross.fs

+8 −0
Original line number Diff line number Diff line
@@ -733,6 +733,7 @@ Plugin branch, ( target-addr -- ) \ compiles a branch 
Plugin ?branch, ( target-addr -- )	\ compiles a ?branch

Plugin branchmark, ( -- branch-addr )	\ reserves room for a branch

Plugin ?branchmark, ( -- branch-addr )	\ reserves room for a ?branch

Plugin ?dup-?branchmark, ( -- branch-addr )	\ reserves room for a ?branch

Plugin ?domark, ( -- branch-addr )	\ reserves room for a ?do branch

Plugin branchto, ( -- )			\ actual program position is target of a branch (do e.g. alignment)

' NOOP plugin-of branchto,
@@ -749,6 +750,7 @@ Plugin doer-resolve ( ghost res-pnt target-addr addr -- ghost res-pnt ) 


Plugin ncontrols? ( [ xn ... x1 ] n -- ) \ checks wheter n control structures are open

Plugin if, 	( -- if-token )

Plugin ?dup-if, 	( -- if-token )

Plugin else,	( if-token -- if-token )

Plugin then,	( if-token -- )

Plugin ahead,
@@ -1098,6 +1100,7 @@ Ghost - drop \ need a ghost otherwise "-" would be treated as a number 


Ghost 0=                                        drop

Ghost branch    Ghost ?branch                   2drop

Ghost ?dup-?branch drop

Ghost unloop    Ghost ;S                        2drop

Ghost lit       Ghost !                         2drop

Ghost noop                                      drop
@@ -3482,6 +3485,8 @@ X has? abranch [IF] 
  IS branchmark, ( -- branchtoken )

:noname compile ?branch T here 0 H offset, ;

  IS ?branchmark, ( -- branchtoken )

:noname compile ?dup-?branch T here 0 H offset, ;

  IS ?dup-?branchmark, ( -- branchtoken )

:noname T here 0 H offset, ;

  IS ?domark, ( -- branchtoken )

:noname dup X @ ?struc X here over branchoffset swap X ! ;
@@ -3571,6 +3576,8 @@ Cond: ?LEAVE ?leave, ;Cond 


: (if,) ?branchmark, ; 				' (if,) plugin-of if,



: (?dup-if,) ?dup-?branchmark, ; 		' (?dup-if,) plugin-of ?dup-if,



: (then,) branchto, branchtoresolve, ; 		' (then,) plugin-of then,



: (else,) ( ahead ) branchmark,
@@ -3606,6 +3613,7 @@ Cond: ?LEAVE ?leave, ;Cond 
>TARGET

Cond: AHEAD     ahead, ;Cond

Cond: IF        if,  ;Cond

Cond: ?dup-IF   ?dup-if,  ;Cond

Cond: THEN      1 ncontrols? then, ;Cond

Cond: ENDIF     1 ncontrols? then, ;Cond

Cond: ELSE      1 ncontrols? else, ;Cond

kernel/stringk.fs

+2 −4
Original line number Diff line number Diff line
@@ -33,7 +33,7 @@ 
    [ 6 cells ] Literal + [ -4 cells ] Literal and ;

: $free ( addr -- ) \ gforth-string string-free

    \G free the string pointed to by addr, and set addr to 0

    0 swap !@ dup IF  free throw  ELSE  drop  THEN ;

    0 swap !@ ?dup-IF  free throw  THEN ;

' $free alias $off \ don't ask, don't use



: $make ( addr1 u -- $addr )
@@ -50,9 +50,7 @@ 
	over $padding over $@len $padding = IF

	    @ 2dup ! cell+ swap move  EXIT

	THEN  THEN

    >r $make

    BEGIN  r@ $free dup 0 r@ ?!@ 0= UNTIL \ prevent memory leak

    drop rdrop ;

    >r $make r> !@ ?dup-IF  free throw  THEN ;

: $@ ( addr1 -- addr2 u ) \ gforth-string string-fetch

    \G returns the stored string.

    @ dup IF  dup cell+ swap @  ELSE  0  THEN ;

minos2/gl-helper.fs

+0 −3
Original line number Diff line number Diff line
@@ -20,9 +20,6 @@ 
require unix/mmap.fs

require mini-oof2.fs



: w, ( n -- )  here 2 allot w! ;

: l, ( n -- )  here 4 allot l! ;



Variable dpy-w

Variable dpy-h

0 Value ctx

minos2/gl-terminal.fs

+12 −11
Original line number Diff line number Diff line
@@ -17,8 +17,6 @@ 
\ You should have received a copy of the GNU General Public License

\ along with this program. If not, see http://www.gnu.org/licenses/.



require ansi.fs \ we may want to support colorize.fs



\ opengl common stuff



\ :noname source type cr stdout flush-file throw ; is before-line
@@ -250,7 +248,7 @@ Variable gl-emit-buf 
: gl-cr ( -- )

    gl-lineend @ 0= IF

	gl-xy 2@ 1+ nip 0 swap gl-xy 2! THEN

    resize-screen  need-sync on ;

    resize-screen  need-sync on  out off ;



: xchar>glascii ( xchar -- 0..7F )

    case
@@ -273,8 +271,17 @@ Variable gl-emit-buf 
	THEN

    0 endcase ;



: gl-atxy ( x y -- )

    >r gl-wh @ min 0 max r> gl-xy 2!

    gl-xy cell+ @ out ! ;



: gl-at-deltaxy ( x y -- )

    >r s>d screenw @ sm/rem r> +

    gl-xy 2@ rot + >r + r> gl-atxy ;



: (gl-emit) ( char color -- )

    over 7 = IF  2drop  EXIT  THEN

    over #bs = IF  2drop -1 0 gl-at-deltaxy  EXIT  THEN

    over #lf = IF  2drop gl-cr  EXIT  THEN

    over #cr = IF  2drop gl-cr  EXIT  THEN

    over #tab = IF  >r drop bl gl-xy cell+ @ dup 1+ dfaligned swap - 0
@@ -286,6 +293,7 @@ Variable gl-emit-buf 
	gl-emit-buf $off $10

    THEN  { n m }



    n out +!

    resize-screen  need-sync on

    dup $70 and 5 lshift or $F0F and 4 lshift r> $FFFF0000 and or

    n 0 ?DO
@@ -308,13 +316,6 @@ Variable gl-emit-buf 
: gl-type-err ( addr u -- )

    bounds ?DO  I c@ gl-emit-err  LOOP ;



: gl-atxy ( x y -- )

    >r gl-wh @ min 0 max r> gl-xy 2! ;



: gl-at-deltaxy ( x y -- )

    >r s>d screenw @ sm/rem r> +

    gl-xy 2@ rot + >r + r> gl-atxy ;



: gl-page ( -- )  0 0 gl-atxy  0 to videorows

    0e screen-scroll  0e fdup scroll-source f! scroll-dest f!

    videomem videocols sfloats resize throw to videomem

struct-val.fs

+0 −3
Original line number Diff line number Diff line
@@ -46,9 +46,6 @@ standard:field 
    :noname ]] >r [[ xt-align compile, ]] r> create+value ; [[

    Create set-does> , , , , ;



: waligned ( addr -- waddr ) 1+ -2 and ;

: laligned ( addr -- waddr ) 3 + -4 and ;



cell      ' aligned   ' @   ' !   wrap+value: value: ( u1 "name" -- u2 )

1         ' noop      ' c@  ' c!  wrap+value: cvalue: ( u1 "name" -- u2 )

2         ' waligned  ' w@  ' w!  wrap+value: wvalue: ( u1 "name" -- u2 )