'===========================================================================
' Subject: PICTURE PUZZLE                     Date: 09-28-96 (16:05)       
'  Author: Robin Ohm                          Code: QB, QBasic, PDS        
'  Origin: rkohm@euronet.nl                 Packet: GAMES.ABC
'===========================================================================
REM **********************************************
REM             More Qbasic Software:
REM       http://www.euronet.nl/users/rkohm/
REM          Any questions? E-mail to:
REM              rkohm@euronet.nl
REM **********************************************

DECLARE SUB swapbox (which!)
DECLARE SUB check ()
DECLARE SUB game ()
DECLARE SUB move (whereto!)
DECLARE SUB fieldsetup ()
DECLARE SUB background ()

COMMON SHARED x, y, xcoor, ycoor, xold, yold, loca, sound$

CLS : SCREEN 12
xcoor = 363: ycoor = 163: loca = 1

ON KEY(10) GOSUB endofgame
KEY(10) ON

DIM SHARED square1(200), square2(200), square3(200), square4(200)
DIM SHARED square5(200), square6(200), square7(200), square8(200)
DIM SHARED square9(200), square10(200), square11(200), square12(200)
DIM SHARED square13(200), square14(200), square15(200), square16(200)
DIM SHARED box(16), theone(200)

RANDOMIZE TIMER
FOR temp = 1 TO 16
again:
 DO: place = FIX(RND * 16 + 1): LOOP UNTIL 1 <= place <= 16
 IF box(place) <> 0 THEN GOTO again
 box(place) = temp
NEXT

'FOR sed = 1 TO 16
' box(sed) = sed
'NEXT
'box(5) = 1: box(1) = 5

background
fieldsetup

DO
 game
 check
LOOP


END

endofgame:
END

SUB background
LOCATE 10, 23: PRINT "Select a background for the puzzle: (1-3)"
LOCATE 11, 28: PRINT "1. House"
LOCATE 12, 28: PRINT "2. Boat"
LOCATE 13, 28: PRINT "3. Car"
DO: user$ = INKEY$: LOOP UNTIL user$ = "1" OR user$ = "2" OR user$ = "3"
CLS
DRAW "bm280,330u176l176d176r176bh8u160l160d160r160bfp15,15h"  'square 1

SELECT CASE user$
CASE "1"
 DRAW "bl45bu10p9,15c14u70l100d70r100bhp14,14fu70c4h50g50r100h4blp4,4rh10c6u40l20d20"
 DRAW "f20u4blp6,6rbg70bd16c1u40r30d40l30bep1,1gbe20br25c2u30r30d30l30bep2,2g"
 DRAW "br83l43d23l102u23l13d31r158u31bgp2,2"
 CIRCLE (245, 200), 20, 14: PAINT (245, 200), 14, 14   'house
CASE "2"
 DRAW "bhp9,15c1u30l160d30r160bhp1,1f2"
 DRAW "bl55c14be15e35l150f35r80bhp14,14fl15u36c6u90l10d90r10bhp6,6fu10c8r50"
 LINE STEP(0, 0)-(218, 190), 8: DRAW "d70bep8,8": LINE (206, 190)-(120, 262), 8
 DRAW "r86u70d5blp8,8ru5bd100br15": CIRCLE STEP(0, 0), 5, 2: DRAW "p2,2bl30"
 CIRCLE STEP(0, 0), 5, 2: DRAW "p2,2bl30": CIRCLE STEP(0, 0), 5, 2: DRAW "p2,2"
 CIRCLE (250, 190), 15, 14: PAINT STEP(0, 0), 14, 14   'boat
CASE "3"
 DRAW "bhp9,15c2u35l160d35r160bhp2,2": CIRCLE (160, 280), 18, 8: DRAW "p8,8"
 CIRCLE (225, 280), 18, 8: DRAW "p8,8": CIRCLE (160, 280), 8, 7: DRAW "p7,7"
 CIRCLE (225, 280), 8, 7: DRAW "p7,7"
 DRAW "bm267,320c12bh40r35u30l30h20l40g20l30d30r140bh30bl5"
 DRAW "p12,12c8h15l20d15r35l2bup8,8dbl38u15l10g15r25bhp8,8fc0bu21br10h35bh"
 CIRCLE STEP(0, 0), 2, 0: DRAW "p0,0": CIRCLE (230, 190), 15, 14: DRAW "p14,14"
END SELECT

DRAW "bm112,162c15r160d160l160u160r40d160r40u160r40d160r40u40l160u40r160u40l160"

DRAW "bm530,330u176l176d176r176bh8u160l160d160r160bfp15,15h"  'square 2
DRAW "bm362,162c15r160d160l160u160r40d160r40u160r40d160r40u40l160u40r160u40l160"


DRAW "bm133,183p0,15"'bm1,1p4,15"
GET (113, 163)-(151, 201), square1
GET (153, 163)-(191, 201), square2
GET (193, 163)-(231, 201), square3
GET (233, 163)-(271, 201), square4
GET (113, 203)-(151, 241), square5
GET (153, 203)-(191, 241), square6
GET (193, 203)-(231, 241), square7
GET (233, 203)-(271, 241), square8
GET (113, 243)-(151, 281), square9
GET (153, 243)-(191, 281), square10
GET (193, 243)-(231, 281), square11
GET (233, 243)-(271, 281), square12
GET (113, 283)-(151, 321), square13
GET (153, 283)-(191, 321), square14
GET (193, 283)-(231, 321), square15
GET (233, 283)-(271, 321), square16

LOCATE 2, 5: COLOR 14: PRINT "F10"; : COLOR 15: PRINT " Exit"
LOCATE 3, 5: COLOR 14: PRINT "(Arrow keys on the Number Pad)";
COLOR 15: PRINT " Move Red Box"
LOCATE 4, 5: COLOR 14: PRINT "Enter"; : COLOR 15: PRINT " Move a piece to the empty place."

LOCATE 23, 5: PRINT "Move the pieces until you have completed the puzzle. You can only move"
LOCATE 24, 5: PRINT "pieces to the empty (black) place. "
END SUB

SUB check
FOR rgt = 1 TO 16
 IF box(rgt) <> rgt THEN EXIT SUB
NEXT
COLOR 14: LOCATE 26, 5: PRINT "Congratulations!! You have completed the puzzle!!"
COLOR 4: END
END SUB

SUB fieldsetup
FOR temp = 1 TO 16
move temp
SELECT CASE box(temp)
 CASE 1: PUT (x, y), square1, PSET
 CASE 2: PUT (x, y), square2, PSET
 CASE 3: PUT (x, y), square3, PSET
 CASE 4: PUT (x, y), square4, PSET
 CASE 5: PUT (x, y), square5, PSET
 CASE 6: PUT (x, y), square6, PSET
 CASE 7: PUT (x, y), square7, PSET
 CASE 8: PUT (x, y), square8, PSET
 CASE 9: PUT (x, y), square9, PSET
 CASE 10: PUT (x, y), square10, PSET
 CASE 11: PUT (x, y), square11, PSET
 CASE 12: PUT (x, y), square12, PSET
 CASE 13: PUT (x, y), square13, PSET
 CASE 14: PUT (x, y), square14, PSET
 CASE 15: PUT (x, y), square15, PSET
 CASE 16: PUT (x, y), square16, PSET
END SELECT
NEXT
END SUB

SUB game
xold = xcoor: yold = ycoor
LINE (xcoor - 1, ycoor - 1)-(xcoor + 39, ycoor + 39), 4, B
DO: userinput$ = INKEY$: LOOP UNTIL userinput$ <> ""
SELECT CASE userinput$
CASE "8"
 IF ycoor > 163 THEN
  ycoor = ycoor - 40
  loca = loca - 4
  sound$ = "no"
 END IF
CASE "6"
  IF xcoor < 483 THEN
   xcoor = xcoor + 40
   loca = loca + 1
   sound$ = "no"
  END IF
CASE "2"
 IF ycoor < 283 THEN
  ycoor = ycoor + 40
  loca = loca + 4
  sound$ = "no"
 END IF
CASE "4"
 IF xcoor > 363 THEN
  xcoor = xcoor - 40
  loca = loca - 1
  sound$ = "no"
 END IF
CASE CHR$(13)
 SELECT CASE loca
  CASE 1
   IF box(loca + 1) = 1 THEN swapbox 1
   IF box(loca + 4) = 1 THEN swapbox 4
  CASE 2, 3
   IF box(loca - 1) = 1 THEN swapbox -1
   IF box(loca + 1) = 1 THEN swapbox 1
   IF box(loca + 4) = 1 THEN swapbox 4
  CASE 4
   IF box(loca - 1) = 1 THEN swapbox -1
   IF box(loca + 4) = 1 THEN swapbox 4
  CASE 5, 9
   IF box(loca + 1) = 1 THEN swapbox 1
   IF box(loca - 4) = 1 THEN swapbox -4
   IF box(loca + 4) = 1 THEN swapbox 4
  CASE 6, 7, 10, 11
   IF box(loca - 1) = 1 THEN swapbox -1
   IF box(loca + 1) = 1 THEN swapbox 1
   IF box(loca - 4) = 1 THEN swapbox -4
   IF box(loca + 4) = 1 THEN swapbox 4
  CASE 8, 12
   IF box(loca - 1) = 1 THEN swapbox -1
   IF box(loca - 4) = 1 THEN swapbox -4
   IF box(loca + 4) = 1 THEN swapbox 4
  CASE 13
   IF box(loca + 1) = 1 THEN swapbox 1
   IF box(loca - 4) = 1 THEN swapbox -4
  CASE 14, 15
   IF box(loca - 1) = 1 THEN swapbox -1
   IF box(loca + 1) = 1 THEN swapbox 1
   IF box(loca - 4) = 1 THEN swapbox -4
  CASE 16
   IF box(loca - 1) = 1 THEN swapbox -1
   IF box(loca - 4) = 1 THEN swapbox -4
 END SELECT
END SELECT
IF sound$ = "" THEN PLAY "L30GC"
sound$ = ""
LINE (xold - 1, yold - 1)-(xold + 39, yold + 39), 15, B
LINE (xcoor - 1, ycoor - 1)-(xcoor + 39, ycoor + 39), 4, B
END SUB

SUB move (whereto)
SELECT CASE whereto
 CASE 1: x = 363: y = 163
 CASE 2: x = 403: y = 163
 CASE 3: x = 443: y = 163
 CASE 4: x = 483: y = 163
 CASE 5: x = 363: y = 203
 CASE 6: x = 403: y = 203
 CASE 7: x = 443: y = 203
 CASE 8: x = 483: y = 203
 CASE 9: x = 363: y = 243
 CASE 10: x = 403: y = 243
 CASE 11: x = 443: y = 243
 CASE 12: x = 483: y = 243
 CASE 13: x = 363: y = 283
 CASE 14: x = 403: y = 283
 CASE 15: x = 443: y = 283
 CASE 16: x = 483: y = 283
END SELECT
END SUB

SUB swapbox (which)
sound$ = "no"
SELECT CASE which
 CASE -1: box(loca - 1) = box(loca): box(loca) = 1
 CASE 4: box(loca + 4) = box(loca): box(loca) = 1
 CASE 1: box(loca + 1) = box(loca): box(loca) = 1
 CASE -4: box(loca - 4) = box(loca): box(loca) = 1
END SELECT

DO
IF times = 0 THEN variable = loca + which
IF times = 1 THEN variable = loca

move variable
SELECT CASE box(variable)
 CASE 1: PUT (x, y), square1, PSET
 CASE 2: PUT (x, y), square2, PSET
 CASE 3: PUT (x, y), square3, PSET
 CASE 4: PUT (x, y), square4, PSET
 CASE 5: PUT (x, y), square5, PSET
 CASE 6: PUT (x, y), square6, PSET
 CASE 7: PUT (x, y), square7, PSET
 CASE 8: PUT (x, y), square8, PSET
 CASE 9: PUT (x, y), square9, PSET
 CASE 10: PUT (x, y), square10, PSET
 CASE 11: PUT (x, y), square11, PSET
 CASE 12: PUT (x, y), square12, PSET
 CASE 13: PUT (x, y), square13, PSET
 CASE 14: PUT (x, y), square14, PSET
 CASE 15: PUT (x, y), square15, PSET
 CASE 16: PUT (x, y), square16, PSET
END SELECT
times = times + 1
LOOP UNTIL times = 2
times = 0
END SUB