home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR9 / ROPE.ZIP / ROPE.ASC < prev    next >
Text File  |  1992-04-06  |  32KB  |  877 lines
  1. DECLARE SUB helparrow ()
  2. DECLARE SUB helphelp ()
  3. DECLARE SUB helpexit ()
  4. DECLARE SUB helpstep ()
  5. DECLARE SUB helpfile ()
  6. DECLARE SUB helpmusic ()
  7. DECLARE SUB helpcompute ()
  8. DECLARE SUB helpredraw ()
  9. DECLARE SUB helpconn ()
  10. DECLARE SUB helpand ()
  11. DECLARE SUB helpvalue ()
  12. DECLARE SUB helpnull ()
  13. DECLARE SUB helpinvert ()
  14. DECLARE SUB helpor ()
  15. DECLARE SUB displaybox (i%, j%, idbox%, idvalue%)
  16. DECLARE SUB helpmsg ()
  17. DECLARE SUB music (i%)
  18. DECLARE SUB drawonec (i%, j%, icolor%)
  19. DECLARE SUB wsum (i%, isum%)
  20. DEFINT I-N
  21. DIM ibox(-1 TO 8, -1 TO 8), ivalue(7, 7), iconn(7, 7)
  22. COMMON SHARED ibox(), ivalue(), iconn()
  23. DECLARE SUB compute (i%, j%)
  24. DECLARE SUB drawbox (i%, j%, icolor%)
  25. DECLARE SUB drawconn (i%, j%, icolor%)
  26. ON ERROR GOTO redraw
  27. CALL helpmsg
  28. redraw:
  29. CLS
  30. FOR i = 0 TO 7
  31.         FOR j = 0 TO 7
  32.                 CALL drawbox(i, j, 1)
  33.                 CALL drawconn(i, j, 1)
  34.                 NEXT j
  35.         NEXT i
  36.  
  37. i = 0
  38. j = 0
  39. i1 = 0
  40. j1 = 0
  41. makecell:
  42.         CALL drawbox(i, j, 1)
  43.         CALL drawconn(i, j, 1)
  44.         CALL drawbox(i1, j1, 2)
  45.         CALL drawconn(i1, j1, 2)
  46.         i = i1
  47.         j = j1
  48.         DO
  49.                 A$ = INKEY$
  50.         LOOP WHILE A$ = ""
  51.         A% = ASC(RIGHT$(A$, 1))
  52.         SELECT CASE A%
  53.         CASE 75
  54.                 i1 = i - 1
  55.                 IF i1 < 0 THEN i1 = 7
  56.         CASE 77
  57.                 i1 = i + 1
  58.                 IF i1 > 7 THEN i1 = 0
  59.         CASE 72
  60.                 IF LEN(A$) < 2 THEN
  61.                         CALL helpmsg
  62.                         GOTO redraw
  63.                 ELSE
  64.                         j1 = j - 1
  65.                         IF j1 < 0 THEN j1 = 7
  66.                 END IF
  67.         CASE 80
  68.                 j1 = j + 1
  69.                 IF j1 > 7 THEN j1 = 0
  70.         CASE 104
  71.                 CALL helpmsg
  72.                 GOTO redraw
  73.         CASE 65, 97
  74.                 ibox(i, j) = 8
  75.                 ivalue(i, j) = 0
  76.         CASE 79, 111
  77.                 ibox(i, j) = 4
  78.                 ivalue(i, j) = 0
  79.         CASE 73, 105
  80.                 ibox(i, j) = 2
  81.                 ivalue(i, j) = 0
  82.         CASE 78, 110
  83.                 ibox(i, j) = 0
  84.                 ivalue(i, j) = 0
  85.         CASE 48 TO 51
  86.                 ivalue(i, j) = A% - 48
  87.                 IF ibox(i, j) < 4 AND ivalue(i, j) > 1 THEN ivalue(i, j) = 1
  88.         CASE 85, 117
  89.                 IF iconn(i, j) = -1 THEN iconn(i, j) = 0 ELSE iconn(i, j) = -1
  90.         CASE 68, 100
  91.                 IF iconn(i, j) = 1 THEN iconn(i, j) = 0 ELSE iconn(i, j) = 1
  92.         CASE 82, 114
  93.                 GOTO redraw
  94.         CASE 67, 99
  95.                 DO
  96.                         CALL drawbox(i, j, 2)
  97.                         CALL compute(i, j)
  98.                         CALL drawbox(i, j, 1)
  99.                         j = j + 1
  100.                         IF j > 7 THEN
  101.                                 CALL wsum(i, isum)
  102.                                 LOCATE 1, 5 * i + 1
  103.                                 PRINT USING " ### "; isum;
  104.                                 j = 0
  105.                                 i = i + 1
  106.                                 IF i > 7 THEN i = 0
  107.                         END IF
  108.                 LOOP WHILE INKEY$ = ""
  109.                 GOTO redraw
  110.         CASE 77, 109
  111.                 DO
  112.                         CALL drawbox(i, j, 2)
  113.                         CALL compute(i, j)
  114.                         CALL drawbox(i, j, 1)
  115.                         j = j + 1
  116.                         IF j > 7 THEN
  117.                                 CALL music(i)
  118.                                 j = 0
  119.                                 i = i + 1
  120.                                 IF i > 7 THEN i = 0
  121.                         END IF
  122.                 LOOP WHILE INKEY$ = ""
  123.                 GOTO redraw
  124.         CASE 83, 115
  125.                 CALL compute(i, j)
  126.         CASE 70, 102
  127.                 SCREEN 0
  128.                 WIDTH 80
  129.                 CLS
  130.                 FILES "*.rop"
  131.                 INPUT "File name to save program"; filenam$
  132.                 IF INSTR(filenam$, ".") = 0 THEN filenam$ = filenam$ + ".rop"
  133.                 CLS
  134.                 OPEN filenam$ FOR OUTPUT AS #1
  135.                 FOR ind% = 0 TO 7
  136.                         FOR jnd% = 0 TO 7
  137.                                 WRITE #1, ibox(ind%, jnd%), ivalue(ind%, jnd%), iconn(ind%, jnd%)
  138.                                 NEXT jnd%
  139.                         NEXT ind%
  140.                 CLOSE #1
  141.                 SCREEN 1
  142.                 GOTO redraw
  143.         CASE 76, 108
  144.                 SCREEN 0
  145.                 WIDTH 80
  146.                 CLS
  147.                 FILES "*.rop"
  148.                 INPUT "File name to load program"; filenam$
  149.                 IF INSTR(filenam$, ".") = 0 THEN filenam$ = filenam$ + ".rop"
  150.                 OPEN filenam$ FOR INPUT AS #1
  151.                 FOR ind% = 0 TO 7
  152.                         FOR jnd% = 0 TO 7
  153.                                 INPUT #1, ibox(ind%, jnd%), ivalue(ind%, jnd%), iconn(ind%, jnd%)
  154.                                 NEXT jnd%
  155.                         NEXT ind%
  156.                 CLOSE #1
  157.                 SCREEN 1
  158.                 GOTO redraw
  159.         CASE 69, 101
  160.                 SYSTEM
  161.         CASE ELSE
  162.                 BEEP
  163.         END SELECT
  164.         GOTO makecell
  165.  
  166. nofile:
  167.         PRINT filenam$ + " not found."
  168.         INPUT "Input new filename"; filenam$
  169.         IF INSTR(filenam$, ".") = 0 THEN filenam$ = filenam$ + ".rop"
  170.         RESUME
  171.  
  172.  
  173. SUB compute (i, j)
  174.  
  175.         li = i - 1
  176.         IF li < 0 THEN li = 7
  177.         lj = j - 1
  178.         IF lj < 0 THEN lj = 7
  179.         nj = j + 1
  180.         IF nj > 7 THEN nj = 0
  181.         SELECT CASE (ibox(li, lj) + ivalue(li, lj))
  182.                 CASE 1, 2, 5, 6, 7, 11
  183.                         l% = 1
  184.                 CASE 0, 3, 4, 8, 9, 10
  185.                         l% = 0
  186.                 END SELECT
  187.         SELECT CASE (ibox(li, j) + ivalue(li, j))
  188.                 CASE 1, 2, 5, 6, 7, 11
  189.                         sj% = 1
  190.                 CASE 0, 3, 4, 8, 9, 10
  191.                         sj% = 0
  192.                 END SELECT
  193.         SELECT CASE (ibox(li, nj) + ivalue(li, nj))
  194.                 CASE 1, 2, 5, 6, 7, 11
  195.                         n% = 1
  196.                 CASE 0, 3, 4, 8, 9, 10
  197.                         n% = 0
  198.                 END SELECT
  199.         IF ibox(i, j) < 4 THEN
  200.                 IF iconn(i, j) = -1 THEN
  201.                         ivalue(i, j) = l%
  202.                         ELSEIF iconn(i, j) = 0 THEN
  203.                                 ivalue(i, j) = sj%
  204.                         ELSE
  205.                                 ivalue(i, j) = n%
  206.                                 END IF
  207.                 ELSE
  208.                         IF iconn(i, j) = -1 THEN
  209.                                 ivalue(i, j) = sj% + 2 * n%
  210.                                 ELSEIF iconn(i, j) = 0 THEN
  211.                                         ivalue(i, j) = l% + 2 * n%
  212.                                 ELSE
  213.                                         ivalue(i, j) = l% + 2 * sj%
  214.                                         END IF
  215.                         END IF
  216. END SUB
  217.  
  218. SUB displaybox (i, j, idbox, idvalue)
  219. isbox = ibox(i, j)
  220. isvalue = ivalue(i, j)
  221. ibox(i, j) = idbox
  222. ivalue(i, j) = idvalue
  223. CALL drawbox(i, j, 1)
  224. ibox(i, j) = isbox
  225. ivalue(i, j) = isvalue
  226. END SUB
  227.  
  228. SUB drawbox (i, j, icolor)
  229.  
  230. iboxtype = ibox(i, j) + ivalue(i, j)
  231. iul = 40 * i + 10
  232. ilr = 25 * j + 2
  233. LINE (iul - 5, ilr)-(iul + 25, ilr + 20), 0, BF
  234. SELECT CASE iboxtype
  235.         CASE 0
  236.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  237.                 LINE (iul, ilr + 8)-(iul, ilr + 12), 0
  238.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  239.                 LINE (iul - 5, ilr + 10)-(iul + 25, ilr + 10), icolor
  240.                 LINE (iul - 5, ilr + 8)-(iul - 3, ilr + 12), icolor, BF
  241.                 LINE (iul + 21, ilr + 8)-(iul + 23, ilr + 12), icolor, BF
  242.         CASE 1
  243.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  244.                 LINE (iul, ilr + 8)-(iul, ilr + 12), 0
  245.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  246.                 LINE (iul - 5, ilr + 10)-(iul + 25, ilr + 10), icolor
  247.                 LINE (iul - 3, ilr + 8)-(iul - 1, ilr + 12), icolor, BF
  248.                 LINE (iul + 23, ilr + 8)-(iul + 25, ilr + 12), icolor, BF
  249.         CASE 2
  250.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  251.                 LINE (iul, ilr + 8)-(iul, ilr + 12), 0
  252.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  253.                 LINE (iul - 5, ilr + 10)-(iul + 5, ilr + 10), icolor
  254.                 LINE (iul + 15, ilr + 10)-(iul + 25, ilr + 10), icolor
  255.                 LINE (iul + 5, ilr + 10)-(iul + 10, ilr + 8), icolor
  256.                 LINE (iul + 10, ilr + 8)-(iul + 15, ilr + 10), icolor
  257.                 LINE (iul + 8, ilr)-(iul + 12, ilr + 3), icolor
  258.                 LINE (iul + 12, ilr + 3)-(iul + 8, ilr + 6), icolor
  259.                 LINE (iul + 8, ilr + 6)-(iul + 10, ilr + 8), icolor
  260.                 LINE (iul - 5, ilr + 8)-(iul - 3, ilr + 12), icolor, BF
  261.                 LINE (iul + 23, ilr + 8)-(iul + 25, ilr + 12), icolor, BF
  262.         CASE 3
  263.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  264.                 LINE (iul, ilr + 8)-(iul, ilr + 12), 0
  265.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  266.                 LINE (iul - 5, ilr + 10)-(iul + 5, ilr + 10), icolor
  267.                 LINE (iul + 15, ilr + 10)-(iul + 25, ilr + 10), icolor
  268.                 LINE (iul + 5, ilr + 10)-(iul + 10, ilr + 5), icolor
  269.                 LINE (iul + 10, ilr + 5)-(iul + 15, ilr + 10), icolor
  270.                 LINE (iul + 8, ilr)-(iul + 12, ilr + 2), icolor
  271.                 LINE (iul + 12, ilr + 2)-(iul + 8, ilr + 4), icolor
  272.                 LINE (iul + 8, ilr + 4)-(iul + 10, ilr + 5), icolor
  273.                 LINE (iul - 3, ilr + 8)-(iul - 1, ilr + 12), icolor, BF
  274.                 LINE (iul + 21, ilr + 8)-(iul + 23, ilr + 12), icolor, BF
  275.         CASE 4
  276.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  277.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  278.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  279.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  280.                 LINE (iul - 5, ilr + 5)-(iul + 5, ilr + 5), icolor
  281.                 LINE (iul + 5, ilr + 5)-(iul + 5, ilr + 7), icolor
  282.                 LINE (iul + 5, ilr + 7)-(iul + 18, ilr + 10), icolor
  283.                 LINE (iul - 5, ilr + 15)-(iul + 5, ilr + 15), icolor
  284.                 LINE (iul + 5, ilr + 15)-(iul + 5, ilr + 13), icolor
  285.                 LINE (iul + 5, ilr + 13)-(iul + 18, ilr + 10), icolor
  286.                 LINE (iul + 18, ilr + 10)-(iul + 25, ilr + 10), icolor
  287.                 LINE (iul - 5, ilr + 3)-(iul - 3, ilr + 7), icolor, BF
  288.                 LINE (iul - 5, ilr + 13)-(iul - 3, ilr + 17), icolor, BF
  289.                 LINE (iul + 21, ilr + 8)-(iul + 23, ilr + 12), icolor, BF
  290.         CASE 5
  291.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  292.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  293.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  294.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  295.                 LINE (iul - 5, ilr + 5)-(iul + 10, ilr + 5), icolor
  296.                 LINE (iul + 10, ilr + 5)-(iul + 18, ilr + 10), icolor
  297.                 LINE (iul - 5, ilr + 15)-(iul + 5, ilr + 15), icolor
  298.                 LINE (iul + 5, ilr + 15)-(iul + 5, ilr + 13), icolor
  299.                 LINE (iul + 5, ilr + 13)-(iul + 18, ilr + 10), icolor
  300.                 LINE (iul + 18, ilr + 10)-(iul + 25, ilr + 10), icolor
  301.                 LINE (iul - 3, ilr + 3)-(iul - 1, ilr + 7), icolor, BF
  302.                 LINE (iul - 5, ilr + 13)-(iul - 3, ilr + 17), icolor, BF
  303.                 LINE (iul + 23, ilr + 8)-(iul + 25, ilr + 12), icolor, BF
  304.         CASE 6
  305.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  306.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  307.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  308.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  309.                 LINE (iul - 5, ilr + 5)-(iul + 5, ilr + 5), icolor
  310.                 LINE (iul + 5, ilr + 5)-(iul + 5, ilr + 7), icolor
  311.                 LINE (iul + 5, ilr + 7)-(iul + 18, ilr + 10), icolor
  312.                 LINE (iul - 5, ilr + 15)-(iul + 10, ilr + 15), icolor
  313.                 LINE (iul + 10, ilr + 15)-(iul + 18, ilr + 10), icolor
  314.                 LINE (iul + 18, ilr + 10)-(iul + 25, ilr + 10), icolor
  315.                 LINE (iul - 5, ilr + 3)-(iul - 3, ilr + 7), icolor, BF
  316.                 LINE (iul - 3, ilr + 13)-(iul - 1, ilr + 17), icolor, BF
  317.                 LINE (iul + 23, ilr + 8)-(iul + 25, ilr + 12), icolor, BF
  318.         CASE 7
  319.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  320.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  321.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  322.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  323.                 LINE (iul - 5, ilr + 5)-(iul + 10, ilr + 5), icolor
  324.                 LINE (iul + 10, ilr + 5)-(iul + 18, ilr + 10), icolor
  325.                 LINE (iul - 5, ilr + 15)-(iul + 10, ilr + 15), icolor
  326.                 LINE (iul + 10, ilr + 15)-(iul + 18, ilr + 10), icolor
  327.                 LINE (iul + 18, ilr + 10)-(iul + 25, ilr + 10), icolor
  328.                 LINE (iul - 3, ilr + 3)-(iul - 1, ilr + 7), icolor, BF
  329.                 LINE (iul - 3, ilr + 13)-(iul - 1, ilr + 17), icolor, BF
  330.                 LINE (iul + 23, ilr + 8)-(iul + 25, ilr + 12), icolor, BF
  331.         CASE 8
  332.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  333.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  334.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  335.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  336.                 LINE (iul - 5, ilr + 5)-(iul + 5, ilr + 5), icolor
  337.                 LINE (iul - 5, ilr + 15)-(iul + 5, ilr + 15), icolor
  338.                 LINE (iul + 5, ilr + 5)-(iul + 5, ilr + 15), icolor
  339.                 LINE (iul + 5, ilr + 10)-(iul + 25, ilr + 10), icolor
  340.                 LINE (iul - 5, ilr + 3)-(iul - 3, ilr + 7), icolor, BF
  341.                 LINE (iul - 5, ilr + 13)-(iul - 3, ilr + 17), icolor, BF
  342.                 LINE (iul + 21, ilr + 8)-(iul + 23, ilr + 12), icolor, BF
  343.         CASE 9
  344.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  345.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  346.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  347.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  348.                 LINE (iul - 5, ilr + 5)-(iul + 10, ilr + 5), icolor
  349.                 LINE (iul - 5, ilr + 15)-(iul + 5, ilr + 15), icolor
  350.                 LINE (iul + 10, ilr + 5)-(iul + 5, ilr + 15), icolor
  351.                 LINE (iul + 10, ilr + 5)-(iul + 25, ilr + 10), icolor
  352.                 LINE (iul - 3, ilr + 3)-(iul - 1, ilr + 7), icolor, BF
  353.                 LINE (iul - 5, ilr + 13)-(iul - 3, ilr + 17), icolor, BF
  354.                 LINE (iul + 21, ilr + 8)-(iul + 23, ilr + 12), icolor, BF
  355.         CASE 10
  356.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  357.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  358.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  359.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  360.                 LINE (iul - 5, ilr + 5)-(iul + 5, ilr + 5), icolor
  361.                 LINE (iul - 5, ilr + 15)-(iul + 10, ilr + 15), icolor
  362.                 LINE (iul + 5, ilr + 5)-(iul + 10, ilr + 15), icolor
  363.                 LINE (iul + 10, ilr + 15)-(iul + 25, ilr + 10), icolor
  364.                 LINE (iul - 5, ilr + 3)-(iul - 3, ilr + 7), icolor, BF
  365.                 LINE (iul - 3, ilr + 13)-(iul - 1, ilr + 17), icolor, BF
  366.                 LINE (iul + 21, ilr + 8)-(iul + 23, ilr + 12), icolor, BF
  367.         CASE 11
  368.                 LINE (iul, ilr)-(iul + 20, ilr + 20), icolor, B
  369.                 LINE (iul, ilr + 3)-(iul, ilr + 7), 0
  370.                 LINE (iul, ilr + 13)-(iul, ilr + 17), 0
  371.                 LINE (iul + 20, ilr + 8)-(iul + 20, ilr + 12), 0
  372.                 LINE (iul - 5, ilr + 5)-(iul + 10, ilr + 5), icolor
  373.                 LINE (iul - 5, ilr + 15)-(iul + 10, ilr + 15), icolor
  374.                 LINE (iul + 10, ilr + 5)-(iul + 10, ilr + 15), icolor
  375.                 LINE (iul + 10, ilr + 10)-(iul + 25, ilr + 10), icolor
  376.                 LINE (iul - 3, ilr + 3)-(iul - 1, ilr + 7), icolor, BF
  377.                 LINE (iul - 3, ilr + 13)-(iul - 1, ilr + 17), icolor, BF
  378.                 LINE (iul + 23, ilr + 8)-(iul + 25, ilr + 12), icolor, BF
  379.         END SELECT
  380.  
  381. END SUB
  382.  
  383. SUB drawconn (i, j, icolor)
  384. m0 = 40 * i - 4
  385. m1 = m0 + 8
  386. n0 = 25 * j - 13
  387. n1 = n0 + 20
  388. n2 = n0 + 25
  389. n3 = n0 + 30
  390. n4 = n0 + 50
  391. LINE (m0, n0)-(m1, n1), 0
  392. LINE (m0, n0)-(m1, n2), 0
  393. LINE (m0, n2)-(m1, n1), 0
  394. LINE (m0, n2)-(m1, n2), 0
  395. LINE (m0, n2)-(m1, n3), 0
  396. LINE (m0, n4)-(m1, n2), 0
  397. LINE (m0, n4)-(m1, n3), 0
  398. CALL drawonec(i, j, icolor)
  399. IF j > 0 THEN CALL drawonec(i, j - 1, 1)
  400. IF j < 7 THEN CALL drawonec(i, j + 1, 1)
  401. END SUB
  402.  
  403. SUB drawonec (i, j, icolor)
  404. k = iconn(i, j)
  405. l = ibox(i, j)
  406. m0 = 40 * i - 4
  407. m1 = m0 + 8
  408. n0 = 25 * j - 13
  409. n1 = n0 + 20
  410. n2 = n0 + 25
  411. n3 = n0 + 30
  412. n4 = n0 + 50
  413. IF l < 4 THEN
  414.         SELECT CASE k
  415.                 CASE -1
  416.                         LINE (m0, n0)-(m1, n2), icolor
  417.                 CASE 0
  418.                         LINE (m0, n2)-(m1, n2), icolor
  419.                 CASE 1
  420.                         LINE (m0, n4)-(m1, n2), icolor
  421.                 END SELECT
  422.         ELSE
  423.                 SELECT CASE k
  424.                         CASE -1
  425.                                 LINE (m0, n2)-(m1, n1), icolor
  426.                                 LINE (m0, n4)-(m1, n3), icolor
  427.                         CASE 0
  428.                                 LINE (m0, n0)-(m1, n1), icolor
  429.                                 LINE (m0, n4)-(m1, n3), icolor
  430.                         CASE 1
  431.                                 LINE (m0, n0)-(m1, n1), icolor
  432.                                 LINE (m0, n2)-(m1, n3), icolor
  433.                         END SELECT
  434.                 END IF
  435. END SUB
  436.  
  437. SUB helpand
  438. SCREEN 1
  439. CLS
  440. PRINT "   HELP MESSAGE SCREEN FOR "; CHR$(34); "A"; CHR$(34); " COMMAND"
  441. PRINT
  442. PRINT "The ADD BOX command changes the"
  443. PRINT "currently selected box to an AND box;"
  444. PRINT "a box that outputs true only if both"
  445. PRINT "inputs are true.  The following four"
  446. PRINT "boxes show an AND with both inputs"
  447. PRINT "false, the top input true, the"
  448. PRINT "bottom input true, and both inputs"
  449. PRINT "true.  Press any key to return to"
  450. PRINT "the main help message screen."
  451. idbox = 8
  452. j = 5
  453. i = 0
  454. idvalue = 0
  455. CALL displaybox(i, j, idbox, idvalue)
  456. i = 2
  457. idvalue = 1
  458. CALL displaybox(i, j, idbox, idvalue)
  459. i = 4
  460. idvalue = 2
  461. CALL displaybox(i, j, idbox, idvalue)
  462. i = 6
  463. idvalue = 3
  464. CALL displaybox(i, j, idbox, idvalue)
  465. DO
  466.         LOOP WHILE INKEY$ = ""
  467. END SUB
  468.  
  469. SUB helparrow
  470. SCREEN 1
  471. CLS
  472. PRINT "HELP MESSAGE SCREEN FOR ARROW COMMANDS"
  473. PRINT
  474. PRINT "The arrow commands change the currently"
  475. PRINT "selected box.  "; CHR$(24); " moves up one box, "; CHR$(25)
  476. PRINT "moves down, "; CHR$(26); " moves right, and "; CHR$(27)
  477. PRINT "moves left.  All motions wrap-around"
  478. PRINT "(the computer is a torus).  The"
  479. PRINT "currently selected box is shown in a"
  480. PRINT "different color (or brightness) and"
  481. PRINT "is the box affected by other commands."
  482. PRINT "Press any key to return to the main"
  483. PRINT "help message screen."
  484. DO
  485.         LOOP WHILE INKEY$ = ""
  486. END SUB
  487.  
  488. SUB helpcompute
  489. SCREEN 1
  490. CLS
  491. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "C"; CHR$(34); " COMMAND"
  492. PRINT
  493. PRINT "The COMPUTE command starts from the"
  494. PRINT "currently selected box and recomputes"
  495. PRINT "the boxes in column order.  It works"
  496. PRINT "until any key is pressed.  The numbers"
  497. PRINT "at the top of each column are the"
  498. PRINT "decimal equivalent of the 8-bit binary"
  499. PRINT "number in the column.  Press any key to"
  500. PRINT "return to the main help message screen."
  501. DO
  502.         LOOP WHILE INKEY$ = ""
  503. END SUB
  504.  
  505. SUB helpconn
  506. SCREEN 1
  507. CLS
  508. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "U"; CHR$(34); " AND "; CHR$(34); "D"; CHR$(34)
  509. PRINT "    COMMANDS"
  510. PRINT
  511. PRINT "The CONNECTION commands change the"
  512. PRINT "input connections of the currently"
  513. PRINT "selected box.  A box can be connected"
  514. PRINT "to the leftward boxes above, even with,"
  515. PRINT "and below itself.  UP reverses the"
  516. PRINT "connection with the box above (it makes"
  517. PRINT "the connection if it is not already"
  518. PRINT "made and breaks it if it is already"
  519. PRINT "made).  DOWN reverses the connection"
  520. PRINT "with the box below.  By using these"
  521. PRINT "two commands, any connection pattern"
  522. PRINT "can be set.  Press any key to return to"
  523. PRINT "the main help message screen."
  524. DO
  525.         LOOP WHILE INKEY$ = ""
  526. END SUB
  527.  
  528. SUB helpexit
  529. SCREEN 1
  530. CLS
  531. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "E"; CHR$(34); " COMMAND"
  532. PRINT
  533. PRINT "The EXIT command returns you to DOS."
  534. PRINT "Press any key to return to the main"
  535. PRINT "help message screen."
  536. DO
  537.         LOOP WHILE INKEY$ = ""
  538. END SUB
  539.  
  540. SUB helpfile
  541. SCREEN 1
  542. CLS
  543. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "F"; CHR$(34); " AND "; CHR$(34); "L"; CHR$(34)
  544. PRINT "    COMMANDS"
  545. PRINT
  546. PRINT "The FILE command stores the current"
  547. PRINT "configurations (box types, connections"
  548. PRINT "and values) into a file.  LOAD reads"
  549. PRINT "a file to set the configuration.  If"
  550. PRINT "no extension is given, .ROP is"
  551. PRINT "assumed.  Press any key to return to"
  552. PRINT "the main help message screen."
  553. DO
  554.         LOOP WHILE INKEY$ = ""
  555. END SUB
  556.  
  557. SUB helphelp
  558. SCREEN 1
  559. CLS
  560. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "H"; CHR$(34); " COMMAND"
  561. PRINT
  562. PRINT "The HELP command prints the main help"
  563. PRINT "screen.  Any command typed when the"
  564. PRINT "help screen is displayed explains"
  565. PRINT "that command rather than executing it."
  566. PRINT "You cannot exit directly from the help"
  567. PRINT "screen, first type <space> to get to"
  568. PRINT "the main program, then type E.  Press"
  569. PRINT "any key to return to the main help"
  570. PRINT "message screen."
  571. DO
  572.         LOOP WHILE INKEY$ = ""
  573. END SUB
  574.  
  575. SUB helpinvert
  576. SCREEN 1
  577. CLS
  578. PRINT "   HELP MESSAGE SCREEN FOR "; CHR$(34); "I"; CHR$(34); " COMMAND"
  579. PRINT
  580. PRINT "The INVERT BOX command changes the"
  581. PRINT "currently selected box to an INVERT box;"
  582. PRINT "a box that outputs false if the input"
  583. PRINT "is true and true if the input is false."
  584. PRINT "The two boxes below show an INVERT with"
  585. PRINT "input false and an INVERT with input"
  586. PRINT "true.  Press any key to return to"
  587. PRINT "the main help message screen."
  588. idbox = 2
  589. j = 5
  590. i = 2
  591. idvalue = 0
  592. CALL displaybox(i, j, idbox, idvalue)
  593. i = 5
  594. idvalue = 1
  595. CALL displaybox(i, j, idbox, idvalue)
  596. DO
  597.         LOOP WHILE INKEY$ = ""
  598. END SUB
  599.  
  600. SUB helpmsg
  601. DIM m(100) AS STRING
  602. newscreen:
  603. SCREEN 0
  604. WIDTH 80
  605. CLS
  606. m(0) = "╔══GREETINGS═════════════════════════════════════════════╗"
  607. m(1) = "║         Welcome to the Apraphul Rope Computer          ║"
  608. m(2) = "║  For details see COMPUTER RECREATIONS by A.K. Dewdney  ║"
  609. m(3) = "║ Scientific American, April 1988, v. 258 #4, p. 118-121 ║"
  610. m(4) = "║         Program copyright 1988 by Aaron Brown          ║"
  611. m(5) = "╚════════════════════════════════════════════════════════╝"
  612. m(6) = "  ╔══ESSENTIALS══════╗"
  613. m(7) = "  ║ Press space bar  ║"
  614. m(8) = "  ║ to start program ║"
  615. m(9) = "  ║ Type " + CHR$(34) + "H" + CHR$(34) + " to get  ║"
  616. m(10) = "  ║ back to help     ║"
  617. m(11) = "  ╚══════════════════╝"
  618. m(12) = "╔══COMMAND SUMMARY═════════════════════════════════════════════════════════════╗"
  619. m(13) = "║ Use cursor (arrow) keys; " + CHR$(24) + ", " + CHR$(25) + ", " + CHR$(26) + ", " + CHR$(27) + "; to move around screen                   ║"
  620. m(14) = "║ Type a command letter now to get additional help                             ║"
  621. m(15) = "╟────────────────┬───────────────────────┬─────────────────────────────────────╢"
  622. m(16) = "║ Change box     │ Change box inputs     │ Start computation                   ║"
  623. m(17) = "╟────────────────┼───────────────────────┼─────────────────────────────────────╢"
  624. m(18) = "║ A - AND box    │ 0 - all inputs false  │ S - Step (compute this box only)    ║"
  625. m(19) = "║ I - INVERT box │ 1 - top input true    │ C - Compute until any key is hit    ║"
  626. m(20) = "║ N - NULL box   │ 2 - bottom input true │ M - Compute and play music          ║"
  627. m(21) = "║ O - OR box     │ 3 - both inputs true  │ R - Redraw screen (no computation)  ║"
  628. m(22) = "╟────────────────┼───────────────────────┼─────────────────────────────────────╢"
  629. m(23) = "║ Miscellaneous  │ File Commands         │ Input connections                   ║"
  630. m(24) = "╟────────────────┼───────────────────────┼─────────────────────────────────────╢"
  631. m(25) = "║ H - Help       │ F - Save to file      │ U - reverse Up connection           ║"
  632. m(26) = "║ E - Exit       │ L - Load from file    │ D - reverse Down connection         ║"
  633. m(27) = "╚════════════════╧═══════════════════════╧═════════════════════════════════════╝"
  634. FOR i% = 0 TO 5
  635.         PRINT m(i%) + m(i% + 6)
  636.         NEXT i%
  637. PRINT
  638. FOR i% = 12 TO 27
  639.         PRINT m(i%)
  640.         NEXT i%
  641.         DO
  642.                 A$ = INKEY$
  643.                 LOOP WHILE A$ = ""
  644.         A% = ASC(RIGHT$(A$, 1))
  645.         SELECT CASE A%
  646.         CASE 75, 77, 80
  647.                 CALL helparrow
  648.         CASE 72, 104
  649.                 IF LEN(A$) < 2 THEN
  650.                         CALL helphelp
  651.                         ELSE
  652.                                 CALL helparrow
  653.                                 END IF
  654.         CASE 65, 97
  655.                 CALL helpand
  656.         CASE 79, 111
  657.                 CALL helpor
  658.         CASE 73, 105
  659.                 CALL helpinvert
  660.         CASE 78, 110
  661.                 CALL helpnull
  662.         CASE 48 TO 51
  663.                 CALL helpvalue
  664.         CASE 85, 117, 68, 100
  665.                 CALL helpconn
  666.         CASE 82, 114
  667.                 CALL helpredraw
  668.         CASE 67, 99
  669.                 CALL helpcompute
  670.         CASE 77, 109
  671.                 CALL helpmusic
  672.         CASE 83, 115
  673.                 CALL helpstep
  674.         CASE 70, 102, 76, 108
  675.                 CALL helpfile
  676.         CASE 69, 101
  677.                 CALL helpexit
  678.         CASE 32
  679.                 SCREEN 1
  680.                 EXIT SUB
  681.         CASE ELSE
  682.                 BEEP
  683.         END SELECT
  684. GOTO newscreen
  685. END SUB
  686.  
  687. SUB helpmusic
  688. SCREEN 1
  689. CLS
  690. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "M"; CHR$(34); " COMMAND "
  691. PRINT
  692. PRINT "The MUSIC command starts from the"
  693. PRINT "currently selected box and recomputes"
  694. PRINT "the boxes in column order.  It works"
  695. PRINT "until any key is pressed.  Each"
  696. PRINT "computed column plays a note of music"
  697. PRINT "the most significant three bits set"
  698. PRINT "the length of the note: 0 for a whole"
  699. PRINT "note, 1 for a half, 2 for a quarter,"
  700. PRINT "3 for an 8th, 4 for a 16th, 5 for a"
  701. PRINT "32nd, 6 for a 64th, and 7 for skip."
  702. PRINT "The remaining five bits set the pitch;"
  703. PRINT "0 is E natural in the octave below"
  704. PRINT "middle C and each increment represents"
  705. PRINT "one half-step above (black or white"
  706. PRINT "note).  Press any key to return to"
  707. PRINT "the main help message screen."
  708. i% = 32
  709. DO
  710.         PLAY "N" + STR$(i%)
  711.         i% = i% + 1
  712.         IF i% > 63 THEN i% = 32
  713.         LOOP WHILE INKEY$ = ""
  714. END SUB
  715.  
  716. SUB helpnull
  717. SCREEN 1
  718. CLS
  719. PRINT "   HELP MESSAGE SCREEN FOR "; CHR$(34); "N"; CHR$(34); " COMMAND"
  720. PRINT
  721. PRINT "The NULL BOX command changes the"
  722. PRINT "currently selected box to a NULL box;"
  723. PRINT "a box that outputs true if the input"
  724. PRINT "is true and false if the input is false."
  725. PRINT "The two boxes below show a NULL with"
  726. PRINT "input false and an NULL with input"
  727. PRINT "true.  Press any key to return to"
  728. PRINT "the main help message screen."
  729. idbox = 0
  730. j = 5
  731. i = 2
  732. idvalue = 0
  733. CALL displaybox(i, j, idbox, idvalue)
  734. i = 5
  735. idvalue = 1
  736. CALL displaybox(i, j, idbox, idvalue)
  737. DO
  738.         LOOP WHILE INKEY$ = ""
  739. END SUB
  740.  
  741. SUB helpor
  742. SCREEN 1
  743. CLS
  744. PRINT "   HELP MESSAGE SCREEN FOR "; CHR$(34); "O"; CHR$(34); " COMMAND"
  745. PRINT
  746. PRINT "The OR BOX command changes the"
  747. PRINT "currently selected box to an OR box;"
  748. PRINT "a box that outputs false only if both"
  749. PRINT "inputs are false.  The following four"
  750. PRINT "boxes show an OR with both inputs"
  751. PRINT "false, the top input true, the"
  752. PRINT "bottom input true, and both inputs"
  753. PRINT "true.  Press any key to return to"
  754. PRINT "the main help message screen."
  755. idbox = 4
  756. j = 5
  757. i = 0
  758. idvalue = 0
  759. CALL displaybox(i, j, idbox, idvalue)
  760. i = 2
  761. idvalue = 1
  762. CALL displaybox(i, j, idbox, idvalue)
  763. i = 4
  764. idvalue = 2
  765. CALL displaybox(i, j, idbox, idvalue)
  766. i = 6
  767. idvalue = 3
  768. CALL displaybox(i, j, idbox, idvalue)
  769. DO
  770.         LOOP WHILE INKEY$ = ""
  771. END SUB
  772.  
  773. SUB helpredraw
  774. SCREEN 1
  775. CLS
  776. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "R"; CHR$(34); " COMMAND"
  777. PRINT
  778. PRINT "The REDRAW command redraws the"
  779. PRINT "screen without changing anything."
  780. PRINT "It is useful after a COMPUTE has"
  781. PRINT "left numbers on the screen."
  782. PRINT "Press any key to return to"
  783. PRINT "the main help message screen."
  784. DO
  785.         LOOP WHILE INKEY$ = ""
  786. END SUB
  787.  
  788. SUB helpstep
  789. SCREEN 1
  790. CLS
  791. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "S"; CHR$(34); " COMMAND"
  792. PRINT
  793. PRINT "The SINGLE STEP command computes only"
  794. PRINT "the currently selected box, setting"
  795. PRINT "its output to correspond to its"
  796. PRINT "input.  Press any key to return to"
  797. PRINT "the main help message screen."
  798. DO
  799.         LOOP WHILE INKEY$ = ""
  800. END SUB
  801.  
  802. SUB helpvalue
  803. SCREEN 1
  804. CLS
  805. PRINT "    HELP MESSAGE SCREEN FOR "; CHR$(34); "0"; CHR$(34); ", "; CHR$(34); "1"; CHR$(34); ","
  806. PRINT "    "; CHR$(34); "2"; CHR$(34); ", and "; CHR$(34); "3"; CHR$(34); " COMMANDS"
  807. PRINT
  808. PRINT "The SET VALUE commands change the"
  809. PRINT "input values of the currently selected"
  810. PRINT "box.  For NULL and INVERT boxes, 0 sets"
  811. PRINT "the input false and 1 sets it true."
  812. PRINT "For AND and OR boxes, 0 sets both"
  813. PRINT "inputs false, 1 sets the top true,"
  814. PRINT "2 sets the bottom true, and 3 sets"
  815. PRINT "both true.  The following four"
  816. PRINT "boxes show an AND with both inputs"
  817. PRINT "false (0), the top input true (1), the"
  818. PRINT "bottom input true (2), and both inputs"
  819. PRINT "true (3).  Press any key to return to"
  820. PRINT "the main help message screen."
  821. idbox = 8
  822. j = 6
  823. i = 0
  824. idvalue = 0
  825. CALL displaybox(i, j, idbox, idvalue)
  826. i = 2
  827. idvalue = 1
  828. CALL displaybox(i, j, idbox, idvalue)
  829. i = 4
  830. idvalue = 2
  831. CALL displaybox(i, j, idbox, idvalue)
  832. i = 6
  833. idvalue = 3
  834. CALL displaybox(i, j, idbox, idvalue)
  835. DO
  836.         LOOP WHILE INKEY$ = ""
  837. END SUB
  838.  
  839. SUB music (i)
  840. isum = 0
  841. FOR j = 0 TO 2
  842.         SELECT CASE (ibox(i, j) + ivalue(i, j))
  843.                 CASE 1, 2, 5, 6, 7, 11
  844.                         isum = 2 * isum + 1
  845.                 CASE 0, 3, 4, 8, 9, 10
  846.                         isum = 2 * isum
  847.                 END SELECT
  848.         NEXT j
  849. IF isum < 7 THEN
  850.         jsum = 1
  851.         isum = 2 ^ isum
  852.         FOR j = 3 TO 7
  853.                 SELECT CASE (ibox(i, j) + ivalue(i, j))
  854.                         CASE 1, 2, 5, 6, 7, 11
  855.                                 jsum = 2 * jsum + 1
  856.                         CASE 0, 3, 4, 8, 9, 10
  857.                                 jsum = 2 * jsum
  858.                         END SELECT
  859.                 NEXT j
  860.         PLAY "L" + LTRIM$(STR$(isum)) + "N" + LTRIM$(STR$(jsum))
  861.         END IF
  862.  
  863. END SUB
  864.  
  865. SUB wsum (i, isum)
  866. isum = 0
  867. FOR j = 0 TO 7
  868.         SELECT CASE (ibox(i, j) + ivalue(i, j))
  869.                 CASE 1, 2, 5, 6, 7, 11
  870.                         isum = 2 * isum + 1
  871.                 CASE 0, 3, 4, 8, 9, 10
  872.                         isum = 2 * isum
  873.                 END SELECT
  874.         NEXT j
  875. END SUB
  876.  
  877.