Programmeren in REXX/Voorbeeldprogramma's
Maximum van twee getallen
[bewerken]REXX-code: Maximum.rex
/* Maximum berekenen */ ok=0 do while \ok say "Geef me twee getallen gescheiden door een komma" parse pull a ',' b if a<>"" & b<>"" & datatype(a,'N') & datatype(b,'N') then ok=1 end say max(a,b) "is het grootste van" a "en" b exit 0
We gebruikten gauw even RexxTry om na te gaan of een nullstring als numeriek beschouwd wordt. Dit is een kleine moeite, en toont hoe nuttig RexxTry wel kan zijn:
C:\Users\Dmitri>rexxtry
REXX-ooRexx_4.1.0(MT) 6.03 5 Dec 2010
rexxtry.rex lets you interactively try REXX statements.
Each string is executed when you hit Enter.
Enter 'call tell' for a description of the features.
Go on - try a few... Enter 'exit' to end.
a=""
say datatype(a,'N')
0
........................................... rexxtry.rex on WindowsNT
Uit deze test concluderen we dat een nullstring niet numeriek is, en de test in het programma kan dus vereenvoudigd worden tot:
if datatype(a,'N') & datatype(b,'N') then ok=1
Het programma is daarmee iets korter en meer leesbaar.
Waardeconversie
[bewerken]REXX-code: conversies.rex
/* conversies.rex */ ok=0 do while \ok say "Geef een waarde die moet worden omgezet" parse pull waarde if waarde<>"" then ok=1 end /* Indien 1 enkel teken: omzetting (met ASCII tabel) */ if length(waarde)=1 then do say '['waarde'] ASCII -> Decimaal = ' c2d(waarde) say '['waarde'] ASCII -> Hexadecimaal = ' c2x(waarde) end /* Indien numeriek getal */ if datatype(waarde,'N') then do say '['waarde'] Decimaal -> ASCII = ' d2C(waarde) say '['waarde'] Decimaal -> Hexadecimaal = ' d2x(waarde) end /* indien hexadecimaal getal */ if datatype(waarde,'X') then do say '['waarde'] Hexadecimaal -> ASCII = ' x2C(waarde) say '['waarde'] Hexadecimaal -> Decimaal = ' x2d(waarde) end exit
Dit programmaatje bevat een beginnersfout. Er wordt namelijk getest met datatype(...,'N') om te zien of het een getal betreft. Doch D2C kan enkel met gehele getallen overweg. De test had daarom
if datatype(waarde,'W') then do
moeten zijn, om na te gaan of het een geheel getal betrof.
Antwoordvalidatie
[bewerken]Wachten op een geldig antwoord.
REXX-code: koffievraag.rex
/* Koffievraag.rex */
do while verify(koffie,"JNS")
say "Wil je koffie ? (Ja/Nee of Stop)"
parse upper pull 1 koffie 2
select
when koffie="J" then say "OK, ik ga er een halen voor jou"
when koffie="N" then say "Nou, een andere keer dan"
otherwise nop
end
end
exit
Ook dit programmaatje bevat een aantal beginnersfouten:
- De gebruiker zal niet begrijpen waarom zijn antwoord niet aanvaard wordt als hij " Ja" intikt (dus met een spatie voor de "Ja"). Men kan dit oplossen door te schrijven:
parse upper pull koffie . ; koffie=left(koffie,1)
- Verify geeft geen binair antwoord. In dit geval zal je toch 0 of 1 krijgen omdat koffie maar 1 karakter lang is. Maar, men mag deze techniek zeker niet veralgemenen. Stel eens dat ook K een goed antwoord zou zijn, en er dus een do while verify(koffie,"JNSK") geschreven staat... dan kan het antwoord iets anders dan 0 of 1 worden en hebben we een uitvoeringsfout. Door er een do until van te maken, en er een vergelijking van te maken, vermijden we dat gevaar:
do until verify(koffie,"JNS")=0
Een andere overweging die je als programmeur moet maken is of je "Jazeker" of "Juli en augustus" ook als geldig antwoord wil aanzien. Een strengere schrijfwijze is daarom:
parse upper pull koffie .
select
when abbrev('JA',koffie,1) then say "OK, ik ga er een halen voor jou"
when abbrev("NEE",koffie,1) then say "Nou, een andere keer dan"
when abbrev('STOP',koffie,1) then leave
otherwise say 'Sorry, ik versta uw antwoord "'koffie'" niet'
end
Nu zullen enkel "Ja", "Nee" of "Stop" valabele antwoorden zijn (kijk er eventueel Abbrev nog eens op na).
Gebruik van subroutines
[bewerken]REXX-code: oppervlakte_donut.rex
/* Oppervlakte_donut.rex */ do until ok say 'Geef de grote en kleine straal van de donut' parse pull r1 r2 . OK=(datatype(r1,"N") & datatype(r2,"N")) end say "De oppervlakte van de donut is" area(r1) - area(r2) exit area: procedure parse arg straal . return 3.14 * straal**2
Een do until voert de lus altijd minstens éénmaal uit. De variabele ok moet dus ook niet geïnitialiseerd worden vóór de lus begint, de waarde wordt toch pas aan het eind van de lus getest, en dan hebben we er wel een logische waarde 0 of 1 aan gegeven.
Een probleempje hier is dat de gebruiker absoluut verplicht is om 2 waarden in te geven, anders stopt het programma nooit, tenzij hij/zij weet dat je kan afbreken met een Ctrl-Break of Ctrl-C combinatie.
Tekstweergave
[bewerken]REXX-code: titel.rex
/* Een kadertje met de titel maken */
parse arg titel /* Titel ophalen */
parse value 60 4 '*', /* initialiseren */
with breedte rand symbool .
binnen=breedte-rand /* breedte tekst */
say copies(symbool,breedte) /* bovenlijn kadertje */
do while length(titel)>binnen
deel=left(titel,binnen) /* analyse deel titel */
blank=lastpos(' ',deel) /* waar laatste blank */
if blank=0 then blank=binnen /* geen blank gevonden */
parse var titel deel =(blank) titel /* opeten */
say symbool center(deel,binnen) symbool /* drukken */
end
say symbool center(titel,binnen) symbool /* rest */
say copies(symbool,breedte) /* onderlijn kadertje */
exit
De test if blank=0 is nodig, want het kan zijn dat in het deel dat we behandelen geen spatie voorkomt. Dan kunnen we niet anders dan brutaal splitsen op die plaats. Mooi is het dan misschien niet, maar als de kader enige breedte heeft zal dit toch niet zo gauw voorkomen.
Gebruik van een stem
[bewerken]REXX-code: stad.rex
/******************** stad.rex *********************/
stad. = "onbekend" /* Standaardwaarde zetten */
stad.1000="Brussel"
stad.2000="Antwerpen"
stad.3500="Hasselt"
stad.8000="Brugge"
stad.9000="Gent"
do while code<>""
say 'Geef een postcode (4 cijfers), of blank om te eindigen'
parse pull code
if stad.code \= stad. then
say "U woont in" stad.postcode "!"
else say "De postcode is" stad.
end
exit
Dit kan ook omgekeerd:
REXX-code: postcode.rex
/* postcode.rex */
postcode. = ""
postcode.Brussel=1000
postcode.Antwerpen=2000
postcode.Hasselt=3500
postcode.Brugge=8000
postcode.Gent=9000
do while stad<>""
say 'Geef de naam van uw stad, of blank om te eindigen'
parse pull stad
if postcode.code \= "" then
say "U woont in" postcode.stad "!"
else say "De postcode is onbekend."
end
exit
Woorden tellen in een tekstbestand
[bewerken]REXX-code: woordteller.rex
/* Programma dat de frequentie van woorden in een txt */
/* bestand zal tellen. */
parse arg bestand
w.=0 /* Initialisatie van woordteller */
wrdn="" /* verschillende woorden */
if SysIsFile(bestand) then do
call stream bestand,'Command','OPEN READ' /* Open */
inhoud=charin(bestand,1,chars(bestand)) /* Lees */
call stream bestand,'Command','CLOSE' /* Sluit */
inhoud=strip(inhoud,'Trailing','1A'x) /* Strip eof */
startp=1 /* start voor zoeken CrLf */
do i=1 by 1 /* continu lus... */
p=pos('0D0A'x,inhoud,startp) /* pos van CrLf */
if p>0 then
call verwerklijn substr(inhoud,startp,p-startp)
else do /* verwerk laatste lijn */
call verwerklijn substr(inhoud,startp)
leave /* alles verwerkt */
end
startp=p+2 /* volgende start na de CrLf */
end
say 'Er zijn' words(wrdn) 'verschillende woorden.'
say 'Daarvan komen volgende meermaals voor:'
do while wrdn<>"" /* voor alle gevonden woorden */
parse var wrdn woord wrdn
if w.woord>1 then say format(w.woord,3,0) 'x' woord
end
call exit 0,'Einde verwerking'
end
else call exit 28,'Het bestand "'bestand'" bestaat niet'
/******************** Subroutines *********************/
VERWERKLIJN: procedure expose w. wrdn /*Woorden tellen*/
parse upper arg lijn
if length(lijn)=0 then return
/* we veranderen leestekens en tab karakters in spaties */
lijn=translate(lijn,"","!""'.,;:/\=+-()[]{}%$€#*"||"09"x)
do while lijn<>""
parse var lijn woord lijn /* lijn opeten */
w.woord=w.woord+1 /* teller van woord +1 */
if w.woord=1 then /* nieuw woord gevonden */
wrdn=wrdn woord
end
return
EXIT: /* Algemene exit-routine */
parse source . oproepvorm myname
a=lastpos('\',myname)
parse var myname +(a) myname '.'
do i=2 to arg()
say myname':' arg(i)
end
if oproepvorm='COMMAND' then
if arg(1)<>"" & arg(1)<>0 then say myname': Foutcode='arg(1)
exit arg(1)
Bij het herlezen van dit programma ontdekken we nog een schoonheidsfoutje: in de verwerklijn routine schrijven we
if length(lijn)=0 then return
Dit is overkill, if lijn="" then return is meer dan voldoende. Het oproepen van een functie is altijd kostelijk.
Uitgebreide DIR dank zij SysFileTree
[bewerken]REXX-code: filetree.rex
/* D.m.v. de functie SysFileTree, bestanden lijsten */
/* Formaat: FILETREE [opties] bestands-selectie */
/* De meeste opties komen overeen met die van SysFileTree */
/* Optie /N vraagt om enkel naam.ext te geven, dus zonder pad */
/* Optie /O vraagt om datum, grootte en atributen niet te tonen */
/* Optie /S vraagt ook in onderliggende mappen te zoeken */
/* Optie /F vraagt om enkel bestanden en geen mappen te tonen */
/* Optie /D vraagt enkel de mappen te lijsten */
/* Optie /A+x of /A-x vraagt bestanden te lijsten met bepaalde atribu- */
/* ten aan of af. Vb. /A+S lijst systeembestanden */
/* Optie /SORT [Date | Size | Name [Asc | Desc] sorteert op datum, */
/* grootte of naam, in oplopende (Ascending) of Dalende order */
signal on Novalue
parse value 0 0 with Omit EnkelNaam . '' fsel StripPath AttrFlags sort
fselFlags='L' /* Standaard optie voor bestandsselectie */
parse arg args /* argumenten ophalen */
/* Als geen parameter of ? of /H, toon dan inleidende commentaartekst */
if args='' | args='?' | translate(args)='/H' then do
do i=1 until left(sourceline(i+1),2)<>'/*'
parse value sourceline(i) with 3 t '*/' ; say t
end
exit
end
/* Parameters analyseren en opties eruithalen... */
do while args<>''
if left(strip(args,'L'),1)='/' then do /* Als woord begint met / */
parse var args flag args /* het woord opeten */
flag=translate(flag) /* naar hoofdletter */
select
when flag='/N' then EnkelNaam=1
when flag='/O' then do
FselFlags=FselFlags||'O'
Omit=1
end
when flag='/L' then FselFlags=FselFlags||'L'
when flag='/D' then FselFlags=FselFlags||'D'
when flag='/F' then FselFlags=FselFlags||'F'
when flag='/S' then FselFlags=FselFlags||'S'
when left(flag,2)='/A' then call AttrFlag
when flag='/SORT' then call SortFlag
Otherwise call ErrExit 5,'Ongeldige optie "'flag'"'
end
end
else parse var args fsel '' args
end
if fsel='' then call ErrExit 5,'Geen selectiecriterium gegeven'
/* Met /O en /SORT DATE of SIZE kunnen we niet verder */
if Omit then
if sort='DATE' | sort='SIZE' then
call ErrExit 77,'Om te kunnen sorteren op' sort 'mag geen /O opgegeven worden.'
/* We kunnen SysFileTree nu oproepen, resultaat in stem f. */
call SysFileTree fsel,'F.',FselFlags,attrFlags
if f.0=0 | result<>0 then
call ErrExit 28,'Geen bestanden gevonden voor' fsel
/* Nu verzorgen we de output */
if EnkelNaam then /* pad afstrippen als enkel naam nodig */
if Omit then do i=1 to f.0
p=lastpos('\',f.i) ; f.i=substr(f.i,p+1)
end i; else do i=1 to f.0
p=lastpos('\',f.i)
f.i=left(f.i,40) || substr(f.i,p+1)
end
/* Als sorteren nodig is, subroutine */
if sort<>'' then call SortResultaat
/* Afdrukken op scherm */
do i=1 to f.0
say f.i
end
call exit 0,'Einde verwerking'
/*-----------------------------------------------------------------*/
AttrFlag: /* /A attributen analyseren */
/*-----------------------------------------------------------------*/
parse var flag 3 PlusMin 4 flags
if PlusMin<>'-' & PlusMin<>'+' then
call ErrExit 6,'/A formaat fout: we verwachten een + of - iplv' plusMin,,
'Formaat: /A+xy of /A-xy, voorbeeld: /A-SD /A+R'
if Verify(flags,'ADRHS')<>0
then call ErrExit 6,'/A formaat fout: we verwachten karakters A,D,H,R of S iplv' fl,,
'Formaat: /A+xy of /A-xy, voorbeeld: /A-SD /A+R'
do while flags<>'' /* We bouwen Zattribuut parameter voor SysFileTree op */
parse var flags fl 2 flags
fl=translate(fl,'12345','ADHRS') /* Positie van de attribuut ligt vast */
attrFlags=overlay(PlusMin,attrFlags,fl) /* Zetten op zijn plaats */
attrFlags=translate(left(attrFlags,5),'*',' ') /* Rest op * */
end
return
/*-----------------------------------------------------------------*/
SortFlag: /* /SORT attributen analyseren */
/*-----------------------------------------------------------------*/
Sort='NAME' ; SortHoe='A' /* Standaard oplopend op naam sorteren */
w1=translate(word(args,1))
Select
when abbrev('DATE',w1,1) then sort='DATE'
when abbrev('SIZE',w1,1) then sort='SIZE'
when abbrev('NAME',w1,1) then sort='NAME'
Otherwise return
end
parse var args . args
w1=translate(word(args,1))
Select
when abbrev('ASCENDING',w1,1) then SortHoe='A'
when abbrev('DESCENDING',w1,1) then SortHoe='D'
Otherwise return
end
parse var args . args
return
/*-----------------------------------------------------------------*/
SortResultaat: /* Resultaat sorteren volgens aanvraag */
/*-----------------------------------------------------------------*/
/* Het formaat van één stem-element is...
2011-12-13 09:38:00 2145386496 A-H-S C:\pagefile.sys
1...+....1....+....2....+....3....+....4....+....5....+....6 */
Select
when sort='DATE' then SortCols=1 19
when sort='SIZE' then SortCols=21 31
when sort='NAME' & \ommit then SortCols=41
otherwise SortCols=1 /* Enkel naam in output */
end
call SysStemSort 'F.',SortHoe,'I',1,F.0,word(SortCols,1),word(SortCols,2)
return
/*-----------------------------------------------------------------*/
NOVALUE: /* Als REXX een niet geinitialiseerde variabele vindt... */
/*-----------------------------------------------------------------*/
parse upper source . how myname '' undefvar
myname=filespec('N',myname)
undefvar= 'CONDITION'('D')
call errexit 99,'REXX probleem in' myname 'op lijn' sigl,
'variabele' undefvar 'is niet gedefinieerd.'
/*-----------------------------------------------------------------*/
ERREXIT: EXIT: /* Algemene exit routine */
/*-----------------------------------------------------------------*/
parse upper source . . myname
myname=filespec('N',myname)
do i=2 to arg() /* toon foutberichten als er zijn */
say myname':' arg(i)
end
exit arg(1)
Dit is een voorbeeld bij uitvoering:
C:\>rexx d:\RexxProgrammas\FileTree /n d:\RexxProgrammas\r*.rex 2008-04-29 17:54:36 3217 A---- Rawdates.rex 2008-05-19 14:46:48 1697 A---- renumfiles.rex 2011-11-30 17:52:45 2498 A---- rexdates.rex 2011-11-19 08:49:56 815 A---- rextimes.rex 1999-12-02 20:46:20 12216 A---- Rexxtry.rex 2011-02-16 10:09:05 109 A---- RxVersie.rex SYSFTREEN.REX: Einde verwerking
Berekenen van priemgetallen, volledige versie
[bewerken]REXX-code: priemgetallen.rex
/********************************************************************/
/* Programma berekent een reeks priemgetallen. */
/* Vroeger berekende getallen zitten in priem.lst (10 per lijn) */
/* Het programma zal: */
/* - priem.lst lezen en de getallen in priem. lijst zetten */
/* - het zoekt nieuwe priemgetallen vanaf laatst gevonden */
/* - 1000 nieuwe getallen worden gezocht. */
/* - getallen worden toegevoegd in de priem.lst */
/********************************************************************/
numeric digits 15 /* we voorzien grote getallen */
/********************************************************************/
/* Stap 1: We lezen priem.lst die in zelfde map als pgm staat */
/********************************************************************/
parse source . . mezelf /* bepalen ons pad... */
priembestand=filespec('D',mezelf)||filespec('P',mezelf)'priem.lst'
tempbestand=priembestand".tmp" /* Tijdelijk werkbestand */
call SysFileDelete tempbestand /* Oude versie uitvagen */
if SysIsFile(priembestand) then do /* Als bestand is gevonden... */
call time 'Reset' /* starten chronometer */
say 'Stap 1 : We lezen' priembestand
rc=SysFileCopy(priembestand,tempbestand) /* reservecopie maken */
if rc\=0 then call exit rc,"Maken van reservecopie mislukt"
call stream priembestand,'C','OPEN READ' /* Open bestand */
oudepriem=charin(priembestand,1,chars(priembestand)) /* lezen */
call stream priembestand,'C','CLOSE' /* Sluiten bestand */
oudepriem=strip(oudepriem,'T','1A'x) /* strippen eof controle */
priem.0=0
startp=1 /* start voor zoeken CrLf */
do i=1 by 1 /* continue lus... */
p=pos('0D0A'x,oudepriem,startp) /* pos van volgende CrLf */
if p>0 then /* als een is gevonden */
call verwerklijn substr(oudepriem,startp,p-startp)
else do /* verwerk laatste lijn */
call verwerklijn substr(oudepriem,startp)
leave /* alles verwerkt */
end
startp=p+2 /* spring over gevonden CrLf */
end
z=priem.0 ; start=priem.z+2 /* we beginnen na laast gekende */
say ' Lezen nam' format(time('R'),,3) 'seconden in beslag'
end
else do
say 'Priem.lst bestaat nog niet, we maken een eerste reeks aan'
parse value 1 2 3 with priem.0 priem.1 start
end
/********************************************************************/
/* Stap 2: We kunnen nu nieuwe priemgetallen zoeken */
/********************************************************************/
say 'Stap 2 : Opzoeken van 1000 nieuwe priemgetallen, even geduld...'
nieuwe=0 /* teller van nieuwe priemgetallen */
do i=start by 2 /* lus vanaf start per 2 */
do j=2 to z /* lus over al gevonden priemgetallen */
if i<priem.j**2 then leave j /* >priem**2 ? ==> verlaat lus j */
if i//priem.j=0 then iterate i /* rest i/priem=0 ? volgende */
end j /* einde van lus j */
nieuwe=nieuwe+1 /* 1 bij nieuwe priemgetallenteller */
parse value 1+priem.0 i with z . 1 priem.0 priem.z /* stockeren */
if nieuwe=1000 then leave i /* We hebben er 1000 gevonden */
end i /* einde van lus i */
say ' Opzoeken duurde' format(time('R'),,3) 'seconden.'
/********************************************************************/
/* Stap 3: Wegschrijven van de nieuwe priemgetallen in priem.lst */
/********************************************************************/
say 'Stap 3 : We schrijven de resultaten weg'
call stream priembestand,'C','OPEN WRITE APPEND' /* Openen bestand */
veldbreedte=min(length(priem.z),digits()+1)+1 /* afdrukbreedte */
do i=priem.0-999 to priem.0 by 10 /* 10 per regel wegschrijven */
lijn='' /* Start met blanco lijn */
do j=i to i+9 /* regel opbouwen */
lijn=lijn||format(priem.j,veldbreedte)
end
call lineout priembestand,lijn /* Wegschrijven regel */
end i
rc=stream(priembestand,'Command','Close') /* Sluiten bestand */
if rc="READY:" then do
call SysFileDelete tempbestand
say ' Wegschrijven duurde' format(time('R'),,3) 'seconden.'
call exit 0,'Einde van het programma.'
end; else call exit 28,'Wegschrijven van priemgetallen mislukt',,
'Foutcode was='rc,,
'Oude versie is bewaard in' tempbestand
/**************************** subroutines ***************************/
VERWERKLIJN: procedure expose priem.
parse arg lijn
do while lijn<>''
parse var lijn priem lijn
parse value 1+priem.0 priem with z . 1 priem.0 priem.z
end
return
EXIT: /* Algemene exit-routine */
parse source . oproepvorm myname
a=lastpos('\',myname)
parse var myname +(a) myname '.'
do i=2 to arg()
say myname':' arg(i)
end
if oproepvorm='COMMAND' then
if arg(1)<>"" & arg(1)<>0 then say myname': Foutcode='arg(1)
exit arg(1)