SCREEN 13

CONST CNT = 3

' Stack for current situation
DIM SHARED W(0 TO 15, 0 TO 2) AS INTEGER

' Draw plates & column
FOR i = 0 TO 2: LINE (50 + i * 100 - 1, 25)-(50 + i * 100 + 1, 184), 6, BF: NEXT
FOR i = 0 TO 15: W(i, 0) = -1: W(i, 1) = -1: W(i, 2) = -1: NEXT
FOR i = 0 TO CNT - 1: DrawPlate 0, i, i: W(i, 0) = i: NEXT

' Solve task
Hanoi 0, 1, 2, CNT

SLEEP 0

SUB Delay (N)
  FOR i = 0 TO N * 100: NEXT
  N = N * .99
END SUB

SUB DrawPlate (col, row, isize)

  x = 50 + 100 * col
  y = 170 - row * 11
  cl = 1 + isize
  size = 45 - isize * 5

  LINE (x - size, y)-(x + size, y + 10), cl, BF
  LINE (x - size, y)-(x + size, y + 10), 15, B
  LINE (x - size, y + 10)-(x + size, y + 10), 8
  LINE (x + size, y + 10)-(x + size, y), 8

END SUB

SUB Hanoi (A, B, C, N)

  ' Front
  IF N > 1 THEN Hanoi A, C, B, N - 1

  ' Get from A and place to B
  FOR i = 0 TO CNT
    IF W(i, A) = -1 THEN irow = i: cl = W(i - 1, A): EXIT FOR
  NEXT

  FOR i = 0 TO CNT
    IF W(i, B) = -1 THEN orow = i: EXIT FOR
  NEXT

  ' Move plate
  W(orow, B) = W(irow - 1, A)
  W(irow - 1, A) = -1

  ' Animate
  Move A, irow - 1, cl, B, orow

  ' Back
  IF N > 1 THEN Hanoi C, B, A, N - 1

END SUB

' From column, row, size (color) -> column, row
SUB Move (icol, irow, isize, ocol, orow)

  DL = 25
  HG = 170

  ' Direction for move
  IF icol < ocol THEN dir = 1 ELSE dir = -1

  x = 50 + 100 * icol
  y = HG - irow * 11
  cl = 1 + isize
  size = 45 - isize * 5

  ' Count increments
  icnt = y - 15
  ocnt = HG - orow * 11 - 15

  ' Incremental UP
  FOR i = 0 TO icnt

    ' Clear one line
    LINE (x - size, y + 10)-(x - 2, y + 10), 0, BF
    LINE (x - 1, y + 10)-(x + 1, y + 10), 6, BF
    LINE (x + 2, y + 10)-(x + size, y + 10), 0, BF

    ' Draw underline
    LINE (x - size, y + 9)-(x + size, y + 9), 8
    LINE (x - size + 1, y)-(x + size - 1, y), cl
    LINE (x - size, y - 1)-(x + size, y - 1), 15
    PSET (x + size, y), 8

    y = y - 1
    Delay DL

  NEXT

  ' Move right/left
  xl = x - size
  xr = x + size
  FOR i = 0 TO 100 * ABS(icol - ocol) - 1

    ' Move RIGHT
    IF dir > 0 THEN

      LINE (xl, y)-(xl, y + 10), 0
      LINE (xl + 1, y)-(xl + 1, y + 10), 15
      LINE (xr, y)-(xr, y + 10), cl
      PSET (xr, y), 15
      PSET (xr, y + 10), 8
      LINE (xr + 1, y)-(xr + 1, y + 10), 8
      xl = xl + 1
      xr = xr + 1
      Delay DL

    ELSE

      LINE (xr, y)-(xr, y + 10), 0
      LINE (xr - 1, y)-(xr - 1, y + 10), 15
      LINE (xl, y)-(xl, y + 10), cl
      PSET (xl, y), 15
      PSET (xl, y + 10), 8
      LINE (xl - 1, y)-(xl - 1, y + 10), 8
      xl = xl - 1
      xr = xr - 1
      Delay DL

    END IF

  NEXT

  ' Incremental DOWN
  FOR i = 0 TO ocnt

    LINE (xl, y)-(xr, y), 0
    LINE (xl + 1, y + 10)-(xr - 1, y + 10), cl
    LINE (xl, y + 1)-(xr, y + 1), 15
    PSET (xl, y + 10), 15
    LINE (xl, y + 11)-(xr, y + 11), 8

    ' Draw if real column
    IF i > 10 THEN LINE (xl + size - 1, y)-(xr - size + 1, y), 6

    y = y + 1
    Delay DL

  NEXT

END SUB
1 июн, 2020
© 2007-2022 Корень в том, что Малахов закусывает котом