version 1.57, 2006/05/07 18:14:11
|
version 1.58, 2006/12/30 20:06:26
|
Line 71 DEFER nlcount ' noop IS nlcount
|
Line 71 DEFER nlcount ' noop IS nlcount
|
nlflag @ IF (nl) nlflag off THEN |
nlflag @ IF (nl) nlflag off THEN |
XPos @ over + cols u>= IF (nl) THEN ; |
XPos @ over + cols u>= IF (nl) THEN ; |
|
|
: c-to-upper ( c1 -- c2 ) \ gforth |
|
\ nac05feb1999 there is a primitive, toupper, with this function |
|
dup [char] a >= over [char] z <= and if bl - then ; |
|
|
|
: ctype ( adr len -- ) |
: ctype ( adr len -- ) |
warp? dup XPos +! C-Output @ |
warp? dup XPos +! C-Output @ |
IF uppercase @ IF bounds ?DO i c@ c-to-upper emit LOOP |
IF uppercase @ IF bounds ?DO i c@ toupper emit LOOP |
uppercase off ELSE type THEN |
uppercase off ELSE type THEN |
ELSE 2drop THEN ; |
ELSE 2drop THEN ; |
|
|