Board index » delphi » Groovy Little Program

Groovy Little Program

Blargh.  Flames suck.

Anyways.

Here's a groovy little program I wrote a while back
named PowerHyperText.  It is only hypertextual
in the vaguest sense of the word -- it's mostly menu
driven, but the menus themselves are text files
which are easily editable.  I believe the version I'm
posting has a really slow textscroller, but I'm not
sure -- you'll have to check on that.  If it does,
you'll notice that it resets the file every display.
*chuckle* I used it to view a 1.3mb file a while
back just to see how slow it got, and on my
Cyrix 6x86 P166+ it got really lagged (using
'Net terms here).  It's really quite pointless,
but I figure I'll post it both to show my
psycho style and possibly as something
you can use in your spare time.

Program ExercitiumMagus (Input, Output, UseFile);

Uses
   CRT;

Const
   MNEnt = 20;

Type
   MType = (NMenu, DspFile, Exit);
   Info = String[80];
   Dat = Record
             Name: Info;
             Entry: MType;
             Path: Info;
          End;
   MData = Record
              Data: Array [1..MNEnt] of Dat;
           End;

Var
   UseFile: text;
   Quit: boolean;
   MPath: Info;

Procedure ClrArr;

   Begin
      GotoXY (2, WhereY);
      Write ('   ');
   End;

Procedure DrwArr;

   Begin
      GotoXY (2, WhereY);
      Write ('-->');
   End;

Procedure MvArUp (TopLine, BotLine: integer);

   Var
      Y: integer;

   Begin
      ClrArr;
      If WhereY = TopLine then
         Y := BotLine
      Else Y := WhereY - 1;
      GotoXY (2, Y);
      DrwArr;
   End;

Procedure MvArDn (TopLine, BotLine: integer);

   Var
      Y: integer;

   Begin
      ClrArr;
      If WhereY = BotLine then
         Y := TopLine
      Else Y := WhereY + 1;
      GotoXY (2, Y);
      DrwArr;
   End;

Procedure RecvMove (TopLine, BotLine: integer;
                    Var Finis: boolean);

   Var
      RK: char;

   Begin
      Case UpCase(ReadKey) of
         #0: Case UpCase(ReadKey) of
                #72, #75: MvArUp (TopLine, BotLine);
                #77, #80: MvArDn (TopLine, BotLine);
             End;
         #13: Finis := true;
      End;
   End;

Procedure GetAns (TopLine, BotLine: integer;
                  Var Finis: boolean);

   Begin
      GotoXY (2, TopLine);
      DrwArr;
      Repeat
         RecvMove (TopLine, BotLine, Finis);
      Until Finis;
   End;

Procedure GetEnt;

   Begin
      WriteLn;
      Write ('Press [Enter] to continue...');
      ReadKey;
      WriteLn;
   End;

Procedure DispText (CmdLine: Info);

   Var
      TLine: Info;
      LineCount: integer;
      Ch: Char;
   Begin
      ClrScr;
      LineCount := 0;
      Assign (UseFile, CmdLine);
      Reset (UseFile);
      While Not EoF(UseFile) do
         Begin
            LineCount := LineCount + 1;
            ReadLn (UseFile, TLine);
            WriteLn (TLine);
            If LineCount mod 22 = 0 then
               Begin
                  GetEnt;
                  ClrScr;
                  LineCount := 0;
               End;
         End;
      GetEnt;
      Close (UseFile);
   End;

Procedure MakeHead (Heading: Info);

   Begin
      WriteLn (Heading:40 + (Length(Heading)) div 2);
   End;

Procedure ClearMenu (Var Menu: MData);

   Var
      Loop: integer;

   Begin
      For Loop := 1 to MNEnt do
         With Menu.Data[Loop] do
            Name := '';
   End;

Procedure RunMenu (Var Quit: boolean;
                   Path: Info);

   Var
      TopLine, BotLine, Numba, NumEntries: integer;
      Menu: MData;
      Ch: char;
      Heading: Info;
      Finis: boolean;

   Begin
      Repeat
         ClrScr;
         ClearMenu (Menu);
         Quit := false;
         Finis := false;
         Numba := 0;
         Assign (UseFile, Path);
         Reset (UseFile);
         ReadLn (UseFile, Heading);
         MakeHead (Heading);
         ReadLn (UseFile, TopLine);
         ReadLn (UseFile, BotLine);
         Window (6, TopLine, 80, BotLine + 2);
         While (Not EoF (UseFile)) and (Numba <= MNEnt - 1) do
            Begin
               Numba := Numba + 1;
               With Menu.Data[Numba] do
                  Begin
                     ReadLn (UseFile, Name);
                     Read (UseFile, Ch);
                     Case Ch of
                        'M': Entry := NMenu;
                        'D': Entry := DspFile;
                        'Q': Entry := Exit;
                     End;
                     Read (UseFile, Ch);
                     ReadLn (UseFile, Path);
                  End;
            End;
         Close (UseFile);
         NumEntries := Numba;
         For Numba := 1 to NumEntries do
            With Menu.Data[Numba] do
               WriteLn (Name);
         Window (1, 1, 80, 25);
         Repeat
            GotoXY (2, TopLine);
            GetAns (TopLine, BotLine, Finis);
         Until Finis;
         For Numba := 1 to NumEntries do
            If WhereY - TopLine + 1 = Numba then
               With Menu.Data[Numba] do
                  Begin
                     Case Entry of
                        NMenu: Begin
                                  RunMenu (Quit, Path);
                                  Quit := false;
                               End;
                        DspFile: DispText (Path);
                        Exit: Quit := true;
                     End;
                  End;
      Until Quit;
      ClrScr;
   End;

Begin
   If ParamStr(1) <> '' then
      MPath := ParamStr(1)
   Else
      MPath := 'main.mnu';
   Repeat
      RunMenu (Quit, MPath);
   Until Quit;
End.

You should be able to figure out the file format
from the program itself, as I tend to give
descriptive variables.  If not, I'll try to remember
how the hell this program works. :)

Phil Bordelon
slvrt...@intersurf.com
http://www.intersurf.com/~slvrtree
Comments welcome (good or bad, as long
as the basis is sound *cough*)

 

Re:Groovy Little Program


Quote
Phil Bordelon wrote:

> [snip]
> It's really quite pointless,
> but I figure I'll post it both to show my
> psycho style and possibly as something
> you can use in your spare time.

To bad we programmers never have any spare time :)

Joke/dST

Re:Groovy Little Program


Quote
> To bad we programmers never have any spare time :)

> Joke/dST

Methinks I found some sample files on my computer.
Might post them tonight. :)

Phil Bordelon

Re:Groovy Little Program


-=[ In:slvrt...@intersurf.com was heard to say... ]=-

 In> Methinks I found some sample files on my computer.
 In> Might post them tonight. :)

 In> Phil Bordelon

Please don't post source code just for the hell of it. Most people will not
be interested in it, and those that are could just as easily get it if you
gave them a pointer where to get it on the web or through ftp.

  /-=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=-\
  $                  Kim Forwood  <kim.forw...@crcn.net>                 %
  %        Author of Disk Ease v0.9.1 Floppy Disk Indexer/Database       $
  $              http://goodship.cn.camriv.bc.ca/~kforwood/              %
  \-=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=--=oOo=-/
            WARNING:  Unsolicited advertising will be reported
                  to your ISP. Flames merely laughed at.

___ Blue Wave/QWK v2.20

Re:Groovy Little Program


Quote
>  In> Methinks I found some sample files on my computer.
>  In> Might post them tonight. :)

>  In> Phil Bordelon

> Please don't post source code just for the hell of it. Most people will
not
> be interested in it, and those that are could just as easily get it if
you
> gave them a pointer where to get it on the web or through ftp.

or you could just not download it.  It's not that long of a message,
and there's a lot worse spam on the Usenet, believe me.

Phil

Re:Groovy Little Program


slvrt...@intersurf.com wrote on 12.03.97:

Quote
> or you could just not download it.  It's not that long of a message,
> and there's a lot worse spam on the Usenet, believe me.

Unlike America, in Europe local phone calls are not free.

Those of us with UUCP accounts have no choice in what messages to download.

Each message costs us money -- the larger ones obviously cost more.

Please do not post large binaries to this group.

Chris Mathews

Re:Groovy Little Program


The Sourceware Archive Group at http://www.gdsoft.com/swag/swag.html
is just the ticket if you would like to share your source.

Other Threads