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