home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 126-150 / apd141 / atishoo.amos / atishoo.amosSourceCode next >
AMOS Source Code  |  1990-08-11  |  12KB  |  492 lines
  1. Default 
  2. Dim CBCOL(73),CBDES(73),CBIMAGE(73),PLAN(12,8),NAM$(5),HSCORE(5)
  3. Global VER,QQ$,CROSS,MULT,GONE,NT$,CD,CC,MAINSCORE,TSCOR,CBCOL(),CBDES(),CBIMAGE(),PLAN(),XT,YT,XTEMP,YTEMP,NAM$(),HSCORE()
  4. TITESCN
  5. LODEHISCORES
  6. INSTUCTIONS
  7. If Upper$(QQ$)<>"H" Then Goto MSS
  8. SHOHIGHSCORES
  9.    Wait Key 
  10.    Screen Close 2
  11. MSS:
  12. Screen Open 2,320,256,4,Lowres : Curs Off 
  13. Pen 2 : Paper 0 : Cls 0
  14. Locate 6,10 : Print "Choose Tiles or Bricks (T/B)"
  15. Locate 6,12 : Print "  Tiles are Easier !"
  16. SS: Q$=Upper$(Inkey$) : If Q$="" Then Goto SS
  17. If Q$="T"
  18.  VER=0
  19. Else 
  20.  VER=48
  21. End If 
  22. Screen Close 2
  23. Auto View Off 
  24. If VER=0
  25.    Unpack 7 To 1
  26. Else 
  27.    Unpack 8 To 1
  28. End If 
  29. 'Load "df0:ishidosprites3.abk" 
  30. Get Sprite Palette 
  31. Cls 0,284,17 To 304,37
  32. BLANKTILES
  33. For N=0 To 15 : Colour N,0 : Next 
  34. Auto View On 
  35. Fade 7 : Wait 115
  36. Screen To Front 1 : Screen 1
  37. 'MAKENEWFILE 
  38. 'SAVHISCORES 
  39. 'End 
  40. '--------------------restart game------------------------- 
  41. BEG:
  42. Show On 
  43. MAINSCORE=0 : TSCOR=0
  44. Cls 10,275,68 To 312,126
  45. KNOCKOFF[72,2]
  46. MULT=1 : GONE=0 : CROSS=0
  47. SETARRAYS
  48. Fade 7 To -1 : Wait 105
  49. Limit Mouse X Hard(10),Y Hard(10) To X Hard(260),Y Hard(176)
  50. Ink 7,0
  51. MAKEZEROES[MAINSCORE,6]
  52. MAKEZEROES[TSCOR,3]
  53. INITBOARD
  54. GONE=6 : KNOCKOFF[GONE,0]
  55. '
  56. '---------------------main loop----------------------
  57. CUBESLEFT=72
  58. HERE:
  59. If CUBESLEFT>1 Then CURRENTCUBE=Rnd(CUBESLEFT-1)+1
  60. If CBIMAGE(CURRENTCUBE)=0 Then Goto HERE
  61. For N=40 To 43
  62.    Paste Bob 284,17,N+VER
  63.    Wait 3
  64. Next N
  65. Paste Bob 284,17,CBIMAGE(CURRENTCUBE)
  66. PICKPLACE
  67. Cls 0,284,17 To 304,37
  68. GONE=GONE+1 : KNOCKOFF[GONE,0]
  69. If GONE=72 Then Goto FIN
  70. Goto HERE
  71. '-------------------end main loop--------------------- 
  72. '
  73. FIN:
  74. For N=20 To 80 : Play N,1 : Next 
  75. TRYHIGH[MAINSCORE]
  76. Clear Key : Wait Key 
  77. Screen To Front 1 : Screen 1
  78. Show 
  79. BLANKTILES
  80. Goto BEG
  81. '--------------------------------
  82. '
  83. Procedure BLANKTILES
  84.    For X=10 To 260 Step 21
  85.       For Y=10 To 176 Step 21
  86.          Paste Bob X,Y,37+VER
  87.    Next : Next 
  88.    For X=31 To 239 Step 21
  89.       For Y=31 To 155 Step 21
  90.          Paste Bob X,Y,38+VER
  91.    Next : Next 
  92. End Proc
  93. Procedure GITCUBES
  94.    B=0
  95.    For Y=31 To 136 Step 21
  96.       For X=73 To 178 Step 21
  97.          B=B+1
  98.          Get Bob B,X,Y To X+20,Y+20
  99.       Next 
  100.    Next 
  101.    Get Bob 37,10,10 To 30,30
  102.    Get Bob 38,31,31 To 51,51
  103. End Proc
  104. Procedure MONMOUS
  105.    Do 
  106.       X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  107.       Locate 10,26 : Print X,Y
  108.       Exit If Inkey$=" "
  109.    Loop 
  110. End Proc
  111. Procedure PICKPLACE
  112.    Shared CURRENTCUBE
  113.    AG:
  114.    Repeat 
  115.       X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
  116.       XM=X-(X-10) mod 21 : YM=Y-(Y-10) mod 21
  117.       XT=(XM+11)/21 : YT=(YM+11)/21
  118.    Until Mouse Click
  119.    If PLAN(XT,YT)=0
  120.       CHECKSCORE
  121.       If TSCOR=0
  122.          Goto AG
  123.       End If 
  124.       Cls 0,XM,YM To XM+20,YM+20
  125.       For N=43 To 40 Step -1
  126.          Paste Bob XM,YM,N+VER
  127.          Wait 5
  128.          Cls 0,XM,YM To XM+20,YM+20
  129.       Next N
  130.       Wait 5
  131.       For N=41 To 43
  132.          Paste Bob XM,YM,N+VER
  133.          Wait 5
  134.          Cls 0,XM,YM To XM+20,YM+20
  135.       Next N
  136.       Paste Bob XM,YM,CBIMAGE(CURRENTCUBE)
  137.       PLAN(XT,YT)=CURRENTCUBE
  138.       CBIMAGE(CURRENTCUBE)=0
  139.    Else 
  140.       Goto AG
  141.    End If 
  142. End Proc
  143. Procedure CHECKSCORE
  144.    Shared CURRENTCUBE
  145.    EDGE=0
  146.    If XT=1 or XT=12 or YT=1 or YT=8
  147.       EDGE=1
  148.    End If 
  149.    TSCOR=0
  150.    CC=CBCOL(CURRENTCUBE) : CD=CBDES(CURRENTCUBE)
  151.    CHECK[1,0]
  152.    CHECK[-1,0]
  153.    CHECK[0,1]
  154.    CHECK[0,-1]
  155.    If TSCOR>0 and EDGE=0
  156.       If TSCOR=4
  157.          TSCOR=TSCOR*MULT
  158.          MULT=MULT*2
  159.          CROSS=CROSS+1
  160.          FOURERS[CROSS]
  161.       End If 
  162.       Ink 7,0
  163.       MAKEZEROES[TSCOR,3]
  164. '      Text 247,220,NT$
  165. 'Ink 0 : Bar 239,212 To 270,223
  166. If VER=48
  167.    L=0
  168. Else 
  169.    L=10
  170. End If 
  171. For N=1 To 3
  172. X=Val(Mid$(NT$,N,1))
  173. Paste Bob 210+8*N,210,101+X+L
  174. Next N
  175.       For J=1 To TSCOR
  176.          MAINSCORE=MAINSCORE+1
  177.          MAKEZEROES[MAINSCORE,6]
  178.          Ink 7,0
  179. For N=1 To 6
  180. X=Val(Mid$(NT$,N,1))
  181. Paste Bob 65+8*N,210,101+X+L
  182. Next N
  183.          Bell 40
  184.       Wait 1
  185.       Next J
  186.    End If 
  187. End Proc
  188. Procedure CHECK[XDEV,YDEV]
  189.    If(XT+XDEV)>12 Then Pop Proc
  190.    If(XT+XDEV)<1 Then Pop Proc
  191.    If(YT+YDEV)>8 Then Pop Proc
  192.    If(XT+XDEV)<1 Then Pop Proc
  193.    If PLAN(XT+XDEV,YT+YDEV)>0
  194.       SIDE=PLAN(XT+XDEV,YT+YDEV)
  195.       'Locate 10,27 : Print CBCOL(SIDE),CBDES(SIDE),SIDE 
  196.       If CBCOL(SIDE)=CC or CBDES(SIDE)=CD
  197.          TSCOR=TSCOR+1
  198.       End If 
  199.    End If 
  200. End Proc
  201. Procedure SETARRAYS
  202.    For N=1 To 72 : CBCOL(N)=0 : CBDES(N)=0 : Next 
  203.    For N=1 To 36 : CBIMAGE(N)=VER+N : Next 
  204.    For N=37 To 72 : CBIMAGE(N)=N+VER-36 : Next 
  205.    For A=1 To 12 : For B=1 To 8 : PLAN(A,B)=0 : Next : Next 
  206.    For Y=0 To 5
  207.       For X=1 To 6
  208.          CBCOL(6*Y+X)=Y+1
  209.          CBDES(6*Y+X)=X
  210.       Next X
  211.    Next Y
  212.    For Y=0 To 5
  213.       For X=1 To 6
  214.          CBCOL(36+6*Y+X)=Y+1
  215.          CBDES(36+6*Y+X)=X
  216.       Next X
  217.    Next Y
  218. End Proc
  219. Procedure TEMP
  220.    Screen Open 0,640,200,16,Hires
  221.    Cls 
  222.    For Y=1 To 6
  223.       For X=1 To 12
  224.          Locate 5,1 : Print "CBCOL & CBDES"
  225.          Locate X*5,Y+2 : Print CBCOL(12*(Y-1)+X);CBDES(12*(Y-1)+X)
  226.       Next 
  227.    Next 
  228.    For Y=1 To 8
  229.       For X=1 To 12
  230.          Locate X*3,Y+10 : Print PLAN(X,Y)
  231.       Next 
  232.    Next 
  233.    Wait Key 
  234.    Screen 1
  235. End Proc
  236. Procedure REDUCEEM
  237.    Shared CURRENTCUBE,CUBESLEFT
  238.    For N=CURRENTCUBE To CUBESLEFT
  239.       CBIMAGE(N)=CBIMAGE(N+1)
  240.       'Follow CBIMAGE(N),CBIMAGE(N+1)
  241.       '   CBCOL(N)=CBCOL(N+1)
  242.       '   CBDES(N)=CBDES(N+1)
  243.    Next 
  244.    CUBESLEFT=CUBESLEFT-1
  245.    'TEMP
  246. End Proc
  247. Procedure INITBOARD
  248.    Paste Bob 52,52,CBIMAGE(1)
  249.    Paste Bob 199,52,CBIMAGE(8)
  250.    Paste Bob 52,115,CBIMAGE(15)
  251.    Paste Bob 199,115,CBIMAGE(22)
  252.    Paste Bob 94,73,CBIMAGE(29)
  253.    Paste Bob 157,94,CBIMAGE(36)
  254.    PLAN(3,3)=1
  255.    PLAN(10,3)=8
  256.    PLAN(3,6)=15
  257.    PLAN(10,6)=22
  258.    PLAN(5,4)=29
  259.    PLAN(8,5)=36
  260.    CBIMAGE(1)=0
  261.    CBIMAGE(8)=0
  262.    CBIMAGE(15)=0
  263.    CBIMAGE(22)=0
  264.    CBIMAGE(29)=0
  265.    CBIMAGE(36)=0
  266. End Proc
  267. Procedure MAKEZEROES[T,W]
  268.    NT$=Str$(T)
  269.    NT$=Right$(NT$,Len(NT$)-1)
  270.    NT$=String$("0",W-Len(NT$))+NT$
  271. End Proc
  272. Procedure KNOCKOFF[STP,K]
  273.    Ink K
  274.    V=0
  275.    For Y=146 To 176 Step 5
  276.       For N=273 To 315 Step 4
  277.          Bar N,Y To N+1,Y+2
  278.          V=V+1
  279.          Exit If V=STP
  280.       Next 
  281.       Exit If V=STP
  282.    Next 
  283. End Proc
  284. Procedure FOURERS[CX]
  285.    Ink 8 : V=0
  286.    For Y=68 To 128 Step 10
  287.       For N=275 To 305 Step 10
  288.          V=V+1
  289.          Draw N,Y+2 To N+6,Y+2
  290.          Draw N,Y+4 To N+6,Y+4
  291.          Draw N+2,Y To N+2,Y+6
  292.          Draw N+4,Y To N+4,Y+6
  293.          Exit If V=CX
  294.       Next 
  295.       Exit If V=CX
  296.    Next 
  297. End Proc
  298. Procedure INITHIGH
  299.    For N=1 To 5
  300.       Read A$ : NAM$(N)=A$
  301.       Read X : HSCORE(N)=X
  302.    Next 
  303.    Data "fred",90,"mary",110,"george",103,"harry",240,"Maggie",370
  304.    ' TRYHIGH[116] 
  305. End Proc
  306. Procedure TRYHIGH[SCR]
  307.    MYSCORE=SCR
  308.    SOGHT
  309.    If MYSCORE>HSCORE(5)
  310.       A$=""
  311.       Curs Off : Bell 
  312.       For N=4 To 1 Step -1
  313.          NAM$(N+1)=NAM$(N)
  314.          HSCORE(N+1)=HSCORE(N)
  315.       Next N
  316.       NAM$(1)=A$ : HSCORE(1)=MYSCORE
  317.       SOGHT
  318.       SHOHIGHSCORES
  319.       JK=0
  320.       For N=1 To 5
  321.          If NAM$(N)=""
  322.             JK=N
  323.          End If 
  324.       Next N
  325.       Pen 2
  326.       Locate 26,6+JK*2 : Print Using "#####";MYSCORE
  327.       Locate 10,6+JK*2 : Curs On 
  328.       Clear Key 
  329.       A$=""
  330.       For N=1 To 8
  331.          ZZ: Q$=Inkey$
  332.          If Q$=""
  333.             Goto ZZ
  334.          End If 
  335.          Exit If Q$=Chr$(13)
  336.          A$=A$+Q$
  337.          Print Right$(Q$,1);
  338.       Next 
  339.       NAM$(JK)=A$
  340.       Curs Off 
  341.    SAVHISCORES
  342.    Clear Key 
  343.    Screen Close 2
  344.    End If 
  345. End Proc
  346. Procedure SHOHIGHSCORES
  347.    Screen Open 2,320,256,16,Lowres : 
  348.    Screen To Front 2
  349.    Hide : Curs Off 
  350.    Cls 0
  351.    Ink 2
  352.    Set Pattern 9
  353.    Bar 10,10 To 310,190
  354.    Set Pattern 0
  355.    Ink 0
  356.    Bar 30,30 To 290,170
  357.    Pen 4 : Paper 0
  358.    Locate 15,5 : Under On : Print "HIGH SCORES" : Under Off 
  359.    Pen 6
  360.    For N=1 To 5
  361.       Locate 10,2*(N+3) : Print NAM$(N)
  362.       Locate 26,2*(N+3) : Print Using "#####";HSCORE(N)
  363.    Next 
  364. End Proc
  365. Procedure SOGHT
  366.    Repeat 
  367.       MARK=0
  368.       For N=1 To 4
  369.          If HSCORE(N)<HSCORE(N+1)
  370.             T=HSCORE(N)
  371.             T$=NAM$(N)
  372.             HSCORE(N)=HSCORE(N+1)
  373.             NAM$(N)=NAM$(N+1)
  374.             HSCORE(N+1)=T
  375.             NAM$(N+1)=T$
  376.             MARK=1
  377.          End If 
  378.       Next N
  379.    Until MARK=0
  380. End Proc
  381. Procedure LODEHISCORES
  382.    Open In 1,"ishhigh.AMOS"
  383.    For N=1 To 5
  384.       Input #1,NAM$(N)
  385.       Input #1,HSCORE(N)
  386.    Next N
  387.    Close 1
  388. End Proc
  389. Procedure SAVHISCORES
  390.    Open Out 1,"ishhigh.AMOS"
  391.    For N=1 To 5
  392.       Print #1,NAM$(N)
  393.       Print #1,HSCORE(N)
  394.    Next N
  395.    Close 1
  396. End Proc
  397. Procedure MAKENEWFILE
  398.    For N=1 To 5
  399.       Read NAM$(N)
  400.       Read HSCORE(N)
  401.    Next N
  402.    Data "GERMAINE",90,"AMELIA",300,"IVY",193,"DOLLY",222,"ABALENE",120
  403.    SAVHISCORES
  404. End Proc
  405. Procedure INSTUCTIONS
  406. Screen Open 2,320,240,8,Lowres
  407. Flash Off : Curs Off : Hide 
  408. Cls 0
  409. Ink 7
  410. Box 0,0 To 320,240
  411. Box 2,2 To 318,238
  412. Under On 
  413. Pen 6 : Paper 0 : Locate 10,2 : Print "ATISHOO INSTRUCTIONS"
  414. Under Off 
  415. Pen 7
  416. Locate 1,7 : Print "Place Tiles on the Board with adjacent"
  417. Locate 1,8 : Print "sides, matching  colours or designs."
  418. Locate 1,9 : Print "The outer darker area of the Board"
  419. Locate 1,10 : Print "may be used but points are not scored"
  420. Locate 1,11 : Print "on these parts. Matching Tiles on more"
  421. Locate 1,12 : Print "than one side scores extra points."
  422. Locate 1,13 : Print "   Matching on four sides scores four"
  423. Locate 1,14 : Print "points in the first instance, but the"
  424. Locate 1,15 : Print "next fourway scores eight points, the"
  425. Locate 1,16 : Print "the next sixteen and so on"
  426. Locate 8,20 : Print "[P] to Play Game"
  427. Locate 8,22 : Print "[H] To see High Scores"
  428. BB: QQ$=Inkey$ : If QQ$="" Then Goto BB
  429. Fade 5 : Wait 75
  430. Screen Close 2
  431. End Proc
  432. Procedure TITESCN
  433. Screen Open 2,320,240,8,Lowres
  434. Pen 2 : Paper 0 : Cls 0
  435. A=Colour(0)
  436. B=Colour(1)
  437. C=Colour(2)
  438. D=Colour(3)
  439. E=Colour(4)
  440. F=Colour(5)
  441. G=Colour(6)
  442. H=Colour(7)
  443. For N=0 To 7 : Colour N,0 : Next 
  444. Hide 
  445. Flash Off 
  446. Set Pattern 0
  447. Ink 2
  448. Plot 25,230-92 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  449. Data 40,166,46,152,50,182,73,104,62,80,56,119,40,121,37,102,25,92,999,999
  450. Ink 6 : Paint 31,230-99 : Ink 2
  451. Plot 47,230-145 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  452. Data 54,128,42,128,47,145,999,999
  453. Ink 0 : Paint 46,230-138 : Ink 2
  454. Plot 86,230-111 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  455. Data 87,153,72,146,75,154,70,156,103,175,100,168,115,165,91,157,93,111,86,111,999,999
  456. Ink 6 : Paint 88,230-114 : Ink 2
  457. Plot 116,230-121 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  458. Data 123,170,130,176,126,131,123,135,116,121,999,999
  459. Ink 6 : Paint 122,230-135 : Ink 2
  460. Plot 142,230-129 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  461. Data 148,139,142,139,160,144,160,155,142,159,141,178,155,197,178,184,170,184,173,178,150,177,148,163,166,162,175,144,142,129,999,999
  462. Ink 6 : Paint 150,230-135 : Ink 2
  463. Plot 187,230-155 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  464. Data 183,199,188,196,190,216,196,182,205,188,207,203,211,195,218,207,211,148,208,154,202,137,204,181,197,178,194,154,191,161,187,155,999,999
  465. Ink 6 : Paint 190,230-165 : Ink 2
  466. Plot 243,230-153 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  467. Data 224,166,228,202,238,215,256,207,257,174,243,153,999,999
  468. Ink 6 : Paint 243,230-158 : Ink 2
  469. Plot 241,230-167 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  470. Data 234,176,241,201,248,175,241,167,999,999
  471. Ink 0 : Paint 241,230-172 : Ink 2
  472. Plot 275,230-164 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  473. Data 263,181,269,209,280,223,296,199,290,173,275,164,999,999
  474. Ink 6 : Paint 278,230-170 : Ink 2
  475. Plot 272,230-184 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  476. Data 279,206,289,195,281,178,272,184,999,999
  477. Ink 0 : Paint 282,230-190 : Ink 2
  478. Plot 113,230-97 : Do : Read X,Y : Exit If X=999 : Draw To X,230-Y : Loop 
  479. Data 245,134,221,118,240,112,113,97,999,999
  480. Ink 6 : Paint 138,230-103 : Ink 2
  481. 'Ink 4,7 : Set Pattern 12 : Paint 20,1 
  482. Ink 0,7
  483. Text 60,184,"Programmed in AMOS BASIC"
  484. Text 60,200,"    By Colin Naylar     "
  485. Fade 5,A,B,C,D,E,F,G,H
  486. Timer=0
  487. Repeat 
  488. Exit If Inkey$<>""
  489. Until Timer=300
  490. Fade 5 : Wait 75
  491. Screen Close 2
  492. End Proc