HANDLEIDING BIJ HET PROGRAMMA VOOR DE KALIBRATIEOPSTELLING VOOR LASER INTERFEROMETERS W.P.A. Rapportnr. 0667 G.C.M. van der Ven
jan.
198~
INHOUDSOPGAVE HOOFDSTUK 1: INLEIDING
2
HOOFDSTUK 2: DE MODIFICATIE VAN HET PROGRAMMA
3
HOOFDSTUK 3: DE STRUCTUUR VAN HET PROGRAMMA 3.1 De unit MyGlobals 3.2 De units Service, Mathl en Graphexl 3.3 De unit Filer 3.4 De unit InputDa1 3.5 De unit Diagram 3.6 De unit TekstFiles 3.7 De unit Verwerk 3.8 De unit LaserInterface 3.9 De unit SpiegelVerpl 3.10: De unit Frequentiemeting 3.11: De unit Vergelijkingsmeting 3.12: Het hoofdprogramma: "PROGRAM Laser"
4 4 4 4 4 5 6 6 6 6 6 7 9
HOOFDSTUK 4: HET OPSTARTEN VAN HET PROGRAMMA
10
BIJLAGE
1: DE VRAGEN-SETS
11
BIJLAGE
2: DE FILE LASER. HLP
13
BIJLAGE
3: DE LISTINGS VAN DE UNITS 3.1 UNIT MyGlobals 3.2 UNIT Service 3.3 UNIT Math1 3.4 UNIT Graphex1 3.5 UNIT Filer 3.6 UNIT InputDa1 3.7 UNIT Diagram 3.8 UNIT TekstFiles 3.9 UNIT Verwerk 3.10: UNIT LaserInterface 3.11: UNIT SpiegelVerpl 3.12: UNIT Frequentiemeting 3.13: UNIT Vergelijkingsmeting 3.14: PROGRAM Laser
19 22 23 25 32 39 55 60 67 72 77 78 82 95
HOOFDSTUK 1 INLEIDING In het laboratorium voor geometrische meettechniek van de vakgroep WPA op de T.U.Eindhoven is een kalibratieopstelling voor industriele laserinterferometers ontwikkeld (R.T.E. Huit, WPA 0499). Deze kalibratieopstelling bestaat uit twee delen, namelijk: - een opstelling voor de kalibratie van de laserlichtbron, - een opstelling voor de kalibratie van de gehele laserinterferometer. V~~r deze kalibratieopstelling is een programma geschreven waarmee het mogelijk is de besturing,de berekeningen en de gegevensverwerking automatisch uit te voeren. Het programma is geschreven in Turbo Pascal 3.0. Het programma is voortgekomen uit een afstudeerwerk van R.T.E. Huit (WPA 0557). Wegens tijdgebrek is dit programma niet aangepast voor wat betreft de gebruikersvriendelijkheid en de opbouw. Tevens blijkt het programma tijdens het gebruik soms vast te lopen, wat waarschijnlijk te wijten was aan de lengte van het programma. Het programma bezit namelijk een lengte groter dan de maximale lengte van 64K (voor Turbo Pascal 3.0) waardoor gebruik gemaakt moest worden van zogenaamde overlay-procedures, die niet optimaal functioneerden. In dit werk wordt een nieuwe opzet van het programma beschreven, zoals dat in het kader van een A.I.O.-opdracht is ontwikkeld. Hierbij heeft vooral de gebruikersvriendelijkheid en de presentatie van de meetresultaten voorop gestaan. In hoofdstuk 2 wordt de aanpak van de modificatie van het programma besproken en in hoofdstuk 3 wordt de opbouw van het programma besproken. Tenslotte wordt in hoofdstuk 4 besproken hoe men het programma moet opstarten.
-2-
HOOFDSTUK 2 DE MODIFICATIE VAN HET PROGRAMMA Het programma dient zodanig aangepast te worden dat: - de gebruikersvriendelijkheid toeneemt, - de opbouw van het programma zodanig is dat het gemakkelijk uitgebreid kan worden zonder beperkingen voor de lengte van het programma, - de bedrijfszekerheid toeneemt, - de representatie van de resultaten zodanig is dat deze naar buiten toe gepresenteerd kunnen worden. Dit kan men op verschillende manieren realiseren, namelijk: - het bestaande programma zodanig modificeren dat aan bovenstaande Eisen wordt voldaan, - het bestaande programma opsplitsen in twee programma's, namelijk een v~~r de kalibratie van de laserlichtbron en een voor de kalibratie van de gehele laserinterferometer, zodat de programma's korter worden, - het programma omzetten in een andere taal welke geen beperkingen heeft wat betreft de lengte. Het bestaande programma gebruikersvriendeIijker maken en de structuur van het programma zodanig aan te passen dat gemakkeIijk uitbreidingen aangebracht kunnen worden, zou op hetzelfde neerkomen als het grotendeels herschrijven van het hele programma. Hierbij zal echter de beperkte programmalengte een probleem blijven opleveren. Daarom kan men in plaats van het programma herschrijven, het programma beter direct in een andere taal schrijven welke geen beperkingen heeft wat betreft de programmalengte. Het programma opsplitsen in twee kortere programma's zou maar een tijdelijke oplossing zijn, omdat er plannen zijn om de opstelling zo aan te passen dat beide kalibraties tegelijk uitgevoerd kunnen worden. Tevens zou dit ook leiden tot een relatief kleine afname van de programmalengte, omdat beide programma's gebruik maken van dezelfde procedures, zoals het tekenen van grafieken, de file-handling en de IEEE-interfacing. Daarom is gekozen voor het omzetten van het gehele programma in een programmeertaal welke geen beperkingen heeft wat betreft de programmalengte. Gekozen is voor de taal Turbo Pascal 4.0. In Turbo Pascal 4.0 wordt de programmalengte aIleen begrensd door het operating system van de computer en de computer zelf. Tevens kan men in Turbo Pascal 4.0 werken met zogenaamde Units. Dit zijn een soort modules welke procedures en variabelen kunnen exporteren naar andere units en naar het hoofdprogramma. Met deze units kan men verschillende programma-onderdelen van elkaar scheiden wat de overzichtelijkheid van het programma ten goede komt. Een ander voordeel van het omzetten van het bestaande programma in Turbo Pascal 4.0 is dat in deze taa1 a1 een gebruikersvriendelijke menustructuur is ontwikkeld (J.A. So~ns, WPA 0558) die met enkele wijzigingen bruikbaar is voor het te ontwikke1en programma. Behalve dan het gebruik van units en de "onbeperkte" programma1engte zijn de verschil1en tussen Turbo Pascal 3.0 en Turbo Pascal 4.0 zo klein dat er geen grote problemen te verwachten zijn wat betreft de interfacing tussen de computer en de opstelling.
-3-
HOOFDSTUK 3 DE STRUCTUUR VAN HET PROGRAMMA Het programma bestaat uit 13 units en het hoofdprogramma. Elke unit heeft een specifieke functie en met het hoofdprogramma bepaald men in feite van welke units men gebruik maakt. De volgende units zijn beschikbaar: - unit MyGlobals, unit Service, unit Math1, unit Graphex1, unit Filer, unit InputDa1, unit Diagram, unit TekstFiles, unit Verwerk, unit Laserlnterface, unit SpiegelVerpl, unit Frequentiemeting, - unit Vergelijkingsmeting. De eerste 9 units zijn algemene units voor de file-handling, de menu-stuctuur, het tekenen van grafieken en voor de verwerking van de meetgegevens. De laatste 4 units zijn specifieke units voor de besturing van de kalibratieopstelling. De listings van de units en van het hoofdprogramma staan in bijlage 3. Hieronder worden aIle units en het hoofdprogramma kort besproken, waarbij zonder nadere aanduiding regelmatig gebruik gemaakt wordt van namen zoals deze in de units worden gebruikt. 3.1 De unit MvGlobals Deze unit bevat aIleen constanten, variabelen en type declaraties. In deze unit zijn de declaraties ondergebracht die van belang Z1Jn voor meerdere units, zodat men niet steeds opnieuw dezelfde constanten, variabelen en types hoeft te declareren. De declaraties in deze unit kan men namelijk in elke andere unit en in het hoofdprogramma importeren. 3.2 De units Service, Mathl en Graphex1 Deze units bevatten procedures voor algemeen gebruik zoals mathematische berekeningen voor machtverheffen en grafische procedures voor het tekenen van lijnen en cirkelbogen. 3.3 De unit Filer Deze unit verzorgt de file-handling voor het hoofdprogramma zoals het bijhouden en verwijderen van aanwezige files. Tevens verzorgt deze unit het ophalen van de zogenaamde vragen-sets (zie Unit InputDa1) . 3.4 De unit InputDa1 Deze unit verzorgt de gehele menu-structuur met helppagina's. Deze unit exporteert verschillende procedures waarvan de belangrijkste worden besproken. - PROCEDURE RepresentHelpPage Deze procedure maakt het mogelijk om op een willekeurig moment een helppagina op het scherm neer te zetten. Het enigste wat men aan deze procedure mee moet geven zijn een
-4-
paginanummer en een file waarin de tekst van de helppagina staat. Deze file moet men wel op een bepaalde manier aanmaken, namelijk men moet beginnen met een "%" teken, op de volgende regel het paginanummer en vervolgens de tekst van de helppagina. Tenslotte moet men deze tekst afsluiten met een "%" teken en daaronder kan men weer beginnen met het paginanummer van de volgende helppagina. De file-naam van de helppagina's voor het laserkalibratie-programma is Laser.HLP (zie bijlage 2). - PROCEDURE Questions Deze procedure maakt een scherm met een vragen-set, welke men eerst met het programma MakeQue.PAS aan moet maken. Dit programma geeft elke vragen-set een nummer en vervolgens moet men de titel ingeven, het aantal vragen en de vragen zelf met het type antwoord (real, integer of string) en een eventuele helppagina. Deze vragen-set wordt vervolgens in ASCII-code naar een file geschreven. Met de procedure Questions kan men vervolgens de vragen-set oproepen en op het scherm zetten. Hierbij moet men echter wel het nummer van de vragen-set en in welke file de vragen-set staat meegeven. De procedure geeft een integer (ifail) terug. Uit de waarde van ifai1 kan men afleiden of de antwoorden geaccepteerd z1Jn (ifai1 = 0), de procedure onderbroken is (ifail = 1) of gevraagd is naar een fileoverzicht (ifail = 3). Het voordee1 van het genereren van vragen op deze manier is dat de vragen niet in het programma of de unit zelf staan, maar in een aparte file. Omdat de antwoorden eveneens naar die file worden geschreven, blijven deze bewaard. De laatst gegeven antwoorden blijven dus altijd bekend, ook als de PC uitgeschakeld is geweest. De zeven laatst gegeven antwoorden worden eveneens bewaard. Deze kan men oproepen door functietoest F2 in te toetsen. Als men F1 intoetst krijgt men de helppagina die men bij het aanmaken van de vragenset met het programma MakeQue heeft opgegeven. De vragen-sets voor het programma voor de kalibratieopstelling voor laserinterferometers staan in de file LaserQue.Que. Omdat deze file in ASCII-code staat, kan men deze niet lezen. Daarom staan in bijlage 1 alle vragen-sets met hun nummer, de vragen en de helppagina. - FUNCTION Menu Met deze functie-procedure kan men een menu op het scherm genereren. Het enigste wat men op hoeft te geven is de titel, het aantal opties en de opties zelf. De functieprocedure heeft als resultaat een integer waaruit men kan opmaken voor welke optie men gekozen heeft. 3.5 De unit Diagram Met deze unit kan men 2-dimensionale grafieken op het scherm weergeven. Men hoeft alleen de procedure TekenGrafiek aan te roepen, waarbij men alleen de tekst bij de grafiek, de file(s) met daarin de x- en y-waarden, het aantal grafieken in een figuur en een eventue1e verschuiving t.o.v. y = 0 hoeft mee te geven. Vervolgens worden de schalen langs de assen zodanig berekend dat het scherm maximaal benut wordt en de schaalverdeling langs de assen gehele getallen zijn.
-5-
3.6 De unit TekstFiles Met deze unit worden tekstfiles aangemaakt waarin de algemene gege~~ns van een meting staan, zoals tijd, datum en operator. Tev~ns bevat deze unit de procedure PrintTekst. Deze procedure schrijft een gegeven ~~xt-file naar de printer. 3.7 De unit Verwerk Deze unit bevat procedures voor het verwerken van zowel de frequentiemetingen als de vergelijkingsmetingen. De procedure VerwerkFreqMet bepaalt de gemiddelde frequentie, de standaardafwijking en de golflengte van de te testen laser uit eerdere frequentiemetingen. Met de procedure VerwerkVergMet kan men van eerder gedane metingen de meetwaarden uitprinten en in een grafiek weergeven. Deze meetwaarden kan men eveneens golflengte gecorrigeerd of golflengte en brekingsindex (in het geval van een meting met automatische compensator) gecorrigeerd uit laten printen en in een grafiek weergeven. 3.8 De unit LaserInterface Deze unit bevat procedures voor de IEEE-interfacing, voor het resetten van de lasers en voor het uitlezen van de lasers. In de unit MyGlobals is het type laserType gedeclareerd. Dit type is een record waarin specifieke gegevens van een laser, zoals het typenummer, het commando voor het setten en uitlezen van de laser en het adres, worden opgeslagen. In de unit LaserInterface worden deze records voor een aantal lasers gevuld met de procedure InitLaserTypes. De procedure SetLaser en ReadLaser zijn nu zodanig opgesteld dat men aIleen een laserType hoeft mee te geven om een laser te setten of uit te lezen. Aangezien aIleen lasers met een IEEE-uitgang automatisch gereset kunnen worden, wordt in de procedure SetLaser eerst gekeken naar het type van de laser. Afhankelijk van het type, wordt de betreffende laser automatisch gereset of wordt op het scherm een helppagina weergegeven dat men de laser handmatig moet resetten. De functie-procedure ReadLaser bepaalt eveneens aan de hand van het type laser hoe de laser uitgelezen moet worden. AIleen lasers met een IEEE- of BCD-uitgang (Function ReadBCDLaser) kunnen automatisch uitgelezen worden. Voor lasers met een andere uitgang moet men de waarden handmatig invoeren (Function ReadManual). 3.9 De unit SpieqelVerpl Deze unit bevat de procedures spiegel.
voor
het
verplaatsen
van de
3.10 De unit FrequentieMetinq Deze unit bevat de procedures voor de kalibratie van de laserlichtbron. Voor de kalibratie kan men 3 metingen uitvoeren welke ondergebracht zijn in 3 procedures, namelijk: - PROCEDURE MeetFrequentie, - PROCEDURE AllenVariance, - PROCEDURE MeetInschakel. De bepaling van de Allen-variance is in het huidige programma nog niet geimplementeerd. De andere twee procedures zullen we
-6-
hieronder kort bespreken. - PROCEDURE MeetFrequentie Met deze procedure kan men een op te geven aantal keren de verschilfrequentie tussen de te testen laser en de He-Ne-J2 frequentiegestabiliseerde laser meten. Vervolgens wordt van deze metingen het gemiddelde en de standaardafwijking bepaald. Met de eerder genoemde procedure VerwerkFreqMeting (unit Verwerk) kan men dan het overall-gemiddelde van meerdere frequentiemetingen berekenen. Aan de hand van het overall-gemiddelde wordt vervolgens de werkelijke golflengte van de te testen laser bepaald. PROCEDURE MeetInschakel Met deze procedure kan men de inschakelverschijnselen van de te testen laser meten. Dit wil zeggen dat men over een bepaalde tijd de verschilfrequentie tussen de te testen laser en de He-Ne-J2 frequentiegestabiliseerde laser meet, waarbij de te testen laser net ingeschakeld is. De tijd waarover deze meting plaatsvindt en de tijd tusen twee metingen moet men vooraf opgeven. 3.11 Unit VergelijkingsMeting Deze unit bevat de procedures voor de kalibratie van de gehele laserinterferometer. V~~r deze kalibratie bestaan 3 procedures: - PROCEDURE MeetVerg, - PROCEDURE MeetNulpuntsDrift, - PROCEDURE MeetVolCor. Deze procedures zijn zodanig opgesteld dat ze onafhankelijk zijn van het type laser. Hieronder worden bovenstaande procedures kort besproken. - PROCEDURE MeetVerg Deze procedure dient voor de vergelijkingsmeting waarbij de spiegel in 30 stappen van ± 100 mm wordt verplaatst. Na elke stap wordt het meetsysteem van de te testen laser vergeleken met het meetsysteem van de master-laser. Deze vergelijkingsmeting kan men in verschillende modes uitvoeren, namelijk in de: - labda-mode, - mm-mode zonder automatische compensator, - mm-mode met automatische compensator. In de labda-mode kan men het telsysteem testen, omdat hierbij geen omrekening plaatsvindt naar de verplaatsing in mm. Hierbij wordt dus geen gebruik gemaakt van het rekengedeelte van de laserinterferometer. Omdat er lasersystemen z~Jn waarbij geen mogelijkheid bestaat om verplaatsingen in de labda-mode te meten (HP5528) t doet men deze meting in de mm-mode met een brekingsindex 1 om fouten in het rekengedeelte zoveel mogelijk te elimineren. In de mm-mode zonder automatische compensator, rekenen beide lasersystemen met dezelfde brekingsindex. In de mm-mode met automatische compensator rekent de te testen laser met de brekingsindex van de automatische compensator en het master-systeem met de brekingsindex volgens de Edlen-formule of de refractometer. Aan de procedure MeetVerg moet men de volgende variabelen meegeven: - de operator, - de file-naam,
-7-
- of de brekingsindex met de Edlen-formule of de refractometer moet worden bepaald (mm-mode), - in welke mode de meting gedaan moet worden, - het type van de te testen laser, - de laser voor de refractometer (brekingsindex met refractometer). De meetwaarden worden opgeslagen in 6 data files. De datafiles 1 tIm 3 dienen voor de opslag van de meetwaarden op de heenweg en de datafiles 4 tIm 6 voor die op de terugweg. In datafile 1 (4) worden de meetwaarden van het mastersysteem opgeslagen, in datafile 2 (5) die van de te testen laser en in datafile 3 (6) wordt in het geval van de labdamode het nummer van de meting (1 tIm 30) en het verschil tussen het master-systeem en de te testen laser opgeslagen en in het geval van de mm-mode de verplaatsing in mm volgens het master-systeem en het verschil tussen het mastersysteem en de te testen laser. In het geval van een meting met automatische compensator worden de VOL-waarden volgens de automatische compensator en die vol gens de Edlen-formule of refractometer opgeslagen in de file "file-naam".AUC. Deze waarden heeft men nodig als men later de meetwaarden wil corrigeren voor fouten in de brekingsindex. AIle files die tijdens een meting worden aangemaakt, worden aangeslagen op een floppy onder de directory "file-naam". Afhankelijk van de mode worden de VOL-waarde en de brekings index automatisch bepaald met behulp van de procedure GetVolWaarden. Afhankelijk van de variabele index worden deze met de Edlen-formule (PROCEDURE VolEdlen) of met de refractometer (PROCEDURE VolRefractometer) bepaald. De meetwaarden die gelezen worden met behulp van de functie-procedure ReadLaser (UNIT LaserInterface) zijn strings. Deze worden met behulp van de procedures OmrekenMaster en OmrekenTestLaser omgezet in reals. Omdat het master-systeem zelf geen rekengedeelte heeft voor het omrekenen naar de verplaatsing in mm, gebeurt dit eveneens in de procedure OmrekenMaster. Hierbij wordt gebruik gemaakt van de eerder met behulp van de Edlen-formule of refractometer bepaalde VOL-waarde. Met de procedure GetHP5528Set wordt bepaald hoe de HP5528 laserinterferometer gereset moet worden. Wordt namelijk gemeten in de rom-mode met brekingsindex 1 of zonder automatische compensator, dan moet de automatische compensator uitgeschakeld worden met de commando's CO,AO. - PROCEDURE MeetNulPuntsDrift Met de procedure MeetNulPuntsDrift kan men over een bepaalde tijd de drift van de te testen laser vergelijken met die van de master. De procedure leest om een vooraf ingestelde tijd beide lasersystemen uit. Deze procedure is onafhankelijk van het type van de te testen laser. - PROCEDURE MeetVolCor Deze procedure berekend eerst de brekingsindex met de Edlen-formule of de refractometer. Hierna wordt de spiegel ± 1000 mm verplaatst en worden beide lasersystemen uitgelezen met dezelfde brekingsindex. Vervolgens wordt de VOL van de te testen laser in stappen van 10 verhoogd beginnende bij een VOL van 650. Bij elke stap worden de waarden van
-8-
beide lasersystemen uitgelezen en uitgeprint. 3.12 Het hoofdprogramma: "PROGRAM Laser" Het hoofdprogramma bevat voornamelijk procedures met menu's en vragen voor het verzamelen van gegevens die nodig zijn voor een meting. Met het hoofdprogramma wordt in feite bepaald van welke unit men gebruik wil gaan maken.
-9-
HOOFOSTUK 4 HET OPSTARTEN VAN HET PROGRAMMA Het laserkalibratieprogramma start op door onder de directory C:\TURB04\GERARO>, laser in te typen. Onder deze directory moe ten de volgende files staan: - laser.pas, - vergelij.pas, - frequent.pas, - spiegelv.pas, - laserint.pas, - verwerk.pas, - tekstfil. pas, - diagram.pas, - inputda1.pas, - filer.pas, - graphex1.pas, - mathl.pas, - service.pas, - myglobal.pas, - makeque.pas (voor het eventueel W1JZ1gen van vragen-sets) , - laserque.que (voor de vragen-sets), - laser.hlp (voor de helppagina's). Tevens moet men ervoor zorgen dat in drive a: altijd een floppy zit. Het programma schrijft namelijk algemene gegevens van een meting en de meetwaarden naar deze floppy.
-10-
BIJLAGE 1
De vraqen-sets BIJLAGE 1 DE VRAGEN-SETS Nr
Titel + vragen
Helppagina
1
Gegevens klant 1: Naam 2: Adres 3: Plaats 4: Telefoon
1 1 1 1
2
3
4
5
6 7
Aangeboden apparatuur 1: Laser typenummer 2: serienummer 3: Display typenummer 4: serienummer 5: Autom. compensator typenummer 6: serienummer 7: Aantal temperatuursensoren 8: Aantal kabels
1
Gegevens temperatuursensoren 1: Temp. sensor 1: typenummer serienummer
1 1
8: Afhankelijk van het aantal temp.sensoren
1
Frequentiemeting 1: Operator 2: File-naam (8 karakters zonder extensie) 3: T.o.v. welke freq.-dip wordt gemeten (A .. N) 4: Aantal metingen
1 1 1 1
1 1 1
1
50 54 51
Gegevens kabels 1: Kabel 1: typenummer 2: serienummer
1 1
8: Afh. van het aantal kabels
1
Verwerking van de frequentiemetingen 1: Aantal frequentiemeting files
52
Invoeren van de frequentiemeting files 1: Frequentiemeting-file 1
53
8: Afh. van het aantal frequentiemeting-files
-11-
BIJLAGE 1
De vragen-sets
He1ppagina
Nr
Tite1 + vragen
8
Inschakelverschijnselen 1 : Operator 2: T.o.v. welke dip wordt gemeten (A .. N) 3: Wat is de tijdsduur van de meting (uren) 4: Wat is de sample-tijd (minuten)
1 59 1 1
Nulpuntsdriftmeting 1: Operator 2: Tijdsduur van de meting (uren) 3: Wat is de sample-tijd (minuten)
56 57
Vergelijkingsmeting 1: Operator 2: File-naam (max. 7 karakters)
1 60
Brekingsindex met refractometer 1: Weerstand STI00 Ohm nummer 1 2: Weerstand PTI00 nr. 4 in refractometer 3: Weerstand PTI00 nr. 5 in refractometer 4: Weerstand PTI00 nr. 6 in refractometer 5: Weerstand PTI00 nr. 7 in hak
90 90 90 90 90
Brekingsindex met Edlen-formule 1: Weerstand STI00 Ohm nummer 1 2: Weerstand PTI00 nr. 7 in bak 3: Wat is de luchtdruk (mhar) 4 : Wat is de temp. van de barometer (Oe)
90 90 91 91
Brekingsindex met Edlen-formule 1: Wat is de dauwpuntstemperatuur (Oe)
92
Brekingsindex met Edlen-formule 1: Wat is de temp. van de natte hol (Oe) 2: De waarde in de tabel voor deze temp. 3: Wat is de temp. van de droge hol (Oe)
93 93 93
Geef de VOL van de autom. compensator 1: VOL volgens automatische compensator
96
9
10
11
12
13 14
15 16 17
18
19
1
File-naam van de vergelijkingsmeting 1: File-naam
150
Golflengte van de te testen laser 1: Werkelijke golflengte 2: Systeem golflengte
151 152
Aangeboden apparatuur 1: Air-sensor typenummer 2: serienummer
1 1
VOL-correctie meting 1: Operator
1
-12-
BIJLAGE 2
FILE Laser.HLP BIJLAGE 2 DE FILE LASER.HLP % 10 Geef de counterkaart het adres C en steek deze kaart bij de counterkaarten van het master-systeem en de refractometer!! % 11 Geef de IEEE-interface het adres 4 en de counterkaart het adres A. Deze counterkaart in een aparte coupler-kast steken!! % 20 Er is een fout gedetecteerd in de procedure EnterIEEE in de UNIT LaserInterface!!! % 21 Er is een fout gedetecteerd in de procedure SpollIEEE in de UNIT LaserInterface!!! % 22 Er is een fout gedetecteerd in de procedure ZendIEEE in de UNIT LaserInterface!!! % 23 Er is een fout gedetecteerd in de procedure TransmitIEEE in de UNIT LaserInterface!!! % 30
De opgegeven file voor de data opslag bestaat al. Als U <esc> in toetst krijgt U een overzicht van de aanwezige frequentie- en vergelijkingsmeting-files. % 31 Een van de door U opgegeven files is niet aanwezig!!!!!!! Als U na <esc> F3 intoetst krijgt U een overzicht van de aanwezige files. % 32 De frequentie-metingen z1Jn niet t.o.v. dezelfde frequentie-dip uitgevoerd. U zult de metingen over moeten doen. % 33 De opgegeven file voor de verwerking bestaat niet. Toets na <esc> de functie-
-13-
BIJLAGE 2
FILE Laser.HLP toets F3 voor een overzicht van de aanwezige vergelijkingsmeting files. % 34
De opgegeven file is van een meting zonder automatische compensator. Hierdoor kan men niet de brekingsindex gecorrigeerde meetwaarden bepalen. % 35
De spiegel verplaatst zich nu naar het einde van de baan. Druk op <esc> als de spiegel daar aangekomen is (led van eindschakelaar A op de motorsturingskast brandt!!). % 36
Controleer of er een floppy in drive-A van de computer zit. Toets <esc> als dit het geval is. %
50 U moet hier een file-naam ingeven zonder extensie. Het programma maakt vervolgens de files 'file-naam.TXT' en 'file-naam.DTA' aan. In .TXT staan de algemene gegevens en in .DTA staan de metingen. Als U F3 intoetst krijgt U een overzicht van reeds bestaande files. % 51
U moet hier het aantal metingen ingeven waaruit het gemiddelde van deze frequentiemeting bepaald wordt. % 52
U moet hier het aantal frequentiemeting files ingeven, waarmee de frequentie en de golflengte van de te testen laser moeten worden bepaald. Als U F3 intoetst krijgt U een overzicht van de aanwezige frequentiefiles. % 53
U moet hier de namen van de frequentiemetingfiles ingeven zonder extensie. % 54
U moet hier de ingestelde frequentie-dip van de He-Ne-J2 frequentiegestabiliseerde laser ingeven. % 55
U moet hier een file-naam ingeven (max. 8 karakters!!! I!!) zonder extensie. Het programma msskt vervolgens de files 'file-naam.TXT'
-14-
BIJLAGE 2
FILE Laser.HLP en 'file-naam.DTA' aan. In .TXT staan de algemene gegevens en in .DTA staan de metingen. Als U F3 intoetst krijgt U een overzicht van reeds bestaande files. % 56
U moet de tijd waarover de nulpuntsdrift meting plaatsvindt in HELE uren ingeven.
, ,
57 U moet hier de tijd tussen twee metingen ingeven in minuten. 58
Zet de spiegel vast en toets <esc> als dit gebeurd is. % 59 U moet hier de ingestelde frequent ie-dip van de He-Ne-J2 frequentiegestabiliseerd laser ingeven. % 60 U moet hier een file-naam ingeven (max. 7 karakters!!!!! !!) zonder extensie. Het programma maakt vervolgens de files 'file-naam1.TXT', 'file-naam2.TXT' en de files 'file-naam1.DTA' tot en met 'file-naam6.DTA' aan. In .TXT staan de algemene gegevens en in .DTA staan de metingen. Als U F3 intoetst krijgt U een overzicht van reeds bestaande files. % 70
De te testen laser kan niet automatisch gereset worden! Reset de te testen laser. Toets <esc> als dit gebeurt is. % 71 Er is een fout gedetecteerd bij het uitlezen van de lasers (BCD)!! U zult de meting over moeten doen!!
,
72 Er is een fout gedetecteerd bij het uitlezen van de lasers (IEEE)!! U zult de meting over moeten doen!!
,
73
De vergelijkingsmetingen kunnen aIleen automatisch uitgevoerd worden met lasers van Hewlett Packard met een IEEE of een BCD uitgang. V~~r andere typen lasers is er nog geen interfacing aanwezig. Daarom moe ten bij deze lasersystemen de meetwaarden met de hand ingevoerd
-15-
FILE Laser.HLP
BIJLAGE 2
worden. De meetwaarden worden wel automatisch verwerkt.
% 74 Voor het bepalen van de nulwaarde moet de refractometer geheel vacuum zijn. Toets <esc> als de refractometer geheel vacuum is. % 75 Laat nu lucht in het samplekanaal van de refractometer. Toets <esc> als de waarde van de laser voor de refractometer, welke op het display wordt weergegeven, niet meer veranderd. % 90 Bepaal met de Daupine Pt10-100 comparator de waarde van de Pt100. % 91 Help barometer % 92 Help dauwpuntsmeter % 93 Help droge-natte bol % 96
U moet hier de waarde van de VOL-correctie volgens de automatische compensator invoeren.
% 100 U moet hier een geheel getal (INTEGER) invoeren.
% 101 U moet hier een real invoeren
% 102 Geef als bovenstaande waarden worden geaccepteerd. % 103 Geen opties beschikbaar.
% 110 Zet de HP5501 in de labda/40 mode. % 111 Zet de HP5501 in de mm-mode en schakel de automatische compensator uit.
% 112 Zet de HP5501 in de mm-mode en schakel de automatische compensator in.
-16-
BIJLAGE 2
FILE Laser.HLP %
115 Zet de HP5526 in de labda/40 mode. Druktoets "X10" ingeschakeld!! %
116 Zet de HP5526 in de mm-mode en zet de automatische compensator op "manual". Druktoets "X10" ingeschakeld!! %
117 Zet de HP5526 in de mm-mode en zet de automatische compensator op "operate". Druktoets "X10" ingeschakeld!! %
120 Zet de te testen laser in de labda/40 mode. %
121 Zet de te testen laser in de mm-mode en schakel de automatische compensator uit. %
122 Zet de te testen laser in de mm-mode en schakel de automatische compensator in. %
150 Geef hier de file-naam van de eerder gedane vergelijkingsmeting, welke uitgeprint moet worden. %
151 Geef hier de golflengte die met de frequentiemetingen is berekend. %
152 Geef hier de systeemgolflengte dus de golflengte waarmee de te testen laser rekent. %
200 Zet de duimwielen op 650 en toets vervolgens <esc>. %
201 Zet de duimwielen op 660 en toets vervolgens <esc>. %
202 Zet de duimwielen op 670 en toets vervolgens <esc>. %
203 Zet de duimwielen op 680 en toets vervolgens <esc>.
-17-
FILE Laser.HLP
BIJLAGE 2
% 204 Zet de duimwielen vervolgens <esc>. % 205 Zet de duimwielen vervolgens <esc>. % 206 Zet de duimwielen vervolgens <esc>. % 207 Zet de duimwielen vervolgens <esc>. % 208 Zet de duimwielen vervolgens <esc>. % 209 Zet de duimwielen vervolgens <esc>. % 210 Zet de duimwielen vervolgens <esc>. % 211 Zet de duimwielen vervolgens <esc>. % 212 Zet de duimwielen vervolgens <esc>. % 213 Zet de duimwielen vervolgens <esc>. % 214 Zet de duimwielen vervolgens <esc>. % 215 Zet de duimwielen vervolgens <esc>. % 216 Zet de duimwielen vervolgens <esc>. %
op 690 en toets
op 700 en toets
op 710 en toets
op 720 en toets
op 730 en toets
op 740 en toets
op 750 en toets
op 760 en toets
op 770 en toets
op 780 en toets
op 790 en toets
op 800 en toets
op 810 en toets
-18-
BIJLAGE 3
UNIT MyGlobals BIJLAGE 3 3.1 UNIT MYGLOBALS UNIT MyGlobals; { This unit contains some of the global types INTERFACE
= 299792458000000.0:
CONST lichtsnelheid
I frequentiewaarden van de verschillende dips
= 473612514721000.0: = 473612505900000.0: = 473612497805000.0: = 473612379916000.0: = 473612367055000.0; = 473612353692000.0: = 473612340494000.0; = 473612236739000.0: = 473612214800000.0: = 473612193235000.0: = 473612084850000.0: = 473612076806000.0; = 473612060999000.0: = 473612051986000.0;
CONST aDip bDip cDip dDip eDip fDip gDip hDip iDip jDip kDip lDip mDip nDip globale types
v~~r
laser
CONST adresIEEE IBMaddres freqDisplay systemController
= $OCOOO; = 21: = 3:
::
0;
I constanten voor het frequentiedisplay CONST poortA = I FUl' ; poortB = I FU3' ; t01 :: 'GAl': t1 = I GA2' ; = I GA3' ; t10 {
constanten en variabelen voor de BCD-interface CONST Port1A = $1BO; Port1B = $1B1: Port1C = $1B2; Port1R = $1B3: Port2A = $1B4: Port2B = $1B5; Port2C = $lB6: Port2R = $1B7: VAR
getalO,getall, getal2,geta13, getal4,getal5 aaa,iii,jjj,c strWaarde
BYTE: REAL: STRING[80];
-19-
UNIT MyGlobals
BIJLAGE 3
( constanten en type declaraties voor de menu-structuur CONST maxoptions = 7; maxquestions = 8: maxlengthfullpage = 30;
VAR
ansQuest questmenu answers ifail
= STRING[80]; = RECORD value ARRAY [ 1 .. maxoptions OF STRING[20]; number INTEGER; END; = STRING[12); = STRING [20) ; = STRING[20]: = ARRAY [l .. maxquestions] OF answerty; = RECORD title textlinetype; NumQuest integer: question ARRAY [l •• maxquestions] OF STRING[45]: answerstype: answer answer type ARRAY [l •• maxquestions] OF INTEGER; options ARRAY [l •• maxquestions] OF optiontype: help ARRAY [l •• maxquestions] OF INTEGER: END; = AAnsquestty; = RECORD textlinetype; title numoptions INTEGER: ARRAY [ 1 .. 8 ] OF option textlinetype: help INTEGER: END; ansQuestTy; menutype; answersType; INTEGER;
TYPE
klantType
= RECORD
TYPE
textlinetype Optiontype
Filenametype Answertype Answerty Answerstype Ansquestty
Ansquestptr Menutype
materType
senKabType
naam, adres, plaats, telefoon : answerType; END; = RECORD typenummer, serienummer answerType; END; = ARRAY [1 .. 8] OF materType;
-20-
BIJLAGE 3
UNIT MYGlobals
TYPE
weerstType
: ARRAY [1 •. 10] OF REAL;
laserType
: RECORD lTypenr: STRING; STRING; lRead STRING; lSet INTEGER; test INTEGER; adres golf Len: REAL; intFace: STRING; END; = RECORD STRING; result INTEGER; lengte END; = ARRAY [1.. 16 ] OF STRING(8];
waardeType
fileArray VAR
poort sampleT operator freqFile vergFile master HP5501 HP5526 HP5528 andere refHP5501 refHP5526 aantalMet nulWaarde
CONST Errorint Errorreal acceptans nooptions FileWithHelp FileWithQuest maxerrors pi ep small small1 large green yellow lightred lightblue white lightgreen black CONST maxKan
STRING[3]; STRING(3); STRING[20]; STRING[8] ; STRING[7]; laserType; laserType; laserType; laserType; laserType; laserType; laserType; INTEGER; REAL:
= 100: = 101; = 102; = 103;
= • Laser. hlp' ; = 'LaserQue.que'; = 25; 3.141592654; = 1e-6: : 1e-7; = 1e-5; = 1e33; = 1;
=
= 1:
= 1;
1; = 1; = 1; = 0;
:
= 10000;
IMPLEMENTATION END.
-21-
BIJLAGE 3
Unit Service 3.2 UNIT SERVICE UNIT
Service~
This unit provides service initialisation operations
routines
for shutdown and I
INTERFACE USES Crt,Graph,MyGlobals; VAR
ErrorCode
INTEGER;
Reports any graphics
OldExitProc
POINTER;
Saves exit procedure address
PROCEDURE PROCEDURE PROCEDURE PROCEDURE
MyExitProc; ExitwithMessage( message InitEnvironment; Cleartextbuffer;
errors
textlinetype );
IMPLEMENTATION
ISF+I PROCEDURE MyExitProc; BEGIN ExitProc := OldExitProc; CloseGraph; END;
Restore exit PROCEDURE address Shut down the graphics system
ISF-I PROCEDURE exitwithmessage(message BEGIN Closegraph; WriteLN(message) ; halt{O); END;
textlinetype);
PROCEDURE InitEnvironment; I initialize environment BEGIN CheckBreak := FALSE this line disables the use of ctr-break Randomize; init random number generator END; PROCEDURE cleartextbuffer; VAR keyl : char; BEGIN WHILE ( keypressed = TRUE ) DO keyl := ReadKey; END; END.
-22-
BIJLAGE 3
UNIT Math1 3.3 UNIT MATH1 UNIT math1;
{ This unit contains a library of mathematical procedures INTERFACE USES MyGlobals, Service; FUNCTION FUNCTION FUNCTION FUNCTION FUNCTION FUNCTION FUNCTION FUNCTION FUNCTION
log ( x : REAL; n : INTEGER ) : REAL; sign (x REAL): integer; power{ x : REAL; n : integer) : REAL: arccos ( x : REAL ) : REAL; arcsin ( x : REAL ) : REAL; AlmostEqueal ( r1,r2 : REAL) : BOOLEAN; maxre (a,b REAL): REAL; minre (a,b REAL): REAL: Omreken(str : STRING) : REAL;
IMPLEMENTATION FUNCTION minint ( a,b : integer BEGIN IF a )= b THEN minint := b ELSE minint := a: END;
.
FUNCTION maxre ( a,b REAL BEGIN IF a >= b THEN maxre a ELSE maxre .- bi END;
)
integer;
REAL;
..--
FUNCTION minre a,b : REAL BEGIN IF a >= b THEN minre .- b ELSE minre .- a; END;
REAL;
..--
FUNCTION log ( x : REAL; n REALi INTEGER BEGIN IF ( x > 0 ) AND ( n > 0 THEN log := In(x)/ln(n) ELSE BEGIN WriteLN('Fatal error in function Log ( argument(s) negative or zero) '); halt(O) ; END: END; FUNCTION sign x: REAL ) : INTEGER: BEGIN IF x (> 0 THEN sign := round(abs(x)/x) ELSE sign := 1: END;
-23-
UNIT Mathl
BIJLAGE 3
FUNCTION power( X REAL: n INTEGER) REAL: BEGIN IF X <> 0 THEN IF Trunc(n/2) = n/2 THEN power := EXP(n * In(abs(x») ELSE power := sign(x)*exp(n *In(abs(x))) ELSE IF n = 0 THEN power .- 1 ELSE power := 0: END: FUNCTION arccos ( X : REAL) : REAL: BEGIN IF x = 0 THEN arccos := pi/2 ELSE arccos := arctan(sqrt(l-sqr(x})/x); END: FUNCTION arcsin ( x : REAL ) : REAL: BEGIN IF ( x = - 1 ) OR ( x = 1 ) THEN arcsin := pi/2*x/abs(x) ELSE arcsin := arctan(x/sqrt(l-sqr(x»); END; FUNCTION AlmostEqueal BEGIN AlmostEqueal := abs END;
rl,r2 : REAL) : boolean: rl - r2 ) < small;
FUNCTION Omreken(str : STRING) : REAL: VAR cijfers i,integ freq BEGIN cijfers i
:=
SET OF CHAR; INTEGER; REAL; ['0' .. '9','.
I, ' - ' ,
'E'];
: = 1;
WHILE i <= LENGTH{str) DO BEGIN IF str(i] IN cijfers THEN i := i + 1 ELSE DELETE(str,i,l); END: VAL(str,freq,integ): IF integ <> 0 THEN WriteLN(str}: Omreken := freq; END: END.
-24-
BIJLAGE 3
UNIT Graphexl 3.4 UNIT GRAPHEXl UNIT Graphexl; { This unit contains extended graphical routines INTERFACE USES Crt, Graph, MyGlobals, Service, Mathl; TYPE
settingstype
= RECORD origcol origbkcol origviewport origtext END;
VAR
GraphDriver GraphMode MaxX, MaxY
INTEGER; INTEGER; WORD;
MaXColor
WORD;
WORD; WORD; viewporttype; textsettingstype;
The Graphics device driver I I The Graphics mode value The maximum resolution of the I screen The maximum color value available
PROCEDURE FUNCTION PROCEDURE PROCEDURE PROCEDURE PROCEDURE PROCEDURE PROCEDURE
Initgraphics; Int2Str(L : LongInt) : STRING; DefaultColors; DrawBorder(color : WORD }; FullPort; MainWindow(Header : STRING}; StatusLine(Msg : STRING); getoriginalsettings(VAR origsettings settings type ); PROCEDURE putoriginalsettings(origsettings : settingstype}; PROCEDURE TUElogo (xlu,ylu,xrl,yrl,bordercolor,pattern, color: WORD; f i l l : boolean ); PROCEDURE linereal ( xl,yl,x2,y2 : REAL); PROCEDURE arcreal ( xl,Yl,hl,h2,r : REAL); PROCEDURE circlereal ( xl,yl,r : REAL); PROCEDURE linetoreal ( xl,yl : REAL); PROCEDURE movetoreal ( xl,yl : REAL); PROCEDURE floodfillreal ( x,y : REAL; color: WORD); PROCEDURE rectanglereal ( xl,yl,x2,y2 : REAL ); PROCEDURE crossreal ( xl,yl,x2,y2 : REAL ); FUNCTION Mytextwidth ( s : STRING ) : INTEGER; FUNCTION value ( stri : STRING ) : REAL; IMPLEMENTATION FUNCTION Mytextwidth ( s : STRING ) : INTEGER; BEGIN IF s = • THEN mytextwidth := 0 ELSE mytextwidth .- textwidth(s}; END; t
-25-
BIJLAGE 3
UNIT Graphexl PROCEDURE linereal ( xl,yl,x2,y2 : REAL) ~ BEGIN line(round(xl) ,round(yl),round(x2) ,round(y2»i END: PROCEDURE linetoreal ( xl,yl : REAL): BEGIN lineto( round(xl) ,round(yl) ): END; PROCEDURE movetoreal ( xl,yl : REAL) BEGIN moveto( round (xl) ,round(yl) ): END:
~
PROCEDURE arcreal ( xl,Yl,hl,h2,r : REAL): BEGIN arc(round(xl),round(yl) ,round(hl) ,round(h2) ,round(r»i END; PROCEDURE circlereal ( xl,yl,r : REAL); BEGIN circle(round(xl),round(yl),round(r»: END; PROCEDURE floodfillreal ( x,y : REAL: color BEGIN floodfill(round(x) ,round{y) ,color): END;
WORD) ;
PROCEDURE rectanglereal ( xl,yl,x2,y2 : REAL); BEGIN rectangle (round(xl) ,round(yl) ,round(x2) ,round(y2»; END: PROCEDURE crossreal ( xl,yl,x2,y2 : REAL )i BEGIN line(round{xl) ,round(yl),round(x2) ,round(y2»: line(round(xl) ,round(y2) ,round(x2) ,round(yl»: END: FUNCTION value ( stri : STRING ) : REALi VAR hulp code
REAL: INTEGER:
BEGIN VAL{stri,hulp,code) : value := hulpi END: PROCEDURE Initgraphics; ( Initialize graphics and report any errors that may occur I BEGIN DirectVideo := False; OldExitProc := ExitProci
{ save previous exit proc
-26-
BIJLAGE 3
UNIT Graphexl
ExitProc := .MyExitProc: {insert our exit proc in chain} ) GraphDriver := detect: ( use autodetection InitGraph(GraphDriver, GraphMode, "): { activate graphics} ) ErrorCode := GraphResult: ( error? IF ErrorCode <) grOk THEN BEGIN Writeln('Graphics error: ' GraphErrorMsg(ErrorCode»: Halt (1) : END: MaxColor := GetMaxColor: MaxX := GetMaxX: { Get screen resolution values MaxY := GetMaxY; END: FUNCTION Int2Str(L : LongInt)
: STRING;
( Converts an integer to a STRING VAR
S: STRING;
BEGIN Str(L, S): Int2Str := S; END; PROCEDURE DefaultColors: BEGIN SetColor(MaxColor) : END; PROCEDURE FullPort: { Set the view port to the entire screen } BEGIN SetViewPort(O, 0, MaxX, MaxY, ClipOn): END: PROCEDURE MainWindow(Header : STRING): { Make a default window and view port } BEGIN DefaultColors: ClearDevice: SetTextStyle(DefaultFont, HorizDir, 1); SetTextJustify(CenterText, TopText): FullPort:
{Reset the colors } (Clear the screen ) (Default text font) (Left justify text) {Full screen view port { Draw the header
OutTextXY(MaxX div 2, 2, Header); SetViewPort(O, TextHeight('M')+4, MaxX, MaxY-(TextHeight('M')+4), ClipOn); DrawBorder(maxcolor) : SetViewPort(l, TextHeight('M')+5, MaxX-l, MaxY-(TextHeight('M')+5), ClipOn); END;
-27-
BIJLAGE 3
UNIT Graphex1 PROCEDURE StatusLine(Msg : STRING);
I Display a status line at the bottom of the screen I
BEGIN FullPort: DefaultColors; SetTextStyle(DefaultFont, HorizDir, 1): SetTextJustify(CenterText, TopText)i SetLineStyle(SolidLn, 0, NormWidth); SetFillStyle{EmptyFill, 0) i Bar{O, MaxY-{TextHeight('M')+4), MaxX, MaxY); Rectangle (0, MaxY-(TextHeight{'M')+4), MaxX, MaxY); OutTextXY{MaxX div 2, MaxY-(TextHeight{'M')+2), Msg); SetViewPort(l, TextHeight('M')+5, MaxX-1, MaxY-(TextHeight('M')+5), ClipOn): END: PROCEDURE getoriginalsettings( VAR origsettings settingstype ): I get original graphical- and textsettings BEGIN getviewsettings(origsettings.origviewport) : gettextsettings(origsettings.origtext) ; origsettings.origbkcol := getbkcolor; origsettings.origcol := getcolor: END; PROCEDURE putoriginalsettings( origsettings : settingstype ): [ return to original graphical- and textsettings BEGIN WITH origsettings.origviewport DO setviewport(x1,yl,x2,y2,clip): WITH origsettings.origtext DO settextstyle{font,direction,charsize); setcolor{origsettings.origcol); END; PROCEDURE DrawBorder{color : WORD); IDraw a border with color color around the current view port} VAR ViewPort originalsettings
ViewPortType; settingstype;
BEGIN getoriginalsettings(originalsettings): setcolor(color); SetLineStyle{SolidLn, 0, NormWidth): GetViewSettings(ViewPort) : WITH ViewPort DO Rectangle(O, 0, x2-xl, y2-yl): putoriginalsettings{originalsettings); END:
-28-
BIJLAGE 3
UNIT Graphexl
PROCEDURE TUElogo (xlu,ylu,xrl,yrl,bordercolor,pattern,color: WORD; f i l l : boolean ): ( present TUE logo VAR dx,dy xasp,yasp settings arcl,arc2,arc3
REAL: WORD; settingstypei arccoordstype;
BEGIN getoriginalsettings( settings) i setcolor(bordercvlor); getaspectratio(xasp,yasp} i dx := (xrl-xlu)/42: IF (33.0*dx*(xasp/yasp» ) yrl-ylu THEN dx := (yrl-ylu)/(33.0*{xasp/yasp»i dy := dx * (xasp/yasp): arcreal (xlu+ 8*dx,ylu+23*dy,180,270,4*dx); getarccoords(arcl) ; IF round(dx) )= 1 THEN BEGIN arcreal(xlu+ 8*dx,ylu+23*dy,180,270,1*dx): getarccoords(arc2): END ELSE BEGIN movetoreal(xlu+ 7*dx,ylu+23*dy): arc2.xstart := GetX: arc2.ystart := GetY; linetoreal(xlu+8*dx,ylu+24*dy) ; arc2.xEND := getX; arc2.yend := GetY; END; movetoreal (arc2.xstart,arc2.ystart); linetoreal (arc2.xstart,ylu+15*dy); linetoreal (xlu+10*dx,ylu+15*dy) i linetoreal (xlu+10*dx,ylu+12*dy); linetoreal (arc2.xstart,ylu+12*dy): linetoreal (arc2.xstart,ylu+ 8*dy) i linetoreal (arcl.xstart,ylu+ 8*dy); linetoreal (arcl.xstart,ylu+12*dy): linetoreal (xlu+l*dx,ylu+12*dy); linetoreal (xlu+ 1*dx,ylu+15*dy); linetoreal (arcl.xstart,ylu+15*dy); linetoreal (arcl.xstart,arcl.ystart): movetoreal (arcl.xend,arcl.yend): linetoreal (xlu+10*dx,arcl.yend); linetoreal (xlu+10*dx,arc2.yend); linetoreal (arc2.xend,arc2.yend); arcreal(xlu+18*dx,ylu+21*dy,180, 270+180/pi*arcsin(3*dx/(6*dx» ,6*dx); getarccoords(arcl): arcreal (xlu+18*dx,ylu+21*dy,180,360,3*dx); getarccoords(arc2} ; movetoreal(arc2.xstart,arc2.ystart): linetoreal(arc2.xstart,ylu+12*dy): linetoreal(arcl.xstart,ylu+12*dy) ;
-29-
UNIT Graphexl
BIJLAGE 3
linetoreal(arcl.xstart,arcl.ystart); movetoreal(arcl.xend,arcl.yend)i linetoreal(arcl.xend,ylu+27*dy); linetoreal(xlu+24*dx,ylu+27*dy) ; linetoreal(xlu+24*dx,ylu+12*dy): linetoreal(arc2.xend,ylu+12*dy) ; linetoreal(arc2.xend,arc2.yend) ; arcreal(xlu+26*dx,ylu+17*dy,0, 180-1S0/pi*arcsin(8*dx/(l5*dx» ,15*dx); getarccoords(arcl): arc3 := arc1: IF dx < 2 THEN arcreal(xlu+26*dx,ylu+17*dy, 1S0/pi*arcsin(3*dx/(13*dx)}, 180-l80/pi*arcsin(8*dx/(13.0*dx» , 13*dx) ELSE arcreal(xlu+26*dx,ylu+l7*dy, l80/pi*arcsin(2*dx/{13*dx», lSO-l80/pi*arcsin(S*dx/(13.0*dx» , l3*dx)i getarccoords(arc2) ~ IF arc2.yend > arcl.yend THEN BEGIN linereal (arcl.xend,arcl.yend,arcl.xend,arc2.yend): (arcl.xend,arc2.yend,arc2.xend,arc2.yend) linereal END ELSE BEGIN (arc2.xend,arc2.yend,arc2.xend,arcl.yend): linereal (arcl.xend,arcl.yend,arc2.xend,arcl.yend): linereal END: linereal (arc2.xstart,arc2.ystart,xlu+26*dx,arc2.ystart): linereal (xlu+26*dx,arc2.ystart,xlu+26*dx,arcl.ystart): linereal (xlu+26*dx,arcl.ystart,arc1.xstart,arcl.ystart): arcreal(xlu+25*dx,ylu+17*dy, 270-180/pi*arcsin(4*dx/(l5*dx» , 360-180/pi*arcsin(2*dx/(l5*dx» ,16*dx): getarccoords(arcl): arcreal(xlu+25*dx,ylu+l7*dy, 270-180/pi*arcsin(4*dx/(l3*dx» , 360-180/pi*arcsin(2*dx/(l3*dx» ,14*dx); getarccoords(arc2): IF arc2.yend ) arcl.yend THEN BEGIN line (arc2.xend,arc2.yend,arc2.xend,arcl.yend): line (arcl.xend,arcl.yend,arc2.xend,arcl.yend): END ELSE BEGIN line (arcl.xend,arcl.yend,arcl.xend,arc2.yend): line (arcl.xend,arc2.yend,arc2.xend,arc2.yend); END: IF arc2.xstart > arcl.xstart THEN BEGIN line (arc2.xstart,arc2.ystart,arcl.xstart,arc2.ystart): (arcl.xstart,arcl.ystart,arcl.xstart,src2.ystart) ; line END ELSE BEGIN line (arcl.xstart,arc1.ystart,arc2.xstart,arcl.ystart); line (arc2.xstart,arcl.ystart,arc2.xstart,arc2.ystart): END:
-30-
UNIT Graphex1
BIJLAGE 3
IF fill = TRUE THEN BEGIN setfillstyle(pattern,bordercolor) : floodfillreal(xlu+S*dx,ylu+14*dy,color): floodfillreal(xlu+14*dx,ylu+14*dy,color) : floodfillreal(xlu+23*dx,ylu+14*dy,color) : floodfillreal(xlu+40*dx,ylu+1S*dy,color) : floodfillreal(arc3.xend+S*dx,arc3.yend-4*dy,color) : floodfillreal(arc2.xend+dx,arc2.yend+dy,color); floodfillreal(arc2.xstart+2*dx,arc2.ystart+dy,color) : END: putoriginalsettings( settings): END: END.
-31-
BIJLAGE 3
UNIT FILER 3.5 UNIT FILER UNIT Filer; I Provides procedures for the operations on files INTERFACE USES
Crt, Graph, MyGlobals, Service, GraphExl;
CONST maxpagelength
= 25;
TYPE
= = = =
filename type string? string8 page type pageptr
textlinetype; STRING[7] ; STRING[8] ; ARRAY [ 1 .. maxpagelength ] OF textlinetype; = pagetype;
FUNCTION exist(filename : filenametype) BOOLEAN; PROCEDURE Make(filename : filenametype); PROCEDURE getdata ( pagenum : integer; VAR pagelength integer; VAR page: pageptr; filename filenametype; VAR ifail integer); FUNCTION ExistFreqFile(filename string8) BOOLEAN; FUNCTION ExistVergFile(fileName : string7) BOOLEAN; PROCEDURE FileMenu; IMPLEMENTATION FUNCTION exist(filename
filenametype)
VAR fil : FILE; BEGIN assign(fil,filename) ; [$1-1 RESET(fil); 1$1+} IF IOresult = 0 THEN BEGIN close (fil); exist := TRUE; END ELSE exist := FALSE; END; PROCEDURE Make(filename VAR fil
filenametype} ;
FILE;
BEGIN ASSIGN(fil,filename) ; {$1-1 RESET(fil); {$1+} IF IOresult = 0 THEN close(fill ELSE BEGIN REWRITE (fil) ; CLOSE (fil) ;
-32-
BOOLEAN;
BIJLAGE 3
UNIT FILER END; END: PROCEDURE getdata
pagenum : INTEGER: VAR pagelength ; INTEGER; VAR page : pageptr; filename filenametypei VAR ifail : INTEGER );
This procedure implements the use of untyped datafiles I Required is an ASCII file which contains the data I different pages are seperated by the symbol % in the firstl colomn followed by the pagenumber in the next line I On return IFail 0 Required page found I = 1 Required page found but no data I 2 Required page not found I 3 Requisted data file not present I
= = =
VAR
textline datafile num
textlinetype; TEXT; INTEGER;
BEGIN IF not(exist(filename)} THEN ifail := 3 ELSE BEGIN assign(datafile,filename); reset(datafile); I determine location of the helppage IFail := 2; WHILE ( IFail = 2 ) AND ( not eof(datafile» DO BEGIN readln(datafile,textline}: IF textline[1] = '%' THEN BEGIN readln(datafile,num)i IF num = pagenum THEN IFail ;= 1; END: END; { read datapage pagelength ;= 0; IF IFail 1 THEN BEGIN WHILE ( IFail 1 ) AND ( (not eof(datafile) OR ( pagelength maxpagelength+1 ) ) DO BEGIN readln(datafile,textline); IF textline[1] = '%' THEN ifail := 0 ELSE BEGIN pagelength := pagelength+1; pageA[pagelength] := textline; END; END; IF pagelength = 0 THEN ifail := 1; END; close( datafile); END: END;
=
=
-33-
=
BIJLAGE 3
UNIT FILER FUNCTION
ExistFreqFile(fileName
stringS)
BOOLEAN;
string7)
BOOLEAN;
LABEL 1; VAR fil line
FILE OF stringS; string8;
BEGIN ASSIGN(fil, 'a:\FreqFile.TXT')i RESET(fil) ; WHILE NOT(EOF(fil» DO BEGIN Read(fil,line) ; IF line = fileName THEN BEGIN ExistFreqFile := TRUE; GOTO 1; END ELSE ExistFreqFile := FALSE; END; Write(fil,fileName) i l:CLOSE(fil)i END; FUNCTION
ExistVergFile(fileName
LABEL 1; VAR fil line
FILE OF string7; string7;
BEGIN ASSIGN(fil, 'a:\VergFile.TXT'); RESET(fil) : WHILE NOT(EOF(fil» DO BEGIN Read(fil,line); IF line = fileName THEN BEGIN ExistVergFile := TRUE; GOTO 1; END ELSE ExistVergFile := FALSE; END; Write(fil,fileName); l:CLOSE(fil); END: PROCEDURE DeleteFreqFile(name VAR fil filB line i
STRINGS) :
FILE OF stringS: FILE OF stringS; stringS: INTEGER:
BEGIN FOR i := 1 TO 8 DO IF name[i] = ' THEN DELETE(name,i,8): IF Exist('a:\' + name + '.TXT') THEN BEGIN I
-34-
BIJLAGE 3
UNIT FILER ASSIGN(fil, 'a:\' + name + '.TXT'); ERASE(fil); END: IF Exist('a:\' + name + '.DTA') THEN BEGIN ASSIGN(fil, 'a:\' + name + '.DTA'); ERASE(fil); END; ASSIGN(filB, 'a:\FreqFi.TXT'}; REWRITE(filB); ASSIGN(fil, 'a:\FreqFile.TXT'); RESET(fil); WHILE NOT (EOF(fil» DO BEGIN Read(fil,line); IF line <> name THEN Write(filB,line); END; CLOSE(fil); ERASE(fil) ; CLOSE(filB); RENAME (filB, 'a:\FreqFile.TXT'}; END: PROCEDURE DeleteVergFile(name : STRING7): VAR fil filB line i
cijfer
FILE OF string7: FILE OF string7; string7: INTEGER; STRING[l];
BEGIN FOR i := 1 TO 7 DO IF name[i] = ' , THEN DELETE(name,i,S); FOR i := 1 TO 6 DO BEGIN STR(i,cijfer); IF Exist('a:\' + name + cijfer[l] + '.DTA') THEN BEGIN ASSIGN(fil, 'a:\' + name + cijfer[l] + '.DTA'); ERASE(fil); END; END: FOR i := 1 TO 2 DO BEGIN STR(i,cijfer); IF Exist('a:\' + name + cijfer[lJ + '.TXT') THEN BEGIN ASSIGN(fil, 'a:\' + name + cijfer[l] + '.TXT'); ERASE(fil); END: END; IF Exist('a:\' + name + '.AUC') THEN BEGIN ASSIGN(fil, 'a:\' + name + '.AUC'); ERASE(fil); END; IF Exist('a:\' + name + '.GRF') THEN BEGIN ASSIGN(fil, 'a:\' + name + '.GRF'); ERASE(fil): END; ASSIGN(filB, 'a:\VergFi.TXT'); REWRITE (filB) ; ASSIGN(fil, 'a:\VergFile.TXT');
-35-
BIJLAGE 3
UNIT FILER RESET(fil): WHILE NOT (EOF(fil» DO BEGIN Read(fil,line) : IF line <> name THEN Write(filB,line): END: CLOSE(fil) ; ERASE (fil) ; CLOSE(filB) ; RENAME (filB, 'a:\VergFile.TXT'); END; PROCEDURE FileMenu; LABEL 1: CONST esc F1 F2 RETURN backspace VAR
i,j,k,a: fil8 fil7 lin8 lin7 iFail fileN8 fileN7 key
= #27; = #59; = #60: = #13; = #8; INTEGER: FILE OF string8; FILE OF string7: string8; string7; INTEGER; stringS; string7; CHAR;
FUNCTION ReadName : STRING; VAR
keyR CHAR; name : stringS;
BEGIN a := 1;
keyR := ReadKey; , name := ' WHILE (keyR <> RETURN) AND (a < 9) DO BEGIN IF keyR = backspace THEN BEGIN IF a <> 1 THEN BEGIN SetColor(black); OutTextXY(round(maxX/1.47 + (a -1) * 9), round{9 * maxY/10 + succ {round (maxY/10) DIV 2», name[a - 1]); SetColor(white); name [a - 1) . a := a - 1; END; END ELSE BEGIN name [a] := keyR; OutTextXY(round(maxX/1.47 + a * 9), I
•
I
';
-36-
BIJLAGE 3
UNIT FILER
round(9 * maxY/10 + succ(round(maxY/10) DIV2) ), keyR); a := a + 1; END: keyR := ReadKey; END; ReadName := name; END; BEGIN 1:ClearDevicei FullPort: SetTextStyle(triplexFont, horizDir, 3); SetColor(white); Rectangle(0,0,maxX,round(1.9*maxY/10»: Rectangle (0,round(2*maxY/10) ,maxX,round(8.9*maxY/10)}; RecTangle(O,round(9*maxY/10),maxX,maxY); FOR i := 1 TO 5 DO Line (round (i*maxX/6) ,round (2*maxY/10) , round(i*maxX/6),round(S.9*maxY/10» i Line(maxX DIV 2, 0, maxX DIV 2, round(1.9 * maxY/10»; SetTextJustify(leftText,centerText); OutTextXY(round(maxX/39),succ(round(1.9*maxY/10) DIV 2), 'Frequentiemeting-Files'); OutTextXY(round(maxX/1.9),succ(round(1.9*maxY/10) DIV 2), 'Vergelijkingsmeting-Files'): SetTextStyle(smallFont,horizDir,5): ASSIGN(filS, 'a:\FreqFile.TXT'); RESET(fi18) ; j : = 0; k : = 1; WHILE NOT(EOF(fi18» DO BEGIN Read(fi18,LinS) ; OutTextXY(round(maxX/40 + j *maxX/6), round(2 * maxY/10 + k * maxY/1S} ,LinS) ; k := k + 1; IF k - 12 THEN BEGIN k := 1; j := j + 1:
END; END: Close(fi18): ASSIGN(fi17, 'a:\VergFile.TXT'): RESET(fi17): j := 3: k : = 1; WHILE NOT{EOF(fi17» DO BEGIN Read(fi17,Lin7): OutTextXY(round(maxX/40 + j *maxX/6), round(2 k * maxY/18} ,Lin7); k := k + 1: IF k = 12 THEN BEGIN k j
: == 1;
:= j
+ 1;
END; END:
-37-
* maxY/IO
+
UNIT FILER
BIJLAGE 3
Close(fil7): SetTextJustify(centerText,centerText); iFail := 2; WHILE iFail 2 DO BEGIN OutTextXY(succ(maxX DIV 2), round(9 * maxY/10 + succ(round(maxY/10) DIV 2», 'F1 - delete freq.meting-file ESC - Terminate F2 - , + 'Delete verg.meting-file')i key := ReadKey; CASE key OF esc iFail := 1; F1,F2 BEGIN SetColor(black); OutTextXY(succ(maxX DIV 2), round(9 * maxY/10 + succ(round{maxY/10} DIV 2», 'F1 - delete freq.meting-file ESC - Terminate F2 - , + 'Delete verg.meting-file'); SetColor(White); IF key = F1 THEN BEGIN OutTextXY(succ(maxX DIV 2), round(9 * maxY/10 + succ(round(maxY/lO) DIV
=
2) ) ,
'Delete frequentiemeting-file:'); fileNS := ReadName; DeleteFreqFile(fileNS); SetColor(black); FOR a := 1 TO 8 DO OutTextXY(round(maxX/1.47 + a * 10), round(9 * maxY/10 + succ(round(maxY/lO) DIV 2», fileN8 [a] ) ; SetColor(white) ; GOTO 1; END ELSE BEGIN OutTextXY(succ(maxX DIV 2), round(9 * maxY/10 + succ(round(maxY/10) DIV 2) ) ,
'Delete vergelijk.meting-file:'); fileN7 := ReadName; DeleteVergFile(fileN7) ; SetColor(black) ; FOR a := 1 TO 7 DO OutTextXY(round{maxX/1.47 + a * 9), round(9 * maxY/10 + succ(round(maxY/10) DIV 2», fileN7[a]); SetColor{white); GOTO 1; END; END; END: END; END: END.
-38-
BIJLAGE· 3
UNIT InputDa1 3.6 UNIT INPUTDA1 UNIT InputDa1;
fThis unit provides tools for the aquisition OF user supplied data I INTERFACE USES Graph, Crt, Dos, MyGlobals, Service, Filer, G::-aphEx1, printer; CONST esc arrowup arrowdown arrowleft arrowright return PgDn PgUp F1 F2 F3 Backspace TYPE
string29 string10
= = = = = = = = = = = =
#27; #72; #80; #75; #77; #13, #81; #73; #59; #60; #61; #8;
= STRING[29] ; = STRING[10);
PROCEDURE Representfullpage ( Pagenum : INTEGER; filename filenametype ); PROCEDURE Representmessage( colortext, colorback : word; messageptr : pageptr; messagelength : INTEGER ); PROCEDURE Representhelppage(Pagenum : INTEGER; filename filenametype) , PROCEDURE Questions ( VAR answers: answerstype; numquest : INTEGER; filename : fi1enametype; VAR ifail : INTEGER ), PROCEDURE getquestion ( questnumber : INTEGER; VAR ansquest : ansquestty ); PROCEDURE putquestion ( questnumber : INTEGER; VAR ansquest ansquestty ); FUNCTION menu ( questmenu : menutype; default: INTEGER ) : INTEGER; FUNCTION evalboolean( answer: answerty; VAR ifail : INTEGER ) : boolean; PROCEDURE getMyDate VAR date : string29 ); PROCEDURE getMyTime VAR Time: string10 ); PROCEDURE MaakKader title: STRING);
-39-
BIJLAGE 3
UNIT InputDa1 IMPLEMENTATION PROCEDURE getMyDate ( VAR date
string29 );
VAR d1,d2,d3,d4 : WORD; BEGIN getdate(d1,d2,d3,d4) ; CASE d4 OF 0 date := 'Sunday , , 1 date := 'Monday , 2 date := 'Tuesday , •. 3 'Wednesday , date 4 date := 'Thursday , . 5 date := 'Friday , . 6 date := 'Saturday , END; date := date + int2str(d3) ; CASE d2 OF , 1 date := date + januari ' , , ', 2 date := date + , februari ' + 3 date .- date , march ' 4 date date + , april 5 date date + , may , 6 date date + june ' , , 7 date date + , july , . ', 8 date := date + , august 9 date date + september ' , ', 10 date date + , october ', 11 date := date + november , 12 date .- date + december ' r END; aa:~ := date + int2str(d1) + ' END;
.
. f
.
.-
f
f
f
. I
.
. . . . f
......-
f
f
f
.
.
PROCEDURE getMyTime ( VAR Time VAR t1,t2,t3,t4 min, sec
.
. f
. . , .,
string10) ;
WORD; STRING(2] ;
BEGIN getTime(tl,t2,t3,t4) ; STR ( t 2 min) ; STR(t3,sec); IF t2 < 10 THEN min := '0' + min; IF t3 < 10 THEN sec := '0' + sec; Time := int2str(t1)+': '+min+':'+sec + ' END; t
,. I
const Yver = 15; FUNCTION evalboolean( answer: answerty; VAR ifail : boolean; BEGIN ifail := 0; IF (answer = 'YES') OR ({answer = 'Yes') OR (answer ='yes'» THEN evalboolean := TRUE
-40-
INTEGER)
BIJLAGE 3
UNIT InputDa1
=
ELSE IF (answer 'NO') OR « answer = 'No') OR ( answer = 'no' » THEN evalboolean .- FALSE ELSE ifail := 1; END; PROCEDURE Representfullpage ( Pagenum : INTEGER; filename filenametype ); VAR page pageptr; pagelength INTEGER; ifail,i INTEGER; origsettings settingstype; BEGIN new (page) i getdata(pagenum,pagelength,page,filename,ifail); IF ifail <) 0 THEN exitwithmessage('File '+filename+' not found') ELSE BEGIN Cleardevice; Fullport; drawborder(white); getoriginalsettings(origsettings ); setcolor(white); settextstyle(smallfont,horizdir,S); settextjustify{lefttext,bottomtext); IF pagelength ) maxpagelength THEN page length .maxpagelength; FOR i := 1 TO pagelength DO outtextxy(round(MaxX/20) ,round(MaxY/24*(i+2», page [i] ) ; outtextxy(round(B.5*MaxX/lO) ,round(MaxY/20*19) , 'Press
This part OF the program implements the use OF helpscreensl Required is an ASCII file which contains the help texts I different pages are seperated by the symbol % in the first) colomn followed by the pagenumber in the next line ) PROCEDURE writebottom(textv : textlinetype;ulx,lrx,lry INTEGER; colorback,colortext : WORD ); BEGIN bar(lrx-4*textwidth('M')-textwidth('PgUp/PgDn') ,lry-12, lrx-2*textwidth('M'),lry); setcolor(lightred); line(ulx,lry,lrx-4*textwidth('M')-mytextwidth(textv),lry); line(lrx-2*textwidth('M') ,lry,lrx,lry); outtextxy(lrx-3*textwidth('M')-mytextwidth(textv), lry-2,textv); setcolor(colortext); END;
-41-
BIJLAGE 3
UNIT InputDa1
PROCEDURE representmessage( colortext, colorback : WORD; messageptr : pageptr; messagelength: INTEGER ); const maxlength maxh maxnumlines VAR
maxl,size origsettings uIx,uIy,lrx,lry hight, length i,numpag,j,eind p
keyp
=
10;
=
13;
= 11; WORD; settingstype; INTEGER; INTEGER; INTEGER; pointer; CHAR;
BEGIN getoriginalsettings( origsettings }; settextstyle(smallfont,horizdir,5) ; settextjustify(lefttext,bottomtext); maxI := 0; numpag := 0; WHILE(numpag * maxnumlines < messagelength) DO numpag := numpag + 1; numpag := numpag; FOR i := 1 TO messagelength DO IF maxI < mytextwidth(messageptrA(i]) THEN maxl := mytextwidth(messageptrA[i]) i IF numpag = 1 THEN hight := round{(messagelength+4)*(maxh + maxh/3}) ELSE hight := round«maxnumlines+4)*(maxh + maxh/3}}; length := round(maxl+10*textwidth('M'}); IF length < textwidth('PgDn/PgUp') + 6*textwidth('M'} THEN length := textwidth('PgDn/PgUp') + 6*textwidth('M'); ulx := succ(getmaxX-length} div 2; uly := succ(getmaxY-hight) div 2; lrx := ulx+length; lry := uly+hight; fullport; size := imagesize(ulx,uly,lrx,lry); IF size> maxavail THEN exitwithmessage('Memory error in procedure representmessage'); getmem(p,size) ; getimage(ulx,uly,lrx,lry,pA} ; setfillstyle(solidfill,colorback) ; bar(ulx,uly,lrx,lry); setcolor(lightred) ; rectangle(ulx,uly,lrx,lry) ; settextjustify(lefttext,bottomtext) ; j
:
= 1i
keyp := Fl; WHILE keyp <> esc DO BEGIN setcolor(colortext); IF (j = numpag) OR ( numpag = 1 ) THEN eind := messagelength-(j-l)*maxnumlines ELSE eind := maxnumlines; FOR i := 1 TO eind DO
-42-
BIJLAGE 3
UNIT InputDal
outtextxy(ulx+5*textwidth('M') , uly+round«1+1/3)*maxh*(i+2», messageptr [{j-1)*10+i]); IF numpag 1 THEN writebottom('Press esc' ,u1x,lrx,lry,colorback, colortext) ELSE IF j 1 THEN writebottom('PgDn' ,ulx,lrx,lry,colorback, colortext) ELSE IF j numpag THEN writebottom('PgUp' ,ulx,lrx,lry,colorback, colortext} ELSE writebottom('PgUp/PgDn' ,ulx,lrx,lry, colorback,colortext)i keyp := readkey; IF « keyp = pgup ) and j > 1 }) OR j < numpag }} « keyp pgdn ) and THEN BEGIN setcolor(colorback): FOR i := 1 TO eind DO outtextxy(ulx+5*textwidth('M'), uly+round«1+1/3)*maxh*(i+2» , messageptr [(j-l)*10+i]}: IF ( keyp PgDn ) THEN j := j + 1 ELSE j := j - 1; END: END: putimage{ulx/uly,pA,O) ; freemem(p,size) ; putoriginalsettings( origsettings ): settextjustify(lefttext,centertext) ; END; A
= =
=
=
A
=
PROCEDURE VAR
Representhelppage(Pagenum: INTEGER; filename filenametype) ; helppage pageptr; pagelength INTEGER; ifail INTEGER;
BEGIN new(helppage); getdata(pagenum,pagelength,helppage,filename,ifail): IF ifail = 0 THEN representmessage( yellow,black,helppage,pagelength ELSE IF ( ifail 1 ) OR ( ifail = 2 ) THEN BEGIN page length := 1: helppage [1] := 'Sorry no help available at this moment' : representmessage{yellow,black,helppage,pagelength) END ELSE IF ifail = 3 THEN exitwithmessage('File '+filename+' not found'}; dispose(helppage); helppage := nil; END;
=
A
-43-
UNIT InputDa1
BIJLAGE 3
PROCEDURE updateansquest(VAR ansquest : ansquestptr; answer answerty; i : INTEGER); VAR j,k INTEGER; present boolean; BEGIN IF answer <> ansquestA.answer[i] THEN BEGIN IF ansquestA.options[i] .number = 0 THEN BEGIN ansquestA.options[i] . number := 1; ansquestA.options[i] .value[l] := ansquestA.answer[i]; END ELSE BEGIN present := FALSE; j
:
= 0;
j
:
WHILE ( present = FALSE ) AND ( j < ansquestA.options[i) . number ) DO BEGIN j := j + 1; IF ansquestA.options[i] .value[j] = ansquestA.answer[i) THEN present := TRUE; END; IF present = FALSE THEN IF ansquestA.options[i] . number < maxoptions THEN BEGIN ansquestA.options[i] .number := ansquestA.options[i] .number+1; ansquestA.options[i) .value[ansquestA.options[i]. number] := ansquestA.answer[i] ; END ELSE BEGIN FOR j := 1 TO maxoptions-1 DO ansquest A.options [i] .value [j] := ansquestA.options[i) .value[j+1]; ansquestA.options[i] .value[maxoptions] := ansquestA.answer[i] ; END; present := FALSE;
=
0;
WHILE ( present = FALSE ) AND ( j < ansquestA.options[i) . number ) DO BEGIN j := j + 1; IF ansquestA.options[i] .value[j] = answer THEN present := TRUE; END; IF present = TRUE THEN BEGIN ansquestA.options[i] . number := ansquestA.options[i] . number - 1; FOR k := j TO ansquestA.options[i) . number DO ansquest A.options [i] .value [k] := ansquestA.options[i] .value[k+l); END; END; ansquestA.answer[i) := answer;
-44-
BIJLAGE 3
UNIT InputDal END; END;
FUNCTION checkanswer(VAR answer: answerty; VAR ansquest : ansquestptr; i: INTEGER) : boolean; VAR result integ Rea hulp
INTEGER; longint; real; boolean;
BEGIN hulp := TRUE; CASE ansquestA.answertype[i] OF 1 : BEGIN val (answer,Integ,result) ; IF result> 0 THEN BEGIN Representhelppage (Errorint, filewithhelp) ; hulp := FALSE; END; END; 2 BEGIN val(answer,Rea,result) ; IF result > 0 THEN BEGIN Representhelppage(Errorreal,filewithhelp) ; hulp .- FALSE; END; END; END; IF hulp = TRUE THEN BEGIN updateansquest(ansquest,answer,i) ; setcolor(lightblue) ; outtextxy(round(2.2*maxX/4) , round(maxy/10*2.2+i*maxy/Yver) ,answer); END; checkanswer .- hulp; END; WORD; numquest PROCEDURE drawrectangle(i : INTEGER; color INTEGER ); BEGIN setcolor(color) ; IF i = numquest+l THEN i := maxquestions+l; rectangle(round(2.15*maxX/4) , round(maxy/10*2.2+i*maxy/Yver-l.5*4) , round(2.25*maxX/4+ textwidth('12345678901234567890'» , round(maxy/10*2.2+i*maxy/Yver+l.5*4»; END; PROCEDURE drawrectangleoptions( i BEGIN setcolor(color) ; rectangle (round(2.35*maxX/4+
-45-
: INTEGER; color
WORD );
BIJLAGE 3
UNIT InputDal
textwidth('12345678901234567890'», round(maxy/10*2.2+(2+i)*maxy/Yver-l.5*4) , round(maxX*(1-O.2*1/10», round(maxy/10*2.2+(2+i)*maxy/Yver+l.5*4)}: END; PROCEDURE moverectangleoptions(VAR i { j I j
=
-1 = 1
: INTEGER;j : INTEGER);
move up move down
BEGIN drawrectangleoptions(i,black): i := i + j; drawrectangleoptions(i,lightred); END; PROCEDURE moverectangle{VAR i : INTEGER; j : INTEGER; VAR answering : boolean; numquest : INTEGER ): j j
= -1 =1
move up move down
BEGIN drawrectangle(i,black,numquest); i := i + j; IF i (= 0 THEN i := numquest+l ELSE IF i > numquest+l THEN i := 1; drawrectangle(i,lightred,numquest): answering := FALSE; END; FUNCTION optionmenu( options INTEGER; VAR i finished key
optiontype: help
INTEGER; boolean: char;
BEGIN IF options.number = 0 THEN BEGIN representhelppage(nooptions,filewithhelp); optionmenu := 0; END ELSE BEGIN setcolor(white): rectangle (round(2.3*maxX/4+ textwidth('l2345678901234567890'» , round(2.1*maxY/10), round(maxX*(1-0.1*1/10»,round(8.8*maxY/10»; line(round(2.3*maxX/4+ textwidth('12345678901234567890'» , round (maxy/10*2+2*maxy/Yver) , round(maxX*(l-O.l*l/lO» , round(maxy/10*2+2*maxy/Yver» ; settextjustify(lefttext,centertext) ;
-46-
INTEGER )
BIJLAGE 3
UNIT InputDal
outtextxy(round(2.4*maxX/4+ textwidth('12345678901234567890'» round(maxy/10*2+0.6*maxY/Yver), 'Available'); outtextxy{round(2.4*maxX/4+ textwidth('12345678901234567890'» , round{maxy/lO*2+1.6*maxY/Yver), 'options'}; FOR i := 1 TO options.number DO outtextxy(round(2.4*maxX/4+ textwidth('12345678901234567890'», round(maxy/10*2.2+(2+i)*maxy/Yver) options.value[i]) ; i : = 1; drawrectangleoptions(i,lightred) ; finished := FALSE; WHILE finished = FALSE DO BEGIN key := readkey; CASE key OF esc BEGIN finished := TRUE; optionmenu := 0; END; arrowup BEGIN IF i > 1 THEN moverectangleoptions(i,-I) ELSE BEGIN drawrectangleoptions(i,black) ; i := options.number; drawrectangleoptions(i,lightred) ; END; END; arrowdown BEGIN IF i < options.Number THEN moverectangleoptions(i,l) ELSE BEGIN drawrectangleoptions(i,black) ; I
I
i
return
:
= 1;
drawrectangleoptions(i,lightred) ; END; END; BEGIN optionmenu := i; finished := TRUE; END; representhelppage (help, filewithhelp) ;
FI END; END; setfillstyle(solidfill,black) ; bar(round(2.3*maxX/4+textwidth('12345678901234567890')} . round(2.1*maxY/10), round{maxX*(l-O.l*l/lO», round(8.8*maxY/10»; END; END;
-47-
BIJLAGE 3
UNIT InputDal
PROCEDURE startedit(VAR answer: answerty; answerold : answerty; VAR answering: boolean; i INTEGER) ; BEGIN setcolor(lightred) ; outtextxy{round(2.2*maxX/4) , round (maxy/l0*2.2+i*maxy/Yver) , answerold) ; answer := answerold; answering .- TRUE; END; PROCEDURE EraseLetterFromEND(VAR answer INTEGER) ; VAR hulp : string[l];
answerty; i
BEGIN IF length(answer} > 0 THEN BEGIN hulp := copy(answer,length(answer) ,1}; delete(answer,length(answer} ,1); setcolor(black) ; outtextxy(round(2.2*maxX/4)+mytextwidth(answer) . round (maxy/10*2.2+i*maxy/Yver) ,hulp); END; END; PROCEDURE insertLetterAtEnd(VAR answer: answerty;letter char; i : INTEGER}; VAR hulp : string[l); BEGIN IF length(answer) < 20 THEN BEGIN setcolor(lightred) ; outtextxy (round(2.2*maxX/4) +mytextwidth(answer) , round(maxy/10*2.2+i*maxy/Yver) ,letter); answer := answer + letter; END; END; PROCEDURE questions( VAR answers: answerstype; numquest INTEGER; filename : filenametype; VAR ifail : INTEGER ); PROCEDURE wich asks the answers OF questionset numquest On return answer answers TO the questions Ifail = 0 completation questions Ifail = 1 questions prematurely aborted by user VAR i.choice origsettings key options answering ansquest option fileansquest
INTEGER; settingstype; CHAR; INTEGER; BOOLEAN; ansquestptr; optiontype; FILE OF ansquestty;
-48-
BIJLAGE 3
UNIT InputDal nurnberstring
STRING [10] ;
BEGIN { produce basic screen cleardevice; Fullport; getoriginalsettings{ origsettings ); settextstyle(triplexfont,horizdir,3); settextjustify(centertext,centertext); setcolor(white) ; rectangle(0,O,rnaxX,round(1.9*rnaxY/10» ; rectangle(0,round(2*rnaxY/10) ,rnaxX,round(8.9*rnaxY/10»; rectangle (0,round(9*rnaxY/10) ,rnaxX,rnaxY); f read questions IF not(exist(filenarne» THEN exitwithrnessage('File '+filenarne+' not found'); assign{fileansquest,filenarne) ; reset(fileansquest) ; IS1-1 seek (fileansquest,nurnquest-l) ; fSI+1 IF ( IOresult (> 0 ) OR ( EOF(fileansquest) ) THEN BEGIN str(numquest,nurnberstring) ; exitwithrnessage('Questionset '+nurnberstring+ , not found in file ' +filenarne); END; new(ansquest) ; read(fileansquest,ansquest A) ; I present questions I outtextxy{succ(rnaxX div 2) ,succ(round(1.9*rnaxY/10) div 2), ansquestA.title) ; settextstyle(srnallfont,horizdir,4) ; settextjustify(centertext,centertext); setcolor(green) ; outtextxy(succ(rnaxX div 2), round (9*rnaxY/10+succ (round (rnaxY/IO) div 2», 'Esc - Terrninate Arrows'+ , - Move '+'Fl'+' - Help '+'F2'+ , - Opties '+ 'F3 - File overzicht ' + 'CR - Accept'); { present questions and default answers setcolor(white); settextjustify(lefttext,centertext); FOR i := 1 TO ansquestA.nurnquest DO BEGIN outtextxy(round(rnaxX/30) , round(rnaxy/lO*2.2+i*rnaxy/Yver} , ansquestA.question[i]) ; outtextxy(round(2.0*rnaxX/4) , round (rnaxy/lO*2. 2+i*rnaxy/Yver} , . '); outtextxy(round(2.2*rnaxX/4) , round (rnaxy/lO*2.2+i*rnaxy/Yver) , ansquest-.answer[i]); END; setcolor(yellow); outtextxy (round {rnaxX/30} round(rnaxy/lO*2.2+(rnaxquestions+l)*rnaxy/Yver) , 'Accept answers'); outtextxy(round(2.0*rnaxX/4) , f
-49-
UNIT InputDal
BIJLAGE 3
round(maxy/10*2.2+(maxquestions+l)*maxy/Yver) , , : '); outtextxy(round(2.2*maxX/4) , round(maxy/10*2.2+(maxquestions+1)*maxy/Yver) , 'Yes'); { present rectangle round first answer drawrectangle(l,lightred,ansquestA.numquest) ; answering := FALSE; { read answers FOR i := 1 TO ansquestA.numquest DO answers[iJ .- ansquest .answer[i]; i : = 1; ifail := 2; WHILE ifail 2 DO BEGIN key := readkey; CASE key OF esc ifail .- 1; #0 BEGIN key := readkey; CASE key OF arrowup IF answering = TRUE THEN BEGIN IF (checkanswer(answers[i], ansquest,i) = TRUE} THEN moverectangle(i,-l, answering,ansquest numquest) ; END ELSE moverectangle(i,-l, answering,ansquest-. numquest) ; arrowdown: IF answering = TRUE THEN BEGIN IF (checkanswer(answers[i], ansquest,i) TRUE) THEN moverectangle(i,l, answering,ansquest numquest) ; END ELSE moverectangle(i,l, answering,ansquest-. numquest); Fl IF i < ansquest-.numquest+1 THEN A representhelppage(ansquest . help[iJ ,filewithhelp} ELSE representhelppage(acceptans, filewithhelp) ; IF i < ansquest-.numquest+l THEN F2 BEGIN choice := optionmenu(ansquest .options[i] ,ansquest help [i] } ; IF choice > 0 THEN BEGIN setcolor(black); A
=
A
•
=
A
•
A
A
•
-50-
BIJLAGE 3
UNIT InputDa1
IF answering = TRUE THEN outtextxy(round(2.2*maxX/4) ,round(maxy/10*2.2+ i*maxy/Yver), answers[i) ELSE outtextxy(round(2.2* maxX/4) ,round(maxy/10* 2.2+i*maxy/Yver} , ansquestA.answer[i); answers[i] := ansquest options[i] .va1ue[choiceJ; IF (checkanswer(answers[i], ansquest,i) = TRUE} THEN moverectang1e{i,1, A answering,ansquest . numquest) ; END; END ELSE representhe1ppage(acceptans, fi1ewithhe1p); BEGIN Fi1eMenu; ifai1 .- 3; END; A
•
F3
END; END; return IF i < ansquest .Numquest+1 THEN BEGIN IF answering = TRUE THEN BEGIN IF ( checkanswer{answers[i] ,ansquest,i) TRUE ) THEN moverectangle(i,l,answering, ansquestA.numquest); END ELSE moverectangle(i,l,answering, ansquestA.numquest) END ELSE ifai1 := 0; Backspace:IF i < ansquest .numquest+l THEN BEGIN IF answering = FALSE THEN startedit(answers[i] ,ansquest A. answer(i] ,answering, i); erase1etterfromEND(answers[i] ,i); END; ELSE IF i < ansquestA.numquest+l THEN BEGIN IF answering = FALSE THEN startedit(answers[i] ,ansquest-. answer(i],answering,i); insertLetterAtEnd(answers[i],key,i}; END; END; END; seek(fi1eansquest,numquest-l) ; A
A
-51-
=
UNIT InputDal
BIJLAGE 3
write(fileansquest,ansquest close(fileansquest); dispose (ansquest) ; ansquest .- nil; END;
A );
PROCEDURE getquestion ( questnumber : INTEGER; VAR ansquest ansquestty ); VAR ansquestfile : file OF ansquestty; BEGIN assign(ansquestfile,filewithquest) ; reset (ansquestfile) ; seek (ansquestfile,questnumber-1) ; read(ansquestfile,ansquest); close(ansquestfile}; END; PROCEDURE putquestion ( questnumber : INTEGER; VAR ansquest ansquestty ); VAR ansquestfile : file OF ansquestty; BEGIN assign(ansquestfile,filewithquest) ; reset(ansquestfile) ; seek (ansquestfile,questnumber-1) ; write(ansquestfile,ansquest); close(ansquestfile); END; PROCEDURE drawrectanglemenu( i,color,maxwidth
INTEGER );
BEGIN setcolor(color} ; rectangle (round (maxX/2-maxwidth/2-maxX/40) , round(maxy/10*2+i*maxy/Yver-l.5*4} , round (maxX/2+maxwidth/2+MaxX/40) , round(maxy/10*2+i*maxy/Yver+2.0*4}) ; END; PROCEDURE moverectanglemenu(VAR i : INTEGER; j,maxwidth, numoptions : INTEGER); j j
= -1
=1
move up move down
BEGIN IF ( i + j > 0 ) AND ( i + j < numoptions+l ) THEN BEGIN drawrectanglemenu(i,black,maxwidth); i
:= i
+ j;
drawrectanglemenu(i,lightblue,maxwidth) ; END; END;
-52-
BIJLAGE 3
UNIT InputDal FUNCTION menu( questmenu INTEGER; VAR i,maxwidth,max origsettings key finished
menutype; default
INTEGER }
INTEGER; settingstype; char; boolean;
BEGIN cleartextbuffer; { produce basic screen cleardevice; Fullport; getoriginalsettings{ origsettings ); settextstyle(smallfont,horizdir,5} ; settextjustify(centertext,centertext); setcolor(white}; maxwidth := 0; FOR i := 1 TO questmenu.numoptions DO IF maxwidth < mytextwidth{questmenu.option[i]} THEN maxwidth := mytextwidth(questmenu.option[i]); max := maxwidth; IF max < mytextwidth{'Esc - Terminate Arrows - Move '+ 'Fl'+' - Help '+ 'CR - Accept') THEN max:= mytextwidth('Esc - Terminate '+#24+' '#25+ , - Move '+ 'Fl'+' - Help '+ 'CR - Accept'); settextstyle(triplexfont,horizdir,3) ; settextjustify(centertext,centertext); IF max < mytextwidth(questmenu.title) THEN max := mytextwidth(questmenu.title); rectangle (round (maxX/2-max/2-MaxX/40) ,0, round (maxX/2+max/2+MaxX/40) ,round{1.9*maxY/10»; rectangle (round (maxX/2-max/2-MaxX/40) , round(2*maxY/10}, round (maxX/2+max/2+MaxX/40) , round(8.9*maxY/10»; rectangle{round(maxX/2-max/2-MaxX/40),round(9*maxY/10) , round(maxX/2+max/2+MaxX/40),maxY); outtextxy(succ(maxX div 2) ,succ(round(1.9*maxY/10) div 2), questmenu.title); settextstyle(smallfont,horizdir,4); setcolor(lightgreen); outtextxy(succ(maxX div 2), round(9*maxY/10+succ(round{maxY/10) div 2», 'Esc - Terminate Arrows'+ , - Move '+'Fl'+' - Help '+ 'CR - Accept'); I present menuoptions settextjustify(lefttext,centertext); setcolor(white); FOR i := 1 TO questmenu.numoptions DO outtextxy(round(maxX/2-maxwidth/2) round (maxy/10*2+i*maxy/Yver) ,questmenu. option[i]); present rectangle round default menu choice i := default; drawrectanglemenu(i,lightblue,maxwidth) ; I read choice finished := FALSE; WHILE finished = FALSE DO I
-53-
UNIT InputDal
BIJLAGE 3
BEGIN key := readkey; CASE key OF BEGIN esc menu := 0; finished := TRUE; END; arrowup moverectanglemenu(i,-l,maxwidth, questmenu.numoptions); moverectanglemenu(i,l,maxwidth, arrowdown questmenu.numoptions) ; representhelppage(questmenu.help, Fl filewithhelp) ; return BEGIN menu := i~ finished .- TRUE; END; END; END; END; PROCEDURE MaakKader ( title
STRING) ;
BEGIN ClearDevice; Fullport; SetTextStyle(triplexfont,horizdir,3); SetTextJustify(centertext,centertext); SetColor(white); Rectangle(O,O,maxX,round(1.9*maxY/10»; Rectangle(0,round(2*maxY/10) ,maxX,round(8.9*maxY/10»; Rectangle(O,round(9*maxY/10) ,maxX,maxY) i OutTextxy(succ(maxX div 2} ,succ(round(1.9*maxY/10) div 2), title); settextstyle(smallfont,horizdir,5) ; settextjustify(lefttext,centertext); END; END.
-54-
UNIT Diagram
BIJLAGE 3 3.7 UNIT DIAGRAM
UNIT Diagram; INTERFACE USES Crt, PRINTER, Graph, Service, MyGlobals, GraphEx1, Filer, InputDa1, math1; CONST MaxNumInDep MaxNumMeas MaxPlots TYPE
= = =
400; 70; 4;
diagramtexttype curvepointtype curve type coordType coordinateType nummerType nummer2Type realFileArray
=
ARRAY [ 1 .. 10 ] of textlinetype; [ 1 .. MaxPlots ] OF REAL; ARRAY [ 1 .. MaxNumInDep ] OF curvepointtype; ARRAY [1 .. 200] OF REAL; ARRAY [1 .. 10] OF coordType; ARRAY [1 .. 10] OF INTEGER; ARRAY [1 .. 10] OF REAL; ARRAY [1 .. 10] OF STRING;
= ARRAY =
= = = =
=
PROCEDURE Kader (diagramtext : diagramtexttype; subdiv,fill BOOLEAN ); PROCEDURE DrawAxes2D ( VAR minIndep,maxIndep,minDep,maxDep, scaleHor,scaleVer : REAL ); PROCEDURE TekenGrafiek{DiagramText : DiagramTextType; DiagramFile : RealFileArray; nrFiles INTEGER; shift : REAL); IMPLEMENTATION PROCEDURE CalculateBeautifulScale(VAR xb,xe,de : REAL; VAR dn,i : INTEGER; maxLine : INTEGER ); VAR dX,xbold,xeold i1,i2 BEGIN IF xe = xb THEN BEGIN xe .- xe+0.5; xb .- xb-0.5; END; IF xb > xe THEN BEGIN dx xb; xb .- xe;
.-
-55-
REAL; INTEGER;
UNIT Diagram
BIJLAGE 3
xe : == dx; END; dx :== xe-xb; xbold :== xb; xeold :== xe; de .- LOG(dx/«maxLine-l}/10),10}; i . - TRUNC (de) ; IF de ( 0 THEN i := i-I; de .- Power ( 10,i); IF dx/de (== 2 THEN de := de/5 ELSE IF dx/de (== 4 THEN de := de/2; il .- TRUNC(xb/de - 0.49999999); i2 .- TRUNC(xe/de + 0.49999999); xb .- de * il; xe := i2 '* de; dn :== i2 - il; WHILE xbold ( xb - small DO BEGIN dn := dn+l; xb := xb-de; END; WHILE xeold > xe + small DO BEGIN dn .- dn+l; xe .- xe+de; END; END; PROCEDURE Kader (diagramText : diagramTextType; subdiv,fill BOOLEAN) ; VAR originalsettings i,dn,scapow valuestring scalehor,scalever de
settingstype; INTEGER; textlinetype; REAL; REAL;
BEGIN getoriginalsettings( original settings ); SetColor(white) ; ClearDevice; FullPort; Drawborder(white); Linereal(O,MaxY/10*8,MaxX,MaxY/10*8); IF subdiv = TRUE THEN BEGIN Linereal(MaxX/10*3.2/MaxY/lO*8,MaxX/10*3.2,MaxY) ; Linereal(MaxX/I0*8.3,MaxY/I0*8,MaxX/I0*8.3,MaxY); TUElogo(round(MaxX/10*8.4) ,round(MaxY/10*8.2), round(MaxX/10*9.9) ,round(MaxY/lO*9.9), white,solidfill,white,FALSE) ; SetColor(white); SetTextStyle(triplexfont,horizdir,2); SetTextJustify(lefttext,centertext); OutTextXY(round(MaxX/10*O.2) ,round(MaxY/10*8.5), diagramtext[l]) ; OutTextXY{round(MaxX/10*0.2) ,round(MaxY/lO*9.5), diagramtext[2]);
-56-
BIJLAGE 3
UNIT Diagram
SetTextStyle(smallfont,horizdir,4)i SetTextJustify(lefttext,bottomtext); FOR i := 1 TO 3 DO Linereal(MaxX/10*3.2,MaxY/10*(8+i*0.5) , MaxX/IO*8.3,MaxY/IO*(8+i*0.5)} i FOR i := 1 TO 4 DO OutTextXY(round(MaxX/10*3.4) , round (MaxY/IO* {7.9+ 0.5*i» ,diagramtext[2+i]): Outtextxy(round(MaxX/10*1.2) ,round(MaxY/10*O.4), diagramtext[7]}; Settextjustify(righttext,bottomtext); Outtextxy(round(MaxX/10*9.5),round(MaxY/lO*6.7) , diagramtext[8]); Putoriginalsettings(originalsettings) ; END; END; PROCEDURE DrawAxes; BEGIN Linereal(MaxX/10*1,MaxY/10*7,MaxX/10*l,MaxY/10*0.5+8); Linereal(MaxX/10*l,MaxY/10*0.5,MaxX/10*1-2,MaxY/10*0.5+8); Linereal(MaxX/10*l,MaxY/10*0.5,MaxX/10*1+2,MaxY/10*0.5+8); Linereal(MaxX/10*1-2,MaxY/10*0.5+8,MaxX/10*1+2, MaxY/IO*0.5+8)i Setfillstyle(solidfill,white); Floodfill(round(MaxX/lO*l) ,round(MaxY/lO*O.5+4} ,white) i Linereal(MaxX/lO*l,MaxY/10*7,MaxX/10*9.5-11,MaxY/lO*7} ; Linereal(MaxX/10*9.5,MaxY/10*7,MaxX/lO*9.5-11,MaxY/lO*7+2); Linereal(MaxX/lO*9.5,MaxY/lO*7,MaxX/10*9.5-11,MaxY/lO*7-2} i Linereal(MaxX/lO*9.5-11,MaxY/lO*7+2,MaxX/lO*9.5-11, MaxY/IO*7-2) ; Floodfill(round(MaxX/lO*9.5-7} ,round(MaxY/10*7} ,white) i END; PROCEDURE DrawAxes2D (VAR minIndep,maxlndep,minDep,maxDep, scaleHor,scaleVer : REAL ); VAR i,dn,scapow valuestring de
INTEGER; textlinetype; REAL;
BEGIN drawaxes; CalculateBeautifulScaIe(Minindep,Maxindep,de,dn,scapow,I3}; scalehor := 7.3 * MaxX/(10 * (Maxindep - MinIndep»; settextstyIe(smallfont,horizdir,4) ; settextjustify(centertext,toptext) ; FOR i := 0 TO dn DO BEGIN linereal(MaxX/10*1+scaleHor*de*i,MaxY/lO*7, MaxX/I0*1+scaleHor*de*i,MaxY/lO*7+3); str{«Minlndep+i*de}/(power(lO,scapow»}:3:1, valuestring); outtextxy(round(MaxX/lO*l+scaleHor*de*i), round (MaxY/IO*7+5) ,valuestring); END: IF scapow <> 0 THEN
-57-
UNIT Diagram
BIJLAGE 3
BEGIN outtextxy(round(MaxX/10*9-5) ,round(MaxY/10*7+5), 'E'); outtextxy(round(MaxX/10*9+15) ,round(MaxY/10*7+3), int2str(scapow» ; END; CalculateBeautifulScale(Mindep,Maxdep,de,dn,scapow,13) ; scalever := 6.0 * MaxY/(lO * (Maxdep - Mindep»; settextjustify{righttext,centertext) ; FOR i := 0 TO dn DO BEGIN linereal(MaxX/10*1,MaxY/lO*7-scaleVer*de*i, MaxX/IO*1-4,MaxY/IO*7-scaleVer*de*i); str«(Mindep+i*de)/(power(lO,scapow») :3:1,valuestring); outtextxy(round(MaxX/lO*l-lO) , round(MaxY/lO*7-scaleVer*de*i) ,valuestring); END; IF scapow <> 0 THEN BEGIN outtextxy(round(MaxX/10-30) ,round{MaxY/10*0.4), 'E '); outtextxy(round(MaxX/10-20) ,round(MaxY/10*0.4-3), int2str(scapow» ; END; IF (minIndep <= 0) AND (maxIndep >= 0) THEN LineReal{MaxX/10*1,MaxY/lO*7+minDep*scaleVer, MaxX/10*9.5,MaxY/IO*7+minDep*scaleVer) END; PROCEDURE Grafiek2D( DiagramText : DiagramTextType; minIndep,maxIndep,minDep,maxDep : REAL; x,y : coordinateType; nrCurves : INTEGER; nrMeting : nummerType); VAR scaleHor,scaleVer i,j originalsettings
REAL; INTEGER; settingstype;
BEGIN getoriginalsettings(originalsettings); setcolor(white}; kader(diagramtext,true,true); drawaxes2D (minindep,maxindep,mindep,maxdep, scalehor, scalever); setcolor(yellow) ; FOR i := nrCurves DOWNTO 1 DO BEGIN movetoreal(MaxX/lO+(x[i,l]-minindep)*scalehor, MaxY/IO*7-(y[i,1]-mindep )*scalever); FOR j := 2 TO nrMeting[i] DO BEGIN linetoreal(MaxX/10+(x[i,j]-minindep)*scalehor, MaxY/IO*7-(y[i,j]-mindep )*scalever); crossreal(MaxX/10+{x[i,j]-minindep)*scalehor-3, MaxY/IO*7-{y[i,j]-mindep }*scalever+2, MaxX/10+(x[i,j]-minindep)*scalehor+3, MaxY/IO*7-(y[i,j]-mindep )*scalever-2); LineReal(MaxX/lO*l+(x[i,j]-minindep)*scalehor, MaxY/IO*7+minDep*scaleVer, MaxX/10*1+(x[i,j]-minindep)*scalehor,
-58-
UNIT Diagram
BIJLAGE 3 MaxY/10*7-(y[i,j]-mindep
)*scalever)
~
END; END~
setcolor(white) ; ClearTextBuffer; REPEAT UNTIL ReadKey END;
=
return;
PROCEDURE TekenGrafiek(DiagramText : DiagramTextType; DiagramFile : Rea1FileArray; nrFiles INTEGER; shift: REAL); VAR 1, j x,y nrMeting fi1 xMax,xMin, yMin,yMax yl
INTEGER; coordinateType; nummerType; FILE OF REAL; REAL; REAL;
BEGIN xMax := -32768.0; xMin := 32768.0; yMax .- -32768.0; yMin := 32768.0; FOR i := 1 TO nrFiles DO BEGIN ASSIGN(fil, 'a:\' + DiagramFile[i] + '.DTA'); RESET(fi1) ; j := 1; nrMeting[i] := 0; WHILE NOT EOF(fi1) DO BEGIN Read(fil,x[i,j]) ; Read(fi1,y1) ; y[i,j] := yl - shift; IF xMin > x[i,j] THEN xMin := x[i,j); IF xMax < x[i,j] THEN xMax := x(i,j]; IF yMin > y[i,j] THEN yMin := y[i,j]; IF yMax < y[i,j] THEN yMax := y[i,j]; j := j + 1; nrMeting[i] := nrMeting(i] + 1; END; END; Grafiek2D(DiagramText,xMin,xMax,yMin,yMax,x,y,nrFiles, nrMeting) ; END; END.
-59-
UNIT TekstFiles
BIJLAGE 3 3.8 UNIT TEKSTFILES
UNIT TekstFiles; INTERFACE USES PRINTER, MyGlobals, InputDal;
= '**********'; = '********************': = '--------------------'; , ,. = , =
CONST sterlO ster20 streep spa tie spatielO
..
PROCEDURE MaakKlantFile(klt klantType; lsr,dsp,cmp : materType; tmps,kbl : senKabType; nT,nK : INTEGER; airSen : materType); PROCEDURE MaakFreqFile(oper,name,sample : STRING: nrM : INTEGER; frDip : answerType); PROCEDURE MaakVerwerkFile(aantalFiles : INTEGER; files fileArray) ; PROCEDURE MaakInschakelFile(oper,frDip : STRING; duur, sampleTd : REAL); PROCEDURE MaakVerglFile(oper,vergFile,index,mode : STRING; typeLaser,typeRefracto : laserType; volCor,acVol : REAL); PROCEDURE MaakVerg2File(index,mode : STRING; volCor,acVol : REAL) ; PROCEDURE PrintVergKop(richting : STRING); PROCEDURE MaakDriftFile(oper : STRING; tdsd, sam: INTEGER); PROCEDURE MaakVolCorFile(oper,index : STRING; typeLaser,refType : laserType); PROCEDURE PrintTekst(filename : STRING}: IMPLEMENTATION TYPE Tekst
= STRING[80];
VAR nr tijd datum i fil typeLas,klant vC,bI,acV,acBI
STRING[3]; stringlO; string29; INTEGER; TEXT; answerTy; STRING;
PROCEDURE MaakKlantFile(klt : klantType; lsr,dsp,cmp : materType; tmps,kbl : senKabType; nT,nK : INTEGER; airSen : materType}; BEGIN getMyDate(datum) ; ASSIGN(fil, 'a:\Klant.txt'); REWRITE(fil) ;
-60-
UNIT TekstFiles
BIJLAGE 3
WriteLN(fil,ster20+ster20+ster20+ster20) : WriteLN(fil,ster20+ster20+ster20+ster20); WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,sterlO+' KALIBRATIE OPSTELLING VOOR' + 'LASERINTERFEROMETERS ' + sterlO): WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO); WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil,ster20+ster20+ster20+ster20); WriteLN(fil) ; WriteLN(fil, 'GEGEVENS KLANT:'); WriteLN(fil, 'Naam ' + klt.naam); WriteLN(fil, 'Adres • + klt.adres); WriteLN(fil, 'Plaats : ' + kIt.plaats}; WriteLN(fil, 'Telefoon: ' + kIt.teIefoon); WriteLN(fil,streep+streep+streep+streep): WriteLN(fil, 'GEGEVENS AANGEBODEN APPARATUUR: '): WriteLN(fil, 'Apparatuur aangeboden op '+datum); WriteLN(fil) ; WriteLN(fil, 'Laser typenummer : ' + lsr.typenummer): WriteLN(fil,' serienummer: ' + lsr.serienummer); WriteLN(fil,streep+streep+streep+streep) ; WriteLN(fil, 'Display typenummer : ' + dsp.typenummer) ; WriteLN(fil, serienummer: • + dsp.serienummer) ; WriteLN(fil,streep+streep+streep+streep); WriteLN(fil, 'Autom. compo typenummer:' + cmp.typenummer) ; WriteLN(fil,' serienummer: • + cmp.serienummer) ; WriteLN(fil,streep+streep+streep+streep); WriteLN(fil, 'Air-sensor typenummer : ' + airSen.typenummer) ; WriteLN(fil,' serienummer: I + airSen.serienummer) ; WriteLN(fil,streep+streep+streep+streep); STR(nT,nr) ; WriteLN(fil, 'Aantal temp. sensoren: ' + nr); FOR i := 1 TO nT DO BEGIN STR{i,nr}; WriteLN(fil, 'Temp. sensor ' + nr + ' typenummer '+ tmps(i] .typenummer}; WriteLN(fil,' serienummer: • + tmps[i) .serienummer): END; WriteLN(fil,streep+streep+streep+streep} ; STR(nK,nr) ; WriteLN(fil, 'Aantal kabels : ' + nr); FOR i := 1 TO nK DO BEGIN STR(i,nr); WriteLN(fil, 'Kabel' + nr + typenummer' + kbl[i] .typenummer); WriteLN(fil,' serienummer: • + kbl[i] .serienummer); I
I
-61-
BIJLAGE 3
UNIT TekstFiles END; WriteLN(fil,streep+streep+streep+streep); CLOSE(fil); END;
PROCEDURE MaakFreqFile(oper,name,sample : STRING; nrM INTEGER;frDip: answerType)i BEGIN getMyTime(tijd); getMyDate(datum) ; STR (nrM , nr) ; ASSIGN(fil, 'a:\' + name + '.TXT'); REWRITE (fil) ; WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO); WriteLN(fil,sterlO+' FREQUENTIE METINGEN '+ tijd + datum + sterlO); WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,ster20+ster20+ster20+ster20)j WriteLN(fil); WriteLN(fil, 'Operator : '+oper+spatie+' Files '+name+' .TXT '+ name+' .DTA')j GetQuestion(l,ansQuest); klant := ansQuest.answer[l] j GetQuestion(2,ansQuest); typeLas := ansQuest.answer[l]; WriteLN(fil, 'Type laser : '+typeLas); WriteLN(fil, 'Eigenaar : '+klant); WriteLN(fil, 'Aantal metingen: '+nr); IF sample = tOl THEN nr := '0.1'; IF sample tl THEN nr :=' 1'; IF sample = tlO THEN nr := 10'; WriteLN(fil, 'Sample tijd : '+nr+' sec. '); WriteLN(fil, 'Frequentie-dip : '+frDip+'-dip'); WriteLN(fil,streep+streep+streep+streep); CLOSE(fil) ; END;
=
I
PROCEDURE MaakVerwerkFile(aantalFiles fileArray);
INTEGER; files
BEGIN ASSIGN(fil, 'a:\verwFreq.txt'); REWRITE(fil); getMyTime(tijd) ; getMyDate(datum); WriteLN(fil/ster20+ster20+ster20+ster20); WriteLN(fil,sterlO+spatie+spatie+spatie+sterl0) ; WriteLN(fil,ster10+' VERWERK FREQ.METING '+ tijd + datum + sterlO); WriteLN(fil,ster10+spatie+spatie+spatie+sterlO); WriteLN(fil,ster20+ster20+ster20+ster20); WriteLN(fil) ; GetQuestion(l,ansQuest)j klant := ansQuest.answer[l]; GetQuestion(2,ansQuest) ; typeLas := ansQuest.answer[l]; WriteLN(fil, 'Type laser '+typeLas) i
-62-
UNIT TekstFiles
BIJLAGE 3
WriteLN(fil, 'Eigenaar ; '+klant); WriteLN(fil,streep+streep+streep+streep) ; WriteLN(fil, 'Gebruikte freguentiemeting files: '); FOR i := 1 TO aantalFiles DO WriteLN(fil,files[i] +' .DTA'); WriteLN(fil,streep+streep+streep+streep) ; CLOSE(fil) ; END; PROCEDURE MaakInschakelFile(oper,frDip : STRING; duur, sampleTd REAL); BEGIN ASSIGN(fil, 'a:\inschakel.txt'); REWRITE(fil) ; getMyTime(tijd); getMyDate(datum); WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,sterlO+' INSCHAKELVERSCH. '+ tijd + datum + sterlO) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil) ; WriteLN(fil, 'Operator : '+oper); GetQuestion(l,ansQuest); klant := ansQuest.answer[l]; GetQuestion(2,ansQuest) ; typeLas := ansQuest.answer[l]; WriteLN(fil, 'Type laser '+typeLas); WriteLN(fil, 'Eigenaar '+klant); WriteLN(fil, 'Frequentie dip '+frDip+'-Dip'); WriteLN(fil, 'Tijdsduur meting: ',duur:4, + ' uur' + I ' + 'Sampletijd: " sampleTd: 4, 'min. '); WriteLN(fil,streep+streep+streep+streep) ; CLOSE(fil) ; END; PROCEDURE MaakVerglFile(oper,vergFile,index,mode : STRING; typeLaser,typeRefracto laserType; volCor,acVol : REAL); VAR kop
STRING[60] ;
BEGIN IF mode = 'mac' THEN kop := spatielO+' mm-Mode met' + '+ , automatische compensator spatielO ELSE IF mode = 'zac'THEN kop := spatielO+' mm-Mode zonder'+ , automatische compensator'+ spatielO ELSE IF (mode = 'labda') AND (typeLaser.lTypeNr 'HP5528') THEN kop := spatielO+' mm-Mode met brekinqsindex 1 ' +spatielO ELSE kop := spatie+' labde-Mode '+spatie; getMyTime(tijd); getMyDate(datum) ; ASSIGN(fil, 'a:\'+vergFile+'l.TXT');
=
-63-
BIJLAGE 3
UNIT TekstFiles
REWRITE (f i1) ; WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO}; WriteLN(fil,sterlO+' VERGELIJKINGSMETING '+tijd+datum+ sterlO); WriteLN(fil,sterlO+kop+sterlO) j WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO); WriteLN(fil,ster20+ster20+ster20+ster20) : WriteLN(fil); '+oper); WriteLN(fil, 'Operator '+vergFile) ; WriteLN(fil, 'File-naam GetQuestion(l,ansQuest) ; klant := ansQuest.answer[l]; WriteLN(fil, 'TUE-laser HP5501'); WriteLN(fil, 'Te testen laser '+typeLaser.lTypeNr); WriteLN(fil, 'Eigenaar '+klant); IF (index = 'Refractometer') OR (index = 'Edlen-formule') THEN WriteLN(fil, 'Brekingsindex : '+index); IF index = 'Refractometer' THEN WriteLN(fil, 'Laser voor refr.: '+typeRefracto.lTypeNr); WriteLN(fil,streep+streep+streep+streep} ; IF mode = 'mac' THEN BEGIN WriteLN(fil,streep+streep+streep+streep) ; STR(volCor:10:2,vC); STR(acVol:lO:2,acV); STR(l/(volCor/lE6+0.999) :lO:9,bI) ;STR(l/(acVol/lE6+ 0.999) :lO:9,acBI); WriteLN(fil,spatie+index+spatielO+'Automatische'+ , compensator'); '+bI+spatielO+acBI); WriteLNlfil, 'Brekingsindex '+vC+spatielO+acV) ; WriteLN(fil, 'VOL-correctie END; IF mode = 'zac' THEN BEGIN WriteLNlfil,streep+streep+streep+streep) ; STR(volCor:10:2,vC); STR(1/(volCor/lE6+0.999} :lO:9,bI); WriteLN(fil, 'Brekingsindex volgens '+index+': ' + bI); WriteLN(fil, 'VOL-vorrectie volgens '+index+': ' + VC); END; CLOSE(fil) ; END; PROCEDURE MaakVerg2File(index,mode : STRING; volCor,acVol REAL} ; BEGIN ASSIGN(fil, 'a:\' + vergFile + '2.TXT'); REWRITE (fil) ; IF mode = 'mac' THEN BEGIN WriteLN(fil/streep+streep+streep+streep) ; WriteLN(fil,streep+streep+streep+streep) j STR(volCor:lO:2,vC); STR(acVol:lO:2,acV); STR(1/(volCor/lE6+0.999) :10:9,bI); STR(1/(acVol/lE6+0.999) :lO:9,acBI) j WriteLN(fil,spatie+index+spatielO+'Automatische' + , compensator'); WriteLN(fil, 'Brekingsindex '+bI+spatielO+acBI); '+vC+spatielO+acV) j WriteLN(fil, 'VOL-correctie END; IF mode = 'zac' THEN BEGIN WriteLN(fil,streep+streep+streep+streep} ;
-64-
BIJLAGE 3
UNIT TekstFiles
WriteLN(fil,streep+streep+streep+streep) ; STR(volCor:10:2,vC); STR(1/(volCor/1E6+0.999) :lO:2,bI); WriteLN(fil, 'Brekingsindex volgens '+index+': ' + bI); WriteLN(fil, 'VOL-vorrectie volgens '+index+': ' + VC); END; CLOSE (fil) ; END; PROCEDURE PrintVergKop(richting : STRING); BEGIN Write(LST,CHR(27) ,CHR(64)); Write{LST,CHR(27) ,CHR(68) ,CHR(4) ,CHR(28) ,CHR(52) ,CHR{O)); WriteLN(LST,streep+streep+streep+streep) ; WriteLN{LST,spatie+spatielO+richting) ; WriteLN{LST,CHR(9), 'TUE-laser' ,CHR(9), 'Te testen laser', CHR(9), 'verschil'); WriteLN{LST,streep+streep+streep+streep) ; END; PROCEDURE MaakDriftFile{oper : STRING; tdsd, sam VAR nr
INTEGER) ;
: STRING[4];
BEGIN getMyTime{tijd) ; getMyDate(datum) ; ASSIGN(fil, 'a:\Drift.TXT'); REWRITE (fil) ; WriteLN{fil,ster20+ster20+ster20+ster20) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,sterlO+' NULPUNTSDRIFTMETING '+ tijd + datum + sterlO) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil) ; WriteLN(fil, 'Operator : '+oper); GetQuestion(l,ansQuest) ; klant := ansQuest.answer[l]; GetQuestion{2,ansQuest) ; typeLas := ansQuest.answer[l]; WriteLN(fil, 'Te testen laser '+typeLas); WriteLN{fil, 'Eigenaar '+klant); STR(tdsd,nr) ; WriteLN(fil, 'Tijdsduur meting: '+nr); STR ( sam, nr) ; WriteLN(fil, 'Sample-tijd '+nr); WriteLN(fil,streep+streep+streep+streep) ; CLOSE(fil) ; END; PROCEDURE MaakVolCorFile(oper,index : STRING; typeLaser,refType : laserType); BEGIN getMyTime(tijd) ; getMyDate{datum) ; ASSIGN(fil, 'a:\VolCor.TXT'); REWRITE (fil) ;
-65-
UNIT TekstFiles
BIJLAGE 3
WriteLN(fil,ster20+ster20+ster20+ster20) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO) ; WriteLN(fil,sterlO+'VOL-CORRECTIE METING '+tijd+datum+ sterlO) ; WriteLN(fil,sterlO+spatie+spatie+spatie+sterlO); WriteLN(fil,ster20+ster20+ster20+ster20); WriteLN (fil) ; WriteLN(fil, 'Operator '+operl; GetQuestion(l,ansQuest); klant := ansQuest.answer[l]; WriteLN(fil, 'TUE-laser HP5501'); WriteLN(fil, 'Te testen laser '+typeLaser,lTypeNr); WriteLN(fil,'Eigenaar '+klant); WriteLN(fil, 'Brekingsindex '+index); IF index = 'Refractometer' THEN WriteLNlfil, 'Laser voor'+ , refr.: '+refType.lTypeNr); WriteLN(fil,streep+streep+streep+streep); CLOSE ( f i l ) ; END; PROCEDURE PrintTekstlfileNarne
STRING) ;
VAR line: STRING[255]; BEGIN ASSIGN(fil, 'a:\' + fileName + '.txt'); RESET(fil) ; WHILE NOT EOF(fill DO BEGIN ReadLN{fil, linel; WriteLN(LST,line); END; CLOSE (fill; END; END.
-66-
BIJLAGE 3
UNIT Verwerk 3.9 UNIT VERWERK UNIT Verwerk; INTERFACE USES PRINTER, MyGlobals, Diagram, Filer, InputDal, TekstFiles; TYPE string7 = STRING(7];
PROCEDURE VerwerkFreqMet(aantalFiles : INTEGER; files: fileArray; VAR ready : BOOLEAN); PROCEDURE VerwerkVergMeting(keuze : INTEGER); PROCEDURE MaakGrafFile(vergFile : string7; typeLaser: laserType; mode,index : STRING); PROCEDURE MaakGrafiek(vergFile : string7;keuze : INTEGER); IMPLEMENTATION PROCEDURE VerwerkFreqMet(aantalFiles : INTEGER; files: fileArray; VAR ready : BOOLEAN); LABEL 1; VAR i fil verschilFreq meanVerFreq meanFreq variance freqDip labdaP questMenu
INTEGER; FILE OF REAL; REAL; REAL; REAL; REAL; ARRAY [1 .. 16] OF REAL; REAL; menuType;
BEGIN ready := TRUE; meanVerFreq := 0; FOR i := 1 TO aantalFiles DO BEGIN IF exist('a:\' + files[iJ + '.DTA') THEN BEGIN ASSIGN(fil, 'a:\' + files[iJ + '.DTA'); RESET(fil); READ(fil,verschilFreq) ; meanVerFreq := meanVerFreq + verschilFreq; SEEK{fil,FileSize(fil)-l); READ(fil,freqDip[i); IF i <> 1 THEN BEGIN IF freqDip[i] <> freqDip[i-l] THEN BEGIN RepresentHelpPage(32,fileWithHelp); ready := FALSE; CLOSE(fil); GOTO 1; END;
-67-
BIJLAGE 3
UNIT Verwerk
END; CLOSE(fil); END ELSE BEGIN RepresentHelpPage(31,fileWithHelp) ; ready := FALSE; GOTO 1; END; END; meanVerFreq := meanVerFreq/aantalFiles; IF ready = TRUE THEN BEGIN MaakVerwerkFile(aantalFiles,files) ; PrintTekst('VerwFreq') ; FOR i := 1 TO aantalFiles DO BEGIN ASSIGN(fil, 'a:\' + files[i] + '.DTA'); RESET (fil) ; READ(fil,verschilFreq) ; variance := variance + SQR{verschilFreq - meanVerFreq); CLOSE (fil) ; END; variance := SQRT(variance/(aantalFiles - 1»; WriteLN(LST, 'Gemiddelde verschil-frequentie: ' meanVerFreq) ; : " variance) ; WriteLN(LST, 'Standaardafwijking QuestMenu.numOptions := 2; QuestMenu.option[l] := 'Positief'; QuestMenu.option(2) := 'Negatief'; QuestMenu.title := 'Is de verschilfreq. positief of'+ , negatief?'; CASE Menu(QuestMenu,2) OF 1 : meanVerFreq:= meanVerFreq; 2: meanVerFreq:= -meanVerFreq; END; meanFreq := freqDip[l) + meanVerFreq; labdaP := lichtsnelheid/(meanFreq); ,meanFreq) ; WriteLN(LST, 'Gemiddelde frequentie labdaP) ; WriteLN(LST, 'Golflengte WriteLN(LST,ster20+ster20+ster20+ster20) ; END; I
,
I
1:
END; PROCEDURE maakGrafFile(vergFile : string7; typeLaser: laserType; mode,index : STRING); VAR fil TEXT; BEGIN ASSIGN(fil, 'a:\'+vergFile+' .GRF'); REWRITE(fil) ; WriteLN(fil, 'Vergelijkingsm.'); WriteLN(fil,typeLaser.lTypeNr) ; IF mode = 'labda' THEN BEGIN IF typeLaser.lTypeNr = 'HP5528' THEN BEGIN WriteLN(fil, 'Lasers in mm-mode. Verschil op de '); WriteLN(fil, 'Beide lasers brekingsindex I'}; END
-68-
UNIT Verwerk
BIJLAGE 3
ELSE BEGIN WriteLN(fil, 'Lasers in labda-mode. Verschil op de '); WriteLN(fil, 'Zonder automatische compensator'); END; WriteLN(fil, 'File-naam : '+vergFile); WriteLN(fil,' '); WriteLN(fil, 'Verschil'); WriteLN(fil, 'Meting'); END ELSE BEGIN WriteLN(fil, 'Lasers in mm-mode. Verschil op de '); IF mode = 'mac' THEN WriteLN(fil, 'Met automatische'+ , compensator') ELSE WriteLN(fil, 'Zonder automatische compensator'); WriteLN(fil, 'Echte brekingsindex met '+index); WriteLN(fil, 'File-naam : '+vergFile); WriteLN(fil, 'Verschil in [mm] '); WriteLN(fil, 'Verplaatsing [mm] '); END; CLOSE(fil) ; END; PROCEDURE MaakGrafiek(vergFile VAR fil
string?;keuze
INTEGER) ;
TEXT; INTEGER; STRING; diagramTextType; realFileArray;
i
line diagramText diagrarr.File
BEGIN ASSIGN{fiJ, 'a:\'+vergFile+' .GRF'); RESET(fil) ; FOR i := 1 TO 8 DO BEGIN ReadLN(fil,line); diagramText[i] := line; END; line := diagramText(3); IF keuze = 2 THEN line .- 'Golflengte gecorrigeerd. '+ , Verschil op de '; IF keuze = 3 THEN line := 'Golfl/BrekingsI gecor. Verschil' · op de '; diagramFile[l] := vergFile + '3'; diagramText(3) := line +'heenweg'; TekenGrafiek(diagramText,diagramFile,l,O) ; diagramFile [1] : = vergFile + '6'; diagramText[3] := line +'terugweg'; TekenGrafiek(diagramText,diagramFile,l,O}; END; PROCEDURE PrintFiles(vergFile richting VAR linel,line2, line3,verschil i
fill,fi12,fi13
-69-
string?; faktor : REAL; STRING; keuze : INTEGER};
REAL; INTEGER; FILE OF REAL;
BIJLAGE 3
UNIT Verwerk
BEGIN WriteLN(LST,streep+streep+streep+streep); IF keuze = 2 THEN WriteLN(LST, , '+ 'Meetwaarden golflengte'+ , gecorrigeerd'); IF keuze = 3 THEN WriteLN(LST,' Meetwaarden'+ , golflengte/brekingsindex gecorrigeerd'); PrintVergKop(richting); IF richting = 'Heenweg' THEN BEGIN ASSIGN(fill, 'a:\'+vergFile+'l.DTA'); ASSIGN(fi12, 'a:\'+vergFile+'2.DTA'); ASSIGN(fi13, 'a:\'+vergFile+'3.DTA'); RESET(fill);RESET(fi12) ;RESET(fi13); END ELSE BEGIN ASSIGN(fill, 'a:\'+vergFile+'4.DTA'); ASSIGN(fi12, 'a:\'+vergFile+'5.DTA'); ASSIGN(fi13, 'a:\'+vergFile+'6.DTA'); RESET(fill);RESET(fi12) ;RESET(fi13); END; WHILE NOT EOF(fi11) DO BEGIN Read(fi11,line1); Read(fi12,line2); verschil := line1 - line2 * faktor; Read(fi13,line3); Write(fi13,verschil); WriteLN(LST,i,CHR(9) ,line1:10:5,CHR(9), line2*faktor:10:5,CHR(9), verschil:10:5); END; CLOSE(fill) ;CLOSE(fi12) ;CLOSE(fi13); END; PROCEDURE VerwerkVergMeting{keuze : INTEGER); LABEL 1,2,3,4,5; VAR uitdraai volCor,acVol, werkelijkeGolflen, systeemGolflen, faktor integ fil
STRING;
REAL; INTEGER; FILE OF REAL;
BEGIN 1:QuestMenu.numoptions := 2; QuestMenu.option[l] := 'Een listing en grafiek'; QuestMenu.option[2] := 'AIleen een listing'; QuestMenu.title := 'Representatie van de meetwaarden'; CASE Menu(QuestMenu,l) OF 1: uitdraai.- 'listgraf'; 2: uitdraai:= 'list'; ELSE GOTO 5; END; 2:Questions(answers,16,fileWithQuest,ifail) ; IF ifail = 3 THEN GOTO 2; IF ifail <> 0 THEN GO TO 1; vergFile := answers[l]; IF exist('a:\' + vergFile + '6.DTA') = FALSE THEN BEGIN
-70-
UNIT Verwerk
BIJLAGE 3
RepresentHelpPage{33,fileWithHelp): GOTO 2; END: CASE keuze OF 1: BEGIN PrintTekst(vergFile + '1'); PrintFiles(vergFile,l, 'Heenweg' ,1); PrintTekst(vergFile + '2'); PrintFiles(vergFile,l, 'Terugweg' ,1); IF (uitdraai = 'listgraf') THEN MaakGrafiek(vergFile,l) ; END; 2 BEGIN 3: Questions(answers,17,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 3; IF ifail <> 0 THEN GOTO 2; VAL (answers [1] ,werkelijkeGolflen,integ); VAL (answers [2] ,systeemGolflen,integ); faktor := werkelijkeGolflen/systeemGolflen; PrintTekst(vergFile + '1'); PrintFiles(vergFile,faktor, 'Heenweg' ,2); PrintTekst(vergFile + '2'); PrintFiles(vergFile,faktor, 'Terugweg' ,2); IF (uitdraai = 'listgraf') THEN MaakGrafiek(vergFile,2} ; END; 3 BEGIN IF Exist('a:\'+vergFile+'.AUC') = FALSE THEN BEGIN RepresentHelpPage(34,fileWithHelp) ; GOTO 5; END; 4: Questions{answers,17,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 4; IF ifail <> 0 THEN GO TO 2; VAL(answers~l] ,werkelijkeGolflen,integ); VAL(answers[2] ,systeemC~lflen,integ); ASSIGN{fil, 'a:\'+vergFile+'.AVC'); RESET(fil) ; Read(fil,volCor);Read(fil,acVol) ; faktor := (werkelijkeGolflen/systeemGolflen)* «O.999+volCor*lE-6)/(O.999+acVol*lE-6» ; PrintTekst(vergFile + '1'); PrintFiles(vergFile,faktor, 'Heenweg' ,3); Read(fil,volCor) ;Read(fil,acVol); faktor := (werkelijkeGolflen/systeemGolflen)* «O.999+volCor*1E-6)/(O.999+acVol*lE-6)}; PrintTekst{vergFile + '2'); PrintFiles(vergFile,faktor, 'Terugweg' ,3); IF (uitdraai = 'listgraf') THEN MaakGrafiek(vergFile,3); CLOSE{fil); END; END; 5: END; END.
-71-
BIJLAGE 3
UNIT LaserInterface 3.10 UNIT LASERINTERFACE UNIT LaserInterface; INTERFACE USES PRINTER, CRT, GRAPH, MyGlobals, InputDa1, Graphexl: TYPE waarde FUNCTION PROCEDURE PROCEDURE PROCEDURE PROCEDURE PROCEDURE FUNCTION
= STRING[80];
EnterIEEE(addres : INTEGER) ; waarde; ZendIEEE(addres ; INTEGER: data: waarde); TransmitIEEE(data : STRING); InitIEEE; InitLaserTypes: SetLaser(typeLaser : LaserType; inDis ; CHAR); ReadLaser(typeLaser ; LaserType; inDis : CHAR) waarde;
IMPLEMENTATION [$1 turbo4.incl VAR
status adres level strW resDesc poll1
INTEGER; INTEGER; INTEGER; waarde: sDesc; INTEGER;
FUNCTION EnterIEEE(addres
INTEGER)
waarde;
VAR lengteStr : INTEGER; BEGIN adres ;= addres; , strW := • resDesc.len := Length(strW); resDesc.address ;= OFS(strW) + li ENTER (resDesc, lengteStr, adres, status); IF status <> 0 THEN RepresentHelpPage(20,fileWithHelp) ELSE EnterIEEE := strW; END; I
FUNCTION SpollIEEE(addres
INTEGER)
•
INTEGER;
BEGIN adres := addres; Spoll(adres,polll,status) ; IF status <> 0 THEN RepresentHelpPage(2l,fileWithHelp) ELSE SpollIEEE ;= polll; END;
-72-
BIJLAGE 3
UNIT LaserInterface PROCEDURE ZendIEEE(addres
INTEGER; data
waarde) ;
BEGIN adres := addres; strW := data; resDesc.Len := Length(strW}; resDesc.Address := OFS(strW) + 1; Send(adres,resDesc,status); IF status <> 0 THEN RepresentHelpPage(22,fileWithHelp); END; PROCEDURE TransmitIEEE(data
STRING) ;
BEGIN strW := data; resDesc.Len ;= Length(strW); resDesc.address := OFS(strW} + 1; Transmit(resDesc,status) ; IF status <> 0 THEN RepresentHelpPage(23,FileWithHelp); END; PROCEDURE InitIEEE; VAR
wrde : BOOLEAN;
BEGIN adres := IBMaddres; level := systemController; wrde := Pc488seg(adresIEEE); IF wrde = true THEN BEGIN WriteLN('fout adres'); HALT; END; Initialize{adres,level); TransmitIEEE('IFC'); END; PROCEDURE InitLaserTypes; BEGIN master.adres 9; .-master.1Set :='006A1A2A30' ; master.lRead := 'lA2A30' ; master.1TypeNr 'HP5501'; .master.test 63; .master.golfLen := 0.632991426; master.intFace ' IEEE' ; .HP5501.lTypeNr 'HP5501'; .HP5501.test 63; .-:= HP5501.intFace 'IEEE' ; HP5526.1TypeNr := 'HP5526' ; HP5526.intFace 'BCD' ; .HP5528.1TypeNr 'HP5528' ; HP552B.adres 7; .HP5528.lRead 'RC '; :=
·
·
·.-
-73-
5IJLAGE 3
UNIT LaserInterface HP5528.test := 65; HP5528.intFace .'IEEE': andere.intFace .'GEEN'; refHP5501.adres:= 9; refHP5501.1Set :='0065152530' ; refHP5501.1Read .' 1B2B30' ; refHP5501.test:= 63; refHP5501.1TypeNr.'HP5501'; refHP5501.go1fLen .- 0.632991426; refHP5501.intFace ,• IEEE' i refHP5526.1TypeNr .• HP5526' ; refHP5526.go1fLen := 0.632991370; refHP5526.intFace := • BCD' ; END; PROCEDURE InDisplay; BEGIN TransmitIEEE{'LISTEN 1 TALK 9 '); TransmitIEEE('UNL UNT'); END; PROCEDURE SetLaser(typeLaser : LaserType; inDis
CHAR) :
BEGIN IF typeLaser.intFace <> 'IEEE' THEN RepresentHelpPage{70,FileWithHelp) ELSE BEGIN ZendIEEE(typeLaser.adres, typeLaser.lSet); IF inDis = 'yo THEN InDisplaYi END; END; CHAR)
FUNCTION ReadLaser(typeLaser : LaserType; inDis waarde; VAR statusl,status2 : INTEGER; FUNCTION ReadManual : waardei VAR a,i : INTEGER; rWaarde : waarde; FUNCTION ReadWaarde : waarde; CONST return backspace VAR
keyR ready
= #13;
=
#8:
CHAR; BOOLEAN;
BEGIN ready := FALSE; a : = 1; rWaarde := ' WHILE ready = FALSE DO
, ,.
-74-
BIJLAGE 3
UNIT LaserInterface
BEGIN keyR := ReadKey; CASE keyR OF return ready := TRUE; backspace: BEGIN IF a <) 1 THEN BEGIN SetColor(black) ; OutTextXY(Round(maxX/1.9 + (a - 1) * 9) ,Round(9.5 * maxY/10), rWaarde[a -1); SetColor(white) ; rWaarde(a - 1] := • '; a := a - 1; END; END; ELSE BEGIN rWaarde(a] := keyR; OutTextXY(Round(maxX/1.9 + a * 9) ,Round(9.5 * maxY/10) ,keyR); a := a + 1; END; END; END; ReadManual := rWaarde; WriteLN(LST,' ... ' ,rWaarde,' ... ') END; BEGIN SetTextJustify(leftText,centerText); OutTextXY{Round{maxX * 1/10) round{9.5 * maxY/10) 'Geef' +' de waarde van te testen laser: '); ReadManual := ReadWaarde; SetColor(black); OutTextXY(Round(maxX * 1/10), round{9.5 * maxY/IO), 'Geef' +' de waarde van te testen laser: '); FOR i := 1 TO a DO OutTextXY(Round(maxX/1.9 + i * 9), Round(9.5 * maxY/10), rWaarde[i]); SetColor{white) ; END; f
FUNCTION ReadBCDLaser : waarde; PROCEDURE LeesBCDLaser; BEGIN getalO .- PORT[Port1A]i getall .- PORT(PortlB] ; geta12 := PORT[Port1C]; geta15 PORT[Port2A]: geta13 .- PORT[Port2B]; geta14 .- PORT[Port2C] ; END;
··
PROCEDURE MaakGetal(getal : BYTE) ; BEGIN iii := (getal MOD 16) i
-75-
I
UNIT LaserInterface
jjj .IF iii IF jjj aaa := END;
10
*
BIJLAGE 3
(getal DIV 16);
> 10 THEN iii := 0; > 100 THEN jjj := 0; iii + jjj;
BEGIN LeesBCDLaser; c : = 0; MaakGetal(getalO) ; c := c + aaa; MaakGetal(getal1); c := c + 100 * aaa; MaakGetal(geta12); c := c + 1E04 * aaa; MaakGetal(geta15); c := c + 1E06 * aaa; iii := (geta13 MOD 16); j j j := 10 * «geta13 DIV 16) AND 15); IF iii > 10 THEN iii := 0; c := c + 1E08 * iii; IF jjj = 10 THEN c:= -1 * c; STR(c,strWaarde); ReadBCDLaser := strWaarde; IF jjj > 10 THEN BEGIN RepresentHelpPage(71,fileWithHelp) : ReadBCDLaser .- 'FOUT': END; END; BEGIN status1 := 0; status2 := 0; IF typeLaser.intFace = 'GEEN' THEN ReadLaser := ReadManual ELSE IF typeLaser.intFace = 'BCD' THEN ReadLaser := ReadBCDLaser ELSE BEGIN ,, ReadLaser := • ZendIEEE(typeLaser.adres, typeLaser.lRead); Delay(I); ReadLaser := EnterIEEE(typeLaser.adres); IF SpollIEEE(typeLaser.adres) > typeLaser.test THEN BEGIN RepresentHelpPage(72,fileWithHelp); ReadLaser := 'FOUT'; END; IF inDis 'Y' THEN inDisplay; END; END;
.
=
END.
-76-
BIJLAGE 3
UNIT Spiege1Verp1 3.11 UNIT SPIEGELVERPL UNIT Spiege1Verp1; INTERFACE PROCEDURE Verp1aatsNaarLaser; PROCEDURE Verp1aatsVanLaser: PROCEDURE StopVerp1aatsen: IMPLEMENTATION PROCEDURE Verp1aats( da CONST
adBase
VAR
x
INTEGER) ;
= $278; INTEGER:
BEGIN
x
:= (da DIV 256) AND 15: Port[ADbase + 7] .- x: Port[ADbase + 6] := da MOD 256: END;
PROCEDURE VerplaatsNaarLaser: BEGIN Verplaats(1112): Verplaats(1112); END: PROCEDURE Verp1aatsVanLaser: BEGIN Verp1aats(3034) : Verp1aats(3034): END; PROCEDURE StopVerplaatsen: BEGIN Verplaats(2073); Verplaats(2073); END; END.
-77-
BIJLAGE 3
UNIT FrequentieMeting 3.12 UNIT FREQUENTIEMETING UNIT FrequentieMeting; INTERFACE USES GRAPH, CRT, PRINTER, Filer, MyGlobals, Math1, InputDal, Graphex1, Diagram, TekstFi1es, Verwerk, LaserInterface;
PROCEDURE MeetFrequentie(freqName : STRING: aantal : INTEGER: fPoort,sample : STRING;dip : REAL) i PROCEDURE AllenVariance; PROCEDURE MeetInschakel(tijdsd, samTijd : REAL: fPoort, sample : STRING); IMPLEMENTATION TYPE commando = STRING [80] : PROCEDURE MeetFrequentie(freqName : STRING; aanta1 : INTEGER; fPoort,sample : STRING; dip: REAL); VAR i,j, aantalInt INTEGER; freqWaarde waardei freq,som,k REAL: fil FILE OF REAL: meanFreq REAL; deviation REAL; aantalReal REAL; nr STRING [4] ; fr STRING; grafFile realFileArray; diagramText diagramTextTypei BEGIN MaakKader('Frequentiemeting'); IF sample = tOl THEN nr := '0.1': IF sample = tl THEN nr :=' 1'; IF sample = tl0 THEN nr := ' 10'; OutTextXY(Round(maxX/30) , Round (3*maxY/l0) , 'Sampletijd + nr + ' sec'); diagramText[4) := 'Sampletijd : '+nr+' sec.': STR(aantal,nr); OutTextXY(Round(maxX/30) ,Round(4*maxY/10}, 'Aantal'+ , metingen: ' + nr): diagramText[3] := 'Aantal metingen: '+ nr: ZendIEEE(freqDisplay,sample): ZendIEEE(freqDisplay, 'DN'):
-78-
BIJLAGE 3
UNIT FreguentieMeting ASSIGN(fil, 'a:\' + freqName + '.DTA'); REWRITE (fil) ; som := 0; deviation := 0; j
: = 1;
FOR i := 1 TO aantal DO BEGIN ZendIEEE(freqDisplay,fPoort) ; freqWaarde := EnterIEEE(freqDisplay); freq := Omreken(freqWaarde); SetColor(black) ; OutTextXY(Round(maxX/30) ,Round(6*maxY/10), 'Frequentiemeting , + nr + ': ' + fr); SetColor(white) ; STR(freq,fr) ; STR (i, nr) ; OutTextXY(Round(maxX/30) ,Round(6*maxY/10), 'Frequentiemeting , + nr + ': ' + fr); som := som + freq; IF j = 4 THEN BEGIN j := 0; WriteLN(LST,freq,' '); END ELSE Wri te (LST, freq, , ,); j := j + 1; k := i * 1.0; Write(fil,k) ; Write(fil,freq) ; END; meanFreq := som/aantal; RESET(fil) ; WHILE NOT EOF(fil) DO BEGIN Read(fil,freq) ; Read (fil, freq) ; deviation .- deviation + (freq - meanFreq) * (freq meanFreq) ; END; deviation := SQRT(deviation/(aantal - 1)); WriteLN(LST) ; WriteLN(LST,streep+streep+streep+streep) ; aantalReal := aantal * 1.0; WriteLN(LST, 'Gemiddelde verschilfreq.: ',meanFreq); WriteLN(LST, 'Standaardafwijking ',deviation); aantalInt := TRUNC(aantalReal); WriteLN(LST, 'Aantal metingen ',aantalInt); WriteLN(LST, 'Frequentie-dip ',dip); WriteLN(LST,ster20+ster20+ster20+ster20) ; diagramText[l] := 'Frequentiemeting'; GetQuestion(2,ansQuest) ; typeLas := ansQuest.answer[l]; diagramText [2] : = typeLas; STR(meanFreq,fr) ; diagramText[5] := 'Gem. frequentie: '+fr; STR(deviation,fr) ; diagramText[6] .- 'Standaardafw. '+fr; diagramText[7] := 'Freq.'; diagramText [8] : = 'Meting'; grafFile [1] : = freqName; TekenGrafiek(diagramText,grafFile,l,meanFreq) ; REWRITE (fil) ;
-79-
BIJLAGE 3
UNIT FreguentieMeting Write(fil, Write(fil, Write(fil, Write(fil, CLOSE(fil) END;
meanFreq); deviation); aantalReal); dip); ;
PROCEDURE AllenVariance; BEGIN END; PROCEDURE MeetInschakel(tijdsd, samTijd : REAL; fPoort, sample: STRING); VAR i,j,samSec fil freqWaarde freq,frShift,tijd aantalSamples aantSam,smSc,tdsd fr,nr,typeLas grafFile diagramText ansQuest
INTEGER; FILE OF REAL; waarde; REAL; INTEGER; STRING[8) ; STRING; realFileArray; diagramTextType; ansQuestTy;
BEGIN MaakKader('Inschakelverschijnselen'); grafFile [1] : = 'inschakel'; ASSIGN(fil, 'a:\inschakel.dta'}; REWRITE(fil) ; aantalSamples := TRUNC(tijdsd * 60 / samTijd); samSec := TRUNC(samTijd * 60); STR(samSec,smSe) ; STR(aantalSamples,aantSam) ; STR(tijdsd,tdsd) ; OutTextXY(Round(maxX/30) ,Round(3*maxY/10) , 'Aantal samples: + aantSam); OutTextXY(Round(maxX/30) ,Round(4*maxY/10), 'Sampletijd : ' + smSe + ' sec'); frShift := 0; ZendIEEE(freqDisplay,sample); tijd := 0; FOR i := 1 TO aantalSamples DO BEGIN FOR j := 1 TO samSee DO DELAY(lOOO); SetColor(black) ; OutTextXY(Round(maxX/30) ,Round(6*maxY/10} , 'Meting , + nr + ': • + fr); SetColor(White); ZendIEEE(freqDisplay,fPoort) ; freqWaarde := EnterIEEE(freqDisplay}; freq := Omreken(freqWaarde) ; STR(freq,fr) ; STR (i , nr) ; OutTextXY(Round(maxX/30) ,Round(6*maxY/10), 'Meting' + nr + ': ' + fr); Wri te (fil, tijd) ; Write(fil,freq) ; I
-80-
UNIT FrequentieMeting WriteLN(LST,tijd,' ',freq); tijd != tijd + samSec/3600; frShift := frShift + freq; END; CLOSE(fil); frShift := frShift/aantalSamples; WriteLN(LST,streep+streep+streep+streep); WriteLN(LST, 'Frequentie-shift :' ,frShift); WriteLN(LST,ster20+ster20+ster20+ster20): STR(frShift,fr); diagramText[1] := 'Inschakelversch. '; GetQuestion(2,ansQuest) ; typeLas := ansQuest.answer[1]; diagramText[2] := typeLas; diagramText[3] := 'Aantal samples: '+aantSam; diagramText[4] := 'Sampletijd '+smSc+' sec.'; diagramText[5] .- 'Tijdsduur '+tdsd+' uur'; diagramText[6] := 'Freq.shift '+fr: diagramText[7] := 'Freq.': diagramText[8] := 'uur'; TekenGrafiek(diagramText,grafFile,1,frShift}; END; END.
-81-
BIJLAGE 3
BIJLAGE 3
UNIT VergelijkingsMeting 3.13 UNIT VERGELIJKINGSMETING UNIT Vergelijkingsmeting; INTERFACE USES CRT, DOS, PRINTER, GRAPH, MyGlobals, Math1, InputDa1, Graphex1, Diagram, Verwerk, LaserInterface, TekstFiles, SpiegelVerpl;
FUNCTION SetRefractometer(typeLaser : laserType) REAL; FUNCTION VolRefractometer(typeLaser : laserType) REAL; FUNCTION VolEdlenForm : REAL; PROCEDURE MeetVerg(operator,vergFile,index,mode : STRING; typeLaser,refractoType : laserType); PROCEDURE MeetNulPuntsDrift(typeLaser : laserType; tijdsd, smpT : INTEGER ); PROCEDURE MeetVolCor(operator,index : STRING; typeLaser, ref Type : laserType); IMPLEMENTATION TYPE string255
= STRING[255];
VAR i,integ brIndex fil1,fi12,fi13, fi14,fi15,fi16, filAuc rich,versch nr,cMnr,cTnr acVol,volCor fout komma
INTEGER; REAL; FILE OF REAL; STRING; STRING; REAL; BOOLEAN; INTEGER;
FUNCTION SetRefractometer(typeLaser LABEL 1; VAR countsR fil nulW
waarde; FILE OF REAL; REAL;
BEGIN RepresentHelpPage(74,fileWithHelp); SetLaser(typeLaser, 'Y'); countsR := ReadLaser(typeLaser, 'Y'); IF countsR = 'FOUT' THEN BEGIN
-82-
laserType)
REAL;
BIJLAGE 3
UNIT VergelijkingsMeting
fout .- TRUE; GOTO 1; END; nulW := Omreken(countsR); SetRefractometer := nulW; ASSIGN(fil, 'c:\turbo4\gerard\nulwaard.ref'); REWRITE (f il) ; Wri te (fil, nulW) ; CLOSE(fil} ; MaakKader('Set refractometer'); OutTextXY(Round(maxX/30),Round{3*maxY/10) , 'Laat nu lucht in het samplekanaal van de refractometer'); OutTextXY(Round(maxX/30},Round(4*maxY/10} , 'Geef als de waarde van de laser voor de '); OutTextXY (Round (maxX/30) ,Round (5*maxY/10) , 'refractometer, welke op het display wordt weergegeven, '); OutTextXY{Round{maxX/30) ,Round (6*maxY/10) , 'niet meer veranderd.'): REPEAT countsR := ReadLaser(typeLaser, 'Y'): UNTIL keypressed; 1:
END; FUNCTION VolRefractometer(typeLaser LABEL 1,2; VAR dT,dN,vol, temp4,temp5, temp6,temp7, eindWaarde, lenRefr eindStr weerst
laserType)
REAL;
REAL; waarde; weerstType;
BEGIN l:Questions(answers,ll,fileWithQuest,ifail); IF ifai1 = 3 THEN GOTO 1; IF ifail = 0 THEN BEGIN VAL(answers[l] ,weerst[l] ,integ); FOR i := 4 TO 7 DO VAL(answers[i-2],weerst[i] ,integ); temp4 .- (weerst[4] - (weerst[l] - 100) - 107.79)/0.388 20 + 0.015: tempS := (weerst[5] - (weerst[l] - 100) - 107.79)/0.388 20 - 0.181; temp6 := (weerst[6] - (weerst[l] - 100) - 107.79)/0.388 20 - 0.06; temp7 .- (weerst[7] - (weerst[l] - 100) - 107.79)/0.388 20 + 0.075: dT := temp7 - {temp4 + temp5)/2; lenRefr := 410070.4 * (1 + 23E-06 * (temp6 - 19.915»: eindStr := ReadLaser(typeLaser, 'Y'): IF eindStr = 'FOUT' THEN GOTO 2; eindWaarde := Omreken(eindStr); brIndex := 1 + (ABS(eindWaarde - nu1Waarde) * typeLaser.golfLen)/(400 * lenRefr); dN := (-(brIndex - 1) * dT)/«temp4 + temp5)/2 + 273): brIndex := brIndex + dN:
-83-
+ + + +
UNIT VergeliikingsMeting
BIJLAGE 3
VolRefractometer := (l/brlndex - 0.999) END ELSE 2: fout := TRUE; END; FUNCTION VolEdlenForm
* 1E06;
REAL;
LABEL 1,2; VAR uren,minu, sec,rest tijd,uur,min, co2,cCo2 temp7,tempCor luchtDr,tempBar, IDruk,cDruk,cTemp: ternpN,tempC,tempD: tempDauw,argum vocht,cVocht,dN weerst
WORD; REAL; REAL; REAL; REAL; REAL; REAL; weerstType;
BEGIN 1:Questions(answers,12,fileWithQuest,ifail) ; IF ifail = 3 THEN GOTO 1; IF ifail = 0 THEN BEGIN VAL (answers [1] ,weerst[l] ,integ); VAL(answers[2J ,weerst[7] ,integ); VAL (answers [3] ,luchtDr,integ}; VAL (answers [4] ,tempBar,integ); 2: tempDauw:= 0; QuestMenu.numoptions := 2; QuestMenu.option[l] .- 'Vochtigheidsmeting met'+ , dauwpuntsmeter'; QuestMenu.option[2] := 'Vochtigheidsmeting met'+ • droge/natte bol'; QuestMenu.title := 'Brekingsindex met Edlen-formule'; CASE Menu(QuestMenu,l) OF 1: BEGIN Questions(answers,13,fileWithQuest,ifail); IF ifail <> 0 THEN GOTO 2; VAL (answers [1] ,tempDauw,integ); END; 2 BEGIN Questions (answers,14,fileWithQuest,ifail) ; IF ifail <> 0 THEN GOTO 2; VAL (answers [1] ,tempN,integ); VAL (answers [2] ,tempC,integ); VAL (answers [3] ,tempD,integ); END; ELSE GOTO 1; END; getTime(uren,minu,sec,rest) ; uur := uren * 1.0; min := minu * 1.0; tijd := 100 * (uur + (min/60»; co2 := 0.475 * tijd + 45; temp7 := (weerst[7] - (weerst[1] - 100) - 107.79)/0.388 + 20 + 0.075;
-84-
BIJLAGE 3
UNIT VergeIijkingsMeting
IDruk := luchtDr * 1.00051 * (-1.63E-04*tempBar + 1) 0.12; IF tempDauw = 0 THEN vocht := 133.322 * (tempC - 0.5 * (tempD - tempN» ELSE BEGIN tempCor := 0.93 * tempDauw + 0.9; argum .- tempCor * (0.0725 - tempCor * (2.881E-4 tempCor * 0.79E-6»; vocht := 611 * EXP(argum} i END; cCo2 := 1 + 0.535E-06 * (co2 - 300); cDruk := 0.104126E-04 * IDruk * 100; cTernp := 1/(1 + 0.003671 * temp7}; cVocht := vocht * -4.2063E-10; dN := 0.27651754E-03 * cCo2 * cDruk * cTemp + cVocht; brIndex := 1 + dN; VolEdlenForm := (l/brIndex - 0.999) * 1E06; END ELSE fout := TRUE; END; PROCEDURE GetVoIWaarden(index,mode : STRING; typeLaser,refractoType LABEL 1; VAR aCVolStr volCorS
laserType);
waarde; STRING[10] ;
BEGIN volCor := 1000; IF index = 'Refractometer' THEN volCor := VolRefractoMeter(refractoType); IF index = 'EdIen-formule' THEN volCor := VolEdlenForm; IF fout = FALSE THEN BEGIN IF (mode = 'Iabda') AND (typeLaser.lTypeNr 'HP5528') THEN BEGIN STR(voICor:1:1,volCorS) ; ZendIEEE(typeLaser.adres,voICorS + 'VL'); END; IF mode = 'mac' THEN BEGIN IF typeLaser.lTypeNr = 'HP5528' THEN BEGIN ZendIEEE(typeLaser.adres, 'VL,RC'); Delay(lOOO); acVolStr := EnterIEEE(typeLaser.adres); acVol := Omreken(acVolStr) ; ZendIEEE(typeLaser.adres, 'M1,UM'); END ELSE BEGIN 1: Questions(answers,15,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 1; IF ifail = 0 THEN VAL (answers [1] ,acVol,integ); END; Write(filAuc,volCor) ; Write(filAuc,acVol) ; END;
=
-85-
UNIT VergeIijkingsMeting
BIJLAGE 3
IF (mode = 'zac') THEN BEGIN IF typeLaser.ITypeNr = 'HP5526' THEN BEGIN STR(voICor:l:l,voICorS); MaakKader('VergeIijkingsmeting HP5526'}; OutTextXY(Round(maxX/30) ,Round(4*maxY/IO) , 'Zet de duimwielen van de HP5526 op , + voICorS); END; IF typeLaser.ITypeNr = 'HP5528' THEN BEGIN STR(volCor:l:l,voICorS); ZendIEEE(typeLaser.adres,voICorS + 'VL'); END; END; END; END; PROCEDURE VergelijkingsmetingScherm(richting,mode,index STRING} ; VAR bI,vC : STRING; BEGIN MaakKader('Vergelijkingsmeting'); Line(maxX DIV 2,ROUND(2*maxY/10) ,maxX DIV 2, ROUND(S.9*maxY/10»; Line(maxX DIV 2,ROUND{maxY/l.85) ,maxX,ROUND(maxY/l.85»; OutTextXY(Round(maXX/30) , Round (3*maxY/10) ,richting); OutTextXY(Round(maxX/30),Round(4*maxY/10), 'Het aantal'+ , metingen is 30'); OutTextXY(Round(maxX/30) ,Round(5*maxY/10), 'Meting '+ I:
');
OutTextXY(Round(maxX/30) ,Round(6*maxY/10), 'TUE-laser , : '); OutTextXY(Round(maxX/30) ,Round(7*maxY/10}, 'Te testen '+ 'laser: '); OutTextXY(Round(maxX/30),Round(8*maxY/10), 'Verschil t
:
'+
'+
'};
IF mode <> 'labda' THEN BEGIN STR(brIndex:12:11,bI}; STR{volCor:6:2,vC); OutTextXY(Round(maxX/l.9) , Round (3*maxY/10) ,index) ; OutTextXY(Round(maxX/l.9) ,Round(4*maxY/10), 'Br.Index: ' +bI) ; OutTextXY(Round{maxX/l.9) ,Round (5*maxY/10) , 'VOL-cor.: ' +vC) ; END; IF mode = 'mac' THEN BEGIN STR(acVol:6:2,vC); STR(1/(acVol/1E6 + 0.999) :12:11,bI); OutTextXY(Round(maXX/1.9) ,Round(6*maxY/10) ,'Automatsich'+ , compensator'); OutTextXY(Round(maxX/1.9) ,Round(7*maxY/10), 'Br.Index: ' +bI) ; OutTextXY(Round(maxX/1.9) ,Round(8*maxY/10), ·VOL-cor.: ' +vC) ; END; END;
-86-
UNIT VerqelijkinqsMetinq
BIJLAGE 3
PROCEDURE Verplaats(richting : STRING); BEGIN StopVerplaatsen; IF richting = 'Heenweg' THEN VerplaatsNaarLaser ELSE VerplaatsVanLaser; DELAY(TRUNC(82/30*1000»; StopVerplaatseni DELAY(15000); END; PROCEDURE VerplaatsingOpScherm(i : INTEGER; countsM,countsT, verschil : REAL); BEGIN SetColor(black) : OutTextXY(Round(maxX/4) ,Round(5*maxY/10),nr); OutTextXY(Round(maxX/4) ,Round(6*maxY/10) ,cMnr) ; OutTextXY(Round(maxX/4) ,Round(7*maxY/10) ,cTnr): OutTextXY(Round(maxX/4),Round(8*maxY/10) ,versch); SetColor(white) : STR(i,nr); STR(verschil:10:komma,versch): STR(countsM:10:komma,cMnr); STR(countsT:10:komma,cTnr): OutTextXY (Round (maxX/4) , Round (5*maxY/10) ,nr)i OutTextXY(Round(maxX/4) , Round (6*maxY/10) ,cMnr): OutTextXY (Round (maxX/4l ,Round(7*maxY/10) ,cTnr); OutTextXY(Round(maxX/4) ,Round(8*maxY/10) ,versch): END; FUNCTION OmrekenMaster(countStr,mode : STRING: typeLaser laserType) : REAL; VAR counts : REAL: BEGIN counts := Omreken(countStr): IF (mode = 'labda') THEN BEGIN IF typeLaser.1TypeNr = 'HP5528' THEN OmrekenMaster := «counts * master.golfLen * 1E-2)/(40» ELSE OmrekenMaster:= counts; END ELSE OmrekenMaster := «counts * master.golfLen * 1E-2)/(40 * brIndex»: END; FUNCTION OmrekenTestLaser(countStr,mode : STRING; typeLaser : laserType) : REAL; VAR counts : REAL: BEGIN counts := Omreken(countStr): IF typeLaser.adres = 10000 THEN OmrekenTestLaser .- counts; IF typeLaser.1TypeNr = 'HP550l' THEN BEGIN
-87-
BIJLAGE 3
UNIT VergelijkingsMetina
END; IF typeLaser.1TypeNr = 'HP5526' THEN BEGIN IF mode = 'labda' THEN OmrekenTestLaser .- counts * 1E-1 ELSE OmrekenTestLaser := counts • 1E-5; END; IF typeLaser.1TypeNr = 'HP5528' THEN OmrekenTestLaser := counts; END; PROCEDURE SchrijfNaarFile(richting,mode : STRING; j,countsM, countsT,verschil : REAL); BEGIN IF richting = 'Heenweg' THEN BEGIN IF mode <> 'labda' THEN j := countsM; Write(fil1,countsM); Write(fi12,countsT); Write(fi13,j); Write(fi13,verschil); END ELSE BEGIN IF mode <> 'labda' THEN j := countsM; Write(fi14,countsM); Write(fi15,countsT): Write(fi16,j); WriteCfi16,verschil); END: END: PROCEDURE Metingen{richting : STRING; typeLaser mode: STRING); LABEL 1; VAR countStrM, acVolStr, countStrT countsM, countsT, 110,120, verschi1, nu1,j
1aserType:
waarde:
REAL:
BEGIN ,, countStrM := ' , , countStrT := ' PrintVergKop(richting): nul : = 0.0: countStrM := ReadLaser(master, 'Y'); countStrT := ReadLaser(typeLaser, 'N'): IF (countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN BEGIN fout := TRUE: GOTO 1: END: 110 := OmrekenMaster(countStrM,mode,typeLaser); 120 := OmrekenTestLaser(countStrT,mode,typeLaser); countsM := ABS(110 - 110): countsT := ABS(120 - 120); verschi1 := countsM - countsT; WriteLN(LST, '0' ,CHR(9),countsM:10:komma,CHR(9), countsT:l0:komma,CHR(9),verschi1:10:komma): Verp1aatsingOpschermCO,countsM,countsT,verschi1);
. .
-88-
8IJLAGE 3
UNIT Verge1ijkingsMeting
OutTextXY(Round(maxX/30),Round(9*maxY/10), 'VOL : '); SchrijfNaarFi1e(richting,mode,nu1,countsM,countsT, verschi1}; FOR i := 1 TO 30 DO BEGIN Verp1aats(richting) ; countStrM := ReadLaser{master, 'Y'): countStrT := ReadLaser(typeLaser, 'N')i IF (countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN BEGIN fout := TRUE; GOTO 1; END; countsM := ABS(OmrekenMaster(countStrM,mode,typeLaser) 110) ; countsT := A8S(OmrekenTestLaser(countStrT,mode,typeLaser) - 120): verschi1 := countsM - countsT; WriteLN(LST,i,CHR(9),countsM:10:komma,CHR(9) , countsT:10:kornrna,CHR(9) ,verschi1:10:komma); Verp1aatsingOpscherm(i,countsM,countsT,verschi1); j
:= i
*
1.0;
SchrijfNaarFi1e(richting,mode,j,countsM,countsT, verschi1); END; 1:
END: FUNCTION GetHP5528Set(mode : STRING) VAR resolutie, preset,vo1HP5528
string255;
STRING[30];
BEGIN STR(5,resolutie}; STR(O,preset): IF mode = 'mac' THEN GetHP5528Set := 'Ml,VL, '+preset+'Pl, '+ resolutie+ 'Rl,D2,UM,RS,Cl,Al' ELSE BEGIN STR(1000.0:1:1,volHP5528); GetHP5528Set := 'H1, '+vo1HP5528+'VL, '+preset+'P1, '+ resolutie+ 'R1,D2,UM,RS,CO,AO'; END; END; PROCEDURE MeetVerg(operator,vergFile,index,mode : STRING; typeLaser,refractoType : laserType); LABEL 1; BEGIN Verp1aatsVanLaser: RepresentHe1pPage(35,fi1eWithHelp): StopVerp1aatsen: maakGrafFile(vergFi1e,typeLaser,mode,index): IF mode = 'labda' THEN IF typeLaser.lTypeNr = 'HP5528' THEN kornrna .- 5 ELSE komma := :2
-89-
UNIT VergelijkingsMeting
BIJLAGE 3
ELSE komma := 5; fout := FALSE; rich := 'Heenweg': IF mode = 'mac' THEN BEGIN ASSIGN(filAuc, 'a:\' + vergFile + '.AUC'); REWRITE(filAuc): END: ASSIGN(fil1, 'a:\'+vergFile+'l.DTA'): ASSIGN(fi12, 'a:\'+vergFile+'2.DTA'); ASSIGN(fi13, 'a:\'+vergFile+'3.DTA'); ASSIGN(fi14, 'a:\'+vergFile+'4.DTA'); ASSIGN(fi15, 'a:\'+vergFile+'5.DTA'): ASSIGN(fi16, 'a:\'+vergFile+'6.DTA'): REWRITE(fil1); REWRITE(fi12); REWRITE(fi13); REWRITE(fi14); REWRITE(fi15); REWRITE(fi16): IF typeLaser.1TypeNr = 'HP5528' THEN typeLaser.1Set .GetHP5528Set(mode); SetLaser(master, 'Y'); SetLaser(typeLaser, 'N'): IF fout = FALSE THEN BEGIN GetVolWaarden(index,mode,typeLaser,refractoType); IF fout = TRUE THEN GOTO 1; MaakVerg1File (operator,vergFile,index,mode, typeLaser, refractoType, volCor,acVol): PrintTekst(vergFile +'1'); VergelijkingsmetingScherm('Heenweg' ,mode,index): Metingen('Heenweg' ,typeLaser,mode); VerplaatsNaarLaser; Delay(3000); StopVerplaatsen; Delay(5000); IF fout = FALSE THEN GetVolWaarden(index,mode,typeLaser,refractoType); IF fout = FALSE THEN BEGIN MaakVerg2File(index,mode,volCor,acVol): PrintTekst(vergFile + '2'); Vergelijkingsmetingscherm('Terugweg' ,mode, index) : Metingen('Terugweg' ,typeLaser,mode): WriteLN(LST,ster20+ster20+ster20+ster20) ; END; END: 1:IF mode = 'mac' THEN CLOSE(filAuc): CLOSE(fi11); CLOSE(fi12): CLOSE(fi13); CLOSE(fi14); CLOSE(fi15): CLOSE(fi16): END; PROCEDURE DriftOpScherm(countsM,countsT
REAL: i
BEGIN SetColor(black): OutTextXY(Round(maxX/4) ,Round{5*maxY/10) ,nr); OutTextXY (Round (maxX/4) ,Round(6*maxY/10) ,cMnr): OutTextXY(Round(maxX/4) ,Round(7*maxY/lO},cTnr); SetColor(white); STR{i,nr): STR(countsM:lO:komma,cMnr): STR(countsT:10:komma,cTnr):
-90-
INTEGER):
BIJLAGE 3
UNIT VergelijkingsMeting OutTextXY(Round(maXX/4),Round(5*maxY/10),nr) ; OutTextXY(Round(maxX/4) ,Round(6*maxY/10),cMnr): OutTextXY(Round(maxX/4),Round(7*maxY/10),cTnr); END:
PROCEDURE MeetNulPuntsDrift(typeLaser : laserType: tijdsd, smpT : INTEGER ); LABEL 1; VAR filD1,filD2 countStrM, countStrT,wT,nM countsT,countsM, verschil,110, l20,tijd nrMeting wachtT,i,j diagramText diagramFile
FILE OF REAL; waarde; REAL; INTEGER; INTEGER; diagramTextType: realFileArray;
BEGIN Write(LST,CHR(27) ,CHR(64»; Write(LST,CHR(27) ,CHR(68) ,CHR{l) ,CHR(14) ,CHR(27) ,CHR(35), CHR (0) ) ; WriteLN(LST,CHR(9),' [uren]' ,CHR(9), 'TUE-laser' ,CHR(9), 'Te testen laser' ,CHR(9), 'verschil'); tijd := 0; komma := 1: ASSIGN(filD1, 'a:\Drift1.DTA'); ASSIGN(filD2, 'a:\Drift2.DTA'); REWRITE(filD1): REWRITE(filD2): RepresentHelpPage(58,fileWithHelp) : IF typeLaser.1TypeNr = 'HP5528' THEN BEGIN typeLaser.1Set := GetHP5528Set('labda'); komma := 5; END; SetLaser(master, 'Y'); SetLaser{typeLaser, 'N'): nrMeting := (tijdsd * 60) DIV smpT: wachtT := smpT * 60; STR(wachtT,wT); STR(nrMeting,nM): MaakKader('Nulpuntsdriftmeting') ; OutTextXY(Round(maxX/30) ,Round(3*maxY/10), 'Aantal'+ , metingen: '+nM); OutTextXY (Round (maxX/30) ,Round(4*maxY/10), 'Sampletijd : '+ wT) ; OutTextXY{Round(maxX/30) ,Round(5*maxY/10), 'Meting : '): OutTextXY(Round(maXX/30) ,Round{6*maxY/10), 'TUE-laser :'); OutTextXY (Round (maxX/30) ,Round(7*maxY/10), 'Te testen'+ , laser: '); countStrM := ReadLaser(master, 'Y'); countStrT := ReadLaser(typeLaser,'N'); IF(countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN GOTO 1: 110 := OmrekenMaster(countStrM, 'labda' ,typeLaser); 120 := OmrekenTestLaser(countStrT, 'labda' ,typeLaser); countsM := 0; countsT := 0; Write(filD1,tijd); Write(filD2,tijd);
-91-
BIJLAGE 3
UNIT Verge1ijkingsMeting
Write(fi1D1,countsM); Write(fi1D2,countsT); FOR i := 1 TO nrMeting DO BEGIN FOR j := 1 TO wachtT DO De1ay(1000); tijd := tijd + wachtT/3600; countStrM := ReadLaser(master, 'Y'); countStrT := ReadLaser(typeLaser, 'N'); IF (countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN GOTO 1; countsM := OmrekenMaster(countStrM, 'labda' ,typeLaser) 110; countsT := OmrekenTestLaser(countStrT, 'labda' ,typeLaser) - 120; verschi1 := countsM - countsT; Write(fi1D1,tijd); Write(fi1D2,tijd); Write(fi1D1,countsM); Write(fi1D2,countsT}; DriftOpScherm(countsM,countsT,i); WriteLN(LST,CHR(9) ,tijd:4:2,CHR(9) ,countsM:10:komma, CHR(9) ,countsT:10:komma,CHR(9), verschi1:10:komma); END; WriteLN(LST,ster20+ster20+ster20+ster20); diagramText[l] := 'Nu1puntsdrift'; diagramText[2] := typeLaser.1TypeNr; diagramText[3] .- 'Nu1puntsdrift van' + typeLaser.1TypeNr; diagramText[4] := 'Aanta1 metingen: '+nM+'; Samp1etijd: ' +wT+' [min]'; diagramText[5] :=' '; ,, diagramText(6] := diagramText[7] .- 'Drift' ; diagramText[B] := , [uren] , i diagramFi1e[1] := 'Drift2' ; CLOSE(fi1Dl)i CLOSE (fi1D2) ; TekenGrafiek(diagramText,diagramFi1e,1,0)i diagramText[2] := 'TUE-laser'i diagramText[3] := 'Nulpuntsdrift van TUE-1aser'; diagramFile[1] := 'Drift1'; TekenGrafiek(diagramText,diagramFi1e,1,O);
.
1:
END; PROCEDURE ZetVolWaarden(typeLaser VAR vol volC
laserType;
REAL; STRING[10];
BEGIN IF typeLaser.lTypeNr = 'HP5528' THEN BEGIN vol := 650 + 10 * (i - 1); STR(vol:l:l,volC); ZendIEEE(typeLaser.adres,vo1C+'VL') END ELSE RepresentHelpPage(i + 199, fi1eWithHe1p) i END:
-92-
i
INTEGER) ;
BIJLAGE 3
UNIT VergelijkingsMeting
PROCEDURE MeetVolCor(operator,index : STRING; typeLaser, ref Type : laserType); LABEL 1; VAR countStrM, countStrT countsM, countsT, 110,120, vo1Waarde
waarde;
REAL;
BEGIN fout := FALSE; MaakKader('VOL-correctie meting'); MaakVo1CorFile(operator,index,typeLaser,refType); PrintTekst('VolCor'); VerplaatsVanLaser; RepresentHelpPage(35,fileWithHelp) ; StopVerplaatsen; Delay(5000) ; IF typeLaser.1TypeNr = 'HP5528' THEN typeLaser.1Set := GetHP5528Set('zac'); SetLaser{master, 'Y'); SetLaser(typeLaser, 'N'); GetVol Waard'en (index, , zac ' , typeLaser, ref Type ) ; IF fout = FALSE THEN BEGIN WriteLN(LST, 'Echte brekingsindex : ',brIndex:l0:9) i WriteLN(LST, 'Echte VOL-waarde : ' ,volCor:6:2); WriteLN(LST,streep+streep+streep+streep); Write(LST,CHR(27) ,CHR(64}); Write(LST,CHR(27) ,CHR(68) ,CHR(l) ,CHR(7} ,CHR{20} ,CHR(35), CHR(O» ; WriteLN(LST,CHR(9) 'VOL' ,CHR(9) ,CHR(9l , 'TUE-laser', CHR(9), 'Te testen laser-VOL.cor'); WriteLN(LST,streep+streep+streep+streep) ; countStrM := ReadLaser(master, 'Y'); countStrT := ReadLaser(typeLaser, 'N'); IF (countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN GOTO 1; 110 := OmrekenMaster(countStrM, 'mm' ,typeLaser); 120 := OmrekenTestLaser(countStrT, 'mm' ,typeLaser); VerplaatsNaarLaser; DELAY(TRUNC(820/30*1000» ; StopVerplaatsen; Delay(15000) ; countStrM := ReadLaser(master, 'Y'); countStrT := ReadLaser(typeLaser, 'N'); IF (countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN GOTO I
1;
countsM := ABS(OmrekenMaster(countStrM, 'mm' ,typeLaser) 110) ; countsT .- ABS(OmrekenTestLaser(countStrT, 'mm' ,typeLaser) -120) ; WriteLN(LST,CHR(9) ,vo1Cor:6:2,CHR(9) ,countsM:10:5, CHR(9) ~countsT:10:5}; WriteLN(LST,streep+streep+streep+streep) ; FOR i := 1 TO 17 DO
-93-
UNIT Verge1ijkingsMeting
BIJLAGE 3
BEGIN ZetVo1Waarden(typeLaser,i); countStrM := ReadLaser(master, 'Y'); countStrT := ReadLaser(typeLaser,'N'): IF (countStrM = 'FOUT') OR (countStrT = 'FOUT') THEN GOTO 1: countsM .- ABS(OmrekenMaster(countStrM, 'rom' ,typeLaser) - 110); countsT .- ABS(OmrekenTestLaser(countStrT, 'rom', typeLaser) - 120); vo1Waarde := 650+10*(i-1): WriteLN(LST,CHR(9) ,vo1Waarde:6:2,CHR(9) , countsM:10:5,CHR(9) ,countsT:l0:5); END: END: WriteLN(LST,ster20+ster20+ster20+ster20) ; 1:
END: END.
-94-
BIJLAGE 3
HOOFDPROGRAMMA 3.14 HET HOOFDPROGRAMMA PROGRAM Laser; ($M,65520,O,6553601 USES Crt, Dos, Graph, MyGlobals, Service, math1, GraphEx1, Filer, InputDa1, TekstFiles, Verwerk, LaserInterface, SpiegelVerpl, FrequentieMeting, VergelijkingsMeting; CONST
PORT1R PORT2R
VAR integ,i,t nr klant laserNr, displayNr, compNr,airSen tempSen,kabel aantalKabels aantalTempSen finished break aantalFM aantalM dip tpLaser, frDip tijdsduur sampleTijd tdsduur,smpTd brIndex refractoType
= $1B3;
= $1B7; INTEGER; STRING[lJ; klantType; materType; senKabType; INTEGER; INTEGER; BOOLEAN; BOOLEAN; INTEGER; INTEGER: REAL; answerType: REAL; REAL: INTEGER; STRING; laserType:
PROCEDURE Intro; BEGIN Fullport: SetColor(white); DrawBorder(white): Settextstyle(Triplexfont,Horizdir,5); Settextjustify(centertext,centertext); OutTextXY(succ(getmaxX) div 2, round(MaxY/10*1.7), 'Kalibratieopstelling') : OutTextXY(succ(getmaxX) div 2,round( maxY/10*5.0),
-95-
BIJLAGE 3
HOOFDPROGRAMMA
'voor laserinterferometers'); Settextstyle(Smallfont,Horizdir,5); OutTextXY(round(maxX/10*3.5),round( maxY/10*7.0), 'Version 2.0. Last update october 3th 1988'); OutTextXY(round(MaxX/10*3.5) ,round ( MaxY/10*8.0), 'R.T.E. Muit, G.C.M. van der Ven'}; OutTextXY(round(maxX/10*3.5) , round ( maxY/10*8.5), 'Metrology Laboratory'): OutTextXY(round(MaxX/10*3.5) ,round( maxY/10*9.0), 'Faculty of Mechanical Enginering')i OutTextXY(round(MaxX/10*3.5),round( maxY/10*9.5), 'Eindhoven University of Technology'); TueLogo(round(MaxX/10*7.0) ,round(MaxY/10*7.0), round(MaxX/10*9.5) ,round(MaxY/10*9.5) ,white,4,white,false); REPEAT UNTIL readkey = return; END; PROCEDURE InvoergegevensLaser; LABEL 1,2,3,4; VAR aantal INTEGER: questSet : INTEGER; PROCEDURE ChangeSenKabQuestions(a,b,c: INTEGER; kabelTemp: STRING) : LABEL 5; BEGIN IF c = 1 THEN questSet .- 3 ELSE questSet := 5; t
:= 1;
FOR i:= a TO b DO BEGIN STR (i, nr) ; ansQuest.question[t] := kabelTemp + nr + ': typenummer'; t := t+2; END; PutQuestion(questSet,ansQuest}; 5:Questions(answers,questSet,fileWithQuest,ifail) ; IF ifail = 3 THEN GOTO 5; t
:= 1;
FOR i := a TO b DO BEGIN IF c = 1 THEN BEGIN tempSen[i].typenummer := answers[t]; tempSen[i].serienummer := answers[t+l): t := t + 2: END ELSE BEGIN kabel[i] .typenummer := answers[t]; kabel[i).serienummer := answers[t + 1]; t
:= t + 2:
END: END; END;
-96-
HOOFDPROGRAMMA
BIJLAGE 3
BEGIN 1:Questions(answers,2,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 1; laserNr.typenummer := answers[l]; laserNr.serienummer .- answers[2); displayNr.typenummer .- answers[3]; displayNr.serienummer := answers[4J: compNr.typenummer .- answers[S]; compNr.serienummer .- answers [6] ; VAL (answers [8] ,aantalKabels,integ); VAL (answers [7] ,aantalTempSen,integ); IF (ifail = 0) AND (aantalTempSen > 0) THEN BEGIN 2: GetQuestion(3,ansQuest); IF aantalTempSen > 4 THEN aantal := 4 ELSE aantal .aantalTempSen; ansQuest.numQuest := aantal * 2; ChangeSenKabQuestions(l,aantal,l, 'Temp.sensor '); IF (ifail <> 0) THEN GOTO 1; IF aantalTempSen > 4 THEN BEGIN GetQuestion(3,ansQuest); ansQuest.numQuest := (aantalTempSen - 4) * 2; ChangeSenKabQuestions(S,aantalTempSen,l, 'Temp.sensor '); IF (ifail <> 0) THEN GOTO 2; END; END ELSE break := FALSE; IF (ifail = 0) AND (aantalKabels > 0) THEN BEGIN 3: GetQuestion(S,ansQuest); IF aantalKabels > 4 THEN aantal := 4 ELSE aantal := aantalKabels; ansQuest.numQuest := aantal * 2; ChangeSenKabQuestions(l,aantal,2, 'Kabel '): IF (ifail <> 0) THEN GOTO 1 ELSE break := TRUE; IF aantalKabels > 4 THEN BEGIN GetQuestion(5,ansQuest) ; ansQuest.numQuest := (aantalKabels - 4) * 2; ChangeSenKabQuestions{5,aantalKabels,2, 'Kabel '); IF (ifail <> 0) THEN GOTO 3 ELSE break := TRUE; END; END; IF (ifail = 0) THEN BEGIN 4: Questions(answers/l8,fileWithQuest,ifail): IF ifail = 3 THEN GOTO 4; IF ifail = 0 THEN BEGIN airSen.typeNummer := answers[l]; airSen.serieNummer := answers[2]; MaakKlantFile(klant,laserNr,displayNr,compNr,tempSen, kabel ,aantalTempSen, aantalKabels,airSen) ; PrintTekst('klant'); END; END; END;
-97-
BIJLAGE 3
HOOFDPROGRAMMA PROCEDURE InvoergegevensKlant; LABEL 1;
BEGIN break := TRUE; REPEAT 1: questions(answers,l,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 1; klant.naam := answers [1] ; klant.adres := answers [2] ; klant.plaats := answers [3] ; klant.telefoon := answers [4] ; IF (ifail = 0) THEN InvoergegevensLaser ELSE break := TRUE; UNTIL break = TRUE; END; PROCEDURE SpiegelVerplaatsen; VAR finished : BOOLEAN; BEGIN finished := FALSE; REPEAT QuestMenu.numoptions := 4; QuestMenu.option[l] .- 'Naar de laser toe verplaatsen'; QuestMenu.option[2] := 'Van de laser af verplaatsen'; QuestMenu.option[3] := 'Stop verplaatsen'; QuestMenu.option[4] := 'Terug naar hoofd-menu'; QuestMenu.title := 'Spiegel verplaatsen'; CASE Menu(QuestMenu,3) OF 1 VerplaatsNaarLaser; 2 VerplaatsVanLaser; 3 StopVerplaatsen; ELSE BEGIN StopVerplaatsen; finished := TRUE; END; END; UNTIL finished = TRUE; END; FUNCTION OmrFreqDip(freqDip
STRING)
VAR d : CHAR; BEGIN d := freqDip[l]; CASE d OF 'a', 'A' OmrFreqDip 'b', 'B' OmrFreqDip 'c', 'C' OmrFreqDip 'd', 'D' OmrFreqDip 'e', 'E' OmrFreqDip 'f' , 'F' OmrFreqDip 'g', 'G' OmrFreqDip 'h', 'H' OmrFreqDip
.-
aDip;
:= bDip; := cDip; := dDip;
.- eDip; := fDip; := gDip; .-- hDip;
.
-98-
REAL;
BIJLAGE 3
HOOFDPROGRAMMA 'i','I' OmrFreqDip:= iDip: 'j', 'J' OmrFreqDip.- jDip; 'k' , 'K' OmrFreqDip:= kDip: '1', 'L' OmrFreqDip:= 1Dip; 'm' , 'M' OmrFreqDip:= mDipi 'n', 'N' OmrFreqDip:= nDip; ELSE BEGIN RepresentHe1pPage(1,fi1eWithHe1p); break := TRUE; END; END; END; PROCEDURE Frequentie; LABEL 1,2;
BEGIN l:break := FALSE; REPEAT Questions(answers,4,fi1eWithQuest,ifai1); IF ifai1 = 3 THEN GOTO 1; operator := answers[l]; freqFi1e := answers [2] ; frDip := answers [3] ; VAL (answers [4] ,aanta1M,integ); dip := OmrFreqDip(frDip); UNTIL break = FALSE; IF ifai1 = 0 THEN BEGIN IF ExistFreqFi1e(freqFi1e) = TRUE THEN BEGIN RepresentHelpPage{30,fileWithHelp); FileMenu: GOTO 1; END; 2: QuestMenu.numoptions:= 2; QuestMenu.option[l) := 'Verschilfrequentie op poort A'; QuestMenu.option[2] := 'Verschilfrequentie op poort B'; QuestMenu.tit1e .- 'Welke poort van het frequentie-display?'; CASE Menu(QuestMenu,l) OF 1: poort:= poortA; 2: poort:= poortB; ELSE GOTO 1: END; QuestMenu.numoptions := 3; QuestMenu.option[l] := 'Sample tijd : 0.1 sec.'; QuestMenu.option[2] := 'Sample tijd: 1 sec,'; QuestMenu.option[3] := 'Sample tijd: 10 sec. '; QuestMenu.title := 'Wat is de sample tijd?': CASE Menu(QuestMenu,l) OF 1: sampleT:= t01; 2: sampleT:= t1; 3: sampleT:= t10; ELSE GOTO 2; END; MaakFreqFi1e(operator,freqFile,samp1eT,aanta1M,frDip);
-99-
BIJLAGE 3
HOOFDPROGRAMMA
PrintTekst(freqFile); MeetFrequentie(freqFile,aantalM,poort,sampleT,dip); END; END; PROCEDURE VerwerkFrequentie; LABEL 1,2,3; VAR i, aantal verwFile nr ready
INTEGER; fileArray; STRING[2]; BOOLEAN:
BEGIN REPEAT 1: Questions(answers,6,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 1; VAL (answers [1] ,aantalMet,integ): IF ifail = 0 THEN BEGIN GetQuestion(7,ansQuest): IF aantalMet > 8 THEN aantal := 8 ELSE aantal := aantalMet: ansQuest.numQuest := aantal; FOR i := 1 TO aantal DO BEGIN STR (i, nr) ; ansQuest.question[i] .- 'Frequentiemeting-file ' + nr; END; PutQuestion(7,ansQuest); 2: Questions (answers,7,fileWithQuest,ifail) ; IF ifail = 3 THEN GOTO 2; IF ifail <> 0 THEN GOTO 1; FOR i := 1 TO aantal DO verwFile[i] := answers[i]: IF aantalMet > 8 THEN BEGIN GetQuestion(7,ansQuest) ; ansQuest.numQuest := aantalMet - 8; FOR i := 9 TO aantalMet DO BEGIN STR (i, nr) ; ansQuest.question[i-8] := 'Frequentiemeting-file ' + nr; END; PutQuestion(7,ansQuest); 3: Questions(answers,7,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 3: FOR i := 9 TO aantalMet DO verwFile[i] := answers[i - 8]; END: END ELSE ready := TRUE; IF ifai1 = 0 THEN VerwerkFreqMet(aantalMet,verwFile,ready): UNTIL ready = TRUE; END;
-100-
BIJLAGE 3
HOOFDPROGRAMMA
PROCEDURE Inschakelverschijnselen; LABEL 1,2; BEGIN 1:Questions(answers,8,fileWithQuest,ifail); IF if ail = 3 THEN GOTO 1; IF ifail = 0 THEN BEGIN operator := answers [1] ; frDip := answers[2); VAL (answers [3] ,tijdsduur,integ); VAL (answers [4] ,sampleTijd,integ); 2: QuestMenu.numoptions := 2; QuestMenu.option[l] := 'Verschilfrequentie op poort A'; QuestMenu.option[2] := 'Verschilfrequentie op poort B'; QuestMenu.title := 'Welke poort van het'+ , frequentie-display?'; CASE Menu (QuestMenu, 1) OF 1: poort := poortA; 2: poort := poortB; ELSE GOTO 1: END; QuestMenu.numoptions := 3: QuestMenu.option[l) := 'Sample tijd 0.1 sec. '; QuestMenu.option[2) := 'Sample tijd 1 sec. '; QuestMenu.option[3) := 'Sample tijd 10 sec. '; QuestMenu.title := 'Wat is de sample tijd?'; CASE Menu(QuestMenu,l} OF 1: sampleT:= t01: 2: sampleT:= t1: 3: sampleT:= tl0; ELSE GOTO 2; END; MaakInschakelFile(operator,frDip,tijdsduur,sampletijd) ; PrintTekst('inschakel'); MeetInschakel{tijdsduur,sampleTijd,poort,sampleT); END; END; PROCEDURE FreqMeting; VAR finished : BOOLEAN; BEGIN finished := FALSE; REPEAT QuestMenu.numoptions := 5; QuestMenu.option[l] := 'Meting van van de'+ , verschilfrequentie'; QuestMenu.option[2] .- 'Verwerking van meerdere'+ , frequentiemetingen'; QuestMenu.option[3] .- 'Bepalen van de Allen Variance'; QuestMenu.option[4] := 'Volgen van de'+ , inschakelverschijnselen'; QuestMenu.option[5] := 'Terug naar het hoofd-menu'; QuestMenu.title := 'Frequentiemetingen';
-101-
BIJLAGE 3
HOOFDPROGRAMMA CASE Menu(QuestMenu,l) OF 1 Frequentie: 2 VerwerkFrequentie; 3: AllenVariance; 4: InschakelVerschijnselen; ELSE finished := TRUE; END; UNTIL finished = TRUE; END; PROCEDURE InitRefractometer; LABEL 1,2; VAR fil : FILE OF REAL;
BEGIN l:QuestMenu.numoptions := 2; QuestMenu.option[l] := 'HP5501'i QuestMenu.option[2] := 'HP5526': QuestMenu.title := 'Welke laser staat voor de'+ , refractometer?': CASE Menu(questMenu,l) OF 1 : refractoType:= refHP5501; 2: refractoType:= refHP5526; ELSE BEGIN refractoType.ITypeNr .- 'fout': GOTO 2; END; END: QuestMenu.numoptions := 2: QuestMenu.option[l] := 'Ja'; QuestMenu.option[2] := 'Nee'; QuestMenu.title := 'Nulwaarde van de refractometer opnieuw' +' bepalen?'; CASE Menu(questMenu,l) OF 1 nuIWaarde:= SetRefractometer(refractoType}; 2 : BEGIN ASSIGN(fil, 'c:\turbo4\gerard\nulwaard.ref'); RESET(fil); READ(fil,nulWaarde) ; CLOSE (fil) ; END; ELSE GOTO 1; END: 2: END; PROCEDURE VergGegevens(index,mode : STRING;typeLaser laserType); LABEL 1,2; VAR
fil
FILE OF REAL:
BEGIN IF index = 'Refractometer' THEN InitRefractometer: IF refractoType.1TypeNr = 'fout' THEN GOTO 2:
-102-
HOOFDPROGRAMMA
BIJLAGE 3
l:Questions!answers,lO,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 1; IF ifail = 0 THEN BEGIN operator := answers[1]; vergFile := answers[2); IF ExistVergFile(vergFile) = TRUE THEN BEGIN RepresentHelpPage(30,fileWithHelp); FileMenu; GOTO 1; END; MeetVerg(operator,vergFile,index,mode,typeLaser, refractoType); MaakGrafiek(vergFile,1); END; 2:
END; PROCEDURE VolCorrectie(index : STRING;typeLaser ref Type : laserType); LABEL 1; VAR operator
laserType;
STRING;
BEGIN 1:Questions(answers,19,fileWithQuest,ifail); IF ifail = 3 THEN GOTO 1; IF ifail = 0 THEN BEGIN operator := answers[l]; MeetVolCor(operator, index, t ypeLaser, ref Type); END; END; FUNCTION RefrEdlen
STRING;
BEGIN QuestMenu.nurnoptions := 2; QuestMenu.option[1] := 'Werkelijke brekingsindex met'+ , Edlen-forrnule'; QuestMenu.option[2] := 'Werkelijke brekingsindex met'+ , refractometer'; QuestMenu.title := 'Werkelijke brekingsindex?'; CASE Menu(questMenu,l) OF 1 : RefrEdlen:= 'Edlen-forrnu1e'; 2: RefrEd1en:= 'Refractometer'; END; END;
-103-
BIJLAGE 3
HOOFDPROGRAMMA laserType);
PROCEDURE NulPuntsDrift{typeLaser LABEL 1;
BEGIN 1:Questions(answers,9,fileWithQuest,ifail) ; IF ifail = 3 THEN GOTO 1; IF ifail = 0 THEN BEGIN operator := answers[l]; VAL (answers [2] ,tdsDuur,integ); VAL(answers[3],smpTd,integ); MaakDriftFile(operator, tdsduur, smpTd); Printtekst('Drift'); MeetNulPuntsDrift{typeLaser,tdsduur,smpTd); END; END; PROCEDURE VergelijkHP5501; LABEL 1; BEGIN break := FALSE; REPEAT 1: QuestMenu.numoptions:= 2; QuestMenu.option[1] := 'HP5501 met counterkaart'; QuestMenu.option[2] := 'HP5501 met counterkaart en'+ , IEEE-interface': QuestMenu.title := 'Interfacing van de HP5501'; CASE Menu(QuestMenu,1) OF 1: BEGIN RepresentHelpPage(10,fileWithHelp) ; HP5501.1set := '006C1C2C30'; HP5501.adres := master.adres; END; 2 BEGIN RepresentHelpPage(11,fileWithHelp); HP5501.1set .- '006A1A2A30'; HP5501.adres := 4: END; ELSE break := TRUE; END; IF break = FALSE THEN REPEAT break := TRUE: QuestMenu.numoptions := 4; QuestMenu.option[1] := 'HP5501 in Labda-mode'; QuestMenu.option[2] .- 'HP5501 in mm-mode zonder'+ , autom. comp.'; QuestMenu.option[3] := 'HP5501 in mm-mode met'+ • autom.comp.·: QuestMenu.option[4] .- 'Nulpuntsdrift'; QuestMenu.title := 'HP5501 vergelijkingsmeting'; CASE Menu(QuestMenu,1) OF 1: BEGIN RepresentHelpPage (110, fileWithHelp) ; vergGegevens ( , , 'labda' , HP5501) i I
-104-
BIJLAGE 3
HOOFDPROGRAMMA
END; BEGIN RepresentHelpPage(lll,fileWithHelp); brIndex := RefrEdlen; vergGegevens(brIndex, 'zac' ,HP5501); END: 3 BEGIN RepresentHelpPage(112,fileWithHelp); brIndex := RefrEdlen; vergGegevens(brIndex, 'mac' ,HP5501); END; 4 BEGIN RepresentHelpPage(110,fileWithHelp); Nulpuntsdrift(HP5501); END; ELSE break := FALSE; END; UNTIL break = FALSE; UNTIL break = TRUE; END; PROCEDURE VergelijkHP5526; BEGIN QuestMenu.numoptions := 5; QuestMenu.option[l] := 'HP5526 in Labda-mode'; QuestMenu.option[2] := 'HP5526 in mm-mode zonder autom. '+ comp.'; QuestMenu.option[3] .- 'HP5526 in mm-mode met autom.comp. '; QuestMenu.option[4] .- 'Nulpuntsdrift'; QuestMenu.option[5] := 'Test duimwielen vol. correctie'; QuestMenu.title := 'HP5526 vergelijkingsmeting'; CASE Menu(QuestMenu,l) OF l : BEGIN RepresentHelpPage(115,fileWithHelp); vergGegevens ( • • , , labda ' , HP5526) ; END; 2 BEGIN RepresentHelpPage(116,fileWithHelp); brIndex := RefrEdlen; vergGegevens(brIndex, 'zac' ,HP5526); END; 3 BEGIN RepresentHelpPage(117,fileWithHelp): brIndex := RefrEdlen; vergGegevens(brIndex, 'mac' ,HP5526); END; 4 BEGIN RepresentHelpPage(115,fileWithHelp); NulpuntsDrift(HP5526); END; 5 BEGIN RepresentHelpPage(116,fileWithHelp); brIndex := RefrEdlen; IF brIndex = 'Refractometer' THEN InitRefractometer; VolCorrectie{brlndex,HP5526,refractoType); END; END; END; 2
I
-105-
HOOFDPROGRAMMA
BIJLAGE 3
PROCEDURE VergelijkHP5528; BEGIN QuestMenu.numoptions := 5; QuestMenu.option[l] := 'HP5528 in mm-mode met'+ , brekingsindex I'; QuestMenu.option[2] := 'HP5528 in mm-mode zonder'+ , autom.comp. ': QuestMenu.optionl3] := 'HP5528 in mm-mode met autom.comp.'; QuestMenu.option[4] := 'Nulpuntsdrift'; QuestMenu.option[5] := 'Test vol. correctie'; QuestMenu.title := 'HP5528 vergelijkingsmeting'; CASE Menu(QuestMenu,l) OF 1 vergGegevens(' ','labda' ,HP5528): 2: BEGIN brIndex := RefrEdlen; vergGegevens(brIndex, 'zac' ,HP5528) END; 3 BEGIN brIndex := RefrEdlen; vergGegevens(brIndex, 'mac' ,HP5528) END: 4 NulpuntsDrift(HP5528); 5 BEGIN brIndex := RefrEdlen; IF brIndex = 'Refractometer' THEN InitRefractometer; VolCorrectie(brIndex,HP5528,refractoType): END: END; END: PROCEDURE VergelijkAndere; BEGIN RepresentHelpPage(73.fileWithHelp) ; QuestMenu.numoptions := 5; QuestMenu.option[l] := 'Labda-mode'; QuestMenu.option[2] := 'mm-mode zonder autom.comp'; QuestMenu.option[3] := 'rom-mode met autom.comp.'; QuestMenu.option[4] := 'Nulpuntsdrift'; QuestMenu.option[5] := 'Test vol. correctie'; QuestMenu.title := 'Vergelijkingsmeting'; CASE Menu(QuestMenu,l) OF 1 : BEGIN RepresentHelpPage(120,fileWithHelp); vergGegevens(' " 'labda' ,andere): END; 2 BEGIN RepresentHelpPage(121,fileWithHelp); brIndex := RefrEdlen: vergGegevens(brIndex, 'zac' ,andere) END: 3 BEGIN RepresentHelpPage(122,fileWithHelp): brlndex := RefrEdlen; vergGegevens(brIndex. 'mac' ,HP5526); END; 4 BEGIN
-106-
BIJLAGE 3
HOOFDPROGRAMMA
5
END: END;
RepresentHelpPage(120,fileWithHe1p); NulpuntsDrift(andere); END; BEGIN RepresentHelpPage(121,fileWithHelp); brIndex := RefrEdlen: IF brIndex = 'Refractometer' THEN InitRefractometer: VolCorrectie(brIndex,andere,refractoType); END:
PROCEDURE VerwerkVergelijking; BEGIN QuestMenu.numoptions := 3; QuestMenu.option[l] .- 'meetwaarden'; QuestMenu.option[2] .- 'golflengte gecorrigeerde'+ , meetwaarden': QuestMenu.option[3] .- 'golflengte en brekingsindex'+ , gecorrigeerde meetwaarden': QuestMenu.title := 'Listing en grafiek van': CASE Menu(QuestMenu,l) OF 1 VerwerkVergMeting(l): 2 VerwerkVergMeting(2): 3 VerwerkVergMeting(3): END: END; PROCEDURE Vergelijkmeting: BEGIN break := TRUE; REPEAT ,, refractoType.1TypeNr := ' QuestMenu.numoptions := 6: QuestMenu.option[l] := 'Vergelijkingsmeting HP5501': QuestMenu.option[2] := 'Vergelijkingsmeting HP5526'; QuestMenu.option[3] := 'Vergelijkingsmeting HP5528': QuestMenu.option[4] := 'Vergelijkingsmeting Andere'+ , systemen'; QuestMenu.option[5] := 'Verwerk vergelijkingsmetingen'; QuestMenu.option[6] := 'Terug naar het hoofd-menu'; QuestMenu.title := 'Vergelijkingsmeting'; CASE Menu(QuestMenu,J) OF 1 VergelijkHP5501: 2 VergelijkHP5526: 3 VergelijkHP5528: 4 VergelijkAndere: 5 VerwerkVergelijking: ELSE break := FALSE: END: UNTIL break = FALSE; END:
.
-107-
