home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 551-575 / apd558 / amoner1 / jigsaw10.amos / jigsaw10.amosSourceCode
AMOS Source Code  |  1993-11-29  |  12KB  |  436 lines
  1. If Fast Free=0
  2.   Load "jigsaw10.bank500"
  3. Else 
  4.   Load "jigsaw10.bank"
  5.   Curs Off : BANANAS
  6. End If 
  7. Randomize Timer : Curs Off 
  8. Cls 0
  9. Gosub MENUS
  10. Unpack 15 To 0
  11. WIDTH=6 : HEIGHT=4 : SIZE=48
  12. Dim BOARD(20,12)
  13. Global WIDTH,HEIGHT,SIZE,BOARD()
  14. BEGIN_THE_GAME:
  15. Menu Active(2,1)
  16. Menu Active(2,2)
  17. Menu Active(2,3)
  18. Rem *************************************  
  19. Rem * Pick Picture and Number of Pieces *  
  20. Rem *************************************  
  21. Do 
  22.   If Choice
  23.     If Choice(1)=2
  24.       If Choice(2)=1
  25.         PICKIFF
  26.       End If 
  27.       If Choice(2)=2 and Choice(3)=1
  28.         WIDTH=5 : HEIGHT=3 : SIZE=64 : Gosub ACTIVE : Menu Inactive(2,2,1)
  29.       End If 
  30.       If Choice(2)=2 and Choice(3)=2
  31.         WIDTH=6 : HEIGHT=4 : SIZE=48 : Gosub ACTIVE : Menu Inactive(2,2,2)
  32.       End If 
  33.       If Choice(2)=2 and Choice(3)=3
  34.         WIDTH=10 : HEIGHT=6 : SIZE=32 : Gosub ACTIVE : Menu Inactive(2,2,3)
  35.       End If 
  36.       If Choice(2)=2 and Choice(3)=4
  37.         WIDTH=20 : HEIGHT=12 : SIZE=16 : Gosub ACTIVE : Menu Inactive(2,2,4)
  38.       End If 
  39.       If Choice(2)=3
  40.         Goto MAIN
  41.       End If 
  42.       If Choice(2)=4
  43.         QUIT
  44.       End If 
  45.     End If 
  46.       If Choice(1)=1 and Choice(2)=1
  47.          ABOUT_MUSIC
  48.       End If 
  49.       If Choice(1)=1 and Choice(2)=2
  50.          ABOUT_BARBARIAN_MINDS
  51.       End If 
  52.   End If 
  53. Loop 
  54. Rem **************** 
  55. Rem * Main Section * 
  56. Rem **************** 
  57. MAIN:
  58.   BUILD_BLOCKS
  59.   SUFFLE
  60.   PLACE_MIX_BOARD
  61.   PLAI
  62.   I_WIN
  63.   Goto BEGIN_THE_GAME
  64. Rem *****************************  
  65. Rem * Set Up Menus and Defaults *
  66. Rem *****************************
  67. MENUS:
  68.   Menu$(1)=" About "
  69.   Menu$(2)=" Options "
  70.   Menu$(1,1)="About Music  "
  71.   Menu$(1,2)="About Barbarian Minds"
  72.   Menu$(2,1)="Pick Iff From Disk"
  73.   Menu$(2,2)="Amount of Pieces  "
  74.   Menu$(2,3)="Play              "
  75.   Menu$(2,4)="Quit              "
  76.   Menu$(2,2,1)="15   "
  77.   Menu$(2,2,2)="24   "
  78.   Menu$(2,2,3)="60   "
  79.   Menu$(2,2,4)="240  "
  80.   Menu Inactive(2,2,2)
  81.   Menu On 
  82. Return 
  83. Rem *************************************  
  84. Rem * Activate of Number of Pieces Menu *
  85. Rem *************************************
  86. ACTIVE:
  87.   Menu Active(2,2,1)
  88.   Menu Active(2,2,2)
  89.   Menu Active(2,2,3)
  90.   Menu Active(2,2,4)
  91. Return 
  92. Procedure PICKIFF
  93. Menu Active(2,3)
  94. FILENAME$=Fsel$("*.iff","","Select an Iff picture")
  95. Rem  
  96. Rem Does the file exists???
  97. Rem
  98. If Exist(FILENAME$)=0 Then FILENAME$=""
  99. Rem  
  100. Rem * Well, have the player really selected an iff pic??? *
  101. Rem
  102. If FILENAME$="" Then Goto NO_IFF
  103. Load Iff FILENAME$,0
  104. NO_IFF:
  105. Rem
  106. Rem * If screen size is diffrent then 320x200 *
  107. Rem * Don't allow the play option.            *
  108. Rem
  109.   If Screen Width<>320 or Screen Height<>200 Then Menu Inactive(2,3)
  110. End Proc
  111. Procedure QUIT
  112.   Default 
  113.   Run "Start.Amos"
  114. End Proc
  115. Procedure BUILD_BLOCKS
  116. Rem *******************************************************
  117. Rem * This procedure sets the board face into board() and *
  118. Rem * picks up the blocks into memory.                    *
  119. Rem *******************************************************
  120.   For Y=1 To HEIGHT
  121.     For X=1 To WIDTH
  122.       BOARD(X,Y)=((Y-1)*WIDTH)+X
  123.       XC=SIZE*(X-1) : YC=(Y-1)*SIZE
  124.       PIECE=((Y-1)*WIDTH)+X
  125.       Get Block PIECE,XC,YC,SIZE,SIZE
  126.     Next X
  127.   Next Y
  128. Rem
  129. Rem * Limiting the mouse, and inactving menus... * 
  130. Rem
  131.   Limit Mouse X Hard(0),Y Hard(0) To X Hard(WIDTH*SIZE)-1,Y Hard(HEIGHT*SIZE)-1
  132.   Menu Inactive(2,1)
  133.   Menu Inactive(2,2)
  134.   Menu Inactive(2,3)
  135. End Proc
  136. Procedure SUFFLE
  137. Rem ****************************** 
  138. Rem * Here we suffle the board() * 
  139. Rem ****************************** 
  140.   SUM=HEIGHT*WIDTH
  141.   For X=1 To SUM*5
  142.     X1=(Rnd(WIDTH-1))+1
  143.     Y1=(Rnd(HEIGHT-1))+1
  144.     X2=(Rnd(WIDTH-1))+1
  145.     Y2=(Rnd(HEIGHT-1))+1
  146.     Swap BOARD(X1,Y1),BOARD(X2,Y2)
  147.   Next X
  148. End Proc
  149. Procedure PLACE_MIX_BOARD
  150. Rem *********************************************************  
  151. Rem * Now it's time to draw the suffled board using board() *
  152. Rem * and the blocks in the memory...                       *
  153. Rem *********************************************************
  154.   For Y=1 To HEIGHT
  155.     For X=1 To WIDTH
  156.       PIECE=BOARD(X,Y)
  157.       XC=SIZE*(X-1) : YC=(Y-1)*SIZE
  158.       Put Block PIECE,XC,YC
  159.     Next X
  160.   Next Y
  161. End Proc
  162. Procedure PLAI
  163. Rem
  164. Rem * init vers *
  165. Rem
  166.   X=1 : Y=1 : C=0 : LC=Screen Colour : T=0 : RX=0 : RY=0 : WIN=0
  167.   WATCH_CUR:
  168. Rem
  169. Rem * Get the square cords of the corrent position... *
  170. Rem * xc,yc = x and y upper left corner               *
  171. Rem * x1c,y1c = x and y lower right corner            *
  172. Rem
  173.     XC=SIZE*(X-1) : YC=(Y-1)*SIZE
  174.     X1C=(SIZE*(X-1))+(SIZE-1) : Y1C=((Y-1)*SIZE)+(SIZE-1)
  175.     XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  176. Rem
  177. Rem * XM and YM are the corrent mouse cords. * 
  178. Rem * Here we check the mouse pointer is     * 
  179. Rem * Still inside the current square        * 
  180. Rem
  181.       While((XM=>XC) and(XM<=X1C) and(YM=>YC) and(YM<=Y1C))
  182. Rem
  183. Rem * Update XM and XY + draw a box around the currect square *
  184. Rem
  185.         XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
  186.         Inc C
  187.         If C>LC Then C=0
  188.         Ink C
  189.         Box XC,YC To X1C,Y1C
  190. Rem
  191. Rem * Did someone click the mouse? * 
  192. Rem * If yes, mark the box.        * 
  193. Rem
  194.         If Mouse Click=1 Then Gosub CLICKED_MARK
  195. Rem  
  196. Rem * After returning from the box cliping * 
  197. Rem * The computer might find you won...   * 
  198. Rem
  199.         If WIN=1 Then Pop Proc
  200. Rem
  201. Rem * And last, let's not forget the Menus... *
  202. Rem * if is still possible to quit you know.. *
  203. Rem
  204.         If Choice(2)=4 Then QUIT
  205.       Wend 
  206. Rem  
  207. Rem * Oooooops, mouse left the corect sqaure... *  
  208. Rem * Cover the square with the right block and *
  209. Rem * Get the new cords to new current square.  *
  210. Rem * By the way, if the square is marked, the  *
  211. Rem * Sqaure will not be covered so the marking *
  212. Rem * will stay...                              *
  213. Rem
  214.     PIECE=BOARD(X,Y)
  215.     XC=SIZE*(X-1) : Y1C=(Y-1)*SIZE
  216.     If Not(T=1 and X=RX and Y=RY) Then Put Block PIECE,XC,YC
  217.     X=Int(XM/SIZE)+1 : Y=Int(YM/SIZE)+1
  218.   Goto WATCH_CUR
  219. Rem
  220. Rem * Mouse Been clicked... *
  221. Rem
  222.   CLICKED_MARK:
  223.   Inc T : MARKC=0
  224. Rem
  225. Rem * If mouse was clicked for the first time, Mark *
  226. Rem * the clicked Square. Otherwise, swap Squares   *
  227. Rem
  228.   If T=2 Then Goto SWEEP
  229. Rem
  230. Rem * Marking Square * 
  231. Rem
  232.   For MARK=0 To SIZE-1
  233.       Inc MARKC
  234.       If MARKC>LC Then MARKC=0
  235.       Plot XC+MARK,YC+MARK,MARKC
  236.       Plot XC+MARK,Y1C-MARK,MARKC
  237.   Next MARK
  238.     RX=X : RY=Y
  239.   Return 
  240. Rem  
  241. Rem * Swaping Squares. * 
  242. Rem  
  243.   SWEEP:
  244.     PIECE1=BOARD(X,Y) : PIECE2=BOARD(RX,RY)
  245.     X1C=SIZE*(X-1) : Y1C=(Y-1)*SIZE
  246.     X2C=SIZE*(RX-1) : Y2C=(RY-1)*SIZE
  247.     Put Block PIECE1,X2C,Y2C
  248.     Put Block PIECE2,X1C,Y1C
  249.     T=0
  250.     Swap BOARD(X,Y),BOARD(RX,RY)
  251. Rem
  252. Rem * Since squres were swaped, we need to check for win... *
  253. Rem
  254.   Gosub WINNING
  255.   Return 
  256.   WINNING:
  257.   WIN=1
  258.   For LINE=1 To HEIGHT
  259.     For ROW=1 To WIDTH
  260. Rem
  261. Rem * If board is not in Order, no win... *
  262. Rem
  263.       If BOARD(ROW,LINE)<>(((LINE-1)*WIDTH)+ROW) Then WIN=0
  264.     Next ROW
  265.   Next LINE
  266.   Return 
  267. End Proc
  268. Procedure I_WIN
  269. Rem *********************
  270. Rem * Winning Procedure *
  271. Rem *********************
  272. Rem  
  273. Rem * First we load the present color registers into * 
  274. Rem * The Vers c0 and c0.                            * 
  275. Rem  
  276.   C0=Colour(0)
  277.   C1=Colour(1)
  278. Rem  
  279. Rem * Now we load registers 0 and 1 with * 
  280. Rem * Black and White colours...         * 
  281. Rem  
  282.   Colour 0,$0
  283.   Colour 1,$FFF
  284. Rem  
  285. Rem * Opening window to display congrtulations massage. *
  286. Rem
  287.   Wind Save : Curs Off 
  288.   Wind Open 1,80,80,18,3
  289.   Window 1 : Wait Vbl 
  290.   Paper 0 : Clw : Curs Off 
  291.   Pen 1 : Print : Print " Congratulations!"
  292.   Repeat : Until Mouse Key
  293.   Wind Close 
  294.   Colour 0,C0
  295.   Colour 1,C1
  296. End Proc
  297. Procedure BANANAS
  298. Rem *********************************************************
  299. Rem * Here is a great example of how NOT to program in AMOS *
  300. Rem * This 20 seconed introduction uses 3 320x200x32        *
  301. Rem * screens, consuming about 500k... Sure there is some   *
  302. Rem * easy way to cut that down, but I'm just too lazy....  *
  303. Rem *********************************************************
  304.   Auto View Off 
  305.   Unpack 14 To 1
  306.   Screen Hide 1
  307.   Auto View On 
  308.   Get Palette 1
  309.   Screen Open 2,320,256,32,LORES
  310.   Screen Open 0,320,256,32,LORES
  311.   Screen 0
  312.   Screen Show 1
  313.   Cls 0
  314.   Ink 6,0 : Text 92,100,"Barbarian Minds"
  315.             Text 117,120,"Presents:"
  316.   Double Buffer 
  317.   Music 1
  318.   Wait 375
  319.   Cls 0
  320.   Get Palette 1
  321.   For A=1 To 12
  322.     Channel A To Bob A
  323.     Bob A,10,0,A
  324.   Next A
  325.   BNUMBER=1
  326.   For X=0 To 290 Step 99
  327.     For Y=60 To 190 Step 34
  328.       WIDTH=X-10
  329.       HEIGHT=Y
  330.       S$=Str$(WIDTH)+","+Str$(HEIGHT)+",140"
  331.       Amal BNUMBER,"M "+S$
  332.       Inc BNUMBER
  333.     Next Y
  334.   Next X
  335.   Amal On : 
  336.   Wait 250 : Screen 2 : Wait Vbl : Get Palette 1 : Cls 0
  337.   Wait Vbl : Screen Copy 1,0,60,300,200 To 2,0,60
  338.   Screen To Front 2 : Screen Close 0 : Wait Vbl 
  339.   Appear 1 To 2,1,32000
  340.   A=20
  341.   While A>1
  342.     Ink 0
  343.     Bar 105,215 To 180,250
  344.     Wait A/2
  345.     Screen Copy 1,105,215,180,250 To 2,105,215
  346.     Wait A
  347.     A=A/1.1
  348.   Wend 
  349.   Wait 400
  350.   Cls 0 : Wait Vbl : Get Palette 1 : Wait Vbl : Ink 2,0 : Wait Vbl 
  351.   Text 60,30,"Program By Gal-on Broner"
  352.   Text 60,70,"  Music And Iffs taken "
  353.   Text 60,90,"From Various Pd Centers."
  354.   Screen Copy 1,105,215,180,250 To 2,115,150
  355.   Repeat : Until Mouse Click
  356.   Screen Close 1 : Wait Vbl : Screen Close 2 : Wait Vbl : Default 
  357. End Proc
  358. Procedure ABOUT_MUSIC
  359. Rem  
  360. Rem * First we load the present color registers into * 
  361. Rem * The Vers c0 and c0.                            * 
  362. Rem  
  363.   C0=Colour(0)
  364.   C1=Colour(1)
  365. Rem  
  366. Rem * Now we load registers 0 and 1 with * 
  367. Rem * Black and White colours...         * 
  368. Rem  
  369.   Colour 0,$0
  370.   Colour 1,$FFF
  371. Rem  
  372. Rem * Opening window to display about music info. *
  373. Rem
  374.   Wind Save : Curs Off 
  375.   Wind Open 1,10,10,38,14
  376.   Window 1 : Wait Vbl 
  377.   Paper 0 : Clw : Curs Off 
  378.   Pen 1 : Print 
  379.   Centre "While Most of my friends agree" : Print 
  380.   Centre "that I have reasonable programming" : Print 
  381.   Centre "technique, they seem to hold" : Print 
  382.   Centre "something against my musical taste." : Print 
  383.   Centre "Each time they hear a melody I've" : Print 
  384.   Centre "composed, they murmur something" : Print 
  385.   Centre "about eating lunch lately and" : Print 
  386.   Centre "wanting to keep it INSIDE." : Print 
  387.   Centre "Oh well :) That's why the music is" : Print 
  388.   Centre "a PD MOD I found and not my own" : Print 
  389.   Centre "creation...." : Print 
  390.   Repeat : Until Mouse Key
  391.   Wind Close 
  392.   Colour 0,C0
  393.   Colour 1,C1
  394. End Proc
  395. Procedure ABOUT_BARBARIAN_MINDS
  396. Rem  
  397. Rem * First we load the present color registers into * 
  398. Rem * The Vers c0 and c0.                            * 
  399. Rem  
  400.   C0=Colour(0)
  401.   C1=Colour(1)
  402. Rem  
  403. Rem * Now we load registers 0 and 1 with * 
  404. Rem * Black and White colours...         * 
  405. Rem  
  406.   Colour 0,$0
  407.   Colour 1,$FFF
  408. Rem  
  409. Rem * Opening window to display about music info. *
  410. Rem
  411.   Wind Save : Curs Off 
  412.   Wind Open 1,10,10,38,12
  413.   Window 1 : Wait Vbl 
  414.   Paper 0 : Clw : Curs Off 
  415.   Pen 1 : Print 
  416.   Centre "I always did like puzzles. So did" : Print 
  417.   Centre "my friend, Yuval Miinster. After" : Print 
  418.   Centre "we wrote our first serious game" : Print 
  419.   Centre "on the App*e we decided that" : Print 
  420.   Centre "amazing coders such as ourself" : Print 
  421.   Centre "needed a name (we were all young" : Print 
  422.   Centre "and foolish then). So we took the" : Print 
  423.   Centre "'B' from Broner and 'M' from" : Print 
  424.   Centre "Miinster and created Barbarian Minds." : Print 
  425.   Repeat : Until Mouse Key
  426.   Clw 
  427.   Centre "So... if you like puzzels and you" : Print 
  428.   Centre "have a 'B' or a 'M' somewhere, and" : Print 
  429.   Centre "you can find us 20 usages for a towel" : Print 
  430.   Centre "other then covering your eyes with," : Print 
  431.   Centre "You are welcome to join us :)" : Print 
  432.   Repeat : Until Mouse Key
  433.   Wind Close 
  434.   Colour 0,C0
  435.   Colour 1,C1
  436. End Proc