home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / games / kidsgame / fiveyrs / add.lst next >
File List  |  1993-08-14  |  23KB  |  1,115 lines
  1. ' add
  2. ' Programmed by S.Shlien in GFA Basic 3.5  Jan 31 1993
  3. ' 624 Courtenay Avenue
  4. ' Ottawa, Ontario
  5. ' Canada K2A 3B5
  6. '
  7. ' board& indicates presence of orange or yellow block or barrier
  8. ' if it an yellow block board& is = 1.
  9. ' if it is a barrier, board& is = 2.
  10. ' if it is an orange block board& contains 3 and board_ans& contains.
  11. ' the answer.
  12. ' board_ans& contains the desired answer next to the yellow block
  13. ' the answer location is marked by board&=4  and board_ans& contains
  14. ' the desired answer.
  15. DIM board&(20,14)
  16. DIM board_ans&(20,14)
  17. ' x_prob%,y_prob% points to top left square of yellow question block.
  18. ' d_prob% indicates whether the block goes across or down.
  19. DIM x_prob%(100),y_prob%(100),d_prob%(100)
  20. DIM deskcolors%(16)
  21. DIM difficulty$(2),operation$(2)
  22. DIM help$(10)
  23. DIM frame%(10000)
  24. DIM frame_ptr%(2)
  25. frame_ptr%(1)=VARPTR(frame%(0))
  26. frame_ptr%(1)=(frame_ptr%(1)+256) AND &HFFFFFF00
  27. frame_ptr%(0)=XBIOS(2)
  28. difficulty$(0)="easy"
  29. difficulty$(1)="harder"
  30. difficulty$(2)="hardest"
  31. operation$(0)="addition"
  32. operation$(1)="mulitplication"
  33. help$(0)="Select option with mouse pointer"
  34. help$(1)="How to run this program"
  35. help$(2)="Sets the largest number"
  36. help$(3)="Add or multiply"
  37. help$(4)="Next file to load"
  38. help$(5)="Joystick delay time"
  39. help$(7)="Lets go"
  40. help$(8)="I am fed up."
  41. DEFMOUSE 0
  42. '
  43. rez%=XBIOS(4)
  44. IF rez%<>0
  45.   ALERT 3," Please switch   to | low  resolution! ",1,"Oops",b%
  46.   STOP
  47. ENDIF
  48. wid%=16
  49. height%=12
  50. xdim%=18
  51. ydim%=12
  52. ytop%=20
  53. xleft%=20
  54. file_num%=1
  55. file_write%=20
  56. difficulty%=0
  57. operation%=0
  58. joystick_response=0.25
  59. @read_put
  60. @get_deskcolors
  61. @load_degas_pi1("addbak.pi1")
  62. ' VSETCOLOR 0,10,10,8
  63. VSETCOLOR 2,8,8,4
  64. VSETCOLOR 5,12,10,10
  65. VSETCOLOR 6,14,14,0
  66. VSETCOLOR 7,14,10,0
  67. VSETCOLOR 8,10,8,8
  68. prob_num%=1
  69. ans_num%=1
  70. pnum%=0
  71. i_explorer%=5
  72. j_explorer%=5
  73. quit%=0
  74. REPEAT
  75.   @select_parameters
  76. UNTIL quit%=1
  77. @restore_deskcolors
  78. END
  79. > PROCEDURE get_deskcolors
  80.   LOCAL i%
  81.   FOR i%=0 TO 15
  82.     deskcolors%(i%)=XBIOS(7,i%,-1)
  83.   NEXT i%
  84. RETURN
  85. > PROCEDURE restore_deskcolors
  86.   LOCAL i%
  87.   FOR i%=0 TO 15
  88.     SETCOLOR i%,deskcolors%(i%)
  89.   NEXT i%
  90. RETURN
  91. > PROCEDURE read_put
  92.   ' the board
  93.   OPEN "i",#1,"add.put"
  94.   add$=INPUT$(CVI(INPUT$(2,#1)),#1)
  95.   CLOSE #1
  96. RETURN
  97. '
  98. > PROCEDURE make_board
  99.   LOCAL i%
  100.   CLS
  101.   @random_pattern(10,10,319,150)
  102.   COLOR 1
  103.   DEFFILL 5
  104.   PBOX xleft%,ytop%,xleft%+xdim%*wid%,ytop%+ydim%*height%
  105.   FOR i%=0 TO wid%
  106.     LINE xleft%+xdim%*i%,ytop%,xleft%+xdim%*i%,ytop%+height%*ydim%
  107.   NEXT i%
  108.   FOR i%=0 TO height%
  109.     LINE xleft%,ytop%+ydim%*i%,xleft%+xdim%*wid%,ytop%+ydim%*i%
  110.   NEXT i%
  111.   GRAPHMODE 2
  112. RETURN
  113. '
  114. > PROCEDURE design_row
  115.   LOCAL i%,j%,ix%,iy%,k%,ok%
  116.   REPEAT
  117.   UNTIL MOUSEK<>0
  118.   i%=(MOUSEX-xleft%)/xdim%
  119.   j%=(MOUSEY-ytop%)/ydim%
  120.   IF i%<0
  121.     i%=0
  122.   ENDIF
  123.   IF j%<0
  124.     j%=0
  125.   ENDIF
  126.   ok%=1
  127.   IF (j%>=height%)
  128.     ok%=0
  129.   ENDIF
  130.   IF (i%>=wid%-3)
  131.     ok%=0
  132.   ENDIF
  133.   FOR k%=0 TO 3
  134.     IF board&(i%+k%,j%)>0
  135.       ok%=0
  136.     ENDIF
  137.   NEXT k%
  138.   IF ok%=1
  139.     ix%=i%*xdim%+xleft%
  140.     iy%=j%*ydim%+ytop%
  141.     @draw_design_row(i%,j%,ix%,iy%,pnum%)
  142.     x_prob%(pnum%)=i%
  143.     y_prob%(pnum%)=j%
  144.     d_prob%(pnum%)=1
  145.     INC prob_num%
  146.     INC pnum%
  147.     LOCATE 1,1
  148.     PRINT SPACE$(10);
  149.     PAUSE 20
  150.   ELSE
  151.     LOCATE 1,1
  152.     PRINT "sorry;"
  153.   ENDIF
  154. RETURN
  155. > PROCEDURE draw_design_row(i%,j%,ix%,iy%,n%)
  156.   LOCAL k%
  157.   DEFTEXT 3
  158.   COLOR 3
  159.   BOX ix%,iy%,ix%+4*xdim%,iy%+ydim%
  160.   TEXT ix%+1,iy%+8,STR$(prob_num%)
  161.   FOR k%=0 TO 3
  162.     board&(i%+k%,j%)=n%+1
  163.   NEXT k%
  164. RETURN
  165. > PROCEDURE design_column
  166.   LOCAL i%,j%,ix%,iy%,k%,ok%
  167.   REPEAT
  168.   UNTIL MOUSEK<>0
  169.   i%=(MOUSEX-xleft%)/xdim%
  170.   j%=(MOUSEY-ytop%)/ydim%
  171.   ok%=1
  172.   IF i%<0
  173.     i%=0
  174.   ENDIF
  175.   IF j%<0
  176.     j%=0
  177.   ENDIF
  178.   IF (j%>=height%-2)
  179.     ok%=0
  180.   ENDIF
  181.   IF (i%>=wid%)
  182.     ok%=0
  183.   ENDIF
  184.   FOR k%=0 TO 2
  185.     IF board&(i%,j%+k%)>0
  186.       ok%=0
  187.     ENDIF
  188.   NEXT k%
  189.   IF (ok%=1)
  190.     ix%=i%*xdim%+xleft%
  191.     iy%=j%*ydim%+ytop%
  192.     @draw_design_col(i%,j%,ix%,iy%,pnum%)
  193.     x_prob%(pnum%)=i%
  194.     y_prob%(pnum%)=j%
  195.     d_prob%(pnum%)=2
  196.     INC pnum%
  197.     INC prob_num%
  198.     PAUSE 20
  199.   ELSE
  200.     LOCATE 1,1
  201.     PRINT "sorry;"
  202.   ENDIF
  203. RETURN
  204. > PROCEDURE draw_design_col(i%,j%,ix%,iy%,n%)
  205.   LOCAL k%
  206.   COLOR 3
  207.   DEFTEXT 3
  208.   BOX ix%,iy%,ix%+xdim%,iy%+3*ydim%
  209.   TEXT ix%+1,iy%+8,STR$(prob_num%)
  210.   FOR k%=0 TO 2
  211.     board&(i%,j%+k%)=n%+1
  212.   NEXT k%
  213. RETURN
  214. > PROCEDURE design_ans
  215.   LOCAL i%,j%,ix%,iy%,ok%
  216.   REPEAT
  217.   UNTIL MOUSEK<>0
  218.   i%=(MOUSEX-xleft%)/xdim%
  219.   j%=(MOUSEY-ytop%)/ydim%
  220.   IF i%<0
  221.     i%=0
  222.   ENDIF
  223.   IF j%<0
  224.     j%=0
  225.   ENDIF
  226.   ok%=1
  227.   IF (j%>=height%)
  228.     ok%=0
  229.   ENDIF
  230.   IF (i%>=wid%)
  231.     ok%=0
  232.   ENDIF
  233.   IF board&(i%,j%)<>0
  234.     ok%=0
  235.   ENDIF
  236.   IF ok%=1
  237.     ix%=i%*xdim%+xleft%
  238.     iy%=j%*ydim%+ytop%
  239.     x_prob%(pnum%)=i%
  240.     y_prob%(pnum%)=j%
  241.     d_prob%(pnum%)=3
  242.     @draw_design_answer(i%,j%,ix%,iy%,pnum%)
  243.     INC ans_num%
  244.     INC pnum%
  245.     LOCATE 1,1
  246.     PRINT SPACE$(8)
  247.     PAUSE 20
  248.   ELSE
  249.     LOCATE 1,1
  250.     PRINT "sorry";
  251.   ENDIF
  252. RETURN
  253. > PROCEDURE draw_design_answer(i%,j%,ix%,iy%,n%)
  254.   COLOR 3
  255.   DEFTEXT 3
  256.   BOX ix%,iy%,ix%+xdim%,iy%+ydim%
  257.   TEXT ix%+1,iy%+8,STR$(ans_num%)
  258.   board&(i%,j%)=n%+1
  259. RETURN
  260. > PROCEDURE design_block
  261.   LOCAL i%,j%,ix%,iy%
  262.   REPEAT
  263.   UNTIL MOUSEK<>0
  264.   i%=(MOUSEX-xleft%)/xdim%
  265.   j%=(MOUSEY-ytop%)/ydim%
  266.   IF i%<0
  267.     i%=0
  268.   ENDIF
  269.   IF j%<0
  270.     j%=0
  271.   ENDIF
  272.   IF i%<wid% AND j%<height% AND board&(i%,j%)=0
  273.     ix%=i%*xdim%+xleft%
  274.     iy%=j%*ydim%+ytop%
  275.     draw_design_block(i%,j%,ix%,iy%,pnum%)
  276.     x_prob%(pnum%)=i%
  277.     y_prob%(pnum%)=j%
  278.     d_prob%(pnum%)=4
  279.     INC pnum%
  280.     LOCATE 1,1
  281.     PRINT SPACE$(10);
  282.     PAUSE 20
  283.   ELSE
  284.     LOCATE 1,1
  285.     PRINT "sorry";
  286.   ENDIF
  287. RETURN
  288. > PROCEDURE draw_design_block(i%,j%,ix%,iy%,n%)
  289.   COLOR 3
  290.   DEFTEXT 3
  291.   BOX ix%,iy%,ix%+xdim%,iy%+ydim%
  292.   board&(i%,j%)=n%+1
  293. RETURN
  294. > PROCEDURE design_erase
  295.   LOCAL i%,j%,ix%,iy%,k%
  296.   REPEAT
  297.   UNTIL MOUSEK<>0
  298.   i%=(MOUSEX-xleft%)/xdim%
  299.   j%=(MOUSEY-ytop%)/ydim%
  300.   IF i%<0
  301.     i%=0
  302.   ENDIF
  303.   IF j%<0
  304.     j%=0
  305.   ENDIF
  306.   k%=board&(i%,j%)
  307.   LOCATE 10,1
  308.   IF k%>0
  309.     '    PRINT k%;" ";d_prob%(k%-1);
  310.     IF d_prob%(k%-1)=1
  311.       DEC prob_num%
  312.     ELSE IF d_prob%(k%-1)=2
  313.       DEC prob_num%
  314.     ELSE IF d_prob%(k%-1)=3
  315.       DEC ans_num%
  316.     ENDIF
  317.     IF pnum%>0
  318.       DELETE x_prob%(k%-1)
  319.       DELETE y_prob%(k%-1)
  320.       DELETE d_prob%(k%-1)
  321.       DEC pnum%
  322.       @draw_design_set
  323.     ENDIF
  324.     PAUSE 20
  325.   ENDIF
  326. RETURN
  327. > PROCEDURE design_clear
  328.   prob_num%=1
  329.   ans_num%=1
  330.   pnum%=0
  331.   @clear_board
  332.   @make_board
  333.   @design_menu
  334. RETURN
  335. > PROCEDURE design_explorer
  336.   LOCAL i%,j%,ok%
  337.   DEFFILL 0
  338.   DEFTEXT 1
  339.   PBOX 0,168,319,199
  340.   TEXT 0,180,"Explorer's starting position."
  341.   REPEAT
  342.   UNTIL MOUSEK<>0
  343.   i%=(MOUSEX-xleft%)/xdim%
  344.   j%=(MOUSEY-ytop%)/ydim%
  345.   i_explorer%=i%
  346.   j_explorer%=j%
  347.   i_explorer_init%=i%
  348.   j_explorer_init%=j%
  349.   PAUSE 30
  350. RETURN
  351. > PROCEDURE design_menu
  352.   LOCAL i%
  353.   COLOR 1
  354.   BOX 0,168,28,182
  355.   BOX 28,168,58,182
  356.   BOX 58,168,88,182
  357.   BOX 88,168,134,182
  358.   BOX 134,168,180,182
  359.   BOX 180,168,224,182
  360.   BOX 224,168,268,182
  361.   FOR i%=1 TO 7
  362.     highlight_menu_element(i%,0)
  363.   NEXT i%
  364. RETURN
  365. '
  366. > PROCEDURE highlight_menu_element(elem%,high%)
  367.   IF high%=1
  368.     DEFTEXT 4
  369.   ELSE
  370.     DEFTEXT 1
  371.   ENDIF
  372.   SELECT elem%
  373.   CASE 1
  374.     TEXT 1,180,"row"
  375.   CASE 2
  376.     TEXT 30,180,"col"
  377.   CASE 3
  378.     TEXT 60,180,"ans"
  379.   CASE 4
  380.     TEXT 90,180,"block"
  381.   CASE 5
  382.     TEXT 136,180,"erase"
  383.   CASE 6
  384.     TEXT 182,180,"clear"
  385.   CASE 7
  386.     TEXT 226,180,"done"
  387.   ENDSELECT
  388. RETURN
  389. > PROCEDURE design_control
  390.   LOCAL quit%,command%,old_command%
  391.   quit%=0
  392.   command%=0
  393.   old_command%=0
  394.   CLS
  395.   INPUT "Enter width ",wid%
  396.   INPUT "Enter height ",height%
  397.   PAUSE 10
  398.   CLS
  399.   IF wid%>16
  400.     wid%=16
  401.   ENDIF
  402.   IF height%>12
  403.     height%=12
  404.   ENDIF
  405.   IF wid%<4
  406.     wid%=4
  407.   ENDIF
  408.   IF height%<3
  409.     height%=3
  410.   ENDIF
  411.   @draw_design_set
  412.   @design_menu
  413.   PAUSE 30
  414.   REPEAT
  415.     REPEAT
  416.     UNTIL MOUSEK<>0
  417.     IF MOUSEY>160
  418.       IF MOUSEX<28
  419.         command%=1
  420.       ELSE IF MOUSEX<58
  421.         command%=2
  422.       ELSE IF MOUSEX<88
  423.         command%=3
  424.       ELSE IF MOUSEX<134
  425.         command%=4
  426.       ELSE IF MOUSEX<182
  427.         command%=5
  428.       ELSE IF MOUSEX<224
  429.         command%=6
  430.         @design_clear
  431.         PAUSE 20
  432.       ELSE
  433.         command%=7
  434.         quit%=1
  435.       ENDIF
  436.     ELSE
  437.       SELECT command%
  438.       CASE 1
  439.         @design_row
  440.       CASE 2
  441.         @design_column
  442.       CASE 3
  443.         @design_ans
  444.       CASE 4
  445.         @design_block
  446.       CASE 5
  447.         @design_erase
  448.       CASE 7
  449.         quit%=1
  450.       ENDSELECT
  451.     ENDIF
  452.     IF command%<>old_command%
  453.       @highlight_menu_element(old_command%,0)
  454.       @highlight_menu_element(command%,1)
  455.       old_command%=command%
  456.     ENDIF
  457.   UNTIL quit%=1
  458.   PAUSE 20
  459.   @design_explorer
  460.   CLS
  461.   @show_all_parameters
  462. RETURN
  463. > PROCEDURE draw_design_set
  464.   LOCAL i%,j%,k%,ix%,iy%
  465.   @clear_board
  466.   prob_num%=1
  467.   ans_num%=1
  468.   @make_board
  469.   COLOR 1
  470.   FOR k%=0 TO pnum%-1
  471.     i%=x_prob%(k%)
  472.     j%=y_prob%(k%)
  473.     ix%=i%*xdim%+xleft%
  474.     iy%=j%*ydim%+ytop%
  475.     SELECT d_prob%(k%)
  476.     CASE 1
  477.       draw_design_row(i%,j%,ix%,iy%,k%)
  478.       INC prob_num%
  479.     CASE 2
  480.       @draw_design_col(i%,j%,ix%,iy%,k%)
  481.       INC prob_num%
  482.     CASE 3
  483.       @draw_design_answer(i%,j%,ix%,iy%,k%)
  484.       INC ans_num%
  485.     CASE 4
  486.       @draw_design_block(i%,j%,ix%,iy%,k%)
  487.     ENDSELECT
  488.   NEXT k%
  489.   @design_menu
  490. RETURN
  491. '
  492. > PROCEDURE clear_board
  493.   LOCAL i%,j%
  494.   FOR i%=0 TO wid%
  495.     FOR j%=0 TO height%
  496.       board&(i%,j%)=0
  497.     NEXT j%
  498.   NEXT i%
  499. RETURN
  500. > PROCEDURE make_prob(n%)
  501.   LOCAL ix%,iy%,n1%,n2%,maxnum%
  502.   ix%=x_prob%(n%)*xdim%+xleft%
  503.   iy%=y_prob%(n%)*ydim%+ytop%
  504.   IF difficulty%=2
  505.     maxnum%=10
  506.     IF operation%=1
  507.       maxnum%=9
  508.     ENDIF
  509.   ELSE IF difficulty%=1
  510.     maxnum%=8
  511.   ELSE
  512.     maxnum%=5
  513.   ENDIF
  514.   n1%=RANDOM(maxnum%)
  515.   n2%=RANDOM(maxnum%)
  516.   IF operation%=1 AND difficulty%>0
  517.     n1%=n1%+1
  518.     n2%=n2%+1
  519.   ENDIF
  520.   DEFFILL 6
  521.   IF d_prob%(n%)=1
  522.     PBOX ix%+1,iy%+1,ix%+xdim%*3-1,iy%+ydim%-1
  523.     TEXT ix%+7,iy%+9,STR$(n1%)
  524.     ix%=(1+x_prob%(n%))*xdim%+xleft%+1
  525.     IF operation%=0
  526.       TEXT ix%,iy%+9,"+"+STR$(n2%)
  527.     ELSE
  528.       TEXT ix%,iy%+9,"x"+STR$(n2%)
  529.     ENDIF
  530.     ix%=(2+x_prob%(n%))*xdim%+xleft%+4
  531.     TEXT ix%,iy%+9,"="
  532.     IF operation%=0
  533.       board_ans&(x_prob%(n%)+3,y_prob%(n%))=n1%+n2%
  534.     ELSE
  535.       board_ans&(x_prob%(n%)+3,y_prob%(n%))=n1%*n2%
  536.     ENDIF
  537.     board&(x_prob%(n%),y_prob%(n%))=1
  538.     board&(x_prob%(n%)+1,y_prob%(n%))=1
  539.     board&(x_prob%(n%)+2,y_prob%(n%))=1
  540.     board&(x_prob%(n%)+3,y_prob%(n%))=4
  541.     ix%=(x_prob%(n%)+3)*xdim%+xleft%
  542.     DEFFILL 8
  543.     PBOX ix%+1,iy%+1,ix%+xdim%-1,iy%+ydim%-1
  544.     IF operation%=0
  545.       @place_answer(n1%+n2%)
  546.     ELSE
  547.       @place_answer(n1%*n2%)
  548.     ENDIF
  549.   ELSE IF d_prob%(n%)=2
  550.     PBOX ix%+1,iy%+1,ix%+xdim%-1,iy%+2*ydim%-1
  551.     TEXT ix%+7,iy%+9,STR$(n1%)
  552.     ix%=x_prob%(n%)*xdim%+xleft%+1
  553.     iy%=(1+y_prob%(n%))*ydim%+ytop%+9
  554.     IF operation%=0
  555.       TEXT ix%,iy%,"+"+STR$(n2%)
  556.     ELSE
  557.       TEXT ix%,iy%,"x"+STR$(n2%)
  558.     ENDIF
  559.     IF operation%=0
  560.       board_ans&(x_prob%(n%),y_prob%(n%)+2)=n1%+n2%
  561.     ELSE
  562.       board_ans&(x_prob%(n%),y_prob%(n%)+2)=n1%*n2%
  563.     ENDIF
  564.     board&(x_prob%(n%),y_prob%(n%))=1
  565.     board&(x_prob%(n%),y_prob%(n%)+1)=1
  566.     board&(x_prob%(n%),y_prob%(n%)+2)=4
  567.     iy%=(2+y_prob%(n%))*ydim%+ytop%
  568.     DEFFILL 8
  569.     PBOX ix%,iy%+1,ix%+xdim%-1,iy%+ydim%-1
  570.     IF operation%=0
  571.       @place_answer(n1%+n2%)
  572.     ELSE
  573.       @place_answer(n1%*n2%)
  574.     ENDIF
  575.   ELSE IF d_prob%(n%)=4
  576.     DEFFILL 3
  577.     board&(x_prob%(n%),y_prob%(n%))=2
  578.     PBOX ix%+1,iy%+1,ix%+xdim%-1,iy%+ydim%-1
  579.   ENDIF
  580. RETURN
  581. > PROCEDURE place_answer(n%)
  582.   LOCAL i%,j%,ix%,iy%,done%,kount%,k%
  583.   done%=0
  584.   ' search for answer if any
  585.   kount%=0
  586.   k%=0
  587.   '  LOCATE 1,1
  588.   REPEAT
  589.     INC k%
  590.     IF d_prob%(k%)=3
  591.       INC kount%
  592.     ENDIF
  593.   UNTIL k%>=pnum%-1 OR kount%=prob_num%
  594.   IF kount%<>prob_num%
  595.     '    PRINT prob_num%;" ";
  596.     REPEAT
  597.       i%=RANDOM(wid%)
  598.       j%=RANDOM(height%)
  599.       IF board&(i%,j%)=0
  600.         done%=1
  601.       ENDIF
  602.     UNTIL done%=1
  603.   ELSE
  604.     i%=x_prob%(k%)
  605.     j%=y_prob%(k%)
  606.   ENDIF
  607.   board_ans&(i%,j%)=n%
  608.   board&(i%,j%)=3
  609.   ix%=i%*xdim%+xleft%
  610.   iy%=j%*ydim%+ytop%
  611.   DEFFILL 7
  612.   PBOX ix%+1,iy%+1,ix%+xdim%-1,iy%+ydim%-1
  613.   IF n%<10
  614.     TEXT ix%+7,iy%+9,STR$(n%)
  615.   ELSE
  616.     TEXT ix%+1,iy%+9,STR$(n%)
  617.   ENDIF
  618. RETURN
  619. > PROCEDURE display_problems
  620.   LOCAL i%
  621.   COLOR 1
  622.   prob_num%=1
  623.   CLS
  624.   @clear_board
  625.   @make_board
  626.   DEFTEXT 4
  627.   FOR i%=0 TO pnum%-1
  628.     @make_prob(i%)
  629.     IF d_prob%(i%)=1 OR d_prob%(i%)=2
  630.       INC prob_num%
  631.     ENDIF
  632.   NEXT i%
  633.   TEXT 10,180,"Press Esc key to exit"
  634.   TEXT 10,190,"Press Undo to restart"
  635. RETURN
  636. '
  637. > FUNCTION stick_handler
  638. LOCAL i%
  639. move%=STICK(1)
  640. FOR i%=0 TO 20
  641.   IF STRIG(1)=TRUE
  642.     RETURN 71
  643.   ENDIF
  644.   t$=INKEY$
  645.   IF t$<>""
  646.     scancode%=CVI(t$)
  647.     IF ASC(t$)=0
  648.       RETURN scancode%
  649.     ELSE
  650.       RETURN ASC(t$)
  651.     ENDIF
  652.   ENDIF
  653. NEXT i%
  654. SELECT move%
  655. CASE 1
  656.   RETURN 72
  657. CASE 2
  658.   RETURN 80
  659. CASE 4
  660.   RETURN 75
  661. CASE 8
  662.   RETURN 77
  663. DEFAULT
  664. ENDSELECT
  665. RETURN 0
  666. ENDFUNC
  667. > PROCEDURE shift_explorer(scancode%)
  668. LOCAL i%,j%,k%,m%,index%,last_index%,code|,temp%
  669. i%=i_explorer%
  670. j%=j_explorer%
  671. '  PRINT scancode%;" ";
  672. SELECT scancode%
  673. CASE 71
  674.   LOCATE 1,1
  675.   PRINT SPACE$(4);
  676.   IF carry%=-1
  677.     IF board&(i%,j%)=3
  678.       carry%=board_ans&(i%,j%)
  679.       ix%=i%*xdim%+xleft%+1
  680.       iy%=j%*ydim%+ytop%+1
  681.       GET ix%,iy%,ix%+xdim%-2,iy%+ydim%-2,ansblock$
  682.       board&(i%,j%)=0
  683.       COLOR 4
  684.       @draw_explorer
  685.       PAUSE 3
  686.       COLOR 3
  687.       @draw_explorer
  688.       WAVE 512*8+8,1,1,2000,20
  689.       SOUND 0,0
  690.     ENDIF
  691.   ELSE IF board&(i%,j%)=0
  692.     board_ans&(i%,j%)=carry%
  693.     board&(i%,j%)=3
  694.     carry%=-1
  695.     COLOR 2
  696.     @draw_explorer
  697.     PAUSE 2
  698.     COLOR 3
  699.     @draw_explorer
  700.     WAVE 512*15+8,1,1,2000,20
  701.     SOUND 0,0
  702.   ELSE IF board&(i%,j%)=4
  703.     IF carry%=board_ans&(i%,j%)
  704.       DEFFILL 6
  705.       PBOX ix%+1,iy%+1,ix%+xdim%-1,iy%+ydim%-1
  706.       DEFTEXT 4
  707.       IF carry%<10
  708.         TEXT ix%+7,iy%+9,STR$(carry%)
  709.       ELSE
  710.         TEXT ix%+1,iy%+9,STR$(carry%)
  711.       ENDIF
  712.       WAVE 512*5+8,1,1,2000,40
  713.       SOUND 0,0
  714.       carry%=-1
  715.       board&(i%,j%)=1
  716.       INC num_done%
  717.       lastblock$=""
  718.       IF num_done%=prob_num%
  719.         GOTO shift_exit
  720.       ENDIF
  721.     ELSE
  722.       LOCATE 1,1
  723.       PRINT "No";
  724.     ENDIF
  725.   ENDIF
  726.   DELAY 0.1
  727. CASE 72
  728.   DEC j%
  729. CASE 75
  730.   DEC i%
  731. CASE 77
  732.   INC i%
  733. CASE 80
  734.   INC j%
  735. CASE 97
  736.   @display_problems
  737.   num_done%=1
  738.   i%=i_explorer_init%
  739.   j%=j_explorer_init%
  740. CASE 27
  741.   exit%=1
  742. DEFAULT
  743.   LOCATE 1,20
  744.   PRINT scancode%;
  745. ENDSELECT
  746. IF j%>=0 AND j%<height%
  747.   IF i%>=0 AND i%<wid%
  748.     IF board&(i%,j%)=0 OR (board&(i%,j%)=3 AND carry%=-1) OR board&(i%,j%)=4
  749.       DEFTEXT 5
  750.       COLOR 1
  751.       @draw_explorer
  752.       IF carry%<>-1
  753.         ix%=i_explorer%*xdim%+xleft%
  754.         iy%=j_explorer%*ydim%+ytop%
  755.         IF lastblock$=""
  756.           DEFFILL 5
  757.           PBOX ix%+1,iy%+1,ix%+xdim%-1,iy%+ydim%-1
  758.         ELSE
  759.           PUT ix%+1,iy%+1,lastblock$
  760.         ENDIF
  761.       ENDIF
  762.       i_explorer%=i%
  763.       j_explorer%=j%
  764.       IF carry%<>-1
  765.         ix%=i_explorer%*xdim%+xleft%
  766.         iy%=j_explorer%*ydim%+ytop%
  767.         DEFFILL 5
  768.         GET ix%+1,iy%+1,ix%+xdim%-1,iy%+ydim%-1,lastblock$
  769.         PUT ix%+1,iy%+1,ansblock$
  770.       ENDIF
  771.       COLOR 3
  772.       DEFTEXT 4
  773.       @draw_explorer
  774.     ENDIF
  775.   ENDIF
  776. ENDIF
  777. shift_exit:
  778. RETURN
  779. > PROCEDURE draw_explorer
  780. LOCAL ix%,iy%
  781. ix%=i_explorer%*xdim%+xleft%
  782. iy%=j_explorer%*ydim%+ytop%
  783. BOX ix%,iy%,ix%+xdim%,iy%+ydim%
  784. '  IF carry%>0
  785. ' TEXT ix%+7,iy%+9,STR$(carry%)
  786. ' ENDIF
  787. RETURN
  788. > PROCEDURE run_game
  789. carry%=-1
  790. num_done%=1
  791. SETMOUSE 199,319
  792. exit%=0
  793. COLOR 3
  794. @draw_explorer
  795. lastblock$=""
  796. HIDEM
  797. REPEAT
  798.   scancode%=@stick_handler
  799.   IF scancode%<>0
  800.     shift_explorer(scancode%)
  801.     DELAY joystick_response
  802.   ENDIF
  803.   STICK 0
  804. UNTIL num_done%=prob_num% OR exit%=1
  805. '  @show_all_parameters
  806. RETURN
  807. > PROCEDURE write_prob_on_disk
  808. ' records problem
  809. LOCAL i%
  810. FILESELECT "*.dat","add"+STR$(file_write%)+".dat",name$
  811. OPEN "o",#1,name$
  812. IF name$<>""
  813.   PRINT #1,wid%
  814.   PRINT #1,height%
  815.   PRINT #1,pnum%
  816.   PRINT #1,i_explorer%
  817.   PRINT #1,j_explorer%
  818.   FOR i%=0 TO pnum%-1
  819.     PRINT #1,x_prob%(i%)
  820.     PRINT #1,y_prob%(i%)
  821.     PRINT #1,d_prob%(i%)
  822.   NEXT i%
  823.   INC file_write%
  824.   CLOSE #1
  825. ENDIF
  826. RETURN
  827. > PROCEDURE read_prob_from_disk
  828. LOCAL i%,name$
  829. '  IF nsongs%>0
  830. ' i%=RANDOM(nsongs%)
  831. ' @dosound(i%)
  832. ' ENDIF
  833. @clear_board
  834. name$="add"+STR$(file_num%)+".dat"
  835. IF EXIST(name$)
  836.   TEXT 1,8,"loading "+name$
  837.   OPEN "i",#1,name$
  838.   INPUT #1,wid%
  839.   INPUT #1,height%
  840.   INPUT #1,pnum%
  841.   INPUT #1,i_explorer_init%
  842.   INPUT #1,j_explorer_init%
  843.   FOR i%=0 TO pnum%-1
  844.     INPUT #1,x_prob%(i%)
  845.     INPUT #1,y_prob%(i%)
  846.     INPUT #1,d_prob%(i%)
  847.   NEXT i%
  848.   CLOSE #1
  849.   i_explorer%=i_explorer_init%
  850.   j_explorer%=j_explorer_init%
  851.   @display_problems
  852.   INC file_num%
  853.   file_ok%=1
  854. ELSE
  855.   TEXT 1,8,name$+" does not exist."
  856.   file_num%=1
  857.   file_ok%=0
  858. ENDIF
  859. RETURN
  860. '
  861. > PROCEDURE show_parameter(num%)
  862. ' show the current parameter in the top menu .
  863. GRAPHMODE 2
  864. SELECT num%
  865. CASE 1
  866.   TEXT 25,(num%+1)*10,"Instructions"
  867. CASE 2
  868.   TEXT 25,(num%+1)*10,"Difficulty"
  869.   PBOX 120,(num%)*10+2,200,(num%+1)*10+1
  870.   TEXT 120,(num%+1)*10,difficulty$(difficulty%)
  871. CASE 3
  872.   TEXT 25,(num%+1)*10,"Operation"
  873.   PBOX 120,(num%)*10+2,280,(num%+1)*10+1
  874.   TEXT 120,(num%+1)*10,operation$(operation%)
  875. CASE 4
  876.   TEXT 25,(num%+1)*10,"First file"
  877.   PBOX 120,(num%)*10+2,210,(num%+1)*10
  878.   TEXT 120,(num%+1)*10,"add"+STR$(file_num%)+".dat"
  879. CASE 5
  880.   TEXT 25,(num%+1)*10,"Response"
  881.   PBOX 120,(num%)*10+2,210,(num%+1)*10
  882.   TEXT 120,(num%+1)*10,STR$(joystick_response)
  883. CASE 7
  884.   TEXT 25,(num%+1)*10,"OK"
  885. CASE 8
  886.   TEXT 25,(num%+1)*10,"QUIT"
  887. ENDSELECT
  888. GRAPHMODE 0
  889. RETURN
  890. > PROCEDURE show_all_parameters
  891. ' display the menu with all its parameters.
  892. LOCAL i%,x1%,y1%,r%
  893. DEFTEXT 4,0,0,6
  894. DEFFILL 2
  895. PRBOX 0,0,319,199
  896. FOR i%=1 TO 8
  897.   @show_parameter(i%)
  898. NEXT i%
  899. GRAPHMODE 2
  900. PUT 150,70,add$,7
  901. TEXT 10,155,"Please turn volume up."
  902. GRAPHMODE 1
  903. RETURN
  904. > PROCEDURE select_parameters
  905. ' select and modify parameter using mouse.
  906. LOCAL choice%,highlight%,key$
  907. DEFFILL 0
  908. ' select character height
  909. DEFTEXT 1,0,0,6
  910. ' clear screen
  911. PBOX 0,0,319,199
  912. highlight%=0
  913. @show_all_parameters
  914. ' play music if any.
  915. '  @dosound
  916. SETMOUSE 10,185,0
  917. REPEAT
  918.   key$=""
  919.   REPEAT
  920.     key$=INKEY$
  921.     SHOWM
  922.     choice%=(MOUSEY-10)/10+1
  923.     ' highlight if mouse moved to a new parameter
  924.     IF highlight%<>choice%
  925.       DEFTEXT 4,0
  926.       show_parameter(highlight%)
  927.       DEFTEXT 5,0
  928.       show_parameter(choice%)
  929.       highlight%=choice%
  930.       show_help(choice%)
  931.     ENDIF
  932.     IF MOUSEK=0
  933.       tim%=TIMER
  934.     ENDIF
  935.   UNTIL MOUSEK<>0 OR key$<>""
  936.   ' left mouse button increases parameter value, right button decreases
  937.   IF MOUSEK=1
  938.     modify_parameter(choice%,1)
  939.   ENDIF
  940.   IF MOUSEK=2
  941.     modify_parameter(choice%,-1)
  942.   ENDIF
  943.   IF choice%<>6
  944.     show_parameter(choice%)
  945.   ENDIF
  946.   PAUSE 20
  947.   IF key$="e"
  948.     @design_control
  949.     choice%=1
  950.   ENDIF
  951.   IF key$="w"
  952.     @write_prob_on_disk
  953.     choice%=1
  954.   ENDIF
  955.   IF key$="r"
  956.     @display_problems
  957.     @run_game
  958.     @show_all_parameters
  959.     choice%=1
  960.   ENDIF
  961. UNTIL choice%=8 OR choice%=7
  962. DEFTEXT 1,0
  963. RETURN
  964. > PROCEDURE modify_parameter(num%,dir%)
  965. ' raise or lower selected parameter withen limits.
  966. '  LOCATE 1,1
  967. '  PRINT num%;
  968. SELECT num%
  969. CASE 1
  970.   @instructions
  971. CASE 2
  972.   difficulty%=difficulty%+dir%
  973.   IF difficulty%>2
  974.     difficulty%=0
  975.   ENDIF
  976.   IF difficulty%<0
  977.     difficulty%=2
  978.   ENDIF
  979. CASE 3
  980.   operation%=1-operation%
  981. CASE 4
  982.   file_num%=file_num%+dir%
  983.   IF file_num%<1
  984.     file_num%=1
  985.   ENDIF
  986. CASE 5
  987.   joystick_response=joystick_response+dir%*0.02
  988.   IF joystick_response<0
  989.     joystick_response=0
  990.   ELSE IF joystick_response>0.4
  991.     joystick_response=0.4
  992.   ENDIF
  993. CASE 7
  994.   @read_prob_from_disk
  995.   IF file_ok%=1
  996.     @run_game
  997.     '    @show_all_parameters
  998.   ELSE
  999.     PAUSE 50
  1000.   ENDIF
  1001. CASE 8
  1002.   quit%=1
  1003. ENDSELECT
  1004. RETURN
  1005. > PROCEDURE show_help(num%)
  1006. ' show running commentary on bottom of screen for menu.
  1007. PBOX 10,160,310,190
  1008. GRAPHMODE 2
  1009. IF num%>0 AND num%<9
  1010.   TEXT 10,170,help$(num%)
  1011. ELSE
  1012.   TEXT 10,170,help$(0)
  1013. ENDIF
  1014. TEXT 10,180,"Click left or right button."
  1015. RETURN
  1016. > PROCEDURE instructions
  1017. CLS
  1018. PRINT "Simple Addition  31-1-93"
  1019. PRINT
  1020. PRINT "The object is to move the answer"
  1021. PRINT "blocks using the joystick or arrow"
  1022. PRINT "keys to complete the arithmetic"
  1023. PRINT "problems. Pick up or drop the"
  1024. PRINT "answer block using the joystick"
  1025. PRINT "button or the Clr Home key."
  1026. PRINT "The Esc key allows you to exit"
  1027. PRINT "prematurely. The Undo key restarts"
  1028. PRINT "the puzzle."
  1029. PRINT
  1030. PRINT "The first four puzzles are trivial."
  1031. PRINT "The next five puzzles require a"
  1032. PRINT "little planning. From then on the"
  1033. PRINT "puzzles require both care and"
  1034. PRINT "planning."
  1035. PRINT
  1036. PRINT "....Click mouse button to continue"
  1037. PAUSE 30
  1038. REPEAT
  1039. UNTIL MOUSEK<>0
  1040. CLS
  1041. PRINT "For making your own problems,"
  1042. PRINT "access the editor by typing e"
  1043. PRINT "from the main menu. Enter the"
  1044. PRINT "dimensions of the screen (max"
  1045. PRINT "18 by 12). Use the control buttons"
  1046. PRINT "at the bottom of the screen to"
  1047. PRINT "reserve row, column, answer and"
  1048. PRINT "barrier areas."
  1049. PRINT "Clear button restarts editor, done"
  1050. PRINT "exits the editor. You may test the"
  1051. PRINT "current problem screen by typing r"
  1052. PRINT "from the main menu. The w key"
  1053. PRINT "produces an output file."
  1054. PRINT
  1055. PRINT "The program creates random problems"
  1056. PRINT "and places them and the answers"
  1057. PRINT "in the reserved areas."
  1058. PRINT
  1059. PRINT "The file addbak.pi1 contains "
  1060. PRINT "background pattterns. You can make"
  1061. PRINT "your own if you have a paint program."
  1062. PRINT
  1063. PRINT "...Click mouse button to continue."
  1064. PAUSE 30
  1065. REPEAT
  1066. UNTIL MOUSEK<>0
  1067. CLS
  1068. PRINT
  1069. PRINT "Programmed by Seymour Shlien"
  1070. PRINT "        624 Courtenay Avenue"
  1071. PRINT "       Ottawa, Canada K2A 3B5"
  1072. PRINT
  1073. PRINT "The program and the sources are public"
  1074. PRINT "domain."
  1075. PRINT
  1076. PRINT "...Click mouse button to continue."
  1077. PAUSE 30
  1078. REPEAT
  1079. UNTIL MOUSEK<>0
  1080. CLS
  1081. @show_all_parameters
  1082. RETURN
  1083. > PROCEDURE load_degas_pi1(file$)
  1084. '
  1085. IF EXIST(file$)
  1086.   OPEN "i",#1,file$
  1087.   s$=INPUT$(2,#1)
  1088.   m__current_colors$=INPUT$(32,#1)
  1089.   s$=INPUT$(32000,#1)
  1090.   CLOSE #1
  1091.   VSYNC
  1092.   ~XBIOS(5,L:frame_ptr%(1),L:-1,-1)
  1093.   SPUT s$
  1094.   ~XBIOS(5,L:frame_ptr%(0),L:-1,-1)
  1095. ELSE
  1096.   PRINT file$+" was not found."
  1097.   PAUSE 200
  1098. ENDIF
  1099. RETURN
  1100. > PROCEDURE random_pattern(ix1%,iy1%,ix2%,iy2%)
  1101. LOCAL i%,j%,ni%,nj%
  1102. ~XBIOS(5,L:frame_ptr%(1),L:-1,-1)
  1103. i%=RANDOM(300)
  1104. j%=RANDOM(180)
  1105. GET i%,j%,i%+20,j%+20,pattern$
  1106. ~XBIOS(5,L:frame_ptr%(0),L:-1,-1)
  1107. nx1%=(ix2%-ix1%)/20
  1108. ny1%=(iy2%-iy1%)/20
  1109. FOR i%=0 TO nx1%
  1110.   FOR j%=0 TO ny1%
  1111.     PUT ix1%+i%*20,iy1%+j%*20,pattern$
  1112.   NEXT j%
  1113. NEXT i%
  1114. RETURN
  1115.