home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / KINGS.ZIP / LOGO.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1979-12-31  |  3.3 KB  |  79 lines
  1. 10  REM    THE KING'S RULE logo routine
  2. 20  REM    (c) 1985, Sunburst Communications
  3. 30  REM    Author: Tom O'Brien
  4. 40  REM    Programmer: Raoul Watson
  5. 50  DEF SEG=0:POKE &H6C,84:POKE &H6D,0:POKE &H6E,0:POKE &H6F,0:POKE 84,&HCF:DEF SEG
  6. 60  DEF SEG=&H40:IF PEEK(&H6B)<>&HA5 THEN 650
  7. 70  DEF SEG=&HF000:JR=(PEEK(&HFFFE)=&HFD):DEF SEG
  8. 80  LD$="UNPACK.BLD":MAXIMUM%=16500
  9. 90  DEF SEG=&H40:MEM%=PEEK(&H13)+256*PEEK(&H14)
  10. 100  ASMPROG%=(MEM%*1024/16)-108
  11. 110  SEGMENT%=INT((ASMPROG%*16-MAXIMUM%)/16):DEF SEG=ASMPROG%:BLOAD LD$,0
  12. 120  GOTO 500
  13. 130  LOCATE 25,8:PRINT "Press any key to continue.";
  14. 140  A$=INKEY$
  15. 150  IF A$<>"" THEN RETURN
  16. 160  GOTO 140
  17. 170  REM Check Graphics Screen
  18. 180  REM First check to see if enough memory...
  19. 190  DEF SEG=&H40:EQUIP=PEEK(&H10)
  20. 200  IF PEEK(&H6B)<>&HA5 THEN GOTO 650
  21. 210  MEM=PEEK(&H13)+256*PEEK(&H14):IF MEM>=196 THEN 240
  22. 220  CLS:COLOR ,1:LOCATE 12:PRINT "    Sorry, but you don't have enough":PRINT:PRINT "     memory to run this program..."
  23. 230  GOSUB 130:RETURN 660
  24. 240  DEF SEG=&HB800:POKE 1,7:IF PEEK(1)=7 THEN CLS:GOTO 270
  25. 250  CLS:WIDTH 40:LOCATE 12:PRINT " Sorry, but you need the Color/Graphics":PRINT:PRINT "  Monitor Adapter to use this program."
  26. 260  GOSUB 130:RETURN 660
  27. 270  IF JR OR (EQUIP AND &H30)<>48 THEN 410
  28. 280  CLS:WIDTH 80:ULX=18:ULY=7:LRX=62:LRY=22
  29. 290  LOCATE ULY,ULX:PRINT "KEY":LOCATE LRY,ULX:PRINT "SCREEN":LOCATE ULY,LRX:PRINT "CLOSE":LOCATE LRY,LRX:PRINT "LOAD"
  30. 300  XL=LRX-ULX-1
  31. 310  LOCATE ULY,ULX+1:PRINT STRING$(XL,"THEN");:LOCATE LRY,ULX+1:PRINT STRING$(XL,"THEN");
  32. 320  FOR L=ULY+1 TO LRY-1:LOCATE L,ULX:PRINT "OPEN";:LOCATE L,LRX:PRINT "OPEN";:NEXT
  33. 330  LOCATE 9,33,0:COLOR 9:PRINT "THE KING'S RULE";:COLOR 7:LOCATE 11,31:PRINT "(c) Copyright 1985":COLOR 10:LOCATE 12,29:PRINT "Sunburst Communications";:COLOR 7:LOCATE 13,25:PRINT "Pleasantville, New York   10570";
  34. 340  LOCATE 15,31:PRINT "Author: Tom O'Brien";:LOCATE 16,28:PRINT "Programmer: Raoul Watson";
  35. 350  LOCATE 18,22,0:PRINT "Please turn on your graphics monitor.":LOCATE 20,33:PRINT "Press any key.";:GOSUB 760
  36. 360  DEF SEG=&HB000:FOR D=0 TO 38 STEP 2:POKE D+2761,240:POKE 2837-D,240:NEXT D
  37. 370  FOR L=1 TO 2500:L=L-2500*(INKEY$<>"")
  38. 380  NEXT L:FOR D=0 TO 38 STEP 2:POKE D+2761,112:POKE 2837-D,112:NEXT D
  39. 390  DEF SEG=&H40:POKE &H10,(EQUIP AND &HCF) OR &H10
  40. 400  SCREEN 0:SCREEN 1:LOCATE ,,0,6,7:COLOR 0,1
  41. 410  RETURN
  42. 420  REM Logo Routine
  43. 430  SCREEN 1,0:DEF SEG:IF JR THEN OUT &H3DA,0:OUT &H3DA,0 ELSE OUT &H3D8,2
  44. 440  PACKIT%=-1:UNPACKIT%=0:PACK%=0
  45. 450  FILE1$="logo.pak"
  46. 460  DEF SEG=SEGMENT%:BLOAD FILE1$,0
  47. 470  DEF SEG=ASMPROG%:CALL PACK%(SEGMENT%,UNPACKIT%):COLOR 52
  48. 480  DEF SEG:IF JR THEN OUT &H3DA,0:OUT &H3DA,10 ELSE OUT &H3D8,10
  49. 490  RETURN
  50. 500  REM Initialization
  51. 510  ON ERROR GOTO 710
  52. 520  KEY OFF:FOR LKEY=1 TO 10:KEY LKEY,"":NEXT:SCREEN 1:CLS:LOCATE ,,0
  53. 530  '
  54. 540  GOSUB 170<UNK! {0009}>'check if graphics screen, switch over if not on.
  55. 550  GOSUB 420:GOSUB 760:FOR L=1 TO 1000:L=L-1000*(INKEY$<>""):NEXT
  56. 560  SCREEN 1,0
  57. 570  COLOR 48:CLS:DEF SEG:IF JR THEN OUT &H3DA,0:OUT &H3DA,0 ELSE OUT &H3D8,2
  58. 580  FILE1$="castle.pak"
  59. 590  DEF SEG=SEGMENT%:BLOAD FILE1$,0
  60. 600  DEF SEG=ASMPROG%:CALL PACK%(SEGMENT%,UNPACKIT%)
  61. 620  DEF SEG:IF JR THEN OUT &H3DA,0:OUT &H3DA,10 ELSE OUT &H3D8,10
  62. 630  REM
  63. 635  WHILE INKEY$<>"":WEND:FOR L=1 TO 800:L=L-800*(INKEY$<>""):NEXT
  64. 640  DEF SEG=0:PL%=INT((((PEEK(&H510)+256*PEEK(&H511))*16+VARPTR(#2))/16)+1):DEF SEG=PL%:POKE 0,0:DEF SEG:RUN"menu"
  65. 650  CLS:KEY OFF:SCREEN 1:LOCATE 12,2:PRINT"Unauthorized copying of this diskette";:LOCATE 14,2:                          PRINT"             is unlawful.";
  66. 651  PRINT CHR$(7);:GOTO 651
  67. 660  SCREEN 0,1,0:COLOR 15,0:WIDTH 40:CLS:LOCATE 9,8,0:PRINT "If you would like to use":LOCATE 11,4:PRINT "another disk, insert it now, and":LOCATE 13,13:PRINT "press  ENTER.":GOSUB 760
  68. 670  K$=INKEY$:IF K$=CHR$(13) THEN 680 ELSE 670
  69. 680  DEF SEG=&H40:POKE &H72,&H34:POKE &H73,&H12:DEF SEG=&HF000
  70. 690  A=&HE05B
  71. 700  CALL A
  72. 710  '******* SOMETHING IS WRONG ******
  73. 720  CLS:LOCATE 11,6
  74. 730  REM
  75. 740  PRINT "Please make sure that the disk":LOCATE 12,6:PRINT "has been inserted properly into":LOCATE 13,6:PRINT "the disk drive.":GOSUB 130
  76. 750  RESUME
  77. 760  DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG:POKE 106,0:RETURN
  78. 770  DATA 55,8b,ec,8b,76,06,5d,06,b8,00,b8,8e,c0,bf,00,00,46,b9,00,00,b8,00,00,46,8a,24,46,8a,04,8a,cc,26,88,05,47,81,ff,ff,3f,7d,04,e2,f4,eb,ea,07,ca,02,00
  79.