home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
17 Bit Software 1: Collection A
/
17Bit_Collection_A.iso
/
files
/
989.dms
/
989.adf
/
Puppy
/
Puppypix
(
.txt
)
< prev
next >
Wrap
AmigaBASIC Source Code
|
1990-04-30
|
7KB
|
318 lines
'PUPPY PIX
ON BREAK GOSUB finale: BREAK ON
LOCATE 7,10
PRINT "Puppy Pictures"
PRINT :PRINT "Setting up camera....."
SAY TRANSLATE$("")
SetUp:
GOSUB Initialization
SCREEN 2,640,200,3,2
WINDOW 2,"",(0,0)-(630,185),12,2
WINDOW OUTPUT 2
FOR x=0 TO 15
PALETTE x,0,0,0
NEXT
RANDOMIZE TIMER
SAY TRANSLATE$("")
Bark$="AA6RF"
DIM Biscuits(21),Puppies(3),Decide(12),Moves(12),Board(6,6),Spot(4)
DIM Bone%(500),Bone2%(500),Pup1%(640),Pup2%(640),Pup3%(640)
DEF FNF(x)=INT(RND(1)*5+1)
FOR x=0 TO 8
READ yip%(x)
NEXT
DATA 300,1,350,1,27000,64,10,0,0
Spot(1)=-10:Spot(2)=10:Spot(3)=-1:Spot(4)=1
OPEN "bone.bob" FOR INPUT AS 1
OBJECT.SHAPE 1,INPUT$(LOF(1),1)
CLOSE 1
OBJECT.X 1,400
OBJECT.Y 1,20
OPEN "puppie1.bob" FOR INPUT AS 1
OBJECT.SHAPE 2,INPUT$(LOF(1),1)
CLOSE 1
OBJECT.X 2,400
OBJECT.Y 2,50
OPEN "puppie2.bob" FOR INPUT AS 1
OBJECT.SHAPE 3,INPUT$(LOF(1),1)
CLOSE 1
OBJECT.X 3,400
OBJECT.Y 1,90
OPEN "puppie3.bob" FOR INPUT AS 1
OBJECT.SHAPE 5,1
OBJECT.PLANES 5,6
OBJECT.X 5,450
OBJECT.Y 5,90
OBJECT.SHAPE 4,INPUT$(LOF(1),1)
CLOSE 1
OBJECT.X 4,400
OBJECT.Y 4,130
OBJECT.ON
GET (400,0)-(432,40),Pup2%
GET (400,50)-(450,80),Pup1%
GET (400,90)-(440,110),Bone%
GET (450,90)-(490,110),Bone2%
GET (400,130)-(450,160),Pup3%
OBJECT.CLOSE
SetColors:
FOR x=0 TO 7
READ red,green,blue
PALETTE x,red,green,blue
NEXT
DATA 0.00,0.00,0.00
DATA 0.93,0.80,0.66
DATA 0.60,0.33,0.00
DATA 0.53,0.26,0.00
DATA 0.40,0.26,0.00
DATA 0.33,0.20,0.00
DATA 0.20,0.13,0.00
DATA 0.66,0.53,0.33
DrawBoard:
Piece=22
LINE (20,3)-(380,164),1,b
FOR x = 1 TO 4
FOR y = 1 TO 4
LINE (20,3+32*y)-(380,3+32*y)
LINE (20+72*x,3)-(20+72*x,164)
NEXT
NEXT
FillBoard:
FOR x = 1 TO 5
FOR y = 1 TO 5
Board(x,y)=1
NEXT
NEXT
FOR Puppy = 1 TO 3
PlacePup:
x=FNF(Puppy)
y=FNF(Puppy)
IF Board(x,y)=1 THEN 'blank spot
Board(x,y)=2
IF Puppy=1 THEN PUT (25+72*(x-1),8+32*(y-1)),Pup1%
IF Puppy=2 THEN PUT (25+72*(x-1),8+32*(y-1)),Pup2%
IF Puppy=3 THEN PUT (25+72*(x-1),8+32*(y-1)),Pup3%
ELSE
GOTO PlacePup
END IF
Puppy(Puppy) =x*10+y
NEXT
FOR x = 1 TO 5
FOR y = 1 TO 5
IF Board(x,y)=1 THEN PUT (30+72*(x-1),24+32*(y-1)),Bone%
NEXT
NEXT
LookMove:
count=1
FOR Pup=1 TO 3
x=INT(Puppy(Pup)/10)
y=Puppy(Pup) MOD 10
Left:
IF Board(x-1,y)=0 OR Board(x-1,y)=2 THEN
Moves(count)=0
count=count+1
END IF
IF Board(x-1,y)=1 THEN
Moves=1:Moves1=1
FOR Check=1 TO 3
IF Check=Pup THEN Moves1=Moves1-1
IF x-1=INT(Puppy(Check)/10) THEN Moves=Moves+1
IF y=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
NEXT
Moves(count)=Moves
IF Moves1>Moves THEN Moves(count)=Moves1
count=count+1
END IF
Right:
IF Board(x+1,y)=0 OR Board(x+1,y)=2 THEN
Moves(count)=0
count=count+1
END IF
IF Board(x+1,y)=1 THEN
Moves=1:Moves1=1
FOR Check=1 TO 3
IF Check=Pup THEN Moves1=Moves1-1
IF x+1=INT(Puppy(Check)/10) THEN Moves=Moves+1
IF y=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
NEXT
Moves(count)=Moves
IF Moves1>Moves THEN Moves(count)=Moves1
count=count+1
END IF
Up:
IF Board(x,y-1)=0 OR Board(x,y-1)=2 THEN
Moves(count)=0
count=count+1
END IF
IF Board(x,y-1)=1 THEN
Moves=1:Moves1=1
FOR Check=1 TO 3
IF Check=Pup THEN Moves=Moves-1
IF x=INT(Puppy(Check)/10) THEN Moves=Moves+1
IF y-1=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
NEXT
Moves(count)=Moves
IF Moves1>Moves THEN Moves(count)=Moves1
count=count+1
END IF
Down:
IF Board(x,y+1)=0 OR Board(x,y+1)=2 THEN
Moves(count)=0
count=count+1
END IF
IF Board(x,y+1)=1 THEN
Moves=1:Moves1=1
FOR Check=1 TO 3
IF Check=Pup THEN Moves=Moves-1
IF x=INT(Puppy(Check)/10) THEN Moves=Moves+1
IF y+1=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
NEXT
Moves(count)=Moves
IF Moves1>Moves THEN Moves(count)=Moves1
count=count+1
END IF
NEXT Pup
CutOff=1:Counter=1
DecideMove:
FOR x=1 TO 12
IF Moves(x)=CutOff THEN
Decide(Counter)=x
Counter=Counter+1
END IF
NEXT
IF CutOff=3 AND Counter=1 THEN GOTO GameLost
IF Counter=1 THEN CutOff=CutOff+1:GOTO DecideMove
Mover:
Pick=INT(RND(1)*(Counter-1))+1
Pup=-(Decide(Pick)>4)-(Decide(Pick)>8)
Where=Decide(Pick)-4*Pup
Pup=Pup+1
OldSpot=Puppy(Pup)
NewSpot=Puppy(Pup)+Spot(Where)
Puppy(Pup)=NewSpot
Oldx=INT(OldSpot/10)
Oldy=OldSpot-(Oldx*10)
Newx=INT(NewSpot/10)
Newy=NewSpot-(Newx*10)
PUT (30+72*(Newx-1),24+32*(Newy-1)),Bone%
IF Pup=1 THEN
PUT (25+72*(Oldx-1),8+32*(Oldy-1)),Pup1%
PUT (25+72*(Newx-1),8+32*(Newy-1)),Pup1%
END IF
IF Pup=2 THEN
PUT (25+72*(Oldx-1),8+32*(Oldy-1)),Pup2%
PUT (25+72*(Newx-1),8+32*(Newy-1)),Pup2%
END IF
IF Pup=3 THEN
PUT (25+72*(Oldx-1),8+32*(Oldy-1)),Pup3%
PUT (25+72*(Newx-1),8+32*(Newy-1)),Pup3%
END IF
FOR Barks= 1 TO INT(RND*3)+1
SAY Bark$,yip%
NEXT
Board(Oldx,Oldy)=0
Board(Newx,Newy)=2
Piece=Piece-1
IF CutOff=3 AND Counter>1 THEN GOTO GameWon
IF Piece=0 THEN GOTO GameLost
YourMove:
WHILE MOUSE(0)<>0:WEND
WHILE MOUSE(0)=0:WEND 'Select Biscuit
x=MOUSE(1)
y=MOUSE(2)
IF x<20 OR x>380 OR y<3 OR y>164 THEN GOTO YourMove
GridX=INT((x-20)/72)+1
GridY=INT((y-3)/36)+1
IF Board(GridX,GridY)<>1 THEN GOTO YourMove
PUT (30+72*(GridX-1),24+32*(GridY-1)),Bone%
PUT (30+72*(GridX-1),24+32*(GridY-1)),Bone2% ' put routine to indicate choice
Blanker:
WHILE MOUSE(0)<>0:WEND
WHILE MOUSE(0)=0:WEND
x1=MOUSE(1)
y1=MOUSE(2)
IF x1<20 OR x1>380 OR y1<3 OR y1>164 THEN GOTO Blanker
SpaceX=INT((x1-20)/72)+1
SpaceY=INT((y1-3)/36)+1
IF SpaceX=GridX AND SpaceY=GridY THEN
PUT (30+72*(SpaceX-1),24+32*(SpaceY-1)),Bone2%,XOR
PUT (30+72*(SpaceX-1),24+32*(SpaceY-1)),Bone% 'put routine to undo choice
GOTO YourMove
END IF
IF Board(SpaceX,SpaceY)<>0 THEN GOTO Blanker
IF SpaceX<>GridX+1 AND SpaceX<>GridX-1 AND SpaceY<>GridY+1 AND SpaceY<>GridY-1 THEN GOTO Blanker
IF (SpaceX=GridX+1 AND (SpaceY=GridY+1 OR SpaceY=GridY-1)) OR (SpaceX=GridX-1 AND (SpaceY=GridY+1 OR SpaceY=GridY-1)) THEN GOTO Blanker
PUT (30+72*(SpaceX-1),24+32*(SpaceY-1)),Bone%
PUT (30+72*(GridX-1),24+32*(GridY-1)),Bone2%
Board(GridX,GridY)=0
Board(SpaceX,SpaceY)=1
IF Piece>0 THEN GOTO LookMove
GameLost:
LOCATE 5,55
PRINT "YOU LOSE!!!"
GOTO CleanUp
GameWon:
SCREEN CLOSE 2
SCREEN 2,640,200,4,2
WINDOW 2,"",(0,0)-(630,185),12,2
GOSUB ILBMLoading
LOCATE 1,55
PRINT "YOU GOT THE PICTURE!!!!"
CleanUp:
LOCATE 2,55
PRINT "Try Again? Y/N";
GetAnswer:
y$ = INKEY$
IF UCASE$(y$)="N" THEN
finale:
SCREEN CLOSE 2
SYSTEM
ELSE
IF UCASE$(y$)="Y" THEN
SCREEN CLOSE 2
SCREEN 2,640,200,3,2
WINDOW 2,"",(0,0)-(630,185),12,2
RESTORE SetColors
GOTO SetColors
END IF
END IF
GOTO GetAnswer
'************** STRATEGIC SUBROUTINES ****************************
REM - From Tutorial to use Assembly routines for IFF-ILBM files
REM - in an AmigaBasic program, by Charles VASSALLO - December 87
REM - (33 route des Traouieros, 22730 Tregastel - France)
Initialization:
DIM code%(1220) :' these routines require less than 2500 bytes
OPEN "ILBM.code" FOR INPUT AS #1 : '(contains assembly code)
i=0
WHILE NOT EOF(1)
INPUT#1,code%(i) : i=i+1 :' loads the code
WEND
CLOSE #1
InitEnd:
RETURN
ILBMLoading:
file0$="Close"+CHR$(0)
ILBMload&=VARPTR(code%(0)) :' safer not to separe
CALL ILBMload&(SADD(file0$)) :' these 2 lines !!!
RETURN