home bbs files messages ]

Just a sample of the Echomail archive

Cooperative anarchy at its finest, still active today. Darkrealms is the Zone 1 Hub.

   PASCAL_LESSONS      Pascal Programming Lessons      361 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 271 of 361   
   mark lewis to Joseph Larsen   
   FPC Oneliners.   
   11 Jun 16 16:53:42   
   
   10 Jun 16 21:10, you wrote to me:   
      
    ml>> what is your bot_bar procedure?   
    ml>>   
      
    JL> --snip---   
      
    JL> Procedure bot_bar;   
      
   i've gone back to your original post where i asked you if you were still stuck   
   on this... it needs a few additional items added to make it stand alone for   
   development and testing... a routine or two and the display files... i have no   
   idea what they are supposed to contain so in plain ascii, what do the files   
   onen.ans, oney.ans, oneh.ans contain? i'm guessing that oneh.ans is a header   
   of some kind and maybe the others are yes and no prompts but what are they   
   prompting? i just need simple basics to work with... here's what i've worked   
   up with full debugging and my displaykey routine... i don't see any problem   
   with the UPARR or DNARR keys and getting into either TOP_BAR or BOT_BAR...   
   here's everything i have and the display files at the bottom...   
      
   NOTE: this message is over 475 lines long...   
      
      
   ==== Begin "oneliners.pas"  ====   
   program oneliners;   
   {$mode objfpc}   
      
   uses   
     crt, classes, sysutils;   
      
   type   
     userrec=record   
               name : string[36];   
             end;   
      
   var  Twriters  : array[1..10] of string;   
   var  Toneliner : array[1..10] of string;   
   var  S         : string;   
   var  Foneline  : string;   
   var  Ch1       : char;   
   var  Ch2       : char;   
   var  Count2    : byte;   
   var  thisuser  : userrec;   
      
   procedure displaykey(var thechar1, thechar2 : char);   
      
   begin   
     case thechar1 of   
       #00 : begin   
               write('    double character key - ');   
               case thechar2 of   
                 #16 : writeln('ALT-Q');   
                 #17 : writeln('ALT-W');   
                 #18 : writeln('ALT-E');   
                 #19 : writeln('ALT-R');   
                 #20 : writeln('ALT-T');   
                 #21 : writeln('ALT-Y');   
                 #22 : writeln('ALT-U');   
                 #23 : writeln('ALT-I');   
                 #24 : writeln('ALT-O');   
                 #25 : writeln('ALT-P');   
      
                 #30 : writeln('ALT-A');   
                 #31 : writeln('ALT-S');   
                 #32 : writeln('ALT-D');   
                 #33 : writeln('ALT-F');   
                 #34 : writeln('ALT-G');   
                 #35 : writeln('ALT-H');   
                 #36 : writeln('ALT-J');   
                 #37 : writeln('ALT-K');   
                 #38 : writeln('ALT-L');   
      
                 #44 : writeln('ALT-Z');   
                 #45 : writeln('ALT-X');   
                 #46 : writeln('ALT-C');   
                 #47 : writeln('ALT-V');   
                 #48 : writeln('ALT-B');   
                 #49 : writeln('ALT-N');   
                 #50 : writeln('ALT-M');   
      
                 #59 : writeln('F1');   
                 #60 : writeln('F2');   
                 #61 : writeln('F3');   
                 #62 : writeln('F4');   
                 #63 : writeln('F5');   
                 #64 : writeln('F6');   
                 #65 : writeln('F7');   
                 #66 : writeln('F8');   
                 #67 : writeln('F9');   
                 #68 : writeln('F10');   
      
                 #71 : writeln('HOME');   
                 #72 : writeln('UPARR');   
                 #73 : writeln('PGUP');   
      
                 #75 : writeln('LFARR');   
      
                 #77 : writeln('RTARR');   
      
                 #79 : writeln('END');   
                 #80 : writeln('DNARR');   
                 #81 : writeln('PGDN');   
                 #82 : writeln('INSERT');   
                 #83 : writeln('DELETE');   
      
                 #104 : writeln('ALT-F1');   
                 #105 : writeln('ALT-F2');   
                 #106 : writeln('ALT-F3');   
                 #107 : writeln('ALT-F4');   
                 #108 : writeln('ALT-F5');   
                 #109 : writeln('ALT-F6');   
                 #110 : writeln('ALT-F7');   
                 #111 : writeln('ALT-F8');   
                 #112 : writeln('ALT-F9');   
                 #113 : writeln('ALT-F10');   
      
                 #133 : writeln('F11');   
                 #134 : writeln('F12');   
      
                 #139 : writeln('ALT-F11');   
                 #140 : writeln('ALT-F12');   
               else   
                 writeln('    unknown double character key = #',ord(thechar1),'   
   #',ord(thechar2));   
               end; {case thechar2}   
             end; {begin thechar1 = #00}   
     else   
       begin   
         write('    single character key - ');   
         case thechar1 of   
           #01 : writeln('CTRL-A');   
           #02 : writeln('CTRL-B');   
           #03 : writeln('CTRL-C');   
           #04 : writeln('CTRL-D');   
           #05 : writeln('CTRL-E');   
           #06 : writeln('CTRL-F');   
           #07 : writeln('CTRL-G');   
           #08 : writeln('BCKSPC');   
           #09 : writeln('TAB');   
           #10 : writeln('LF');   
           #11 : writeln('VT');   
           #12 : writeln('FF');   
           #13 : writeln('ENTER');   
           #14 : writeln('CTRL-N');   
           #15 : writeln('CTRL-O');   
           #16 : writeln('CTRL-P');   
           #17 : writeln('CTRL-Q');   
           #18 : writeln('CTRL-R');   
           #19 : writeln('CTRL-S');   
           #20 : writeln('CTRL-T');   
           #21 : writeln('CTRL-U');   
           #22 : writeln('CTRL-V');   
           #23 : writeln('CTRL-W');   
           #24 : writeln('CTRL-X');   
           #25 : writeln('CTRL-Y');   
           #26 : writeln('CTRL-Z');   
           #27 : writeln('ESC');   
           #28 : writeln('FS');   
           #29 : writeln('GS');   
           #30 : writeln('RS');   
           #31 : writeln('US');   
           #32 : writeln('SPACE');   
         else   
           writeln(chr(byte(thechar1)),' = #',ord(thechar1));   
         end; {case thechar1}   
       end; {begin}   
     end;   
   end;   
      
   //### begin printf procedure ####################################   
   //### temporary routine to provide printf without needing the   
   //### entire impulse package   
   procedure printf(thefile : string);   
      
   var   
     filecontents : TStringList;   
     thisline : integer;   
      
   begin   
     writeln('  PRINTF: entering PRINTF routine');   
     writeln('  PRINTF: creating stringlist to hold file contents');   
     filecontents.sorted := false;   
     filecontents := TStringList.Create;   
     try   
       writeln('  PRINTF: attempting to load file ',thefile);   
       filecontents.LoadFromFile(thefile);   
       writeln('  PRINTF: display ',IntToStr(filecontents.Count),' lines');   
       for thisline := 0 to filecontents.Count-1 do   
         begin   
           writeln(filecontents.Strings[thisline]);   
         end;   
     finally   
       writeln('  PRINTF: dump stringlist contents and free memory');   
       if Assigned(filecontents) then   
         FreeAndNil(filecontents);   
     end;   
     writeln('  PRINTF: leaving PRINTF routine');   
   end;   
   //### end printf procedure ######################################   
      
   //### begin show procedure ######################################   
   Procedure show;   
      
   var Count : byte;   
      
   Begin   
     writeln('  SHOW: entering SHOW routine');   
     writeln('  SHOW: going to PRINTF(''oneh.ans'')');   
     printf('oneh.ans');   
     writeln('  SHOW: back from PRINTF(''oneh.ans'')');   
     writeln('  SHOW: displaying current oneliners');   
     For Count := 1 To 10 Do   
       Begin;   
         write(Twriters[Count],' - ');   
         WriteLn(Toneliner[Count]);   
       End;   
     writeln('  SHOW: finished displaying current oneliners');   
     writeln('  SHOW: leaving SHOW routine');   
   End; // show   
   //### end show procedure ########################################   
      
   //### begin init procedure ######################################   
   Procedure init;   
      
   Var f1 : textfile;   
   var Count : byte;   
   var myfilecode : word;   
      
   Begin   
     writeln('  INIT: entering INIT routine');   
   //  GetThisUser;   
   // just stuff something into thisuser.name to get the prog to run   
     writeln('  INIT: assign thisuser.name');   
     thisuser.name := 'my goofy user';   
      
     writeln('  INIT: look for oneliner.lst');   
     fOneLine := ('./oneliner.lst');   
     If Not fileExists(fOneLine) Then   
       Begin   
         writeln('  INIT: creating oneliner.lst with default entries');   
         Assign(f1, fOneLine);   
         ReWrite(f1);   
         For Count := 1 To 10 Do   
           Begin   
             WriteLn(f1,'Ia! Cthulhu!');   
             WriteLn(f1,'IGNATIUS');   
           End;   
         Close(f1);   
       End;   
      
     writeln('  INIT: reading oneliner.lst');   
     Assign(f1, fOneLine);   
   // make sure to turn off iochecking if using IoResult   
     {$I-}   
     Reset(f1);   
   // turn iochecking back on   
     {$I+}   
   // grab the IoResult to our own variable   
     myfilecode := IoResult;   
   // reverse the logic from "= 0" to "<> 0" so we can print an error message   
     If myfilecode <> 0 Then   
       begin   
         writeln('  INIT: ioresult ',myfilecode,' while reading oneliner.lst');   
         writeln('  INIT: aborting program');   
         halt;   
       end   
     else   
       Begin   
         For Count := 1 To 10 Do   
           Begin   
             ReadLn(f1, Toneliner[Count]);   
             ReadLn(f1, Twriters[Count]);   
           End;   
         Close(f1);   
       End;   
     writeln('  INIT: leaving INIT routine');   
   End; // Init   
   //### end init procedure ########################################   
      
   //### begin bot_bar procedure ###################################   
   Procedure bot_bar;   
      
   Begin   
     writeln('  BOT_BAR: entering BOT_BAR routine');   
     ch1 := #00;   
     ch2 := #00;   
     writeln('  BOT_BAR: going to PRINTF(''onen.ans'')');   
     printf('onen.ans');   
     writeln('  BOT_BAR: back from PRINTF(''onen.ans'')');   
     writeln('  BOT_BAR: any key to show or ENTER to exit BOT_BAR');   
     Ch1 := ReadKey;   
     case ch1 of   
       #00 : begin   
               ch2 := readkey;   
               displaykey(ch1,ch2);   
             end; {begin ch1 = #00}   
     else   
       displaykey(ch1,ch2);   
     end; {case ch1}   
     If Ch1 = #13 then   
       Begin   
         writeln('  BOT_BAR: leaving BOT_BAR via ENTER key');   
         exit;   
       End;   
     writeln('  BOT_BAR: going to SHOW routine');   
     show;   
     writeln('  BOT_BAR: back from SHOW routine');   
     writeln('  BOT_BAR: leaving BOT_BAR via normal exit');   
   End; // bot_bar   
   //### end bot_bar procedure #####################################   
      
   //### begin top_bar procedure ###################################   
   Procedure top_bar;   
      
   Var f1 : textfile;   
   var Count : byte;   
      
   Begin   
     writeln('  TOP_BAR: entering TOP_BAR routine');   
     ch1 := #00;   
     ch2 := #00;   
     writeln('  TOP_BAR: going to PRINTF(''oney.ans'')');   
     printf('oney.ans');   
     writeln('  TOP_BAR: back from PRINTF(''oney.ans'')');   
     writeln('  TOP_BAR: any key to exit TOP_BAR or ENTER to add a oneliner');   
     Ch1 := ReadKey;   
     case ch1 of   
       #00 : begin   
               ch2 := readkey;   
               displaykey(ch1,ch2);   
             end; {begin ch1 = #00}   
     else   
       displaykey(ch1,ch2);   
     end; {case ch1}   
     If Ch1 = #13 then   
       Begin   
         writeln('  TOP_BAR: going to PRINTF(''oneline.asc'')');   
         printf('oneline.asc');   
         writeln('  TOP_BAR: back from PRINTF(''oneline.asc'')');   
         // temp readln replacing inputl to avoid needing entire impulse code   
         readln(s);   
         If s = '' then   
           Begin   
             WriteLn('aborted');   
             writeln('  TOP_BAR: going to SHOW routine');   
             show;   
             writeln('  TOP_BAR: back from SHOW routine');   
             writeln('  TOP_BAR: leaving TOP_BAR via blank oneliner line');   
             Exit;   
           End;   
      
         For Count := 1 To 9 Do   
           Begin   
             Count2 := Count + 1;   
             Toneliner[Count] := Toneliner[Count2];   
             Twriters[Count] := Twriters[Count2];   
           End;   
      
         tWriters[10]:=thisuser.name;   
         tOneliner[10] := s;   
      
         Assign(f1, fOneLine);   
         ReWrite(f1);   
         For Count := 1 To 10 do   
           Begin   
             WriteLn(f1,tOneliner[Count]);   
             WriteLn(f1,tWriters[Count]);   
           End;   
         Close(f1);   
       End;   
     writeln('  TOP_BAR: going to SHOW routine');   
     show;   
     writeln('  TOP_BAR: back from SHOW routine');   
     writeln('  TOP_BAR: leaving TOP_BAR via normal exit');   
   End; // top_bar   
   //### end top_bar procedure #####################################   
      
   //### begin position procedure ##################################   
   Procedure position;   
      
   Begin   
     writeln('POSITION: entering POSITION routine');   
     writeln('POSITION: do show routine');   
     show;   
     writeln('POSITION: any key to continue or ENTER to exit');   
     Repeat   
       ch1 := #00;   
       ch2 := #00;   
       ch1 := ReadKey;   
       case ch1 of   
         #00 : begin   
                 ch2:=ReadKey;   
                 displaykey(ch1,ch2);   
                 case ch2 of   
                   #80 : begin   
                           writeln('POSITION: going to BOT_BAR routine');   
                           bot_bar;   
                           writeln('POSITION: back from BOT_BAR routine');   
                         end;   
                   #72 : begin   
                           writeln('POSITION: going to TOP_BAR routine');   
                           top_bar;   
                           writeln('POSITION: back from TOP_BAR routine');   
                         end;   
                 end;   
               end;   
       else   
         displaykey(ch1,ch2);   
       end; {case ch1}   
     until ch1=#13;   
     writeln('POSITION: leaving POSITION routine');   
   end;   
   //### end position procedure ####################################   
      
   Begin   
     writeln('MAIN: going to INIT routine');   
     init;   
     writeln('MAIN: back from INIT routine');   
     writeln('MAIN: going to POSITION routine');   
     Position;   
     writeln('MAIN: back from POSITION routine');   
   End.   
      
   ==== End "oneliners.pas" ====   
      
      
      
   ==== Begin "oneh.ans"  ====   
      
                             ONELINERS! Whoohoo!   
      
                     Displaying 10 most recent oneliners.   
   ===============================================================================   
   ==== End "oneh.ans" ====   
      
      
      
   ==== Begin "onen.ans"  ====   
      
   this is onen.ans. what is it supposed to say?   
      
   ==== End "onen.ans" ====   
      
      
      
   ==== Begin "oney.ans"  ====   
      
   Do you want to add to the oneliners? ENTER=Yes, any other key=no   
      
   ==== End "oney.ans" ====   
      
      
      
   ==== Begin "oneline.asc"  ====   
      
   this is oneline.asc. what is it supposed to say??   
      
   ==== End "oneline.asc" ====   
      
      
      
   ==== Begin "oneliner.lst"  ====   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   Ia! Cthulhu!   
   IGNATIUS   
   foobery foober foo   
   my goofy user   
   this is my oneliner!   
   my goofy user   
   ==== End "oneliner.lst" ====   
      
      
   )\/(ark   
      
   Always Mount a Scratch Monkey   
      
   ... Men find it difficult to make eye contact cause breasts don't have eyes.   
   ---   
    * Origin:  (1:3634/12.73)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca