program JeffBob;

{$M 65520, 0, 655360}

uses
  Crt, Dos;

const
  MaxX = 319;
  MaxY = 199;
  HalfX = MaxX div 2;
  HalfY = MaxY div 2;
  ShadeRad : integer = 8;
  ColBackGd : integer = 28;
  Pal2Rot : boolean = false;
  deltarad : boolean = false;

type
  ColorValue = record
    red, green, blue: byte;
  end;

  PaletteType = array [0..255] of ColorValue;

  pointrec3d = record
    x, y, z : integer
  end;
  pointarray3d = array [1..10] of pointrec3d;

  pointrec2d = record
    x, y, z, r, c : integer
  end;
  pointarray2d = array [1..10] of pointrec2d;

  buffrec = record
    x, y : integer
  end;
  buffarray = array [1..10] of array [1..10] of buffrec;

var
  pal   : palettetype;
  pt    : pointarray3d;
  p2    : pointarray2d;
  ptend : integer;
  b     : buffarray;
  bobbing, SBob : boolean;
  oldclockvec : procedure;
  putlinepixel : procedure (x, y : integer; color : byte);
  first, second : ColorValue;
  pal2 : palettetype;
  d_rads : array [1..5] of integer;

procedure EatKeypress;

  var
    ch : char;

  begin
    if keypressed then
      begin
        ch := readkey;
        if ch in [#17, #24, #27] then halt;   { Ctrl-Q, Ctrl-X, Escape key }
        if ch = #0 then
          begin
            ch := readkey;
            if ch in [#16, #45, #68] then halt;  { Alt-Q, Alt-X, F10 }
          end
      end;
  end;

procedure SetVGApalette;
var
  i:word;
begin
  port[$3C8]:=0;
  while ((port[$3DA] AND 8)<>8) do;
  asm
    mov cx,768
    mov dx,3c9h
    mov si,offset pal
    @Jmp1:
    lodsb
    out dx,al
    Loop @Jmp1
  end;
end;

Function ISqrt(a:word):integer;
begin
  Isqrt:=round(sqrt(a));
end;

procedure ModeVGA; assembler;

  asm
    mov ax, 0013h
    int 10h
  end;

procedure PutPixel (x, y : integer; color : byte); far;

  begin
    mem[$A000:x + y * 320] := color;
  end;

function getpixel (a, b : integer) : byte;

  begin
    GetPixel := mem[$A000:word(320*b+a)]
  end;

procedure Swap (var a, b : integer);

  var
    t : integer;

  begin
    t := a;
    a := b;
    b := t
  end;

procedure HLine (x1, x2, y : integer; color : byte);

  begin
    if x2 < x1 then
      swap(x1,x2);
    if x1 < 0 then x1 := 0;
    if x1 > MaxX then x1 := MaxX;
    if x2 < 0 then x2 := 0;
    if x2 > MaxX then x2 := MaxX;
    if (y > 0) and (y < MaxY) then
      fillchar(mem[$A000:x1+y*320],x2-x1+1,color);
  end;

procedure VLine (x, y1, y2 : integer; color : byte);

{ Draws a vertical line.  Apple ][e BASIC command. }

  var
    y : integer;

  begin
    if y1 > y2 then swap (y1, y2);
    for y := y1 to y2 do
      PutPixel (x, y, Color)
  end;

Procedure Line(x1,y1,x2,y2:integer;color:byte); assembler;
var
  diagonal_x_increment,
  diagonal_y_increment,
  short_distance,
  straight_x_increment,
  straight_y_increment,
  straight_count,
  diagonal_count:integer;
asm
  mov ax, $a000 { Set up segment for output }
  mov es,ax
  mov cx,1 { Set initial increments for each pixel position }
  mov dx,1
  mov di,y2 { Calculate Vertical distance }
  sub di,y1
  jge @keep_y
  neg dx
  neg di
@Keep_Y:
  mov diagonal_y_increment,dx
  mov si,x2 { Calculate horizontal distance }
  sub si,x1
  jge @keep_x
  neg cx
  neg si
@Keep_X:
  mov diagonal_x_increment,cx
  cmp si,di { Figure whether straight segments are horizontal or vertical }
  jge @horz_seg
  mov cx,0
  xchg si,di
  jmp @Save_Values
@Horz_seg:
  mov dx,0
@Save_values:
  mov short_distance,di
  mov straight_x_increment,cx
  mov straight_y_increment,dx
  mov ax,short_distance { Calculate adjustment factor }
  shl ax,1
  mov straight_count,ax
  sub ax,si
  mov bx,ax
  sub ax,si
  mov diagonal_count,ax
  mov cx,x1 { prepare to draw the line }
  mov dx,y1
  inc si
  mov al,color
@MainLoop: { Now draw the line }
  dec si
  jz  @line_finished
  { Plot Pixel }
  push ax
  push bx
  push cx
  push dx
  push si

  push cx
  push dx
  push ax
  call putlinepixel

  pop  si
  pop  dx
  pop  cx
  pop  bx
  pop  ax
  { End Plot Pixel }
  cmp bx,0
  jge @diagonal_line
  add cx,straight_x_increment { Draw Stright Line Segments }
  add dx,straight_y_increment
  add bx,straight_count
  jmp @MainLoop
@Diagonal_line: { Draw Diagonal Line Segments }
  add cx,diagonal_x_increment
  add dx,diagonal_y_increment
  add bx,diagonal_count
  jmp @MainLoop
@Line_Finished:
end;

procedure ClearScreen;

  begin
    FillChar (mem [$a000:0], 64000, 0);
  end;

procedure MorbidMan;

  var
    p : palettetype;
    loop, loopx, loopy, c, inccol : integer;

  procedure rotatePalette(var p: PaletteType; n1,n2,d: integer);
    var
      q: PaletteType;
      i : integer;
  begin { procedure rotatePalette }
    q:=p;
    for i:=n1 to n2 do
      p[i]:=q[n1+(i+d) mod (n2-n1+1)];
    SetVGApalette;
  end; { procedure rotatePalette }

  procedure BrickBackGd;

    procedure HMortar (x1, x2, y : integer);

      var
        loop : integer;

      begin
        for loop := y to y + 3 do
          begin
            line (x1, loop, x2 + 1, loop, loop - y);
            line (x1, y + 6 - loop, x2 + 1, y + 6 - loop, loop - y);
          end;
      end;

    procedure VMortar (x, y1, y2 : integer);

      var
        loop : integer;

      begin
        for loop := x to x + 3 do
          line (loop, y1, loop, y2, loop - x);
      end;

    begin

      HMortar (0, MaxX, 0);
      HMortar (0, MaxX, 50);
      HMortar (0, MaxX, 100);
      HMortar (0, MaxX, 150);
      HMortar (0, MaxX, MaxY - 6);

      VMortar (80, 6, 50);
      VMortar (160, 6, 50);
      VMortar (240, 6, 50);
      VMortar (MaxX - 6, 6, 50);

      VMortar (40, 54, 100);
      VMortar (120, 54, 100);
      VMortar (200, 54, 100);
      VMortar (280, 54, 100);

      VMortar (80, 104, 150);
      VMortar (160, 104, 150);
      VMortar (240, 104, 150);
      VMortar (MaxX - 6, 104, 150);

      VMortar (40, 154, 194);
      VMortar (120, 154, 194);
      VMortar (200, 154, 194);
      VMortar (280, 154, 194);

    end;

  procedure FillCircle (x_center, y_center, radius : word);

    var
      x,y,r2:integer;

    procedure hline (x, x2, y : integer);

      var
        xloop, c : integer;

      begin
        for xloop :=  x to x2 do
          begin
            c := getpixel (xloop, y);
            if c in [0..3] then
              begin
                inc (c, IncCol);
                putpixel (xloop, y, c)
              end
          end;
      end;

    begin
      if radius=0 then exit;
      r2:=radius*radius;
      x:=0;
      y:=radius;
      repeat
        hline(x_center-x,x_center+x,y_center-y);
        hline(x_center-x,x_center+x,y_center+y);
        hline(x_center-y,x_center+y,y_center-x);
        hline(x_center-y,x_center+y,y_center+x);
        inc(x);
        y:=isqrt(r2-x*x);
      until x>y;
    end;

  procedure Paint (x1, y1, x2, y2 : integer);

    var
      x, y : integer;

    begin
      x := x1;
      y := y1;
      FillCircle (x, y, shaderad);
      while (x <> x2) or (y <> y2) do
        begin
          if x > x2 then dec (x) else if x < x2 then inc (x);
          if y > y2 then dec (y) else if y < y2 then inc (y);
          FillCircle (x, y, shaderad);
          delay (10);
        end;
      EatKeyPress;
    end;

  begin
    p := pal;
    ShadeRad := 3;
    ClearScreen;
    for loop := 0 to 3 do
      begin
        with pal [loop] do
          begin
            red := loop * 10 + 30;
            green := loop * 10 + 30;
            blue := loop * 10 + 30;
          end;
        with pal [loop+4] do
          begin
            red := loop * 10 + 30;
            green := 10;
            blue := 10;
          end;
        with pal [loop+8] do
          begin
            red := 10;
            green := loop * 10 + 30;
            blue := loop * 10 + 30;
          end;
        with pal [loop+12] do
          begin
            red := 10;
            green := loop * 10 + 30;
            blue := 20;
          end;
      end;
    with pal [0] do
      begin
        red := 30;
        green := 0;
        blue := 0;
      end;
    with pal [4] do
      begin
        red := 63;
        green := 10;
        blue := 10;
      end;
    with pal [8] do
      begin
        red := 20;
        green := 10;
        blue := 63;
      end;
    with pal [12] do
      begin
        red := 10;
        green := 63;
        blue := 20;
      end;
    SetVGAPalette;
    BrickBackGd;

    { MRBID }

    IncCol := 4;

    Paint (8, 47, 4, 43);
    Paint (4, 43, 7, 35);
    Paint (7, 35, 14, 33);
    Paint (14, 33, 22, 33);
    Paint (22, 33, 32, 36);
    Paint (32, 36, 39, 38);
    Paint (39, 38, 48, 39);
    Paint (48, 39, 54, 34);
    Paint (54, 34, 53, 47);
    Paint (53, 47, 51, 54);
    Paint (51, 54, 50, 63);
    Paint (50, 63, 42, 70);
    Paint (42, 70, 35, 76);
    Paint (35, 76, 24, 80);
    Paint (24, 80, 10, 80);
    Paint (10, 80, 4, 74);
    Paint (4, 74, 7, 63);
    Paint (7, 63, 14, 60);
    Paint (14, 60, 20, 60);
    Paint (54, 43, 60, 40);
    Paint (60, 40, 65, 33);
    Paint (65, 33, 66, 40);
    Paint (66, 40, 66, 48);
    Paint (66, 48, 64, 57);
    Paint (64, 57, 60, 67);
    Paint (66, 43, 73, 39);
    Paint (73, 39, 80, 33);
    Paint (80, 33, 82, 40);
    Paint (82, 40, 81, 53);
    Paint (81, 53, 82, 65);
    Paint (82, 65, 79, 73);
    Paint (79, 73, 72, 78);
    Paint (106, 62, 100, 57);
    Paint (100, 57, 97, 46);
    Paint (97, 46, 102, 31);
    Paint (102, 31, 120, 29);
    Paint (120, 29, 131, 35);
    Paint (131, 35, 135, 48);
    Paint (135, 48, 133, 57);
    Paint (133, 57, 129, 62);
    Paint (129, 62, 124, 65);
    Paint (124, 65, 124, 78);
    Paint (114, 64, 115, 75);
    Paint (107, 62, 106, 74);
    Paint (108, 48, 110, 53);
    Paint (125, 49, 121, 54);
    Paint (147, 39, 149, 63);
    Paint (141, 35, 143, 25);
    Paint (143, 25, 150, 24);
    Paint (150, 24, 157, 28);
    Paint (157, 28, 163, 31);
    Paint (163, 31, 161, 44);
    Paint (161, 44, 154, 47);
    Paint (154, 47, 160, 52);
    Paint (160, 52, 163, 63);
    Paint (163, 63, 163, 73);
    Paint (163, 73, 169, 80);
    Paint (169, 80, 172, 81);
    Paint (172, 81, 180, 79);
    Paint (177, 33, 180, 59);
    Paint (172, 29, 179, 24);
    Paint (179, 24, 193, 22);
    Paint (193, 22, 196, 30);
    Paint (196, 30, 194, 40);
    Paint (194, 40, 182, 43);
    Paint (182, 43, 195, 49);
    Paint (195, 49, 198, 61);
    Paint (198, 61, 192, 67);
    Paint (192, 67, 177, 69);
    Paint (177, 69, 170, 61);
    Paint (213, 35, 215, 59);
    Paint (232, 33, 233, 67);
    Paint (233, 67, 240, 64);
    Paint (240, 64, 245, 63);
    Paint (245, 63, 261, 60);
    Paint (261, 60, 262, 50);
    Paint (262, 50, 263, 37);
    Paint (263, 37, 256, 27);
    Paint (256, 27, 242, 17);
    Paint (242, 17, 222, 15);
    Paint (222, 15, 210, 17);
    Paint (210, 17, 210, 22);
    Paint (210, 22, 212, 27);
    Paint (212, 27, 217, 29);

    { MAN }

    IncCol := 8;

    Paint (109, 139, 110, 98);
    Paint (110, 98, 120, 109);
    Paint (120, 109, 125, 114);
    Paint (125, 114, 128, 117);
    Paint (128, 117, 132, 123);
    Paint (132, 123, 138, 115);
    Paint (138, 115, 143, 110);
    Paint (143, 110, 146, 104);
    Paint (146, 104, 153, 97);
    Paint (153, 97, 154, 139);
    Paint (154, 139, 164, 139);
    Paint (164, 139, 168, 129);
    Paint (168, 129, 170, 117);
    Paint (170, 117, 173, 109);
    Paint (173, 109, 179, 96);
    Paint (179, 96, 187, 108);
    Paint (187, 108, 190, 115);
    Paint (190, 115, 194, 124);
    Paint (194, 124, 200, 141);
    Paint (200, 141, 209, 140);
    Paint (209, 140, 209, 97);
    Paint (209, 97, 216, 107);
    Paint (216, 107, 222, 115);
    Paint (222, 115, 230, 125);
    Paint (230, 125, 239, 137);
    Paint (239, 137, 242, 141);
    Paint (242, 141, 240, 99);

    { Presents }

    IncCol := 12;
    ShadeRad := 2;
    Paint (19, 189, 17, 161);
    Paint (17, 161, 23, 161);
    Paint (23, 161, 26, 161);
    Paint (26, 161, 27, 163);
    Paint (27, 163, 30, 166);
    Paint (30, 166, 30, 171);
    Paint (30, 171, 27, 174);
    Paint (27, 174, 23, 175);
    Paint (23, 175, 18, 175);
    Paint (35, 186, 35, 181);
    Paint (35, 181, 34, 176);
    Paint (34, 176, 36, 173);
    Paint (36, 173, 43, 171);
    Paint (43, 171, 44, 175);
    Paint (55, 178, 59, 177);
    Paint (59, 177, 59, 171);
    Paint (59, 171, 56, 169);
    Paint (56, 169, 50, 169);
    Paint (50, 169, 50, 178);
    Paint (50, 178, 54, 186);
    Paint (54, 186, 59, 188);
    Paint (59, 188, 61, 184);
    Paint (79, 173, 75, 170);
    Paint (75, 170, 71, 169);
    Paint (71, 169, 66, 173);
    Paint (66, 173, 70, 178);
    Paint (70, 178, 75, 180);
    Paint (75, 180, 79, 183);
    Paint (79, 183, 77, 187);
    Paint (77, 187, 73, 188);
    Paint (73, 188, 67, 188);
    Paint (67, 188, 65, 183);
    Paint (93, 175, 97, 171);
    Paint (97, 171, 93, 166);
    Paint (93, 166, 85, 167);
    Paint (85, 167, 84, 174);
    Paint (84, 174, 87, 187);
    Paint (87, 187, 95, 190);
    Paint (95, 190, 98, 188);
    Paint (104, 184, 103, 173);
    Paint (103, 173, 104, 169);
    Paint (104, 169, 110, 167);
    Paint (110, 167, 114, 171);
    Paint (114, 171, 116, 176);
    Paint (116, 176, 116, 180);
    Paint (116, 180, 116, 185);
    Paint (127, 160, 127, 172);
    Paint (127, 172, 128, 180);
    Paint (128, 180, 130, 186);
    Paint (130, 186, 137, 188);
    Paint (137, 188, 139, 184);
    Paint (121, 169, 132, 168);
    Paint (154, 169, 145, 167);
    Paint (145, 167, 143, 170);
    Paint (143, 170, 147, 174);
    Paint (146, 174, 152, 175);
    Paint (152, 175, 155, 182);
    Paint (155, 182, 151, 185);
    Paint (151, 185, 146, 185);
    Paint (146, 185, 141, 182);
    Paint (165, 183, 168, 186);
    Paint (178, 182, 182, 184);
    Paint (192, 181, 196, 184);

    repeat
      rotatepalette (pal, ColBackGd + 1, 127, 1);
      delay (50);
    until keypressed;
    pal := p;
    EatKeyPress;
    ClearScreen;
  end;

procedure fillcircle (x_center, y_center, radius, color : word);

  var
    x,y,r2:integer;

  begin
    if radius=0 then exit;
    r2:=radius*radius;
    x:=0;
    y:=radius;
    repeat
      hline(x_center-x,x_center+x,y_center-y, color);
      hline(x_center-x,x_center+x,y_center+y, color);
      hline(x_center-y,x_center+y,y_center-x, color);
      hline(x_center-y,x_center+y,y_center+x, color);
      inc(x);
      y:=isqrt(r2-x*x);
    until x>y;
  end;

procedure ShadeBobCirc (x_center, y_center, radius : word; sb : boolean);

  var
    x,y,r2:integer;

  procedure ahline (x, x2, y : integer);

   { Anti - hline shadebob }

    var
      xloop, c : integer;

    begin
      for xloop :=  x to x2 do
        begin
          c := getpixel (xloop, y);
          dec (c);
          if c < 0 then c := 140;
          if bobbing and (c < ColBackGd) then c := ColBackgd;
          putpixel (xloop, y, c);
        end;

    end;

  procedure hline (x, x2, y : integer);

    var
      xloop, c : integer;

    begin
      for xloop :=  x to x2 do
        begin
          c := getpixel (xloop, y);
          inc (c);
          if bobbing and (c > 140) then c := ColBackGd
            else
          if c > 140 then c := 0;
          putpixel (xloop, y, c);
        end;
    end;

  begin
    if radius=0 then exit;
    r2:=radius*radius;
    x:=0;
    y:=radius;
    repeat
      if sb then
        begin
          hline(x_center-x,x_center+x,y_center-y);
          hline(x_center-x,x_center+x,y_center+y);
          hline(x_center-y,x_center+y,y_center-x);
          hline(x_center-y,x_center+y,y_center+x);
        end
      else
        begin
          ahline(x_center-x,x_center+x,y_center-y);
          ahline(x_center-x,x_center+x,y_center+y);
          ahline(x_center-y,x_center+y,y_center-x);
          ahline(x_center-y,x_center+y,y_center+x);
        end;
      inc(x);
      y:=isqrt(r2-x*x);
    until x>y;
  end;

procedure getdata;

  var
    loop : integer;

  begin
    pt [1].x := -20;
    pt [1].y := 0;
    pt [1].z := 0;
    pt [2].x := 0;
    pt [2].y := 0;
    pt [2].z := 20;
    pt [3].x := 20;
    pt [3].y := 0;
    pt [3].z := 0;
    pt [4].x := 0;
    pt [4].y := 0;
    pt [4].z := -20;
    pt [5].x := 0;
    pt [5].y := 20;
    pt [5].z := 0;

    for loop := 1 to 10 do
      begin
        pal [10 + loop].red := 0;
        pal [10 + loop].green := 63 - (loop * 6);
        pal [10 + loop].blue := 0;
        pal [30 + loop].red := 63 - (loop * 6);
        pal [30 + loop].green := 0;
        pal [30 + loop].blue := 0;
        pal [50 + loop].red := 0;
        pal [50 + loop].green := 0;
        pal [50 + loop].blue := 63 - (loop * 6);
        pal [70 + loop].red := 63 - (loop * 6);
        pal [70 + loop].green := 0;
        pal [70 + loop].blue := 63 - (loop * 6);
        pal [90 + loop].red := 63 - (loop * 6);
        pal [90 + loop].green := 63 - (loop * 6);
        pal [90 + loop].blue := 0;
        pal [110 + loop].red := 0;
        pal [110 + loop].green := 63 - (loop * 6);
        pal [110 + loop].blue := 63 - (loop * 6);
        pal [130 + loop].red := 63 - (loop * 6);
        pal [130 + loop].green := 63 - (loop * 6);
        pal [130 + loop].blue := 63 - (loop * 6);
        pal [loop].red := 0;
        pal [loop].green := loop * 6;
        pal [loop].blue := 0;
        pal [20 + loop].red := (loop * 6);
        pal [20 + loop].green := 0;
        pal [20 + loop].blue := 0;
        pal [40 + loop].red := 0;
        pal [40 + loop].green := 0;
        pal [40 + loop].blue :=(loop * 6);
        pal [60 + loop].red := (loop * 6);
        pal [60 + loop].green := 0;
        pal [60 + loop].blue := (loop * 6);
        pal [80 + loop].red := (loop * 6);
        pal [80 + loop].green := (loop * 6);
        pal [80 + loop].blue := 0;
        pal [100 + loop].red := 0;
        pal [100 + loop].green :=(loop * 6);
        pal [100 + loop].blue := (loop * 6);
        pal [120 + loop].red := (loop * 6);
        pal [120 + loop].green := (loop * 6);
        pal [120 + loop].blue := (loop * 6);
      end;
    setvgapalette;
    fillchar (b, sizeof (b), 0);
  end;

function rad (a : real) : real;

  begin
    rad := a * pi / 180
  end;

procedure rotatearray (lrtheta, udtheta, circtheta : real;
  xshift, yshift, zoom: integer);

  var
    xa, ya, ca, e, f,
    cud, sud, clr, slr, cc, sc : real;
    loop : integer;

  begin
    cud := cos (udtheta);
    sud := sin (udtheta);
    clr := cos (lrtheta);
    slr := sin (lrtheta);
    cc := cos (circtheta);
    sc := sin (circtheta);
    for loop := 1 to ptend do
      begin
        xa := (clr * pt [loop].x) - (slr * pt [loop].z);
        ca := (slr * pt [loop].x) + (clr * pt [loop].z);
        e := (cc * xa) + (sc * pt [loop].y);
        ya := (cc * pt [loop].y) - (sc * xa);
        p2 [loop].z := round ((cud * ca - sud * ya) * zoom);
        f := (sud * ca) + (cud * ya);
        p2 [loop].x := round (e * zoom + xshift);
        p2 [loop].y := round (f * zoom + yshift);
      end;
    for loop := 10 downto 2 do
      b [loop] := b [loop - 1];
    for loop := 1 to ptend do
      begin
        b [1, loop].x := p2 [loop].x;
        b [1, loop].y := p2 [loop].y;
      end
  end;

procedure putdata;

  var
    loop, loop2, loop3, r, dy, dx, y, x : integer;

  begin
    loop := 0;
    dy := 1;
    dx := 1;
    y := halfy;
    x := halfx;
    while not keypressed do
      begin
    inc (x, dx);
    inc (y, dy);
    if (dx = 1) and (x > MaxX - 50) then dx := -1;
    if (dx = -1) and (x < 50) then dx := 1;
    if (dy = 1) and (y > MaxY - 50) then dy := -1;
    if (dy = -1) and (y < 50) then dy := 1;

    rotatearray (rad (loop), rad (loop), 0, x, y, 2);

    for loop2 := 1 to ptend do
      ShadeBobCirc (b [1, loop2].x, b [1, loop2].y, 8, true);

    for loop2 := 1 to ptend do
      if (b [10, loop2].x <> 0) or (b [10, loop2].x <> 0)
        or (b [10, loop2].y <> 0) or (b [10, loop2].y <> 0) then
          ShadeBobCirc (b [10, loop2].x, b [10, loop2].y, 8, false);

    inc (loop, 10);
    if loop = 360 then loop := 0;

    end;
  end;

procedure ShadeBob (x1, y1, x2, y2 : integer);

  var
    x, y : integer;

  begin
    x := x1;
    y := y1;
    ShadeBobCirc (x, y, shaderad, SBob);
    while (x <> x2) or (y <> y2) do
      begin
        if x > x2 then dec (x) else if x < x2 then inc (x);
        if y > y2 then dec (y) else if y < y2 then inc (y);
        ShadeBobCirc (x, y, shaderad, SBob)
      end;
    EatKeyPress;
  end;

procedure JeffBobTitle;

  var
    tempnum, tempnum2, tempnum3 : ColorValue;
    loopy : integer;

  begin
    tempnum := pal [30];
    pal [30].red := 0;
    tempnum2 := pal [50];
    pal [50].red := 0;
    pal [50].green := 0;
    pal [50].blue := 0;
    tempnum3 := pal [70];
    pal [70].red := 0;
    pal [70].green := 0;
    pal [70].blue := 0;
    SetVGAPalette;
    shaderad := 4;
    fillchar (mem [$a000:0], 64000, 30);

    { Jeffrey }

    ShadeBob (31, 33, 39, 27);
    ShadeBob (39, 27, 48, 26);
    ShadeBob (48, 26, 56, 35);
    ShadeBob (56, 35, 63, 37);
    ShadeBob (63, 37, 78, 33);
    ShadeBob (78, 33, 87, 22);
    ShadeBob (87, 22, 87, 36);
    ShadeBob (87, 36, 87, 54);
    ShadeBob (87, 54, 86, 74);
    ShadeBob (86, 74, 82, 85);
    ShadeBob (82, 85, 69, 92);
    ShadeBob (69, 92, 53, 94);
    ShadeBob (53, 94, 39, 91);
    ShadeBob (39, 91, 31, 79);
    ShadeBob (31, 79, 30, 76);
    ShadeBob (30, 76, 39, 69);
    ShadeBob (39, 69, 51, 69);
    ShadeBob (51, 69, 67, 73);
    ShadeBob (67, 73, 75, 73);
    ShadeBob (75, 73, 89, 74);
    ShadeBob (89, 74, 104, 71);
    ShadeBob (104, 71, 112, 65);
    ShadeBob (112, 65, 115, 57);
    ShadeBob (115, 57, 105, 53);
    ShadeBob (105, 53, 94, 65);
    ShadeBob (94, 65, 98, 79);
    ShadeBob (98, 79, 106, 87);
    ShadeBob (106, 87, 119, 86);
    ShadeBob (119, 86, 131, 73);
    ShadeBob (131, 73, 136, 55);
    ShadeBob (136, 55, 133, 33);
    ShadeBob (133, 33, 126, 29);
    ShadeBob (126, 29, 123, 56);
    ShadeBob (123, 56, 122, 81);
    ShadeBob (122, 81, 120, 98);
    ShadeBob (120, 98, 118, 119);
    ShadeBob (118, 119, 124, 128);
    ShadeBob (124, 128, 138, 117);
    ShadeBob (138, 117, 135, 93);
    ShadeBob (135, 93, 122, 81);
    ShadeBob (122, 81, 137, 84);
    ShadeBob (137, 84, 149, 81);
    ShadeBob (149, 81, 157, 70);
    ShadeBob (157, 70, 161, 54);
    ShadeBob (161, 54, 159, 35);
    ShadeBob (159, 35, 152, 27);
    ShadeBob (152, 27, 150, 51);
    ShadeBob (150, 51, 150, 70);
    ShadeBob (150, 70, 148, 90);
    ShadeBob (148, 90, 148, 106);
    ShadeBob (148, 106, 148, 120);
    ShadeBob (148, 120, 153, 129);
    ShadeBob (153, 129, 165, 115);
    ShadeBob (165, 115, 170, 103);
    ShadeBob (170, 103, 164, 89);
    ShadeBob (164, 89, 154, 80);
    ShadeBob (154, 80, 150, 79);
    ShadeBob (150, 79, 164, 73);
    ShadeBob (164, 73, 171, 66);
    ShadeBob (171, 66, 170, 57);
    ShadeBob (170, 57, 184, 65);
    ShadeBob (184, 65, 183, 75);
    ShadeBob (183, 75, 186, 86);
    ShadeBob (186, 86, 199, 83);
    ShadeBob (199, 83, 211, 69);
    ShadeBob (211, 69, 204, 58);
    ShadeBob (204, 58, 195, 63);
    ShadeBob (195, 63, 194, 77);
    ShadeBob (194, 77, 207, 88);
    ShadeBob (207, 88, 215, 82);
    ShadeBob (215, 82, 220, 68);
    ShadeBob (220, 68, 229, 61);
    ShadeBob (229, 61, 235, 76);
    ShadeBob (235, 76, 235, 87);
    ShadeBob (235, 87, 246, 89);
    ShadeBob (246, 89, 252, 85);
    ShadeBob (252, 85, 258, 73);
    ShadeBob (258, 73, 254, 60);
    ShadeBob (254, 60, 258, 74);
    ShadeBob (258, 74, 261, 85);
    ShadeBob (261, 85, 262, 98);
    ShadeBob (262, 98, 261, 112);
    ShadeBob (261, 112, 255, 122);
    ShadeBob (255, 122, 242, 130);
    ShadeBob (242, 130, 233, 124);
    ShadeBob (233, 124, 232, 109);
    ShadeBob (232, 109, 244, 98);
    ShadeBob (244, 98, 260, 93);
    ShadeBob (260, 93, 269, 90);

    { Bobs }

    for loopy := 140 to 199 do
      fillchar (mem [$a000:loopy * 320], 190, 50);
    for loopy := 125 to 140 do
      fillchar (mem [$a000:loopy * 320], 110, 50);

    ShadeBob (10, 179, 10, 175);
    ShadeBob (10, 175, 11, 167);
    ShadeBob (11, 167, 15, 156);
    ShadeBob (15, 156, 19, 144);
    ShadeBob (19, 144, 22, 136);
    ShadeBob (22, 136, 27, 132);
    ShadeBob (27, 132, 36, 130);
    ShadeBob (36, 130, 45, 133);
    ShadeBob (45, 133, 51, 137);
    ShadeBob (51, 137, 54, 146);
    ShadeBob (54, 146, 50, 155);
    ShadeBob (50, 155, 45, 159);
    ShadeBob (45, 159, 36, 160);
    ShadeBob (36, 160, 37, 161);
    ShadeBob (37, 161, 44, 164);
    ShadeBob (44, 164, 49, 170);
    ShadeBob (49, 170, 50, 180);
    ShadeBob (50, 180, 42, 190);
    ShadeBob (42, 190, 31, 190);
    ShadeBob (31, 190, 19, 184);
    ShadeBob (68, 163, 72, 161);
    ShadeBob (72, 161, 79, 163);
    ShadeBob (79, 163, 84, 171);
    ShadeBob (84, 171, 84, 179);
    ShadeBob (84, 179, 79, 186);
    ShadeBob (79, 186, 68, 187);
    ShadeBob (68, 187, 62, 182);
    ShadeBob (62, 182, 60, 167);
    ShadeBob (60, 167, 67, 162);
    ShadeBob (102, 136, 103, 150);
    ShadeBob (103, 150, 101, 159);
    ShadeBob (101, 159, 100, 171);
    ShadeBob (100, 171, 97, 180);
    ShadeBob (97, 180, 98, 186);
    ShadeBob (98, 186, 106, 192);
    ShadeBob (106, 192, 118, 188);
    ShadeBob (118, 188, 118, 173);
    ShadeBob (118, 173, 117, 166);
    ShadeBob (117, 166, 106, 161);
    ShadeBob (106, 161, 101, 163);
    ShadeBob (128, 184, 136, 189);
    ShadeBob (136, 189, 142, 186);
    ShadeBob (142, 186, 147, 181);
    ShadeBob (147, 181, 143, 172);
    ShadeBob (143, 172, 137, 169);
    ShadeBob (137, 169, 130, 165);
    ShadeBob (130, 165, 130, 158);
    ShadeBob (130, 158, 142, 154);

    { The Demo }

    for loopy := 137 to 199 do
      fillchar (mem [$a000:180 + loopy * 320], 130, 70);

    ShadeRad := 3;

    ShadeBob (214, 141, 195, 141);
    ShadeBob (204, 145, 205, 160);
    ShadeBob (221, 141, 220, 160);
    ShadeBob (220, 150, 231, 150);
    ShadeBob (231, 150, 231, 140);
    ShadeBob (231, 140, 231, 159);
    ShadeBob (250, 140, 239, 140);
    ShadeBob (239, 140, 239, 150);
    ShadeBob (239, 150, 251, 149);
    ShadeBob (251, 149, 240, 151);
    ShadeBob (240, 151, 239, 160);
    ShadeBob (239, 160, 251, 162);
    ShadeBob (200, 171, 200, 191);
    ShadeBob (200, 191, 212, 189);
    ShadeBob (212, 189, 215, 184);
    ShadeBob (215, 184, 214, 177);
    ShadeBob (214, 177, 211, 173);
    ShadeBob (211, 173, 200, 171);
    ShadeBob (231, 170, 220, 170);
    ShadeBob (220, 170, 221, 190);
    ShadeBob (221, 190, 229, 190);
    ShadeBob (220, 180, 230, 180);
    ShadeBob (236, 189, 236, 169);
    ShadeBob (236, 169, 243, 180);
    ShadeBob (243, 180, 252, 170);
    ShadeBob (252, 170, 254, 189);
    ShadeBob (270, 170, 261, 175);
    ShadeBob (261, 175, 260, 181);
    ShadeBob (260, 181, 263, 187);
    ShadeBob (263, 187, 267, 191);
    ShadeBob (267, 191, 274, 192);
    ShadeBob (274, 192, 278, 186);
    ShadeBob (278, 186, 280, 180);
    ShadeBob (280, 180, 277, 177);
    ShadeBob (277, 177, 270, 170);

    repeat
    until keypressed;
    EatKeyPress;
    Pal [30] := tempnum;
    Pal [50] := tempnum2;
    Pal [70] := tempnum3;
    ClearScreen;
    SetVGAPalette;
  end;

procedure One;

  begin
    ShadeBob (86, 58, 69, 64);
    ShadeBob (69, 64, 61, 74);
    ShadeBob (61, 74, 57, 88);
    ShadeBob (57, 88, 58, 102);
    ShadeBob (58, 102, 66, 111);
    ShadeBob (66, 111, 79, 121);
    ShadeBob (79, 121, 92, 123);
    ShadeBob (92, 123, 108, 116);
    ShadeBob (108, 116, 115, 106);
    ShadeBob (115, 106, 117, 86);
    ShadeBob (117, 86, 116, 70);
    ShadeBob (116, 70, 102, 59);
    ShadeBob (102, 59, 91, 56);
    ShadeBob (91, 56, 86, 57);
    ShadeBob (142, 120, 141, 57);
    ShadeBob (141, 57, 190, 117);
    ShadeBob (190, 117, 189, 55);
    ShadeBob (251, 54, 208, 53);
    ShadeBob (208, 53, 210, 84);
    ShadeBob (210, 84, 250, 84);
    ShadeBob (250, 84, 211, 83);
    ShadeBob (211, 83, 211, 115);
    ShadeBob (211, 115, 253, 118);
  end;

procedure Three;

  begin
    ShadeBob (7, 51, 57, 51);
    ShadeBob (57, 51, 29, 50);
    ShadeBob (29, 50, 29, 102);
    ShadeBob (78, 51, 78, 51);
    ShadeBob (78, 51, 77, 104);
    ShadeBob (77, 104, 78, 76);
    ShadeBob (78, 76, 105, 76);
    ShadeBob (105, 76, 108, 50);
    ShadeBob (108, 50, 109, 103);
    ShadeBob (135, 100, 133, 49);
    ShadeBob (133, 49, 158, 48);
    ShadeBob (158, 48, 167, 60);
    ShadeBob (167, 60, 162, 76);
    ShadeBob (162, 76, 134, 77);
    ShadeBob (134, 77, 147, 77);
    ShadeBob (147, 77, 168, 98);
    ShadeBob (190, 49, 224, 49);
    ShadeBob (224, 49, 190, 48);
    ShadeBob (190, 48, 190, 70);
    ShadeBob (190, 70, 223, 69);
    ShadeBob (223, 69, 191, 68);
    ShadeBob (191, 68, 191, 102);
    ShadeBob (191, 102, 221, 98);
    ShadeBob (249, 48, 282, 48);
    ShadeBob (282, 48, 250, 48);
    ShadeBob (250, 48, 252, 68);
    ShadeBob (252, 68, 285, 71);
    ShadeBob (285, 71, 252, 68);
    ShadeBob (252, 68, 253, 102);
    ShadeBob (253, 102, 280, 102);
  end;

  {$F+}
  procedure newclockvec; interrupt;
    begin
      asm pushf end;
      oldclockvec;
      first := pal[1];
      second := pal[2];
      move(pal[3],pal[1],125*3);
      pal[127] := second;
      pal[126] := first;
      if pal2rot then
        begin
          first := pal2[1];
          second := pal2[2];
          move(pal2[3],pal2[1],125*3);
          pal2[127] := second;
          pal2[126] := first;
        end;
      first := pal[128];
      second := pal[129];
      move(pal[130],pal[128],126 * 3);
      pal[254] := second;
      pal[253] := first;

      setvgapalette;
    end;
  {$F-}

procedure PlasmaBob;

  const
    PlasmaSBob : boolean = false;

  var
    buff : array [0..63999] of byte;
    loop, palrot, cycle : integer;
    fillloop : longint;

  procedure PutPixelBuff (x, y, color : integer);

    begin
      buff [x + y * 320] := color
    end;

  function GetPixelBuff (x, y : integer): byte;

    begin
      GetPixelBuff := buff [x + y * 320]
    end;

  procedure adjust(xa,ya,x,y,xb,yb: integer);
    var
      d: integer;
      v: real;
  begin { procedure adjust }
    if GetPixelBuff(x,y)<>0 then exit;
    d:=Abs(xa-xb)+Abs(ya-yb);
    v:=(GetPixelBuff(xa,ya)+GetPixelBuff(xb,yb))/2+(random-0.5)*d;
    if v<1 then v:=1;
    if v>=128 then v:=127;
    PutPixelBuff(x,y,Trunc(v));
  end; { procedure adjust }

  procedure subDivide(x1,y1,x2,y2: integer);
    var
      x,y: integer;
      v: real;
  begin { procedure subDivide }
    if (x2-x1<2) and (y2-y1<2) then exit;
    EatKeyPress;
    x:=(x1+x2) div 2;
    y:=(y1+y2) div 2;

    adjust(x1,y1,x,y1,x2,y1);
    adjust(x2,y1,x2,y,x2,y2);
    adjust(x1,y2,x,y2,x2,y2);
    adjust(x1,y1,x1,y,x1,y2);

    if GetPixelBuff(x,y)=0 then
      begin
        v:=(GetPixelBuff(x1,y1)+GetPixelBuff(x2,y1)+GetPixelBuff(x2,y2)+
          GetPixelBuff(x1,y2))/4;
        PutPixelBuff(x,y,Trunc(v));
      end;

    subDivide(x1,y1,x,y);
    subDivide(x,y1,x2,y);
    subDivide(x,y,x2,y2);
    subDivide(x1,y,x,y2);
  end; { procedure subDivide }

  function FileExists (S : String) : boolean;

    var
      SRec : SearchRec;

    begin
      FindFirst (S, AnyFile, SRec);
      if DOSError <> 0 then FileExists := false
        else FileExists := true
    end;

  procedure GeneratePlasma;

    var
      ok : boolean;
      image : file;

    begin
      Assign(image,'PLASMA.IMG');
      if not FileExists ('PLASMA.IMG') then { create a new image }
        begin
          PutPixelBuff (0,0,1+Random(127));
          PutPixelBuff (319,0,1+Random(127));
          PutPixelBuff (319,199,1+Random(127));
          PutPixelBuff (0,199,1+Random(127));
          subDivide (0,0,319,199);
          Rewrite (image, 1);
          BlockWrite (image, buff, sizeof(buff));
        end
      else
        begin
          Reset (image, 1);
          BlockRead (image, buff, sizeof (buff));
        end;
      Close (image);
    end;

  procedure ShowPlasma;

    var
      xloop, yloop : integer;

    begin
      for yloop := 0 to MaxY do
        for xloop := 0 to MaxX do
          putpixel (xloop, yloop, buff [xloop + yloop * 320]);
    end;

  procedure PlasBox (x, y : integer);

    var
      xloop, yloop, c : integer;

    begin
      for yloop := y to y + 8 do
        for xloop := x to x + 8 do
          if PlasmaSBob then
            begin
              c := getpixel (xloop, yloop);
              if c = 0 then
                putpixel (xloop, yloop, buff [xloop + yloop * 320])
              else
                begin
                  if bobbing then
                    begin
                      inc (c);
                      if c > 255 then c := 0;
                    end
                  else
                    begin
                      dec (c);
                      if c < 0 then c := 255;
                    end;
                  putpixel (xloop, yloop, c)
                end;
            end
          else
            putpixel (xloop, yloop, buff [xloop + yloop * 320]);
    end;

  procedure PlasmaLine (x1, y1, x2, y2 : integer);

  var
    x, y : integer;

  begin
    x := x1;
    y := y1;
    PlasBox (x, y);
    while (x <> x2) or (y <> y2) do
      begin
        if x > x2 then dec (x) else if x < x2 then inc (x);
        if y > y2 then dec (y) else if y < y2 then inc (y);
        PlasBox (x, y)
      end;
  end;

  procedure PlasmaWord;

    begin
      PlasmaLine (10, 99, 10, 29);
      PlasmaLine (10, 29, 29, 29);
      PlasmaLine (29, 29, 39, 36);
      PlasmaLine (39, 36, 41, 44);
      PlasmaLine (41, 44, 41, 53);
      PlasmaLine (41, 53, 38, 62);
      PlasmaLine (38, 62, 33, 64);
      PlasmaLine (33, 64, 23, 65);
      PlasmaLine (23, 65, 9, 64);
      PlasmaLine (59, 30, 58, 96);
      PlasmaLine (58, 96, 82, 97);
      PlasmaLine (82, 97, 91, 97);
      PlasmaLine (102, 98, 101, 79);
      PlasmaLine (101, 79, 105, 57);
      PlasmaLine (105, 57, 110, 42);
      PlasmaLine (110, 42, 118, 29);
      PlasmaLine (118, 29, 128, 37);
      PlasmaLine (128, 37, 132, 46);
      PlasmaLine (132, 46, 134, 58);
      PlasmaLine (134, 58, 137, 72);
      PlasmaLine (137, 72, 138, 82);
      PlasmaLine (138, 82, 139, 97);
      PlasmaLine (102, 70, 136, 69);
      PlasmaLine (148, 85, 156, 96);
      PlasmaLine (156, 96, 167, 96);
      PlasmaLine (167, 96, 180, 94);
      PlasmaLine (180, 94, 183, 83);
      PlasmaLine (183, 83, 184, 69);
      PlasmaLine (184, 69, 171, 61);
      PlasmaLine (171, 61, 158, 56);
      PlasmaLine (158, 56, 147, 45);
      PlasmaLine (147, 45, 150, 29);
      PlasmaLine (150, 29, 170, 27);
      PlasmaLine (170, 27, 181, 34);
      PlasmaLine (201, 97, 198, 29);
      PlasmaLine (198, 29, 212, 42);
      PlasmaLine (212, 42, 218, 54);
      PlasmaLine (218, 54, 222, 70);
      PlasmaLine (222, 70, 225, 50);
      PlasmaLine (225, 50, 235, 33);
      PlasmaLine (235, 33, 241, 28);
      PlasmaLine (241, 28, 244, 99);
      PlasmaLine (261, 98, 259, 78);
      PlasmaLine (259, 78, 260, 60);
      PlasmaLine (260, 60, 263, 47);
      PlasmaLine (263, 47, 272, 35);
      PlasmaLine (272, 35, 276, 28);
      PlasmaLine (276, 28, 289, 40);
      PlasmaLine (289, 40, 293, 51);
      PlasmaLine (293, 51, 298, 65);
      PlasmaLine (298, 65, 300, 79);
      PlasmaLine (300, 79, 301, 99);
      PlasmaLine (261, 70, 302, 70);
      PlasmaLine (87, 173, 85, 115);
      PlasmaLine (85, 115, 99, 115);
      PlasmaLine (99, 115, 117, 123);
      PlasmaLine (117, 123, 126, 136);
      PlasmaLine (126, 136, 121, 147);
      PlasmaLine (121, 147, 110, 152);
      PlasmaLine (110, 152, 86, 150);
      PlasmaLine (86, 150, 110, 152);
      PlasmaLine (110, 152, 124, 159);
      PlasmaLine (124, 159, 127, 174);
      PlasmaLine (127, 174, 116, 186);
      PlasmaLine (116, 186, 87, 186);
      PlasmaLine (87, 186, 86, 173);
      PlasmaLine (157, 136, 146, 138);
      PlasmaLine (146, 138, 139, 145);
      PlasmaLine (139, 145, 141, 156);
      PlasmaLine (141, 156, 145, 164);
      PlasmaLine (145, 164, 159, 165);
      PlasmaLine (159, 165, 169, 164);
      PlasmaLine (169, 164, 178, 155);
      PlasmaLine (178, 155, 169, 141);
      PlasmaLine (169, 141, 158, 135);
      PlasmaLine (194, 115, 196, 182);
      PlasmaLine (196, 182, 228, 182);
      PlasmaLine (228, 182, 236, 173);
      PlasmaLine (236, 173, 236, 161);
      PlasmaLine (236, 161, 228, 150);
      PlasmaLine (228, 150, 217, 147);
      PlasmaLine (217, 147, 196, 145);
    end;

  procedure DripWords;

    var
      loopx, loopy : integer;
      c : byte;

    procedure CheckColor (a, b : integer; col: byte);

    var
      c : byte;

    begin
      c := getpixel (a, b);
      if c = 0 then putpixel (a, b, col)
    end;

    begin
      for loopy := 0 to MaxY do
        for loopx := 0 to MaxX do
          begin
            c := getpixel (loopx, loopy);
            if c <> 0 then
              begin
                checkcolor (loopx - 1, loopy, 255);
                checkcolor (loopx, loopy - 1, 255);
              end;
          end;
    end;

  procedure PBob (x_center, y_center, radius : word; draw : boolean);

    var
      x,y,r2:integer;
      c : byte;

    procedure ahline (x, x2, y : integer);

     { Anti - hline shadebob }

      var
        xloop, c : integer;

      begin
        for xloop :=  x to x2 do
          begin
            c := getpixel (xloop, y);
            dec (c);
            if c < 0 then c := 140;
            if bobbing and (c < 8) then c := 8;
            putpixel (xloop, y, c);
          end;

      end;

    procedure hline (x, x2, y : integer);

      var
        xloop, c : integer;

      begin
        for xloop :=  x to x2 do
          begin
            c := getpixel (xloop, y);
            inc (c);
            if bobbing and (c > 140) then c := 8
              else
            if c > 140 then c := 0;
            putpixel (xloop, y, c);
          end;
      end;

    begin
      if radius=0 then exit;
      r2:=radius*radius;
      x:=0;
      y:=radius;
      repeat
        if draw then
          begin
            hline(x_center-x,x_center+x,y_center-y);
            hline(x_center-x,x_center+x,y_center+y);
            hline(x_center-y,x_center+y,y_center-x);
            hline(x_center-y,x_center+y,y_center+x);
          end
        else
          begin
            ahline(x_center-x,x_center+x,y_center-y);
            ahline(x_center-x,x_center+x,y_center+y);
            ahline(x_center-y,x_center+y,y_center-x);
            ahline(x_center-y,x_center+y,y_center+x);
          end;
        c := getpixel (x_center-x,y_center-y);
        putpixel (x_center-x,y_center-y, c or $80);
        c := getpixel (x_center+x,y_center-y);
        putpixel (x_center+x,y_center-y, c or $80);
        c := getpixel (x_center-x,y_center+y);
        putpixel (x_center-x,y_center+y, c or $80);
        c := getpixel (x_center+x,y_center+y);
        putpixel (x_center+x,y_center+y, c or $80);
        c := getpixel (x_center-y,y_center-x);
        putpixel (x_center-y,y_center-x, c or $80);
        c := getpixel (x_center+y,y_center-x);
        putpixel (x_center+y,y_center-x, c or $80);
        c := getpixel (x_center-y,y_center+x);
        putpixel (x_center-y,y_center+x, c or $80);
        c := getpixel (x_center+y,y_center+x);
        putpixel (x_center+y,y_center+x, c or $80);
        inc(x);
        y:=isqrt(r2-x*x);
      until x>y;
    end;

  procedure PlasmaBobs;

    const
      MaxRadius = 10;

    var
      dx, dy, x, y, radius : integer;
      up : boolean;

    begin
      dx := (random (3) + 1);
      dy := (random (3) + 1);
      x := halfx;
      y := halfy;
      up := true;
      radius := 4;
      repeat
        inc (x, dx);
        inc (y, dy);
        if x >= MaxX - MaxRadius then dx := -(random (3) + 1);
        if y >= MaxY - MaxRadius then dy := -(random (3) + 1);
        if x <= MaxRadius then dx := (random (3) + 1);
        if y <= MaxRadius then dy := (random (3) + 1);
        if up then inc (Radius) else dec (Radius);
        if up and (Radius = MaxRadius) then up := false
          else
        if not up and (Radius = 4) then up := true;
        PBob (x, y, radius, true);
      until keypressed;
      EatKeyPress;
    end;

  procedure FadePal1Pal2 (num : byte);

    var
      oldpal : ColorValue;
      i, j : integer;

    begin
      if num <= 63 then
        begin
          i := 63 - num;
          for j:=0 to 127 do
            begin
              oldpal := pal [j];
              pal[j].red:=(oldpal.red*i div 63) +
                (pal2[j].red*(63-i) div 63);
              pal[j].green:=(oldpal.green*i div 63) +
                (pal2[j].green*(63-i) div 63);
              pal[j].blue:=(oldpal.blue*i div 63) +
                (pal2[j].blue*(63-i) div 63);
            end
        end
    end;

  procedure PlasBob;

    var
      x, y, dx, dy : integer;

    procedure BobBar (x, y : integer);

      var
        loopx, loopy, c : integer;

      begin
        for loopy := 1 to 20 do
          for loopx := 1 to 32 do
            begin
              c := getpixel (x + loopx, y + loopy);
              if c = 0 then c := 127;
              if c or $80 > buff [x + loopx + (y + loopy) * 320] then
                putpixel (x + loopx, y + loopy, (c - 1) or $80);
            end;
      end;

    begin
      Fillchar (mem [$a000:0], 64000, 0);
      EatKeyPress;
      dx := 1;
      dy := 1;
      x := halfx;
      y := halfy;
      repeat
        inc (x, dx);
        inc (y, dy);
        if x > MaxX then dx := -1;
        if x < 0 then dx := 1;
        if y > MaxY then dy := -1;
        if y < 0 then dy := 1;
        bobbar (x, y);
      until keypressed;
    end;

  begin
    getintvec($8,@oldclockvec);
    setintvec($8,addr(newclockvec));
    fillchar (pal, sizeof (pal), 0);
    for loop := 0 to 15 do
      begin

        if loop < 4 then
          begin
            pal [loop].red := trunc ((15 - (loop * 2)) / 15 * 63 / 2.5);
            pal [loop].green := trunc ((15 - (loop * 2)) / 15 * 63 / 2.5);
          end
        else
          if loop > 12 then
          begin
            pal [loop].red := trunc ((loop) / 15 * 63 / 3.5);
            pal [loop].green := trunc ((loop) / 15 * 63 / 3.5);
          end;
        pal [loop].blue := 32;
        pal [loop+16].blue := 0;
        pal [loop+32].green := 0;
        pal [loop+48].green := 0;
        pal [loop+64].red := 0;
        pal [loop+80].red := 0;
        pal [loop+96].green := 0;
        pal [loop+112].green := 0;
      end;
    pal [0].red := 0;
    pal [0].green := 0;
    pal [0].blue := 0;
    pal [255].red := 0;
    pal [255].green := 0;
    pal [255].blue := 63;
    fillchar (pal2, sizeof (pal2), 0);
    for loop := 0 to 15 do
      begin
        pal2 [loop].blue:= loop;
        pal2 [loop+16].blue:= 63 - (loop * 4);
        pal2 [loop+32].red:= loop;
        pal2 [loop+48].red:= 63 - (loop * 4);
        pal2 [loop+64].green:= loop;
        pal2 [loop+80].green:= 63 - (loop * 4);
        pal2 [loop+96].red:= loop;
        pal2 [loop+96].green:= loop;
        pal2 [loop+96].blue:= loop;
        pal2 [loop+112].red:= 63 - (loop * 4);
        pal2 [loop+112].green:= 63 - (loop * 4);
        pal2 [loop+112].blue:= 63 - (loop * 4);
      end;
    for loop := 128 to 159 do { create the color wheel }
      begin
        with pal[loop] do begin Red:=loop; Green:=63-loop; Blue:=0; end;
        with pal[loop+32] do begin Red:=63-loop; Green:=0; Blue:=loop; end;
        with pal[loop+64] do begin Red:=0; Green:=loop; Blue:=63-loop; end;
        if loop <= 158 then
          with pal[loop+96] do begin Red:=63 - loop;
            Green:=loop; Blue:=loop; end;
      end;

    fillchar (buff, sizeof (buff), 0);
    GeneratePlasma;
    PlasmaWord;
    palrot := 0;
    cycle := 0;
    while not keypressed and (cycle < 9) do
      begin
        inc (palrot);
        if palrot = 64 then
          begin
            palrot := 0;
            inc (cycle);
          end;
        if (cycle = 6) or (cycle = 7) then fadepal1pal2 (palrot div 2+(cycle- 6) * 32);
        if palrot = 0 then
          case cycle of
            3 : dripwords;
            6 : pal2rot := true;
            8 : pal2rot := false;
          end;
        delay (30)
      end;
    for fillloop := 0 to 63999 do
      inc (buff [fillloop], 127);
    PlasBob;
    EatKeyPress;
    setintvec($8,@oldclockvec)
  end;

procedure MandelBob;

  var
    buff : array [0..63999] of byte;

  procedure fillbar (x1, y1, x2, y2 : integer; c : byte);

    var
      loopy : integer;

    begin
      for loopy := y1 to y2 do
        fillchar (mem [$a000:x1 + loopy * 320], x2 - x1, c);
    end;

  procedure MandelText;

    const
      MaxX = 319;
      MaxY = 199;

    var
      color : boolean;
      color_ul, color_ur, color_ll, color_lr : real;
      i, j, x, y, dx, dy, size, loop, loop2 : integer;
      c, n : byte;

    function Min (x, y : real) : real;

      begin
        if x < y then Min := x else Min := y
      end;

    procedure GouraudShade (x1, y1, size : integer);

      var
        xp, yp : integer;
        leftedge, rightedge, color, colordelta : real;


      begin
        leftedge := (Min (color_ul, 15) - Min (color_ll, 15))
          / (Size + 1);
        rightedge := (Min (color_ur, 15) - Min (color_lr, 15))
          / (Size + 1);
        if (color_ul < 0.95) and (color_ur < 0.95) and
          (color_ll < 0.95) and (color_lr < 0.95) then
            putpixel (x1, y1, 0)
          else
            begin
              y := 0;
              for yp := y1 to trunc (y1 + size) do
                  begin
                    Color := Min (color_ul, 15) - leftedge * y;
                    ColorDelta := ((Min (color_ul, 15) - leftedge * y) -
                    (Min (color_ur, 15) - rightedge * y))/ (size + 1);
                    x := 0;
                    for xp := x1 to trunc (x1 + (Size + 1)) do
                        begin
                          putpixel (xp, yp, trunc (color + 0.5));
                          color := color - colordelta;
                          inc (x);
                        end;
                    inc (y);
                  end;
            end;
      end;

    procedure GouraudLine (x1, y1, x2, y2 : integer);

      var
        x, y : integer;

      begin
        x := x1;
        y := y1;
        c := getpixel (x, y);
        if c = 0 then c := random (15) + 1;
        color_ul := c;
        c := getpixel (x + 6, y);
        if c = 0 then c := random (15) + 1;
        color_ur := c;
        c := getpixel (x, y + 6);
        if c = 0 then c := random (15) + 1;
        color_ll := c;
        c := getpixel (x + 6, y + 6);
        if c = 0 then c := random (15) + 1;
        color_lr := c;
        if color then
          GouraudShade (x, y, 6)
        else
          fillbar (x, y, x + n, y + n, 0);
        while (x <> x2) or (y <> y2) do
          begin
            if x > x2 then dec (x) else if x < x2 then inc (x);
            if y > y2 then dec (y) else if y < y2 then inc (y);
            if color then
              GouraudShade (x, y, 6)
            else
              begin
                delay (1);
                fillbar (x, y, x + n, y + n, 0);
              end;
          end;
      end;

    procedure MandelBobText;

      begin
        GouraudLine (0, 29, 44, 0);
        GouraudLine (44, 0, 20, 15);
        GouraudLine (20, 15, 20, 49);
        GouraudLine (50, 9, 49, 49);
        GouraudLine (49, 49, 49, 29);
        GouraudLine (49, 29, 69, 29);
        GouraudLine (69, 29, 69, 9);
        GouraudLine (69, 9, 70, 49);
        GouraudLine (110, 9, 81, 9);
        GouraudLine (81, 9, 80, 28);
        GouraudLine (80, 28, 108, 29);
        GouraudLine (108, 29, 80, 29);
        GouraudLine (80, 29, 80, 49);
        GouraudLine (80, 49, 109, 49);
        GouraudLine (52, 156, 55, 163);
        GouraudLine (55, 163, 51, 168);
        GouraudLine (51, 168, 45, 169);
        GouraudLine (45, 169, 28, 167);
        GouraudLine (28, 167, 21, 158);
        GouraudLine (21, 158, 21, 152);
        GouraudLine (21, 152, 24, 146);
        GouraudLine (24, 146, 31, 142);
        GouraudLine (31, 142, 41, 140);
        GouraudLine (41, 140, 49, 139);
        GouraudLine (49, 139, 65, 135);
        GouraudLine (65, 135, 78, 129);
        GouraudLine (78, 129, 82, 124);
        GouraudLine (82, 124, 85, 110);
        GouraudLine (85, 110, 88, 86);
        GouraudLine (88, 86, 91, 70);
        GouraudLine (91, 70, 97, 92);
        GouraudLine (97, 92, 103, 106);
        GouraudLine (103, 106, 106, 108);
        GouraudLine (106, 108, 107, 102);
        GouraudLine (107, 102, 111, 93);
        GouraudLine (111, 93, 115, 83);
        GouraudLine (115, 83, 118, 77);
        GouraudLine (118, 77, 121, 73);
        GouraudLine (121, 73, 122, 100);
        GouraudLine (122, 100, 123, 119);
        GouraudLine (123, 119, 123, 136);
        GouraudLine (123, 136, 123, 151);
        GouraudLine (123, 151, 135, 174);
        GouraudLine (135, 174, 141, 180);
        GouraudLine (156, 129, 155, 115);
        GouraudLine (155, 115, 153, 106);
        GouraudLine (153, 106, 145, 98);
        GouraudLine (145, 98, 137, 98);
        GouraudLine (137, 98, 133, 103);
        GouraudLine (133, 103, 129, 113);
        GouraudLine (129, 113, 132, 118);
        GouraudLine (132, 118, 139, 122);
        GouraudLine (139, 122, 147, 121);
        GouraudLine (164, 124, 163, 107);
        GouraudLine (163, 107, 164, 103);
        GouraudLine (164, 103, 174, 97);
        GouraudLine (174, 97, 181, 97);
        GouraudLine (181, 97, 184, 104);
        GouraudLine (184, 104, 185, 107);
        GouraudLine (185, 107, 185, 116);
        GouraudLine (185, 116, 185, 121);
        GouraudLine (214, 103, 193, 98);
        GouraudLine (193, 98, 193, 105);
        GouraudLine (193, 105, 194, 120);
        GouraudLine (194, 120, 206, 124);
        GouraudLine (206, 124, 212, 119);
        GouraudLine (212, 119, 219, 110);
        GouraudLine (219, 110, 219, 92);
        GouraudLine (219, 92, 213, 81);
        GouraudLine (213, 81, 204, 73);
        GouraudLine (204, 73, 189, 74);
        GouraudLine (189, 74, 186, 79);
        GouraudLine (186, 79, 187, 84);
        GouraudLine (241, 113, 249, 111);
        GouraudLine (249, 111, 251, 106);
        GouraudLine (251, 106, 245, 100);
        GouraudLine (245, 100, 234, 97);
        GouraudLine (234, 97, 231, 100);
        GouraudLine (231, 100, 228, 114);
        GouraudLine (228, 114, 234, 121);
        GouraudLine (234, 121, 235, 122);
        GouraudLine (235, 122, 241, 124);
        GouraudLine (241, 124, 251, 123);
        GouraudLine (251, 123, 253, 120);
        GouraudLine (261, 71, 261, 78);
        GouraudLine (261, 78, 260, 88);
        GouraudLine (260, 88, 260, 103);
        GouraudLine (260, 103, 262, 115);
        GouraudLine (262, 115, 264, 118);
        GouraudLine (264, 118, 274, 119);
        GouraudLine (274, 119, 276, 114);
        GouraudLine (276, 114, 276, 108);
        GouraudLine (178, 127, 169, 134);
        GouraudLine (169, 134, 167, 146);
        GouraudLine (167, 146, 168, 160);
        GouraudLine (168, 160, 171, 172);
        GouraudLine (171, 172, 191, 175);
        GouraudLine (191, 175, 203, 165);
        GouraudLine (203, 165, 202, 156);
        GouraudLine (202, 156, 193, 149);
        GouraudLine (193, 149, 188, 149);
        GouraudLine (188, 149, 185, 148);
        GouraudLine (185, 148, 173, 152);
        GouraudLine (173, 152, 168, 157);
        GouraudLine (225, 150, 214, 151);
        GouraudLine (214, 151, 212, 161);
        GouraudLine (212, 161, 219, 171);
        GouraudLine (219, 171, 232, 175);
        GouraudLine (232, 175, 239, 157);
        GouraudLine (239, 157, 233, 151);
        GouraudLine (233, 151, 223, 148);
        GouraudLine (262, 131, 249, 133);
        GouraudLine (249, 133, 247, 150);
        GouraudLine (247, 150, 250, 165);
        GouraudLine (250, 165, 266, 172);
        GouraudLine (266, 172, 275, 172);
        GouraudLine (275, 172, 278, 162);
        GouraudLine (278, 162, 275, 153);
        GouraudLine (275, 153, 261, 149);
        GouraudLine (261, 149, 246, 151);
      end;

    begin
      ClearScreen;
      Color := true;
      MandelBobText;
      if not keypressed then
        delay (1000);
      Color := false;
      n := 1;
      while (n <= 7) and not keypressed do
        begin
          MandelBobText;
          inc (n);
        end;
      EatKeypress;
      ClearScreen;
    end;

  procedure PutPixelBuff (x, y, color : integer);

    begin
      buff [x + y * 320] := color
    end;

  function GetPixelBuff (x, y : integer): byte;

    begin
      GetPixelBuff := buff [x + y * 320]
    end;

  function FileExists (S : String) : boolean;

    var
      SRec : SearchRec;

    begin
      FindFirst (S, AnyFile, SRec);
      if DOSError <> 0 then FileExists := false
        else FileExists := true
    end;

  procedure PlotMandelSet;

    procedure Mandelbrot (x1, y1, xmax, ymax : integer; colors : byte;
      left, top, xside, yside : real);

      var
        x, y, count : integer;
        xscale, yscale, zx, zy, cx, cy, tempx : real;

      begin
        xmax := xmax - x1;
        ymax := ymax - y1 div 2;
        xscale := xside / xmax;
        yscale := yside / ymax;
        for y := 0 to ymax div 2 do
          begin
            for x := 0 to xmax do
              begin
                cx := x * xscale + left;
                cy := y * yscale + top;
                zx := 0;
                zy := 0;
                count := 0;
                while (zx * zx + zy * zy < 4) and (count < colors) do
                  begin
                    tempx := ((zx * zx) - (zy * zy)) + cx;
                    zy := (2 * zx * zy) + cy;
                    zx := tempx;
                    inc (count)
                  end;
                putpixelbuff (x + x1, y + y1, count);
                putpixelbuff (x + x1, ymax - y + y1, count);
              end
          end;
      end;

    begin
      MandelBrot (0, 0, MaxX, MaxY, 16, -2.0, 1.25, 2.5, -2.5)
    end;

  procedure GenerateMandel;

    var
      ok : boolean;
      image : file;

    begin
      Assign(image,'MANDEL.IMG');
      if not FileExists ('MANDEL.IMG') then { regenerate the sucker }
        begin
          PlotMandelSet;
          Rewrite (image, 1);
          BlockWrite (image, buff, sizeof(buff));
        end
      else
        begin
          Reset (image, 1);
          BlockRead (image, buff, sizeof (buff));
        end;
      Close (image);
    end;

  procedure MandelBob;

    var
      x, y, dx, dy, total, count : integer;

    procedure BobBar (x, y : integer);

      var
        loopx, loopy, c : integer;

      begin
        if count = 1 then
          for loopy := 1 to 20 do
            for loopx := 1 to 32 do
              begin
                c := getpixel (x + loopx, y + loopy);
                if c < buff [x + loopx + (y + loopy) * 320] then
                  putpixel (x + loopx, y + loopy, c + count)
              end
        else
          for loopy := 1 to 20 do
            for loopx := 1 to 32 do
              begin
                c := getpixel (x + loopx, y + loopy);
                if c > 0 then
                  putpixel (x + loopx, y + loopy, c + count)
              end;
      end;

    begin
      ClearScreen;
      EatKeyPress;
      total := 0;
      count := 1;
      dx := -12;
      dy := -1;
      x := halfx;
      y := halfy;
      repeat
        inc (x, dx);
        inc (y, dy);
        inc (total);
        if total = 2500 then
          begin
            count := -1;
            x := 0;
            y := 0;
            dx := 1;
            dy := 10;
          end;
        if total < 2500 then
          begin
            if x > MaxX then dx := -12;
            if x < 0 then dx := 12;
            if y > MaxY then dy := -1;
            if y < 0 then dy := 1;
          end
        else
          begin
            if x > MaxX then dx := -1;
            if x < 0 then dx := 1;
            if y > MaxY then dy := -10;
            if y < 0 then dy := 10;
          end;
        bobbar (x, y);
      until (keypressed) or (total = 5000);
    end;

  begin
    ModeVGA;  { Quickest way to reset the palette...I'm lazy! ;}
    MandelText;
    GenerateMandel;
    MandelBob;
  end;

procedure PutSBobPixel (x, y : integer; color : byte); far;

  var
    c : byte;

  begin
    c := getpixel (x, y);
    inc (c);
    if c > 255 then c := 0;
    mem [$a000:x +  y * 320] := c
  end;

procedure LineBobs;

  procedure DescribeLineBobs;

    begin
      TextMode (LastMode);
      ClrScr;
      writeln ('This is the final part of my "DemoBobs".  It''''s a bit more');
      writeln ('interactive than the other parts.  Still no music though...');
      writeln;
      writeln ('I call the next part "LineBobs" because it is basically two');
      writeln ('(x,y) coordinates bouncing around, with a color-incremented line');
      writeln ('connecting them.');
      writeln;
      writeln ('Escape, Alt-X, Alt-Q, Ctrl-X, and Ctrl-Q quit.');
      writeln ('F1 - F10 =--> changes the palette.');
      writeln ('Any other key clears the screen and restarts the linebob.');
      writeln;
      writeln ('Press enter to continue...');
      readln;
    end;

  procedure JustDoIt;

    const
      CowsComeHome : boolean = false;
      HellFreezesOver : boolean = false;

    var
      loop : integer;

    procedure GetRGB (color : byte; var r, g, b : byte);


      begin
        while (port [$3da] and 8) <> 8 do;
        port [$3c8] := color;
        r := port [$3c9];
        g := port [$3c9];
        b := port [$3c9]
      end;

    procedure StandardPal;

      begin
        pal := pal2;
        setvgapalette;
      end;

    procedure RedPal;

      var
        loop : integer;

      begin
        fillchar (pal, sizeof (pal), 0);
        for loop := 0 to 31 do
          begin
            pal [loop].red := loop * 2;
            pal [63 - loop].red := loop * 2;
            pal [loop+64].red := loop * 2;
            pal [127 - loop].red := loop * 2;
            pal [loop+128].red := loop * 2;
            pal [191 - loop].red := loop * 2;
            pal [loop+192].red := loop * 2;
            pal [255 - loop].red := loop * 2;
          end;
        setvgapalette;
      end;

    procedure GreenPal;

      var
        loop : integer;

      begin
        fillchar (pal, sizeof (pal), 0);
        for loop := 0 to 31 do
          begin
            pal [loop].green := loop * 2;
            pal [63 - loop].green := loop * 2;
            pal [loop+64].green := loop * 2;
            pal [127 - loop].green := loop * 2;
            pal [loop+128].green := loop * 2;
            pal [191 - loop].green := loop * 2;
            pal [loop+192].green := loop * 2;
            pal [255 - loop].green := loop * 2;
          end;
        setvgapalette;
      end;

    procedure BluePal;

      var
        loop : integer;

      begin
        fillchar (pal, sizeof (pal), 0);
        for loop := 0 to 31 do
          begin
            pal [loop].blue := loop * 2;
            pal [63 - loop].blue := loop * 2;
            pal [loop+64].blue := loop * 2;
            pal [127 - loop].blue := loop * 2;
            pal [loop+128].blue := loop * 2;
            pal [191 - loop].blue := loop * 2;
            pal [loop+192].blue := loop * 2;
            pal [255 - loop].blue := loop * 2;
          end;
        setvgapalette;
      end;

    procedure RainbowPal;

      var
        loop : integer;

      begin
        fillchar (pal, sizeof (pal), 0);
        for loop := 0 to 31 do
          begin
            pal [loop].red := loop * 2;
            pal [63 - loop].red := loop * 2;
            pal [loop+64].green := loop * 2;
            pal [127 - loop].green := loop * 2;
            pal [loop+128].blue := loop * 2;
            pal [191 - loop].blue := loop * 2;
            pal [loop+192].red := loop * 2;
            pal [loop+192].green := loop * 2;
            pal [loop+192].blue := loop * 2;
            pal [255 - loop].red := loop * 2;
            pal [255 - loop].green := loop * 2;
            pal [255 - loop].blue := loop * 2;
          end;
        setvgapalette;
      end;

    procedure GrayScalePal;

      var
        loop : integer;

      begin
        for loop := 0 to 31 do
          begin
            pal [loop].red := loop * 2;
            pal [loop].green := loop * 2;
            pal [loop].blue:= loop * 2;
            pal [63 - loop].red := loop * 2;
            pal [63 - loop].green := loop * 2;
            pal [63 - loop].blue:= loop * 2;
            pal [loop+64].red := loop * 2;
            pal [loop+64].green := loop * 2;
            pal [loop+64].blue := loop * 2;
            pal [127 - loop].red:= loop * 2;
            pal [127 - loop].green := loop * 2;
            pal [127 - loop].blue:= loop * 2;
            pal [loop+128].red:= loop * 2;
            pal [loop+128].green:= loop * 2;
            pal [loop+128].blue := loop * 2;
            pal [191 - loop].red:= loop * 2;
            pal [191 - loop].green:= loop * 2;
            pal [191 - loop].blue := loop * 2;
            pal [loop+192].red := loop * 2;
            pal [loop+192].green := loop * 2;
            pal [loop+192].blue := loop * 2;
            pal [255 - loop].red := loop * 2;
            pal [255 - loop].green := loop * 2;
            pal [255 - loop].blue := loop * 2;
          end;
        setvgapalette;
      end;

    procedure Funky1Pal;

      var
        loop : integer;

      begin
        fillchar (pal, sizeof (pal), 0);
        for loop := 0 to 31 do
          begin
            pal [loop].red := 63;
            pal [63 - loop].green := 63;
            pal [loop+64].blue := 63;
            pal [127 - loop].red:= 63;
            pal [loop+128].green:= 63;
            pal [191 - loop].blue := 63;
            pal [loop+192].red := 63;
            pal [255 - loop].green := 63;
          end;
        pal [0] := pal2 [0];
        setvgapalette;
      end;

    procedure Funky2Pal;

      var
        loop, r, g, b : integer;

      procedure Colorize (c1, c2, r, g, b : byte);

        var
          c : byte;

        begin
          for c := c1 to c2 do
            begin
              pal [c].red := r;
              pal [c].green := g;
              pal [c].blue := b;
            end
        end;

      begin
        for loop := 1 to 16 do
          begin
            r := random (63);
            g := random (63);
            b := random (63);
            Colorize ((loop - 1) * 16, loop * 16, r, g, b);
          end;
        pal [0] := pal2 [0];
        setvgapalette;
      end;

    procedure Funky3Pal;

      var
        loop, r, g, b, rx, gx, bx : integer;
        r_up, g_up, b_up : boolean;

      begin
        r := 0;
        g := 0;
        b := 0;
        rx := random (5) + 1;
        gx := random (5) + 1;
        bx := random (5) + 1;
        r_up := true;
        g_up := true;
        b_up := true;
        for loop := 0 to 255 do
          begin
            pal [loop].red := r;
            pal [loop].green := g;
            pal [loop].blue := b;
            if r_up then inc (r, rx) else dec (r, rx);
            if g_up then inc (g, gx) else dec (g, gx);
            if b_up then inc (b, bx) else dec (b, bx);
            if (r + rx > 63) or (r - rx < 0) then
              begin
                r_up := not r_up;
                rx := random (5) + 1
              end;
            if (g + gx > 63) or (g - gx < 0) then
              begin
                g_up := not g_up;
                gx := random (5) + 1
              end;
            if (b + bx > 63) or (b - bx < 0) then
              begin
                b_up := not b_up;
                bx := random (5) + 1
              end;
          end;
        SetVGAPalette;
      end;

    procedure RandomPal;

      var
        loop : integer;

      begin
        for loop := 1 to 255 do
          begin
            pal [loop].red := random (64);
            pal [loop].green := random (64);
            pal [loop].blue := random (64);
          end;
        setvgapalette;
      end;

    procedure EatKeypress;

      var
        ch : char;

      begin
        if keypressed then
          begin
            ch := readkey;
            if ch in [#17, #24, #27] then cowscomehome := true
              else      { Ctrl-Q, Ctrl-X, Escape key }
            if ch <> #0 then HellFreezesOver := true;
            if ch = #0 then
              begin
                ch := readkey;
                if ch in [#16, #45] then cowscomehome := true
                  else     { Alt-Q, Alt-X }
                if ch in [#59, #60, #61, #62, #63, #64, #65, #66, #67, #68]
                  then              { function keys }
                    begin
                      case ch of
                        #59 : StandardPal;
                        #60 : RedPal;
                        #61 : GreenPal;
                        #62 : BluePal;
                        #63 : GrayScalePal;
                        #64 : RainbowPal;
                        #65 : Funky1Pal;
                        #66 : Funky2Pal;
                        #67 : Funky3Pal;
                        #68 : RandomPal;
                      end
                    end
                  else
                HellFreezesOver := true
              end
          end;
      end;


    procedure LineBobBobBobbingAlong;

      var
        x1, y1, x2, y2, dx1, dx2, dy1, dy2 : integer;

      procedure Checkbounds (var a, b : integer; c : integer);

        begin
          if a > c then b := -1
           else
          if a < 0 then b := 1;
        end;

      begin
        x1 := random (320);
        x2 := random (320);
        y1 := random (200);
        y2 := random (200);
        dx1 := 1;
        dx2 := -1;
        dy1 := 1;
        dy2 := -1;
        HellFreezesOver := false;
        repeat
          inc (x1, dx1);
          inc (x2, dx2);
          inc (y1, dy1);
          inc (y2, dy2);
          CheckBounds (x1, dx1, 319);
          CheckBounds (x2, dx2, 319);
          CheckBounds (y1, dy1, 199);
          CheckBounds (y2, dy2, 199);
          line (x1, y1, x2, y2, 1);
          EatKeypress;
        until HellFreezesOver or cowscomehome
      end;

    begin
      ModeVGA;
      putlinepixel := PutSbobPixel;
      for loop := 1 to 255 do
        getrgb (loop, pal2 [loop].red, pal2 [loop].green, pal2 [loop].blue);
      pal := pal2;
      setvgapalette;
      repeat
        LineBobBobBobbingAlong;
        EatKeypress;
        ClearScreen;
      until CowsComeHome;
    end;

  begin
    TextMode (LastMode);
    DescribeLineBobs;
    JustDoIt;
  end;

procedure Finale;

  const
    red = 1;
    green = 33;
    blue = 65;

  var
    loop : integer;
    font : array [0..255, 0..15] of byte;

  Procedure LoadROMFont;

    var
      f8x8ofs, f8x8seg : word;

    begin
      asm
        push bp
        mov ah,11h
        mov al,30h
        mov bh,06h
        int 10h
        mov ax,bp
        pop bp
        mov f8x8ofs,ax
        mov f8x8seg,es
      end;
      move(mem[f8x8seg:f8x8ofs],font,256*16)
    end;

  Procedure GrWrite (line : string; x, y : integer; forecolor : byte);

    var
      tx,ty:word;
      i:byte;

    begin
      for i:=1 to length(line) do
        for ty:=0 to 15 do
          for tx:=0 to 7 do
            if font[ord(line[i]),ty] and ($80 shr tx)<>0 then
              putpixel(x+tx+(i-1)*10, y+ty, forecolor)
    end;

  procedure CenterText (str : string; y : integer; color : byte);

    begin
      GrWrite (Str, HalfX - ((length (Str) * 10) div 2), y, Color)
    end;

  procedure SBob1 (x, y : integer; color : byte);

    var
      loopx, loopy : integer;
      c : byte;

    begin
      for loopy := y to y + 15 do
        for loopx := x to x + 10 do
          begin
            c := getpixel (loopx, loopy);
            if c = 0 then c := color;
            if c <> 255 then
              putpixel (loopx, loopy, c + 2);
          end
    end;

  procedure SBob2 (x, y : integer; color : byte);

    var
      loopx, loopy : integer;
      c : byte;

    begin
      for loopy := y to y + 15 do
        for loopx := x to x + 10 do
          begin
            c := getpixel (loopx, loopy);
            if c = 0 then c := color;
            if c <> 255 then
              putpixel (loopx, loopy, 0);
          end
    end;

  procedure HShadeLineL (y : integer; c : byte; show : boolean);

    var
      x : integer;

    begin
      for x := 0 to 310 do
        if show then
          SBob1 (x, y, c)
        else
          SBob2 (x, y, c)
    end;

  procedure HShadeLineR (y : integer; c : byte; show : boolean);

    var
      x : integer;

    begin
      for x := 310 downto 0 do
        if show then
          SBob1 (x, y, c)
        else
          SBob2 (x, y, c)
    end;

  procedure rgb (color, red, green, blue : byte);

    begin
      while (port [$3da] and 8) <> 8 do;
      port [$3c8] := color;
      port [$3c9] := red;
      port [$3c9] := green;
      port [$3c9] := blue
    end;

  procedure WordPaletteShift;

    var
      r, g, b, rx, gx, bx, loop : integer;
      r_up, g_up, b_up : boolean;

    begin
      r := 0;
      g := 0;
      b := 0;
      rx := random (5) + 1;
      gx := random (5) + 1;
      bx := random (5) + 1;
      r_up := true;
      g_up := true;
      b_up := true;
      for loop := 1 to 500 do
        begin
          if r_up then inc (r, rx) else dec (r, rx);
          if g_up then inc (g, gx) else dec (g, gx);
          if b_up then inc (b, bx) else dec (b, bx);
          if r - rx < 0 then
            begin
              r_up := true;
              rx := random (5) + 1;
            end;
          if g - gx < 0 then
            begin
              g_up := true;
              gx := random (5) + 1;
            end;
          if b - bx < 0 then
            begin
              b_up := true;
              bx := random (5) + 1;
            end;
          if r + rx > 63 then
            begin
              r_up := false;
              rx := random (5) + 1;
            end;
          if g + gx > 63 then
            begin
              g_up := false;
              gx := random (5) + 1;
            end;
          if b + bx > 63 then
            begin
              b_up := false;
              bx := random (5) + 1;
            end;
          rgb (255, r, g, b);
          if keypressed then exit;
          delay (2);
        end;
    end;

  begin
    ClearScreen;
    fillchar (pal, sizeof (pal), 0);
    for loop := 1 to 32 do
      begin
        pal [loop].red := (loop * 2) - 1;
        pal [loop+32].green := (loop * 2) - 1;
        pal [loop+64].blue :=  (loop * 2) - 1;
      end;
    SetVGAPalette;

    LoadROMFont;
    CenterText ('The Jeffrey Bob Demo', 20, 255);
    CenterText ('By Jeffrey', 40, 255);
    CenterText ('"Bob-Bob-Bobbin'+''''+' Along"', 60, 255);
    CenterText ('Berthiaume', 80, 255);
    CenterText ('(Morbid Man)', 100, 255);
    CenterText ('Blame my parents', 120, 255);
    CenterText ('for my middle name.', 140, 255);
    CenterText ('Yes, it'+''''+'s really "Bob"!', 160, 255);

    HShadeLineL (20, blue, true);
    HShadeLineR (40, green, true);
    HShadeLineL (60, red, true);
    HShadeLineR (80, blue, true);
    HShadeLineL (100, red, true);
    HShadeLineR (120, green, true);
    HShadeLineL (140, blue, true);
    HShadeLineR (160, red, true);
    if keypressed then exit;

    WordPaletteShift;
    rgb (255, 0, 0, 0);
    if keypressed then exit;

    HShadeLineL (160, blue, false);
    HShadeLineR (140, green, false);
    HShadeLineL (120, red, false);
    HShadeLineR (100, blue, false);
    HShadeLineL (80, red, false);
    HShadeLineR (60, green, false);
    HShadeLineL (40, blue, false);
    HShadeLineR (20, red, false);
    if keypressed then exit;
    delay (1000);
  end;

begin
  ModeVGA;
  getdata;
  putlinepixel := putpixel;
  randomize;
  bobbing := false;
  SBob := true;
  MorbidMan;
  SetVGAPalette;
  ClearScreen;
  JeffBobTitle;
  ShadeRad := 8;
  ColBackGd := 8;
  One;
  delay (1000);
  SBob := false;
  One;
  delay (500);
  bobbing := true;
  ptend := 1;
  pal [8].green := 0;
  SetVGAPalette;
  fillchar (mem [$a000:0], 64000, 8);
  putdata;
  EatKeyPress;
  pal [8].green := 45;
  ClearScreen;
  bobbing := false;
  SBob := true;
  Three;
  delay (1000);
  SBob := false;
  Three;
  delay (500);
  bobbing := true;
  ptend := 3;
  pal [8].green := 0;
  SetVGAPalette;
  fillchar (mem [$a000:0], 64000, 8);
  putdata;
  EatKeypress;
  ClearScreen;
  PlasmaBob;
  EatKeyPress;
  ClearScreen;
  MandelBob;
  LineBobs;
  Finale;
  TextMode (LastMode)
end.