home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 501-525 / apd503 / fabrizio_bazzo / hideandseek.amos / hideandseek.amosSourceCode
AMOS Source Code  |  1986-08-03  |  13KB  |  478 lines
  1. '
  2. ' SOLITAIRE PROJECT     ***************  
  3. ' by Fabrizio Bazzo     * Hide'n'seek *      
  4. ' 0481/22018 GO (I)     ***************  
  5. '  
  6. ' About SOLITAIRE PROJECT: 
  7. '
  8. ' SOME TIME AGO, I FOUND A LITTLE OLD BOOK WITH MORE THEN      
  9. ' ONE HUNDRED SOLITAIRES INSIDE,SOME OF WHICH ASCRIBED TO    
  10. ' NAPOLEON; I LIKE CARD GAMES VERY MUCH, SO I WROTE A FEW    
  11. ' PROCEDURES IN AMIGABASIC, RECENTLY CONVERTED IN  AMOS, TO    
  12. ' DEAL WITH TYPICAL PROBLEMS OF THIS TYPE OF GAMES: PICK A   
  13. ' CARD, PUT IT SOMEWHERE ELSE ,CHECK FOR CORRECT MOVES, ETC. 
  14. ' HIDE 'N'SEEK IS THE SIMPLEST OF THE CARD GAMES THAT I KNOW,  
  15. ' SO IT 'S  GOOD FOR TEST THE CARD-GAME ENGINE; THIS IS ALSO   
  16. ' THE REASON WHY IT LOOKS SO TRIVIAL.  
  17. ' (NO,I 'M NOT  GOING TO WRITE MORE THEN ONE HUNDRED CARD GAMES, 
  18. ' MAY BE JUST FOUR OR FIVE, BUT ***YOU*** COULD WRITE THE OTHER    
  19. ' 95 WITH VERY LITTLE EFFORT, IF YOU DECIDE TO HAVE A CLOSE LOOK 
  20. ' AT THESE LISTINGS (THAT IS HIDE'N'SEEK, GALLERY AND MEFISTOFELE))    
  21. ' AND IF YOU ALSO HAVE THAT BOOK, OF COURSE... SINCE YOU ARE READING   
  22. ' THIS, YOU OBVIOUSLY ALREADY HAVE THE MAIN TOOL (THANKS, MR. LIONET)
  23. '
  24. ' I DID MY BEST TO COMMENT THIS SOURCE, BUT UNFORTUNATLY THE ENGLISH 
  25. ' IS NOT MY LANGUAGE (MAY BE AMOS IS), SO YOU'LL PROBABLY FIND 
  26. ' THE CHOICE OF SOME WORDS UNUSUAL OR PRETTY SILLY; BE UNDERSTANDING.  
  27. '  
  28. ' number of detect zones = number of heaps 
  29. NZONE=13
  30. ' card image width 
  31. CW=64
  32. ' card image height
  33. CH=48
  34. ' number of cards (no jolly here)
  35. NCARDS=52
  36. '
  37. 'ZNDEF() holds x,y coords for each detect zone 
  38. '
  39. 'HOUSE() holds the full description for each heap; it is dimensioned   
  40. '        (number_of_heaps,max_number_of_card_per_heap)         
  41. '        each vector is structured as follows: 
  42. '
  43. '        HOUSE(Heap,0) : number of cards present 
  44. '        HOUSE(Heap, 1..HOUSE(Heap,0) ) : every single card
  45. '
  46. '         1,..,13    Ace,..,King   of  Hearts
  47. '        14,..,26     "      "     "   Diamonds
  48. '        27,..,39     "      "     "   Clubs 
  49. '        40,..,52     "      "     "   Spades
  50. '
  51. '  To easily recognize every card two functions are defined: 
  52. '      
  53. '        FN Suit(x) : returns 0 (Hearts) to 3 (Spades) 
  54. '        FN Vlue(x) : returns 1 (Ace) to 13 (King) 
  55. '
  56. '  Seek for more info inside the procedures
  57. '
  58. 'Load ":abk/cards1.abk"  
  59. Dim ZNDEF(NZONE*2),HOUSE(NZONE,5),HEAP(NCARDS)
  60. '
  61. Global ZNDEF(),HOUSE(),HEAP(),OBJ,CW,CH,NCARDS,ACTCARD,FINISHED
  62. Global FIRSTTIME,NZONE,FROM,LAST,GRABBED,RELEASED,OK,UFFA,AGAIN
  63. '
  64. ENABLE
  65. Repeat 
  66.    NEWGAME
  67.    Repeat 
  68.       If AGAIN=0 Then CHECKOPT
  69.    Until UFFA or AGAIN
  70. Until UFFA
  71. DISABLE
  72. End 
  73. '
  74. Procedure NEWGAME
  75. '
  76. ' this is the main procedure of the program  
  77. '
  78. INITHEAP
  79. MIX
  80. '
  81. ' this section may vary a lot from game to game, depending on the number 
  82. ' and the content of every zone, and the global vars needed;   
  83. ' in this case only FIRSTTIME is HideAndSeek-specific  
  84. '
  85. For I=1 To NZONE
  86.   HOUSE(I,0)=4
  87.   For J=1 To 4
  88.     HOUSE(I,J)=(HEAP(J+4*(I-1)) or 128) : Rem distribution  128=covered  
  89.   Next 
  90.   DRWFIRST[I] : Rem draw the firts of the heap 
  91. Next 
  92. CLEAR[228,92,440,103]
  93. GRABBED=0 : RELEASED=1 : FIRSTTIME=1 : FINISHED=0 : AGAIN=0
  94. '
  95. ' this section require only minor changes, tipically for calls to game-
  96. ' specific procedures (compare with Gallery and/or Mefistofele sources)  
  97. '
  98. While FINISHED=0
  99.   If GRABBED
  100.     While RELEASED=0
  101.       If OBJ
  102.         Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),ACTCARD
  103.       End If 
  104.       If Mouse Click
  105.          If Mouse Key=1
  106.            ACTLIST=Mouse Zone
  107.            CHECKRULES[ACTLIST,0]
  108.            If OK
  109.              ADCARD[ACTLIST,1]
  110.              CHECKFINISH
  111.              GRABBED=0
  112.              RELEASED=1
  113.            End If 
  114.          Else 
  115.             CHECKOPT
  116.          End If 
  117.       End If 
  118.     Wend 
  119.   Else 
  120.       While RELEASED=1
  121.       If Mouse Click
  122.          If Mouse Key=1
  123.            ACTLIST=Mouse Zone
  124.            CHECKRULES[ACTLIST,1]
  125.            If OK
  126.              GRABCARD[ACTLIST]
  127.              GRABBED=1
  128.              RELEASED=0
  129.            End If 
  130.          Else 
  131.             CHECKOPT
  132.          End If 
  133.       End If 
  134.     Wend 
  135.   End If 
  136. Wend 
  137. End Proc
  138. Procedure MAKEZONE[NZONE]
  139. '
  140. ' defines the detect zones, with standard size (CW,CH) 
  141. '
  142. ZNEDATA:
  143. Data 87,42,165,42,243,42,321,42,399,42,477,42
  144. Data 87,106,165,106,243,106,321,106,399,106,477,106,87,170
  145. Restore ZNEDATA
  146. Reserve Zone NZONE+4
  147. For I=1 To NZONE
  148.    Read C1,C2
  149.    J=I*2-1
  150.    ZNDEF(J)=C1 : ZNDEF(J+1)=C2
  151.    Set Zone I,C1,C2 To C1+CW,C2+CH
  152. Next 
  153. For I=1 To 4
  154.    Set Zone NZONE+I,470+(I-1)*40,233 To 508+(I-1)*40,243 : Rem opts gadget  
  155. Next 
  156. End Proc
  157. Procedure CLEARZONE[ZNE]
  158. '  this does not need any comment  
  159.    I=ZNE*2-3
  160.    CLEAR[ZNDEF(I),ZNDEF(I+1),ZNDEF(I)+CW,ZNDEF(I+1)+CH]
  161. End Proc
  162. Procedure INITHEAP
  163. ' a very dull initialization 
  164. ' note: if you use 104 cards You should modify it a little   
  165.   For I=1 To NCARDS
  166.     HEAP(I)=I
  167.   Next 
  168. End Proc
  169. Procedure MIX
  170. ' frrrrrr....
  171.   Randomize Timer
  172.   For I=1 To NCARDS
  173.     J=Rnd(NCARDS-1)+1
  174.     Swap HEAP(I),HEAP(J)
  175.   Next 
  176. End Proc
  177. Procedure DRWFIRST[N]
  178. '
  179. ' draws the first card of the heap N, if any;  
  180. ' (covered cards have the bit number 7 set)
  181. ' if not, simply deletes the previous image  
  182. '
  183.   M=(N-1)*2+1 : Rem 1,2,3,4,.. => 1,3,5,7,...
  184.   If HOUSE(N,0) and 127 : Rem at least one card  
  185.     If HOUSE(N,1) and 128 : Rem visible?     
  186.     Paste Bob ZNDEF(M),ZNDEF(M+1),53 : Rem no 
  187.     Else 
  188.       IMAGE=(HOUSE(N,1) and 127) : Rem 1,..,52  
  189.       Paste Bob ZNDEF(M),ZNDEF(M+1),IMAGE
  190.     End If 
  191.   Else 
  192.     CLEARZONE[N]
  193.   End If 
  194. End Proc
  195. Procedure ADCARD[N,MDE]
  196. '
  197. ' adds the grabbed card to the heap N;   
  198. ' if MDE=0 at the top, otherwise at the bottom 
  199. '
  200.   LAST=N
  201.   M=(N-1)*2+1
  202.   If MDE : Rem bottom of list 
  203.     Inc HOUSE(N,0) : Rem 1 card more    
  204.     PS=(HOUSE(N,0) and 127) : Rem here 
  205.     HOUSE(N,PS)=ACTCARD : Rem this one 
  206.     Limit Bob 1,0,0 To 640,ZNDEF(M+1) : Rem sometimes is better to use 
  207.     Bob 1,ZNDEF(M),ZNDEF(M+1)-CH,ACTCARD : Rem Bob 2 to hide the movement 
  208.     For I=1 To 24
  209.       Bob 1,X Bob(1),Y Bob(1)+2,ACTCARD
  210.       Wait 1
  211.     Next 
  212.     Limit Bob 
  213.     Bob Off 1 : OBJ=0
  214.   Else 
  215.     Inc HOUSE(N,0) : Rem=HOUSE(N,0)+1 
  216.     For I=(HOUSE(N,0) and 127) To 2 Step -1
  217.       HOUSE(N,I)=HOUSE(N,I-1)
  218.     Next 
  219.     HOUSE(N,1)=ACTCARD
  220.     Bob Off 1 : OBJ=0
  221.     DRWFIRST[N]
  222.   End If 
  223. End Proc
  224. Procedure GRABCARD[N]
  225. '
  226. ' grabs the first card from the heap N 
  227. ' various global vars are set
  228. '
  229.    If HOUSE(N,0) and 127 : Rem no empty list  
  230.       FROM=N : Rem I came from here 
  231.       Dec HOUSE(N,0) : Rem 1 card less    
  232.       ACTCARD=HOUSE(N,1) : Rem this one 
  233.       For I=1 To(HOUSE(N,0) and 127) : Rem scroll the other cards 
  234.          HOUSE(N,I)=HOUSE(N,I+1)
  235.       Next 
  236.       DRWFIRST[N]
  237.       If(ACTCARD and 128) : Rem turn it before 
  238.          ACTCARD=ACTCARD and %1111111101111111
  239.          For I=53 To 57
  240.             Bob 1,X Screen(X Mouse),Y Screen(Y Mouse),I
  241.             Wait 4
  242.          Next 
  243.       End If 
  244.       OBJ=1 : Rem bob-bing aroung  
  245.    End If 
  246. End Proc
  247. Procedure CHECKRULES[N,MDE]
  248. '
  249. ' this is usually the most painful procedure to write; all the rules of the
  250. ' game are defined here, and there is very few room for mistakes;  
  251. ' furthermore, You have to write it totally on you own (good work) 
  252. ' FROM an LAST are very useful here, as well as VLUE and SUIT; 
  253. ' (it seem necessary to re-DEF these functions every time the procedure  
  254. ' is called; am I doing somethig wrong or it's an AMOS characteristic?)  
  255. ' MDE=0 : droppin' a card  
  256. ' MDE=1 : grabbin' a card
  257. ' return OK  
  258. '
  259. Def Fn VLUE(X)=((X mod 13)-13*((X mod 13)=0))
  260. Def Fn SUIT(X)=((X-1)/13)
  261.   OK=0
  262.   If N=0 Then Pop Proc
  263.   If MDE : Rem trying to grab 
  264.     If FIRSTTIME
  265.       If N=13 : Rem you must start with the King 
  266.         OK=1
  267.         FIRSTTIME=0
  268.       End If 
  269.     Else 
  270.       If N=LAST : Rem where you drop the last card 
  271.         OK=1
  272.       End If 
  273.     End If 
  274.   Else 
  275.     ACTVALUE= Fn VLUE(ACTCARD)
  276.     ACTSUIT= Fn SUIT(ACTCARD)
  277.     If N=ACTVALUE : Rem on the right list  
  278.       OK=1
  279.     End If 
  280.   End If 
  281.   If OK=0 Then Bell : Rem what a hell are you doing? 
  282. End Proc
  283. Procedure CHECKFINISH
  284. '
  285. ' this is at least as nasty as CheckRules to write, and not reusable 
  286. ' the global var FINISHED is set here  
  287. ' (for the Def-Fn comments see the procedure above)  
  288. '
  289. Def Fn VLUE(X)=((X mod 13)-13*((X mod 13)=0))
  290. Def Fn SUIT(X)=((X-1)/13)
  291.   If FINISHED Then Pop Proc
  292.   If(HOUSE(13,0) and 127)=4
  293.     For I=1 To 4
  294.       If HOUSE(13,I) and 128
  295.         Pop Proc
  296.       End If 
  297.     Next 
  298.     If Fn VLUE(HOUSE(13,1))=13 : Rem  all kings here? 
  299.       If Fn VLUE(HOUSE(13,2))=13
  300.         If Fn VLUE(HOUSE(13,3))=13
  301.           If Fn VLUE(HOUSE(13,4))=13
  302.             Bob Off 
  303.             N=1 : I=1 : FINISHED=1 : NOBBUONO=0
  304.             While N<=12 and NOBBUONO=0 : Rem all other heaps ok?  
  305.               If Fn VLUE(HOUSE(N,I))<>N
  306.                 NOBBUONO=1
  307.               End If 
  308.               I=I+1
  309.               If I=5
  310.                 I=1 : N=N+1
  311.               End If 
  312.             Wend 
  313.             If NOBBUONO : Rem if not, You'd better try again 
  314.               For I=0 To 1
  315.                 WRITE[5*I,0,0,246-2*I,102-I,"Sorry, try again!"]
  316.               Next 
  317.             Else 
  318.               For I=0 To 1
  319.                 WRITE[5*I,0,0,230-2*I,102-I,"You are a VERY lucky man!"]
  320.               Next 
  321.             End If 
  322.           End If 
  323.         End If 
  324.       End If 
  325.     End If 
  326.   End If 
  327. End Proc
  328. Procedure WRITE[PN,PAP,MD,X,Y,A$]
  329. Ink PN,PAP : Gr Writing MD : Text X,Y,A$
  330. End Proc
  331. Procedure CLEAR[X1,Y1,X2,Y2]
  332. Ink 7,4 : Gr Writing 1 : Set Pattern 13
  333. Bar X1,Y1 To X2,Y2
  334. End Proc
  335. Procedure ENABLE
  336. '
  337. ' draw the main board and greets 
  338. '
  339. 'Load "df1:sol/cards1.abk" 
  340. Screen Open 0,640,250,8,Hires : Screen Hide 0
  341. Double Buffer : Autoback 1
  342. MAKEZONE[NZONE]
  343. Palette $0,$0,$0,$0,$0,$0,$0,$0
  344. Change Mouse 2 : Curs Off : Flash Off : Limit Mouse 
  345. Set Pattern 13 : Ink 7,4 : Paint 10,10
  346. Ink 4,7 : Bar 0,0 To 640,2 : Bar 0,2 To 3,250
  347. Ink 4,2 : Bar 2,248 To 640,250 : Bar 636,1 To 640,248
  348. Screen Show 0
  349. Fade 3,$0,$C90,$333,$ECA,$262,$C00,$842,$C0 : Wait 45
  350. HALLO
  351. End Proc
  352. Procedure INFO
  353. '
  354. ' give some info about the rules of the game 
  355. '
  356. Autoback 0 : Get Block 1,120,82,400,102
  357. Gr Writing 1 : Set Pattern 0 : Set Paint 1 : Ink 5,0,1
  358. Bar 120,82 To 506,182 : Set Paint 0
  359. INFODATA:
  360. Data 90,"    To pick a card just click on its heap"
  361. Data 100,"     Dropping a card is a similar affair"
  362. Data 110,"    Begin with the King's heap (the 13th)"
  363. Data 120,"   If You find an ace, goto the first heap"
  364. Data 130,"If You find a Two, goto the second, etc, etc.."
  365. Data 140,"  When You pick the fourth king, all heaps"
  366. Data 150," should be discovered, otherwise You failed"
  367. Data 160,"      Less trivial games coming soon!!"
  368. Data 180,"         Smash the rat to continue"
  369. Restore INFODATA
  370. For J=1 To 9
  371.    Read Y,A$
  372.    For I=0 To 1
  373.       WRITE[1*I,0,0,130-2*I,Y-I,A$]
  374.    Next 
  375. Next 
  376. Screen Swap : Wait Vbl 
  377. Repeat 
  378. Until Mouse Key
  379. Screen Swap : Wait Vbl : Put Block 1,120,82 : Autoback 2
  380. End Proc
  381. Procedure ABOUT
  382. '
  383. ' guess what there is here!
  384. '
  385. Autoback 0 : Get Block 1,120,82,400,102
  386. Gr Writing 1 : Set Pattern 0 : Set Paint 1 : Ink 6,0,1
  387. Bar 120,82 To 506,182 : Set Paint 0
  388. WHODATA:
  389. Data 95,"     Solitaire Project"
  390. Data 105,"        Hide'n'Seek"
  391. Data 117,"            by"
  392. Data 130,"       Fabrizio Bazzo"
  393. Data 140,"v.del Carso 29 - 34170 GO (I)"
  394. Data 150,"   Tel. 0039-(0)481-22018"
  395. Data 165,"   Smash the rat to resume"
  396. Restore WHODATA
  397. For J=1 To 7
  398.    Read Y,A$
  399.    For I=0 To 1
  400.       WRITE[1*I,0,0,200-2*I,Y-I,A$]
  401.    Next 
  402. Next 
  403. Screen Swap : Wait Vbl 
  404. Repeat 
  405. Until Mouse Key
  406. Screen Swap : Wait Vbl : Put Block 1,120,82 : Autoback 2
  407. End Proc
  408. Procedure HALLO
  409. '
  410. ' greets 
  411. '
  412. HALLODATA:
  413. Data 98,"   Hide'n'Seek   by BZZ Soft 1992"
  414. Data 110,"  RMB = options    LMB = selection"
  415. Data 120,"     Select  NEW!  to   restart"
  416. Data 130," Select INFO  for brief instructions"
  417. Data 140,"    Select WHO? to make me happy"
  418. Data 150,"        Select  BYE! to exit"
  419. Data 160," Select by Kim Wilde is a nice album"
  420. Data 175,"      Bash the rat to go ahead"
  421. Autoback 0 : Get Block 1,120,82,400,102
  422. Gr Writing 1 : Set Pattern 0 : Set Paint 1 : Ink 2,0,1
  423. Bar 120,82 To 506,182 : Set Paint 0
  424. Restore HALLODATA
  425. For J=1 To 8
  426.    Read Y,A$
  427.    For I=0 To 1
  428.       WRITE[1*I,0,0,160-2*I,Y-I,A$]
  429.    Next 
  430. Next 
  431. Screen Swap : Wait Vbl 
  432. Repeat 
  433. Until Mouse Key
  434. Screen Swap : Wait Vbl : Put Block 1,120,82 : Autoback 2
  435. End Proc
  436. Procedure CHECKOPT
  437. '
  438. ' display the menu when the RMB is pressed 
  439. '
  440. If OBJ Then Pop Proc : Rem not while grabbed
  441. OPTDATA:
  442. Data 472,"NEW!",512,"INFO",552,"WHO?",592,"BYE!"
  443. Restore OPTDATA : Autoback 0
  444. For J=1 To 4
  445.    Read X,A$
  446.    For I=0 To 1
  447.       WRITE[5*I,0,0,X-2*I,241-I,A$]
  448.    Next 
  449. Next 
  450. Screen Swap : Wait Vbl 
  451. Repeat 
  452.    Z=Mouse Zone
  453. Until Mouse Click
  454. Screen Swap : Wait Vbl : CLEAR[470,233,630,243] : Autoback 2
  455. If Z>13
  456.    On Z-13 Proc RESTART,INFO,ABOUT,QUIT
  457. End If 
  458. End Proc
  459. Procedure RESTART
  460. '
  461. ' this may seem trivial, but I hate GOTO 
  462. '
  463. GRABBED=1 : RELEASED=0 : FINISHED=1 : UFFA=0 : AGAIN=1
  464. End Proc
  465. Procedure QUIT
  466. '
  467. ' see above
  468. '
  469. RESTART
  470. UFFA=1
  471. End Proc
  472. Procedure DISABLE
  473. '
  474. ' this is only to match the ENABLE, as suggested by the Amiga Rom Kernal Manual  
  475. '
  476. Screen Close 0
  477. 'Erase 1 
  478. End Proc