CP/M/CPM_CDROM.iso/simtel/sigm/vols000/vol072/checkbk.pas

Pascal/Delphi Source File | 1984-04-29 | 10.6 KB | 450 lines

(************************************************
*
*        CHECKBK PROGRAM
*
*  It always shocks me when I do something I don't
* think I would ever do but when I was handed this
* program from BYTE magazine I really scared myself.
* I sat down that same day and four hours later had
* it all typed in and debugged. As lazy as I am that
* set a record. I have never been know to stick to
* it that long. Ray Penley you would have been
* proud of me.
*
*  I always like to give credit to the author of a
* program but in this case I'll need help. BYTE blew
* it pretty bad during the Jan 1982 issue and lost
* a huge chunk of the West Coast's mail of their
* issue. Furthermore, they refused to resend it.
* So this program was send to me on a poor paper
* copy. I was able to guess at the program because
* it had some logic to it but the Author I couldn't
* figure out. So whoever you are, I apologize. But
* this was in the Jan 1982 issue of Byte under the
* name of NOW. Pretty good job anyway.
*
*  I wrote this in Pascal/Z and created a Data file
* to go along with the program. You can go into the
* source and change things but hang onto the data
* file. Otherwise, you'll have to compile twice.
* Once to comment out the READFILE procedure so you
* can run the program and create the disk data file.
* Then you'll have to put READFILE back in and re-
* compile.
*
*  How about you all improveing this thing and sending
* me the updates for the membership. I'll be
* working on it.
*
* Charlie Foster, March 1982
**************************************************)

PROGRAM checkbk;

CONST
    maxItems = 300;
    maxCodes = 50;
    maxAddCode = 10;
    diskFile = 'a:DATA.82';
TYPE
    itemData = RECORD
        itemNumber : INTEGER;
        month      : INTEGER;
        day        : INTEGER;
        year       : INTEGER;
        amount     : REAL;
        description: STRING 30;
        code       : INTEGER;
        END;

    $STRING0 = STRING 0;
    $STRING255 = STRING 255;
VAR
    command     : CHAR;
    ItemCode   : ARRAY[1..maxCodes] OF STRING 15;
    items  : ARRAY[1..maxItems] OF itemData;
    itemLast    : 1..maxItems;
    dataFile    : File of itemData;
    linesPrinted    : 0..80;
    codeAmount    : ARRAY[1..maxCodes] OF REAL;
    entryYear    : INTEGER;
    swaped        : BOOLEAN;
    answer        : CHAR;
    result        : INTEGER;

FUNCTION length (x:$STRING255) : INTEGER; EXTERNAL;

PROCEDURE initialize;    {this sets initial code values}

VAR
    count : 0..maxItems;
BEGIN
    ItemLast := 1;
    FOR count := 1 TO maxCodes DO
      ItemCode[count] := '               ';

    {now we list the code items, can be changed}
{Family}
    ItemCode[1] := 'Zug Balance';
    ItemCode[2] := 'Family Balance';
    ItemCode[3] := 'Zug Deposit';
    ItemCode[4] := 'Family Deposit';
    ItemCode[5] := 'Zug Interest';
    ItemCode[6] := 'Family Interest';
    { #'s 7,8,8,10 for future}
    ItemCode[11] := 'House Payment';
    ItemCode[12] := 'Car Lease';
    ItemCode[13] := 'Car Expenses';
    ItemCode[14] := 'Electricity';
    ItemCode[15] := 'Gas';
    ItemCode[16] := 'Credit Cards';
    ItemCode[17] := 'Insurance';
    ItemCode[18] := 'Telephone';
    ItemCode[19] := 'Contributions';
    ItemCode[20] := 'Water/Sewer';
    ItemCode[21] := 'Taxes';
    ItemCode[22] := 'Food';
    ItemCode[23] := 'Medical';
    ItemCode[24] := 'Misc.expenses';
{Pascal/Z}
    ItemCode[25] := 'Computer Lease';
    ItemCode[26] := 'Car Expenses';
    ItemCode[27] := 'Disks';
    ItemCode[28] := 'Printing';
    ItemCode[29] := 'Postage';
    ItemCode[30] := 'Books';
    ItemCode[31] := 'Software';
    ItemCode[32] := 'Printer Expen.';
    ItemCode[33] := 'Trip Expen.';
    ItemCode[34] := 'Equipment';
    ItemCode[35] := 'Misc.expenses';
    { #'s 36 through 50 for future }

END;

PROCEDURE newpage;
    { print form-feed and 2 blank lines}
BEGIN
    WRITELN(CHR(12));
    WRITELN;
    WRITELN;
    linesPrinted := 0;
END;

PROCEDURE instructions;
    { print description of program operation}
    { ADD my header program once debugged}
VAR
    pause,answer : CHAR;
    count        : INTEGER;
BEGIN
    newpage;
    WRITELN(' ':15,'THE (your name) CHECKBOOK PROGRAM');
    WRITELN(' ':24,'Version 1.0');
    WRITELN;
    WRITE('Do you want some instructions?  ');
    READ(answer);
    WRITELN;
    IF (answer = 'Y') OR (answer ='y') THEN
      BEGIN
        newpage;
        WRITELN('-----------Commands------------');
        WRITELN;
        WRITELN('A - Add an item');
        WRITELN('R - Remove an item');
        WRITELN('P - Print all items');
        WRITELN('B - Print Balance');
        WRITELN('S - Sort by date');
        WRITELN('D - Dump to disk');
        WRITELN('L - Load from disk');
        WRITELN('Q - Quit');
        WRITELN;
        WRITELN;
        WRITELN ('Hit any key to continue---');
        READLN (pause);
        WRITELN('Code          Description');
        FOR  count := 1 TO 27 DO
        WRITE('-');
        WRITELN;
        FOR count := 1 TO 50 DO
        IF ItemCode[count] <> '               ' THEN
          WRITELN(count:3,'   ',ItemCode[count]);
    END;
END;


PROCEDURE heading;
    {print heading for new page of item printout}
VAR
    count : 0..79;
BEGIN
    WRITE(' Item     Date         Amount       ');
    WRITE('      Description              Code');
    WRITELN;
    FOR count := 1 TO 79 DO
      WRITE('-');
    WRITELN;
END;

PROCEDURE itemPrint ( count : INTEGER);
    { print data on one item}
BEGIN
    WITH items[count] DO
      BEGIN
        WRITE(itemNumber:5);
        WRITE(month:5,'/');
        IF day < 10 THEN
          WRITE('0',day:1)
        ELSE
          WRITE(DAY:2);
        WRITE('/',year:2);
        WRITE(amount:14:2);
        WRITE('    ',description);
        WRITE('  ',ItemCode[code]);
        END;
END;

PROCEDURE printAll;
    { print data for all items in file}
VAR
    count : INTEGER;
BEGIN
    newpage;
    heading;
    FOR count := 1 TO itemLast-1 DO
      BEGIN
        IF linesPrinted = 55 THEN
        BEGIN
          newpage;
          heading;
        END;
            itemPrint(count);
        WRITELN;
      END;
    WRITELN;
END;

PROCEDURE balance;
    { print totals by categories and net balance }
VAR
    item : 1..maxItems;
    balance : REAL;
BEGIN
    FOR item := 1 TO maxCodes DO
      codeAmount[item] := 0.00;
    balance := 0.00;
    FOR  item := 1 TO itemLast-1 DO
      WITH items[item] DO
      codeAmount[code] := codeAmount[code] + amount;
    FOR item := 1 TO maxAddCode DO
      balance := balance + codeAmount[item];
    FOR item := maxAddCode + 1 TO maxCodes DO
     balance := balance - codeAmount[item];
    newpage;
    WRITELN('   Category            Amount');
    FOR item := 1 TO 32 DO
      WRITE('-');
    WRITELN;
    FOR item := 1 TO maxCodes DO
      IF codeAmount[item] <> 0.00 THEN
WRITELN(itemCode[item],'  -',codeAmount[item]:14:2);
    FOR item := 1 TO 32 DO
      WRITE('-');
    WRITELN;
    WRITELN('Balance          -',balance:14:2);
    WRITELN;
END;

PROCEDURE remove;
    { remove item from file }
VAR
    remove : CHAR;
    found,
    item   : INTEGER;
    itemRemove : INTEGER;
BEGIN
    found := 0;
    WRITELN;
    WRITE(' Remove item number - ');
    READ(itemRemove);
    FOR item := 1 TO itemLast - 1 DO
      IF items[item].itemNumber = itemRemove THEN
        found := item;
    WRITELN;
    IF found <> 0 THEN
      BEGIN
        heading;
        itemPrint(found);
    WRITELN;
    WRITELN;
    WRITE(' Remove ? ');
    READ(remove);
    IF (remove = 'Y') OR (remove = 'y') THEN
      BEGIN
        FOR item := found TO itemLast - 1 DO
          items[item] := items[item + 1];
        itemLast := itemLast - 1;
       END;
      END;
    IF found = 0 THEN
      WRITELN(' Item not in list ...');
END;

PROCEDURE entry;
    { console entry of check/deposit data }
VAR
    ch : CHAR;
BEGIN
    REPEAT
      WITH items[itemLast] DO
        BEGIN
          description := '                              ';
          WRITELN;
          WRITE(' Item number ? ');
          READLN(itemNumber);
          WRITE(' Month ? ');
          READ(month);
          WRITE(' Date ? ');
          READ(day);
          WRITE (' Amount ?');
          READ(amount);
          WRITELN('               ------------------------------');
          WRITE(' Description ? ');
          READLN(description);
          WHILE length(description) <> 30 DO
            APPEND(description,' ');
          WRITE(' Code ? ');
          READ(code);
          year := entryYear;
          WRITELN;
       END;
    heading;
    itemPrint(itemLast);
    WRITELN;
    WRITELN;
    WRITE(' Correct ?');
    READ(ch);
      UNTIL (ch = 'Y') OR (ch = 'y');
    items[itemLast + 1] := items[itemLast];
    items[itemLast + 1].itemNumber := 0;
    itemLast := itemLast + 1;
    WRITELN;
END;

PROCEDURE swapItems(item : INTEGER ;
            VAR swaped : BOOLEAN);
    {exchange file data at location with location+1}
BEGIN
    items[maxItems] := items[item];
    items[item] := items[item + 1];
    items[item + 1] := items[maxItems];
    swaped := TRUE
END;

PROCEDURE dateSort;
    { sort data file by date }
VAR
    finish,
    item       : 0..maxItems;
    dateFirst,
    dateSecond : REAL;
    itemFirst,
    itemSecond : INTEGER;
BEGIN
    finish := itemLast - 2;
    REPEAT
      swaped := FALSE;
      FOR item := 1 TO finish DO
        BEGIN
          WITH items[item] DO
        BEGIN
          dateFirst := year * 10000.0 + month
                   * 100.0 + day;
          itemFirst := itemNumber;
        END;
         WITH items[item+1] DO
        BEGIN
          dateSecond := year * 10000.0 + month
                * 100.0 + day;
          itemSecond := itemNumber;
        END;
         IF dateFirst > dateSecond THEN
        swapItems(item,swaped);
         IF (dateFirst = dateSecond) AND
        (itemFirst > itemSecond) THEN
        swapItems(item,swaped);
             END;
    IF finish > 2 THEN
      finish := finish - 1;
     UNTIL NOT swaped
END;

PROCEDURE dump;
    { write file of item information to disk }
VAR
    count : INTEGER;
BEGIN
    REWRITE(diskFile,dataFile);
    FOR count := 1 TO itemLast DO
      WRITE(dataFile,items[count]);
END;

PROCEDURE readDisk;
    { load data from disk to file}
BEGIN
    WRITELN;
    RESET(diskFile,dataFile);
    itemLast := 1;
    REPEAT
      READ(dataFile,items[itemLast]);
      WRITE('.');
      IF itemLast MOD 10 = 0 THEN
        WRITELN;
      itemLast := itemLast + 1;
    UNTIL items[itemLast - 1].itemNumber = 0;
      itemLast := itemLast - 1;
      WRITELN;
END;

PROCEDURE progCommands;
    { console entry of program command }
BEGIN
    WRITELN;
    WRITE(' Command ? ');
    READ (command);
    CASE command OF
      'A','a' : entry;
      'B','b' : balance;
      'P','p' : printAll;
      'R','r' : remove;
      'S','s' : dateSort;
      'D','d' : dump;
      'L','l' : readDisk;
    ELSE:
      IF (command = 'Q') OR (command = 'q') THEN
        WRITELN ('Leaving Program')
          ELSE
        WRITELN(' Invalid command...');
    END;
END;

{----------- MAIN ------------------}
BEGIN
    initialize;
    instructions;
    WRITELN;
    WRITE('Enter Year "2-digit" for new entries - ');
    READ(entryYear);
    WRITELN;
    WRITELN;
    readDisk;
    REPEAT
      progCommands;
    UNTIL (command = 'Q') OR (command = 'q');
    WRITELN;
    WRITE(' Save file ?   ');
    READ(answer);
    IF (answer = 'Y') OR (answer = 'y') THEN
      dump;
END.