Keskustelu: Koodit: QB: Kenttäeditori

DECLARE SUB Ohje ()
DECLARE SUB TallennaKentta ()
DECLARE SUB PiirraKentta ()
DECLARE SUB LataaKentta ()
DIM SHARED tiedosto$
DIM SHARED korkeus%
DIM SHARED leveys%
DIM SHARED kentta%(1 TO 40, 1 TO 24)
korkeus% = 24
leveys% = 40
alku:
COLOR 2                       'päävalikko
CLS
WIDTH 80, 25
LOCATE 4, 10: PRINT "____   Ü  Ü     Ü  Ü                                     ___"
LOCATE 5, 10: PRINT "³   ³   /\       /\  \      /  /\    ³    ³  ³  / ³  /  /   \"
LOCATE 6, 10: PRINT "³___/  /  \     /  \  \    /  /  \   ³    ³  ³/   ³/   ³     ³"
LOCATE 7, 10: PRINT "³     /ÄÄÄÄ\   /ÄÄÄÄ\  \  /  /ÄÄÄÄ\  ³    ³  ³\   ³\   ³     ³"
LOCATE 8, 10: PRINT "³    /      \ /      \  \/  /      \ ÀÄÄÄ ³  ³  \ ³  \  \___/"
COLOR 11
LOCATE 10, 12: PRINT "1. Uusi kenttä"
LOCATE 11, 12: PRINT "2. Avaa kenttä"
LOCATE 12, 12: PRINT "3. Ohje"
LOCATE 13, 12: PRINT "4. Lopeta"
DO
  nap$ = INKEY$
LOOP WHILE nap$ = ""
WIDTH 40, 25
SELECT CASE nap$
  CASE "1"
  CASE "2": LataaKentta
  CASE "3": Ohje: GOTO alku
  CASE "4": END
  CASE ELSE: GOTO alku
END SELECT
x = 12
y = 20
ux = x
uy = y
DO
  CLS
  COLOR 7
  PiirraKentta                'näytön piirto
  LOCATE 25, 1: COLOR 10: PRINT "F1 Ohje  F2 Tallenna  F3 Avaa";
  LOCATE x, y: PRINT "*";
  DO
  nap$ = INKEY$
  LOOP WHILE nap$ = ""
  SELECT CASE nap$                          'näppäimet
    CASE CHR$(0) + CHR$(59)
      Ohje
      SLEEP
    CASE CHR$(0) + CHR$(60): TallennaKentta
    CASE CHR$(0) + CHR$(61): LataaKentta
    CASE "4": uy = y - 1: ux = x      'kursorin liikutus
    CASE "6": uy = y + 1: ux = x
    CASE "8": ux = x - 1: uy = y
    CASE "2": ux = x + 1: uy = y
    CASE "1": ux = x + 1: uy = y - 1
    CASE "3": ux = x + 1: uy = y + 1
    CASE "7": ux = x - 1: uy = y - 1
    CASE "9": ux = x - 1: uy = y + 1
    CASE "5": kentta%(y, x) = 1
    CASE "0": kentta%(y, x) = 2
    CASE ",": kentta%(y, x) = 0
    CASE CHR$(27): LOCATE 25, 1: INPUT "haluatko varmasti lopettaa?[k,e]", a$
      IF a$ = "K" THEN GOTO loppu
      IF a$ = "k" THEN GOTO loppu
  END SELECT
  IF ux > 24 OR ux < 1 THEN       'reunatarkistus
  ELSE
    x = ux
  END IF
  IF uy > 40 OR uy < 1 THEN
  ELSE
    y = uy
  END IF
LOOP
loppu:

SUB LataaKentta
CLS : LOCATE 12, 1: COLOR 1
INPUT "Avattava kenttä>", tiedosto$
tiedosto$ = tiedosto$ + ".ken"
OPEN tiedosto$ FOR INPUT AS #1
INPUT #1, leveys%, korkeus%
FOR i = 1 TO korkeus%
 FOR j = 1 TO leveys%
  INPUT #1, kentta%(j, i)
 NEXT j
NEXT i
CLOSE #1
END SUB

SUB Ohje
CLS
WIDTH 40, 25
COLOR 5
PRINT "Muista pitää NumLock päällä"
PRINT "Näppäimet"
PRINT "1-4,6-9 liikuttaa"
PRINT "5 tekee #-merkin"
PRINT "0 tekee H-merkin"
PRINT "ja ,/del-näppäin tekee tyhjää"
SLEEP
END SUB

SUB PiirraKentta
FOR i = 1 TO korkeus%
 FOR j = 1 TO leveys%
  LOCATE i, j
  IF kentta%(j, i) = 0 THEN
   PRINT " ";
  ELSEIF kentta%(j, i) = 1 THEN
   PRINT "#";
  ELSEIF kentta%(j, i) = 2 THEN
   PRINT "H";
  ELSEIF kentta%(j, i) = 3 THEN
   PRINT " ";
  ELSE
   LOCATE 25, 4
   COLOR 4
   PRINT "Virhe";
   SLEEP
  END IF
 NEXT j
NEXT i
END SUB

SUB TallennaKentta
CLS
IF tiedosto$ = "" THEN
  LOCATE 12, 1
  INPUT "tiedostonimi>", tiedosto$
  tiedosto$ = tiedosto$ + ".ken"
END IF
OPEN tiedosto$ FOR OUTPUT AS #1
WRITE #1, leveys%, korkeus%
FOR i = 1 TO korkeus%
 FOR j = 1 TO leveys%
  WRITE #1, kentta%(j, i)
 NEXT j
NEXT i
CLOSE #1
END SUB