Примеры программ на языке QBASIC

DECLARE SUB change (i1 AS INTEGER, j1 AS INTEGER)
DECLARE SUB printTAB (s AS STRING)
DECLARE SUB level ()
DECLARE SUB poisk ()
REM Дерево решений BASIC
DEFINT A-Z
DIM SHARED x0 AS INTEGER, y0 AS INTEGER, nmax AS INTEGER, k AS INTEGER
DIM SHARED from AS INTEGER
DIM SHARED tree(360) AS STRING * 6, ind(360) AS INTEGER, pos0 AS STRING * 6
nmax = 1: x0 = 1: y0 = 2
tree(0) = "BASIC*"
ind(0) = -1
CLS
INPUT "Введите строку с исходной позицией - ", pos0
FOR from = 0 TO nmax - 1: level: poisk: NEXT from
END

SUB change (i1 AS INTEGER, j1 AS INTEGER)
  DIM n AS INTEGER, k1 AS INTEGER, tmp AS STRING, str2 AS STRING
  IF (i1 < 0) OR (i1 > 1) OR (j1 < 0) OR (j1 > 2) THEN EXIT SUB
  k1 = i1 * 3 + j1 + 1
  str2 = tree(from)
  tmp = MID$(str2, k, 1)
  MID$(str2, k, 1) = MID$(str2, k1, 1)
  MID$(str2, k1, 1) = tmp
  FOR n = 0 TO nmax - 1
      IF str2 = tree(n) THEN EXIT SUB
  NEXT n
  ind(nmax) = from
  tree(nmax) = str2
  nmax = nmax + 1
END SUB

SUB level
  FOR k = 1 TO 6
    IF MID$(tree(from), k, 1) = "*" THEN EXIT FOR
  NEXT k
  i = (k - 1) \ 3  '  номер строки
  j = (k - 1) MOD 3'  номер столбца
  CALL change(i - 1, j)
  CALL change(i + 1, j)
  CALL change(i, j - 1)
  CALL change(i, j + 1)
END SUB

SUB poisk
  FOR q = 0 TO nmax - 1
    IF pos0 = tree(q) THEN GOTO m
  NEXT q
  PRINT "Эта позиция не сводится к требуемой"
  EXIT SUB
m:
  CALL printTAB(tree(q))
  q = ind(q)
  IF q >= 0 THEN GOTO m
END SUB

SUB printTAB (s AS STRING)
  LOCATE y0, x0:  PRINT "--T-T-¬"
  LOCATE y0 + 1, x0: PRINT "¦"; MID$(s, 1, 1);
                  PRINT "¦"; MID$(s, 2, 1);
                  PRINT "¦"; MID$(s, 3, 1); "¦"
  LOCATE y0 + 2, x0: PRINT "+-+-+-+"
  LOCATE y0 + 3, x0: PRINT "¦"; MID$(s, 4, 1);
                  PRINT "¦"; MID$(s, 5, 1);
                  PRINT "¦"; MID$(s, 6, 1); "¦"
  LOCATE y0 + 4, x0: PRINT "L-+-+--"
  x0 = x0 + 10
  IF x0 = 81 THEN y0 = y0 + 5: x0 = 1
END SUB