'Generador de un reloj digital en pantalla'
DEFINT A-Z

DECLARE SUB PonNum (Digito$, Posicion)
DIM SHARED P(6), A
mir$ = "Reloj  ( Jos‚ David Guill‚n 15/02/93 )"
IF MID$(mir$, 13, 1) <> "‚" THEN PRINT " Programa modificado 1": SYSTEM
IF MID$(mir$, 26, 1) <> "‚" THEN PRINT " Programa modificado 2": SYSTEM

P(1) = 0
P(2) = 80
P(3) = 200
P(4) = 280

P(5) = 400
P(6) = 440

SCREEN 9
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)
                       
                        Hora1$ = LEFT$(Hora$, 1)
                                A = 1
                                PonNum Hora1$, 1
                        Hora2$ = MID$(Hora$, 2, 1)
                                A = 2
                                PonNum Hora2$, 2
                              
LINE (170, 20)-(180, 30), 12, BF
LINE (170, 60)-(180, 70), 12, BF

                        Min1$ = LEFT$(Min$, 1)
                                A = 3
                                PonNum Min1$, 3
                               
                        Min2$ = MID$(Min$, 2, 1)
                                A = 4
                                PonNum Min2$, 4


LINE (370, 50)-(380, 60), 12, BF
LINE (370, 80)-(380, 90), 12, BF


DO
Hora$ = LEFT$(TIME$, 2)
Min$ = MID$(TIME$, 4, 2)

IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM

IF OldHor2$ <> LEFT$(Hora$, 1) THEN
                        Hora1$ = LEFT$(Hora$, 1)
                                A = 1
                                PonNum Hora1$, 1
END IF
OldHor2$ = LEFT$(Hora$, 1)

IF OldHor1$ <> MID$(Hora$, 2, 1) THEN
                        Hora2$ = MID$(Hora$, 2, 1)
                                A = 2
                                PonNum Hora2$, 2
END IF
OldHor1$ = MID$(Hora$, 2, 1)

IF OldMin2$ <> LEFT$(Min$, 1) THEN
                        Min1$ = LEFT$(Min$, 1)
                                A = 3
                                PonNum Min1$, 3
END IF
OldMin2$ = LEFT$(Min$, 1)

IF OldMin1$ <> MID$(Min$, 2, 1) THEN
                        Min2$ = MID$(Min$, 2, 1)
                                A = 4
                                PonNum Min2$, 4
                                
END IF
OldMin1$ = MID$(Min$, 2, 1)

IF INKEY$ <> "" THEN SCREEN 0: PRINT mir$: SYSTEM

                            seg$ = MID$(TIME$, 7, 1)
                                A = 5
                                PonNum seg$, 5
                            seg$ = MID$(TIME$, 8, 1)
                                A = 6
                                PonNum seg$, 6


LOOP

SUB PonNum (Digito$, Posicion)

SELECT CASE VAL(RTRIM$(LTRIM$(Digito$)))
        CASE 0
              D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 0: D6 = 1: D7 = 1
       
        CASE 1
              D1 = 0: D2 = 0: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
              
        CASE 2
              D1 = 0: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 0: D7 = 1
              
              
        CASE 3
              D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
              
              
        CASE 4
              D1 = 1: D2 = 0: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 0
              
              
        CASE 5
              D1 = 1: D2 = 1: D3 = 0: D4 = 0: D5 = 1: D6 = 1: D7 = 1
              
              
        CASE 6
              D1 = 1: D2 = 1: D3 = 0: D4 = 1: D5 = 1: D6 = 1: D7 = 1
              
              
        CASE 7
              D1 = 0: D2 = 1: D3 = 1: D4 = 0: D5 = 0: D6 = 1: D7 = 0
              
              
        CASE 8
              D1 = 1: D2 = 1: D3 = 1: D4 = 1: D5 = 1: D6 = 1: D7 = 1
              
              
        CASE 9
              D1 = 1: D2 = 1: D3 = 1: D4 = 0: D5 = 1: D6 = 1: D7 = 1
              
              
END SELECT

IF Posicion < 5 THEN

IF D1 = 1 THEN
PSET (0 + P(A), 0), 4
DRAW "D40 R15 U26 H15"
 DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 0), 0
DRAW "D40 R15 U26 H15"
 DRAW "F13 BL5 P0,0"

END IF

IF D2 = 1 THEN
PSET (3 + P(A), 0), 4
DRAW "R63 G15 L33 H15"
 DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 0), 0
DRAW "R63 G15 L33 H15"
 DRAW "BR5 BD5 BR23 P0,0"

END IF

IF D3 = 1 THEN
PSET (69 + P(A), 0), 4
DRAW " D40 L15 U25 E15"
 DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 0), 0
DRAW " D40 L15 U25 E15"
 DRAW "G13 BR5 P0,0"

END IF

IF D4 = 1 THEN
PSET (0 + P(A), 42), 4
DRAW " D50 E15 U20 H15"
 DRAW "F13 BL5 P4,4"
ELSE
PSET (0 + P(A), 42), 0
DRAW " D50 E15 U20 H15"
 DRAW "F13 BL5 P0,0"

END IF

IF D5 = 1 THEN
PSET (3 + P(A), 42), 4
DRAW " R63 G15 L33 H15"
 DRAW "BR5 BD5 BR23 P4,4"
ELSE
PSET (3 + P(A), 42), 0
DRAW " R63 G15 L33 H15"
 DRAW "BR5 BD5 BR23 P0,0"

END IF

IF D6 = 1 THEN
PSET (69 + P(A), 42), 4
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P4,4"
ELSE
PSET (69 + P(A), 42), 0
DRAW " D50 H15 U20 E15"
DRAW "G13 BR5 P0,0"

END IF

IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW " E15 R33 F15 L62"
DRAW "BR23 BU5 P0,0"

END IF

'********************************************************
'**************** EL GRAN  " ELSE " *********************
'********************************************************

ELSE

IF D1 = 1 THEN
PSET (0 + P(A), 45), 4
DRAW "D20 R8 U13 H8"
 DRAW "F7 BL3 P4,4"
ELSE
PSET (0 + P(A), 45), 0
DRAW "D20 R8 U13 H8"
 DRAW "F7 BL3 P0,0"

END IF

IF D2 = 1 THEN
PSET (3 + P(A), 45), 4
DRAW "R32 G8 L17 H8"
 DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 45), 0
DRAW "R32 G8 L17 H8"
 DRAW "BR3 BD3 BR12 P0,0"

END IF

IF D3 = 1 THEN
PSET (37 + P(A), 45), 4
DRAW "D20 L8 U13 E8"
 DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 45), 0
DRAW "D20 L8 U13 E8"
 DRAW "G8 BR3 P0,0"

END IF

IF D4 = 1 THEN
PSET (0 + P(A), 67), 4
DRAW "D25 E8 U10 H8"
 DRAW "F8 BL3 P4,4"
ELSE
PSET (0 + P(A), 67), 0
DRAW "D25 E8 U10 H8"
 DRAW "F8 BL3 P0,0"

END IF

IF D5 = 1 THEN
PSET (3 + P(A), 67), 4
DRAW "R32 G8 L17 H8"
 DRAW "BR3 BD3 BR12 P4,4"
ELSE
PSET (3 + P(A), 67), 0
DRAW "R32 G8 L17 H8"
 DRAW "BR3 BD3 BR12 P0,0"

END IF

IF D6 = 1 THEN
PSET (37 + P(A), 67), 4
DRAW "D25 H8 U10 E8"
 DRAW "G8 BR3 P4,4"
ELSE
PSET (37 + P(A), 67), 0
DRAW "D25 H8 U10 E8"
 DRAW "G8 BR3 P0,0"

END IF

IF D7 = 1 THEN
PSET (3 + P(A), 93), 4
DRAW "E8 R17 F8 L34"
 DRAW "BR12 BU3 P4,4"
ELSE
PSET (3 + P(A), 93), 0
DRAW "E8 R17 F8 L34"
 DRAW "BR12 BU3 P0,0"

END IF

END IF



END SUB