!****************************************************************************
!*                                                                          *
!*                                 PUZZLE                                   *
!*                         Slide-Tile Puzzle Game                           *
!*                                                                          *
!****************************************************************************
!Written by: David Pallmann
!Created on: 08-Aug-88
!
!NOTE: requires GET.SBR

       MAP1 I,F,6
       MAP1 J,F,6
       MAP1 K,F,6
       MAP1 L,F,6
       MAP1 KEY,S,1
       MAP1 ARRAY(4,4),F,6
       MAP1 X,F,6
       MAP1 Y,F,6

!--- see if GET.SBR exists

LOOKUP: LOOKUP "DSK0:GET.SBR[7,6]",I
       IF I<>0 THEN GOTO START
       LOOKUP "GET.SBR",I
       IF I<>0 THEN GOTO START
       PRINT "?This game requires GET.SBR"
       END

!--- display background and set-up for new screen

START:  RANDOMIZE
       CALL BACKGROUND
       CALL SETUP

!--- mark new position in board using reverse video

MARK:   PRINT TAB(2+(Y*3),4+(X*6)); TAB(-1,33);
       PRINT TAB(2+(Y*3),1+(X*6)); TAB(-1,32);

!--- check to see if user has solved the puzzle

CHECK:  K = 0
       L = -1
       FOR I = 1 TO 4
           FOR J = 1 TO 4
               IF I=4 AND J=4 THEN GOTO C1
               K = K+1
               IF ARRAY(I,J)<>K THEN J = 4 : I = 4 : L = 0
C1:             NEXT J
           NEXT I
       IF L THEN GOTO WINNER

!--- get character

GET:    XCALL GET,KEY
       IF KEY=CHR(27) THEN GOTO FINISH         ! ESCape
       IF KEY=CHR(8) THEN GOTO LEFT            ! left-arrow
       IF KEY=CHR(10) THEN GOTO DOWN           ! down-arrow
       IF KEY=CHR(11) THEN GOTO UP             ! up-arrow
       IF KEY=CHR(12) THEN GOTO RIGHT          ! right-arrow
       IF KEY=" " THEN GOTO MOVE               ! space
       IF KEY="?" THEN GOTO HELP               ! ?
       GOTO GET

!--- move left

LEFT:   IF X=1 THEN GOTO GET
       CALL UNMARK
       X = X-1
       GOTO MARK

!--- move right

RIGHT:  IF X=4 THEN GOTO GET
       CALL UNMARK
       X = X+1
       GOTO MARK

!--- move up

UP:     IF Y=1 THEN GOTO GET
       CALL UNMARK
       Y = Y-1
       GOTO MARK

!--- move down

DOWN:   IF Y=4 THEN GOTO GET
       CALL UNMARK
       Y = Y+1
       GOTO MARK

!--- space bar pressed - move tile if empty slot is adjacent

MOVE:   IF ARRAY(Y,X)=0 THEN PRINT CHR(7); : GOTO GET
       IF X>1 THEN IF ARRAY(Y,X-1)=0 THEN GOTO MOVE'LEFT
       IF X<4 THEN IF ARRAY(Y,X+1)=0 THEN GOTO MOVE'RIGHT
       IF Y>1 THEN IF ARRAY(Y-1,X)=0 THEN GOTO MOVE'UP
       IF Y<4 THEN IF ARRAY(Y+1,X)=0 THEN GOTO MOVE'DOWN
       PRINT CHR(7);
       GOTO GET

!--- slide selected tile to the left

MOVE'LEFT:
       I = ARRAY(Y,X)
       ARRAY(Y,X) = 0
       CALL DELETE
       X = X-1
       ARRAY(Y,X) = I
       CALL CREATE
       GOTO MARK

!--- slide selected tile to the right

MOVE'RIGHT:
       I = ARRAY(Y,X)
       ARRAY(Y,X) = 0
       CALL DELETE
       X = X+1
       ARRAY(Y,X) = I
       CALL CREATE
       GOTO MARK

!--- slide selected tile up

MOVE'UP:
       I = ARRAY(Y,X)
       ARRAY(Y,X) = 0
       CALL DELETE
       Y = Y-1
       ARRAY(Y,X) = I
       CALL CREATE
       GOTO MARK

!--- slide selected tile down

MOVE'DOWN:
       I = ARRAY(Y,X)
       ARRAY(Y,X) = 0
       CALL DELETE
       Y = Y+1
       ARRAY(Y,X) = I
       CALL CREATE
       GOTO MARK

!--- help

HELP:   PRINT TAB(-1,12);
       PRINT TAB(18,1); "The object is to get the tiles to read in numeric order, so that the first"
       PRINT TAB(19,1); "row reads 1-2-3-4, the second 5-6-7-8, the third 9-10-11-12, and the"
       PRINT TAB(20,1); "fourth 13-14-15.  To move a tile, use the arrow keys to position the marker"
       PRINT TAB(21,1); "onto it.  Then, press the SPACE bar to slide it up, down, left, or right."
       GOTO GET

!--- user has solved the puzzle

WINNER: FOR I = 1 TO 4
           FOR J = 1 TO 4
               PRINT TAB(2+(I*3),4+(J*6)); TAB(-1,33);
               PRINT TAB(2+(I*3),1+(J*6)); TAB(-1,32);
               NEXT J
           NEXT I

!--- exit

FINISH: PRINT TAB(-1,12);
       PRINT TAB(24,1); TAB(-1,28);
       END

!=== subroutine: remove reverse video marker

UNMARK: PRINT TAB(2+(Y*3),1+(X*6)); " ";
       RETURN

!=== subroutine: make current tile the blank tile

DELETE: PRINT TAB(2+(Y*3),1+(X*6)); "   ";
       RETURN

!=== subroutine: update current tile number

CREATE: PRINT TAB(2+(Y*3),1+(X*6)); " ";
       PRINT ARRAY(Y,X) USING "##";
       RETURN

!=== subroutine: clear screen and draw background

BACKGROUND:
       PRINT TAB(-1,0);
       PRINT TAB(-1,29);
       PRINT TAB(-1,23);
       RESTORE
BG1:    READ I
       IF I=0 THEN GOTO BG3
       IF I=32 THEN PRINT " "; : GOTO BG1
       IF I<38 THEN GOTO BG2
       PRINT TAB(-1,I);
       GOTO BG1
BG2:    READ J
       PRINT TAB(I,J);
       GOTO BG1
BG3:    PRINT TAB(-1,24);
       PRINT TAB(8,40); TAB(-1,11); "Press "; TAB(-1,12); "ARROW KEYS ";
       PRINT TAB(-1,11); "to move";
       PRINT TAB(10,40); "Press "; TAB(-1,12); "SPACE BAR "; TAB(-1,11);
       PRINT "to slide tile";
       PRINT TAB(12,40); "Press "; TAB(-1,12); "ESCAPE "; TAB(-1,11); "to quit";
       PRINT TAB(14,40); "Press "; TAB(-1,12); "? "; TAB(-1,11); "for help";
       PRINT TAB(-1,12);
       RETURN

!=== subroutine: initialize game array and variables

SETUP:  FOR I = 1 TO 15
S1:             J = INT(RND(0)*4)+1
               K = INT(RND(0)*4)+1
               IF ARRAY(J,K)<>0 THEN GOTO S1
               ARRAY(J,K) = I
               PRINT TAB(2+(J*3),2+(K*6));
               PRINT I USING "##";
           NEXT I
       X = 1
       Y = 1
       RETURN

!=== graphics data
!
!       a,b ....... cursor address (example: 4,5)
!       32 ........ space
!       x ......... tab(-1,x) (example: 46)
!       0 ......... end of table

DATA  4,5,38,46,46,46,46,46,42,46,46,46,46,46,42,46,46,46,46,46,42,46,46,46,46,46,39
DATA  5,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA  6,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA  7,5,44,46,46,46,46,46,48,46,46,46,46,46,48,46,46,46,46,46,48,46,46,46,46,46,43
DATA  8,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA  9,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA 10,5,44,46,46,46,46,46,48,46,46,46,46,46,48,46,46,46,46,46,48,46,46,46,46,46,43
DATA 11,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA 12,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA 13,5,44,46,46,46,46,46,48,46,46,46,46,46,48,46,46,46,46,46,48,46,46,46,46,46,43
DATA 14,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA 15,5,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47,32,32,32,32,32,47
DATA 16,5,40,46,46,46,46,46,45,46,46,46,46,46,45,46,46,46,46,46,45,46,46,46,46,46,41
DATA 0

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.