[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    {
    From: ac_march@ECE.Concordia.CA (Angus C. March)

    I have this grave problem where when I use this certain program that calls a
    function that I defined in a unit, the program shortly hangs up. Oddly enough
    if I start peppering the regions of code about where the hang up occurs it is
    delayed. As another interesting piece of information: pushing ctrl-break
    causes the hangup as well.
         Anyway, the following is a Turbo Pascal 6.0 partially written in
    Borland.  It's REAL LONG, so I'm not going to expect anyone to sift through
    all the code, that is why I have COMMENTED THE KEY POINTS IN CODE w/UPPERCASE
    LETTERS, so it will be MUCH EASER TO FIND. Just like a comic book advert for
    a martial arts course.

         Anyway, here is all the code.
    }

    Program mailManager;

    Uses DOS, CRT, AngusU; {AngusU= A UNIT WITH MY OWN ROUTINES, SEE END IF
                                    POST}

    Const
         background = Blue;
         foreground = LightGray;

         scrX = 80;
         scrY = 25;
         scrXY = 80*25;

    Type          {screen save types}
        scrXRange = 1..scrX;  {x-axis range of my screen}
        scrYRange = 1..scrY;  {y-  "    "   "  "    "}
        scrXYRange = 1..scrXY;
        scrElementRecord = Record  {attributes of a cell on the text screen}
                           element: Char;
                           colour: Byte;
        end;
        scrPointer = ^scrNode;
        scrNode = Record          {linked list of window to be put on the stack}
                  cell: scrElementRecord;
                  next: scrPointer;
        end;
        scrStackPointer = ^stackNode;       {These set the stack}
        stackNode = Record
                    scrWindowPointer: scrPointer; {pointer to window to be saved}
                    cursorX, {where cursor was left}
                    left, right: scrXRange; {boundries of the window to be saved}
                    cursorY, {where cursor was left}
                    top, bottom: scrYRange; {boundries of the window to be save}
                    winMax, winMin: Word; {boundries of the window}
                    colour: Byte;  {textAttr}
                    downward: scrStackPointer; {pointer to next place in stack}
        end;

                          {menuTypes}
        stringPointer = ^stringNode;
        stringNode = Record
             prev,next: stringPointer;  {strings passed to menu}
             streng: String;
        end;

    Var
       dummy, menuAnswer: Char;
       p: DirPointer;
       head, bufferPointer, q: stringPointer;
       menuCand: String;
       COUNTER: Byte;
       EXTENDED: BOOLEAN;

       {screen save vars}
       scrStack: scrStackPointer;

    {Procedure colorWindow;
    Var
       i: Word;

    Begin
         TextBackground(White);
         For i:= 1 To 2000 Do
             Write(' ');
    end;}

    Function strg(x: Longint): String;
    Var
       carry: String;

    Begin
         Str(x, carry);
         strg:= carry;
    end;

    Procedure message(messg: String);
    Var
       carryWindMax, carryWindMin: Word;
       carryWhereX: scrXRange;
       carryWhereY: scrYRange;

    Begin
         carryWhereX:= WhereX; carryWhereY:= WhereY;
         carryWindMax:= WindMax; carryWindMin:= WindMin;
         Window(1, 25, 80, 25);
         Write(messg);
         WindMax:= carryWindMax; WindMin:= carryWindMin;
         GotoXY(carryWhereX, carryWhereY);
    end;

    Procedure shiftWindow(xShift, yShift: Shortint);
    Begin
         Window(Lo(WindMin) + 1 + xShift, Hi(WindMin) + 1 + yShift, Lo(WindMax) +
    1 + xShift, Hi(WindMax) + 1 + yShift);
    end;

    Procedure getCursorChar(Var attrib, charCode: Byte);
    {THIS THING DOESN'T WORK VERY WELL BUT IT ISN'T CAUSING THE PROBLEM
    BECAUSE THE PROBLEM REMAINS WHEN THIS PROCEDURE IS REMOVED FROM THE CODE}
    Var
       reg: Registers;{regPack}

    Begin
         Reg.AH := 8;  {Function 8 = Read attribute and character at cursor.}
         Reg.BH := 0;  {Use display page = 0}

         Intr(10,Reg); {Call Interrupt 10 (BIOS)}

         attrib := Reg.AH;  {Get atrribute value from result.}
         charCode:= Reg.AL; {Get character code from result.}
    end;

    Procedure getChar(x: scrXRange; y: scrYRange; Var cell: scrElementRecord);
    Var
       xCarry: scrXRange;
       yCarry: scrYRange;
       colour, charOrd: Byte;

    Begin
         xCarry:= WhereX; yCarry:= WhereY;
         GotoXY(x, y);
         getCursorChar(colour, charOrd);
         cell.colour:= colour;
         cell.element:= Chr(charOrd);
    dummy:= WriteRead('');  {THIS IS INSTRUMENTAL IN THE PROBLEM! IF I TAKE THIS
    OUT THE PROBLEM GOES AWAY... FOR A WHILE. SEE THE END OF THE PROGRAM FOR
    THE IMPLEMENTATION OF THE ANGUSU UNIT}
         GotoXY(xCarry, yCarry);
    end;

    Function oneString(counter: Byte): String;
    Var
       i: Byte;
       beg, j: Word;
       theString, letters: String;

    Begin
         j:= 1;
         letters:= '';
         theString:= 'Hi I''m Wayne Gretzky I scored 92 goals 10 years ago and
    anyone who sez n that I''m a homosexual can go';
    {     theString:= ConCat(theString, ' get run over by a starship. Max, you sly
    puss. Good grief this could take for Moncton');}
    {     theString:= ConCat(theString, ' ever I mean all the things that we have
    to write');}
         For i:= 1 To counter Do
         Begin
              beg:= j;
              While Not(thestring[j] = ' ') And (j < Length(theString)) Do
                    j:= j + 1;
              j:= j + 1;
         end;
         If j > Length(theString) Then
            letters:= ''
         Else
             For i:= beg To j - 1 Do
                 letters:= Concat(letters,theString[i]);
         oneString:= letters;
    end;

    {Procedure scrSaveParam;}

    Procedure initStack;
    Begin
         scrStack:= Nil;
    end;

    Procedure scrPush(scr: scrPointer; left, right: scrXRange;
                             top, bottom: scrYRange);
    Var
       carryStackPointer: scrStackPointer;
       carryWindMax, carryWindMin: Word;

    Begin
         carryWindMax:= WindMax; carryWindMin:= WindMin;

         Window(1, 1, 80, 25);
         carryStackPointer:= scrStack;
         New(scrStack);
         scrStack^.cursorX:= WhereX; scrStack^.cursorY:= WhereY;
         scrStack^.winMax:= carryWindMax; scrStack^.winMin:= carryWindMin;
         scrStack^.colour:= TextAttr;
         scrStack^.scrWindowPointer:= scr;
         scrStack^.left:= left; scrStack^.right:= right; scrStack^.top:= top;
    scrStack^.bottom:= bottom;
         scrStack^.downward:= carryStackPointer;
         WindMax:= carryWindMax; WindMin:= carryWindMin;
    end;

    Procedure scrPop(Var scr: scrPointer; Var left, right: scrXRange;
                            Var top, bottom: scrYRange);
    Var
       carry: scrStackPointer;

    Begin
         Window(1, 1, 80, 25);
         GotoXY(scrStack^.cursorX, scrStack^.cursorY);
         WindMax:= scrStack^.winMax; WindMin:= scrStack^.winMin;
         TextAttr:= scrStack^.colour;
         scr:= scrStack^.scrWindowPointer;
         left:= scrStack^.left; right:= scrStack^.right; top:= scrStack^.top;
    bottom:= scrStack^.bottom;
         carry:= scrStack;
         scrStack:= scrStack^.downward;
         Dispose(carry);
    end;

    Procedure initWindowPointer(Var pointer: scrPointer);
    Begin
         pointer:= Nil;
    end;

    Procedure scrStoreElement(Var pointer: scrPointer; Var cell: scrElementRecord);
    Var
       buffer: scrPointer;
       messg: Char;

    Begin
         New(buffer);
         buffer^.cell:= cell;
    {messg:= buffer^.cell.element;
    message(messg);
    Write('We are now saving ',Ord(messg));}
         buffer^.next:= Nil;
         If pointer = Nil Then
            pointer:= buffer
         Else
             pointer^.next:= buffer;
    end;

    Procedure scrRetrieveElement(Var pointer: scrPointer; Var charChar: Char);
    Var
       carry: scrPointer;

    Begin
         If pointer= Nil Then
            WriteLn('hey this is Nil!')
         Else
         Begin
         charChar:= pointer^.cell.element;
         TextAttr:= pointer^.cell.colour;
         carry:= pointer;
         pointer:= pointer^.next;
         Dispose(carry);
         end;
    end;

    Procedure windowSave;
    Var
       x: scrXRange;
       y: scrYRange;
       windowPointer: scrPointer;
       cell: scrElementRecord;

    Begin
         initWindowPointer(windowPointer);
         For y:= Hi(WindMin) + 1 To Hi(WindMax) + 1 Do
             For x:= Lo(WindMin) + 1 To Lo(WindMax) + 1 Do
             Begin
                  getChar(x, y, cell);
                  WriteLn('Ok, I get here',x,' ',y,' ',cell.colour,'
    ',Ord(cell.element));
                  scrStoreElement(windowPointer, cell);
             end;
         scrPush(windowPointer, Lo(WindMin) + 1, Lo(WindMax) + 1, Hi(WindMin) + 1,
    Hi(WindMax) + 1);
    end;

    Procedure windowRetrieve;
    Var
       x, left, right: scrXRange;
       y, top, bottom: scrYRange;
       windowPointer: scrPointer;
       element: Char;

    Begin
         scrPop(windowPointer, left, right, top, bottom);
         scrPush(windowPointer, 1, 1, 1, 1);
         Window(1, 1, 80, 25);
         For y:= top To bottom Do
             For x:= left To right Do
             Begin
                  GotoXY(x, y);
    If Not(windowPointer = Nil) Then
                  scrRetrieveElement(windowPointer, element);
                  Write(element);
             end;
         scrPop(windowPointer, left, right, top, bottom);
    end;

    Procedure drawMenu(head: stringPointer; Var extended: Boolean);
    {THIS PROCEDURE IS PASSED A SET OF STRINGS, LINKED-LISTED, AND MAKE A MENU
    OF THEM}
    Var
       size, longest: Word;

       bufferPointer: stringPointer;
       menuWidth, x, middleX: scrXRange;
       menuHeight, y,middleY: scrYRange;

    Begin

         bufferPointer:= head;
         size:= 0; longest:= 0;

         While Not(bufferPointer = Nil) Do
         Begin
              size:= size + 1;
              If (Length(bufferPointer^.streng) > longest) Then longest:=
    Length(bufferPointer^.streng);
              bufferPointer:= bufferPointer^.next;
         end;
         extended:= ((size + 1) Div 2) > (Hi(WindMax) - Hi(WindMin) - 3);

         middleX:= (Lo(WindMax) - Lo(WindMin) + 1) Div 2;
         middleY:= (Hi(WindMax) - Hi(WindMin) + 1) Div 2;
         If extended Then
            Window(middleX - (longest + 1), Hi(WindMin) + 1, middleX + longest + 2,
                           Hi(WindMax) + 1)
         Else
             Window(middleX - (longest + 1), (middleY - 1) - (size - 1) Div 4,
                            middleX + longest + 2, (middleY + 1) + (size + 1) Div
    4);
         shiftWindow(-25, -4);
         windowSave;
         menuWidth:= Lo(WindMax) - Lo(WindMin) - 1;
         menuHeight:= Hi(WindMax) - Hi(WindMin) + 1;
         If extended Then menuHeight:= menuHeight - 1;
         middleX:= (Lo(WindMax) - Lo(WindMin)) Div 2;
         middleY:= (Hi(WindMax) - Hi(WindMin) + 1) Div 2;
         GotoXY(1, 1);
         TextColor(White); Write('É'); For x:= 1 To menuWidth - 2 Do Write('Í');
    WriteLn('»');
         For y:= 2 To menuHeight - 1 Do
         Begin
              TextColor(White); Write('º'); TextColor(Yellow);
              Write(head^.streng);
              clrEol;
              If Not(head^.next = Nil) Then
              Begin
                   GotoXY(middleX + 2, y);
                   Write(head^.next^.streng);
              end;
              head:= head^.next^.next;
              GotoXY(menuWidth, y);
              TextColor(White); WriteLn('º'); TextColor(Yellow);
         end;
         TextColor(White);
         If extended Then
         Begin
              Write('º');
              GotoXY(middleX - 8, WhereY);
              Write('Page Up/Page Down');
              GotoXY(menuWidth, WhereY);
              WriteLn('º');

         end;
         Write('È'); For x:= 1 To menuWidth - 2 Do Write('Í'); Write('¼');
    end;

    Procedure writeLnHighLight(streng: String; foreground, background: Byte);
    Var
       i: Shortint;
       textStart: Byte;

    Begin
         textStart:= TextAttr;
         TextBackground(background);
         TextColor(foreground);
         For i:= 1 To Length(streng) Do
         Begin
              If streng[i] = '(' Then
                 TextColor(White)
              Else
                  If streng[i] = ')' Then
                     TextColor(foreground)
                  Else
                      Write(streng[i]);
         end;
         WriteLn;
         TextAttr:= textStart;
    end;

    Begin
         COUNTER:= 1;
         menuAnswer:= ' ';
         TextBackground(background);
         TextColor(foreground);
         ClrScr;

         writeLnHighLight(' Mailing (L)ist             (C)onfigure Schedual
          (M)ail             E(x)it',
                                   LightBlue, LightGray);
         Window(1, 2, 80, 25);

         menuCand:= 'Wayne Gretzky';
         WriteLn('Ok tell Santa what you want to put in the menu');
         New(bufferPointer);
         head:= bufferPointer;
         q:= Nil;
         While Not(menuCand = '') Do
         Begin
              menuCand:= oneString(COUNTER);
              COUNTER:= COUNTER + 1;
              If Not(menuCand = '') Then
              Begin
                   q^.next:= bufferPointer; bufferPointer^.prev:= q;
    bufferPointer^.next:= Nil;
                   bufferPointer^.streng:= menuCand;
                   q:= bufferPointer;
                   New(bufferPointer);
              end;
         end;
    {THIS PART OF THE PROGRAM IS JUST TRYING TO DRAW A MENU AND SEE IF IT CAN BE
    READ OFF THE SCREEN. SO FAR I HAVEN'T HAD MUCH LUCK.}
         drawMenu(head, extended);
         dummy:= WriteRead('Just lemme know when you''re tired of looking at it
    (Anykey)');
         windowRetrieve;
         While Not(menuAnswer = 'X') Do
         Begin
              menuAnswer:= WriteRead('');
         end;
    end.

    Unit AngusU;

    Interface
             Uses DOS, CRT;

             Type
                 RealDecimalRange = 0..38;

                 DirPointer = ^listpointer;
                 listpointer = Record
                             results: SearchRec;
                             next: DirPointer;
                 end;

             Function WriteRead(message: String): Char;
             {Outputs messages, and waits for a single key input}

             Function WriteReadLn(message: String): String;
             {Outputs message, and waits for entered keyboard input}

             Procedure Dir(pathway: PathStr; Var list: DirPointer);
             {Do the Gilligan's directory thing, and return attributes in linked
    list}

             Function AllUpCase(streng: String): String;

             Function Log(argu: Real): Real;
             {Returns common logrithm}

             Function DeScience(input: Real; decimal: RealDecimalRange): String;
             {Reads a real number and outputs it in string}

    Implementation
                  Function WriteRead(message: string): Char;
    {SO FAR, OTHER THAN ONE OF THE TYPES THIS IS THE ONLY THING FROM THIS UNIT
    THAT I INVOKE. AGAIN, IF I REMOVE THE CODE FROM MY CALLER PROGRAM (I FORGET THE
    PROGRAMMER JARGON FOR IT) THE PROBLEM SEEM TO DECREASE}.
                  {Outputs messages, and waits for a single key input}
                  Begin
                       Write(message);
                       WriteRead:= UpCase(ReadKey);
                  end;

                  Function WriteReadLn(message: String): String;
                  {Outputs message, and waits for entered keyboard input}
                  Var
                     buffer: String;

                  Begin
                       Write(message);
                       ReadLn(buffer);
                       WriteReadLn:= buffer;
                  end;

                  Procedure Dir(pathway: PathStr; Var list: DirPointer);
                  {Do the Gilligan's directory thing, and return attributes in
    linked list}
                  Var
                     carry, buffer: DirPointer;
                     searchBuff: SearchRec;
                     i, j: Integer;

                  Begin
                       New(list);
                       FindFirst(pathway, AnyFile, searchBuff);
                       If DosError = 0 Then
                          list^.results:= searchBuff;

                       New(buffer);
                       list^.next:= buffer;
                       carry:= list;
                       While DosError = 0 Do
                       Begin
                            FindNext(searchBuff);
                            buffer^.results:= searchBuff;
                            If DosError = 0 Then
                            Begin
                                 carry:= buffer;
                                 New(buffer);
                                 carry^.next:= buffer;
                            end;
                       end;
                       carry^.next:= Nil;
                  end;

                  Function AllUpCase(streng: String): String;
                  Var
                     i: Integer;

                  Begin
                       For i:= 1 To Length(streng) Do
                       streng[i]:= UpCase(streng[i]);
                       AllUpCase:= streng
                  end;

                  Function Log(argu: Real): Real;
                  Begin
                       Log:= Ln(argu)/Ln(10);
                  end;

                  Function DeScience(input: Real; decimal: realDecimalRange):
    String;
                  {Reads a real number and outputs it in string}
                  Var
                     buffer: String;
                  Begin
                       Str(input: trunc(Log(input) + 1): decimal, buffer);
                       DeScience:= buffer;
                  end;
    end.

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]