Subversion Repositories Kolibri OS

Rev

Blame | Last modification | View Log | Download | RSS feed

  1. ( Ñëîâà ôîðìàòíîé ïå÷àòè ÷èñåë.
  2.   Copyright [C] 1992-1999 A.Cherezov ac@forth.org
  3.   Ïðåîáðàçîâàíèå èç 16-ðàçðÿäíîãî â 32-ðàçðÿäíûé êîä - 1995-96ãã
  4.   Ðåâèçèÿ - ñåíòÿáðü 1999 [ïåðåõîä íà USER-ïåðåìåííûå è
  5.   çàìåíà CODE-ñëîâ âûñîêîóðîâíåâûìè îïðåäåëåíèÿìè]
  6. )
  7.  
  8. 4096 DUP CONSTANT NUMERIC-OUTPUT-LENGTH
  9. USER-CREATE SYSTEM-PAD
  10. USER-ALLOT \ Îáëàñòü ôîðìàòíîãî ïðåîáðàçîâàíèÿ - îáÿçàòåëüíî ïåðåä PAD
  11.  
  12. : HEX ( -- ) \ 94 CORE EXT
  13. \ Óñòàíîâèòü ñîäåðæèìîå BASE ðàâíûì øåñòíàäöàòè.
  14.   16 BASE !
  15. ;
  16.  
  17. : DECIMAL ( -- ) \ 94
  18. \ Óñòàíîâèòü îñíîâàíèå ñèñòåìû ñ÷èñëåíèÿ ðàâíûì äåñÿòè.
  19.   10 BASE !
  20. ;
  21.  
  22. : HOLD ( char -- ) \ 94
  23. \ Äîáàâèòü char ê íà÷àëó ôîðìàòíîé ÷èñëîâîé ñòðîêè.
  24. \ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü HOLD
  25. \ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
  26.   HLD @ 1- DUP HLD ! C!
  27. ;
  28.  
  29. : HOLDS ( addr u -- ) \ from eserv src
  30.   TUCK + SWAP 0 ?DO DUP I - 1- C@ HOLD LOOP DROP
  31. ;
  32.  
  33. : <# ( -- ) \ 94
  34. \ Íà÷àòü ôîðìàòíîå ïðåîáðàçîâàíèå ÷èñåë.
  35.   PAD 1- HLD !
  36.   0 PAD 1- C!
  37. ;
  38.  
  39. : DIGIT> ( c -- c1 )
  40.  DUP 10 < 0= IF 7 + THEN 48 + ;
  41.  
  42. : # ( ud1 -- ud2 ) \ 94
  43. \ Äåëåíèåì ud1 íà çíà÷åíèå BASE âûäåëèòü îäíó öèôðó ñ êîíöà è
  44. \ äîáàâèòü åå â áóôåð ôîðìàòíîãî ïðåîáðàçîâàíèÿ ÷èñåë,
  45. \ îñòàâèâ ÷àñòíîå ud2.
  46. \ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü #
  47. \ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
  48.   0 BASE @ UM/MOD >R BASE @ UM/MOD R>
  49.   ROT DIGIT> HOLD
  50. ;
  51.  
  52. : #S ( ud1 -- ud2 ) \ 94
  53. \ Âûäåëÿòü öèôðû D1 ïî ñëîâó # äî ïîëó÷åíèÿ íóëÿ.
  54. \ ud2 - íîëü.
  55. \ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü #S
  56. \ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
  57.   BEGIN
  58.     # 2DUP D0=
  59.   UNTIL
  60. ;
  61.  
  62. : #> ( xd -- c-addr u ) \ 94
  63. \ Óáðàòü xd. Ñäåëàòü áóôåð ôîðìàòíîãî ïðåîáðàçîâàíèÿ äîñòóïíûì â âèäå
  64. \ ñòðîêè ñèìâîëîâ, çàäàííîé c-addr è u.
  65. \ Ïðîãðàììà ìîæåò ìåíÿòü ñèìâîëû â ýòîé ñòðîêå.
  66.   2DROP HLD @ PAD OVER - 1-
  67. ;
  68.  
  69. : SIGN ( n -- ) \ 94
  70. \ Åñëè n îòðèöàòåëüíî, äîáàâèòü â ñòðîêó ôîðìàòíîãî ïðåîáðàçîâàíèÿ
  71. \ ÷èñåë ìèíóñ.
  72. \ Èñêëþ÷èòåëüíàÿ ñèòóàöèÿ âîçíèêàåò, åñëè èñïîëüçîâàòü SIGN
  73. \ âíå <# è #>, îãðàíè÷èâàþùèâàþùèõ ïðåîáðàçîâàíèå ÷èñåë.
  74.   0< IF [CHAR] - HOLD THEN
  75. ;
  76.  
  77. : (D.)  ( d -- addr len )  DUP >R DABS <# #S R> SIGN #> ;
  78.  
  79. : D.    ( d -- )   (D.) TYPE SPACE ;
  80.  
  81. : . ( n -- )   S>D D. ;
  82.  
  83. : D.R ( d w -- )   >R (D.) R> OVER - 0MAX SPACES TYPE ;
  84.  
  85. : .R  ( n w -- )   >R  S>D  R>  D.R ;
  86.  
  87. : U.R ( u w -- )   0 SWAP D.R ;
  88.  
  89. : U. ( u -- ) \ 94
  90. \ Íàïå÷àòàòü u â ñâîáîäíîì ôîðìàòå.
  91.   U>D D.
  92. ;
  93.  
  94. : .0
  95.   >R 0 <# #S #> R> OVER - 0 MAX DUP
  96.     IF 0 DO [CHAR] 0 EMIT LOOP
  97.     ELSE DROP THEN TYPE
  98. ;
  99.  
  100. : >PRT
  101.   DUP BL U< IF DROP [CHAR] . THEN
  102. ;
  103.  
  104. : PTYPE
  105.   0 DO DUP C@ >PRT EMIT 1+ LOOP DROP
  106. ;
  107.  
  108. : DUMP ( addr u -- ) \ 94 TOOLS
  109.   DUP 0= IF 2DROP EXIT THEN
  110.   BASE @ >R HEX
  111.   15 + 16 U/ 0 DO
  112.     CR DUP 4 .0 SPACE
  113.     SPACE DUP 16 0
  114.       DO I 4 MOD 0= IF SPACE THEN
  115.         DUP C@ 2 .0 SPACE 1+
  116.       LOOP SWAP 16  PTYPE
  117.   LOOP DROP R> BASE !
  118. ;
  119.  
  120. : (.") ( T -> )
  121.  COUNT TYPE
  122. ;
  123. \ ' (.") TO (.")-CODE
  124.  
  125. : DIGIT ( C, N1 ->> N2, TF / FF )
  126. \ N2 - çíà÷åíèå ëèòåðû C êàê
  127. \ öèôðû â ñèñòåìå ñ÷èñëåíèÿ ïî îñíîâàíèþ N1
  128.   >R
  129.   [CHAR] 0 - 10 OVER U<
  130.   IF
  131.      DUP [CHAR] A [CHAR] 0 -     < IF  RDROP DROP 0 EXIT      THEN
  132.      DUP [CHAR] a [CHAR] 0 -  1- > IF [CHAR] a  [CHAR] A - -  THEN
  133.          [CHAR] A [CHAR] 0 - 10 - -
  134.   THEN R> OVER U> DUP 0= IF NIP THEN ;
  135.  
  136. : >NUMBER ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) \ 94
  137. \ ud2 - ðåçóëüòàò ïðåîáðàçîâàíèÿ ñèìâîëîâ ñòðîêè, çàäàííîé c-addr1 u1,
  138. \ â öèôðû, èñïîëüçóÿ ÷èñëî â BASE, è äîáàâëåíèåì êàæäîé ê ud1 ïîñëå
  139. \ óìíîæåíèÿ ud1 íà ÷èñëî â BASE. Ïðåîáðàçîâàíèå ïðîäîëæàåòñÿ ñëåâà
  140. \ íàïðàâî äî ïåðâîãî íåïðåîáðàçóåìîãî ñèìâîëà, âêëþ÷àÿ ñèìâîëû "+" è "-",
  141. \ èëè äî ïîëíîãî ïðåîáðàçîâàíèÿ ñòðîêè.
  142. \ c-addr2 - àäðåñ ïåðâîãî íåïðåîáðàçóìîãî ñèìâîëà èëè ïåðâîãî ñèìâîëà
  143. \ çà êîíöîì ñòðîêè, åñëè ñòðîêà áûëà ïîëíîñòüþ ïðåîáðàçîâàíà.
  144. \ u2 - ÷èñëî íåïðåîáðàçîâàííûõ ñèìâîëîâ â ñòðîêå.
  145. \ Íåîäíîçíà÷íàÿ ñèòóàöèÿ âîçíèêàåò, åñëè ud2 ïåðåïîëíÿåòñÿ âî âðåìÿ
  146. \ ïðåîáðàçîâàíèÿ.
  147.  BEGIN
  148.    DUP
  149.  WHILE
  150.    >R
  151.    DUP >R
  152.    C@ BASE @ DIGIT 0=     \ ud n flag
  153.    IF R> R> EXIT THEN     \ ud n  ( ud = udh udl )
  154.    SWAP BASE @ UM* DROP   \ udl n udh*base
  155.    ROT BASE @ UM* D+      \ (n udh*base)+(udl*baseD)
  156.    R> 1+ R> 1-
  157.  REPEAT
  158. ;
  159.  
  160. : SCREEN-LENGTH ( addr n -- n1 ) \ ýêðàííàÿ-äëèíà
  161. \ äàòü äëèíó ñòðîêè ïðè âûâîäå (ïðè ïå÷àòè)
  162. \ - ÷èñëî çíàêîìåñò, êîòîðîå ñòðîêà çàéìåò íà ýêðàíå.
  163. \ addr n  - ñòðîêà. n1 ÷èñëî çíàêîìåñò íà ýêðàí.
  164.  0 -ROT OVER + SWAP ?DO
  165.    I C@ 9 = IF 3 RSHIFT 1+ 3 LSHIFT
  166.    ELSE 1+ THEN
  167.  LOOP
  168. ;
  169.