home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / CAKE.ZIP / PCHELLO.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  3.6 KB  |  58 lines
  1. 1  DEF SEG=0: IF PEEK(&H1F2)<> 80  OR PEEK(&H1F3)<> 7  THEN NEW
  2. 5  REM
  3. 10  GOTO 10000
  4. 20  IF NOT PCJR THEN DEF SEG=0: POKE &H417,PEEK(&H417) OR &H20: DEF SEG
  5. 30  KB%=-1: RRND=RND: KB$=INKEY$: GOSUB 80: IF KB$="" THEN RETURN ELSE KB%=ASC(KB$)
  6. 40  KB$=INKEY$: IF KB$<>"" THEN GOSUB 80: GOTO 40 ELSE RETURN
  7. 50  KB.SPACE=FRE(" "): GOSUB 40
  8. 60  KB.I%=INT(KB.SEC*18.2)
  9. 70  RRND=RND: DEF SEG=0: KB.II%=PEEK(&H46C): WHILE KB.II%=PEEK(&H46C): WEND: GOSUB 20: IF KB%<>-1 THEN RETURN ELSE KB.I%=KB.I%-1: IF KB.I%>0 THEN 70 ELSE RETURN
  10. 80  IF KB$="" THEN RETURN ELSE IF ASC(KB$)<>19 OR PCJR THEN RETURN
  11. 90  KB$="": SND.MODE=(SND.MODE+1) MOD 2: DEF SEG=0: POKE &H40F,((PEEK(&H40F) AND &HFC) OR ((SND.MODE+1) AND 3)): DEF SEG: RETURN
  12. 10000  DEF SEG=&HF000: PCJR=PEEK(&HFFFE)=&HFD: SND.MODE=1: DEF SEG=0: I=PEEK(&H40F) AND 3: IF I>0 THEN SND.MODE=I-1
  13. 10010  MONOCHROME=0: GEN.PIC%=0: ON ERROR GOTO 62000: DEF SEG=0: MCHF%=((PEEK(&H410)) AND &H30) = &H30: MF%=MCHF% OR MONOCHROME: W80F%=MF%: GOSUB 62120: POKE &H417,&H60+PCJR*&H20
  14. 10020  IF MF% THEN SCREEN 0,0,0,0: WIDTH 80: COLOR 7,0,0: ELSE SCREEN 1,0: COLOR 0,1
  15. 10030  IF MCHF% THEN<UNK! {0009}>LOCATE ,,0,11,13 ELSE<UNK! {0009}>LOCATE ,,0,6,7
  16. 10040  IF NOT MF% THEN GOSUB 10150: GOTO 10110
  17. 10050  DEF SEG=0: OUT 987,0: X=INP(986): IF X<>&HFF THEN POKE &H410,(PEEK(&H410) AND &HCF) OR &H10: LOCATE ,,,7,7: LOCATE 1,1,0: SCREEN 0:WIDTH 40:WIDTH 80: RUN
  18. 10060  CLS: KEY OFF: COLOR 15: CP=FNP(3)
  19. 10070  LOCATE 2,CP+9: PRINT "E A R L Y   G A M E S": LOCATE 4,CP+8: PRINT "P I E C E   of   C A K E": LOCATE 8,CP+11: PRINT "By  Robert Eyestone";
  20. 10080  LOCATE 13,1: COLOR 7: PRINT TAB(11) "This program operates only with the Color/Graphics Monitor Adapter."
  21. 10090  LOCATE 18,CP+13: PRINT "Springboard";: LOCATE 19,CP+12: PRINT "Software, Inc.";: LOCATE 20,CP+10: PRINT "Copyright (C) 1984";
  22. 10100  KB.SEC=600: GOSUB 60: LOCATE 21,1: SYSTEM
  23. 10110  DEF SEG=0: POKE &H405,&HCF: POKE &H6C,5:POKE &H6D,4: POKE &H6E,0: POKE &H6F,0: DEF SEG
  24. 10120  KB.SEC=5: GOSUB 50: IF PCJR THEN GOSUB 10240
  25. 10130  IF KB%=-1 THEN 10140
  26. 10140  RUN "PCMENU.BAS"
  27. 10150  CLS: DIM TITLE%(2000): KEY OFF: COLOR 0,1: CP=3: IF PCJR THEN PALETTE 1,14: PALETTE 2,12: PALETTE 3,9
  28. 10160  IF NOT GEN.PIC% THEN DEF SEG: I=0: TITLE%(0)=0: I=VARPTR(TITLE%(0)): BLOAD "HELLO.BSV",I: PUT (56,0),TITLE%: GOTO 10180
  29. 10170  X$="EARLY GAMES": XC$="312121312121": X%=70: Y%=4: DX%=2: DY%=2: GOSUB 10200: X$="Piece of Cake": X%=56: Y%=32: DX%=2: DY%=4: XC$="1111113332222": GOSUB 10200: DEF SEG: GET (56,0)-(273,63),TITLE%: I=VARPTR(TITLE%(0)): BSAVE "HELLO.BSV",I,2*2000
  30. 10180  LOCATE 15,20: PRINT "by";: LOCATE 17,13: PRINT "Robert  Eyestone";
  31. 10190  LOCATE 21,15: PRINT "Springboard";: LOCATE 22,14: PRINT "Software, Inc.";: LOCATE 24,12: PRINT "Copyright (C) 1984";: RETURN
  32. 10200  FOR DSP.CSI%=1 TO LEN(X$): DSP.C$=MID$(X$,DSP.CSI%,1): DSP.C%=ASC(MID$(XC$,DSP.CSI%,1))-48: GOSUB 10210: X%=X%+DX%*8: NEXT DSP.CSI%: RETURN
  33. 10210  DEF SEG=&HF000: DSP.BI%=ASC(DSP.C$)*8: DSP.Y%=Y%: FOR DSP.YI%=0 TO 7: DSP.D%=PEEK(&HFA6E+DSP.BI%+DSP.YI%): DSP.X%=X%
  34. 10220  FOR DSP.XI%=0 TO 7: DSP.D%=DSP.D%+DSP.D%: IF DSP.D% AND &H100 THEN LINE (DSP.X%,DSP.Y%)-(DSP.X%+DX%-1,DSP.Y%+DY%-1),DSP.C%,BF
  35. 10230  DSP.D%=DSP.D% AND &HFF: DSP.X%=DSP.X%+DX%: NEXT DSP.XI%: DSP.Y%=DSP.Y%+DY%: NEXT DSP.YI%: DEF SEG: RETURN
  36. 10240  CLS: LOCATE ,,0: SCREEN 0,1: CLS: LOCATE ,,0: KB.SEC=0.3: GOSUB 50: LOCATE  7,10: COLOR 9: PRINT "Sound Output Choices"
  37. 10250  LOCATE 11,12:COLOR 10: PRINT "1  Monitor or";: LOCATE 12,12: PRINT "   TV Speaker"
  38. 10260  LOCATE 14,12: COLOR 14: PRINT "2  PCjr Speaker"
  39. 10270  LOCATE 17,12: COLOR 12: PRINT "3  No Sound"
  40. 10280  LOCATE 20,10: COLOR 9: PRINT "Select  ";: COLOR 10: PRINT "1";:: COLOR 9: PRINT ",  ";: COLOR 14: PRINT "2";: COLOR 9: PRINT "  or  ";: COLOR 12: PRINT "3  ";: COLOR 9: LOCATE ,,1
  41. 10290  KB.SEC=1500: GOSUB 50: IF KB%=-1 OR KB%<49 OR KB%>51 THEN 10290
  42. 10300  SND.MODE=2+49-KB%: IF SND.MODE=2 THEN SOUND ON ELSE SOUND OFF
  43. 10310  DEF SEG=0: POKE &H40F,(PEEK(&H40F) AND &HFC) OR (SND.MODE+1): DEF SEG
  44. 10320  LOCATE ,,0: CLS: SCREEN 1,0: CLS: KB.SEC=0.3: GOSUB 50: PALETTE 1,14: PALETTE 2,12: PALETTE 3,9: PUT (56,48),TITLE%: RETURN
  45. 62000  SCREEN 0,1,0,0: LOCATE ,,0: COLOR 7: CLS: X$="": IF ERR=53 THEN X$="DISK WITH PROGRAMS NEEDED"
  46. 62010  IF ERR=72 OR ERR=71 THEN X$="DISK ERROR OR NOT READY"
  47. 62020  IF ERR=5 THEN X$="LIST AND SAVE COMMANDS ARE ILLEGAL"
  48. 62030  IF X$="" THEN 62080
  49. 62040  GOSUB 62090
  50. 62050  RESUME 62060
  51. 62060  ON ERROR GOTO 62000
  52. 62070  KB.SEC=20: GOSUB 50: CLS: IF KB%=27 THEN RUN "PCMENU.BAS" ELSE  RUN
  53. 62080  SCREEN 0,1,0,0: LOCATE ,,0: COLOR 7,0: CLS: RUN
  54. 62090  GOSUB 62120: IF X$="" THEN X$="  "
  55. 62100  XL%=LEN(X$): IF XL%>36 THEN XL%=36
  56. 62110  LOCATE 25,2,0: PRINT SPACE$((38-XL%)\2)+LEFT$(X$,XL%) +SPACE$(38-XL%-(38-XL%)\2);: RETURN
  57. 62120  DEF FNC%(I%)=I%: DEF FNP(I)=I+(20 AND W80F%): DEF FNRN%(F%,L%)=INT(RND*(L%-F%+1) MOD (L%-F%+1))+F%: RANDOMIZE VAL(RIGHT$(TIME$,2)): RETURN
  58.