home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0030_7 Segment clock.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-25  |  12.0 KB  |  490 lines
  1. {
  2. Here's the source of a seven segment display useful to place at the end
  3. of your autoexec if you also have the habit of turning your computer on
  4. long before using it or want an expensive clock (works then best on a
  5. 66Mhz DX2 or Pentium).
  6.  
  7.  
  8. The BGI_01 unit just links in the BGI driver. If removed you'll have to
  9. supply EGAVGA.BGI in the current directory (Or get the source of the
  10. unit from a previous message).
  11.  
  12.  
  13. Start it with SEGMENT 15 and a bright yellow clock will appear.
  14.  
  15.  
  16. -------------------------<cut here
  17.  
  18. {---------------------------------------------------------}
  19. {  Project : Seven Segment Display                        }
  20. {  Auteur  : Ir. G.W. van der Vegt                        }
  21. {---------------------------------------------------------}
  22. {  Datum .tijd  Revisie                                   }
  23. {  901025.2000  Creatie.                                  }
  24. {---------------------------------------------------------}
  25.  
  26. PROGRAM Segment(INPUT,OUTPUT);
  27.  
  28. USES
  29.   CRT,
  30.   DOS,
  31.   GRAPH,
  32.   BGI_01;
  33.  
  34. VAR
  35.   cl : INTEGER;
  36.  
  37. {---------------------------------------------------------}
  38. {----Routine to display ASCII as seven segment LED display}
  39. {---------------------------------------------------------}
  40.  
  41. PROCEDURE Segments(nch,och : CHAR;xc,yc : INTEGER;scale : REAL);
  42.  
  43. {---------------------------------------------------------}
  44. {----Types & const for graphical LED segment definition   }
  45. {---------------------------------------------------------}
  46.  
  47. TYPE
  48.   seg = ARRAY[1..7] OF Pointtype;
  49.  
  50. CONST
  51.   Ver   : seg = ((x :   1; y :   0),(x :   0; y :   1),
  52.                  (x :   0; y :   9),(x :   1; y :  10),
  53.                  (x :   2; y :   9),(x :   2; y :   1),
  54.                  (x :   1; y :   0)                  );
  55.  
  56.   Hor   : seg = ((x :   0; y :   1),(x :   1; y :   0),
  57.                  (x :   9; y :   0),(x :  10; y :   1),
  58.                  (x :   9; y :   2),(x :   1; y :   2),
  59.                  (x :   0; y :   1)                  );
  60.  
  61.   DPdot : seg = ((x :   1; y :   1),(x :   2; y :   0),
  62.                  (x :   2; y :   1),(x :   2; y :   2),
  63.                  (x :   1; y :   2),(x :   0; y :   2),
  64.                  (x :   1; y :   1)                   );
  65.  
  66.   SCDot : seg = ((x :   4; y :   4),(x :   4; y :   6),
  67.                  (x :   6; y :   6),(x :   6; y :   4),
  68.                  (x :   4; y :   4),(x :   4; y :   4),
  69.                  (x :   4; y :   4)                   );
  70.  
  71. Type
  72.   dir  = (vertical,horizontal,decimal,dot);
  73.  
  74. {---------------------------------------------------------}
  75. {----Routine to hide/display a segment                    }
  76. {---------------------------------------------------------}
  77.  
  78. PROCEDURE Dispsegm(dir : dir;show : BOOLEAN; m,dx,dy : REAL);
  79.  
  80. VAR
  81.   segm : seg;
  82.   i    : INTEGER;
  83.  
  84. BEGIN
  85.   CASE dir OF
  86.     vertical   : segm:=ver;
  87.     horizontal : segm:=hor;
  88.     decimal    : segm:=DPdot;
  89.     dot        : segm:=SCdot;
  90.   END;
  91.  
  92.   FOR i:=1 TO 7 DO
  93.     BEGIN
  94.       segm[i].x:=TRUNC((segm[i].x+dx)*m)+xc;
  95.       segm[i].y:=TRUNC((segm[i].y+dy)*m)+yc;
  96.     END;
  97.  
  98.   IF show
  99.     THEN setfillstyle(solidfill,cl)
  100.     ELSE setfillstyle(solidfill,black);
  101.  
  102.   Fillpoly(7,segm);
  103. END;
  104.  
  105. {---------------------------------------------------------}
  106. {----Types & Const for 7 segment display codes definitions}
  107. {---------------------------------------------------------}
  108.  
  109. TYPE
  110.   leds  = (a,b,c,d,e,f,g,dp,dl,dh);
  111.   offst = RECORD
  112.             dx,dy : REAL;
  113.             d     : dir;
  114.           END;
  115.   disp  = SET OF leds;
  116.  
  117. CONST
  118.   rel : ARRAY[leds] OF offst =
  119.         ((dx : 1.0;dy : 0.0; d : horizontal),
  120.          (dx : 0.0;dy : 1.0; d : vertical  ),
  121.          (dx : 0.0;dy :11.0; d : vertical  ),
  122.          (dx : 1.0;dy :20.0; d : horizontal),
  123.          (dx :10.0;dy :11.0; d : vertical  ),
  124.          (dx :10.0;dy : 1.0; d : vertical  ),
  125.          (dx : 1.0;dy :10.0; d : horizontal),
  126.          (dx :11.0;dy :21.0; d : decimal   ),
  127.          (dx : 1.0;dy : 1.0; d : dot       ),
  128.          (dx : 1.0;dy :11.0; d : dot       ));
  129.  
  130. {---------------------------------------------------------}
  131. {----Routine to convert ASCII to 7 segments               }
  132. {---------------------------------------------------------}
  133.  
  134. PROCEDURE Calcleds(ch : CHAR;VAR sseg : disp);
  135.  
  136. BEGIN
  137.   CASE ch OF
  138.     '0' : sseg:=[a,b,c,d,e,f];
  139.     '1' : sseg:=[e,f];
  140.     '2' : sseg:=[a,c,d,f,g];
  141.     '3' : sseg:=[a,d,e,f,g];
  142.     '4' : sseg:=[b,e,f,g];
  143.     '5' : sseg:=[a,b,d,e,g];
  144.     '6' : sseg:=[a,b,c,d,e,g];
  145.     '7' : sseg:=[a,e,f];
  146.     '8' : sseg:=[a,b,c,d,e,f,g];
  147.     '9' : sseg:=[a,b,d,e,f,g];
  148.     '-' : sseg:=[g];
  149.     '-' : sseg:=[d];
  150.     '^' : sseg:=[a];
  151.     ':' : sseg:=[dl,dh];
  152.     '≡' : sseg:=[a,d,g];
  153.     '.' : sseg:=[dp];
  154.   ELSE sseg:=[];
  155.   END;
  156. END;
  157.  
  158. VAR
  159.   led     : leds;
  160.   oseg,
  161.   nseg,
  162.   offseg,
  163.   onseg   : disp;
  164.  
  165. BEGIN
  166.   Setcolor(DarkGray);
  167.  
  168.   IF (nch=#0) AND (och=#0)
  169.     THEN
  170.       BEGIN
  171.         offseg:=[a,b,c,d,e,f,g,dp,dl,dh];
  172.         onseg :=[];
  173.       END
  174.     ELSE
  175.       BEGIN
  176.         Calcleds(och,oseg);
  177.         Calcleds(nch,nseg);
  178.  
  179.         onseg :=nseg-oseg-oseg*nseg;    {----Leds to turn on }
  180.         offseg:=oseg-nseg-oseg*nseg;    {----Leds to turn off}
  181.       END;
  182.  
  183.   FOR led:=a TO dh DO
  184.     WITH rel[led] DO
  185.       BEGIN
  186.         IF led IN  onseg THEN Dispsegm(d, true,scale,dx,dy);
  187.         IF led IN offseg THEN Dispsegm(d,false,scale,dx,dy);
  188.       END;
  189. END;
  190.  
  191. {---------------------------------------------------------}
  192. {----Prints error msg & halts program                     }
  193. {---------------------------------------------------------}
  194.  
  195. PROCEDURE Error(s : STRING);
  196.  
  197. BEGIN
  198.   CLRSCR;
  199.   WRITELN;
  200.   WRITELN('SYNTAX : Segment <color>');
  201.   WRITELN;
  202.   WRITELN('ERROR    ',s);
  203.   WRITELN;
  204.   HALT;
  205. END;
  206.  
  207. {---------------------------------------------------------}
  208. {----Main Program                                         }
  209. {---------------------------------------------------------}
  210.  
  211. VAR
  212.   tmp,
  213.   h,m,s,ms : WORD;
  214.   i,e      : INTEGER;
  215.  
  216.   c1,c2,c3 : STRING[2];
  217.  
  218.   olds,
  219.   news     : STRING;
  220.  
  221.   grdriver,
  222.   grmode,
  223.   errcode : INTEGER;
  224.  
  225.   r       : REGISTERS;
  226.   oldstate: BYTE;
  227.  
  228. {---------------------------------------------------------}
  229.  
  230. BEGIN
  231.  
  232.   Grdriver:=detect;
  233.   DetectGraph(grdriver,grmode);
  234.  
  235. {----Allow segment color to be chosen by user}
  236.   IF (PARAMCOUNT=1)
  237.     THEN
  238.       BEGIN
  239.         VAL(PARAMSTR(1),cl,e);
  240.         IF (e<>0) THEN Error('Incorrcet Parameter');
  241.       END
  242.     ELSE
  243.       CASE grdriver OF
  244.         mcga,
  245.         egamono : cl:=1;
  246.         ega64   : cl:=3;
  247.         ega,
  248.         vga     : cl:=15;
  249.       END;
  250.  
  251.   CASE grdriver OF
  252.     mcga    : IF NOT (cl IN [1])
  253.                 THEN Error('With MCGA only color 1 is allowed');
  254.     ega64   : IF NOT (cl IN [1..3])
  255.                 THEN Error('With 64 K EGA only colors 1..4 are allowed');
  256.     egamono : IF NOT (cl IN [1])
  257.                 THEN Error('With EGA mono only color 1 is allowed');
  258.     ega     : IF NOT (cl IN [1..15])
  259.                 THEN Error('With 256 K EGA only colors 1..15 are allowed');
  260.     vga     : IF NOT (cl IN [1..15])
  261.                 THEN Error('With VGA only colors 1..15 are allowed');
  262.   ELSE Error('Graphics Adapter NOT Supported');
  263.   END;
  264.  
  265.   Initgraph(grdriver,grmode,'');
  266.   errcode:=Graphresult;
  267.  
  268.   news:='        ';
  269.   olds:='        ';
  270.  
  271.   FOR i:=1 TO LENGTH(news) DO Segments(#0,#0,80*(i-1),80,6.0);
  272.  
  273.   r.ah:=$02;
  274.   INTR($16,r);
  275.  
  276.   REPEAT
  277.     oldstate:=r.al;
  278.  
  279.     GETTIME(h,m,s,ms);
  280.  
  281.     STR(h:2,c1);
  282.     STR(m:2,c2);
  283.     STR(s:2,c3);
  284.  
  285.     IF Odd(s)
  286.       THEN news:=c1+':'+c2+':'+c3
  287.       ELSE news:=c1+' '+c2+' '+c3;
  288.  
  289.     IF (news[1]=' ') THEN news[1]:='0';
  290.     IF (news[4]=' ') THEN news[4]:='0';
  291.     IF (news[7]=' ') THEN news[7]:='0';
  292.  
  293.   {----Write only the changed segments in all displays}
  294.     FOR i:=1 TO LENGTH(news) DO Segments(news[i],olds[i],80*(i-1),80,6.0);
  295.  
  296.     olds:=news;
  297.  
  298.     Delay(100);
  299.  
  300. {----Not only wait for normal keypressed but also for
  301.      shift/alt/ctrl or insert/numlock/scrollock keys pressed}
  302.     r.ah:=$02;
  303.     INTR($16,r);
  304.  
  305.   UNTIL (r.al<>oldstate) OR (KEYPRESSED AND (READKEY<>#255));
  306.  
  307.   Closegraph;
  308.  
  309. END. {of segment}
  310.  
  311.  
  312. > I would like to include a clock in my current project which will be
  313. > updated once a minute.  Instead of constantly checking the computer's clock
  314. > and waiting for it to change, I would like to use an interrupt.
  315.  
  316. This one has even a hot key handler.  If you want to update it once per
  317. minute, bump a counter within the interrupt 1Ch handler till it reaches the
  318. value 60*18.2.  Then refresh the screen.
  319. }
  320.  
  321. Program Clock;
  322.  
  323. {$G+,R-,S-,M 1024, 0, 0 }
  324.  
  325. uses
  326.   Dos;
  327.  
  328. Const
  329.   x           = 71;                   { x location on screen }
  330.   y           = 1;                    { y location on screen }
  331.   Keyboard    = 9;                    { Hardware keyboard interrupt }
  332.   TimerTick   = $1C;                  { Gets called 18.2 / second }
  333.   VideoOffset = 160 * (y - 1) + 2 * x;{ Offset in display memory }
  334.   yellow      = 14;
  335.   blue        = 1;
  336.   attribute   = blue * 16 + yellow;   { Clock colours }
  337.   VideoBase   : Word = $B800;         { Segment of display memory }
  338.   ActiveFlag  : ShortInt = -1;        { 0: on, -1: off }
  339.  
  340. Var
  341.   OrgInt9,                             { Saved interrupt 9 vector }
  342.   OrgInt1Ch : Pointer;              { Saved interrupt 1Ch vector }
  343.   VideoMode : Byte absolute $0000:$0449;
  344.  
  345. { Display a string using Dos services (avoid WriteLn, save memory) }
  346.  
  347. Procedure DisplayString(s : String); Assembler;
  348.  
  349. ASM
  350.   PUSH   DS
  351.   XOR    CX, CX
  352.   LDS    SI, s
  353.   LODSB
  354.   MOV    CL, AL
  355.   JCXZ   @EmptyString
  356.   CLD
  357.  @NextChar:
  358.   LODSB
  359.   XCHG   AX, DX
  360.   MOV    AH, 2
  361.   INT    21h
  362.   LOOP   @NextChar
  363.  @EmptyString:
  364.   POP    DS
  365. end;
  366.  
  367. { Returns True if a real time clock could be found }
  368. Function HasRTClock : Boolean; Assembler;
  369.  
  370. ASM
  371.   XOR    AL, AL
  372.   MOV    AH, 2
  373.   INT    1Ah
  374.   JC     @NoRTClock
  375.   INC    AX
  376.  @NoRTCLock:
  377. end;
  378.  
  379. { Release Dos environment }
  380. Procedure ReleaseEnvironment; Assembler;
  381. ASM
  382.   MOV    ES, [PrefixSeg]
  383.   MOV    ES, ES:[002Ch]
  384.   MOV    AH, 49h
  385.   INT    21h
  386. end;
  387.  
  388. { INT 9 handler intercepting Alt-F11 }
  389. Procedure ToggleClock; Interrupt; Assembler;
  390. Const
  391.   F11      = $57;                  { 'F11' make code }
  392.   BiosSeg  = $40;                  { Segment of BIOS data area }
  393.   AltMask  = $08;                  { Bitmask of Alt key }
  394.   KbdFlags = $17;                  { Byte showing keyboard status }
  395.  
  396. ASM
  397.   STI
  398.   IN     AL, 60h
  399.  
  400.  { F11 pressed? }
  401.   CMP    AL, F11
  402.   JNE    @PassThru
  403.  
  404.  { Alt-key pressed? }
  405.   PUSH   BiosSeg
  406.   POP    ES
  407.   MOV    AL, ES:[KbdFlags]
  408.   AND    AL, AltMask
  409.   CMP    AL, AltMask
  410.   JNE    @PassThru
  411.  
  412.  { Flip status flag, force EOI and leave routine }
  413.   NOT    [ActiveFlag]
  414.   IN     AL, 61h
  415.   MOV    AH, AL
  416.   OR     AL, 80h
  417.   OUT    61h, AL
  418.   MOV    AL, AH
  419.   OUT    61h, AL
  420.   CLI
  421.   MOV    AL, 20h
  422.   OUT    20h, AL
  423.   STI
  424.   JMP    @Exit
  425.  
  426.  @PassThru:
  427.   CLI
  428.   PUSHF
  429.   CALL   DWord Ptr [OrgInt9]
  430.  @Exit:
  431. end;  { ToggleClock }
  432.  
  433. { Convert a packed BCD byte to ASCII character }
  434. Procedure Digit; Assembler;
  435. ASM
  436.   PUSH   AX
  437.   CALL   @HiNibble
  438.   POP    AX
  439.   CALL   @LoNibble
  440.   RETN
  441.  
  442.  @HiNibble:
  443.   SHR    AL, 4
  444.   JMP    @MakeAscii
  445.  @LoNibble:
  446.   AND    AL, 0Fh
  447.  @MakeAscii:
  448.   OR     AL, '0'
  449.   STOSW
  450. end;
  451.  
  452. { INT 1Ch handler that displays a clock on the right hand side of the screen }
  453. Procedure DisplayClock; Interrupt; Assembler;
  454. ASM
  455.   CMP    [ActiveFlag], 0
  456.   JNE    @Exit
  457.   CLD
  458.   MOV    AH, 2
  459.   INT    1Ah
  460.   MOV    ES, [VideoBase]
  461.   MOV    DI, VideoOffset
  462.   MOV    AH, attribute
  463.   MOV    AL, CH
  464.   CALL   Digit
  465.   MOV    AL, ':'
  466.   STOSW
  467.   MOV    AL, CL
  468.   CALL   Digit
  469.   MOV    AL, ':'
  470.   STOSW
  471.   MOV    AL, DH
  472.   CALL   Digit
  473.   PUSHF
  474.   CALL   DWord Ptr [OrgInt1Ch]
  475.  @Exit:
  476. end;
  477.  
  478. Begin
  479.   If VideoMode = 7 Then
  480.     VideoBase := $B000;
  481.   GetIntVec(TimerTick, OrgInt1Ch);
  482.   SetIntVec(TimerTick, @DisplayClock);
  483.   GetIntVec(Keyboard, OrgInt9);
  484.   SetIntVec(Keyboard, @ToggleClock);
  485.   SwapVectors;
  486.   ReleaseEnvironment;
  487.   DisplayString('CLOCK installed.  <Alt-F11> toggles on/off');
  488.   Keep(0);
  489. end.
  490.