Best Objectech Shareware Selections/UNTITLED.iso/boss/educ/math/027/birdface.pas

Pascal/Delphi Source File | 1987-09-28 | 4.7 KB | 200 lines

PROGRAM BIRDFACE;          { You can experiment with new multipliers  }
                           { or variable values & see what happens.   }

CONST
  MemorySize = 150;

VAR
  X1, X2, Y1, Y2,
  CURRENTLINE,
  COLORCOUNT,
  INCREMENTCOUNT,
  DELTAX1, DELTAY1, DELTAX2, DELTAY2,
  I, COLOR                                                        : INTEGER;

  CH                                                              : CHAR;

  LINE                                      : ARRAY [1..MemorySize] OF RECORD
                                    LX1, LY1: integer;
                                    LX2, LY2: integer;
                                    LCOLOR  : integer;
                                                  end;


PROCEDURE CHECKIT;

  VAR
    CH: CHAR;

  BEGIN
    WRITE('     ');
    WRITELN
  ('This Program Wants a Color Graphics Card - Don''t Leave Home Without It!');
    WRITELN;
    WRITE('     ');
    WRITELN
  ('Peck the Esc key to return to Labcoat Program when tired of graphics');
    WRITELN;
    WRITELN;
    WRITE('                         Continue Y/N ');
      REPEAT
        READ(KBD,CH)
      UNTIL UPCASE(CH) IN ['Y','N', #27];  {     note another way of setting  }
      IF UPCASE(Ch) IN ['N', #27] THEN     { uppercase and INcluding specific }
      HALT;                                { key calls to initiate - for some }
  END;                                     { clumsier examples of different   }
                                           { ways, see LABCOAT.PAS source     }

PROCEDURE INITIALIZE;                      { set initial values to 0 }

  BEGIN
    FOR I:= 1 TO MemorySize DO
    WITH LINE[I] DO
      BEGIN
        LX1 := 0;
        LX2 := 0;
        LY1 := 0;
        LY2 := 0;
      END;
    X1 := 0;
    Y1 := 0;
    X2 := 0;
    Y2 := 0;
    CURRENTLINE:= 1;
    COLORCOUNT:= 0;
    INCREMENTCOUNT:= 0;
    CH := ' ';
    GRAPHCOLORMODE;
    PALETTE(2);
    COLOR:= 2;
  END;

PROCEDURE ADJUSTX (VAR X,DELTAX: INTEGER);
  VAR
    TESTX: INTEGER;
  BEGIN
    TESTX := X+DELTAX;
      IF (TESTX < 1) OR (TESTX > 310) THEN
        BEGIN
          TESTX  := X;
          DELTAX := -DELTAX;
        END;

    X := TESTX;
  END;

PROCEDURE ADJUSTY (VAR Y,DELTAY: INTEGER);
  VAR
    TESTY: INTEGER;                          { A testy variable }
  BEGIN
    TESTY := Y+DELTAY;
    IF (TESTY < 1) OR (TESTY > 200) THEN
      BEGIN
        TESTY  := Y;
        DELTAY := -DELTAY;
      END;
    Y:= TESTY;                                { Y gets testy too }
  END;

PROCEDURE GETnewCOLOR;
  BEGIN
    COLOR      := RANDOM(3)+1;
    COLORCOUNT := 7*(1 + RANDOM(10));
  END;

PROCEDURE GETnewDELTAvalues;
  BEGIN
    DELTAX1 := RANDOM(7)-3;
    DELTAX2 := RANDOM(7)-3;
    DELTAY1 := RANDOM(7)-3;
    DELTAY2 := RANDOM(7)-3;
    INCREMENTCOUNT := 8*(1 + RANDOM(9));
  END;

PROCEDURE SAVEtheCURRENTline;
  BEGIN
    WITH LINE[CURRENTline] DO
      BEGIN
        LX1 := X1;
        LY1 := Y1;
        LX2 := X2;
        LY2 := Y2;
        LCOLOR := COLOR;
      END;
  END;

PROCEDURE RENEWSIT;
  VAR
    I: INTEGER;
  BEGIN
    NOSOUND;
    GRAPHCOLORMODE;
    PALETTE(2);
      FOR I := 1 TO MemorySize DO
        WITH LINE[I] DO
         DRAW(LX1,LY1,LX2,LY2,LCOLOR);
         READ(KBD,CH);
  END;

PROCEDURE FLYINGBIRDFACE;
  BEGIN
    REPEAT
      REPEAT
        WITH LINE[CURRENTLINE] DO
          DRAW(LX1,LY1,LX2,LY2,0);

        IF COLORCOUNT     = 0 THEN GETnewCOLOR;
        IF INCREMENTCOUNT = 0 THEN GETnewDELTAVALUES;

        ADJUSTX(X1,DELTAX1);
        ADJUSTY(Y1,DELTAY1);
        ADJUSTX(X2,DELTAX2);
        ADJUSTY(Y2,DELTAY2);

        DRAW(X1,Y1,X2,Y2,COLOR);

        SAVEtheCURRENTline;

        CURRENTLINE := SUCC(CURRENTLINE);          { the successor value }

          IF CURRENTLINE > MEMORYSIZE THEN CURRENTLINE := 1;

        COLORCOUNT     := PRED(COLORCOUNT);        { the predecessor value }
        INCREMENTCOUNT := PRED(INCREMENTCOUNT);
      UNTIL KEYPRESSED;
      READ(KBD,CH);
        IF CH <> #27 THEN
          BEGIN
            RENEWSIT;
          END;
    UNTIL CH = #27;
  END;

PROCEDURE CYBERPUNK;                       { When Escape Pecked, goto LABCOAT }
 VAR
    LABCOAT:FILE;

  BEGIN
    ASSIGN(LABCOAT,'LABCOAT.COM');
    EXECUTE(LABCOAT);                       { you better have LABCOAT around }
  END;                                      { else just end program instead. }

                    {}

BEGIN                                 { MAIN CODE SECTION }
  GRAPHBACKGROUND(1);
  TEXTBACKGROUND(1);
  CLRSCR;
  CHECKIT;
  INITIALIZE;
  FLYINGBIRDFACE;
  TEXTMODE;
  CYBERPUNK;
END.