DECLARE SUB wisselen (x!)

DECLARE SUB wachttijd (x!)

DECLARE SUB spanningnul ()

DECLARE SUB naarspoor (x!)

DECLARE SUB seingroen (x!)

DECLARE SUB seinrood (x!)

DECLARE SUB spanningdefault ()

DECLARE SUB parade (x!)

DECLARE SUB wissel (x!)

DECLARE SUB sein (x!)

DECLARE SUB contact (x!)

DECLARE SUB kalibreren ()

DECLARE SUB opties ()

DECLARE SUB lees (x!)

DECLARE SUB puls (x!)

DECLARE SUB scherm ()



'**********************initialiseren

CONST p = &H378: 'printerpoort uitgang

CONST q = &H379: 'printerpoort ingang



DIM SHARED s(3), b(3), w(4), c(4), ontk: 'sein, baan, wissel, contactrail, ontkoppelrail

DIM SHARED optie$(23), optie(23), keuze: 'beschikbare modules en keuze van gebruiker

DIM SHARED klok: 'tijdwaarde die dimmer nog heeft van 0 naar 12 volt



CALL scherm

OUT p, 0

FOR i = 1 TO 3

s(i) = 1

w(i) = 0

b(i) = 0

NEXT

w(4) = 0

FOR i = 1 TO 23

READ optie$(i)

NEXT

FOR i = 1 TO 3

CALL lees(i)

OUT p, 10 + i

IF c(i) = 1 THEN PRINT "Storing in contactrail"; i + 10: fout = 1

OUT p, 0

IF c(i) = 1 THEN PRINT "Storing in contactrail"; i: fout = 1

NEXT

IF fout = 1 THEN INPUT "Druk op Enter indien gereed"; keuze

'CALL kalibreren

'CALL spanningdefault







DATA "Vertrek van spoor 1"

DATA "Vertrek van spoor 2"

DATA "Vertrek van spoor 3"

DATA "Aankomst op spoor 1"

DATA "Aankomst op spoor 2"

DATA "Aankomst op spoor 3"

DATA "Van spoor 1 naar spoor 2"

DATA "Van spoor 2 naar spoor 1"

DATA "Van spoor 2 naar spoor 3"

DATA "Van Spoor 3 naar spoor 2"

DATA "Van spoor 1 naar spoor 3"

DATA "Van Spoor 3 naar spoor 1"

DATA "Parade zijspoor 2"

DATA "Parade spoor 1, vanaf spoor 2"

DATA "Parade spoor 1, vanaf spoor 3"

DATA "Parade spoor 3, vanaf spoor 2"

DATA "Parade spoor 3, vanaf spoor 1"

DATA "Rijrichting wijzigen op spoor 3"

DATA "Wisselen spoor 1 en 2 op spoor 2"

DATA "Wisselen spoor 1 en 2 op spoor 1"

DATA "Wisselen spoor 2 en 3 op spoor 3"

DATA "Wisselen spoor 1 en 3 op spoor 1"

DATA "Wisselen spoor 1 en 3 op spoor 2"



'******************besturing



DO

  CALL scherm

  CALL opties

  INPUT " Keuze"; keuze

  IF optie(keuze) = 1 THEN

    CALL scherm

    COLOR 0, 7

    LOCATE 9, 2

    PRINT "Uitvoeren module"; keuze; ":   "; optie$(keuze)

    COLOR 7, 0

    PRINT

    SELECT CASE keuze

      CASE 1 TO 3

        CALL seingroen(keuze)

      CASE 4 TO 6

        CALL seinrood(keuze - 3)

      CASE 6 TO 12

        CALL naarspoor(keuze)

      CASE 13 TO 18

        CALL parade(keuze)

      CASE 19 TO 23

        CALL wisselen(keuze)

    END SELECT

    SOUND 2000, 5

  ELSE

    BEEP

  END IF

LOOP



SUB contact (x)

'Wacht op railcontact of druk op [ESC]



PRINT " Wacht op railcontact"; x;

IF x > 3 THEN

  y = INP(p)

  OUT p, x

  x = x - 10

END IF

z = CSRLIN

t = TIMER

c(x) = 0

WHILE c(x) = 0 AND INKEY$ <> CHR$(27)

CALL lees(x)

LOCATE 5, 75

PRINT USING "##.##"; TIMER - t

WEND

LOCATE 5, 75

PRINT USING "##.##"; 0

LOCATE z, 1

OUT p, y

END SUB



SUB kalibreren

'Bepaal waarde voor variable klok



PRINT " Kalibreren regelspanning"

'regelspanning op 0 volt zetten

'zet dimmer aan, meetrelais 15 aan

y = INP(p)

OUT p, y + 15

CALL puls(14)

CALL puls(10)



'wacht 2 seconden om voorbij het nulpunt te komen

t = TIMER + 2

WHILE TIMER < t

LOCATE 5, 75

PRINT USING "##.##"; ABS(TIMER - t)

WEND



'zolang contactrelais 4 is ingeschakeld blijven wachten

t = TIMER

y = INP(q)

WHILE y < 120 OR y = 248 AND INKEY$ <> CHR$(27)

y = INP(q)

LOCATE 5, 75

PRINT USING "##.##"; ABS(TIMER - t)

WEND

CALL puls(10)



'tijd meten

CALL puls(10)

t = TIMER



'eerst 2 seconden wachten

WHILE TIMER < t + 2

LOCATE 5, 75

PRINT USING "##.##"; ABS(TIMER - t)

WEND



y = INP(q)

WHILE y < 120 OR y = 248 AND INKEY$ <> CHR$(27)

y = INP(q)

LOCATE 5, 75

PRINT USING "##.##"; ABS(TIMER - t)

WEND

klok = (TIMER - t) / 2

CALL puls(10)



'zet dimmer uit, meetrelais 15 uit

CALL puls(14)

OUT p, y

LOCATE 5, 75

PRINT USING "##.##"; 0



END SUB



SUB lees (x)

'reset gevraagde contact x en geef actuele waarde terug



c(x) = 0

y = INP(q)

IF y = 152 OR y = 184 OR y = 216 THEN c(1) = 1

IF y = 168 OR y = 184 OR y = 232 THEN c(2) = 1

IF y = 200 OR y = 216 OR y = 232 THEN c(3) = 1



END SUB



SUB naarspoor (x)



SELECT CASE x

  CASE 7

    CALL contact(11)

    CALL contact(1)

    CALL contact(1)

    CALL contact(1)

    CALL contact(1)

    CALL wissel(1)

    CALL contact(12)

    CALL contact(2)

    CALL wissel(1)

  CASE 8

    'rekening houden met sein 2 bezet

    CALL contact(12)

    CALL contact(2)

    IF s(2) = 0 THEN CALL contact(2)

    CALL wissel(1)

    CALL contact(2)

    IF s(2) = 0 THEN CALL contact(2)

    CALL contact(1)

    CALL wissel(1)

  CASE 9

    'rekening houden met sein 2 bezet

    CALL contact(12)

    CALL contact(2)

    IF s(2) = 0 THEN CALL contact(2)

    CALL wissel(3)

    CALL contact(2)

    CALL contact(3)

    CALL wissel(3)

  CASE 10

    'rekening houden met rijrichting op baan 3

    IF b(3) = -1 THEN CALL parade(18)

    CALL contact(13)

    CALL wissel(3)

    CALL contact(3)

    CALL contact(3)

    CALL contact(2)

    CALL contact(2)

    CALL wissel(3)

  CASE 11

    'rekening houden met sein 2 bezet

    CALL contact(11)

    CALL contact(1)

    CALL contact(1)

    CALL contact(1)

    CALL contact(1)

    CALL wissel(1)

    CALL contact(12)

    CALL wissel(3)

    CALL contact(2)

    IF s(2) = 0 THEN CALL wissel(2)

    CALL wissel(1)

    CALL contact(3)

    CALL wissel(3)

  CASE 12

    'rekening houden met rijrichting op baan 3

    IF b(3) = -1 THEN CALL parade(18)

    CALL contact(3)

    CALL wissel(3)

    CALL contact(2)

    CALL wissel(1)

    CALL contact(2)

    CALL wissel(3)

    CALL contact(1)

    CALL wissel(1)

END SELECT

END SUB



SUB opties

'Bepaal opties en print opties



FOR i = 1 TO 23

optie(i) = 0

NEXT



'vertrek/aankomst

IF b(1) = 0 AND s(1) <> 0 THEN optie(1) = 1

IF b(2) = 0 AND s(2) <> 0 THEN optie(2) = 1

IF b(3) = 0 AND s(3) <> 0 THEN optie(3) = 1

IF b(1) <> 0 AND s(1) = 0 THEN optie(4) = 1

IF b(2) <> 0 AND s(2) = 0 THEN optie(5) = 1

IF b(3) <> 0 AND s(3) = 0 THEN optie(6) = 1



'naarspoor

IF b(1) = 1 AND b(2) = 0 THEN optie(7) = 1

IF b(1) = 0 AND b(2) = 1 AND s(1) = 0 THEN optie(8) = 1

IF b(2) = -1 AND b(3) = 0 AND s(3) = 0 THEN optie(9) = 1

IF b(2) = 0 AND b(3) = 1 THEN optie(10) = 1

IF b(1) <> 0 AND b(2) = 0 AND b(3) = 0 THEN optie(11) = 1

IF b(1) = 0 AND b(2) = 0 AND b(3) <> 0 THEN optie(12) = 1



'parade

IF b(2) <> 0 THEN optie(13) = 1

IF b(1) = 0 AND b(2) = 1 THEN optie(14) = 1

IF b(1) = 0 AND b(2) = 0 AND b(3) <> 0 THEN optie(15) = 1

IF b(2) = -1 AND b(3) = 0 AND s(3) = 0 THEN optie(16) = 1

IF b(1) <> 0 AND b(2) = 0 AND b(3) = 0 AND s(3) = 0 THEN optie(17) = 1

IF b(3) = -1 THEN optie(18) = 1



'wisselen

IF b(1) = 1 AND b(2) = 0 AND s(2) = 1 THEN optie(19) = 1

IF b(1) = 0 AND b(2) = 1 AND s(1) <> 0 THEN optie(20) = 1

IF b(2) = -1 AND b(3) = 0 AND s(3) = 1 THEN optie(21) = 1

IF b(1) = 0 AND b(2) = 0 AND b(3) = 1 AND s(1) <> 1 THEN optie(22) = 1

IF b(1) <> 0 AND b(2) = 0 AND b(3) = 0 AND s(3) = 1 THEN optie(23) = 1









FOR i = 1 TO 23

IF optie(i) = 1 THEN

  PRINT USING "###. "; i;

  PRINT optie$(i)

END IF

NEXT

PRINT



END SUB



SUB parade (x)



SELECT CASE x

  CASE 13

    CALL contact(12)

    CALL wissel(2)

    CALL contact(2)

    CALL contact(2)

    CALL wissel(2)

  CASE 14

    'rekening houden met sein 2 bezet

    CALL contact(12)

    CALL contact(2)

    IF s(2) = 0 THEN CALL contact(2)

    CALL wissel(1)

    CALL contact(2)

    CALL contact(1)

    CALL contact(1)

    CALL contact(1)

    CALL contact(2)

    CALL contact(2)

    CALL wissel(1)

  CASE 15

    CALL contact(3)

    CALL wissel(3)

    CALL contact(2)

    CALL wissel(1)

    CALL contact(2)

    CALL contact(1)

    CALL contact(1)

    CALL contact(1)

    CALL contact(2)

    CALL contact(2)

    CALL wissel(1)

    CALL contact(3)

    CALL wissel(3)

  CASE 16

    CALL contact(12)

    CALL wissel(3)

    CALL contact(2)

    CALL wachttijd(5)

    CALL wissel(3)

    CALL contact(3)

    CALL wissel(3)

    CALL contact(3)

    CALL contact(3)

    CALL contact(2)

    CALL contact(2)

    CALL wissel(3)

  CASE 17

    'rekening houden met sein 2 bezet

    CALL contact(11)

    CALL contact(1)

    CALL contact(1)

    CALL wissel(1)

    CALL contact(1)

    CALL contact(1)

    CALL contact(2)

    IF s(2) = 0 THEN CALL wissel(2)

    CALL wissel(3)

    CALL contact(2)

    CALL wachttijd(5)

    CALL wissel(3)

    CALL contact(3)

    CALL wissel(3)

    CALL contact(3)

    CALL contact(3)

    CALL contact(2)

    CALL contact(2)

    CALL wissel(3)

    CALL contact(1)

    CALL wissel(1)

  CASE 18

    CALL contact(3)

    CALL wissel(3)

    CALL contact(3)

    CALL contact(13)

    CALL wissel(3)

END SELECT



END SUB



SUB puls (x)

'geef puls op uitgang x, bestaande instelling behouden



y = INP(p)

OUT p, x + y

FOR i = 1 TO 1000: NEXT

OUT p, y



END SUB



SUB scherm

'print layout en variabelen



COLOR 7, 0

CLS

COLOR 0, 7

PRINT "                              TREINBESTURING CH2005                             "

COLOR 7, 0

PRINT

PRINT " SPOOR 1:       SEIN 1:       WISSEL 1:       OKRAIL:          MODULE:       99 "

PRINT " SPOOR 2:       SEIN 2:       WISSEL 2:                        TAAK:         99 "

PRINT " SPOOR 3:       SEIN 3:       WISSEL 3:                        TIMER:     00:00 "

PRINT "                              WISSEL 4:                                         "

PRINT "________________________________________________________________________________";

FOR i = 1 TO 3

LOCATE i + 2, 11

PRINT b(i)

LOCATE i + 2, 25

PRINT s(i)

LOCATE i + 2, 41

PRINT w(i)

NEXT

LOCATE 6, 41

PRINT w(4)

LOCATE 3, 58

PRINT ontk

LOCATE 3, 76

PRINT USING "  ##"; module

LOCATE 4, 76

PRINT USING "  ##"; taak

LOCATE 5, 75

PRINT USING "##.##"; 0

LOCATE 25, 1

COLOR 0, 7

PRINT "                           V0.1 2006  (C)HENK DE JONG                           ";

COLOR 7, 0

LOCATE 9, 1

END SUB



SUB sein (x)



PRINT " Zet sein"; x;

IF s(x) = 0 THEN

        PRINT "op rood"

        CALL puls(x)

        s(x) = b(x)

        b(x) = 0

ELSE

        PRINT "op groen"

        CALL puls(x + 128)

        b(x) = s(x)

        s(x) = 0

END IF

z = CSRLIN

LOCATE x + 2, 25

PRINT s(x)

LOCATE z, 1

END SUB



SUB seingroen (x)

'Module vertrek van spoor x



PRINT " Besturing spoor"; x; "overnemen"

CALL spanningnul

y = INP(p)

IF x = 1 THEN OUT p, y + 16

IF x = 2 THEN OUT p, y + 32

IF x = 3 THEN OUT p, y + 64



CALL sein(x)



PRINT " Optrekken"

CALL puls(14)

CALL puls(10)

t = TIMER + klok

WHILE TIMER < t

WEND

CALL puls(10)



PRINT " Besturing spoor"; x; "op autopilot"

OUT p, y



'Controleer of trein rijdt

CALL contact(x)

PRINT " Trein rijdt op spoor"; x



PRINT " Regelspanning naar default"

CALL puls(10)

t = TIMER + 1

WHILE TIMER < t

WEND

CALL puls(10)

CALL puls(14)



END SUB



SUB seinrood (x)

'Module aankomst op spoor x



PRINT " Besturing spoor"; x; "overnemen"



'spanning van 11 volt (default) naar 12 volt

CALL puls(14)

CALL puls(10)

t = TIMER + 1

WHILE TIMER < t

WEND

CALL puls(10)



'baanspanning overnemen

y = INP(p)

IF x = 1 THEN OUT p, y + 16

IF x = 2 THEN OUT p, y + 32

IF x = 3 THEN OUT p, y + 64



CALL contact(x + 10)

CALL sein(x)



PRINT " Vaart minderen"

CALL puls(10)

t = TIMER + klok - 2

WHILE TIMER < t

WEND

CALL puls(10)



CALL contact(x)

PRINT "Trein aangekomen op seinspoor"; x

CALL puls(14)

OUT p, y

CALL spanningnul

CALL spanningdefault



END SUB



SUB spanningdefault



PRINT "Regelspanning instellen"



'Zet spanning op ongeveer default 11 Volt vanaf nul

z = CSRLIN

CALL puls(14)

CALL puls(10)

t = TIMER + klok - 1

WHILE TIMER < t

LOCATE 5, 75

PRINT USING "##.##"; ABS(t - TIMER)

WEND

CALL puls(10)

CALL puls(14)

LOCATE 5, 75

PRINT USING "##.##"; 0

LOCATE z, 1



END SUB



SUB spanningnul



PRINT " Zet regelspanning op nul"



'zet dimmer aan, meetrelais 15 aan

y = INP(p)

z = CSRLIN

OUT p, y + 15

CALL puls(14)

CALL puls(10)



'zolang contactrelais 4 is ingeschakeld blijven wachten

t = TIMER

y = INP(q)

WHILE y < 120 OR y = 248

y = INP(q)

LOCATE 5, 75

PRINT USING "##.##"; ABS(TIMER - t)

WEND

CALL puls(10)

CALL puls(14)



'meetrelais 15 uit

OUT p, y

LOCATE 5, 75

PRINT USING "##.##"; 0

LOCATE z, 1

END SUB



SUB wachttijd (x)

'wacht gedurende x seconden



t = TIMER + x

WHILE TIMER < t

LOCATE 5, 75

PRINT USING "##.##"; TIMER - t

WEND

PRINT USING "##.##"; 0



END SUB



SUB wissel (x)



PRINT " Zet wissel"; x; "om ";

IF s(x) = 0 THEN

        PRINT "/"

        CALL puls(x + 3)

        w(x) = 1

ELSE

        PRINT "-"

        CALL puls(x + 3 + 128)

        w(x) = 0

END IF

z = CSRLIN

LOCATE x + 2, 41

PRINT w(x)

LOCATE z, 1

END SUB



SUB wisselen (x)



PRINT " Under construction"

SLEEP 2





END SUB