home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS - Coast to Coast / simteldosarchivecoasttocoast2.iso / turbopas / dates.pas < prev    next >
Pascal/Delphi Source File  |  1994-03-05  |  44KB  |  1,310 lines
  1. PROGRAM dates(input,output);
  2.   { Bruce Hillyer.  Keeps a list of memos.  Displays appropriate calendars.
  3.     Written for Turbo Pascal. }
  4.  
  5.   {$i zString.tur} { include null-terminated string routines }
  6.  
  7.   CONST
  8.     yearBase   = 1900; { add to 0..99 to get year }
  9.     memoMax    = 200;  { number of memos the program can hold }
  10.     display    = 12;   { number of memo lines to show under the calendar - 1 }
  11.     statusLine = 10;   { line for printing status }
  12.     promptLine = 11;
  13.     memoLine   = 12;
  14.     memoFileNm = '\dates.mem';  { file name to store memos, in root }
  15.  
  16.   TYPE
  17.     dayType   = 1..31;
  18.     monthType = 1..12;
  19.     yearType  = 100..10000;
  20.  
  21.     dateType = RECORD
  22.                  day : dayType;
  23.                  month : monthType;
  24.                  year : yearType
  25.                END;
  26.  
  27.     memoType = RECORD
  28.                  startDate : dateType;
  29.                  endDate : dateType;
  30.                  comment : zString
  31.                END;
  32.  
  33.     memoArrayType = ARRAY[0..memoMax] OF memoType; { 0 is not used }
  34.  
  35. VAR
  36.   { date-handling global constants }
  37.   monthName   : ARRAY[monthType] OF STRING[10]; { month names }
  38.   monthLen    : ARRAY[monthType] OF INTEGER;  { length of month names in chrs }
  39.   monthSize   : ARRAY[monthType] OF INTEGER;  { days per month }
  40.   monthOffset : ARRAY[monthType] OF INTEGER;  { days before 1st of the month }
  41.   dayName     : ARRAY[dayType] OF STRING[10];   { day names }
  42.   dayLen      : ARRAY[dayType] OF INTEGER;    { length of day names in chrs }
  43.   today       : dateType;
  44.   tomorrow    : dateType;
  45.  
  46.   { variables }
  47.   memoFile    : FILE OF memoType;
  48.   memoArray   : memoArrayType;
  49.   nMemo       : INTEGER;
  50.   finish      : BOOLEAN;
  51.   currentLine : INTEGER;
  52.   currentDate : dateType;
  53.   showingDate : dateType;
  54.   command     : zString;
  55.   pos         : zStringSub;
  56.  
  57.  
  58.  
  59.  
  60. PROCEDURE pause;
  61.   BEGIN GotoXY(1,25);
  62.         ClrEol;
  63.         Write(output,'  (press return to continue)');
  64.         WHILE NOT Keypressed DO { nothing }
  65.   END; { pause }
  66.  
  67.  
  68.  
  69.  
  70.  
  71. { ----------------------- date handling --------------------------- }
  72.  
  73. PROCEDURE initDateConstants;
  74.   BEGIN
  75.     monthName[1] := 'January   ';
  76.     monthName[2] := 'February  ';
  77.     monthName[3] := 'March     ';
  78.     monthName[4] := 'April     ';
  79.     monthName[5] := 'May       ';
  80.     monthName[6] := 'June      ';
  81.     monthName[7] := 'July      ';
  82.     monthName[8] := 'August    ';
  83.     monthName[9] := 'September ';
  84.     monthName[10]:= 'October   ';
  85.     monthName[11]:= 'November  ';
  86.     monthName[12]:= 'December  ';
  87.  
  88.     monthLen[1] := 7;
  89.     monthLen[2] := 8;
  90.     monthLen[3] := 5;
  91.     monthLen[4] := 5;
  92.     monthLen[5] := 3;
  93.     monthLen[6] := 4;
  94.     monthLen[7] := 4;
  95.     monthLen[8] := 6;
  96.     monthLen[9] := 9;
  97.     monthLen[10]:= 7;
  98.     monthLen[11]:= 8;
  99.     monthLen[12]:= 8;
  100.  
  101.     monthSize[1] := 31;
  102.     monthSize[2] := 28;
  103.     monthSize[3] := 31;
  104.     monthSize[4] := 30;
  105.     monthSize[5] := 31;
  106.     monthSize[6] := 30;
  107.     monthSize[7] := 31;
  108.     monthSize[8] := 31;
  109.     monthSize[9] := 30;
  110.     monthSize[10] := 31;
  111.     monthSize[11] := 30;
  112.     monthSize[12] := 31;
  113.  
  114.     monthOffset[1] := 0;
  115.     monthOffset[2] := 31;
  116.     monthOffset[3] := 59;
  117.     monthOffset[4] := 90;
  118.     monthOffset[5] := 120;
  119.     monthOffset[6] := 151;
  120.     monthOffset[7] := 181;
  121.     monthOffset[8] := 212;
  122.     monthOffset[9] := 243;
  123.     monthOffset[10] := 273;
  124.     monthOffset[11] := 304;
  125.     monthOffset[12] := 334;
  126.  
  127.     dayName[1] := 'Sunday    ';
  128.     dayName[2] := 'Monday    ';
  129.     dayName[3] := 'Tuesday   ';
  130.     dayName[4] := 'Wednesday ';
  131.     dayName[5] := 'Thursday  ';
  132.     dayName[6] := 'Friday    ';
  133.     dayName[7] := 'Saturday  ';
  134.  
  135.     dayLen[1] := 6;
  136.     dayLen[2] := 6;
  137.     dayLen[3] := 7;
  138.     dayLen[4] := 9;
  139.     dayLen[5] := 8;
  140.     dayLen[6] := 6;
  141.     dayLen[7] := 8;
  142.   END; { initDateConstants }
  143.  
  144.  
  145.  
  146. { ----- compare dates ----- }
  147.  
  148. FUNCTION dateLT(date1,date2 : dateType) : BOOLEAN;
  149.   { returns false if date2 is before date1 }
  150.   BEGIN  IF date1.year  < date2.year  THEN dateLT := TRUE
  151.     ELSE IF date1.year  > date2.year  THEN dateLT := FALSE
  152.     ELSE IF date1.month < date2.month THEN dateLT := TRUE
  153.     ELSE IF date1.month > date2.month THEN dateLT := FALSE
  154.     ELSE IF date1.day   < date2.day   THEN dateLT := TRUE
  155.     ELSE                   dateLT := FALSE
  156.   END; { dateLT }
  157.  
  158.  
  159.  
  160. FUNCTION dateEQ(date1,date2 : dateType) : BOOLEAN;
  161.   BEGIN
  162.     dateEq := (date1.year = date2.year) AND (date1.month = date2.month)
  163.               AND (date1.day = date2.day)
  164.   END; { dateEQ }
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171. { ----- date manipulation ----- }
  172.  
  173. FUNCTION leapYear(year : yearType) : BOOLEAN;
  174.   { tells if the given year is a leap year }
  175.   BEGIN  IF (year Mod 4000) = 0 THEN leapYear := FALSE
  176.     ELSE IF (year Mod  400) = 0 THEN leapYear := TRUE
  177.     ELSE IF (year Mod  100) = 0 THEN leapYear := FALSE
  178.     ELSE IF (year Mod    4) = 0 THEN leapYear := TRUE
  179.     ELSE                             leapYear := FALSE
  180.   END; { leapYear }
  181.  
  182.  
  183.  
  184. FUNCTION weekDay(date : dateType) : INTEGER;
  185.   { returns 1 for Sunday, 2 for Monday,...,7 for Friday }
  186.   VAR dayCnt, yearM1 : INTEGER;
  187.   BEGIN
  188.     dayCnt := date.day + monthOffset[date.month];
  189.     IF leapYear(date.year) AND (date.month > 2)
  190.       THEN dayCnt := dayCnt + 1;
  191.     yearM1  := date.year - 1;
  192.     weekDay := 1 + ((dayCnt + yearM1
  193.                      + (yearM1 Div 4) - (yearM1 Div 100)
  194.                      + (yearM1 Div 400) - (yearM1 Div 4000))       Mod 7)
  195.   END; { weekDay }
  196.  
  197.  
  198. PROCEDURE incrDate(inDate : dateType; VAR outDate : dateType);
  199.   { increment the input date by one day to get the output date }
  200.   BEGIN
  201.     outDate := inDate;
  202.     WITH outDate DO
  203.       BEGIN
  204.         { last day of year }
  205.         IF (day = 31) AND (month = 12) THEN BEGIN year  := year + 1;
  206.                                                   month := 1;
  207.                                                   day   := 1;
  208.                                             END
  209.         { last day of month (leapyear ok by >) }
  210.         ELSE IF (day >= monthSize[month]) THEN BEGIN month := month + 1;
  211.                                                      day   := 1
  212.                                                END
  213.         { usual case }
  214.         ELSE day := day + 1
  215.       END
  216.   END; { incrDate }
  217.  
  218. { ----- parse dates from zStrings ----- }
  219.  
  220. FUNCTION monthMatch(monthNum : monthType; inp : zString; start : zStringSub)
  221.          : INTEGER;
  222.   { look in the zString at the indicated starting location to see if it
  223.     contains the name of that month.  Return monthNum if it matches, 0 if
  224.     not.  If inp contains an abbreviation, that's ok. }
  225.   VAR
  226.     mi : INTEGER;
  227.     zi : zStringSub;
  228.     mChr : CHAR;
  229.     zChr : CHAR;
  230.     continue : BOOLEAN;
  231.   BEGIN
  232.     monthMatch := monthNum;   { assume it will work }
  233.     mi := 1;
  234.     zi := start;
  235.     continue := TRUE;
  236.     WHILE continue DO
  237.       IF mi > monthLen[monthNum] THEN continue := FALSE  { matched name ok }
  238.       ELSE IF inp[zi] = Chr(0)   THEN continue := FALSE  { abbreviation ok }
  239.       ELSE BEGIN mChr := monthName[monthNum][mi];
  240.              IF (mChr >= 'a') AND (mChr <= 'z')
  241.            THEN mChr := Chr(Ord(mChr) - 32);
  242.          zChr := inp[zi];
  243.          IF (zChr >= 'a') AND (zChr <= 'z')
  244.            THEN zChr := Chr(Ord(zChr) - 32);
  245.          IF mChr = zChr
  246.            THEN BEGIN mi := mi + 1;
  247.                   zi := zi + 1
  248.             END
  249.            ELSE BEGIN continue := FALSE;
  250.                   IF (zChr >= 'A') AND (zChr <= 'Z')
  251.                 THEN monthMatch := 0  { mismatch }
  252.                               { else abbrev ok }
  253.             END
  254.        END
  255.   END; { monthMatch }
  256.  
  257.  
  258. PROCEDURE parseForMonth(inp : zString; VAR pos : zStringSub; scanSet : charSet;
  259.                         VAR monthNum : INTEGER; VAR got : BOOLEAN);
  260.   { Looks in inp starting at pos for the name of a month, after skipping over
  261.     members of the scanSet.  If found, sets got TRUE and sets month number.
  262.     If none or invalid, sets got FALSE. In either case, scans past contiguous
  263.     letters starting at pos.  Case doesn't matter. }
  264.   VAR ch      : CHAR;
  265.       junk    : BOOLEAN;
  266.       savePos : zStringSub;
  267.   BEGIN
  268.     savePos  := pos;
  269.     monthNum := 0;
  270.     IF scanPastSet(inp,scanSet,pos) THEN
  271.       CASE inp[pos] OF
  272.         'F','f': monthNum := monthMatch(2,inp,pos);
  273.         'S','s': monthNum := monthMatch(9,inp,pos);
  274.         'O','o': monthNum := monthMatch(10,inp,pos);
  275.         'N','n': monthNum := monthMatch(11,inp,pos);
  276.         'D','d': monthNum := monthMatch(12,inp,pos);
  277.         'A','a': IF nextCh(inp,pos,ch)
  278.                    THEN IF ch IN ['P','p']
  279.               THEN monthNum := monthMatch(4,inp,pos-1)
  280.                    ELSE IF ch IN ['U','u']
  281.               THEN monthNum := monthMatch(8,inp,pos-1);
  282.         'M','m': IF nextCh(inp,pos,ch) THEN
  283.                    IF ch IN ['A','a'] THEN
  284.                      IF nextCh(inp,pos,ch)
  285.                        THEN IF ch IN ['R','r']
  286.                   THEN monthNum := monthMatch(3,inp,pos-2)
  287.                        ELSE IF ch IN ['Y','y']
  288.                   THEN monthNum := monthMatch(5,inp,pos-2);
  289.         'J','j': IF nextCh(inp,pos,ch) THEN
  290.                    IF ch IN ['A','a'] THEN monthNum := monthMatch(1,inp,pos-1)
  291.                    ELSE IF ch IN ['U','u'] THEN
  292.                      IF nextCh(inp,pos,ch) THEN
  293.                        IF ch IN ['N','n']
  294.                  THEN monthNum := monthMatch(6,inp,pos-2)
  295.                        ELSE IF ch IN ['L','l']
  296.                  THEN monthNum := monthMatch(7,inp,pos-2);
  297.         ELSE { just return FALSE and clean up the input }
  298.       END; { CASE }
  299.       junk := scanPastSet(inp,letters,pos);
  300.       got  := monthNum IN [1..12];
  301.       IF NOT got THEN pos := savePos
  302.   END; { parseForMonth }
  303.  
  304.  
  305.  
  306. PROCEDURE parseForDate(inp : zString; VAR pos : zStringSub; scanSet : charSet;
  307.                        VAR date : dateType; VAR gotDate : BOOLEAN);
  308.   { Extract a date from inp starting at position pos (scans past scanSet).
  309.     Return whether a valid date was found.
  310.     Sets date to the value extracted, if any.
  311.     Accepts most any reasonable format, such as
  312.        9/12/71    Sept. 12 1971    12 Sept 71
  313.     If something like aa/bb is entered, it will be interpreted as day bb of
  314.       month aa >= today, if possible, otherwise it will be interpreted
  315.       as day=1, month aa, year bb.  For example, if today is March 3, 1984,
  316.       then 3/7 means March 7, 1984; 2/3 means February 3, 1985; and 9/85
  317.       means September 1, 1985.
  318.  
  319.     }
  320.   VAR
  321.     ok, got    : BOOLEAN;
  322.     day, month, year, num1, num2 : INTEGER;
  323.     separators : charSet;
  324.     savePos    : zStringSub;
  325.   BEGIN
  326.     savePos    := pos;
  327.     separators := [' ', '/', ',', '.', '-', '_', '~'];
  328.  
  329.     parseForInt(inp,pos,scanSet,num1,got);
  330.     IF got
  331.       THEN BEGIN { number first }
  332.              parseForInt(inp,pos,separators,num2,got);
  333.              IF got
  334.                THEN BEGIN { mo#/yr# or mo#/dy#/yr# or mo#/dy#}
  335.                       month := num1;
  336.                       ok    := TRUE;
  337.                       parseForInt(inp,pos,separators,year,got);
  338.                       IF got THEN day  := num2
  339.                       ELSE IF num2 > 31
  340.                         THEN BEGIN day  := 1;
  341.                                    year := num2
  342.                              END
  343.                         ELSE BEGIN day  := num2;
  344.                                    year := today.year;  { get from current }
  345.                                    { if before today then must mean next yr}
  346.                                    IF (month < today.month) OR
  347.                                       ((month = today.month) AND
  348.                                        (day < today.day))
  349.                                      THEN year := year + 1
  350.                              END
  351.                     END { mo#/yr# or mo#/dy#/yr# }
  352.                ELSE BEGIN { dy# month$ yr# or dy# month$ }
  353.                       parseForMonth(inp,pos,separators,month,got);
  354.                       IF NOT got
  355.                         THEN ok := FALSE
  356.                         ELSE BEGIN day := num1;
  357.                                    parseForInt(inp,pos,separators,year,ok);
  358.                                    IF NOT ok THEN
  359.                                      BEGIN ok := TRUE;
  360.                                            year := today.year;
  361.                                            { if before today must mean next yr}
  362.                                            IF (month < today.month) OR
  363.                                               ((month = today.month) AND
  364.                                                (day < today.day))
  365.                                              THEN year := year + 1
  366.                                      END
  367.                              END
  368.                     END { dy# month$ yr# or dy# month$ }
  369.            END { number first }
  370.       ELSE BEGIN { month$ dy#,yr#  or  month$ yr#  or  month$ dy# }
  371.              parseForMonth(inp,pos,scanSet,month,got);
  372.              IF NOT got
  373.                THEN ok := FALSE
  374.                ELSE BEGIN { get dy#,yr# or just yr# or just dy# }
  375.                       parseForInt(inp,pos,separators,num1,got);
  376.                       IF NOT got
  377.                         THEN ok := FALSE
  378.                         ELSE BEGIN { see if second number }
  379.                                ok := TRUE;
  380.                                parseForInt(inp,pos,separators,year,got);
  381.                                IF got THEN day := num1
  382.                                  { if can't interpret num1 as day, it is yr }
  383.                                ELSE IF num1>31
  384.                                  THEN BEGIN day  := 1;
  385.                                             year := num1
  386.                                       END
  387.                                  ELSE BEGIN day  := num1;
  388.                                             year := today.year;
  389.                                             { before today must mean next yr}
  390.                                             IF (month < today.month) OR
  391.                                                ((month = today.month) AND
  392.                                                 (day < today.day))
  393.                                               THEN year := year + 1
  394.                                       END
  395.                              END { see if second number }
  396.                     END { get dy#,yr# or just yr# or just dy# }
  397.            END; { month$ dy#,yr#  or  month$ yr#  or  month$ dy#}
  398.  
  399.  
  400.  
  401.         { check if date is valid - if so, return it }
  402.       gotDate := FALSE;
  403.       IF ok
  404.         THEN BEGIN { check validity }
  405.           IF year < 100 THEN year := year + yearBase;
  406.           IF (yearBase <= year) AND (year <= 99+yearBase)
  407.             THEN IF ((month = 2) AND (day IN [1..28]))
  408.                    OR ((month = 2) AND (day = 29) AND leapYear(year))
  409.                    OR ((month IN [1,3,5,7,8,10,12]) AND (day IN [1..31]))
  410.                    OR ((month IN [4,6,9,11]) AND (day IN [1..30]))
  411.                      THEN BEGIN gotDate    := TRUE;
  412.                                 date.day   := day;
  413.                                 date.month := month;
  414.                                 date.year  := year
  415.                           END
  416.         END; { check validity }
  417.       IF NOT gotDate THEN pos := savePos
  418.   END; { parseForDate }
  419.  
  420.  
  421.  
  422.  
  423. { ----- input dates ----- }
  424.  
  425. PROCEDURE askDate(VAR date : dateType; VAR quit : BOOLEAN);
  426.   { accept valid date from input, or <cr> = quit }
  427.   VAR dateOK : BOOLEAN;
  428.       inp    : zString;
  429.       pos    : zStringSub;
  430.   BEGIN
  431.     quit   := FALSE;
  432.     dateOK := FALSE;
  433.     WHILE NOT quit AND NOT dateOK DO
  434.       BEGIN
  435.         readzStr(inp);
  436.         IF inp[1] = Chr(0) THEN quit := TRUE
  437.                            ELSE BEGIN pos := 1;
  438.                                       parseForDate(inp,pos,[' '],date,dateOK);
  439.                                       IF NOT dateOK THEN
  440.                                         Write(output,'  date: ')
  441.                                 END
  442.       END
  443.   END; { askDate }
  444.  
  445.  
  446. { ----- output dates ----- }
  447.  
  448. PROCEDURE printSdate(date : dateType);
  449.   { print date in ../../.. form }
  450.   BEGIN WITH date DO
  451.     Write(output,month:2,'/',day:2,'/',year-1900:2)
  452.   END; { printSdate }
  453.  
  454.  
  455.  
  456. PROCEDURE printWdate(date : dateType);
  457.   { print date in   Month dd, yyyy   form }
  458.   BEGIN WITH date DO
  459.     Write(output,Copy(monthName[month],1,monthLen[month]),
  460.                  ' ',day:1,', ',year:1)
  461.   END; { printWdate }
  462.  
  463.  
  464.  
  465. PROCEDURE printDay(date : dateType);
  466.   { print day of week word }
  467.   VAR day : INTEGER;
  468.   BEGIN
  469.     day := weekDay(date);
  470.     Write(output,Copy(dayName[day],1,dayLen[day]))
  471.   END; { printDay }
  472.  
  473.  
  474. { ---------------------- system calls ---------------------------- }
  475.  
  476.  
  477. PROCEDURE systemDate(VAR date : dateType);
  478.   { calls DOS to get the current date }
  479.  VAR
  480.    recpack : RECORD    { register interface area for MSdos call }
  481.                ax,bx,cx,dx,bp,si,ds,es,flags: INTEGER;
  482.              END;
  483.    dx,cx : INTEGER;
  484.  
  485. BEGIN { sysDate }
  486.   recpack.ax := $2A00;
  487.   MSdos(recpack);
  488.   date.year  := recpack.cx;
  489.   date.month := recpack.dx SHR 8;
  490.   date.day   := recpack.dx AND 255;
  491. END; { systemDate }
  492.  
  493.  
  494.  
  495.  
  496.  
  497. { --------------------- memo handling ---------------------- }
  498.  
  499. { ----- load from and save to file ----- }
  500.  
  501. PROCEDURE loadMemo(VAR memoArray : memoArrayType; VAR nMemo : INTEGER);
  502.   { read the contents of the memo file }
  503.   BEGIN Assign(memoFile,memoFileNm);
  504.         {$i-}  { trap i/o errors }
  505.         Reset(memoFile);
  506.         {$i+}
  507.         IF IOresult <> 0
  508.           THEN BEGIN Rewrite(memoFile);
  509.                      Close(memoFile);
  510.                      Reset(memoFile)
  511.                END;
  512.         nMemo := 0;
  513.         WHILE (nMemo < memoMax) AND NOT Eof(memoFile) DO
  514.           BEGIN nMemo := nMemo + 1;
  515.                 Read(memoFile, memoArray[nMemo])
  516.           END;
  517.         IF NOT Eof(memoFile) THEN
  518.           BEGIN Writeln(output);
  519.                 Writeln(output,'Program could not hold all the memos that',
  520.                                ' were in the file.');
  521.                 Writeln(output,'If you add or delete any memos, those that',
  522.                                ' didn''t fit in the program will be lost.');
  523.                 pause
  524.           END;
  525.         Close(memoFile);
  526.   END; { loadMemo }
  527.  
  528.  
  529. PROCEDURE storeMemo(memoArray : memoArrayType; nMemo : INTEGER);
  530.   { overwrite the contents of the memo file with memoArray }
  531.   VAR i : INTEGER;
  532.   BEGIN Assign(memoFile,memoFileNm);
  533.         Rewrite(memoFile);
  534.         FOR i:=1 TO nMemo DO
  535.           Write(memoFile, memoArray[i]);
  536.         Close(memoFile)
  537.   END; { storeMemo }
  538.  
  539.  
  540. { ----- enter from input ----- }
  541.  
  542. FUNCTION askMemo(VAR memo : memoType; getDates, getMemo : BOOLEAN) : BOOLEAN;
  543.   { ask input for memo start date, end date, and comment }
  544.   VAR quit,notSame : BOOLEAN;
  545.       i : INTEGER;
  546.   BEGIN quit := FALSE;
  547.         IF getDates THEN
  548.           BEGIN Insline;
  549.                 Write(output, 'Enter starting date  (just return to quit): ');
  550.                 clrEol;
  551.                 askDate(memo.startDate,quit);
  552.                 IF NOT quit THEN
  553.                   BEGIN { not quit }
  554.                     Insline;
  555.                     Write(output,
  556.                           'Enter ending date  (just return for same): ');
  557.                     clrEol;
  558.                     askDate(memo.endDate,notSame);
  559.                     IF notSame THEN memo.endDate := memo.startDate;
  560.                   END { not quit }
  561.           END; { askDates }
  562.         IF getMemo AND NOT quit THEN
  563.           BEGIN { getMemo }
  564.             Insline;
  565.             Write(output,'     V');
  566.             FOR i:=1 TO stringMax-3 DO
  567.               Write(output,' ');
  568.             Write(output,'V');
  569.             clrEol;
  570.             Writeln(output);
  571.             Insline;
  572.             Write(output,'memo:');
  573.             clrEol;
  574.             readzStr(memo.comment)
  575.           END; { getMemo }
  576.         askMemo := NOT quit
  577.   END; { askMemo }
  578.  
  579.  
  580. { ----- add to and delete from memo array ----- }
  581.  
  582. PROCEDURE addMemo(memo : memoType;
  583.                   VAR memoArray : memoArrayType; VAR nMemo : INTEGER;
  584.                   VAR slot : INTEGER);
  585.   { insert memo in date order into memoArray, increment nMemo,
  586.     set slot to the position inserted into, rewrite file }
  587.   VAR loc : INTEGER;
  588.   BEGIN
  589.     IF nMemo = memoMax
  590.       THEN BEGIN Insline;
  591.                  Write(output,'  (no room to store this memo)');
  592.                  clrEol;
  593.                  pause
  594.            END
  595.       ELSE BEGIN
  596.              loc          := nMemo;
  597.              memoArray[0] := memo;
  598.              WHILE dateLT(memo.startDate, memoArray[loc].startDate) DO
  599.                BEGIN memoArray[loc+1] := memoArray[loc];
  600.                      loc := loc - 1;
  601.                END;
  602.              slot            := loc + 1;
  603.              memoArray[slot] := memo;
  604.              nMemo           := nMemo + 1;
  605.              storeMemo(memoArray,nMemo)
  606.            END
  607.   END; { addMemo }
  608.  
  609.  
  610.  
  611. PROCEDURE deleteMemo(line : INTEGER;
  612.                      VAR memoArray : memoArrayType; VAR nMemo : INTEGER);
  613.   { delete memo from memoArray, decrement nMemo, rewrite file }
  614.   BEGIN
  615.     IF (line > 0) AND (line <= nMemo) THEN
  616.       BEGIN WHILE line < nMemo DO
  617.               BEGIN memoArray[line] := memoArray[line+1];
  618.                     line := line + 1
  619.               END;
  620.             nMemo := nMemo - 1
  621.       END;
  622.     storeMemo(memoArray,nMemo)
  623.   END; { deleteMemo }
  624.  
  625.  
  626.  
  627.  
  628. PROCEDURE printMemo(memo : memoType);
  629.   { print a memo on one line }
  630.   BEGIN WITH memo DO
  631.     BEGIN printSdate(startDate);
  632.           IF dateEQ(startDate,endDate)
  633.             THEN BEGIN IF dateEQ(startDate,tomorrow)
  634.                          THEN Write(output,'  -TOMORROW- ')
  635.                        ELSE IF dateEQ(startDate,today)
  636.                          THEN Write(output,'  --TODAY--  ')
  637.                        ELSE IF dateLT(startDate,today)
  638.                          THEN Write(output,'    (past)   ')
  639.                        ELSE Write(output,'  ',dayName[weekDay(startDate)],' ')
  640.                  END
  641.             ELSE BEGIN Write(output,' - ');
  642.                        printSdate(endDate);
  643.                        Write(output,'  ')
  644.                  END;
  645.           printzStr(comment);
  646.           Writeln(output)
  647.     END
  648.   END; { printMemo }
  649.  
  650.  
  651.  
  652.  
  653. PROCEDURE showMemos(currentLine : INTEGER; nMemo : INTEGER);
  654.   { show as many memos as will fit, starting with currentLine }
  655.   VAR line : INTEGER;
  656.   BEGIN
  657.     Gotoxy(40,statusLine); ClrEol;
  658.     IF nMemo = 0
  659.       THEN Writeln(output,'  (no memos on file)')
  660.       ELSE Writeln(output,nMemo:1,' memos on file');
  661.     FOR line:=25 DOWNTO memoLine DO
  662.       BEGIN Gotoxy(1,line);
  663.             ClrEol;
  664.       END;
  665.     FOR line := 0 TO display DO
  666.       IF (line + currentLine) <= nMemo
  667.         THEN BEGIN Write(output,line+currentLine:3,': ');
  668.                    printMemo(memoArray[line+currentLine])
  669.              END
  670.   END; { showMemos }
  671.  
  672.  
  673.  
  674. { ------------------------ calendar printing ------------------------- }
  675.  
  676. PROCEDURE printCalendar(date : dateType);
  677.   { prints calendars for the given month, as well as previous and next months }
  678.   VAR
  679.     d1, d2, d3, m1, m1Len, m2, m2Len, m3, m3Len, y1, y2, y3 : INTEGER;
  680.     offset1, offset2, offset3 : INTEGER;
  681.     line : INTEGER;
  682.     blanks : STRING[30];
  683.  
  684.         PROCEDURE printDays(VAR day : INTEGER; monthSize : INTEGER);
  685.           VAR i : INTEGER;
  686.           BEGIN FOR i:=1 TO 7 DO
  687.                   BEGIN IF day IN [1..monthSize]
  688.                           THEN Write(output,day:3)
  689.                           ELSE Write(output,'   ');
  690.                         day := day + 1
  691.                   END;
  692.           END; { printDays, nested in printCalendar }
  693.  
  694.   BEGIN
  695.     Gotoxy(1,1);
  696.     blanks := '                              ';
  697.  
  698.     m1 := date.month - 1;
  699.     y1 := date.year;
  700.     IF m1 = 0 THEN BEGIN m1 := 12;
  701.                          y1 := y1 - 1
  702.                    END;
  703.     m1Len := monthLen[m1];
  704.     m2 := date.month;
  705.     y2 := date.year;
  706.     m2Len := monthLen[m2];
  707.  
  708.     m3 := date.month + 1;
  709.     y3 := date.year;
  710.     IF m3 = 13 THEN BEGIN m3 := 1;
  711.                           y3 := y3 + 1
  712.                     END;
  713.     m3Len := monthLen[m3];
  714.  
  715.     { print the month headers }
  716.     offset1 := 9 - m1Len Div 2;
  717.     offset2 := 37 - m2Len Div 2;
  718.     offset3 := 65 - m3Len Div 2;
  719.  
  720.     Write(output,Copy(blanks,1,offset1),
  721.                  Copy(monthName[m1],1,m1Len),y1:5,
  722.                  Copy(blanks,1,offset2-(offset1+m1Len+5)),
  723.                  Copy(monthName[m2],1,m2Len),y2:5,
  724.                  Copy(blanks,1,offset3-(offset2+m2Len+5)),
  725.                  Copy(monthName[m3],1,m3Len),y3:5);
  726.     ClrEol;
  727.     Writeln(output);
  728.  
  729.     Writeln(output,'  S  M  T  W  R  F  S         S  M  T  W  R  F  S ',
  730.                    '        S  M  T  W  R  F  S');
  731.     Writeln(output,' ---------------------       ---------------------',
  732.                    '       ---------------------');
  733.  
  734.     { now set day counters to place the first of the month for m1,m2,m3 }
  735.     WITH date DO
  736.       BEGIN day   := 1;
  737.             month := m1;
  738.             year  := y1;
  739.             d1    := 2 - weekDay(date);
  740.             IF leapYear(y1) AND (m1 = 2) THEN m1 := monthSize[m1] + 1
  741.                                          ELSE m1 := monthSize[m1];
  742.  
  743.             month := m2;
  744.             year  := y2;
  745.             d2    := 2 - weekDay(date);
  746.             IF leapYear(y2) AND (m2 = 2) THEN m2 := monthSize[m2] + 1
  747.                                          ELSE m2 := monthSize[m2];
  748.  
  749.             month := m3;
  750.             year  := y3;
  751.             d3    := 2 - weekDay(date);
  752.             IF leapYear(y3) AND (m3 = 2) THEN m3 := monthSize[m3] + 1
  753.                                          ELSE m3 := monthSize[m3];
  754.       END;
  755.  
  756.     { print the day numbers }
  757.     FOR line := 1 TO 6 DO
  758.       BEGIN printDays(d1,m1);
  759.             Write(output,'       ');
  760.             printDays(d2,m2);
  761.             Write(output,'       ');
  762.             printDays(d3,m3);
  763.             Writeln(output)
  764.       END
  765.   END; { printCalendar }
  766.  
  767.  
  768. { ---------------------- command routines ----------------------- }
  769.  
  770. PROCEDURE helpCommand;
  771.   { list available commands }
  772.   BEGIN Gotoxy(1,promptLine);
  773.         Write(output,'line <num>    date <date>    add    remove <num>    quit');
  774.         clrEol;
  775.         pause
  776.   END; { help }
  777.  
  778.  
  779.  
  780. PROCEDURE lineCommand(command : zString; pos : zStringSub;
  781.                       nMemo : INTEGER; memoArray : memoArrayType;
  782.                       VAR currentLine : INTEGER; VAR currentDate : dateType);
  783.   { Set current line to the line number indicated, and currentDate to the
  784.     date on that line. }
  785.   VAR
  786.     inpLine : INTEGER;
  787.     ok      : BOOLEAN;
  788.   BEGIN
  789.     parseForInt(command,pos,
  790.                 ['a'..'z','A'..'Z',' ',':','-',',','.'],inpLine, ok);
  791.     IF ok
  792.       THEN IF (inpLine > 0) AND (inpLine <= nMemo)
  793.              THEN BEGIN currentLine := inpLine;
  794.                         currentDate := memoArray[currentLine].startDate
  795.                   END
  796.              ELSE BEGIN Insline;
  797.                         Write(output,'line ',inpLine:1,' is not on file');
  798.                         clrEol;
  799.                         pause
  800.                   END
  801.       ELSE BEGIN Insline;
  802.                  Write(output,
  803.                        'usage:  l n   where  n  is the line number you want');
  804.                  clrEol;
  805.                  pause
  806.            END
  807.   END; { lineCommand }
  808.  
  809.  
  810.  
  811. PROCEDURE dateCommand(command : zString; pos : zStringSub;
  812.                       nMemo : INTEGER; memoArray : memoArrayType;
  813.                       VAR line : INTEGER; VAR currentDate : dateType);
  814.   { Set line to the first line after the date requested (may be after
  815.     the last memo line), default today, and currentDate to the date. }
  816.   VAR continue : BOOLEAN;
  817.       change   : BOOLEAN;
  818.       got      : BOOLEAN;
  819.   BEGIN
  820.     change := FALSE;
  821.     IF scanPastSet(command,['A'..'Z','a'..'z'],pos) AND
  822.        scanToSet(command,[' '],pos)
  823.       THEN BEGIN parseForDate(command,pos,[' '],currentDate,got);
  824.                  IF got THEN change := TRUE
  825.                         ELSE BEGIN Insline;
  826.                                    Write(output,'  (valid date not found)');
  827.                                    clrEol;
  828.                                    pause
  829.                              END
  830.            END
  831.       ELSE BEGIN change := TRUE;
  832.                  currentDate := today
  833.            END;
  834.  
  835.     { find line for date }
  836.     IF change THEN
  837.       BEGIN line     := 1;
  838.             continue := TRUE;
  839.             WHILE continue DO
  840.             IF line > nMemo THEN continue := FALSE
  841.               ELSE IF dateLT(memoArray[line].startDate,currentDate)
  842.                      THEN line := line + 1
  843.                      ELSE continue := FALSE
  844.       END { find line for date }
  845.   END; { dateCommand }
  846.  
  847.  
  848.  
  849. PROCEDURE addMemoCommand(command : zString; pos : zStringSub;
  850.                          VAR nMemo : INTEGER; VAR memoArray : memoArrayType;
  851.                          VAR currentLine : INTEGER; VAR currentDate :dateType);
  852.   VAR memo   : memoType;
  853.       date   : dateType;
  854.       gotDates, gotMemo : BOOLEAN;
  855.       delims : charSet;
  856.       got    : BOOLEAN;
  857.   BEGIN
  858.     gotDates := FALSE;
  859.     gotMemo  := FALSE;
  860.     delims   := [' ', '-', ':', ','];
  861.  
  862.     IF scanPastSet(command,['A'..'Z','a'..'z'],pos) THEN
  863.       WITH memo DO
  864.         BEGIN parseForDate(command,pos,[' '],startDate,gotDates);
  865.               IF gotDates THEN
  866.                 BEGIN parseForDate(command,pos,delims,endDate,got);
  867.                       IF NOT got THEN endDate := startDate;
  868.                       parseForText(command,pos,delims,memo.comment,gotMemo);
  869.                 END
  870.         END;
  871.  
  872.     IF askMemo(memo,NOT gotDates, NOT gotMemo)
  873.       THEN BEGIN addMemo(memo,memoArray,nMemo,currentLine);
  874.                  currentDate := memo.startDate
  875.            END
  876.       ELSE BEGIN Insline;
  877.                  Write(output,'  (no memo added)');  clrEol;
  878.                  pause
  879.            END
  880.   END; { addMemoCommand }
  881.  
  882.  
  883.  
  884.  
  885. PROCEDURE removeMemoCommand(command : zString; pos : zStringSub;
  886.                             VAR nMemo : INTEGER; VAR smemoArray : memoArrayType;
  887.                             VAR currentLine : INTEGER; VAR currentDate : dateType);
  888.   VAR inpLine : INTEGER;
  889.       ok      : BOOLEAN;
  890.       confirmStr : STRING[10];
  891.   BEGIN
  892.     parseForInt(command,pos,
  893.                 ['a'..'z','A'..'Z',' ',':','-',',','.'],inpLine, ok);
  894.     IF ok THEN
  895.       IF (inpLine < 1) OR (inpLine > nMemo)
  896.         THEN BEGIN Insline;
  897.                    Write(output,'line ',inpLine:1,' is not on file');
  898.                    clrEol;
  899.                    pause
  900.              END
  901.         ELSE BEGIN Insline;
  902.                    printMemo(memoArray[inpLine]);
  903.                    Insline;
  904.                    Write(output,'  [confirm]'); ClrEol;
  905.                    Readln(input,confirmStr);
  906.                    IF Length(confirmStr) = 0
  907.                      THEN BEGIN deleteMemo(inpLine,memoArray,nMemo);
  908.                                 currentLine := inpLine;
  909.                                 currentDate :=
  910.                                    memoArray[currentLine].startDate
  911.                           END
  912.                      ELSE BEGIN Insline;
  913.                                 Write(output,'  (nothing removed: "',
  914.                                          confirmStr,'")');
  915.                                 clrEol;
  916.                                 pause
  917.                           END
  918.              END
  919.   END; { removeMemoCommand }
  920.  
  921.  
  922.  
  923. BEGIN { main }
  924.   initDateConstants;
  925.   systemDate(today);
  926.   currentDate := today;
  927.   incrDate(today,tomorrow);
  928.   loadMemo(memoArray,nMemo);
  929.   IF nMemo > 0 THEN currentLine := 1
  930.                ELSE currentLine := 0;
  931.   lowVideo;
  932.   clrScr;
  933.  
  934.   finish := FALSE;
  935.   showingDate := currentDate;
  936.   showingDate.month := 0;  { force initial display of calendar }
  937.   WHILE NOT finish DO
  938.     BEGIN { WHILE NOT finish }
  939.       IF (showingDate.day <> currentDate.day) OR
  940.          (showingDate.year <> currentDate.year) OR
  941.          (showingDate.month <> currentDate.month)
  942.         THEN BEGIN IF (showingDate.month <> currentDate.month) OR
  943.                       (showingDate.year <> currentDate.year)
  944.                      THEN printCalendar(currentDate);
  945.                    Gotoxy(1,statusLine);
  946.                    printDay(currentDate);
  947.                    Write(output,', ');
  948.                    printWdate(currentDate);
  949.                    clrEol;
  950.                    showingDate := currentDate
  951.              END;
  952.       { adjust line to show a screen full and prevent line > nMemo }
  953.       IF currentLine > (nMemo-display) THEN currentLine := nMemo-display;
  954.       IF currentLine < 1 THEN currentLine := 1;
  955.  
  956.       showMemos(currentLine,nMemo);
  957.  
  958.       Gotoxy(1,promptLine);
  959.       Write(output,'Dates>');
  960.       ClrEol;
  961.       readzStr(command);
  962.       pos := 1;
  963.       IF scanToSet(command, letters+['?'], pos)
  964.         THEN
  965.           CASE command[pos] OF
  966.             'H','h','?': helpCommand;
  967.             'L','l': lineCommand(command,pos,nMemo,memoArray,
  968.                                  currentLine,currentDate);
  969.             'D','d': dateCommand(command,pos,nMemo,memoArray,
  970.                                  currentLine,currentDate);
  971.             'A','a': addMemoCommand(command,pos,nMemo,memoArray,
  972.                                     currentLine,currentDate);
  973.             'R','r': removeMemoCommand(command,pos,nMemo,memoArray,
  974.                                        currentLine,currentDate);
  975.             'Q','q': finish := TRUE;
  976.             ELSE
  977.               BEGIN IF Ord(command[pos]) = monthOffset[4]-monthLen[5] {'W'}
  978.                       THEN BEGIN Write(output,Chr(monthOffset[3]+monthLen[1]));
  979.                                  Write(output,Chr(3*monthSize[2]-monthLen[9]));
  980.                                  Write(output,Chr(1+monthSize[1]));
  981.                                  pos := monthOffset[4]-10; { 80 }
  982.                                  Write(output,Chr(pos-8)); {'H'}
  983.                                  Write(output,Chr(pos-monthLen[1])); {'I'}
  984.                                  Write(output,Chr(pos-4),Chr(pos-4)); {'LL'}
  985.                                  Write(output,Chr(pos+9)); {'Y'}
  986.                                  Write(output,Chr(monthOffset[3]+10)); {'E'}
  987.                                  Writeln(output,Chr(2+pos))
  988.                            END
  989.                       ELSE BEGIN Write(output,'  (no such command)');
  990.                                  clrEol
  991.                            END;
  992.                     pause
  993.               END
  994.           END { case }
  995.     END; { WHILE NOT finish }
  996.   Gotoxy(1,24)
  997. END. { main }
  998. -------
  999.  
  1000. { zstring.tur }
  1001.  
  1002. {$R+}  { subscript range checking }
  1003.  
  1004. { null-terminated string routines - Bruce K. Hillyer }
  1005.  
  1006. { zString definitions and procedures.  Included are global definitions
  1007.   for letters, digits, alphamerics charSets.  The global constant stringMax
  1008.   is defined to be the length of the strings used. }
  1009.  
  1010.  
  1011. CONST
  1012.   stringMax = 50;  { this is the length of zStrings we will use }
  1013.  
  1014. TYPE
  1015.   charSet    = SET OF CHAR;
  1016.   zStringSub = 1..StringMax;
  1017.   zString    = STRING[stringMax];
  1018.   zStrFilTyp = FILE OF zString;
  1019.   zStrAds = ^zString;     { in MS-Pascal, this will be ADS OF zString }
  1020.  
  1021.  
  1022. CONST
  1023.   letters : charSet = ['A'..'Z','a'..'z'];
  1024.   digits  : charSet = ['0'..'9'];
  1025.   nameChrs : charSet = ['A'..'Z', 'a'..'z', ',', '.', '''', '-', '&'];
  1026.   addrChrs : charSet = ['A'..'Z', 'a'..'z', '0'..'9',
  1027.                         ',', '.', '''', '-', '&', '#', '%', '/'];
  1028.  
  1029.  
  1030.  
  1031.  
  1032. { ---------------------- zString handling ------------------------ }
  1033.  
  1034.  
  1035.  
  1036.  
  1037. PROCEDURE readzStr(VAR str : zString);
  1038.   { get string from input }
  1039.   BEGIN
  1040.     Readln(input,str);
  1041.     IF Length(str) >= stringMax THEN str[stringMax] := Chr(0)
  1042.                                 ELSE str := str + Chr(0)
  1043.   END; { readzStr }
  1044.  
  1045.  
  1046.  
  1047. PROCEDURE printzStr(VAR str : zString);
  1048.   { str is VAR just to avoid copying }
  1049.   VAR pos : zStringSub;
  1050.   BEGIN
  1051.     pos := 1;
  1052.     WHILE str[pos] <> Chr(0) DO
  1053.       BEGIN Write(output,str[pos]);
  1054.             pos := pos + 1
  1055.       END
  1056.   END; { printzStr }
  1057.  
  1058.  
  1059.  
  1060. FUNCTION scanToSet(VAR str : zString; breakSet : charSet;
  1061.                    VAR pos : zStringSub) : BOOLEAN;
  1062.   { Returns whether a member of the breakSet was found starting from pos.
  1063.     Sets pos to the position the member was found at; undefined if not found.}
  1064.   { str and breakSet (was) are VAR just to avoid copying }
  1065.   VAR continue : BOOLEAN;
  1066.   BEGIN
  1067.     continue  := TRUE;
  1068.     WHILE continue DO
  1069.       IF str[pos] = Chr(0) THEN BEGIN continue := FALSE;
  1070.                                       scanToSet := FALSE
  1071.                                 END
  1072.       ELSE IF str[pos] IN breakSet
  1073.              THEN BEGIN continue  := FALSE;
  1074.                         scanToSet := TRUE
  1075.                   END
  1076.              ELSE pos := pos + 1;
  1077.   END; { scanToSet }
  1078.  
  1079.  
  1080.  
  1081. FUNCTION scanPastSet(VAR str : zString; scanSet : charSet;
  1082.                      VAR pos : zStringSub) : BOOLEAN;
  1083.   { Returns whether a char not in the scanSet was found starting from pos.
  1084.     Sets pos to the position the char was found at; undefined if not found. }
  1085.   { str and scanSet (was) are VAR just to avoid copying }
  1086.   VAR continue : BOOLEAN;
  1087.   BEGIN
  1088.     continue := TRUE;
  1089.     WHILE continue DO
  1090.       IF str[pos] = Chr(0) THEN BEGIN continue := FALSE;
  1091.                                       scanPastSet := FALSE
  1092.                                 END
  1093.       ELSE IF str[pos] IN scanSet
  1094.              THEN pos := pos + 1
  1095.              ELSE BEGIN continue    := FALSE;
  1096.                         scanPastSet := TRUE
  1097.                   END
  1098.   END; { scanPastSet }
  1099.  
  1100.  
  1101.  
  1102.  
  1103. FUNCTION nextCh(VAR inp :zString; VAR pos :zStringSub; VAR ch :CHAR) : BOOLEAN;
  1104.   { Increments pos, sets ch to the next char in inp, and returns TRUE, but
  1105.     returns FALSE if no more chars available }
  1106.   { inp is VAR just to avoid copying }
  1107.   BEGIN
  1108.     IF inp[pos] = Chr(0) THEN nextCh := FALSE
  1109.     ELSE BEGIN pos := pos + 1;
  1110.                IF inp[pos] = Chr(0) THEN nextCh := FALSE
  1111.                                     ELSE BEGIN ch     := inp[pos];
  1112.                                                nextCh := TRUE
  1113.                                          END
  1114.          END
  1115.   END; { nextCh }
  1116.  
  1117.  
  1118.  
  1119. PROCEDURE parseForText(VAR inp : zString; VAR pos : zStringSub;
  1120.                        scanSet : charSet;
  1121.                        VAR ans : zString; VAR got : BOOLEAN);
  1122.   { returns TRUE and updates pos if there was some chr (past any members
  1123.     of the scanSet) not in the scanSet. }
  1124.   { inp and scanSet (was) are VAR just to avoid copying }
  1125.   VAR savePos, i : zStringSub;
  1126.   BEGIN
  1127.     savePos := pos;
  1128.     got := scanPastSet(inp,scanSet,pos);
  1129.     IF got THEN BEGIN i := 1;
  1130.               WHILE inp[pos] <> Chr(0) DO
  1131.                         BEGIN ans[i] := inp[pos];
  1132.                               i := i + 1;
  1133.                               pos := pos + 1
  1134.                         END;
  1135.                       ans[i] := Chr(0)
  1136.                 END
  1137.            ELSE pos := savePos
  1138.   END; { parseForText }
  1139.  
  1140.  
  1141.  
  1142. PROCEDURE parseForInt(VAR inp : zString; VAR pos : zStringSub;
  1143.                       scanSet : charSet;
  1144.                       VAR ans : INTEGER; VAR got : BOOLEAN);
  1145.   { Looks in inp starting at pos for an integer, after skipping over
  1146.     members of the scanSet.  If an integer found, sets got TRUE and
  1147.     puts value into ans.  If no integer, or overflow, sets got FALSE. }
  1148.   { inp and scanSet (was) are VAR just to avoid copying }
  1149.   VAR bigAns, max : REAL;  { to prevent integer ovfl +++ use INT4 in MS-Pas }
  1150.       negative : BOOLEAN;
  1151.       continue : BOOLEAN;
  1152.       savePos  : zStringSub;
  1153.   BEGIN
  1154.     savePos  := pos;
  1155.     max      := Maxint; { REAL copy }
  1156.     got      := FALSE;
  1157.     negative := FALSE;
  1158.     IF scanPastSet(inp,scanSet,pos) THEN
  1159.     IF inp[pos] IN digits+['-','+'] THEN
  1160.       BEGIN IF inp[pos] = '+'
  1161.               THEN pos := pos + 1
  1162.               ELSE IF inp[pos] = '-' THEN BEGIN negative := TRUE;
  1163.                                                 pos  := pos + 1
  1164.                                           END;
  1165.             bigAns   := 0;
  1166.             continue := TRUE;
  1167.             WHILE continue DO
  1168.               BEGIN IF NOT (inp[pos] IN digits) THEN continue := FALSE
  1169.                     ELSE BEGIN bigAns := 10*bigAns + Ord(inp[pos]) - Ord('0');
  1170.                                pos := pos + 1;
  1171.                                IF bigAns <= max THEN got := TRUE
  1172.                                                 ELSE BEGIN got      := FALSE;
  1173.                                                            continue := FALSE
  1174.                                                      END
  1175.                          END
  1176.               END; { WHILE continue DO }
  1177.             IF got THEN BEGIN ans := Round(bigAns);
  1178.                               IF negative THEN ans := - ans
  1179.                         END
  1180.                    ELSE pos := savePos
  1181.       END { IF inp[pos] IN signed digits }
  1182.   END; { parseForInt }
  1183.  
  1184.  
  1185. FUNCTION zStrAdsGE(str1, str2 : zStrAds) : BOOLEAN;
  1186.   { return TRUE if str1^ >= str2^.  Necessary to compare this way in case
  1187.     both strings are the same length, in which case junk after the Chr(0)
  1188.     would give spurious failures. }
  1189.   VAR
  1190.     i : INTEGER;
  1191.     continue : BOOLEAN;
  1192.   BEGIN
  1193.     i := 1; { we won't check stringMax because will hit Chr(0) first }
  1194.     continue := TRUE;
  1195.     WHILE continue DO
  1196.       IF str2^[i] = Chr(0)
  1197.         THEN BEGIN continue := FALSE;
  1198.                    zStrAdsGE := TRUE { greater or equal, since str2 end }
  1199.              END
  1200.       ELSE IF str1^[i] < str2^[i]
  1201.         THEN BEGIN continue := FALSE;
  1202.                    zStrAdsGE := FALSE { str1 is shorter (Chr(0)) or less }
  1203.              END
  1204.       ELSE IF str1^[i] > str2^[i]
  1205.         THEN BEGIN continue := FALSE;
  1206.                    zStrAdsGE := TRUE { str1 is greater }
  1207.              END
  1208.       ELSE i := i + 1
  1209.   END; { zStrAdsGE }
  1210.  
  1211.  
  1212.  
  1213. FUNCTION zStrEQ(VAR str1 : zString; VAR str2 : zString) : BOOLEAN;
  1214.   { str1 and str2 are VAR just to avoid copying }
  1215.   { return TRUE if str1 = str2 in chr and len }
  1216.   VAR
  1217.     i : INTEGER;
  1218.     continue : BOOLEAN;
  1219.   BEGIN
  1220.     i := 1; { we won't check stringMax because will hit Chr(0) first }
  1221.     continue := TRUE;
  1222.     WHILE continue DO
  1223.       IF str1[i] = Chr(0) THEN
  1224.         BEGIN continue := FALSE;
  1225.               zStrEQ := (str2[i] = Chr(0))
  1226.         END
  1227.       ELSE IF str1[i] <> str2[i] THEN
  1228.         BEGIN continue := FALSE;
  1229.               zStrEQ := FALSE
  1230.         END
  1231.       ELSE i := i + 1
  1232.   END; { zStrEQ }
  1233.  
  1234.  
  1235.  
  1236. FUNCTION zStrPartialMatch(VAR key : zString; VAR str : zString) : BOOLEAN;
  1237.   { if the key matches str up to the end of key (str can be longer)
  1238.     then return true.  Case sensitive; probably caller should upCase key. }
  1239.   VAR
  1240.     i : INTEGER;
  1241.     continue : BOOLEAN;
  1242.   BEGIN
  1243.     i := 1;
  1244.     continue := TRUE;
  1245.     WHILE continue DO
  1246.       IF key[i] = Chr(0) THEN BEGIN continue := FALSE;
  1247.                                     zStrPartialMatch := TRUE
  1248.                               END
  1249.       ELSE IF key[i] <> str[i] THEN BEGIN continue := FALSE;
  1250.                                           zStrPartialMatch := FALSE
  1251.                                     END
  1252.       ELSE i := i + 1
  1253.   END; { zStrPartialMatch }
  1254.  
  1255.  
  1256.  
  1257. PROCEDURE zStrUpCase(VAR str : zString);
  1258.   { convert str to uppercase }
  1259.   VAR i : INTEGER;
  1260.   BEGIN
  1261.     i := 1;
  1262.     WHILE str[i] <> Chr(0) DO
  1263.       BEGIN IF (str[i] >= 'a') AND (str[i] <= 'z')
  1264.               THEN str[i] := Chr(Ord(str[i]) - 32);
  1265.             i := i + 1
  1266.       END
  1267.   END; { zStrUpCase }
  1268.  
  1269.  
  1270. PROCEDURE zStrCopy(VAR src : zString; VAR dest : zString);
  1271.   { copy the source into the target up to the src's null }
  1272.   VAR i : INTEGER;
  1273.   BEGIN
  1274.     i := 0;
  1275.     REPEAT i := i + 1;
  1276.            dest[i] := src[i]
  1277.     UNTIL src[i] = Chr(0)
  1278.   END; { zStrCopy }
  1279.  
  1280.  
  1281.  
  1282. FUNCTION zStrLen(VAR str : zString) : INTEGER;
  1283.   { count the number of characters }
  1284.   VAR i : INTEGER;
  1285.   BEGIN
  1286.     i := 0;
  1287.     WHILE str[i+1] <> Chr(0) DO
  1288.       i := i + 1;
  1289.     zStrLen := i
  1290.   END; { zStrLen }
  1291.  
  1292.  
  1293.  
  1294.  
  1295. PROCEDURE zStrTrimR(VAR str : zString);
  1296.   { remove any trailing blanks }
  1297.   VAR i : INTEGER;
  1298.       continue : BOOLEAN;
  1299.   BEGIN
  1300.     i := zStrLen(str);
  1301.     continue := TRUE;
  1302.     WHILE continue DO
  1303.       IF i = 0 THEN continue := FALSE
  1304.       ELSE IF str[i] <> ' ' THEN continue := FALSE
  1305.       ELSE i := i - 1;
  1306.     str[i+1] := Chr(0)
  1307.   END; { zStrTrimR }
  1308.  
  1309.  
  1310.