/* REXX ***************************************************************
* Eingabe Funktion
* EURO ATS 100 DEM 100 ATS (über Euro) in DEM umrechnen
* EURO 100 ATS 100 Euro in ATS umrechnen
* EURO 100 100 Euro in alle Euro-Währungen umrechnen
* EURO ATS 100 100 ATS in alle Euro-Währungen umrechnen
* EURO 1 Euro in alle Euro-Währungen umrechnen
* EURO ATS Name der Währung, Untereinheit und Land herzeigen
***********************************************************************
* Änderungen:
* 16.05.2001 Walter Pachl pachl@chello.at Lösungsvorschlag
**********************************************************************/
Signal On Halt
Signal On Novalue
Signal On Syntax
Numeric Digits 16
Parse Upper Arg a b c .
Call init
Select
When a='?' Then /* Hilfe gewünscht */
Call help /* Ausgabe der Hilfe */
When a='' Then Do /* kein Argument */
einwhg='EUR'; betrag=1; auswhg='' /* alle Gegenwerte zu 1.00 EUR*/
End
When a<>'' & datatype(a)='NUM' Then Do /* Betrag an erster Stelle */
einwhg='EUR'; betrag=a; auswhg=b /* Annahme: Euro */
End
Otherwise Do /* Zwei oder drei Argumente */
einwhg=a; betrag=b; auswhg=c
End
End
If kurs.einwhg=0 Then
Call err 'Eingabewährung ('einwhg') ungültig. Gültig sind:' wlist
If betrag='' Then Do
Say space(einwhg name.einwhg '/' teil.einwhg '('land.einwhg')')
Exit
End
If auswhg<>'' &,
kurs.auswhg=0 Then
Call err 'Ausgabewährung ('auswhg') ungültig. Gültig sind:' wlist
If betrag<>'' &,
datatype(betrag)<>'NUM' Then
Call err 'Betrag ('betrag') nucht numerisch.'
zbetrag=betrag/kurs.einwhg /* Einbetrag in Euro */
If auswhg<>'' Then Do
xx=format(zbetrag*kurs.auswhg,15,dec.auswhg)
Say betrag einwhg '=' format(zbetrag,12,6) 'EUR =',
format(zbetrag*kurs.auswhg,15,dec.auswhg) auswhg
End
Else Do
Do While wlist<>''
Parse Var wlist whg wlist
If whg<>einwhg Then Do
If dec.whg=0 Then bla=' '
Else bla=''
xx=format(zbetrag*kurs.whg,15,dec.whg)
Say betrag einwhg '=' format(zbetrag,12,6) 'EUR =',
format(zbetrag*kurs.whg,15,dec.whg)||bla whg
End
End
End
Exit
init:
/**********************************************************************
* Währungseigenschaften initialisieren und Währungsliste erstellen
**********************************************************************/
wlist='' /* Währungsliste zunächst leer*/
kurs.=0 /* und keinerlei Kurse */
Call setkurs 'ATS',13.7603 ,'Österr. Schilling ','Groschen ',2, 'Österreich'
Call setkurs 'BEF',40.3399 ,'Belgischer Franc ','Centimes ',0, 'Belgien'
Call setkurs 'DEM',1.95583 ,'Deutsche Mark ','Pfennig ',2, 'Deutschland'
Call setkurs 'ESP',166.386 ,'Peseta ',' ',2, 'Spanien'
Call setkurs 'EUR',1 ,'MUM-Länder ','Cents ',2, 'Europa'
Call setkurs 'FIM',5.94573 ,'Finnmark ','Penniä ',2, 'Finnland'
Call setkurs 'FRF',6.55957 ,'Französischer Franc ','Centimes ',2, 'Frankreich'
Call setkurs 'GRD',340.750 ,'Griechische Drachme ','Lepta ',0, 'Griechenland'
Call setkurs 'IEP',0.787564,'Irisches Pfund ','Pence ',2, 'Irland'
Call setkurs 'ITL',1936.27 ,'Italienische Lira ','Centesimi',0, 'Italien'
Call setkurs 'LUF',40.3399 ,'Luxemburg.Franc ','Centimes ',0, 'Luxemburg'
Call setkurs 'NLG',2.20371 ,'Holländischer Gulden','Cents ',2, 'Niederlande'
Call setkurs 'PTE',200.482 ,'Escudo ','Centavos ',0, 'Portugal'
wlist=wordsort(strip(wlist)) /* Währungsliste sortieren */
Return
setkurs:
/**********************************************************************
* Attribute der Währung setzen;
* kurs.whg Wert eines Euro in der jetzigen Währung
* name.whg Name der Währung
* teil.whg Unterteilung
* dec.whg Anzahl der Dezimalen
* land.whg Land in dem die Währung verwendet wird
* Zusätzlich Aufbau der Liste der MUM-Währungen (wlist)
**********************************************************************/
Parse Arg whg,kurs.whg,name.whg,teil.whg,dec.whg,land.whg
wlist=wlist whg
Return
err:
/**********************************************************************
* Ausgabe einer Fehlermeldung und Programmende
**********************************************************************/
Parse Arg msg
Do Until msg=''
Parse Var msg m '.' msg
Say strip(m)
End
Exit
wordsort: Procedure
/**********************************************************************
* Die übergebene Wortliste wird aufsteigend sortiert zurückgegeben
**********************************************************************/
Parse Arg wl /* Wortliste als Argument */
wa.='' /* Array der Wörter */
wa.0=0 /* Anzahl der Wörter */
Do While wl<>'' /* so lange noch etwas da ist */
Parse Var wl w wl /* nächstes Wort nehmen */
Do i=1 To wa.0 /* ein größeres in wa.i suchen*/
If wa.i>w Then Leave /* gefunden */
End
If i<=wa.0 Then Do /* wenn eines gefunden wurde */
Do j=wa.0 To i By -1 /* größere hinaufschieben */
ii=j+1 /* Zielindex */
wa.ii=wa.j /* hier wird geschoben */
End
End
wa.i=w /* in den freigewordenen Platz*/
wa.0=wa.0+1 /* Anzahl erhöhen */
End
swl='' /* sortierte Wortliste */
Do i=1 To wa.0 /* aus allen Wörtern */
swl=swl wa.i /* zusammensetzen */
End
Return strip(swl) /* und zurückgeben */
help:
/**********************************************************************
* Hilfsinformation ausgeben
**********************************************************************/
Do i=2 By 1
If pos('***',sourceline(i))>0 Then Leave
Say strip(sourceline(i))
End
Say 'MUM-Währungen: (eigenlich Minderdenominationen des Euro)'
Do ii=1 By 1 While wlist<>''
Parse Var wlist w wlist
Say ' 'right(ii,2)'. 'w' 'left(name.w,20) '/' left(teil.w,11),
land.w
End
Exit
/**********************************************************************
* Fehlerbehandlung (unerwartete Programmfehler)
**********************************************************************/
Novalue:
Say 'Novalue raised in line' sigl
Say sourceline(sigl)
Say 'Variable' condition('D')
Signal lookaround
Syntax:
Say 'Syntax raised in line' sigl
Say sourceline(sigl)
Say 'rc='rc '('errortext(rc)')'
halt:
lookaround:
Say 'You can look around now.'
Trace ?R
Nop
Exit 12