home *** CD-ROM | disk | FTP | other *** search
/ Windows CE - The Ultimate Companion / ROMMAN_CE.iso / Files / Programming / Basice / Digger / DIGGER09.BAS next >
BASIC Source File  |  1997-12-10  |  19KB  |  781 lines
  1. call clrscr
  2. wait 0.2
  3. dim board%[256]         ! the whole 16x16 board status flag
  4.  
  5. hiscore%=0
  6. no_file%=0
  7. call read_hi
  8.  
  9. if hiscore%<100 or no_file%=1 then
  10.    hiscore%=100 
  11. endif
  12.  
  13. !********** Possible board%[n] **********!
  14. ! 0 digged (empty)
  15. ! 1 (undigged) sand
  16. ! 2 undigged sand with diamond
  17. call init
  18. quit% = 0
  19. fail% = 0
  20.  
  21. call show_face
  22. loop 
  23.  call init_level
  24.  call init_diamond
  25.  call init_magic
  26.  call draw_frame
  27.  call draw_base
  28.  call score
  29.  call draw_digger
  30.  call draw_predator
  31.  
  32.  loop
  33.     k$=key$
  34.     k%=asc%(k$,1)
  35.     change% = 0
  36.  
  37.     ! escape the program !
  38.     if k%=27 then
  39.        quit% = 1
  40.     endif
  41.  
  42.     ! move the digger around !
  43.     if ((k%=37) and (xx%>1)) then
  44.         xx% = xx%-1
  45.         change% = 1
  46.     endif
  47.     if ((k%=38) and (yy%>1)) then
  48.         yy% = yy%-1
  49.         change% = 1
  50.     endif
  51.     if ((k%=39) and (xx%<16)) then
  52.         xx% = xx%+1
  53.         change% = 1
  54.     endif
  55.     if ((k%=40) and (yy%<16)) then
  56.         yy% = yy%+1
  57.         change% = 1
  58.     endif
  59.  
  60.     if (change%=1)  then
  61.         moveleft% = moveleft%-1
  62.  
  63.         ! if scored and check if this level is finished !
  64.         if (board%[(yy%-1)*16+xx%]=2)  then
  65.            moveleft% = 0
  66.            dstep% = 1
  67.            score% = score%+20
  68.            ate% = ate%+1
  69.            call score
  70.            if (ate%=dnum%)  then
  71.              nextlevel% = 1
  72.            endif
  73.         endif
  74.  
  75.         ! digger is qualified for additional move ? !
  76.         if (board%[(yy%-1)*16+xx%]=0) then
  77.             dstep% = 3
  78.         endif
  79.         if (board%[(yy%-1)*16+xx%]=1) then
  80.             dstep% = 2
  81.         endif
  82.  
  83.         ! if digger got magic !
  84.         if (board%[(yy%-1)*16+xx%]=3) and (magic%=0) then
  85.            magic% = 1
  86.            magicstep% = 0
  87.         endif
  88.  
  89.         ! check if magic runs out !
  90.         if (magic%=1) then
  91.            magicstep% = magicstep%+1
  92.            reststep% = 16-level%-magicstep%
  93.            if (reststep%>0)  then
  94.               call curpos(52,17)
  95.               print reststep%-1" magic left";
  96.            else
  97.               magic% = 0
  98.               call curpos(52,17)
  99.               print "               ";
  100.            endif
  101.         endif
  102.  
  103.         ! see if the predator should be moved !
  104.         if (moveleft%<1) then
  105.              call move_predator
  106.              call draw_predator
  107.              moveleft% = dstep%
  108.         endif
  109.  
  110.         ! see if ghost should appear !
  111.         if (ghoston%=0)  then
  112.            ! first see sand and diamond left to set probability !
  113.            space% = 0 
  114.            loop for i%=1 to 256
  115.               space% = space%+board%[i%]
  116.            endloop
  117.  
  118.            call random
  119.            if (mod%(rand%, 256+dnum%)>space%)  then
  120.                ghoston% = 1
  121.                ghoststep% = 0
  122.                call set_ghost
  123.                if (ghoston%=1)  then
  124.                   call draw_ghost
  125.                   call curpos (43,17)
  126.                   print "GHOST!";
  127.                endif
  128.            endif
  129.         endif
  130.  
  131.         ! move the ghost, check if it should be off !
  132.         if (ghoston%=1)  then
  133.            if (ghoststep%>(dnum%+dnum%/2))  then
  134.               ! or (xg%<1) or (yg%<1) or (xg%>16) or (yg%>16)) then
  135.                ghoston% = 0
  136.                call die_ghost
  137.                call curpos (43,17)
  138.                print "      ";
  139.            else
  140.                call move_ghost
  141.                call draw_ghost
  142.                ghoststep% = ghoststep%+1
  143.            endif
  144.         endif
  145.              
  146.         ! move the digger ! 
  147.         board%[(yy%-1)*16+xx%]=0
  148.         call draw_digger
  149.         call curpos (25,17)
  150.         print moveleft%" more step(s)";
  151.  
  152.         ! check if failed (being caught by predator) !
  153.         if ((abs(xc%-xx%)+abs(yc%-yy%))<2) and (magic%=0) then
  154.            fail% = 1
  155.         endif
  156.  
  157.         ! check if got magic bite !
  158.         if ((abs(xc%-xx%)+abs(yc%-yy%))<1) and (magic%=1)  then
  159.            score%=score%+50
  160.            call score
  161.            magic%=0
  162.            call curpos(52,17)
  163.            print "               ";
  164.            oldxc% = 8
  165.            oldyc% = 8
  166.            xc% = 8
  167.            yc% = 8
  168.         endif
  169.  
  170.         ! check if being caught by ghost !
  171.         if (ghoston%=1) and ((abs(xg%-xx%)+abs(yg%-yy%))<2)  then
  172.            moveleft% = 1
  173.            dstep% = 1 
  174.            score% = score%-10
  175.            call score
  176.         endif
  177.  
  178.     endif
  179.     wait 0.01
  180.  
  181.     while (fail%=0) and (quit%=0) and (nextlevel%=0)
  182.  endloop
  183.  
  184.  while (quit%=0) and (fail%=0) and (level%<maxlevel%)
  185. endloop
  186.  
  187. if (fail%=1) then
  188.   call explode(xx%, yy%)
  189.   wait 0.5
  190.   call draw_grid(xx%, yy%)
  191.   wait 0.5
  192.   call explode(xx%, yy%)
  193.   wait 1.0
  194. endif
  195.  
  196. print "Q"+chr$(32);
  197. call fillrect(160,40,320,120)
  198. print "Q"+chr$(35);
  199. call line(160,40,160,120)
  200. call line(320,40,320,120)
  201. call line(160,40,320,40)
  202. call line(160,120,320,120)
  203.  
  204. if (score%>hiscore%) then
  205.   call curpos(30, 7)
  206.   print "NEW HI-SCORE: "score%;
  207.   hiscore%=score%
  208.   call save_hi
  209. else
  210.   call curpos(32, 7)
  211.   print "SCORE:"score%;
  212. endif
  213.  
  214. call curpos(30, 9)
  215. print "press any key to exit"
  216. loop 
  217.   k$ = key$
  218.   wait 0.1
  219.   while len%(k$)=0
  220. endloop
  221.  
  222. call clrscr
  223. call curpos(0,2)
  224. print"Thanks for playing digger"
  225. print"email: lrong@watfast.uwaterloo.ca"
  226. print""
  227. ! end of program !
  228.  
  229. !----- PROCEDURES -------
  230.  
  231. procedure show_face
  232.    call curpos(0,0)
  233.    print "DIGGER V0.9";
  234.    call curpos(0, 1)
  235.    print " L. Rong ";
  236.    call curpos(0,2)
  237.    print "  1997";
  238.    call curpos(4,4)
  239.    print "digger";
  240.    call curpos(4,6)
  241.    print "predator";
  242.    call curpos(4,8)
  243.    print "ghost";
  244.    call curpos(4,10)
  245.    print "diamond";
  246.    call curpos(4,12)
  247.    print "magic";
  248.    call shape_digger(0, 40)
  249.    call shape_predator(0,59)
  250.    call shape_ghost(0,78)
  251.    call shape_diamond(0,97)
  252.    call shape_magic(0, 116)
  253. endproc
  254.  
  255. procedure random
  256.   rand% = rand%*25173+13849
  257.   rand% = mod%(rand%,65536)
  258. endproc 
  259.  
  260. ! move the predator close to digger
  261. procedure move_predator
  262.   dx% = xx%-xc%
  263.   dy% = yy%-yc%
  264.   adx% = abs(dx%)
  265.   ady% = abs(dy%)
  266.  
  267.   if (magic%=0) then 
  268.     if (adx%>ady%) then
  269.        step% = dx%/adx%
  270.        xc% = xc%+step%
  271.     else
  272.        step% = dy%/ady%
  273.        yc% = yc%+step%
  274.     endif 
  275.   else
  276.     if (xc%>xx%) and (xc%<16) then
  277.         xc% = xc%+1
  278.     else
  279.       if (yc%>yy%) and (yc%<16) then
  280.             yc% = yc%+1
  281.       else
  282.         if (xc%<xx%) and (xc%>1) then
  283.             xc% = xc%-1
  284.         else
  285.           if (yc%<yy%) and (yc%>1) then
  286.               yc% = yc%-1
  287.           else
  288.             if (adx%>ady%) then
  289.                 step% = dx%/adx%
  290.                 xc% = xc%+step%
  291.             else
  292.                 if (ady%=0) then
  293.                   step% = 0
  294.                 else
  295.                   step% = dy%/ady%
  296.                 endif
  297.                 yc% = yc%+step%
  298.             endif 
  299.           endif
  300.         endif
  301.       endif
  302.     endif
  303.   endif
  304. endproc
  305.  
  306. ! find the next move for the ghost 
  307. procedure move_ghost
  308.   mleft% = 0
  309.   mright% = 0
  310.   mtop% = 0
  311.   mdown% = 0
  312.  
  313.   ! check left space for digged place ! 
  314.   if (xg%>1)  then
  315.     if (board%[(yg%-1)*16+xg%-1]=0) then
  316.         mleft% = mleft%+20
  317.     endif
  318.   endif
  319.  
  320.   ! check right space for digged place ! 
  321.   if (xg%<16)  then
  322.     if (board%[(yg%-1)*16+xg%+1]=0) then
  323.         mright% = mright%+20
  324.     endif
  325.   endif
  326.  
  327.   ! check top space for digged place ! 
  328.   if (yg%>1)  then
  329.     if (board%[(yg%-2)*16+xg%]=0) then
  330.         mtop% = mtop%+20
  331.     endif
  332.   endif
  333.  
  334.   ! check down space for digged place ! 
  335.   if (yg%<16)  then
  336.     if (board%[yg%*16+xg%]=0) then
  337.         mdown% = mdown%+20
  338.     endif
  339.   endif
  340.  
  341.   ! check ghost's relative position to the digger !
  342.   if (xx%>xg%) then
  343.      mright% = mright%+(xx%-xg%)
  344.   else
  345.      mleft% = mleft%+(xg%-xx%)
  346.   endif
  347.  
  348.   if (yy%>yg%) then
  349.      mdown% = mdown%+(yy%-yg%)
  350.   else
  351.      mtop% = mtop%+(yg%-yy%)
  352.   endif
  353.  
  354.   ! make sure ghost not move out of board
  355.   if (xg%=1)   then  mleft% = -400    endif
  356.   if (xg%=16)  then  mright% = -400   endif
  357.   if (yg%=1)   then  mtop% = -400     endif
  358.   if (yg%=16)  then  mdown% = -400    endif
  359.  
  360.   ! now select the direction with highest score
  361.   oldxg% = xg%
  362.   oldyg% = yg%
  363.   if (mleft%>=mright%) and (mleft%>=mtop%) and (mleft%>=mdown%)  then
  364.       xg% = xg%-1
  365.   endif
  366.   if (mright%>=mleft%) and (mright%>=mtop%) and (mright%>=mdown%)  then
  367.       xg% = xg%+1
  368.   endif
  369.   if (mtop%>=mleft%) and (mtop%>=mright%) and (mtop%>=mdown%)  then
  370.       yg% = yg%-1
  371.   endif
  372.   if (mdown%>=mleft%) and (mdown%>=mright%) and (mdown%>=mtop%)  then
  373.       yg% = yg%+1
  374.   endif
  375. endproc
  376.  
  377. ! find an initial coordinate of ghost !
  378. procedure set_ghost
  379.     call random
  380.     m%=mod%(rand%, 256)
  381.     pxg% = mod%(m%, 16)+1
  382.     pyg% = m%/16+1
  383.  
  384.     if (board%[m%+1]=0 and ((abs(pxg%-xx%)+abs(pyg%-yy%))>1))  then 
  385.        xg% = pxg%
  386.        yg% = pyg%
  387.     else
  388.        ! search for lower empty places !
  389.        loop for i%=1 to m%+1
  390.          pxg% = mod%(i%-1, 16)+1
  391.          pyg% = (i%-1)/16+1
  392.          if ((board%[i%]=0) and ((abs(pxg%-xx%)+abs(pyg%-yy%))>1))  then 
  393.              m1% = i%-1
  394.              break
  395.          endif
  396.        endloop
  397.  
  398.        ! search for higher empty places !
  399.        loop for i%=m%+1 to 256
  400.          pxg% = mod%(i%-1, 16)+1
  401.          pyg% = (i%-1)/16+1
  402.          if ((board%[i%]=0) and ((abs(pxg%-xx%)+abs(pyg%-yy%))>1))  then 
  403.              m2% = i%-1
  404.              break
  405.          endif
  406.        endloop
  407.  
  408.        ! select one of place
  409.        xg1% = mod%(m1%, 16)+1
  410.        yg1% = m1%/16+1
  411.        xg2% = mod%(m2%, 16)+1
  412.        yg2% = m2%/16+1
  413.        dis1% = abs(xg1%-xx%)+abs(yg1%-yy%)
  414.        dis2% = abs(xg2%-xx%)+abs(yg2%-yy%)
  415.        if  (dis1%>dis2%) and (board%[m1%+1]=0) and (dis1%>2)  then
  416.           xg% = xg1%
  417.           yg% = yg1%
  418.        else
  419.           if (dis1%<=dis2%) and (board%[m2%+1]=0) and (dis2%>2)  then
  420.              xg% = xg2%
  421.              yg% = yg2%
  422.           else
  423.              ghoston% = 0
  424.           endif
  425.        endif
  426.     endif
  427. endproc
  428.  
  429. procedure draw_frame
  430.   print "Q"+chr$(32);
  431.   call fillrect(75,4,402,166) 
  432.  
  433.   print "Q"+chr$(35);
  434.   call line(75,166,402,166)
  435.   call line(75,4,402,4)
  436.   call line(75,4,75,166)
  437.   call line(402,4,402,166)
  438. endproc
  439.  
  440. procedure draw_base
  441.  loop for j%=1 to 16
  442.    loop for i%=1 to 16
  443.       call draw_grid(i%, j%)
  444.    endloop
  445.  endloop
  446. endproc
  447.  
  448. procedure draw_grid(ii%, jj%)
  449.   ! Draw grid (ii, jj) !
  450.   xs% = (ii%-1)*20+80
  451.   ys% = (jj%-1)*10+5
  452.  
  453.   ! empty places
  454.   if (board%[(jj%-1)*16+ii%]=0)  then
  455.      print "Q"+chr$(32);
  456.      call fillrect(xs%,ys%,xs%+20,ys%+10)
  457.   endif
  458.  
  459.   ! draw sand
  460.   if (board%[(jj%-1)*16+ii%]>0)  then
  461.      print "Q"+chr$(35);
  462.      call plot(xs%, ys%+2)
  463.      call plot(xs%+5, ys%+2)
  464.      call plot(xs%+10, ys%+2)
  465.      call plot(xs%+15, ys%+2)
  466.      call plot(xs%, ys%+4)
  467.      call plot(xs%+5, ys%+7)
  468.      call plot(xs%+10, ys%+7)
  469.      call plot(xs%+15, ys%+7)
  470.   endif
  471.  
  472.   ! draw diamond
  473.   if (board%[(jj%-1)*16+ii%]=2)  then
  474.      call draw_diamond(ii%, jj%)
  475.   endif
  476.  
  477.   ! draw magic
  478.   if (board%[(jj%-1)*16+ii%]=3)  then
  479.      call draw_magic(ii%, jj%)
  480.   endif
  481. endproc
  482.  
  483. ! draw diamond at (id, jd) !
  484. procedure draw_diamond(id%, jd%)
  485.   xs% = (id%-1)*20+80
  486.   ys% = (jd%-1)*10+5
  487.   call shape_diamond(xs%, ys%)
  488. endproc 
  489.  
  490. ! draw magic at (id, jd) !
  491. procedure draw_magic(id%, jd%)
  492.   xs% = (id%-1)*20+80
  493.   ys% = (jd%-1)*10+5
  494.   call shape_magic(xs%, ys%)
  495. endproc 
  496.  
  497. procedure shape_diamond(xs%, ys%)
  498.   print "Q"+chr$(35);
  499.   call line(xs%+5, ys%+5, xs%+10, ys%+10)
  500.   call line(xs%+15, ys%+5, xs%+10, ys%+10)
  501.   call line(xs%+5, ys%+5, xs%+10, ys%)
  502.   call line(xs%+15, ys%+5, xs%+10, ys%)
  503.   call line(xs%+5, ys%+5, xs%+15, ys%+5)
  504. endproc
  505.  
  506. procedure shape_magic(xs%, ys%)
  507.   print "Q"+chr$(35);
  508.   call line(xs%+7, ys%, xs%+13, ys%)
  509.   call line(xs%+13, ys%, xs%+11, ys%+3)
  510.   call line(xs%+11, ys%+3, xs%+16, ys%+9)
  511.   call line(xs%+16, ys%+9, xs%+4, ys%+9)
  512.   call line(xs%+4, ys%+9, xs%+9, ys%+3)
  513.   call line(xs%+9, ys%+3, xs%+7, ys%)
  514. endproc
  515.  
  516. procedure draw_ghost
  517.   ! first let old ghost place filled with sand ! 
  518.   print "Q"+chr$(32);
  519.   xs% = (oldxg%-1)*20+80
  520.   ys% = (oldyg%-1)*10+5
  521.   call fillrect(xs%, ys%, xs%+20, ys%+10)
  522.  
  523.   if board%[(oldyg%-1)*16+oldxg%]=0  then 
  524.      board%[(oldyg%-1)*16+oldxg%]=1
  525.   endif
  526.   call draw_grid(oldxg%, oldyg%)
  527.   
  528.   ! now at new place draw the ghost
  529.   xs% = (xg%-1)*20+80
  530.   ys% = (yg%-1)*10+5
  531.   call shape_ghost(xs%,ys%)
  532. endproc
  533.  
  534. procedure shape_ghost(xs%, ys%)
  535.   print "Q"+chr$(35);
  536.   call line(xs%+7, ys%, xs%+13, ys%)
  537.   call line(xs%+13, ys%, xs%+10, ys%+3)
  538.   call line(xs%+10, ys%+3, xs%+7, ys%)
  539.   call line(xs%+3, ys%+4, xs%+17, ys%+4)
  540.   call line(xs%+7, ys%+10, xs%+10, ys%+5)
  541.   call line(xs%+13, ys%+10, xs%+10, ys%+5)
  542. endproc
  543.  
  544. procedure die_ghost
  545.   ! draw the "white" ghost
  546.   print "Q"+chr$(32);
  547.   xs% = (xg%-1)*20+80
  548.   ys% = (yg%-1)*10+5
  549.   call line(xs%+7, ys%, xs%+13, ys%)
  550.   call line(xs%+13, ys%, xs%+10, ys%+3)
  551.   call line(xs%+10, ys%+3, xs%+7, ys%)
  552.   call line(xs%+3, ys%+4, xs%+17, ys%+4)
  553.   call line(xs%+7, ys%+10, xs%+10, ys%+5)
  554.   call line(xs%+13, ys%+10, xs%+10, ys%+5)
  555. endproc
  556.  
  557. procedure draw_digger
  558.   ! first erase old digger at (oldxx, oldyy) !
  559.   print "Q"+chr$(32);
  560.   xs% = (oldxx%-1)*20+80
  561.   ys% = (oldyy%-1)*10+5
  562.   call fillrect(xs%, ys%, xs%+20, ys%+10)
  563.  
  564.   ! clear (newly digged) the new place at (xx, yy) !
  565.   print "Q"+chr$(32);
  566.   xs% = (xx%-1)*20+80
  567.   ys% = (yy%-1)*10+5
  568.   call fillrect(xs%, ys%, xs%+20, ys%+10)
  569.  
  570.   ! Draw the digger at (xx, yy) !
  571.   xs% = (xx%-1)*20+80
  572.   ys% = (yy%-1)*10+5
  573.   call shape_digger(xs%,ys%)
  574.  
  575.   ! update the digger's "old" coordinate !
  576.   oldxx% = xx%
  577.   oldyy% = yy%
  578. endproc
  579.  
  580. procedure shape_digger(xs%, ys%)
  581.   print "Q"+chr$(35);
  582.   call fillrect(xs%+5, ys%, xs%+15, ys%+5)
  583.   call fillrect(xs%, ys%+5, xs%+20, ys%+10)
  584. endproc
  585.  
  586. procedure draw_predator
  587.   ! first erase old predator at (oldxc, oldyc) !
  588.   xs% = (oldxc%-1)*20+80
  589.   ys% = (oldyc%-1)*10+5
  590.   print "Q"+chr$(32);
  591.   call fillrect(xs%,ys%,xs%+20,ys%+10)
  592.   call draw_grid(oldxc%, oldyc%)
  593.  
  594.   ! Draw the predator at (xc, yc) !
  595.   xs% = (xc%-1)*20+80
  596.   ys% = (yc%-1)*10+5
  597.   call shape_predator(xs%,ys%)
  598.  
  599.   oldxc% = xc%
  600.   oldyc% = yc%
  601. endproc
  602.  
  603. procedure shape_predator(xs%,ys%)
  604.   print "Q"+chr$(35);
  605.   call line(xs%+1, ys%+2, xs%+10, ys%+10)
  606.   call line(xs%+19, ys%+2, xs%+10, ys%+10)
  607.   call line(xs%+1, ys%+7, xs%+10, ys%)
  608.   call line(xs%+19, ys%+7, xs%+10, ys%)
  609.   call line(xs%+1, ys%+2, xs%+1, ys%+7)
  610.   call line(xs%+19, ys%+2, xs%+19, ys%+7)
  611. endproc
  612.  
  613. procedure explode(hx%, hy%)
  614.    xs% = (hx%-1)*20+80
  615.    ys% = (hy%-1)*10+5
  616.    print "Q"+chr$(32);
  617.    call fillrect(xs%,ys%,xs%+20,ys%+10)
  618.    print "Q"+chr$(35);
  619.    call line(xs%,ys%+5,xs%+8,ys%+5)
  620.    call line(xs%,ys%,xs%+8,ys%+4)
  621.    call line(xs%+10,ys%,xs%+10,ys%+4)
  622.    call line(xs%+20,ys%,xs%+12,ys%+4)
  623.    call line(xs%+20,ys%+5,xs%+12,ys%+5)
  624.    call line(xs%+20,ys%+10,xs%+12,ys%+6)
  625.    call line(xs%+10,ys%+10,xs%+10,ys%+6)
  626.    call line(xs%,ys%+10,xs%+8,ys%+6)
  627. endproc
  628.  
  629. procedure score
  630.    print "Q"+chr$(35);
  631.    call curpos(2,17)
  632.    print"            ";
  633.    call curpos(2,17)
  634.    print"SCORE:"score%;
  635.    call curpos (15,17)
  636.    print"LEVEL:"level%;
  637.    call curpos(68,17)
  638.    print"HIGH:"hiscore%;
  639. endproc
  640.  
  641. procedure init
  642.    maxlevel%=10
  643.    score%=0
  644.    level%=0
  645.    dnum%=10
  646. endproc
  647.  
  648. procedure init_level
  649.         dnum%=dnum%+(level%*2)
  650.     level%=level%+1
  651.  
  652.         ! pseudo random seed by timer
  653.         curtime$ = dtime$(0)
  654.         rand%=asc%(mid$(curtime$, 19, 1), 1)+level%
  655.  
  656.         ! fill the board with sand !
  657.     loop for i%=1 to 256
  658.            board%[i%] = 1
  659.         endloop
  660.        
  661.         ! position the digger !
  662.         xx% = 16
  663.         yy% = 16
  664.         oldxx% = 16
  665.         oldyy% = 16
  666.  
  667.         ! position the predator !
  668.         xc% = 8
  669.         yc% = 8
  670.         oldxc% = 8
  671.         oldyc% = 8
  672.  
  673.         ! position the ghost !
  674.         xg% = 1
  675.         yg% = 1
  676.         oldxg% = 1
  677.         oldyg% = 1
  678.  
  679.         ! some initial values !
  680.         dstep% = 2
  681.         moveleft% = dstep%
  682.         nextlevel% = 0
  683.         ate% = 0
  684.         ghoston% = 0
  685.         ghoststep% = 0
  686.         magic% = 0
  687.         magicstep% = 0
  688.         call curpos (43,17)
  689.         print "      ";
  690.         call curpos(52,17)
  691.         print "               ";
  692. endproc
  693.  
  694. procedure init_diamond
  695.   n%=0
  696.   loop
  697.     call random
  698.     m%=mod%(rand%, 256)+1
  699.     if ((board%[m%]=1) and (m%<>120)) then
  700.       board%[m%]=2
  701.       n%=n%+1
  702.     endif
  703.     while n%<dnum%
  704.   endloop
  705. endproc
  706.  
  707. procedure init_magic
  708.   mnum% = 3-level%/3
  709.   if mnum%<1 then
  710.     mnum% = 1
  711.   endif
  712.  
  713.   n%=0
  714.   loop
  715.     call random
  716.     m%=mod%(rand%, 256)+1
  717.     if ((board%[m%]=1) and (m%<>120)) then
  718.       board%[m%]=3
  719.       n%=n%+1
  720.     endif
  721.     while n%<mnum%
  722.   endloop
  723. endproc
  724.  
  725. procedure plot(px%,py%)        ! Clone of POINT !
  726.    print "P"+chr$(shift%(px%,-6)+1)+chr$((px% and 63)+1)+\
  727.                          chr$(shift%(py%,-6)+1)+chr$((py% and 63)+1);
  728. endproc
  729.  
  730. procedure read_hi
  731.     done%=0
  732.     ON "ERROR" CALL ERR_HANDLER
  733.     OPEN "\\digger.hsc",1
  734.     if(done%) then return endif
  735.         INPUT #1,dt#
  736.         hiscore%=dt#
  737.     close 1
  738. endproc
  739.  
  740. procedure save_hi
  741.     done%=0
  742.     ON "ERROR" CALL ERR_HANDLER
  743.      CREATE "\\digger.hsc",1
  744.     if(done%) then return endif
  745.         dt#=hiscore%
  746.         print #1,dt#
  747.         print #1,"degger hi-score file"
  748.     close 1
  749. endproc
  750.  
  751. PROCEDURE ERR_HANDLER
  752.   no_file%=1
  753.   done%=1
  754. ENDPROC
  755.  
  756. ! BasiCE library files already included here. Just in case !
  757.  
  758. procedure clrscr
  759.    print "C";
  760. endproc
  761.  
  762. procedure line( x1%,y1%,x2%,y2%)
  763.    print "L";chr$(shift%(x1%,-6)+1);chr$((x1% and 63)+1);\
  764.               chr$(shift%(y1%,-6)+1);chr$((y1% and 63)+1);
  765.  
  766.    print      chr$(shift%(x2%,-6)+1);chr$((x2% and 63)+1);\
  767.               chr$(shift%(y2%,-6)+1);chr$((y2% and 63)+1);
  768. endproc
  769.  
  770. procedure fillrect( x1%,y1%,x2%,y2%)
  771.    print "R";chr$(shift%(x1%,-6)+1);chr$((x1% and 63)+1);\
  772.               chr$(shift%(y1%,-6)+1);chr$((y1% and 63)+1);
  773.  
  774.    print      chr$(shift%(x2%,-6)+1);chr$((x2% and 63)+1);\
  775.               chr$(shift%(y2%,-6)+1);chr$((y2% and 63)+1);
  776. endproc
  777.  
  778. procedure curpos(c%,r%)
  779.    print "G";chr$(c%+1);chr$(r%+1);
  780. endproc
  781.