Subj : FPC Oneliners.
To   : Joseph Larsen
From : mark lewis
Date : Sat Jun 11 2016 04:53 pm


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)

You are viewing proxied material from cvs.synchro.net. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.