( Ñëîâà ôîðìàòíîé ïå÷àòè ÷èñåë.
Copyright [C] 1992-1999 A.Cherezov ac@forth.org
Ïðåîáðàçîâàíèå èç 16-ðàçðÿäíîãî â 32-ðàçðÿäíûé êîä - 1995-96ãã
Ðåâèçèÿ - ñåíòÿáðü 1999 [ïåðåõîä íà USER-ïåðåìåííûå è
çàìåíà CODE-ñëîâ âûñîêîóðîâíåâûìè îïðåäåëåíèÿìè]
)
4096 DUP CONSTANT NUMERIC-OUTPUT-LENGTH
USER-CREATE SYSTEM-PAD
USER-ALLOT \ Îáëàñòü ôîðìàòíîãî ïðåîáðàçîâàíèÿ - îáÿçàòåëüíî ïåðåä PAD
: HEX ( -- ) \ 94 CORE EXT
\ Óñòàíîâèòü ñîäåðæèìîå BASE ðàâíûì øåñòíàäöàòè.
16 BASE !
;
: DECIMAL ( -- ) \ 94
\ Óñòàíîâèòü îñíîâàíèå ñèñòåìû ñ÷èñëåíèÿ ðàâíûì äåñÿòè.
10 BASE !
;
: HOLD ( char -- ) \ 94
\ Äîáàâèòü char ê íà÷àëó ôîðìàòíîé ÷èñëîâîé ñòðîêè.
\ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü HOLD
\ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
HLD @ 1- DUP HLD ! C!
;
: HOLDS ( addr u -- ) \ from eserv src
TUCK + SWAP 0 ?DO DUP I - 1- C@ HOLD LOOP DROP
;
: <# ( -- ) \ 94
\ Íà÷àòü ôîðìàòíîå ïðåîáðàçîâàíèå ÷èñåë.
PAD 1- HLD !
0 PAD 1- C!
;
: DIGIT> ( c -- c1 )
DUP 10 < 0= IF 7 + THEN 48 + ;
: # ( ud1 -- ud2 ) \ 94
\ Äåëåíèåì ud1 íà çíà÷åíèå BASE âûäåëèòü îäíó öèôðó ñ êîíöà è
\ äîáàâèòü åå â áóôåð ôîðìàòíîãî ïðåîáðàçîâàíèÿ ÷èñåë,
\ îñòàâèâ ÷àñòíîå ud2.
\ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü #
\ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
0 BASE @ UM/MOD >R BASE @ UM/MOD R>
ROT DIGIT> HOLD
;
: #S ( ud1 -- ud2 ) \ 94
\ Âûäåëÿòü öèôðû D1 ïî ñëîâó # äî ïîëó÷åíèÿ íóëÿ.
\ ud2 - íîëü.
\ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü #S
\ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
BEGIN
# 2DUP D0=
UNTIL
;
: #> ( xd -- c-addr u ) \ 94
\ Óáðàòü xd. Ñäåëàòü áóôåð ôîðìàòíîãî ïðåîáðàçîâàíèÿ äîñòóïíûì â âèäå
\ ñòðîêè ñèìâîëîâ, çàäàííîé c-addr è u.
\ Ïðîãðàììà ìîæåò ìåíÿòü ñèìâîëû â ýòîé ñòðîêå.
2DROP HLD @ PAD OVER - 1-
;
: SIGN ( n -- ) \ 94
\ Åñëè n îòðèöàòåëüíî, äîáàâèòü â ñòðîêó ôîðìàòíîãî ïðåîáðàçîâàíèÿ
\ ÷èñåë ìèíóñ.
\ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü SIGN
\ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
0< IF [CHAR] - HOLD THEN
;
: (D.) ( d -- addr len ) DUP >R DABS <# #S R> SIGN #> ;
: D. ( d -- ) (D.) TYPE SPACE ;
: . ( n -- ) S>D D. ;
: D.R ( d w -- ) >R (D.) R> OVER - 0MAX SPACES TYPE ;
: .R ( n w -- ) >R S>D R> D.R ;
: U.R ( u w -- ) 0 SWAP D.R ;
: U. ( u -- ) \ 94
\ Íàïå÷àòàòü u â ñâîáîäíîì ôîðìàòå.
U>D D.
;
: .0
>R 0 <# #S #> R> OVER - 0 MAX DUP
IF 0 DO [CHAR] 0 EMIT LOOP
ELSE DROP THEN TYPE
;
: >PRT
DUP BL U< IF DROP [CHAR] . THEN
;
: PTYPE
0 DO DUP C@ >PRT EMIT 1+ LOOP DROP
;
: DUMP ( addr u -- ) \ 94 TOOLS
DUP 0= IF 2DROP EXIT THEN
BASE @ >R HEX
15 + 16 U/ 0 DO
CR DUP 4 .0 SPACE
SPACE DUP 16 0
DO I 4 MOD 0= IF SPACE THEN
DUP C@ 2 .0 SPACE 1+
LOOP SWAP 16 PTYPE
LOOP DROP R> BASE !
;
: (.") ( T -> )
COUNT TYPE
;
\ ' (.") TO (.")-CODE
: DIGIT ( C, N1 ->> N2, TF / FF )
\ N2 - çíà÷åíèå ëèòåðû C êàê
\ öèôðû â ñèñòåìå ñ÷èñëåíèÿ ïî îñíîâàíèþ N1
>R
[CHAR] 0 - 10 OVER U<
IF
DUP [CHAR] A [CHAR] 0 - < IF RDROP DROP 0 EXIT THEN
DUP [CHAR] a [CHAR] 0 - 1- > IF [CHAR] a [CHAR] A - - THEN
[CHAR] A [CHAR] 0 - 10 - -
THEN R> OVER U> DUP 0= IF NIP THEN ;
: >NUMBER ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) \ 94
\ ud2 - ðåçóëüòàò ïðåîáðàçîâàíèÿ ñèìâîëîâ ñòðîêè, çàäàííîé c-addr1 u1,
\ â öèôðû, èñïîëüçóÿ ÷èñëî â BASE, è äîáàâëåíèåì êàæäîé ê ud1 ïîñëå
\ óìíîæåíèÿ ud1 íà ÷èñëî â BASE. Ïðåîáðàçîâàíèå ïðîäîëæàåòñÿ ñëåâà
\ íàïðàâî äî ïåðâîãî íåïðåîáðàçóåìîãî ñèìâîëà, âêëþ÷àÿ ñèìâîëû "+" è "-",
\ èëè äî ïîëíîãî ïðåîáðàçîâàíèÿ ñòðîêè.
\ c-addr2 - àäðåñ ïåðâîãî íåïðåîáðàçóìîãî ñèìâîëà èëè ïåðâîãî ñèìâîëà
\ çà êîíöîì ñòðîêè, åñëè ñòðîêà áûëà ïîëíîñòüþ ïðåîáðàçîâàíà.
\ u2 - ÷èñëî íåïðåîáðàçîâàííûõ ñèìâîëîâ â ñòðîêå.
\ Íåîäíîçíà÷íàÿ ñèòóàöèÿ âîçíèêàåò, åñëè ud2 ïåðåïîëíÿåòñÿ âî âðåìÿ
\ ïðåîáðàçîâàíèÿ.
BEGIN
DUP
WHILE
>R
DUP >R
C@ BASE @ DIGIT 0= \ ud n flag
IF R> R> EXIT THEN \ ud n ( ud = udh udl )
SWAP BASE @ UM* DROP \ udl n udh*base
ROT BASE @ UM* D+ \ (n udh*base)+(udl*baseD)
R> 1+ R> 1-
REPEAT
;
: SCREEN-LENGTH ( addr n -- n1 ) \ ýêðàííàÿ-äëèíà
\ äàòü äëèíó ñòðîêè ïðè âûâîäå (ïðè ïå÷àòè)
\ - ÷èñëî çíàêîìåñò, êîòîðîå ñòðîêà çàéìåò íà ýêðàíå.
\ addr n - ñòðîêà. n1 ÷èñëî çíàêîìåñò íà ýêðàí.
0 -ROT OVER + SWAP ?DO
I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT
ELSE 1+ THEN
LOOP
;