home *** CD-ROM | disk | FTP | other *** search
/ Global Amiga Experience / globalamigaexperience.iso / text_dtp / editor / turbotext / rexx / hanoi.ttx < prev    next >
Text File  |  1995-07-10  |  3KB  |  196 lines
  1.  
  2. /** $VER: Hanoi.ttx 2.0 (14.3.94)
  3.  **
  4.  ** Towers of Hanoi toy.
  5.  **
  6.  ** Written by Mikael Karlsson
  7.  ** Modified by Martin Taillefer
  8.  **/
  9.  
  10.  
  11. OPTIONS RESULTS
  12. PARSE ARG disks
  13.  
  14.  
  15.   ADDRESS TURBOTEXT
  16.  
  17.   OpenDoc
  18.   IF RC = 0 THEN DO
  19.     ADDRESS VALUE RESULT
  20.  
  21.     'SetStatusBar Towers of Hanoi'
  22.     SetCursor OFF
  23.     SetInputLock ON
  24.     SetDisplayLock ON
  25.  
  26.     IF disks = "" THEN disks = 4
  27.     IF disks < 1 THEN disks = 1
  28.     IF disks > 9 THEN disks = 9
  29.  
  30.     pegs.0 = "999"
  31.     pegs.1 = "999"
  32.     pegs.2 = "999"
  33.  
  34.     clockwise.0 = 1
  35.     clockwise.1 = 2
  36.     clockwise.2 = 0
  37.  
  38.     diskstr.1 = "         XXXX         "
  39.     diskstr.2 = "        XXXXXX        "
  40.     diskstr.3 = "       XXXXXXXX       "
  41.     diskstr.4 = "      XXXXXXXXXX      "
  42.     diskstr.5 = "     XXXXXXXXXXXX     "
  43.     diskstr.6 = "    XXXXXXXXXXXXXX    "
  44.     diskstr.7 = "   XXXXXXXXXXXXXXXX   "
  45.     diskstr.8 = "  XXXXXXXXXXXXXXXXXX  "
  46.     diskstr.9 = " XXXXXXXXXXXXXXXXXXXX "
  47.  
  48.     pegstr    = "          ||          "
  49.  
  50.     InsertLine
  51.     InsertLine
  52.  
  53.     'Text " 'copies(' ',72)'"'
  54.     InsertLine
  55.  
  56.     RecordMacro QUIET
  57.     'Text " 'pegstr'   'pegstr'   'pegstr'"'
  58.     InsertLine
  59.     EndMacro
  60.     PlayMacro 10
  61.  
  62.     'Text " 'copies('T',72)'"'
  63.     InsertLine
  64.  
  65.     UpdateView
  66.  
  67.     DO i = disks TO 1 BY -1
  68.       CALL OnPeg(0,i)
  69.       pegs.0 = i pegs.0
  70.     END
  71.  
  72.     pegwithsmallest = 0
  73.  
  74.     DO FOREVER
  75.       CALL DoMove(pegwithsmallest,clockwise.pegwithsmallest)
  76.       pegwithsmallest = clockwise.pegwithsmallest
  77.       pegafter = clockwise.pegwithsmallest
  78.       pegbefore = clockwise.pegafter
  79.  
  80.       IF pegs.pegbefore = "999" & pegs.pegafter = "999" THEN DO
  81.         LEAVE
  82.       END
  83.  
  84.       IF Word(pegs.pegbefore,1) < Word(pegs.pegafter,1) THEN DO
  85.         CALL DoMove(pegbefore,pegafter)
  86.  
  87.       END; ELSE DO
  88.         CALL DoMove(pegafter,pegbefore)
  89.  
  90.       END
  91.     END
  92.  
  93.     'SetStatusBar Temporary Done!'
  94.     MoveSOF
  95.     SetInputLock OFF
  96.     SetDisplayLock OFF
  97.     SetCursor ON
  98.   END
  99.   EXIT
  100.  
  101.  
  102. DoMove:
  103. ARG src,dest
  104.  
  105.    disk = Word(pegs.src,1)
  106.    CALL OffPeg(src,disk)
  107.    CALL MoveOver(src,dest)
  108.    CALL OnPeg(dest,disk)
  109.    PARSE VALUE pegs.src WITH disk pegs.src
  110.    pegs.dest = disk pegs.dest
  111.    RETURN
  112.  
  113.  
  114. MoveOver:
  115. ARG src,dest
  116.  
  117.    pos = src*25+2
  118.    destpos = dest*25+2
  119.    Move 3 1
  120.    IF pos < destpos THEN DO
  121.      RecordMacro QUIET
  122.      'Text " "'
  123.      UpdateView
  124.      EndMacro
  125.      PlayMacro destpos-pos
  126.    END; ELSE DO
  127.      RecordMacro QUIET
  128.      Delete
  129.      UpdateView
  130.      EndMacro
  131.      PlayMacro pos-destpos
  132.    END
  133.    RETURN
  134.  
  135.  
  136. OnPeg:
  137. ARG peg,disk
  138.  
  139.    Move 3 peg*25+2
  140.    Delete 22
  141.    'Text "'copies(' ',22)'"'
  142.    MoveLeft 22
  143.    UpdateView
  144.    MoveDown
  145.  
  146.    Delete 22
  147.    'Text "'diskstr.disk'"'
  148.    MoveLeft 22
  149.  
  150.    destpos = 10 - Words(pegs.peg)
  151.    IF destpos > 0 THEN DO
  152.      RecordMacro QUIET
  153.  
  154.      Delete 22
  155.      'Text "'pegstr'"'
  156.      MoveLeft 22
  157.      UpdateView
  158.      MoveDown
  159.  
  160.      Delete 22
  161.      'Text "'diskstr.disk'"'
  162.      MoveLeft 22
  163.  
  164.      UpdateView
  165.      EndMacro
  166.  
  167.      PlayMacro destpos
  168.    END
  169.    RETURN
  170.  
  171.  
  172. OffPeg:
  173. ARG peg,disk
  174.  
  175.    pos = 15 - Words(pegs.peg)
  176.    IF pos > 3 THEN DO
  177.      Move pos peg*25+2
  178.      RecordMacro QUIET
  179.  
  180.      Delete 22
  181.      'Text "'pegstr'"'
  182.      MoveLeft 22
  183.      UpdateView
  184.      MoveUp
  185.  
  186.      Delete 22
  187.      'Text "'diskstr.disk'"'
  188.      MoveLeft 22
  189.  
  190.      UpdateView
  191.      EndMacro
  192.  
  193.      PlayMacro pos-3
  194.    END
  195.    RETURN
  196.