program vectime;

uses crt, graph, dos;

const Max = 10;
const count = 1;

Const

   Gray50  : FillPatternType = ( $AA, $55, $AA, $55, $AA, $55, $AA, $55 );
   Leds    : FillPatternType = ( $AA, $00, $AA, $00, $AA, $00, $AA, $00 );

var    lines, verts, one, cur_rotangle, colour, sine_pos
       ,l1, v1, l2, v2, l3, v3,l4, v4, l5, v5, oll, olv,
       segx, segy, a, clockx, clocky : integer;

type   two_dimensional_array = array[1..2,1..Max] of integer;

var    object1,object2,object3,object4,object5,object_loaded,
       startend1,startend2,startend3,startend4,startend5,
       startend_loaded,buffer,sine : two_dimensional_array;

       seg_a, seg_b, seg_c, seg_d, seg_e, seg_f, seg_g : boolean;

var    h, s, m, hund, sec : Word;
       dif1, dif2, mindif1, mindif2,hrdif1, hrdif2 : integer;

{--------------------------------------------------------------}

  Function LeadingZero(w : Word) : String;
  var
   s : String;
  begin
    Str(w:0,s);
    if length(s) = 1 then
      s := '0' + s;
    LeadingZero := s;
  end;

{-------------------------------------------------------------- }

  Procedure Time;
   begin
    GetTime(h,m,s,hund);
   end;

{-------------------------------------------------------------- }

 Procedure InitGraphics;

 var gd, gm : integer;

   begin
    Gd := Detect; InitGraph(Gd, Gm, '');
    if GraphResult <> grOK then Halt(1);
   end;

{---------------------------------------------------------------}

  Procedure init_array(var oldcord:two_dimensional_array);

  var

  vert : integer;

    begin
       for vert := 1 to Max do
         begin
           oldcord[1,vert] := 0;
           oldcord[2,vert] := 0;
         end;
       end;

{---------------------------------------------------------------}

 Procedure Clear_vec_object;
   begin
     init_array(object1);
     init_array(object2);
     init_array(object_loaded);
     init_array(startend1);
     init_array(startend2);
     init_array(startend_loaded);

              verts := 0;
              lines := 0;
                one := 0;

   end;

{--------------------------------------------------------------}

  function Does_File_Exist(filename:string):boolean;

  var f:file;
    begin
    {$I-}
    assign(f,filename);
    reset(f);
    close(f);
    {$I+};
    Does_File_Exist := (IOResult = 0) AND (filename <> '');
  end;

{---------------------------------------------------------------}

  Procedure load_vec_object(filename:string);

  var FileChar : file of integer;
         index : integer;
          data : integer;

    begin

      init_array(object_loaded);
      init_array(startend_loaded);
      one := 0;

      If Does_File_Exist(Filename) = false
        then
          begin
          end;

      If Does_File_Exist(Filename) = true
        then
          begin
            assign (FileChar, Filename);
            reset(FileChar);

            read(FileChar,oll);
            read(FileChar,olv);

            For index := 1 to olv do
              begin
                read(FileChar,data);
                object_loaded[1,index] := data;
                read(FileChar,data);
                object_loaded[2,index] := data;
              end;

            For index := 1 to oll do
              begin
                read(FileChar,data);
                startend_loaded[1,index] := data;
                read(FileChar,data);
                startend_loaded[2,index] := data;
              end;

          close(FileChar);

         end;
    end;

{---------------------------------------------------------------}

  Procedure load_sine(filename:string);

  var FileChar : file of integer;
         index : integer;
          data : integer;

    begin

      If Does_File_Exist(Filename) = false
        then
          begin
          end;

      If Does_File_Exist(Filename) = true
        then
          begin

            assign (FileChar, Filename);
            reset(FileChar);

            read(FileChar,sine_pos);

            For index := 1 to sine_pos do
              begin
                read(FileChar,data);
                sine[1,index] := data;
                read(FileChar,data);
                sine[2,index] := data;
              end;

          close(FileChar);

    end;
  end;

{--------------------------------------------------------------}

 Procedure loaded_object_2_object1;

 var  index : integer;

   begin

   l1 := oll;
   v1 := olv;

     For Index := 1 to v1 do
       begin
         object1[1,index] := object_loaded[1,index];
         object1[2,index] := object_loaded[2,index];
       end;
     For Index := 1 to l1 do
       begin
         startend1[1,index] := startend_loaded[1,index];
         startend1[2,index] := startend_loaded[2,index];
       end;
   end;

{---------------------------------------------------------------}

 Procedure loaded_object_2_object2;

 var  index : integer;

   begin

   l2 := oll;
   v2 := olv;

     For Index := 1 to v2 do
       begin
         object2[1,index] := object_loaded[1,index];
         object2[2,index] := object_loaded[2,index];
       end;
     For Index := 1 to l2 do
       begin
         startend2[1,index] := startend_loaded[1,index];
         startend2[2,index] := startend_loaded[2,index];
       end;
   end;

{---------------------------------------------------------------}

 Procedure loaded_object_2_object3;

 var  index : integer;

   begin

   l3 := oll;
   v3 := olv;

     For Index := 1 to v3 do
       begin
         object3[1,index] := object_loaded[1,index];
         object3[2,index] := object_loaded[2,index];
       end;
     For Index := 1 to l3 do
       begin
         startend3[1,index] := startend_loaded[1,index];
         startend3[2,index] := startend_loaded[2,index];
       end;
   end;

{---------------------------------------------------------------}

 Procedure loaded_object_2_object4;

 var  index : integer;

   begin

   l4 := oll;
   v4 := olv;

     For Index := 1 to v4 do
       begin
         object4[1,index] := object_loaded[1,index];
         object4[2,index] := object_loaded[2,index];
       end;
     For Index := 1 to l4 do
       begin
         startend4[1,index] := startend_loaded[1,index];
         startend4[2,index] := startend_loaded[2,index];
       end;
   end;

{---------------------------------------------------------------}

 Procedure loaded_object_2_object5;

 var  index : integer;

   begin

   l5 := oll;
   v5 := olv;

     For Index := 1 to v5 do
       begin
         object5[1,index] := object_loaded[1,index];
         object5[2,index] := object_loaded[2,index];
       end;
     For Index := 1 to l5 do
       begin
         startend5[1,index] := startend_loaded[1,index];
         startend5[2,index] := startend_loaded[2,index];
       end;
   end;

{---------------------------------------------------------------}

 procedure Draw_vec_object(object_data:two_dimensional_array;
                             start_end:two_dimensional_array;
                       line_no, colour:integer);

 var

 dline : integer;

 points:array [1..2] of pointtype;

   begin

     setcolor(colour);

     for dline := 1 to line_no - one do
       begin
         points[1].x := object_data[1,start_end[1,dline]];
         points[1].y := object_data[2,start_end[1,dline]];
         points[2].x := object_data[1,start_end[2,dline]];
         points[2].y := object_data[2,start_end[2,dline]];
         line(points[1].x,points[1].y,points[2].x,points[2].y);
       end;

   end;

{---------------------------------------------------------------}

  Procedure Display_sine(colour : integer);

  var count,index,X,Y : integer;

    begin

       for index := 1 to sine_pos do
         begin
           SetColor(colour);

           X := sine[1,index];
           Y := sine[2,index];

           line(X-2,Y,X+2,Y);
           line(X,Y-2,X,Y+2);
         end;
    end;

{--------------------------------------------------------------}

 procedure rotate_vec_object(oldcord : two_dimensional_array;
                             rotangle:integer);

 var

               vert : integer;
            difcord : pointtype;
               calc : real;

   begin

     rotangle := Cur_Rotangle;

     calc := rotangle / 360 * 2 * pi;

     for vert :=1 to verts do
       begin
         buffer[1,vert]:=round((oldcord[1,vert]*cos(calc))+
                           (oldcord[2,vert]*(-sin(calc))));

         buffer[2,vert]:=round((oldcord[1,vert]*sin(calc))+
                           (oldcord[2,vert]*cos(calc)));
       end;

     difcord.x := buffer[1,1] - oldcord[1,1];
     difcord.y := buffer[2,1] - oldcord[2,1];

     for vert := 1 to verts do
       begin
         buffer[1,vert] := buffer[1,vert] - difcord.x;
         buffer[2,vert] := buffer[2,vert] - difcord.y;
       end;
   end;

{--------------------------------------------------------------}

 procedure shift_vec_object(oldcord : two_dimensional_array;
                 vertices:integer;vec_object_x, vec_object_y : integer);

 var

             vert : integer;
          difcord : two_dimensional_array;

   begin

     difcord[1,count] := vec_object_x - oldcord[1,count];
     difcord[2,count] := vec_object_y - oldcord[2,count];

     for vert :=1 to vertices do
       begin
         buffer[1,vert] := oldcord[1,vert] + difcord[1,count];
         buffer[2,vert] := oldcord[2,vert] + difcord[2,count];
       end;
   end;

{---------------------------------------------------------------}

  Procedure Display_Verts(colour : integer);

  var count,index,X,Y : integer;

    begin

       for index := 1 to verts do
         begin
           SetColor(colour);

           X := object1[1,index];
           Y := object1[2,index];

           line(X-2,Y,X+2,Y);
           line(X,Y-2,X,Y+2);
         end;
    end;

{--------------------------------------------------------------}

  Procedure Display_Segments;

    begin

      if seg_a = true then
        begin
          shift_vec_object(object1,v1,segx,segy+5);
          draw_vec_object(buffer,startend1,l1,colour);
       end;

     if seg_b = true then
       begin
         shift_vec_object(object2,v2,segx+34,segy+7);
         draw_vec_object(buffer,startend2,l2,colour);
       end;
    
     if seg_c = true then
       begin
         shift_vec_object(object2,v2,segx+34,segy+40);
         draw_vec_object(buffer,startend2,l2,colour);
       end;
    
     if seg_d = true then
       begin
         shift_vec_object(object5,v5,segx+30,segy+72);
         draw_vec_object(buffer,startend5,l5,colour);
      end;
      
    if seg_e = true then
      begin
        shift_vec_object(object4,v4,segx-4,segy+70);
        draw_vec_object(buffer,startend4,l4,colour);
      end;

    if seg_f = true then
      begin
        shift_vec_object(object4,v4,segx-4,segy+37);
        draw_vec_object(buffer,startend4,l4,colour);
      end;

    if seg_g = true then
      begin
         shift_vec_object(object3,v3,segx+5,segy+35);
         draw_vec_object(buffer,startend3,l3,colour);
      end;

    end;

{--------------------------------------------------------------}

  Procedure Reset;
    begin
      seg_a := false;
      seg_b := false;
      seg_c := false;
      seg_d := false;
      seg_e := false;
      seg_f := false;
      seg_g := false;
    end;

{--------------------------------------------------------------}

  Procedure _1;

   begin
     reset;
     seg_a := false;
     seg_b := true;
     seg_c := true;
     seg_d := false;
     seg_e := false;
     seg_f := false;
     seg_g := false;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _2;

   begin
     reset;
     seg_a := true;
     seg_b := true;
     seg_c := false;
     seg_d := true;
     seg_e := true;
     seg_f := false;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _3;

   begin
     reset;
     seg_a := true;
     seg_b := true;
     seg_c := true;
     seg_d := true;
     seg_e := false;
     seg_f := false;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _4;

   begin
     reset;
     seg_a := false;
     seg_b := true;
     seg_c := true;
     seg_d := false;
     seg_e := false;
     seg_f := true;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _5;

   begin
     reset;
     seg_a := true;
     seg_b := false;
     seg_c := true;
     seg_d := true;
     seg_e := false;
     seg_f := true;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _6;

   begin
     reset;
     seg_a := true;
     seg_b := false;
     seg_c := true;
     seg_d := true;
     seg_e := true;
     seg_f := true;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _7;

   begin
     reset;
     seg_a := true;
     seg_b := true;
     seg_c := true;
     seg_d := false;
     seg_e := false;
     seg_f := false;
     seg_g := false;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _8;

   begin
     reset;
     seg_a := true;
     seg_b := true;
     seg_c := true;
     seg_d := true;
     seg_e := true;
     seg_f := true;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _9;

   begin
     reset;
     seg_a := true;
     seg_b := true;
     seg_c := true;
     seg_d := true;
     seg_e := false;
     seg_f := true;
     seg_g := true;
     display_segments;
   end;

{--------------------------------------------------------------}

  Procedure _0;

   begin
     reset;
     seg_a := true;
     seg_b := true;
     seg_c := true;
     seg_d := true;
     seg_e := true;
     seg_f := true;
     seg_g := false;
     display_segments;
   end;

{--------------------------------------------------------------}

   Procedure Display_Clock_Face;
     begin

       colour := 8;
       setcolor(colour);
      
       clockx := 175;
       clocky := 170;

       rectangle(clockx - 10,clocky - 5,clockx + 296,clocky + 95);
       rectangle(clockx - 15,clocky - 10,clockx + 301,clocky + 100);
       setfillpattern(gray50,7);
       floodfill(clockx-12,clocky-7,8);

       colour := 0;

       segx := clockx + 5;
       segy := clocky;
       _8;
       segx := clockx + 50;
       segy := clocky;
       _8;


       setcolor(14);
       circle(clockx + 93,clocky + 20,4);
       circle(clockx + 93,clocky + 55,4);
       setfillpattern(gray50,14);
       floodfill(clockx+93,clocky+20,14);
       floodfill(clockx+93,clocky+55,14);

       segx := clockx + 105;
       segy := clocky;
       _8;
       segx := clockx + 150;
       segy := clocky;
       _8;

       setcolor(14);
       circle(clockx + 193,clocky + 20,4);
       circle(clockx + 193,clocky + 55,4);
       floodfill(clockx+193,clocky+20,14);
       floodfill(clockx+193,clocky+55,14);

       segx := clockx + 205;
       segy := clocky;
       _8;
       segx := clockx + 250;
       segy := clocky;
       _8;
       setcolor(7);
       settextstyle(smallfont, horizdir, 5);
       outtextxy(clockx+12,clocky+80,' Written By Franz Ayestaran  1993');

     end;

{--------------------------------------------------------------}

Procedure Display_Time;

begin


load_vec_object('vec\seg1.vec');
loaded_object_2_object1;

load_vec_object('vec\seg2.vec');
loaded_object_2_object2;

load_vec_object('vec\seg3.vec');
loaded_object_2_object3;

load_vec_object('vec\seg4.vec');
loaded_object_2_object4;

load_vec_object('vec\seg5.vec');
loaded_object_2_object5;

display_clock_face;

    GetTime(h,m,s,hund);

    segx := clockx + 205;
    segy := clocky;

    if (s>00) and (s<10) then begin colour := 0; _8; colour := 9; _0; end;
    if (s>10) and (s<20) then begin colour := 0; _8; colour := 9; _1; end;
    if (s>20) and (s<30) then begin colour := 0; _8; colour := 9; _2; end;
    if (s>30) and (s<40) then begin colour := 0; _8; colour := 9; _3; end;
    if (s>40) and (s<50) then begin colour := 0; _8; colour := 9; _4; end;
    if (s>50) and (s<60) then begin colour := 0; _8; colour := 9; _5; end;

    segx := clockx + 105;
    segy := clocky;

    if (m>00) and (m<10) then begin colour := 0; _8; colour := 10; _0; end;
    if (m>10) and (m<20) then begin colour := 0; _8; colour := 10; _1; end;
    if (m>20) and (m<30) then begin colour := 0; _8; colour := 10; _2; end;
    if (m>30) and (m<40) then begin colour := 0; _8; colour := 10; _3; end;
    if (m>40) and (m<50) then begin colour := 0; _8; colour := 10; _4; end;
    if (m>50) and (m<60) then begin colour := 0; _8; colour := 10; _5; end;

    segx := clockx + 5;
    segy := clocky;

    if (h>00) and (h<10) then begin colour := 0; _8; colour := 10; _0; end;
    if (h>10) and (h<20) then begin colour := 0; _8; colour := 10; _1; end;
    if (h>20) and (h<30) then begin colour := 0; _8; colour := 10; _2; end;
    if (h>30) and (h<40) then begin colour := 0; _8; colour := 10; _3; end;
    if (h>40) and (h<50) then begin colour := 0; _8; colour := 10; _4; end;
    if (h>50) and (h<60) then begin colour := 0; _8; colour := 10; _5; end;

repeat

    mindif1 := m;
     hrdif1 := h;
    GetTime(h,m,s,hund);
    mindif2 := m;
     hrdif2 := h;

    if mindif2 <> mindif1 then
                           begin
                             colour := 0;
                             segx := clockx + 150;
                             segy := clocky;
                             _8;
                           end;

    if hrdif2 <> hrdif1 then
                         begin
                           colour := 0;
                           segx := clockx + 50;
                           segy := clocky;
                           _8;
                         end;


    colour := 9;

    segx := clockx + 250;
    segy := clocky;

    if (s=0) or (s=10) or (s=20) or (s=30) or (s=40) or (s=50) then _0;
    if (s=1) or (s=11) or (s=21) or (s=31) or (s=41) or (s=51) then _1;
    if (s=2) or (s=12) or (s=22) or (s=32) or (s=42) or (s=52) then _2;
    if (s=3) or (s=13) or (s=23) or (s=33) or (s=43) or (s=53) then _3;
    if (s=4) or (s=14) or (s=24) or (s=34) or (s=44) or (s=54) then _4;
    if (s=5) or (s=15) or (s=25) or (s=35) or (s=45) or (s=55) then _5;
    if (s=6) or (s=16) or (s=26) or (s=36) or (s=46) or (s=56) then _6;
    if (s=7) or (s=17) or (s=27) or (s=37) or (s=47) or (s=57) then _7;
    if (s=8) or (s=18) or (s=28) or (s=38) or (s=48) or (s=58) then _8;
    if (s=9) or (s=19) or (s=29) or (s=39) or (s=49) or (s=59) then _9;

    segx := clockx + 205;
    segy := clocky;

    if s = 00 then begin colour := 0; _8; colour := 9; _0; end;
    if s = 10 then begin colour := 0; _8; colour := 9; _1; end;
    if s = 20 then begin colour := 0; _8; colour := 9; _2; end;
    if s = 30 then begin colour := 0; _8; colour := 9; _3; end;
    if s = 40 then begin colour := 0; _8; colour := 9; _4; end;
    if s = 50 then begin colour := 0; _8; colour := 9; _5; end;

    colour := 10;

    segx := clockx + 150;
    segy := clocky;

    if (m=0) or (m=10) or (m=20) or (m=30) or (m=40) or (m=50) then _0;
    if (m=1) or (m=11) or (m=21) or (m=31) or (m=41) or (m=51) then _1;
    if (m=2) or (m=12) or (m=22) or (m=32) or (m=42) or (m=52) then _2;
    if (m=3) or (m=13) or (m=23) or (m=33) or (m=43) or (m=53) then _3;
    if (m=4) or (m=14) or (m=24) or (m=34) or (m=44) or (m=54) then _4;
    if (m=5) or (m=15) or (m=25) or (m=35) or (m=45) or (m=55) then _5;
    if (m=6) or (m=16) or (m=26) or (m=36) or (m=46) or (m=56) then _6;
    if (m=7) or (m=17) or (m=27) or (m=37) or (m=47) or (m=57) then _7;
    if (m=8) or (m=18) or (m=28) or (m=38) or (m=48) or (m=58) then _8;
    if (m=9) or (m=19) or (m=29) or (m=39) or (m=49) or (m=59) then _9;

    segx := clockx + 105;
    segy := clocky;

    if m = 00 then begin colour := 0; _8; colour := 10; _0; end;
    if m = 10 then begin colour := 0; _8; colour := 10; _1; end;
    if m = 20 then begin colour := 0; _8; colour := 10; _2; end;
    if m = 30 then begin colour := 0; _8; colour := 10; _3; end;
    if m = 40 then begin colour := 0; _8; colour := 10; _4; end;
    if m = 50 then begin colour := 0; _8; colour := 10; _5; end;

    segx := clockx + 50;
    segy := clocky;

    if (h=0) or (h=10) or (h=20) or (h=30) or (h=40) or (h=50) then _0;
    if (h=1) or (h=11) or (h=21) or (h=31) or (h=41) or (h=51) then _1;
    if (h=2) or (h=12) or (h=22) or (h=32) or (h=42) or (h=52) then _2;
    if (h=3) or (h=13) or (h=23) or (h=33) or (h=43) or (h=53) then _3;
    if (h=4) or (h=14) or (h=24) or (h=34) or (h=44) or (h=54) then _4;
    if (h=5) or (h=15) or (h=25) or (h=35) or (h=45) or (h=55) then _5;
    if (h=6) or (h=16) or (h=26) or (h=36) or (h=46) or (h=56) then _6;
    if (h=7) or (h=17) or (h=27) or (h=37) or (h=47) or (h=57) then _7;
    if (h=8) or (h=18) or (h=28) or (h=38) or (h=48) or (h=58) then _8;
    if (h=9) or (h=19) or (h=29) or (h=39) or (h=49) or (h=59) then _9;

    segx := clockx + 5;
    segy := clocky;

    if h = 00 then begin colour := 0; _8; colour := 10; _0; end;
    if h = 10 then begin colour := 0; _8; colour := 10; _1; end;
    if h = 20 then begin colour := 0; _8; colour := 10; _2; end;
   
    delay(900);

    segx := clockx + 250;
    segy := clocky;
    colour := 0;
    _8;

until keypressed;

end;

{--------------------------------------------------------------}

begin

initgraphics;

display_time;

closegraph;

end.