Subj : FPC Oneliners.
To   : Joseph Larsen
From : mark lewis
Date : Sun Jun 12 2016 10:21 am


12 Jun 16 06:38, you wrote to me:

ml>> i've gone back to your original post where i asked you if you were stil
ml>>

JL> Hmm. Not sure why the quoted portions are truncated. But, anyway, you are
JL> correct about the oneh.ans, onen.ans, and oney.ans files.

can you provide simple ASCII versions of those files, please? i can't tell what
they should say by the code context... i made a guess at two of them but...

JL> I'll try the code out.

the main thing is all the additional debugging code so we can follow the logic
flow... i think it can be completely revised and simplified... as i haven't
looked at it, i'm pretty sure that a lot could be rewritten using new
techniques which are simplier and easier to use... the PRINTF routine i threw
in there using TStringList is one example...

JL> Thank you!

luckily enough, i had a few hours to try to work with it yesterday... there are
some problems (initial file loading if it doesn't exist) but they can be worked
around... personally, i think i'd restructure the oneliners file to contain all
the info on one like and then maybe break it apart for display... TStringList
would works great for lines of text... using a TStringList would also allow for
moving away from the older style of manually doing all the file reading and
writing as TStringList already handles that on its own with LoadFromFile and
SaveToFile... like this small rewrite...

==== Begin "myoneliners.pas"  ====
program myoneliners;
{$mode objfpc}

uses
 crt, classes, sysutils;

type
 userrec=record
           name : string[36];
         end;

const onehfname      = './oneh.ans';
const onenfname      = './onen.ans';
const oneyfname      = './oney.ans';
const onelinefname   = './oneline.asc';
const onelinersfname = './oneliners.lst';

var  S            : string;
var  Ch1          : char;
var  Ch2          : char;
var  thisuser     : userrec;
var  theoneliners : TStringList;


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 := TStringList.Create;
 filecontents.sorted := false;
 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 : integer;

Begin
 writeln('    SHOW: entering SHOW routine');
 writeln('    SHOW: going to PRINTF(''',onehfname,''')');
 printf(onehfname);
 writeln('    SHOW: back from PRINTF(''',onehfname,''')');
 writeln('    SHOW: displaying current oneliners');
 for count := 0 to theoneliners.Count-1 do
   begin
     writeln(theoneliners.Strings[count]);
   end;
 writeln('    SHOW: finished displaying current oneliners');
 writeln('    SHOW: leaving SHOW routine');
End; // show
//### end show procedure ########################################

//### begin init procedure ######################################
Procedure init;

var Count : byte;

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: creating stringlist to hold oneliners file contents');
 theoneliners := TStringList.Create;
 theoneliners.sorted := false;
 try
   writeln('  INIT: loading default writers and oneliners');
   For Count := 1 To 10 Do
     Begin
       theoneliners.add('IGNATIUS: Ia! Cthulhu!');
     End;
   writeln('  INIT: defaults loaded');

   if FileExists(onelinersfname) then
     begin
       writeln('  INIT: attempting to load oneliners file ',onelinersfname);
       theoneliners.LoadFromFile(onelinersfname);
     end
   else
     begin
       writeln('  INIT: writing initial oneliners file ',onelinersfname);
       theoneliners.SaveToFile(onelinersfname);
     end;

   writeln('  INIT: oneliners file contains ',IntToStr(theoneliners.Count),'
lines');
 finally
 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(''',onenfname,''')');
 printf(onenfname);
 writeln('  BOT_BAR: back from PRINTF(''',onenfname,''')');
 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;

Begin
 writeln('  TOP_BAR: entering TOP_BAR routine');
 ch1 := #00;
 ch2 := #00;
 writeln('  TOP_BAR: going to PRINTF(''',oneyfname,''')');
 printf(oneyfname);
 writeln('  TOP_BAR: back from PRINTF(''',oneyfname,''')');
 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(''',onelinefname,''')');
     printf(onelinefname);
     writeln('  TOP_BAR: back from PRINTF(''',onelinefname,''')');
     // temp readln replacing inputl to avoid needing entire impulse code
     readln(s);
     If s = '' then
       Begin
         WriteLn('  TOP_BAR: aborted adding new oneliner');
         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;

     writeln('  TOP_BAR: deleting oldest oneliner from top of list');
     theoneliners.delete(0);
     writeln('  TOP_BAR: adding new oneliner to bottom of list');
     theoneliners.add(thisuser.name+': '+s);
     writeln('  TOP_BAR: saving modified oneliners file ',onelinersfname);
     theoneliners.SaveToFile(onelinersfname);

   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
 try
   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');
   writeln('MAIN: dump stringlist contents and free memory');
 finally
   if Assigned(theoneliners) then
     FreeAndNil(theoneliners);
 end;
End.

==== End "myoneliners.pas" ====

)\/(ark

Always Mount a Scratch Monkey

... Machine-independent Program: program which will not run on any machine.
---
* Origin:  (1:3634/12.73)