home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 1: Collection A / 17Bit_Collection_A.iso / files / 989.dms / in.adf / Puppy / Puppypix (.txt) < prev   
Encoding:
AmigaBASIC Source Code  |  1990-04-30  |  6.7 KB  |  318 lines
  1. 'PUPPY PIX
  2. ON BREAK GOSUB finale: BREAK ON
  3. LOCATE 7,10
  4. PRINT "Puppy Pictures"
  5. PRINT :PRINT "Setting up camera....."
  6. SAY TRANSLATE$("")
  7. SetUp:
  8.    GOSUB Initialization
  9.    SCREEN 2,640,200,3,2
  10.    WINDOW 2,"",(0,0)-(630,185),12,2
  11.    WINDOW OUTPUT 2
  12.    FOR x=0 TO 15
  13.       PALETTE x,0,0,0
  14.    NEXT
  15.    RANDOMIZE TIMER
  16.    SAY TRANSLATE$("")
  17.    Bark$="AA6RF"
  18.    DIM Biscuits(21),Puppies(3),Decide(12),Moves(12),Board(6,6),Spot(4)
  19.    DIM Bone%(500),Bone2%(500),Pup1%(640),Pup2%(640),Pup3%(640)
  20.    DEF FNF(x)=INT(RND(1)*5+1)
  21.    FOR x=0 TO 8
  22.       READ yip%(x)
  23.    NEXT
  24.    DATA 300,1,350,1,27000,64,10,0,0
  25.    Spot(1)=-10:Spot(2)=10:Spot(3)=-1:Spot(4)=1
  26.    
  27.    OPEN "bone.bob" FOR INPUT AS 1
  28.    OBJECT.SHAPE 1,INPUT$(LOF(1),1)
  29.    CLOSE 1
  30.    OBJECT.X 1,400
  31.    OBJECT.Y 1,20
  32.    OPEN "puppie1.bob" FOR INPUT AS 1
  33.    OBJECT.SHAPE 2,INPUT$(LOF(1),1)
  34.    CLOSE 1
  35.    OBJECT.X 2,400
  36.    OBJECT.Y 2,50
  37.    OPEN "puppie2.bob" FOR INPUT AS 1
  38.    OBJECT.SHAPE 3,INPUT$(LOF(1),1)
  39.    CLOSE 1
  40.    OBJECT.X 3,400
  41.    OBJECT.Y 1,90
  42.    OPEN "puppie3.bob" FOR INPUT AS 1
  43.    OBJECT.SHAPE 5,1
  44.    OBJECT.PLANES 5,6
  45.    OBJECT.X 5,450
  46.    OBJECT.Y 5,90
  47.    OBJECT.SHAPE 4,INPUT$(LOF(1),1)
  48.    CLOSE 1
  49.    OBJECT.X 4,400
  50.    OBJECT.Y 4,130
  51.    OBJECT.ON
  52.    GET (400,0)-(432,40),Pup2%
  53.    GET (400,50)-(450,80),Pup1%
  54.    GET (400,90)-(440,110),Bone%
  55.    GET (450,90)-(490,110),Bone2%
  56.    GET (400,130)-(450,160),Pup3%
  57.    OBJECT.CLOSE
  58. SetColors:
  59.    FOR x=0 TO 7
  60.       READ red,green,blue
  61.       PALETTE x,red,green,blue
  62.    NEXT
  63.    DATA 0.00,0.00,0.00
  64.    DATA 0.93,0.80,0.66
  65.    DATA 0.60,0.33,0.00
  66.    DATA 0.53,0.26,0.00
  67.    DATA 0.40,0.26,0.00
  68.    DATA 0.33,0.20,0.00
  69.    DATA 0.20,0.13,0.00
  70.    DATA 0.66,0.53,0.33
  71.  
  72. DrawBoard:
  73.    Piece=22
  74.    LINE (20,3)-(380,164),1,b
  75.    FOR x = 1 TO 4
  76.       FOR y = 1 TO 4
  77.          LINE (20,3+32*y)-(380,3+32*y)
  78.          LINE (20+72*x,3)-(20+72*x,164)
  79.       NEXT
  80.    NEXT
  81. FillBoard:
  82.    FOR x = 1 TO 5
  83.       FOR y = 1 TO 5
  84.          Board(x,y)=1
  85.       NEXT
  86.    NEXT
  87.    FOR Puppy = 1 TO 3
  88. PlacePup:
  89.       x=FNF(Puppy)
  90.       y=FNF(Puppy)
  91.       IF Board(x,y)=1 THEN   'blank spot
  92.          Board(x,y)=2
  93.          IF Puppy=1 THEN PUT (25+72*(x-1),8+32*(y-1)),Pup1%
  94.          IF Puppy=2 THEN PUT (25+72*(x-1),8+32*(y-1)),Pup2%
  95.          IF Puppy=3 THEN PUT (25+72*(x-1),8+32*(y-1)),Pup3%
  96.       ELSE
  97.          GOTO PlacePup
  98.       END IF
  99.          
  100.       Puppy(Puppy) =x*10+y
  101.    NEXT
  102.          
  103.    FOR x = 1 TO 5
  104.       FOR y = 1 TO 5
  105.          IF Board(x,y)=1 THEN PUT (30+72*(x-1),24+32*(y-1)),Bone%
  106.       NEXT
  107.    NEXT
  108.    
  109. LookMove:
  110.    count=1
  111.    FOR Pup=1 TO 3
  112.       x=INT(Puppy(Pup)/10)
  113.       y=Puppy(Pup) MOD 10
  114. Left:
  115.       IF Board(x-1,y)=0 OR Board(x-1,y)=2 THEN
  116.          Moves(count)=0
  117.          count=count+1
  118.       END IF
  119.       IF Board(x-1,y)=1 THEN   
  120.          Moves=1:Moves1=1
  121.          FOR Check=1 TO 3
  122.             IF Check=Pup THEN Moves1=Moves1-1
  123.             IF x-1=INT(Puppy(Check)/10) THEN Moves=Moves+1
  124.             IF y=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
  125.          NEXT
  126.          Moves(count)=Moves
  127.          IF Moves1>Moves THEN Moves(count)=Moves1   
  128.          count=count+1
  129.       END IF
  130. Right:
  131.       IF Board(x+1,y)=0 OR Board(x+1,y)=2 THEN
  132.          Moves(count)=0
  133.          count=count+1
  134.       END IF
  135.       IF Board(x+1,y)=1 THEN   
  136.          Moves=1:Moves1=1
  137.          FOR Check=1 TO 3
  138.             IF Check=Pup THEN Moves1=Moves1-1
  139.             IF x+1=INT(Puppy(Check)/10) THEN Moves=Moves+1
  140.             IF y=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
  141.          NEXT
  142.          Moves(count)=Moves
  143.          IF Moves1>Moves THEN Moves(count)=Moves1   
  144.          count=count+1
  145.       END IF 
  146.       
  147. Up:
  148.       IF Board(x,y-1)=0 OR Board(x,y-1)=2 THEN
  149.          Moves(count)=0
  150.          count=count+1
  151.       END IF
  152.       IF Board(x,y-1)=1 THEN  
  153.          Moves=1:Moves1=1
  154.          FOR Check=1 TO 3
  155.             IF Check=Pup THEN Moves=Moves-1
  156.             IF x=INT(Puppy(Check)/10) THEN Moves=Moves+1
  157.             IF y-1=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
  158.          NEXT
  159.          Moves(count)=Moves
  160.          IF Moves1>Moves THEN Moves(count)=Moves1   
  161.          count=count+1
  162.       END IF       
  163.         
  164. Down:
  165.       IF Board(x,y+1)=0 OR Board(x,y+1)=2 THEN
  166.          Moves(count)=0
  167.          count=count+1
  168.       END IF
  169.       IF Board(x,y+1)=1 THEN   
  170.          Moves=1:Moves1=1
  171.          FOR Check=1 TO 3
  172.             IF Check=Pup THEN Moves=Moves-1
  173.             IF x=INT(Puppy(Check)/10) THEN Moves=Moves+1
  174.             IF y+1=Puppy(Check) MOD 10 THEN Moves1=Moves1+1
  175.          NEXT
  176.          Moves(count)=Moves
  177.          IF Moves1>Moves THEN Moves(count)=Moves1   
  178.          count=count+1
  179.       END IF 
  180.                       
  181.    NEXT Pup
  182.         
  183.    CutOff=1:Counter=1
  184. DecideMove:
  185.    FOR x=1 TO 12
  186.       IF Moves(x)=CutOff THEN 
  187.          Decide(Counter)=x
  188.          Counter=Counter+1
  189.       END IF   
  190.    NEXT
  191.    IF CutOff=3 AND Counter=1 THEN GOTO GameLost
  192.    IF Counter=1 THEN CutOff=CutOff+1:GOTO DecideMove
  193.  
  194.          
  195. Mover:
  196.    Pick=INT(RND(1)*(Counter-1))+1
  197.    Pup=-(Decide(Pick)>4)-(Decide(Pick)>8)
  198.    Where=Decide(Pick)-4*Pup
  199.    Pup=Pup+1
  200.    OldSpot=Puppy(Pup)
  201.    NewSpot=Puppy(Pup)+Spot(Where)
  202.    Puppy(Pup)=NewSpot
  203.    Oldx=INT(OldSpot/10)
  204.    Oldy=OldSpot-(Oldx*10) 
  205.    Newx=INT(NewSpot/10)
  206.    Newy=NewSpot-(Newx*10)   
  207.    PUT (30+72*(Newx-1),24+32*(Newy-1)),Bone%
  208.    IF Pup=1 THEN 
  209.       PUT (25+72*(Oldx-1),8+32*(Oldy-1)),Pup1%
  210.       PUT (25+72*(Newx-1),8+32*(Newy-1)),Pup1%
  211.    END IF   
  212.    IF Pup=2 THEN 
  213.       PUT (25+72*(Oldx-1),8+32*(Oldy-1)),Pup2%      
  214.       PUT (25+72*(Newx-1),8+32*(Newy-1)),Pup2%
  215.    END IF   
  216.    IF Pup=3 THEN 
  217.       PUT (25+72*(Oldx-1),8+32*(Oldy-1)),Pup3%
  218.       PUT (25+72*(Newx-1),8+32*(Newy-1)),Pup3%
  219.    END IF
  220.    FOR Barks= 1 TO INT(RND*3)+1
  221.       SAY Bark$,yip%
  222.    NEXT
  223.    Board(Oldx,Oldy)=0
  224.    Board(Newx,Newy)=2
  225.    Piece=Piece-1
  226.    IF CutOff=3 AND Counter>1 THEN GOTO GameWon
  227.    IF Piece=0 THEN GOTO GameLost
  228. YourMove:
  229.    WHILE MOUSE(0)<>0:WEND
  230.    WHILE MOUSE(0)=0:WEND         'Select Biscuit
  231.    x=MOUSE(1)
  232.    y=MOUSE(2)
  233.    IF x<20 OR x>380 OR y<3 OR y>164 THEN GOTO YourMove
  234.    GridX=INT((x-20)/72)+1
  235.    GridY=INT((y-3)/36)+1
  236.    IF Board(GridX,GridY)<>1 THEN GOTO YourMove
  237.    PUT (30+72*(GridX-1),24+32*(GridY-1)),Bone%
  238.    PUT (30+72*(GridX-1),24+32*(GridY-1)),Bone2%      ' put routine to indicate choice
  239. Blanker: 
  240.    WHILE MOUSE(0)<>0:WEND
  241.    WHILE MOUSE(0)=0:WEND 
  242.    x1=MOUSE(1)
  243.    y1=MOUSE(2)
  244.    IF x1<20 OR x1>380 OR y1<3 OR y1>164 THEN GOTO Blanker
  245.    SpaceX=INT((x1-20)/72)+1
  246.    SpaceY=INT((y1-3)/36)+1
  247.    IF SpaceX=GridX AND SpaceY=GridY THEN
  248.       PUT (30+72*(SpaceX-1),24+32*(SpaceY-1)),Bone2%,XOR
  249.       PUT (30+72*(SpaceX-1),24+32*(SpaceY-1)),Bone% 'put routine to undo choice
  250.       GOTO YourMove
  251.    END IF   
  252.    IF Board(SpaceX,SpaceY)<>0 THEN GOTO Blanker
  253.    IF SpaceX<>GridX+1 AND SpaceX<>GridX-1 AND SpaceY<>GridY+1 AND SpaceY<>GridY-1 THEN GOTO Blanker
  254.    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
  255.    PUT (30+72*(SpaceX-1),24+32*(SpaceY-1)),Bone%
  256.    PUT (30+72*(GridX-1),24+32*(GridY-1)),Bone2%
  257.    Board(GridX,GridY)=0
  258.    Board(SpaceX,SpaceY)=1
  259.    IF Piece>0 THEN  GOTO LookMove
  260.  
  261. GameLost:
  262.    LOCATE 5,55
  263.    PRINT "YOU LOSE!!!"
  264.    GOTO CleanUp
  265.    
  266. GameWon:
  267.    SCREEN CLOSE 2
  268.    SCREEN 2,640,200,4,2
  269.    WINDOW 2,"",(0,0)-(630,185),12,2
  270.    GOSUB ILBMLoading
  271.    LOCATE 1,55
  272.    PRINT "YOU GOT THE PICTURE!!!!"
  273.                              
  274. CleanUp:
  275.    LOCATE 2,55
  276.    PRINT "Try Again? Y/N";
  277. GetAnswer:
  278.    y$ = INKEY$
  279.    IF UCASE$(y$)="N" THEN 
  280. finale:
  281.       SCREEN CLOSE 2
  282.       SYSTEM
  283.    ELSE
  284.       IF UCASE$(y$)="Y" THEN 
  285.          SCREEN CLOSE 2
  286.          SCREEN 2,640,200,3,2
  287.          WINDOW 2,"",(0,0)-(630,185),12,2
  288.          RESTORE SetColors
  289.          GOTO SetColors
  290.       END IF
  291.    END IF   
  292.    GOTO GetAnswer
  293.       
  294.       
  295. '**************  STRATEGIC SUBROUTINES  ****************************
  296. REM - From Tutorial to use Assembly routines for IFF-ILBM files 
  297. REM - in an AmigaBasic program, by Charles VASSALLO - December 87
  298. REM - (33 route des Traouieros, 22730 Tregastel - France)
  299.  
  300. Initialization:
  301.        DIM code%(1220)    :' these routines require less than 2500 bytes 
  302.        OPEN "ILBM.code" FOR INPUT AS #1 : '(contains assembly code)
  303.        i=0  
  304.        WHILE NOT EOF(1)
  305.         INPUT#1,code%(i) : i=i+1         :' loads the code
  306.        WEND
  307.        CLOSE #1
  308. InitEnd: 
  309.        RETURN
  310.  
  311. ILBMLoading:
  312.        file0$="Close"+CHR$(0)
  313.        ILBMload&=VARPTR(code%(0))          :' safer not to separe
  314.        CALL ILBMload&(SADD(file0$))        :' these 2 lines !!!                              
  315.        RETURN
  316.  
  317.  
  318.