home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / other / stsimon / simon.gfa (.txt) next >
Encoding:
GFA-BASIC Atari  |  1985-11-19  |  8.3 KB  |  401 lines
  1. '  ****************************************
  2. '  *      SIMON by Greg Bennett           *
  3. '  *  A.K.A. The Original 'Friendly User' *
  4. '  *        written in GFA 3.0            *
  5. '  *  (C)1991  Friendly User Software     *
  6. '  *            version 1.1               *
  7. '  *              9/10/91                 *
  8. '  ****************************************
  9. '
  10. GOSUB initialize
  11. '
  12. GOTO make_menu
  13. '
  14. PROCEDURE simon_start
  15.   DEFMOUSE 4
  16.   last%=0
  17. begin:
  18.   IF last%>0
  19.     PAUSE 35
  20.   ENDIF
  21.   INC last%
  22.   GOSUB get_random
  23.   sim%(last%)=num%
  24.   FOR x%=1 TO last%
  25.     ON sim%(x%) GOSUB show_color_one,show_color_two,show_color_three,show_color_four
  26.     SHOWM
  27.     IF (last% MOD 5)=0
  28.       DEC pause_time%
  29.     ENDIF
  30.     PAUSE pause_time%
  31.   NEXT x%
  32.   x%=0
  33.   DO
  34.     IF x%<last%
  35.       INC x%
  36.     ENDIF
  37.     SHOWM
  38.     GOSUB get_reply
  39.     IF sim%(x%)<>reply%
  40.       GOTO error
  41.     ENDIF
  42.     EXIT IF x%=last%
  43.   LOOP
  44.   GOTO begin
  45.   '
  46. error:
  47.   VSYNC
  48.   PUT 54,24,all1$
  49.   SOUND 1,15,5,1
  50.   SOUND 2,15,6,1
  51.   SOUND 3,15,8,1,buzz_period#*2
  52.   VSYNC
  53.   PUT 54,24,all$
  54.   SOUND 1,0,5,1
  55.   SOUND 2,0,6,1
  56.   SOUND 3,0,8,1
  57.   IF longest%<last%
  58.     GOSUB make_longest
  59.   ENDIF
  60.   GOSUB check_scores
  61. RETURN
  62. '
  63. PROCEDURE get_reply
  64.   reply%=0
  65.   t%=TIMER
  66.   REPEAT
  67.     MOUSE x#,y#,k#
  68.     IF k#=1
  69.       IF POINT(x#,y#)=3
  70.         IF MOUSEK=1
  71.           GOSUB show_color_one
  72.         ENDIF
  73.       ENDIF
  74.       IF POINT(x#,y#)=6
  75.         IF MOUSEK=1
  76.           GOSUB show_color_two
  77.         ENDIF
  78.       ENDIF
  79.       IF y#<97 AND x#<266 AND POINT(x#,y#)=2
  80.         IF MOUSEK=1
  81.           GOSUB show_color_three
  82.         ENDIF
  83.       ENDIF
  84.       IF y#>97 AND POINT(x#,y#)=4
  85.         IF MOUSEK=1
  86.           GOSUB show_color_four
  87.         ENDIF
  88.       ENDIF
  89.       SHOWM
  90.     ENDIF
  91.     IF (TIMER-t%)>600
  92.       reply%=5
  93.     ENDIF
  94.   UNTIL reply%<>0
  95. RETURN
  96. '
  97. PROCEDURE get_random
  98.   num%=(INT(RND*1000) MOD 4)+1
  99. RETURN
  100. '
  101. PROCEDURE show_color_one
  102.   VSYNC
  103.   PUT 54,24,a1$
  104.   SOUND 1,15,10,4,period#
  105.   VSYNC
  106.   PUT 54,24,a$
  107.   SOUND 1,0,10,4
  108.   reply%=1
  109. RETURN
  110. '
  111. PROCEDURE show_color_two
  112.   VSYNC
  113.   PUT 54,100,c1$
  114.   SOUND 1,15,12,4,period#
  115.   VSYNC
  116.   PUT 54,100,c$
  117.   SOUND 1,0,12,4,period#
  118.   reply%=2
  119. RETURN
  120. '
  121. PROCEDURE show_color_three
  122.   VSYNC
  123.   PUT 159,24,b1$
  124.   SOUND 1,15,1,4,period#
  125.   VSYNC
  126.   PUT 159,24,b$
  127.   SOUND 1,0,1,4,period#
  128.   reply%=3
  129. RETURN
  130. '
  131. PROCEDURE show_color_four
  132.   VSYNC
  133.   PUT 160,100,d1$
  134.   SOUND 1,15,3,4,period#
  135.   VSYNC
  136.   PUT 160,100,d$
  137.   SOUND 1,0,3,4,period#
  138.   reply%=4
  139. RETURN
  140. '
  141. PROCEDURE play_last
  142.   FOR x%=1 TO last%
  143.     ON sim%(x%) GOSUB show_color_one,show_color_two,show_color_three,show_color_four
  144.     PAUSE ptime%
  145.   NEXT x%
  146. RETURN
  147. '
  148. PROCEDURE make_longest
  149.   IF last%>1
  150.     FOR x%=1 TO last%-1
  151.       simlongest%(x%)=sim%(x%)
  152.       longest%=last%
  153.     NEXT x%
  154.   ENDIF
  155. RETURN
  156. '
  157. PROCEDURE play_longest
  158.   FOR x%=1 TO longest%
  159.     ON simlongest%(x%) GOSUB show_color_one,show_color_two,show_color_three,show_color_four
  160.     PAUSE ptime%
  161.   NEXT x%
  162. RETURN
  163. '
  164. PROCEDURE check_rez
  165.   rez#=XBIOS(4)
  166.   IF rez#<>0
  167.     alrt$="SIMON only works in|Low Resolution."
  168.     ALERT 3,alrt$,1,"Crap!",b#
  169.     SYSTEM
  170.   ENDIF
  171. RETURN
  172. PROCEDURE load_colour
  173.   OPEN "I",#1,filename$
  174.   temp$=INPUT$(38,#1)
  175.   colour$=MID$(temp$,5,32)
  176.   CLOSE #1
  177.   palnum#=0
  178.   count#=0
  179.   REPEAT
  180.     hibyte#=ASC(MID$(colour$,count#,1))
  181.     INC count#
  182.     lobyte#=ASC(MID$(colour$,count#,1))
  183.     INC count#
  184.     pal2#(palnum#)=(hibyte#*256)+lobyte#
  185.     INC palnum#
  186.   UNTIL palnum#=15
  187. RETURN
  188. '
  189. PROCEDURE install_colour
  190.   VOID XBIOS(6,L:VARPTR(colour$))
  191. RETURN
  192. '
  193. PROCEDURE show_pic
  194.   physbase%=XBIOS(2)
  195.   BLOAD filename$,physbase%-128
  196. RETURN
  197. '
  198. PROCEDURE save_palette
  199.   FOR ctr%=0 TO 15
  200.     palette#(ctr%)=XBIOS(7,W:ctr%,W:-1)
  201.   NEXT ctr%
  202. RETURN
  203. '
  204. PROCEDURE restore_palette
  205.   FOR ctr%=0 TO 15
  206.     SETCOLOR ctr%,palette#(ctr%)
  207.   NEXT ctr%
  208. RETURN
  209. '
  210. '
  211. make_menu:
  212. DEFMOUSE 0
  213. FOR ctr%=0 TO 50
  214.   READ menu_strip$(ctr%)
  215.   EXIT IF menu_strip$(ctr%)="***"
  216. NEXT ctr%
  217. menu_strip$(ctr%)=""
  218. menu_strip$(ctr%+1)=""
  219. DATA Desk," About SIMON          "
  220. DATA  --------------------,3,4,5,6,""
  221. DATA Options, Start Game, ------------, Play Last," Play Longest "
  222. DATA  ------------, High Scores, ------------, Quit,""
  223. DATA ***
  224. MENU menu_strip$()
  225. FOR ctr%=2 TO 6
  226.   MENU ctr%,2
  227. NEXT ctr%
  228. MENU 10,2
  229. MENU 13,2
  230. MENU 15,2
  231. ON MENU GOSUB menu_routine
  232. DO
  233.   ON MENU
  234. LOOP
  235. '
  236. PROCEDURE menu_routine
  237.   DEFMOUSE 0
  238.   string$=menu_strip$(MENU(0))
  239.   IF string$=" Quit"
  240.     GOSUB save_high_scores
  241.     CLOSE
  242.     restore_palette
  243.     SYSTEM
  244.     END
  245.   ENDIF
  246.   IF string$=" About SIMON          "
  247.     GOSUB about_simon
  248.   ENDIF
  249.   IF string$=" Play Longest "
  250.     HIDEM
  251.     GOSUB play_longest
  252.   ENDIF
  253.   IF string$=" Play Last"
  254.     HIDEM
  255.     GOSUB play_last
  256.   ENDIF
  257.   IF string$=" High Scores"
  258.     HIDEM
  259.     GOSUB show_high_scores
  260.   ENDIF
  261.   IF string$=" Start Game"
  262.     MENU OFF
  263.     GOSUB simon_start
  264.   ENDIF
  265.   MENU OFF
  266.   SHOWM
  267.   DEFMOUSE 0
  268. RETURN
  269. '
  270. PROCEDURE about_simon
  271.   alrt$="       Atari SIMON   |By Greg Bennett in GFA 3.0    | Friendly User Software   |  (C)1991  Version 1.1 "
  272.   ALERT 0,alrt$,1," OK ",b#
  273. RETURN
  274. '
  275. PROCEDURE initialize
  276.   period#=7
  277.   ptime#=5
  278.   pause_time%=15
  279.   counter#=1000
  280.   last%=0
  281.   longest%=0
  282.   buzz_period#=25
  283.   DIM sim%(1000),simlongest%(1000)
  284.   DIM palette#(15),pal2#(15)
  285.   DIM menu_strip$(25)
  286.   DIM high_name$(10)
  287.   DIM high_score%(10)
  288.   DEFMOUSE 2
  289.   GOSUB save_palette
  290. main:
  291.   OPEN "I",#2,"SIMON.SCR"
  292.   FOR score_counter%=1 TO 10
  293.     INPUT #2,high_name$(score_counter%),high_score%(score_counter%)
  294.   NEXT score_counter%
  295.   CLOSE #2
  296.   number_ten%=high_score%(10)
  297.   GOSUB check_rez
  298.   filename$="SIMON33.NEO"
  299.   GOSUB load_colour
  300.   GOSUB install_colour
  301.   GOSUB show_pic
  302.   GET 54,24,160,100,a1$
  303.   GET 159,24,266,97,b1$
  304.   GET 54,100,160,176,c1$
  305.   GET 160,100,266,176,d1$
  306.   '
  307.   GET 54,24,266,176,all1$
  308.   '
  309.   DEFFILL 2,1
  310.   FILL 212,66
  311.   DEFFILL 6,1
  312.   FILL 108,134
  313.   DEFFILL 4,1
  314.   FILL 212,135
  315.   DEFFILL 3,1
  316.   FILL 109,62
  317.   '
  318.   GET 54,24,160,100,a$
  319.   GET 159,24,266,97,b$
  320.   GET 54,100,160,176,c$
  321.   GET 160,100,266,176,d$
  322.   '
  323.   GET 54,24,266,176,all$
  324. RETURN
  325. '
  326. PROCEDURE show_high_scores
  327.   HIDEM
  328.   DEFFILL 0,1
  329.   GET 50,40,270,189,screen$
  330.   PRBOX 50,40,270,189
  331.   RBOX 51,41,269,188
  332.   DEFTEXT 2,4,0,32
  333.   TEXT 55,70," High Scores"
  334.   DEFTEXT 1,0,0,6
  335.   person_counter%=0
  336.   FOR q%=85 TO 175 STEP 10
  337.     INC person_counter%
  338.     temp%=LEN(high_name$(person_counter%))+LEN(STR$(high_score%(person_counter%)))
  339.     out$=high_name$(person_counter%)+STRING$(26-temp%,".")+STR$(high_score%(person_counter%))
  340.     TEXT 57,q%,out$
  341.   NEXT q%
  342.   DEFTEXT 2,0,0,4
  343.   TEXT 59,183,"       - Click any button -"
  344.   DO
  345.     EXIT IF MOUSEK=1 OR MOUSEK=2
  346.   LOOP
  347.   VSYNC
  348.   PUT 50,40,screen$
  349.   SHOWM
  350. RETURN
  351. '
  352. PROCEDURE check_scores
  353.   IF (last%-1)>=number_ten%
  354.     GOSUB get_name
  355.     number_ten%=high_score%(10)
  356.   ENDIF
  357. RETURN
  358. '
  359. PROCEDURE get_name
  360.   HIDEM
  361.   GET 60,70,260,139,screen$
  362.   DEFFILL 0,1
  363.   PBOX 60,70,260,139
  364.   BOX 61,71,259,138
  365.   DEFTEXT 2,17,0,13
  366.   TEXT 65,89,"  CONGRATULATIONS"
  367.   PRINT AT(9,13);" You have ranked in the "
  368.   PRINT AT(9,14);" TOP TEN with a score "
  369.   PRINT AT(9,15);" of ";(last%-1);"."
  370.   PRINT AT(9,16);" Name >_______________"
  371.   PRINT AT(16,16);
  372.   FORM INPUT 15,name$
  373.   GOSUB shift_scores
  374.   VSYNC
  375.   PUT 60,70,screen$
  376.   SHOWM
  377.   GOSUB show_high_scores
  378. RETURN
  379. '
  380. PROCEDURE shift_scores
  381.   top%=1
  382.   temp%=last%-1
  383.   WHILE high_score%(top%)>temp%
  384.     INC top%
  385.   WEND
  386.   FOR shift%=10 TO (top%+1) STEP -1
  387.     high_score%(shift%)=high_score%(shift%-1)
  388.     high_name$(shift%)=high_name$(shift%-1)
  389.   NEXT shift%
  390.   high_score%(top%)=temp%
  391.   high_name$(top%)=name$
  392. RETURN
  393. '
  394. PROCEDURE save_high_scores
  395.   OPEN "O",#2,"SIMON.SCR"
  396.   FOR score_counter%=1 TO 10
  397.     WRITE #2,high_name$(score_counter%),high_score%(score_counter%)
  398.   NEXT score_counter%
  399.   CLOSE #2
  400. RETURN
  401.