[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]

    {
    Here's the source of a seven segment display useful to place at the end
    of your autoexec if you also have the habit of turning your computer on
    long before using it or want an expensive clock (works then best on a
    66Mhz DX2 or Pentium).

    The BGI_01 unit just links in the BGI driver. If removed you'll have to
    supply EGAVGA.BGI in the current directory (Or get the source of the
    unit from a previous message).

    Start it with SEGMENT 15 and a bright yellow clock will appear.

    -------------------------<cut here

    {---------------------------------------------------------}
    {  Project : Seven Segment Display                        }
    {  Auteur  : Ir. G.W. van der Vegt                        }
    {---------------------------------------------------------}
    {  Datum .tijd  Revisie                                   }
    {  901025.2000  Creatie.                                  }
    {---------------------------------------------------------}

    PROGRAM Segment(INPUT,OUTPUT);

    USES
      CRT,
      DOS,
      GRAPH,
      BGI_01;

    VAR
      cl : INTEGER;

    {---------------------------------------------------------}
    {----Routine to display ASCII as seven segment LED display}
    {---------------------------------------------------------}

    PROCEDURE Segments(nch,och : CHAR;xc,yc : INTEGER;scale : REAL);

    {---------------------------------------------------------}
    {----Types & const for graphical LED segment definition   }
    {---------------------------------------------------------}

    TYPE
      seg = ARRAY[1..7] OF Pointtype;

    CONST
      Ver   : seg = ((x :   1; y :   0),(x :   0; y :   1),
                     (x :   0; y :   9),(x :   1; y :  10),
                     (x :   2; y :   9),(x :   2; y :   1),
                     (x :   1; y :   0)                  );

      Hor   : seg = ((x :   0; y :   1),(x :   1; y :   0),
                     (x :   9; y :   0),(x :  10; y :   1),
                     (x :   9; y :   2),(x :   1; y :   2),
                     (x :   0; y :   1)                  );

      DPdot : seg = ((x :   1; y :   1),(x :   2; y :   0),
                     (x :   2; y :   1),(x :   2; y :   2),
                     (x :   1; y :   2),(x :   0; y :   2),
                     (x :   1; y :   1)                   );

      SCDot : seg = ((x :   4; y :   4),(x :   4; y :   6),
                     (x :   6; y :   6),(x :   6; y :   4),
                     (x :   4; y :   4),(x :   4; y :   4),
                     (x :   4; y :   4)                   );

    Type
      dir  = (vertical,horizontal,decimal,dot);

    {---------------------------------------------------------}
    {----Routine to hide/display a segment                    }
    {---------------------------------------------------------}

    PROCEDURE Dispsegm(dir : dir;show : BOOLEAN; m,dx,dy : REAL);

    VAR
      segm : seg;
      i    : INTEGER;

    BEGIN
      CASE dir OF
        vertical   : segm:=ver;
        horizontal : segm:=hor;
        decimal    : segm:=DPdot;
        dot        : segm:=SCdot;
      END;

      FOR i:=1 TO 7 DO
        BEGIN
          segm[i].x:=TRUNC((segm[i].x+dx)*m)+xc;
          segm[i].y:=TRUNC((segm[i].y+dy)*m)+yc;
        END;

      IF show
        THEN setfillstyle(solidfill,cl)
        ELSE setfillstyle(solidfill,black);

      Fillpoly(7,segm);
    END;

    {---------------------------------------------------------}
    {----Types & Const for 7 segment display codes definitions}
    {---------------------------------------------------------}

    TYPE
      leds  = (a,b,c,d,e,f,g,dp,dl,dh);
      offst = RECORD
                dx,dy : REAL;
                d     : dir;
              END;
      disp  = SET OF leds;

    CONST
      rel : ARRAY[leds] OF offst =
            ((dx : 1.0;dy : 0.0; d : horizontal),
             (dx : 0.0;dy : 1.0; d : vertical  ),
             (dx : 0.0;dy :11.0; d : vertical  ),
             (dx : 1.0;dy :20.0; d : horizontal),
             (dx :10.0;dy :11.0; d : vertical  ),
             (dx :10.0;dy : 1.0; d : vertical  ),
             (dx : 1.0;dy :10.0; d : horizontal),
             (dx :11.0;dy :21.0; d : decimal   ),
             (dx : 1.0;dy : 1.0; d : dot       ),
             (dx : 1.0;dy :11.0; d : dot       ));

    {---------------------------------------------------------}
    {----Routine to convert ASCII to 7 segments               }
    {---------------------------------------------------------}

    PROCEDURE Calcleds(ch : CHAR;VAR sseg : disp);

    BEGIN
      CASE ch OF
        '0' : sseg:=[a,b,c,d,e,f];
        '1' : sseg:=[e,f];
        '2' : sseg:=[a,c,d,f,g];
        '3' : sseg:=[a,d,e,f,g];
        '4' : sseg:=[b,e,f,g];
        '5' : sseg:=[a,b,d,e,g];
        '6' : sseg:=[a,b,c,d,e,g];
        '7' : sseg:=[a,e,f];
        '8' : sseg:=[a,b,c,d,e,f,g];
        '9' : sseg:=[a,b,d,e,f,g];
        '-' : sseg:=[g];
        '-' : sseg:=[d];
        '^' : sseg:=[a];
        ':' : sseg:=[dl,dh];
        'ð' : sseg:=[a,d,g];
        '.' : sseg:=[dp];
      ELSE sseg:=[];
      END;
    END;

    VAR
      led     : leds;
      oseg,
      nseg,
      offseg,
      onseg   : disp;

    BEGIN
      Setcolor(DarkGray);

      IF (nch=#0) AND (och=#0)
        THEN
          BEGIN
            offseg:=[a,b,c,d,e,f,g,dp,dl,dh];
            onseg :=[];
          END
        ELSE
          BEGIN
            Calcleds(och,oseg);
            Calcleds(nch,nseg);

            onseg :=nseg-oseg-oseg*nseg;    {----Leds to turn on }
            offseg:=oseg-nseg-oseg*nseg;    {----Leds to turn off}
          END;

      FOR led:=a TO dh DO
        WITH rel[led] DO
          BEGIN
            IF led IN  onseg THEN Dispsegm(d, true,scale,dx,dy);
            IF led IN offseg THEN Dispsegm(d,false,scale,dx,dy);
          END;
    END;

    {---------------------------------------------------------}
    {----Prints error msg & halts program                     }
    {---------------------------------------------------------}

    PROCEDURE Error(s : STRING);

    BEGIN
      CLRSCR;
      WRITELN;
      WRITELN('SYNTAX : Segment <color>');
      WRITELN;
      WRITELN('ERROR    ',s);
      WRITELN;
      HALT;
    END;

    {---------------------------------------------------------}
    {----Main Program                                         }
    {---------------------------------------------------------}

    VAR
      tmp,
      h,m,s,ms : WORD;
      i,e      : INTEGER;

      c1,c2,c3 : STRING[2];

      olds,
      news     : STRING;

      grdriver,
      grmode,
      errcode : INTEGER;

      r       : REGISTERS;
      oldstate: BYTE;

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

    BEGIN

      Grdriver:=detect;
      DetectGraph(grdriver,grmode);

    {----Allow segment color to be chosen by user}
      IF (PARAMCOUNT=1)
        THEN
          BEGIN
            VAL(PARAMSTR(1),cl,e);
            IF (e<>0) THEN Error('Incorrcet Parameter');
          END
        ELSE
          CASE grdriver OF
            mcga,
            egamono : cl:=1;
            ega64   : cl:=3;
            ega,
            vga     : cl:=15;
          END;

      CASE grdriver OF
        mcga    : IF NOT (cl IN [1])
                    THEN Error('With MCGA only color 1 is allowed');
        ega64   : IF NOT (cl IN [1..3])
                    THEN Error('With 64 K EGA only colors 1..4 are allowed');
        egamono : IF NOT (cl IN [1])
                    THEN Error('With EGA mono only color 1 is allowed');
        ega     : IF NOT (cl IN [1..15])
                    THEN Error('With 256 K EGA only colors 1..15 are allowed');
        vga     : IF NOT (cl IN [1..15])
                    THEN Error('With VGA only colors 1..15 are allowed');
      ELSE Error('Graphics Adapter NOT Supported');
      END;

      Initgraph(grdriver,grmode,'');
      errcode:=Graphresult;

      news:='        ';
      olds:='        ';

      FOR i:=1 TO LENGTH(news) DO Segments(#0,#0,80*(i-1),80,6.0);

      r.ah:=$02;
      INTR($16,r);

      REPEAT
        oldstate:=r.al;

        GETTIME(h,m,s,ms);

        STR(h:2,c1);
        STR(m:2,c2);
        STR(s:2,c3);

        IF Odd(s)
          THEN news:=c1+':'+c2+':'+c3
          ELSE news:=c1+' '+c2+' '+c3;

        IF (news[1]=' ') THEN news[1]:='0';
        IF (news[4]=' ') THEN news[4]:='0';
        IF (news[7]=' ') THEN news[7]:='0';

      {----Write only the changed segments in all displays}
        FOR i:=1 TO LENGTH(news) DO Segments(news[i],olds[i],80*(i-1),80,6.0);

        olds:=news;

        Delay(100);

    {----Not only wait for normal keypressed but also for
         shift/alt/ctrl or insert/numlock/scrollock keys pressed}
        r.ah:=$02;
        INTR($16,r);

      UNTIL (r.al<>oldstate) OR (KEYPRESSED AND (READKEY<>#255));

      Closegraph;

    END. {of segment}

    > I would like to include a clock in my current project which will be
    > updated once a minute.  Instead of constantly checking the computer's clock
    > and waiting for it to change, I would like to use an interrupt.

    This one has even a hot key handler.  If you want to update it once per
    minute, bump a counter within the interrupt 1Ch handler till it reaches the
    value 60*18.2.  Then refresh the screen.
    }

    Program Clock;

    {$G+,R-,S-,M 1024, 0, 0 }

    uses
      Dos;

    Const
      x           = 71;                   { x location on screen }
      y           = 1;                    { y location on screen }
      Keyboard    = 9;                    { Hardware keyboard interrupt }
      TimerTick   = $1C;                  { Gets called 18.2 / second }
      VideoOffset = 160 * (y - 1) + 2 * x;{ Offset in display memory }
      yellow      = 14;
      blue        = 1;
      attribute   = blue * 16 + yellow;   { Clock colours }
      VideoBase   : Word = $B800;         { Segment of display memory }
      ActiveFlag  : ShortInt = -1;        { 0: on, -1: off }

    Var
      OrgInt9,                             { Saved interrupt 9 vector }
      OrgInt1Ch : Pointer;              { Saved interrupt 1Ch vector }
      VideoMode : Byte absolute $0000:$0449;

    { Display a string using Dos services (avoid WriteLn, save memory) }

    Procedure DisplayString(s : String); Assembler;

    ASM
      PUSH   DS
      XOR    CX, CX
      LDS    SI, s
      LODSB
      MOV    CL, AL
      JCXZ   @EmptyString
      CLD
     @NextChar:
      LODSB
      XCHG   AX, DX
      MOV    AH, 2
      INT    21h
      LOOP   @NextChar
     @EmptyString:
      POP    DS
    end;

    { Returns True if a real time clock could be found }
    Function HasRTClock : Boolean; Assembler;

    ASM
      XOR    AL, AL
      MOV    AH, 2
      INT    1Ah
      JC     @NoRTClock
      INC    AX
     @NoRTCLock:
    end;

    { Release Dos environment }
    Procedure ReleaseEnvironment; Assembler;
    ASM
      MOV    ES, [PrefixSeg]
      MOV    ES, ES:[002Ch]
      MOV    AH, 49h
      INT    21h
    end;

    { INT 9 handler intercepting Alt-F11 }
    Procedure ToggleClock; Interrupt; Assembler;
    Const
      F11      = $57;                  { 'F11' make code }
      BiosSeg  = $40;                  { Segment of BIOS data area }
      AltMask  = $08;                  { Bitmask of Alt key }
      KbdFlags = $17;                  { Byte showing keyboard status }

    ASM
      STI
      IN     AL, 60h

     { F11 pressed? }
      CMP    AL, F11
      JNE    @PassThru

     { Alt-key pressed? }
      PUSH   BiosSeg
      POP    ES
      MOV    AL, ES:[KbdFlags]
      AND    AL, AltMask
      CMP    AL, AltMask
      JNE    @PassThru

     { Flip status flag, force EOI and leave routine }
      NOT    [ActiveFlag]
      IN     AL, 61h
      MOV    AH, AL
      OR     AL, 80h
      OUT    61h, AL
      MOV    AL, AH
      OUT    61h, AL
      CLI
      MOV    AL, 20h
      OUT    20h, AL
      STI
      JMP    @Exit

     @PassThru:
      CLI
      PUSHF
      CALL   DWord Ptr [OrgInt9]
     @Exit:
    end;  { ToggleClock }

    { Convert a packed BCD byte to ASCII character }
    Procedure Digit; Assembler;
    ASM
      PUSH   AX
      CALL   @HiNibble
      POP    AX
      CALL   @LoNibble
      RETN

     @HiNibble:
      SHR    AL, 4
      JMP    @MakeAscii
     @LoNibble:
      AND    AL, 0Fh
     @MakeAscii:
      OR     AL, '0'
      STOSW
    end;

    { INT 1Ch handler that displays a clock on the right hand side of the screen }
    Procedure DisplayClock; Interrupt; Assembler;
    ASM
      CMP    [ActiveFlag], 0
      JNE    @Exit
      CLD
      MOV    AH, 2
      INT    1Ah
      MOV    ES, [VideoBase]
      MOV    DI, VideoOffset
      MOV    AH, attribute
      MOV    AL, CH
      CALL   Digit
      MOV    AL, ':'
      STOSW
      MOV    AL, CL
      CALL   Digit
      MOV    AL, ':'
      STOSW
      MOV    AL, DH
      CALL   Digit
      PUSHF
      CALL   DWord Ptr [OrgInt1Ch]
     @Exit:
    end;

    Begin
      If VideoMode = 7 Then
        VideoBase := $B000;
      GetIntVec(TimerTick, OrgInt1Ch);
      SetIntVec(TimerTick, @DisplayClock);
      GetIntVec(Keyboard, OrgInt9);
      SetIntVec(Keyboard, @ToggleClock);
      SwapVectors;
      ReleaseEnvironment;
      DisplayString('CLOCK installed.  <Alt-F11> toggles on/off');
      Keep(0);
    end.

[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]