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   [10 / 36] RSS
 From   To   Subject   Date/Time 
Message   mark lewis    Joseph Larsen   FPC Oneliners.   June 11, 2016
 4: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)
  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.1065 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_2p9t4pss58hemlavd2r3u5can1, 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_2p9t4pss58hemlavd2r3u5can1, 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_2p9t4pss58hemlavd2r3u5can1, 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