home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / ST_USER / 1990 / USEROC90.MSA / LISTINGS_RUBICLOC.BSC < prev    next >
Text File  |  1990-08-19  |  5KB  |  171 lines
  1. REM RUBIC'S CLOCK
  2.  
  3. ESCAPE OFF:CLEAR 512
  4. IF SCREENMODE<>2 THEN PRINT "Set screenmode to hires.":END
  5. PROCpreamble:PROCinit:PROCscreen:done%=FALSE
  6. REPEAT
  7.     REPEAT:MOUSE x%,y%,b%,k%:UNTIL  k%=4 OR b%=1 OR b%=2
  8.         IF k%=4 THEN CLG 0:END
  9.         PROCselectbutton
  10.         PROCselectwheel
  11.     REPEAT:MOUSE x%,y%,b%,k%:UNTIL b%=0
  12. UNTIL done%
  13. TXTSIZE 26:PRINT TAB(0,10);
  14.     PRINT " Well done!-You have solved the puzzle. ";    
  15. g=GET:CLG 0:END
  16.  
  17. DEF PROCscreen
  18.     FILLSTYLE 2,2:CIRCLE 160,160,150:CIRCLE 480,160,150
  19.     FILLSTYLE 0,0
  20.     FOR y%=120 TO 200 STEP 80:FOR x%=120 TO 200 STEP 80
  21.         CIRCLE x%,y%,11:GTXT x%,y%-2,"U"
  22.         CIRCLE x%+320,y%,11:GTXT x%+320,y%-2,"D"
  23.     NEXT:NEXT
  24.     FOR clock%=1 TO 18
  25.         CIRCLE cx%(clock%),cy%(clock%),32    
  26.     NEXT
  27.     PROCclocks
  28.     GTXTSIZE 26:GTXT 320,8,"RUBIK CLOCK"
  29.     GTXTSIZE 13:GTXT 60,10,"FRONT FACE":GTXT 580,10,"BACK FACE"
  30.     a$="TURN"
  31.     FOR y%=40 TO 275 STEP 235
  32.         GTXT 40,y%,a$:GTXT 285,y%,a$:GTXT 360,y%,a$:GTXT 605,y%,a$
  33.     NEXT    
  34.     PRINT TAB(1,20);"Click on U/D buttons to toggle between Up and Down.";
  35.     PRINT "(PRESS CONTROL TO QUIT.)"
  36.     PRINT TAB(1);"Click on TURN to turn clocks.";
  37.     PRINT "(Left-hand anticlockwise,right-hand clockwise.)"
  38.     PRINT TAB(10);"Set all the clocks to 12 o'clock ";
  39.     PRINT "to complete the puzzle."
  40. ENDPROC
  41.  
  42. DEF PROCinit
  43.     DIM clock%(18),cx%(18),cy%(18),turn%(18),butt%(7),bx%(7),by%(7),hx%(12),hy%(12)
  44.     PROChourxy
  45.     FOR clock%=1 TO 18
  46.         clock%(clock%)=clock%:IF clock%>9 THEN clock%(clock%)=21-clock%
  47.         READ cx%(clock%),cy%(clock%)
  48.         turn%(clock%)=1:IF clock%>9 THEN turn%(clock%)=-1
  49.     NEXT
  50. DATA 80,80,160,80,240,80,240,160,240,240,160,240,80,240,80,160,160,160
  51. DATA 560,80,480,80,400,80,400,160,400,240,480,240,560,240,560,160,480,160
  52.     FOR butt%=1 TO 7 STEP 2
  53.         butt%(butt%)=-1
  54.         READ bx%(butt%),by%(butt%)    
  55.     NEXT
  56.     DATA 120,120,200,120,200,200,120,200
  57. ENDPROC
  58.  
  59. DEF PROCselectbutton
  60.     butt%=0:bx%=0:by%=0
  61.     IF x%>109 AND x%<131 THEN bx%=1
  62.     IF x%>189 AND x%<211 THEN bx%=3
  63.     IF x%>429 AND x%<451 THEN bx%=3
  64.     IF x%>509 AND x%<521 THEN bx%=1
  65.     IF y%>109 AND y%<131 THEN by%=1
  66.     IF y%>189 AND y%<211 THEN by%=7
  67.     butt%=bx%*by%:IF butt%>7 THEN butt%=5
  68.     IF butt%>0 THEN PROCbutt
  69. ENDPROC
  70.  
  71. DEF PROCselectwheel
  72.     wheel%=0:wx%=0:wy%=0
  73.     IF x%>17 AND x%<59 THEN wx%=1
  74.     IF x%>262 AND x%<305 THEN wx%=3
  75.     IF x%>336 AND x%<378 THEN wx%=12
  76.     IF x%>583 AND x%<625 THEN wx%=10
  77.     IF y%>34 AND y%<50 THEN wy%=1
  78.     IF y%>270 AND y%<286 THEN wy%=7
  79.     wheel%=wx%*wy%
  80.     IF wheel%=21 THEN wheel%=5
  81.     IF wheel%=84 THEN wheel%=14
  82.     IF wheel%=70 THEN wheel%=16
  83.     IF wheel%>0 THEN PROCturn
  84. ENDPROC
  85.         
  86. DEF PROCbutt
  87.     BEEP 
  88.     IF butt%(butt%)=-1 THEN
  89.         GTXT bx%(butt%),by%(butt%),"D":GTXT 640-bx%(butt%),by%(butt%),"U"
  90.     ELSE
  91.         GTXT bx%(butt%),by%(butt%),"U":GTXT 640-bx%(butt%),by%(butt%),"D"
  92.     ENDIF
  93.     butt%(butt%)=-butt%(butt%)
  94. ENDPROC
  95.                 
  96. DEF PROCturn
  97.     IF wheel%<10 THEN front%=2*b%-3 ELSE front%=3-2*b%
  98.     back%=-front%:IF wheel%>9 THEN wheel%=wheel%-9
  99.     b1%=wheel%:b2%=wheel%+2:IF b2%>7 THEN b2%=b2%-8
  100.     b3%=wheel%+4:IF b3%>7 THEN b3%=b3%-8
  101.     b4%=wheel%+6:IF b4%>7 THEN b4%=b4%-8
  102.     FOR clock%=1 TO 18:turn%(clock%)=0:NEXT
  103.     turn%(b1%)=front%:turn%(b1%+9)=back%
  104.     IF butt%(b1%)=-1 THEN
  105.         turn%(9)=front%:turn%(b1%+1)=front%:turn%(b4%+1)=front%
  106.         IF butt%(b2%)=-1 THEN
  107.             turn%(b1%+1)=front%:turn%(b2%)=front%:turn%(b2%+1)=front%
  108.             turn%(b2%+9)=back%
  109.         ENDIF
  110.         IF butt%(b3%)=-1 THEN
  111.             turn%(b2%+1)=front%:turn%(b3%)=front%:turn%(b3%+1)=front%
  112.             turn%(b3%+9)=back%
  113.         ENDIF
  114.         IF butt%(b4%)=-1 THEN
  115.             turn%(b3%+1)=front%:turn%(b4%)=front%:turn%(b4%+1)=front%
  116.             turn%(b4%+9)=back%
  117.         ENDIF                
  118.     ELSE
  119.         turn%(18)=back%:turn%(b1%+10)=back%:turn%(b4%+10)=back%
  120.         IF butt%(b2%)=1 THEN
  121.             turn%(b2%)=front%
  122.             turn%(b1%+10)=back%:turn%(b2%+9)=back%:turn%(b2%+10)=back%
  123.         ENDIF
  124.         IF butt%(b3%)=1 THEN
  125.             turn%(b3%)=front%
  126.             turn%(b2%+10)=back%:turn%(b3%+9)=back%:turn%(b3%+10)=back%    
  127.         ENDIF
  128.         IF butt%(b4%)=1 THEN
  129.             turn%(b4%)=front%
  130.             turn%(b3%+10)=back%:turn%(b4%+9)=back%:turn%(b4%+10)=back%
  131.         ENDIF    
  132.     ENDIF
  133.     BEEP:PROCclocks        
  134. ENDPROC
  135.  
  136. DEF PROCclocks
  137.     LINEENDS 0,1:done%=TRUE
  138.     FOR clock%=1 TO 18
  139.     IF turn%(clock%)<>0 THEN
  140.         hr%=clock%(clock%):LINECOL 0
  141. LINE cx%(clock%),cy%(clock%) TO cx%(clock%)+hx%(hr%),cy%(clock%)+hy%(hr%)        
  142.         hr%=hr%+turn%(clock%):IF hr%=0 THEN hr%=12
  143.         IF hr%=13 THEN hr%=1
  144.         clock%(clock%)=hr%:LINECOL 1
  145. LINE cx%(clock%),cy%(clock%) TO cx%(clock%)+hx%(hr%),cy%(clock%)+hy%(hr%)
  146.     ENDIF
  147.     IF clock%(clock%)<>12 THEN done%=FALSE
  148.     NEXT
  149. ENDPROC
  150.  
  151. DEF PROChourxy
  152.     FOR hr%=1 TO 12
  153.         ang%=90-30*hr%:IF ang%<0 THEN ang%=ang%+360
  154.         hx%=30*COS(RAD(ang%)):hy%=-30*SIN(RAD(ang%))
  155.         hx%(hr%)=hx%:hy%(hr%)=hy%
  156.     NEXT
  157. ENDPROC
  158.  
  159. DEF PROCpreamble
  160.     GRAFRECT 0,0,640,400:CLG 0:GTXTALIGN 1,1
  161.     TXTRECT 16,16,640,400:TXTSIZE 13
  162.     PRINT "RUBIK CLOCK":PRINT
  163.     PRINT "This program is a computer version of the Rubik Clock puzzle."
  164.     PRINT:PRINT "Set the button pattern and turn the wheels ";
  165.     PRINT "until all the clocks are at 12."
  166.     PRINT "(The solution can be found in RUBICLOC.DOC)"
  167.     PRINT:PRINT "Press any key to start.":g=GET
  168.     TXTRECT 0,0,640,400:CLG 0
  169. ENDPROC
  170.     
  171.