Download code

From LiteratePrograms

Jump to: navigation, search

Back to Convert_integer_to_words_(QBASIC)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

NUM2LANG.BAS

  1 REM Copyright (c) 2009 the authors listed at the following URL, and/or
  2 REM the authors of referenced articles or incorporated external code:
  3 REM http://en.literateprograms.org/Convert_integer_to_words_(QBASIC)?action=history&offset=20070516003031
  4 REM 
  5 REM Permission is hereby granted, free of charge, to any person obtaining
  6 REM a copy of this software and associated documentation files (the
  7 REM "Software"), to deal in the Software without restriction, including
  8 REM without limitation the rights to use, copy, modify, merge, publish,
  9 REM distribute, sublicense, and/or sell copies of the Software, and to
 10 REM permit persons to whom the Software is furnished to do so, subject to
 11 REM the following conditions:
 12 REM 
 13 REM The above copyright notice and this permission notice shall be
 14 REM included in all copies or substantial portions of the Software.
 15 REM 
 16 REM THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 17 REM EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 18 REM MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 19 REM IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 20 REM CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
 21 REM TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 22 REM SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 23 REM 
 24 REM Retrieved from: http://en.literateprograms.org/Convert_integer_to_words_(QBASIC)?oldid=10097
 25 
 26 DECLARE FUNCTION Num2Lang$ (aNumber AS LONG, aLang AS STRING)
 27 
 28 DIM mTestCount AS INTEGER
 29 DIM mStatus AS STRING
 30 DIM mTest AS STRING
 31 DIM mLang AS STRING
 32 DIM mNumber AS LONG
 33 DIM mExpected AS STRING
 34 DIM mGot AS STRING
 35 DIM mDelay AS SINGLE
 36 DIM mTimer AS SINGLE
 37 
 38 mTestCount = 0
 39 RESTORE TestCases
 40 DO
 41    READ mTest
 42    IF mTest = "" THEN
 43       EXIT DO
 44    ELSE
 45       READ mLang, mNumber, mExpected
 46       mTestCount = mTestCount + 1
 47    END IF
 48 LOOP
 49 
 50 CLS
 51 PRINT "1.." + LTRIM$(STR$(mTestCount))
 52 mTestCount = 0
 53 RESTORE TestCases
 54 mStatus = ""
 55 DO WHILE INKEY$ <> CHR$(27)
 56    READ mTest
 57    IF mTest = "" THEN
 58       EXIT DO
 59    ELSE
 60       mTestCount = mTestCount + 1
 61       READ mLang, mNumber, mExpected
 62       mGot = Num2Lang$(mNumber, mLang)
 63       mStatus = "ok" + STR$(mTestCount)
 64       IF mExpected <> mGot THEN
 65          mStatus = "not " + mStatus
 66       END IF
 67       mStatus = mStatus + " - " + LEFT$(mLang + ": " + LTRIM$(STR$(mNumber)) + SPACE$(15), 15) + "'" + mGot + "'"
 68       IF mExpected <> mGot THEN
 69          mStatus = mStatus + " (Expected '" + mExpected + "')"
 70       END IF
 71       PRINT mStatus
 72       IF mExpected = mGot THEN
 73          mDelay = .2
 74       ELSE
 75          mDelay = 2
 76       END IF
 77       mTimer = INT(TIMER * 10)
 78       DO WHILE mDelay > 0
 79          IF mTimer <> INT(TIMER * 10) THEN
 80             mTimer = INT(TIMER * 10)
 81             mDelay = mDelay - .1
 82          END IF
 83       LOOP
 84    END IF
 85 LOOP
 86 SYSTEM
 87 
 88 TestCases:
 89    DATA "*","en-uk",0,"zero"
 90    DATA "*","en-uk",1,"one"
 91    DATA "*","en-uk",9,"nine"
 92    DATA "*","en-uk",10,"ten"
 93    DATA "*","en-uk",11,"eleven"
 94    DATA "*","en-uk",19,"nineteen"
 95    DATA "*","en-uk",20,"twenty"
 96    DATA "*","en-uk",21,"twenty-one"
 97    DATA "*","en-uk",100,"one hundred"
 98    DATA "*","en-uk",101,"one hundred and one"
 99    DATA "*","en-us",101,"one hundred one"
100    DATA "*","en-uk",1000,"one thousand"
101    DATA "*","en-uk",1001,"one thousand and one"
102    DATA "*","en-uk",1958,"one thousand nine hundred and fifty-eight"
103    DATA "*","fr",10,"dix"
104    DATA "*","fr",11,"onze"
105    DATA "*","fr",21,"vingt et un"
106    DATA "*","fr",22,"vingt-deux"
107    DATA "*","fr",29,"vingt-neuf"
108    DATA "*","fr",60,"soixante"
109    DATA "*","fr",61,"soixante et un"
110    DATA "*","fr",62,"soixante-deux"
111    DATA "*","fr",70,"soixante-dix"
112    DATA "*","fr-be",70,"septante"
113    DATA "*","fr-be",71,"septante et un"
114    DATA "*","fr",71,"soixante et onze"
115    DATA "*","fr",79,"soixante-dix-neuf"
116    DATA "*","fr",80,"quatre-vingts"
117    DATA "*","fr-be",80,"octante"
118    DATA "*","fr-ch",80,"huitante"
119    DATA "*","fr",81,"quatre-vingt-un"
120    DATA "*","fr-be",81,"octante et un"
121    DATA "*","fr",82,"quatre-vingt-deux"
122    DATA "*","fr",90,"quatre-vingt-dix"
123    DATA "*","fr-be",90,"nonante"
124    DATA "*","fr",99,"quatre-vingt-dix-neuf"
125    DATA "*","fr",100,"cent"
126    DATA "*","fr",101,"cent un"
127    DATA "*","fr",900,"neuf cents"
128    DATA "*","fr",999,"neuf cent quatre-vingt-dix-neuf"
129    DATA "*","fr",1000,"mille"
130    DATA "*","fr",1100,"mille cent"
131    DATA "*","fr",100000,"cent mille"
132    DATA "*","fr",200000,"deux cents mille"
133    DATA "*","fr",200025,"deux cents mille vingt-cinq"
134    DATA "*","fr",1000000,"un million"
135    DATA "*","fr",1000100,"un million cent"
136    DATA "*","fr",2000000,"deux millions"
137    DATA "*","fr",2003201,"deux million trois mille deux cent un"
138    DATA "*","fr",2000000000,"deux milliards"
139    DATA "*","fr",2000003201,"deux milliard trois mille deux cent un"
140    DATA "*","fr",300,"trois cents"
141    DATA "*","fr",301,"trois cent un"
142    DATA ""
143 
144 FUNCTION Num2Lang$ (aNumber AS LONG, aLang AS STRING)
145 
146    STATIC dLang AS STRING, dLog10 AS DOUBLE
147    STATIC dUnits() AS STRING, dTens() AS STRING, dPowers() AS STRING
148 
149    DIM dBuffer AS STRING, dDigitGroup AS LONG
150    DIM dTensGroup AS LONG, dPowersGroup AS LONG
151    DIM dRange AS INTEGER
152 
153    IF dLang <> aLang THEN
154       GOSUB Num2LangInit
155       dLang = aLang
156    END IF
157 
158    SELECT CASE aNumber
159 
160    CASE 0 TO 19
161       dBuffer = dUnits(INT(aNumber))
162 
163    CASE 20 TO 99
164       dTensGroup = INT(aNumber / 10)
165       dBuffer = dTens(dTensGroup)
166       IF dBuffer = "" THEN
167          dTensGroup = dTensGroup - 1
168          dBuffer = dTens(dTensGroup)
169       END IF
170       dDigitGroup = aNumber - dTensGroup * 10
171       IF dDigitGroup > 0 THEN
172          IF LEFT$(aLang, 2) = "fr" AND RIGHT$(dBuffer, 1) = "s" THEN
173             dBuffer = LEFT$(dBuffer, LEN(dBuffer) - 1)
174          END IF
175          IF LEFT$(aLang, 2) <> "fr" OR dDigitGroup MOD 10 <> 1 THEN
176             dBuffer = dBuffer + "-"
177          ELSEIF aLang = "fr" AND dTensGroup = 8 THEN
178             dBuffer = dBuffer + "-"
179          ELSE
180             dBuffer = dBuffer + " et "
181          END IF
182          dBuffer = dBuffer + Num2Lang(dDigitGroup, aLang)
183       END IF
184 
185    CASE 100 TO 2147483647
186       dRange = INT(LOG(aNumber + .4) / dLog10)
187       IF dRange > 3 THEN dRange = INT(dRange / 3) * 3
188       dPowersGroup = INT(aNumber / 10 ^ dRange)
189       IF aLang = "fr" AND dPowersGroup = 1 AND dRange < 5 THEN
190          dBuffer = ""
191       ELSE
192          dBuffer = Num2Lang(dPowersGroup, aLang)
193       END IF
194       dBuffer = LTRIM$(dBuffer + dPowers(dRange))
195       dDigitGroup = aNumber - dPowersGroup * 10 ^ dRange
196      
197       IF LEFT$(aLang, 2) = "fr" AND (dPowersGroup = 1 OR dDigitGroup > 0) THEN
198          IF RIGHT$(dBuffer, 1) = "s" THEN
199             dBuffer = LEFT$(dBuffer, LEN(dBuffer) - 1)
200          END IF
201       END IF
202       IF dDigitGroup > 0 THEN
203          dBuffer = dBuffer + " "
204          IF dDigitGroup < 100 AND aLang = "en-uk" THEN
205             dBuffer = dBuffer + "and "
206          END IF
207          dBuffer = dBuffer + Num2Lang(dDigitGroup, aLang)
208       END IF
209 
210    CASE ELSE
211       dBuffer = LTRIM$(STR$(aNumber))
212 
213    END SELECT
214 
215    Num2Lang = dBuffer
216 
217    EXIT FUNCTION
218 
219 Num2LangInit:
220    REDIM dUnits(19), dTens(9), dPowers(9)
221    SELECT CASE LEFT$(aLang, 2)
222    CASE "fr"
223       dUnits(0) = "zero": dUnits(10) = "dix": dTens(0) = "": dPowers(0) = ""
224       dUnits(1) = "un": dUnits(11) = "onze": dTens(1) = "": dPowers(1) = ""
225       dUnits(2) = "deux": dUnits(12) = "douze": dTens(2) = "vingt": dPowers(2) = " cents"
226       dUnits(3) = "trois": dUnits(13) = "treize": dTens(3) = "trente": dPowers(3) = " mille"
227       dUnits(4) = "quatre": dUnits(14) = "quatorze": dTens(4) = "quarante": dPowers(4) = ""
228       dUnits(5) = "cinq": dUnits(15) = "quinze": dTens(5) = "cinquante": dPowers(5) = ""
229       dUnits(6) = "six": dUnits(16) = "seize": dTens(6) = "soixante": dPowers(6) = " millions"
230       dUnits(7) = "sept": dUnits(17) = "dix-sept": dTens(7) = "": dPowers(7) = ""
231       dUnits(8) = "huit": dUnits(18) = "dix-huit": dTens(8) = "quatre-vingts": dPowers(8) = ""
232       dUnits(9) = "neuf": dUnits(19) = "dix-neuf": dTens(9) = "": dPowers(9) = " milliards"
233    CASE "en"
234       dUnits(0) = "zero": dUnits(10) = "ten": dTens(0) = "": dPowers(0) = ""
235       dUnits(1) = "one": dUnits(11) = "eleven": dTens(1) = "": dPowers(1) = ""
236       dUnits(2) = "two": dUnits(12) = "twelve": dTens(2) = "twenty": dPowers(2) = " hundred"
237       dUnits(3) = "three": dUnits(13) = "thirteen": dTens(3) = "thirty": dPowers(3) = " thousand"
238       dUnits(4) = "four": dUnits(14) = "fourteen": dTens(4) = "forty": dPowers(4) = ""
239       dUnits(5) = "five": dUnits(15) = "fifteen": dTens(5) = "fifty": dPowers(5) = ""
240       dUnits(6) = "six": dUnits(16) = "sixteen": dTens(6) = "sixty": dPowers(6) = " million"
241       dUnits(7) = "seven": dUnits(17) = "seventeen": dTens(7) = "seventy": dPowers(7) = ""
242       dUnits(8) = "eight": dUnits(18) = "eighteen": dTens(8) = "eighty": dPowers(8) = ""
243       dUnits(9) = "nine": dUnits(19) = "nineteen": dTens(9) = "ninety": dPowers(9) = " billion"
244    CASE ELSE
245       dUnits(0) = "0": dUnits(10) = "0": dTens(0) = "": dPowers(0) = ""
246       dUnits(1) = "1": dUnits(11) = "1": dTens(1) = "1": dPowers(1) = ""
247       dUnits(2) = "2": dUnits(12) = "2": dTens(2) = "2": dPowers(2) = ""
248       dUnits(3) = "3": dUnits(13) = "3": dTens(3) = "3": dPowers(3) = ""
249       dUnits(4) = "4": dUnits(14) = "4": dTens(4) = "4": dPowers(4) = ""
250       dUnits(5) = "5": dUnits(15) = "5": dTens(5) = "5": dPowers(5) = ""
251       dUnits(6) = "6": dUnits(16) = "6": dTens(6) = "6": dPowers(6) = ""
252       dUnits(7) = "7": dUnits(17) = "7": dTens(7) = "7": dPowers(7) = ""
253       dUnits(8) = "8": dUnits(18) = "8": dTens(8) = "8": dPowers(8) = ""
254       dUnits(9) = "9": dUnits(19) = "9": dTens(9) = "9": dPowers(9) = ""
255    END SELECT
256    SELECT CASE LEFT$(aLang, 5)
257    CASE "fr-be"
258       dTens(7) = "septante"
259       dTens(8) = "octante"
260       dTens(9) = "nonante"
261    CASE "fr-ch"
262       dTens(7) = "septante"
263       dTens(8) = "huitante"
264       dTens(9) = "nonante"
265    CASE ELSE
266       REM Do nothing
267    END SELECT
268    dLog10 = LOG(10)
269    RETURN
270 
271 END FUNCTION
272 
273


Retrieved from "http://en.literateprograms.org/Special:Downloadcode"
Views
Personal tools