Programmeren in REXX/Voorbeeldprogramma's

Uit Wikibooks
Naar navigatie springen Naar zoeken springen

   Programmeren    in REXX



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)
Informatie afkomstig van http://nl.wikibooks.org Wikibooks NL.
Wikibooks NL is onderdeel van de wikimediafoundation.