status-line.fs 1.87 KB
Newer Older
Bernd Paysan's avatar
Bernd Paysan committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
\ status line, inspired by seedForth

\ Authors: Bernd Paysan
\ Copyright (C) 2020 Free Software Foundation, Inc.

\ This file is part of Gforth.

\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation, either version 3
\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.

\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see http://www.gnu.org/licenses/.

blue >bg white >fg or bold or Value status-attr
Bernd Paysan's avatar
Bernd Paysan committed
22 23
: redraw-status ( addr u -- )
    .\" \e7"
Bernd Paysan's avatar
Bernd Paysan committed
24
    0 rows 1 - at-xy
Bernd Paysan's avatar
Bernd Paysan committed
25 26 27 28 29 30
    status-attr attr! type default-color attr!
    .\" \e8" ;
: .unstatus-line ( -- )
    .\" \e7"
    0 rows 1 - at-xy   cols spaces
    .\" \e8" ;
Bernd Paysan's avatar
Bernd Paysan committed
31
: .status-line ( -- ) { | w^ status$ }
Bernd Paysan's avatar
Bernd Paysan committed
32
    base @
Bernd Paysan's avatar
Bernd Paysan committed
33 34
    [:  ." gforth 😷 | " unused 1024 / 0 u.r
	." k free | order: " order
Bernd Paysan's avatar
Bernd Paysan committed
35 36
	." | base=" .
	." | " depth 0= IF ." ∅" ELSE  ...  THEN ;]
Bernd Paysan's avatar
Bernd Paysan committed
37 38
    [:  ." gforth 😷 | " unused 1024 / 0 u.r
	." k free|o " order
Bernd Paysan's avatar
Bernd Paysan committed
39 40
	." |b=" 0 .r
	." | " depth 0= IF ." ∅" ELSE  ...  THEN ;]
Bernd Paysan's avatar
Bernd Paysan committed
41
    cols 100 > select
Bernd Paysan's avatar
Bernd Paysan committed
42
    #10 ['] base-execute status$ $exec
Bernd Paysan's avatar
Bernd Paysan committed
43 44 45 46 47 48 49 50 51 52 53
    cols status$ $@ x-width - dup 0> IF
	['] spaces status$ $exec
    ELSE  0< IF
	    0 status$ $@ bounds U+DO
		I xc@+ swap >r
		dup #tab = IF  drop 1+ dfaligned  ELSE  xc-width +  THEN
		dup cols u> IF  rdrop I status$ $@ drop - status$ $!len
		    leave  THEN
	    r> I - +LOOP  drop
	THEN
    THEN
Bernd Paysan's avatar
Bernd Paysan committed
54
    .\" \n\n\e[2A" status$ $@ redraw-status
Bernd Paysan's avatar
Bernd Paysan committed
55 56
    status$ $free ;

Bernd Paysan's avatar
Bernd Paysan committed
57 58 59 60
: +status ['] .status-line is .status ['] .unstatus-line is .unstatus ;
: -status ['] noop is .status ['] noop is .unstatus ;

+status