home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d1xx / d122 / pushover.lha / PushOver / push_over < prev    next >
Text File  |  1987-12-31  |  11KB  |  493 lines
  1. ' Push_Over_16, October 19, 1987 16:48 R. Yost
  2.  
  3. ' With last.mmv table to assure machine does not
  4. ' play same move three times in succession.
  5.  
  6. ' With mak.val.tbl reading a file rather'
  7.  
  8. ' than DATA statements.
  9. '
  10. ' With machine code get_m_move
  11. '
  12. ' "Push-over," Science et Vie, Jeux et Strategies, No. 2, Avril-Mai 1980, p. 7.
  13. '
  14. CLEAR, 25000
  15. CLEAR, 50000&, 8000
  16. WINDOW 1 ,"Push Over  Instructions"
  17. PRINT  "  This is the Game of Push Over.  It is played on a 5x5"
  18. PRINT  "board. You play the 'white' pieces; I play the red ones.  You"
  19. PRINT  "play first.  The object is to get a row or column or major"
  20. PRINT  "diagonal filled with 5 of your pieces.  To move, use the cursor"
  21. PRINT  "to point to one of the 20 1/2 sized edge starting pads, then"
  22. PRINT  "click the left button.  Your piece will move onto the board,"
  23. PRINT  "pushing any pieces in its way to their neighboring squares."
  24. PRINT ""
  25. PRINT  "  A move is illegal if it merely cancels the effect of the"
  26. PRINT " preceding opponent's move."
  27. PRINT ""
  28. PRINT  "  To quit, press the Q key."
  29. PRINT ""
  30. PRINT  "Type any key to start the game."
  31. begin:
  32.   IF INKEY$ = "" THEN begin
  33. '  
  34. SCREEN 2,320,200,2,1
  35. WINDOW  2,"PUSH OVER      by R. Yost",,31, 2
  36. DEFINT a-z 
  37. DIM b1&(6,6), b0&(6,6),bm1&(6,6), in.play(52)
  38. DIM b.m.tbl&(21)
  39. DIM val.tbl&(2,2,2,2,2)
  40. DIM getmmvcode(1040)
  41. DIM last.mmvs&(1) ' Table used by get_m_move_code.
  42. GOSUB mak.val.tbl
  43. GOSUB get.piece.shapes
  44. GOSUB get.getmmvcode
  45. '
  46. start.game:
  47. CLS: OBJECT.OFF
  48. '
  49. ' close game piece objects
  50. '
  51. FOR p = 1 TO 52
  52.   IF in.play(p) THEN
  53.     OBJECT.CLOSE p
  54.   END IF
  55. NEXT p 
  56. '
  57. ' Initialize arrays
  58. '
  59. FOR i=0 TO 6: FOR j=0 TO 6
  60.   b1&(i,j)=0
  61.   b0&(i,j)=0
  62.   bm1&(i,j)=0
  63. NEXT j,i
  64. FOR i=0 TO 52
  65.   in.play(i)=0
  66. NEXT i
  67. '
  68. FOR i = 0 TO 1
  69.   last.mmvs&(i) = 0  ' An impossible move, so machine moves
  70.                      ' avoid repeating it.
  71. NEXT i
  72. '
  73.   last.mmv&=25 ' An impossible move, so machine moves wont
  74.   '              avoid repeating it.
  75. '
  76. x0 = 85: y0 = 25: sqsize = 25 : hsqsz=INT(sqsize/2)
  77. speed = 32
  78. '
  79. RANDOMIZE TIMER
  80. '
  81. main:
  82.   ON MOUSE GOSUB move.loop
  83.   CALL draw.board(x0, y0, sqsize)
  84. main.loop:
  85.   MOUSE ON
  86.   LOCATE 1,1: PRINT "Your turn:        ": LOCATE 1,1
  87.   SLEEP
  88.   
  89.   IF UCASE$(INKEY$)="Q"  THEN
  90.     IF err.flg& THEN
  91.      PRINT"You lose.         "
  92.     ELSE
  93.       PRINT"Quitting ?         "
  94.     END IF
  95.     GOTO wrap.up
  96.   END IF
  97.   GOTO main.loop
  98. END
  99. '
  100. move.loop:
  101.   MOUSE OFF  
  102.   GOSUB get.h.move 
  103.   GOSUB get.pc.id
  104.   IF err.flg& THEN GOSUB bad.move: RETURN
  105.   mvp= 0: ' Don't move pieces.       
  106.   CALL move.vector( move, new.pc.id, mvp, bm1&(), b0&(), b1&()) 
  107.   IF err.flg& THEN GOSUB bad.move: RETURN
  108.   mvp = -1: ' now moving pieces
  109.   CALL move.vector ( move, new.pc.id, mvp, bm1&(), b0&(), b1&())
  110.   GOSUB score
  111. m.turn:
  112.   MOUSE OFF
  113.   GOSUB get.m.move
  114.   GOSUB get.pc.id
  115. ' mvp = 0 
  116. '  illegal = 0
  117. ' CALL move.vector(move, new.pc.id, mvp, bm1&(), b0&(), b1&())
  118. '  IF err.flg& THEN  illegal = move: GOTO m.turn
  119.   mvp = -1
  120.   CALL move.vector( move, new.pc.id, mvp, bm1&(), b0&(), b1&())
  121.   GOSUB score
  122. RETURN
  123. '
  124. bad.move:LOCATE 1,1
  125.   PRINT"Bad move; try again.": LOCATE 1,1
  126.   delay.t = 1: GOSUB delay
  127.   PRINT STRING$(30,32): LOCATE 1,1
  128. RETURN
  129. '
  130. ' get human move number 1..20
  131. '
  132. get.h.move:
  133.   pc.color = 202: ' white
  134.   err.flg& = 0
  135.   WHILE MOUSE(0)<>0
  136.   WEND
  137.   xms=MOUSE(1): yms=MOUSE(2)
  138.   IF (xms>x0) AND (xms<x0+5*sqsize) THEN
  139.     IF (yms>y0-hsqsz) AND (yms<y0) THEN
  140.         move = INT((xms-x0)/sqsize+1)
  141.     ELSEIF ((yms>y0+5*sqsize) AND (yms < y0+5*sqsize+hsqsz) ) THEN
  142.         move = INT((xms-x0)/sqsize + 6)
  143.     ELSE 
  144.         err.flg& = -1
  145.     END IF
  146.   ELSEIF ((xms>x0-hsqsz) AND (xms<x0)) THEN
  147.         IF (yms>y0) AND (yms<y0+5*sqsize) THEN
  148.             move = INT( (yms-y0)/sqsize + 11)
  149.         ELSE
  150.             err.flg& = -1
  151.         END IF
  152.   ELSEIF ((xms>x0+5*sqsize) AND (xms<x0+5*sqsize+hsqsz)) THEN
  153.         IF (yms>y0) AND (yms<y0 + 5*sqsize) THEN
  154.            move = INT((yms-y0)/sqsize + 16 )
  155.         ELSE 
  156.            err.flg& = -1
  157.         END IF
  158.   ELSE
  159.         err.flg& = -1      
  160.   END IF
  161. RETURN
  162. '
  163. get.pc.id:
  164.   IF err.flg& = 0 THEN
  165.     '
  166.     ' get new.pc.id
  167.     '
  168.     new.pc.id = pc.color - 200
  169.     WHILE in.play(new.pc.id)<>0
  170.       new.pc.id = new.pc.id + 2
  171.     WEND
  172.     OBJECT.SHAPE new.pc.id, pc.color
  173.     in.play(new.pc.id)=-1 : ' true
  174.   END IF           
  175.   LOCATE 1,1
  176.   PRINT STRING$(30,32): LOCATE 1,1 
  177. RETURN  
  178. '
  179. SUB draw.board( x0,y0, bx ) STATIC
  180.   FOR x=x0 TO x0+2*bx STEP bx
  181.     LINE(x,y0-bx/2)-STEP(3*bx,6*bx),3,b
  182.   NEXT x
  183.   FOR y=y0 TO y0+2*bx STEP bx
  184.     LINE(x0-bx/2,y)-STEP(6*bx,3*bx),3,b
  185.   NEXT y 
  186. END SUB
  187. '               
  188. get.piece.shapes:
  189. '
  190.  ' CHDIR"push_over:pshovr"
  191.   OPEN "WHTOKEN" FOR INPUT AS 4
  192.   OPEN "BLKTOKEN" FOR INPUT AS 5
  193.   OBJECT.SHAPE 202, INPUT$(LOF(4),4)
  194.   OBJECT.SHAPE 201, INPUT$(LOF(5),5)
  195.   CLOSE 4,5
  196. RETURN
  197. '  
  198. get.getmmvcode:
  199.   OPEN "getmmovcode" FOR INPUT AS 6
  200.   i = 0
  201.   WHILE NOT EOF(6)
  202.     INPUT# 6, getmmvcode(i)
  203.     i = i+1
  204.   WEND
  205.   CLOSE 6
  206. RETURN
  207.   '
  208. SUB move.vector (mov,npcid,moving.pieces, bm1&(2), b0&(2), b1&(2)) STATIC : ' move.number, pc.color
  209.   DEFINT a-z
  210.   SHARED sqsize, x0, y0, speed ,in.play(), hsqsz
  211.   SHARED  err.flg&  
  212.   xb0=x0-5: yb0 = y0+4: ' Offsets for objects
  213.   spcid=npcid 
  214.   IF (spcid AND 1)<>0 THEN
  215.     spcid = -spcid
  216.   END IF
  217.   IF NOT moving.pieces THEN
  218.     brd.move.type = 1
  219.     GOSUB move.brds
  220.     GOSUB make.move
  221.     '
  222.     ' Check if new board same as board
  223.     ' before previous move.
  224.     '
  225.     same=-1
  226.     FOR i=1 TO 5: FOR j=1 TO 5
  227.       IF ( SGN(b1&(i,j))<>SGN(bm1&(i,j))) THEN  same=0: i=5: j=5
  228.     NEXT j,i
  229.     IF same THEN err.flg& = -1 
  230.   ELSE
  231.     brd.move.type=1
  232.     GOSUB move.brds
  233.     GOSUB make.move
  234.     brd.move.type=2
  235.     GOSUB move.brds
  236.   END IF
  237. EXIT SUB
  238. '
  239. make.move:   
  240.   IF mov<6 THEN
  241.     mv = mov
  242.     xstrt=xb0+mv*sqsize-hsqsz
  243.     ystrt=yb0-hsqsz
  244.     row.new = 0: col.new = mv
  245.     step.size= 1
  246.     GOSUB move.col
  247.   ELSEIF mov>5 AND mov < 11 THEN
  248.     mv = mov-5
  249.     xstrt=xb0+mv*sqsize-hsqsz
  250.     ystrt=yb0+5*sqsize+hsqsz+1
  251.     step.size = -1
  252.     row.new = 6: col.new = mv
  253.     GOSUB move.col
  254.   ELSEIF mov>10 AND mov<16 THEN
  255.     mv=mov-10
  256.     xstrt=xb0-hsqsz
  257.     ystrt=yb0+mv*sqsize-hsqsz
  258.     row.new=mv: col.new=0
  259.     step.size=1
  260.     GOSUB move.row
  261.   ELSE
  262.     mv=mov-15
  263.     xstrt=xb0+5*sqsize+hsqsz
  264.     ystrt=yb0+mv*sqsize-hsqsz
  265.     row.new=mv: col.new=6
  266.     step.size= -1
  267.     GOSUB move.row
  268.   END IF
  269. RETURN
  270. '
  271. move.brds:
  272.   FOR i=0 TO 6: FOR j=0 TO 6
  273.     ON brd.move.type GOSUB move1, move2
  274.   NEXT j,i
  275. RETURN    
  276. '
  277. move1:
  278.   b1&(i,j)=b0&(i,j)
  279. RETURN
  280. '
  281. move2:
  282.   bm1&(i,j)=b0&(i,j)
  283.   b0&(i,j)=b1&(i,j)
  284. RETURN
  285. '
  286. move.col:
  287.   IF moving.pieces THEN
  288.     OBJECT.X npcid, xstrt
  289.     OBJECT.Y npcid, ystrt
  290.     OBJECT.ON npcid
  291.   END IF
  292.   b1&(row.new,col.new)= spcid
  293.   row.n = row.new
  294.   WHILE b1&(row.n,col.new)<>0
  295.     row.n = row.n+step.size
  296.   WEND
  297.   ' row.n now points to empty square, 
  298.   ' possibly row 6, off board.    
  299.   FOR row=row.n TO row.new + step.size STEP -1*step.size
  300.       b1&(row,col.new)=b1&(row-step.size,col.new)
  301.       IF moving.pieces THEN
  302.         OBJECT.VY ABS(b1&(row-step.size,col.new)), step.size*speed
  303.       END IF
  304.   NEXT row
  305.   '
  306.   ' now, move pieces in vector
  307.   '
  308.   IF moving.pieces THEN
  309.     OBJECT.START
  310.     keep.moving:
  311.     OBJECT.START
  312.     ydis = ABS(OBJECT.Y(npcid) - ystrt)
  313.     IF ydis < sqsize THEN keep.moving
  314.     OBJECT.STOP
  315.     OBJECT.STOP ' Make sure they stop!
  316.     
  317.     '  
  318.     ' reset velocities to zero.
  319.     '
  320.     FOR row = row.new+step.size TO row.n STEP step.size
  321.       OBJECT.VY ABS(b1&(row,col.new)),0
  322.     NEXT row
  323.     '
  324.     ' Discard piece pushed off board.
  325.     '
  326.     IF row.n = 6-row.new THEN
  327.       OBJECT.OFF ABS(b1&(6-row.new,col.new))
  328.       in.play(ABS(b1&(6-row.new,col.new)))=0      
  329.     END IF
  330.   END IF
  331.   '
  332.   ' Clear edges.
  333.   '
  334.   b1&(0,col.new)=0 
  335.   b1&(6,col.new)=0
  336.   '
  337.   ' Vector moved.
  338. RETURN
  339. '
  340. move.row:
  341.   IF moving.pieces THEN
  342.     OBJECT.Y npcid, ystrt
  343.     OBJECT.X npcid, xstrt
  344.     OBJECT.ON npcid
  345.   END IF
  346.   b1&(row.new,col.new)=spcid
  347.   col.n = col.new
  348.   WHILE b1&(row.new,col.n)<>0
  349.     col.n = col.n + step.size
  350.   WEND
  351.   '
  352.   FOR col = col.n TO col.new+step.size STEP -1*step.size
  353.     b1&(row.new,col)=b1&(row.new,col-step.size)
  354.     IF moving.pieces THEN
  355.       OBJECT.VX ABS(b1&(row.new,col-step.size)), step.size*speed
  356.     END IF
  357.   NEXT col
  358.   '
  359.   IF moving.pieces THEN
  360.     keep.sliding:
  361.     OBJECT.START 
  362.     xdis = ABS(OBJECT.X(npcid) - xstrt)
  363.     IF xdis < sqsize-1 THEN keep.sliding
  364.     OBJECT.STOP
  365.     OBJECT.STOP  ' Make sure they stop!
  366.     '
  367.     FOR col = col.new+step.size TO col.n STEP step.size
  368.       OBJECT.VX ABS(b1&(row.new,col)), 0
  369.     NEXT col
  370.     IF col.n = 6 - col.new THEN
  371.       OBJECT.OFF ABS(b1&(row.new, 6-col.new))
  372.       in.play(ABS(b1&(row.new,6-col.new))) = 0
  373.     END IF
  374.   END IF
  375.   b1&(row.new,6)=0
  376.   b1&(row.new,0)=0
  377. RETURN
  378. END SUB         
  379. '
  380. ' Win evaluator; returns result 
  381. ' in variable "win"
  382. '
  383. SUB win.eval(brd&(2),pc,win) STATIC
  384.   DEFINT a-z
  385.   win = 0: win.diag1 = -1: win.diag2 = -1
  386.   FOR i=1 TO UBOUND(brd&,1)-1
  387.     ON pc GOSUB test.diags.blk, test.diags.wht
  388.     win.row = -1: win.col = -1
  389.     FOR j=1 TO UBOUND(brd&,2)-1
  390.       ON pc GOSUB test.blk, test.wht
  391.     NEXT j
  392.     win = win OR (win.row OR win.col)
  393.     IF win THEN EXIT SUB
  394.   NEXT i
  395.   win = win OR (win.diag1 OR win.diag2)
  396. EXIT SUB
  397. '
  398. subroutines
  399. '
  400.   test.diags.blk:
  401.     IF brd&(i,i) >=0 THEN win.diag1 = 0
  402.     IF brd&(i,6-i) >=0 THEN win.diag2=0
  403.   RETURN
  404.   '
  405.   test.diags.wht:
  406.     IF brd&(i,i) <=0 THEN win.diag1 = 0
  407.     IF brd&(i,6-i) <=0 THEN win.diag2=0
  408.   RETURN
  409.   '
  410.   test.blk:
  411.     IF brd&(i,j) >=0 THEN win.row = 0
  412.     IF brd&(j,i) >=0 THEN win.col = 0
  413.   RETURN
  414.   '
  415.   test.wht:
  416.     IF brd&(i,j) <=0 THEN win.row = 0
  417.     IF brd&(j,i) <=0 THEN win.col = 0
  418.   RETURN
  419.   '
  420. END SUB
  421. '
  422. ' subroutine score detects wins and
  423. ' announces results and offers new
  424. ' game or ends.
  425. '
  426. score:
  427.   CALL win.eval(b1&(),1,win.blk)
  428.   CALL win.eval(b1&(),2,win.wht)
  429.   IF (win.wht AND win.blk) THEN
  430.     PRINT"A Tie.         ": LOCATE 1,1
  431.     GOTO wrap.up
  432.   ELSEIF win.wht THEN
  433.     PRINT"You WIN!        ": LOCATE 1,1
  434.     GOTO wrap.up
  435.   ELSEIF win.blk THEN
  436.     PRINT"I win!           ": LOCATE 1,1
  437.     GOTO wrap.up
  438.   END IF
  439. RETURN
  440. '
  441. wrap.up:
  442.   delay.t = 1: GOSUB delay
  443.   PRINT"New Game?";
  444.   w.u.loop:
  445.     a$=INKEY$
  446.     IF a$="" THEN w.u.loop
  447.   OBJECT.OFF
  448.   IF (a$="y" OR a$="Y") THEN start.game
  449.   SCREEN CLOSE 2
  450.   WINDOW CLOSE 2
  451.   CLS
  452. END   
  453. '
  454. delay:
  455.     FOR i=1 TO 250*delay.t: q=SIN(.5):NEXT
  456. RETURN
  457.  
  458. mak.val.tbl:
  459.   OPEN "val.tbl.file" FOR INPUT AS #10
  460.   FOR i = 0 TO 2
  461.     FOR j = 0 TO 2
  462.       FOR k = 0 TO 2
  463.         FOR l = 0 TO 2
  464.           FOR m = 0 TO 2
  465.             INPUT# 10, val.tbl&(i,j,k,l,m)
  466.   NEXT m,l,k,j,i
  467.   CLOSE 10
  468. RETURN
  469. '
  470. '
  471. get.m.move:
  472.   PRINT  "Please wait a moment."
  473.   LOCATE 1,1
  474.   getmmv& = VARPTR(getmmvcode(0))
  475.   CALL getmmv&(VARPTR(val.tbl&(0,0,0,0,0)),VARPTR(bm1&(0,0)), VARPTR(b0&(0,0)), VARPTR(b.m.tbl&(0)), VARPTR(last.mmv&), VARPTR(last.mmvs&(0)) )
  476.   move = b.m.tbl&(INT(1+(b.m.tbl&(0)-1)*RND))
  477.   last.mmv& = move
  478.   pc.color = 201
  479.   err.flg& = 0
  480.   PRINT  "OK, here's my move.  " : LOCATE 1,1
  481.   delay.t = 1 : GOSUB delay
  482. RETURN
  483. '
  484. SUB dmp( brd(2) ) STATIC
  485.   FOR i = 1 TO 5
  486.     PRINT ""
  487.     FOR j = 1 TO 5
  488.       PRINT brd(i,j);
  489.     NEXT j
  490.   NEXT i
  491. END SUB
  492.              
  493.