minos-float.fs 1.13 KB
Newer Older
1 2
\ floating point numbers

3 4
\needs float import float

bp's avatar
bp committed
5
also minos definitions
6

bp's avatar
bp committed
7 8
6 Value fa-precision

9
number-action class float-action
bp's avatar
bp committed
10
    cell var precision
11
  how:
bp's avatar
bp committed
12
    : init  fa-precision precision ! super init ;
bp's avatar
bp committed
13
    : >#f ( f -- addr u ) base push nbase @ base !
bp's avatar
bp committed
14
	precision @ set-precision fx$ ;
bp's avatar
bp committed
15
    : store ( f -- ) >#f edit assign ;
bp's avatar
bp committed
16
    : fetch ( -- f ) base push nbase @ base ! edit get >float
bp's avatar
bp committed
17
	0= IF  0e  THEN ;
18 19
class;

bp's avatar
bp committed
20 21 22 23 24 25
: #pre ( n o -- ) textfield with
        edit callback self float-action with
            precision !
        endwith
    endwith ;

26
: ]#f ( key sys ) postpone ;] (textfield postpone endwith
bp's avatar
bp committed
27
  & float-action >o float-action bind-key o> ;      immediate
bp's avatar
bp committed
28 29 30 31 32
'-' #[ sp@ 1 ins drop 1 c ]#F
'.' #[ sp@ 1 ins drop 1 c ]#F
',' #[ sp@ 1 ins drop 1 c ]#F
'e' #[ sp@ 1 ins drop 1 c ]#F
'E' #[ sp@ 1 ins drop 1 c ]#F
33
: ]SF postpone ;] float-action postpone new ;
bp's avatar
bp committed
34
[defined] DoNotSin [IF] DoNotSin [THEN]
35
                                             immediate restrict
bp's avatar
bp committed
36
[defined] alias [IF]
37
' [: alias SF[                               immediate restrict
bp's avatar
bp committed
38
' noop alias ]F 
bp's avatar
bp committed
39
[ELSE]
40
    synonym SF[ [:
bp's avatar
bp committed
41 42
    synonym ]F noop
[THEN]
43

bp's avatar
bp committed
44
previous definitions