home *** CD-ROM | disk | FTP | other *** search
/ Nederland Interaktief Kinderen / NLeduca.bin / NLEDUCA / DOOLHOF / MAAKDOOL.BAS < prev    next >
BASIC Source File  |  1991-11-05  |  15KB  |  476 lines
  1. DEFINT A-Z
  2.  DIM hor(36, 36)        'horizontalen streepjes aan(1)  uit(0)
  3.  DIM ver(36, 36)        'verticalen   streepjes aan(1)  uit(0)
  4.  DIM Loper(1000)        'GET / PUT witte vakje
  5.  DIM Dolen1$(100)       'doolhoven 1
  6.  DIM Dolen2$(100)       '          2
  7.  DIM Dolen3$(100)       '          3
  8.  DIM dolen$(100)        'lijst waarmee gewerkt wordt
  9.  DIM sleutels(36, 36)
  10.  DIM Sleutel(1000)      'GET / PUT Sleutel
  11.  DIM Rondje(1000)       'GET / PUT Rondje
  12. GOSUB Begin
  13. GOSUB LijstDol
  14. verder1:
  15.     GOSUB HoofdMenu
  16.     IF SpelNivo = 4 THEN END
  17.     IF nieuw$ = "j" THEN
  18.        GOSUB NieuwDol
  19.     ELSE
  20.        GOSUB TonenLijst        'laat doolhof kiezen
  21.        GOSUB LeesDol           'inlezen doolhof
  22.     END IF
  23.     GOSUB Scherm            'scherm opbouwen
  24.     DO
  25.         woord$ = INKEY$
  26.         SELECT CASE woord$
  27.             CASE IS = omhoog$, omlaag$, Rechts$, Links$
  28.                     GOSUB PijltjesToetsen
  29.             CASE "b"
  30.                     GOSUB Boven
  31.             CASE "o"
  32.                     GOSUB Onder
  33.             CASE "l"
  34.                     GOSUB Links
  35.             CASE "r"
  36.                     GOSUB Rechts
  37.             CASE F1$
  38.                     GOSUB F1
  39.             CASE F2$
  40.                     GOSUB F2
  41.             CASE F3$
  42.                     GOSUB F3
  43.             CASE esc$
  44.                     GOSUB bewaren
  45.         END SELECT
  46.     LOOP UNTIL woord$ = esc$ OR EindeSpel = 1
  47.  
  48. GOTO verder1
  49.  
  50.  
  51. '------------------------------------------------------------------------
  52. Begin:
  53.  REM ---------------Begin akties van het programma---------
  54.  SCREEN 9
  55.  COLOR 15, 5            'witte voorgrond, roze achtergrond
  56.  omhoog$ = CHR$(0) + CHR$(72)
  57.  omlaag$ = CHR$(0) + CHR$(80)
  58.  Links$ = CHR$(0) + CHR$(75)
  59.  Rechts$ = CHR$(0) + CHR$(77)
  60.  F1$ = CHR$(0) + CHR$(59)
  61.  F2$ = CHR$(0) + CHR$(60)
  62.  F3$ = CHR$(0) + CHR$(61)
  63.  esc$ = CHR$(27)
  64.  CLS
  65. RETURN
  66. '--------------------------------------------------------------------------
  67. bewaren:
  68.    LOCATE 20, 1
  69.    INPUT "Doolhof bewaren (j/n)"; bewaren$
  70.    bewaren$ = LCASE$(bewaren$)
  71.    IF (bewaren$ <> "j") THEN
  72.       INPUT "U weet het zeker"; zeker$
  73.       zeker$ = LCASE$(zeker$)
  74.       IF (zeker$ <> "j") THEN
  75.          GOTO bewaren
  76.       ELSE
  77.          GOTO eindebewaren
  78.       END IF
  79.    END IF
  80.    IF (nieuw$ = "j") THEN
  81.       IF (SpelNivo = 1) THEN
  82.          AantDolen1 = AantDolen1 + 1
  83.          Dolen1$(AantDolen1) = DoolNaam$
  84.       END IF
  85.       IF (SpelNivo = 2) THEN
  86.          AantDolen2 = AantDolen2 + 1
  87.          Dolen2$(AantDolen2) = DoolNaam$
  88.       END IF
  89.       IF (SpelNivo = 3) THEN
  90.          AantDolen3 = AantDolen3 + 1
  91.          Dolen3$(AantDolen3) = DoolNaam$
  92.       END IF
  93.    END IF
  94.    IF (SpelNivo = 1) THEN BestandsNaam$ = DoolNaam$ + "." + "DO1"
  95.    IF (SpelNivo = 2) THEN BestandsNaam$ = DoolNaam$ + "." + "DO2"
  96.    IF (SpelNivo = 3) THEN BestandsNaam$ = DoolNaam$ + "." + "DO3"
  97.    ON ERROR GOTO SchrijfFout
  98.    OPEN "o", #3, BestandsNaam$
  99.    WRITE #3, BeginX, BeginY, "b"
  100.    WRITE #3, EindeX, EindeY, "e"
  101.    FOR i = 0 TO aantvakjes
  102.    FOR j = 0 TO aantvakjes
  103.       IF (hor(i, j)) = 1 THEN WRITE #3, i, j, "0"
  104.       IF (ver(i, j)) = 1 THEN WRITE #3, i, j, "1"
  105.       IF (sleutels(i, j)) = 1 THEN WRITE #3, i, j, "s"
  106.    NEXT j
  107.    NEXT i
  108.    WRITE #3, 9, 9, 9
  109.    CLOSE #3
  110.    ON ERROR GOTO 0
  111. eindebewaren:
  112. RETURN
  113. '--------------------------------------------------------------------------
  114. Boven:
  115.    IF hor(LoperX, LoperY) = 1 THEN
  116.       LINE (LoperX * LengteX + 171, LoperY * LengteY + 12)-STEP(LengteX - 2, 0), 0
  117.       hor(LoperX, LoperY) = 0
  118.    ELSE
  119.       LINE (LoperX * LengteX + 171, LoperY * LengteY + 12)-STEP(LengteX - 2, 0)
  120.       hor(LoperX, LoperY) = 1
  121.   END IF
  122. RETURN
  123. '--------------------------------------------------------------------------
  124. F1:
  125.    PUT (LoperX * LengteX + 171, LoperY * LengteY + 13), Sleutel
  126.    IF (sleutels(LoperX, LoperY) = 1) THEN
  127.       sleutels(LoperX, LoperY) = 0
  128.    ELSE
  129.       sleutels(LoperX, LoperY) = 1
  130.    END IF
  131. RETURN
  132. '--------------------------------------------------------------------------
  133. F2:
  134.    LINE (BeginX * LengteX + 172, BeginY * LengteY + 14)-STEP(LengteX - 4, LengteY - 4), 0, B
  135.    BeginX = LoperX
  136.    BeginY = LoperY
  137.    PUT (LoperX * LengteX + 171, LoperY * LengteY + 13), Loper 'Zet loper op oude plaats
  138.    LINE (BeginX * LengteX + 172, BeginY * LengteY + 14)-STEP(LengteX - 4, LengteY - 4), , B
  139.    PUT (LoperX * LengteX + 171, LoperY * LengteY + 13), Loper 'Zet loper op nieuwe plaats
  140. RETURN
  141. '--------------------------------------------------------------------------
  142. F3: 
  143.    PUT (EindeX * LengteX + 171, EindeY * LengteY + 13), Rondje
  144.    EindeX = LoperX
  145.    EindeY = LoperY
  146.    PUT (EindeX * LengteX + 171, EindeY * LengteY + 13), Rondje
  147. RETURN
  148. '--------------------------------------------------------------------------
  149. HoofdMenu:
  150.    CLS
  151.    PRINT "Maak een keuze (1, 2, 3 of 4)"
  152.    PRINT ""
  153.    PRINT "   1  Spelnivo 1, doolhof 20 x 20"
  154.    PRINT "   2  Spelnivo 2, doolhof 27 x 27"
  155.    PRINT "   3  Spelnivo 3, doolhof 36 x 36"
  156.    PRINT "   4  Einde programma"
  157.    PRINT
  158.    INPUT SpelNivo
  159.    IF SpelNivo < 1 THEN GOTO HoofdMenu
  160.    IF SpelNivo > 4 THEN GOTO HoofdMenu
  161.    REM ---------- Maakt alles dezelfde ----------
  162.    IF SpelNivo = 1 THEN
  163.       aantvakjes = 20
  164.       AantDolen = AantDolen1
  165.       FOR i = 1 TO AantDolen1
  166.          dolen$(i) = Dolen1$(i)
  167.       NEXT i
  168.    END IF
  169.    IF SpelNivo = 2 THEN
  170.       aantvakjes = 27
  171.       AantDolen = AantDolen2
  172.       FOR i = 1 TO AantDolen
  173.          dolen$(i) = Dolen2$(i)
  174.       NEXT i
  175.    END IF
  176.    IF SpelNivo = 3 THEN
  177.       aantvakjes = 36
  178.       AantDolen = AantDolen3
  179.       FOR i = 1 TO AantDolen
  180.          dolen$(i) = Dolen3$(i)
  181.       NEXT i
  182.    END IF
  183.    IF (SpelNivo <> 4) THEN
  184.       INPUT "Een nieuw doolhof maken (j/n)"; nieuw$
  185.       IF nieuw$ = "J" THEN nieuw$ = "j"
  186.       IF (nieuw$ = "j") THEN
  187.          IF (AantDolen > 99) THEN
  188.             PRINT
  189.             PRINT "Er zijn al meer dan 99 doolhoven van nivo"; SpelNivo
  190.             PRINT "Druk op een toets"
  191.             WHILE INKEY$ = ""
  192.             WEND
  193.             GOTO HoofdMenu
  194.          END IF
  195.       ELSE
  196.          IF (AantDolen < 1) THEN
  197.             PRINT
  198.             PRINT "Er zijn (nog) geen doolhoven van nivo"; SpelNivo
  199.             PRINT "Druk op een toets"
  200.             WHILE INKEY$ = ""
  201.             WEND
  202.             GOTO HoofdMenu
  203.          END IF
  204.       END IF
  205.    END IF
  206. RETURN
  207. '--------------------------------------------------------------------------
  208. LeesFout:
  209.     PRINT "Fout bij lezen "; BestandsNaam$
  210.     PRINT "Druk op een knop voor programma einde"
  211.     WHILE INKEY$ = ""
  212.     WEND
  213.     END
  214. '--------------------------------------------------------------------------
  215. LeesDol:
  216.    ON ERROR GOTO LeesFout
  217.    BestandsNaam$ = DoolNaam$ + ".do1"
  218.    IF SpelNivo = 1 THEN BestandsNaam$ = DoolNaam$ + ".do1"
  219.    IF SpelNivo = 2 THEN BestandsNaam$ = DoolNaam$ + ".do2"
  220.    IF SpelNivo = 3 THEN BestandsNaam$ = DoolNaam$ + ".do3"
  221.    OPEN "i", #1, BestandsNaam$
  222.    REM ------ lezen lijst ----------
  223.    GOSUB LegeTabellen
  224.    FOR i = 1 TO 4000 'REM lees max 4000 regels van doolhof
  225.       IF EOF(1) THEN GOTO SluitenLijst
  226.       INPUT #1, x, y, wat$
  227.       IF wat$ = "9" THEN GOTO SluitenLijst 'REM een 9 in kolom 3 geeft einde aan
  228.       SELECT CASE wat$
  229.           CASE "0"
  230.              hor(x, y) = 1
  231.          CASE "1"
  232.              ver(x, y) = 1
  233.          CASE "s"
  234.              sleutels(x, y) = 1
  235.          CASE "b"
  236.              BeginX = x: BeginY = y
  237.          CASE "e"
  238.              EindeX = x: EindeY = y
  239.       END SELECT
  240.    NEXT i
  241. SluitenLijst:
  242.    CLOSE #1
  243.    ON ERROR GOTO 0
  244. RETURN
  245. '--------------------------------------------------------------------------
  246. LegeTabellen:
  247.    FOR i = 0 TO aantvakjes 'REM zet tabellen op leeg
  248.    FOR j = 0 TO aantvakjes
  249.       hor(i, j) = 0
  250.       ver(i, j) = 0
  251.       sleutels(i, j) = 0
  252.    NEXT j
  253.    NEXT i
  254. RETURN
  255. '--------------------------------------------------------------------------
  256. LijstDol:
  257.    REM ----------- Maken en lezen lijst .DO? files ------------
  258.    ON ERROR GOTO LeesFout
  259.    BestandsNaam$ = "DOL.DIR"
  260.    SHELL "dir *.do? > dol.dir"
  261.    OPEN "i", #2, "dol.dir"
  262.    FOR i = 1 TO 350
  263.       IF EOF(2) THEN GOTO EindeLijstDo
  264.       INPUT #2, regel$
  265.       LENGTE = INSTR(1, regel$, " ")
  266.       IF MID$(regel$, 10, 3) = "DO1" THEN
  267.          IF (AantDolen1 < 100) THEN
  268.             AantDolen1 = AantDolen1 + 1
  269.             Dolen1$(AantDolen1) = LEFT$(regel$, LENGTE - 1)
  270.          END IF
  271.       END IF
  272.       IF MID$(regel$, 10, 3) = "DO2" THEN
  273.          IF (AantDolen2 < 100) THEN
  274.             AantDolen2 = AantDolen2 + 1
  275.             Dolen2$(AantDolen2) = LEFT$(regel$, LENGTE - 1)
  276.          END IF
  277.       END IF
  278.       IF MID$(regel$, 10, 3) = "DO3" THEN
  279.          IF (AantDolen3 < 100) THEN
  280.             AantDolen3 = AantDolen3 + 1
  281.             Dolen3$(AantDolen3) = LEFT$(regel$, LENGTE - 1)
  282.          END IF
  283.       END IF
  284.    NEXT i
  285. EindeLijstDo:
  286.    CLOSE #2
  287.    ON ERROR GOTO 0
  288. RETURN
  289. '--------------------------------------------------------------------------
  290. Links:
  291.    IF ver(LoperX, LoperY) = 1 THEN
  292.       LINE (LoperX * LengteX + 170, LoperY * LengteY + 13)-STEP(0, LengteY - 2), 0
  293.       ver(LoperX, LoperY) = 0
  294.    ELSE
  295.       LINE (LoperX * LengteX + 170, LoperY * LengteY + 13)-STEP(0, LengteY - 2)
  296.       ver(LoperX, LoperY) = 1
  297.    END IF
  298. RETURN
  299. '--------------------------------------------------------------------------
  300. NieuwDol:
  301.    INPUT "Welke naam (max 8 posities)"; DoolNaam$
  302.    IF (LEN(DoolNaam$) > 8) OR (LEN(DoolNaam$) < 1) THEN
  303.       SOUND 400, 1
  304.       GOTO NieuwDol
  305.    END IF
  306.    DoolNaam$ = UCASE$(DoolNaam$)
  307.    FOR i = 1 TO aandolen
  308.       IF (dolen$ = DoolNaam$) THEN
  309.          PRINT "Naam bestaat al"
  310.          GOTO NieuwDol
  311.       END IF
  312.    NEXT i
  313.    GOSUB LegeTabellen
  314.    BeginX = 0
  315.    BeginY = 0
  316.    EindeX = aantvakjes - 1
  317.    EindeY = aantvakjes - 1
  318. RETURN
  319. '--------------------------------------------------------------------------
  320. Onder:
  321.    IF hor(LoperX, LoperY + 1) = 1 THEN
  322.       LINE (LoperX * LengteX + 171, (LoperY + 1) * LengteY + 12)-STEP(LengteX - 2, 0), 0
  323.       hor(LoperX, LoperY + 1) = 0
  324.    ELSE
  325.       LINE (LoperX * LengteX + 171, (LoperY + 1) * LengteY + 12)-STEP(LengteX - 2, 0)
  326.       hor(LoperX, LoperY + 1) = 1
  327.   END IF
  328. RETURN
  329. '--------------------------------------------------------------------------
  330. PijltjesToetsen:
  331.    REM ---------- Testen of verplaatsing in gewenste richting is toegestaan ----
  332.    IF woord$ = omhoog$ THEN
  333.       loperynieuw = LoperY - 1
  334.       loperxnieuw = LoperX
  335.    END IF
  336.    IF woord$ = omlaag$ THEN
  337.       loperynieuw = LoperY + 1
  338.       loperxnieuw = LoperX
  339.    END IF
  340.    IF woord$ = Rechts$ THEN
  341.       loperxnieuw = LoperX + 1
  342.       loperynieuw = LoperY
  343.    END IF
  344.    IF woord$ = Links$ THEN
  345.       loperxnieuw = LoperX - 1
  346.       loperynieuw = LoperY
  347.    END IF
  348.    IF loperxnieuw < 0 OR loperxnieuw > aantvakjes - 1 THEN GOTO verplaatserror
  349.    IF loperynieuw < 0 OR loperynieuw > aantvakjes - 1 THEN GOTO verplaatserror
  350.    REM -------- Haal loper weg op oude plaats ---------- 
  351.    PUT (LoperX * LengteX + 171, LoperY * LengteY + 13), Loper 'Zet loper op oude plaats
  352.    REM -------- Zet loper op nieuwe plaats -------
  353.    LoperX = loperxnieuw
  354.    LoperY = loperynieuw
  355.    PUT (LoperX * LengteX + 171, LoperY * LengteY + 13), Loper 'Zet loper op nieuwe plaats
  356.    GOTO eindepijltjes
  357. verplaatserror:
  358.    BEEP
  359. eindepijltjes:
  360. RETURN
  361. '--------------------------------------------------------------------------
  362. Rechts:
  363.    IF ver(LoperX + 1, LoperY) = 1 THEN
  364.       LINE ((LoperX + 1) * LengteX + 170, LoperY * LengteY + 13)-STEP(0, LengteY - 2), 0
  365.       ver(LoperX + 1, LoperY) = 0
  366.    ELSE
  367.       LINE ((LoperX + 1) * LengteX + 170, LoperY * LengteY + 13)-STEP(0, LengteY - 2)
  368.       ver(LoperX + 1, LoperY) = 1
  369.    END IF
  370. RETURN
  371. '--------------------------------------------------------------------------
  372. Scherm:
  373.    REM ------- Scherm opbouwen ------------------------------
  374.    EindeSpel = 0
  375.    SCREEN , , 1   'werk op andere scherm
  376.    IF SpelNivo = 1 THEN
  377.       PSET (6, 7)
  378.       DRAW "d3 r1 u2 r4 d1 r1 d1 r1 u1 r1 u3 l1 u1 l1 d1 l1 d1 l4"
  379.       LINE (102, 102)-(119, 114), , BF
  380.       CIRCLE (210, 208), 7
  381.       PAINT (210, 208), 15, 15
  382.       LengteX = 21
  383.       LengteY = 16
  384.    END IF
  385.    IF SpelNivo = 2 THEN
  386.       PSET (4, 5)
  387.       DRAW "d3 r1 u2 r4 d1 r1 d1 r1 u1 r1 u3 l1 u1 l1 d1 l1 d1 l4"
  388.       LINE (102, 102)-(114, 110), , BF
  389.       CIRCLE (208, 206), 5
  390.       PAINT (208, 206), 15, 15
  391.       LengteX = 16
  392.       LengteY = 12
  393.    END IF
  394.    IF SpelNivo = 3 THEN
  395.       PSET (2, 4)
  396.       DRAW "d3 r1 u2 r4 d1 r1 d1 r1 u1 r1 u3 l1 u1 l1 d1 l1 d1 l4"
  397.       LINE (102, 102)-(110, 107), , BF
  398.       CIRCLE (206, 204), 3
  399.       PAINT (206, 204), 15, 15
  400.       LengteX = 12
  401.       LengteY = 9
  402.    END IF
  403.    GET (1, 1)-(20, 15), Sleutel
  404.    GET (101, 101)-(120, 115), Loper
  405.    GET (201, 201)-(220, 215), Rondje
  406.    CLS
  407.    SCREEN , , 0
  408.    CLS
  409.    FOR i = 0 TO aantvakjes
  410.    FOR j = 0 TO aantvakjes
  411.       x = 170 + i * LengteX
  412.       y = 12 + j * LengteY
  413.       PSET (x, y)
  414.       IF hor(i, j) = 1 THEN LINE (x, y)-(x + LengteX, y)
  415.       IF ver(i, j) = 1 THEN LINE (x, y)-(x, y + LengteY)
  416.       IF sleutels(i, j) = 1 THEN PUT (x + 1, y + 1), Sleutel
  417.    NEXT j
  418.    NEXT i
  419.    LoperX = BeginX
  420.    LoperY = BeginY
  421.    IF SpelNivo = 1 THEN
  422.       LINE (BeginX * LengteX + 172, BeginY * LengteY + 14)-STEP(17, 12), , B
  423.    END IF
  424.    IF SpelNivo = 2 THEN
  425.       LINE (BeginX * LengteX + 172, BeginY * LengteY + 14)-STEP(12, 8), , B
  426.    END IF
  427.    IF SpelNivo = 3 THEN
  428.       LINE (BeginX * LengteX + 172, BeginY * LengteY + 14)-STEP(8, 5), , B
  429.    END IF
  430.    PUT (BeginX * LengteX + 171, BeginY * LengteY + 13), Loper
  431.    PUT (EindeX * LengteX + 171, EindeY * LengteY + 13), Rondje
  432.    LOCATE 3, 1
  433.    PRINT " ESC = Stoppen";
  434.    LOCATE 5, 1
  435.    PRINT " Pijltjes Toetsen"
  436.    LOCATE 6, 1
  437.    PRINT "   = Verschuiven"
  438.    LOCATE 8, 1
  439.    PRINT " b  = lijntje boven"
  440.    PRINT " o  = lijntje onder"
  441.    PRINT " l  = lijntje links"
  442.    PRINT " r  = lijntje rechts"
  443.    PRINT
  444.    PRINT " F1 = sleutel"
  445.    PRINT " F2 = beginpunt"
  446.    PRINT " F3 = eindpunt"
  447.    LOCATE 18, 1
  448.    PRINT "Doolhof: "; DoolNaam$
  449. RETURN
  450. '--------------------------------------------------------------------------
  451. SchrijfFout:
  452.    PRINT "Fout bij schrijven "; BestandsNaam$
  453.    PRINT "Druk op een knop voor programma einde"
  454.    WHILE INKEY$ = ""
  455.    WEND
  456.    END
  457. '--------------------------------------------------------------------------
  458. TonenLijst:
  459.    REM ----------- Tonen lijsten, vragen om keuze --------------
  460. TekleinOfTegroot:
  461.    PRINT : PRINT "Kies een doolhof:": PRINT
  462.    TEL = 0
  463.    FOR i = 1 TO AantDolen
  464.       TEL = TEL + 1
  465.       PRINT TAB((TEL - 1) * 15); i; dolen$(i);
  466.       IF TEL = 5 THEN TEL = 0
  467.    NEXT i
  468.    PRINT : PRINT
  469.    INPUT "Welk doolhof ....."; DOOLKEUZE
  470.    IF DOOLKEUZE > AantDolen THEN PRINT "Te groot": GOTO TekleinOfTegroot
  471.    IF DOOLKEUZE < 1 THEN PRINT "Te klein": GOTO TekleinOfTegroot
  472.    DoolNaam$ = dolen$(DOOLKEUZE)
  473. tonenlijsteinde:
  474. RETURN
  475.  
  476.