home *** CD-ROM | disk | FTP | other *** search
/ PC Plus 24 / ISSUE_24_SEP_1988 / BASIC2 / ENIGMA.BAS
Encoding:
BASIC Source File  |  1988-01-01  |  7.9 KB  |  260 lines
  1.    WINDOW #1 OPEN:WINDOW #1 FULL:CLS #1
  2. '
  3. '  dimension all arrays and strings
  4. '  and initialise variables and screen
  5. '
  6.    DIM arr$(8,10) :  'used in valid move logic
  7.    DIM l(10)      :  'block lengths
  8.    DIM h(10)      :  ' "    heights
  9.    DIM c(10)      :  ' "    colors
  10.    DIM x(10)      :  'x-cords
  11.    DIM y(10)      :  'y-co-ords
  12.    DIM bk$(10)    :  'data for blocks
  13.    DIM k$(16)     :  '
  14. '
  15. '  setup screen
  16. '
  17.    GOSUB setup
  18. '
  19. '  ***** MAIN ******
  20. '
  21.    play$="yes"
  22. '
  23.    WHILE play$="yes
  24. '
  25.      GOSUB initdata
  26.      finish$="no"
  27.      ans$="no"
  28.      ians=0
  29. '
  30.         WHILE finish$="no"
  31.           IF ans$="no" THEN GOSUB getmove ELSE GOSUB getans
  32.           IF move$="q" THEN finish$="quit"
  33.           IF move$="a" THEN ans$="yes":GOSUB initdata:GOSUB getans
  34.           GOSUB checkmove
  35.           IF move$="valid" THEN GOSUB checkend
  36.         WEND
  37. '
  38.      MOVE 200;100
  39.      IF ans$="yes" THEN finish$="no": PRINT MODE(1);"EASY,wasn't it..try again ?"
  40.      IF finish$="yes"  THEN PRINT MODE(1);"WELL DONE.....another go  ?"
  41.      IF finish$="quit" THEN PRINT MODE(1);"HARD LUCK.......try again   ?"
  42. '
  43.         ans$=""
  44.         WHILE ans$=""
  45.           ans$=INKEY$
  46.           IF ans$<>"y" AND ans$<>"n" THEN ans$=""
  47.         WEND
  48. '
  49.         IF ans$="n" THEN play$="no"
  50. '
  51.    WEND
  52. '
  53.    WINDOW #1 CLOSE : CLS : STOP
  54. '
  55. '  *** ENDMAIN ****
  56. '
  57. '
  58. '
  59.    LABEL getans
  60.    ians=ians+1
  61.    block=VAL(MID$(ac$,ians,1))
  62.    IF block=0 THEN block=10
  63.    move$=MID$(ad$,ians,1)
  64.    RETURN
  65. '
  66. '
  67. '
  68.    LABEL checkmove
  69.    lp=l(block):hp=h(block):xp=x(block):yp=y(block):cp=c(block)
  70.    e$=bk$(block):dk$=k$(block):oldmv$=mv$:mv$=dk$+"-"+move$
  71.    dx=0 : dy=0
  72.    IF move$="u" AND yp>1     THEN dy=-1
  73.    IF move$="d" AND yp+hp<11 THEN dy=1
  74.    IF move$="l" AND xp>2     THEN dx=-2
  75.    IF move$="r" AND xp+lp<9  THEN dx=2
  76.    IF dx=0 AND dy=0 THEN move$="invalid" : RETURN
  77.    GOSUB dummy  :'check valid move
  78.    IF move$="invalid" THEN RETURN
  79.    MOVE 100;167:PRINT MODE(1);mv$
  80.    cp=7:GOSUB drawblock
  81.    cp=c(block):xp=x(block):yp=y(block):m=1:GOSUB drawblock:cp=1:GOSUB drawoutline
  82.    IF lastblock=block THEN RETURN
  83.    movecount=movecount+1
  84.    lastblock=block
  85.    MOVE 100;153:PRINT MODE(1);movecount
  86.    RETURN
  87. '
  88. '
  89. '
  90.    LABEL checkend
  91.    IF x(1)<>5 OR y(1)<>7 THEN RETURN
  92.    IF x(2)<>7 OR y(2)<>7 THEN RETURN
  93.    IF x(7)<>1 OR y(7)<>1 THEN RETURN
  94.    IF x(10)<>1 OR y(10)<>3 THEN RETURN
  95.    finish$="yes"
  96.    RETURN
  97. '
  98. '
  99. '
  100.    LABEL getmove
  101.    ik=0
  102.      WHILE ik<11
  103.         GOSUB getkeys
  104.         IF ik<11 THEN block=ik:MOVE 100;167:PRINT MODE(1); k$(ik)+"  "
  105.      WEND
  106.    move$=ky$
  107.    RETURN
  108. '
  109. '
  110. '
  111.    LABEL getkeys
  112.    ik=0
  113.    WHILE ik=0
  114.    ky$=""
  115.        WHILE ky$=""
  116.          ky$=INKEY$
  117.        WEND
  118.            FOR k=1 TO 16
  119.            IF ky$=k$(k) THEN ik=k
  120.            NEXT k
  121.    WEND
  122.    RETURN
  123. '
  124. '
  125. '
  126.    LABEL dummy
  127.    xd=xp+dx : yd=yp+dy
  128.    xd1=xd+lp-1 : yd1=yd+hp-1
  129.    xa=xp : ya=yp : a$=" "
  130.    GOSUB arrmove : ' delete block
  131.    move$="valid" : i=0
  132.    FOR id=yd TO yd1
  133.    FOR jd=xd TO xd1
  134.    i=i+1
  135.    IF arr$(jd,id)<>" " AND MID$(e$,i,1)="X" THEN move$="invalid"
  136.    NEXT jd
  137.    NEXT id
  138.    xa=xp : ya=yp : a$=k$(block)
  139.    GOSUB arrmove : ' return block after check
  140.    IF move$="invalid" THEN RETURN
  141.    xa=xp : ya=yp : a$=" "
  142.    GOSUB arrmove
  143.    xa=xd : ya=yd : a$=dk$
  144.    GOSUB arrmove
  145.    x(block)=xd : y(block)=yd
  146.    RETURN
  147. '
  148. '
  149. '
  150.    LABEL arrmove
  151.    x1=xa : x2=x1+lp-1 : y1=ya : y2=y1+hp-1
  152.    i=0
  153.    FOR ym=y1 TO y2
  154.      FOR xm=x1 TO x2
  155.      i=i+1
  156.      IF MID$(e$,i,1)="X" THEN arr$(xm,ym)=a$
  157.                          ELSE arr$(xm,ym)=" "
  158.      NEXT xm
  159.    NEXT ym
  160.    RETURN
  161. '
  162. '
  163. '
  164.    LABEL drawblock
  165.    xo=160+(xp*30):yo=190-(yp*15)
  166.    IF block=1 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-30, xo+118;yo-30,xo+118;yo-59, xo;yo-59, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
  167.    IF block=2 OR block=4 OR block=8 OR block=10  THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
  168.    IF block=3 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-13, xo+58;yo-13, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
  169.    IF block=5 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-16, xo+118;yo-16, xo+118;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
  170.    IF block=6 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-29, xo+60;yo-29, xo+60;yo-14, xo;yo-14, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
  171.    IF block=7 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-59, xo+61;yo-59, xo+61;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp MODE 1 FILL
  172.    IF block=9 THEN SHAPE xo;yo-16, xo+60;yo-16, xo+60;yo, xo+118;yo, xo+118;yo-29, xo;yo-29, xo;yo-16 WIDTH 4 COLOR cp MODE 1 FILL
  173.    IF cp=7 THEN RETURN
  174.    IF block=9 THEN MOVE (xo+5);(yo-25) ELSE MOVE (xo+5);(yo-10)
  175.    PRINT k$(block)
  176.    RETURN
  177. '
  178. '
  179. '
  180.    LABEL drawoutline
  181.    xo=160+(xp*30):yo=190-(yp*15)
  182.    IF block=1 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-30, xo+118;yo-30,xo+118;yo-59, xo;yo-59, xo;yo WIDTH 4 COLOR 1
  183.    IF block=2 OR block=4 OR block=8 OR block=10  THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
  184.    IF block=3 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-13, xo+58;yo-13, xo+58;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
  185.    IF block=5 THEN SHAPE xo;yo, xo+58;yo, xo+58;yo-16, xo+118;yo-16, xo+118;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
  186.    IF block=6 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-29, xo+60;yo-29, xo+60;yo-14, xo;yo-14, xo;yo WIDTH 4 COLOR cp
  187.    IF block=7 THEN SHAPE xo;yo, xo+118;yo, xo+118;yo-59, xo+61;yo-59, xo+61;yo-29, xo;yo-29, xo;yo WIDTH 4 COLOR cp
  188.    IF block=9 THEN SHAPE xo;yo-16, xo+60;yo-16, xo+60;yo, xo+118;yo, xo+118;yo-29, xo;yo-29, xo;yo-16 WIDTH 4 COLOR cp
  189.    RETURN
  190. '
  191. '
  192.    LABEL setup
  193.    USER SPACE 200
  194.    USER ORIGIN 0;0
  195.    BOX 0;0,640,200 COLOR 4 FILL
  196.    SET #1 MODE 2
  197.    BOX 470;100,110,85 COLOR 7 FILL
  198.    BOX 470;100,110,85 WIDTH 2 COLOR 1
  199.    BOX 526;104,49,26 COLOR 3 FILL
  200.    BOX 476;143,49,26 COLOR 5 FILL
  201.    LINE 470;171,580;171
  202.    MOVE 490;175 :PRINT "OBJECTIVE"
  203.    MOVE 476;80  :PRINT "KEYS :"
  204.    MOVE 476;70  :PRINT "0 - 9 .. select"
  205.    MOVE 476;60  :PRINT "u ...... up"
  206.    MOVE 476;50  :PRINT "d ...... down"
  207.    MOVE 476;40  :PRINT "l ...... left"
  208.    MOVE 476;30  :PRINT "r ...... right"
  209.    MOVE 476;20  :PRINT "q ...... quit"
  210.    BOX 30;140,110,45 COLOR 0 FILL
  211.    BOX 30;140,110,45 WIDTH 4
  212.    MOVE 52;167 : PRINT "MOVE"
  213.    MOVE 52;153 : PRINT"TOTAL"
  214.    BOX 30;15,110,100 FILL COLOR 13
  215.    BOX 30;15,110,100 WIDTH 4:MOVE 60;100:PRINT "RATINGS":MOVE 60;90:PRINT"-------":MOVE 40;80:PRINT "<50...WORDS":MOVE 40;70:PRINT"      FAIL":MOVE 40;60:PRINT "51-60 GREAT":MOVE 40;50:PRINT"61-70 GOOD":MOVE 40;40:PRINT"71-80 FAIR"
  216.    MOVE 40;30:PRINT">80   Hmmm"
  217.    RETURN
  218. '
  219. '
  220. '
  221.    LABEL initdata
  222.    RESTORE
  223.    ac$="666611156444522335522666444770981722224445533665554442220009718881117024444422333665577700000888884444222299992211"
  224.    ad$="uurrdddlldddrddlluurruulluuuurrddlddddrddddrruulluuuuuuuuuuruuurrdddllldddddrddddrrrruuululuuuulullluuddlluuuurrrr"
  225.    FOR i=1 TO 10
  226.    READ  l(i),h(i),x(i),y(i),c(i),bk$(i),k$(i)
  227.        FOR j=1 TO 8
  228.        arr$(j,i)=" "
  229.        NEXT j
  230.    NEXT i
  231.    FOR i=11 TO 16
  232.    READ k$(i)
  233.    NEXT i
  234.    DATA 4,4,1,1,3,"XXOOXXOOXXXXXXXX","1"
  235.    DATA 2,2,3,1,3,"XXXX"            ,"2"
  236.    DATA 4,2,5,1,6,"XXXXXXOO"        ,"3"
  237.    DATA 2,2,7,2,6,"XXXX"            ,"4"
  238.    DATA 4,2,5,3,6,"XXOOXXXX"        ,"5"
  239.    DATA 4,2,1,7,6,"XXXXOOXX"        ,"6"
  240.    DATA 4,4,5,7,5,"XXXXXXXXOOXXOOXX","7"
  241.    DATA 2,2,1,8,6,"XXXX"            ,"8"
  242.    DATA 4,2,1,9,6,"OOXXXXXX"        ,"9"
  243.    DATA 2,2,5,9,5,"XXXX"            ,"0"
  244.    DATA "u","d","r","l","q","a"
  245.    lastblock=10:ik=0
  246.    mv$="   ":movecount=0
  247.    MOVE 100;167:PRINT MODE(1);mv$
  248.    MOVE 100;153:PRINT MODE(1);movecount
  249.    BOX 170;15,280,170 COLOR 7 FILL
  250.    BOX 170;15,280,170 WIDTH 4 COLOR 1
  251.    FOR block=1 TO 10
  252.    lp=l(block):hp=h(block):xp=x(block)
  253.    yp=y(block):cp=c(block):dx=0:dy=0
  254.    e$=bk$(block)
  255.    xa=xp : ya=yp : a$=k$(block)
  256.    GOSUB arrmove :m=1: GOSUB drawblock : cp=1 : GOSUB drawoutline
  257.    NEXT block
  258.    block=6
  259.    RETURN
  260.