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)