Message Area
Casually read the BBS message area using an easy to use interface. Messages are categorized exactly like they are on the BBS. You may post new messages or reply to existing messages!

You are not logged in. Login here for full access privileges.

Previous Message | Next Message | Back to Pascal Programming Lessons  <--  <--- Return to Home Page
   Networked Database  Pascal Programming Lessons   [13 / 36] RSS
 From   To   Subject   Date/Time 
Message   mark lewis    Joseph Larsen   FPC Oneliners.   June 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)
  Show ANSI Codes | Hide BBCodes | Show Color Codes | Hide Encoding | Hide HTML Tags | Show Routing
Previous Message | Next Message | Back to Pascal Programming Lessons  <--  <--- Return to Home Page

VADV-PHP
Execution Time: 0.0914 seconds

If you experience any problems with this website or need help, contact the webmaster.
VADV-PHP Copyright © 2002-2024 Steve Winn, Aspect Technologies. All Rights Reserved.
Virtual Advanced Copyright © 1995-1997 Roland De Graaf.
v2.0.140505

Warning: Unknown: open(c:\Sessions\sess_qcepq8ma0psro4kisv4vvtcl63, O_RDWR) failed: No such file or directory (2) in Unknown on line 0 Warning: Unknown: Failed to write session data (files). Please verify that the current setting of session.save_path is correct (c:\Sessions) in Unknown on line 0 PHP Warning: session_start(): open(c:\Sessions\sess_qcepq8ma0psro4kisv4vvtcl63, O_RDWR) failed: No such file or directory (2) in D:\wc5\http\public\VADV\include\common.inc.php on line 45 PHP Warning: Unknown: open(c:\Sessions\sess_qcepq8ma0psro4kisv4vvtcl63, O_RDWR) failed: No such file or directory (2) in Unknown on line 0 PHP Warning: Unknown: Failed to write session data (files). Please verify that the current setting of session.save_path is correct (c:\Sessions) in Unknown on line 0