5748316 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n game2.bas
   1: DECLARE SUB Explosion (x!, y!)
   2: DECLARE SUB PlayGame ()
   3: DECLARE SUB Delay (t!)
   4: DECLARE SUB LoadImgs ()
   5: DECLARE SUB Shoot (x!, y!, d!)
   6: DECLARE SUB LoadFont (f$)
   7: DECLARE SUB Font (t$, x!, y!, C!)
   8: DECLARE SUB OpeningTitle ()
   9: DIM SHARED Txt(255) AS STRING
  10: DIM SHARED Char(1 TO 3000)
  11: DIM SHARED Char2(1 TO 3000)
  12: DIM SHARED Back(1 TO 3000)
  13: ON ERROR GOTO er
  14: LoadFont "C:\ascii.fnt"
  15: SCREEN 13: CLS
  16: LoadImgs
  17: OpeningTitle
  18: Font "My Game Rulez", 100, 100, 34
  19: Delay 1
  20: CLS
  21: PlayGame
  22: 
  23: END
  24: er:
  25: RESUME NEXT
  26: 
  27: SUB Delay (t)
  28: a = TIMER + t
  29: DO UNTIL TIMER >= a: LOOP
  30: END SUB
  31: 
  32: SUB Explosion (x, y)
  33: w = x + 5: z = y + 5
  34: FOR q = 0 TO 5
  35: CIRCLE (w, z), q, 14
  36: SOUND q * 40, .2
  37: NEXT q
  38: FOR q = 5 TO 8
  39: CIRCLE (w, z), q, 12
  40: SOUND q * 40, .2
  41: NEXT q
  42: FOR q = 8 TO 9
  43: CIRCLE (w, z), q, 4
  44: SOUND q * 40, .2
  45: NEXT q
  46: END SUB
  47: 
  48: SUB Font (t$, x, y, C)
  49: s$ = "C" + STR$(C) + "BM" + STR$(x) + "," + STR$(y)
  50: DRAW "X" + VARPTR$(s$)
  51: FOR q = 1 TO LEN(t$)
  52: DRAW "X" + VARPTR$(Txt(ASC(MID$(t$, q, 1))))
  53: NEXT q
  54: END SUB
  55: 
  56: SUB LoadFont (f$)
  57: OPEN f$ FOR INPUT AS #1
  58: a = 0
  59: DO UNTIL EOF(1)
  60: INPUT #1, Txt(a)
  61: a = a + 1
  62: LOOP
  63: CLOSE 1
  64: END SUB
  65: 
  66: SUB LoadImgs
  67: CLS
  68: CIRCLE (10, 10), 5, 2
  69: PAINT (10, 10), 2, 2
  70: GET (4, 4)-(16, 16), Char2
  71: CLS
  72: CIRCLE (10, 10), 5, 1
  73: PAINT (10, 10), 1, 1
  74: GET (4, 4)-(16, 16), Char
  75: CLS
  76: END SUB
  77: 
  78: SUB OpeningTitle
  79: x% = POINT(0) * 2: y% = POINT(1) * 2
  80: d = 32
  81: FOR q = 0 TO x% / 2
  82: LINE (q, 0)-(q, y%), d, BF
  83: LINE (x% - q, 0)-(x% - q, y%), d, BF
  84: d = d + 1
  85: NEXT q
  86: END SUB
  87: 
  88: SUB PlayGame
  89: i = 2
  90: OpeningTitle
  91: x = 160: y = 100
  92: COLOR 39
  93: LOCATE 2, 1: PRINT "лллллллллллллллллллллллллллллллллллллллл";
  94: LOCATE 25, 1: PRINT "лллллллллллллллллллллллллллллллллллллллл";
  95: FOR q = 2 TO 24
  96: LOCATE q, 40: PRINT "л";
  97: LOCATE q, 1: PRINT "л";
  98: NEXT q
  99: GET (x - (5 + i), y - (5 + i))-(x + (5 + i), y + (5 + i)), Back
 100: CIRCLE (x, y), 5, 2
 101: 'PAINT (x, y), 2, 2
 102: msg$ = "Score:" + STR$(score%) + "   DDE Rulez " + "X =" + STR$(x) + "  Y =" + STR$(y)
 103: LOCATE 1, 1: PRINT msg$; STRING$(40 - LEN(msg$), 32);
 104: 1 a$ = INKEY$
 105: IF a$ = "" THEN GOTO 1
 106: msg$ = "Score:" + STR$(score%) + "   DDE Rulez " + "X =" + STR$(x) + "  Y =" + STR$(y)
 107: LOCATE 1, 1: PRINT msg$; STRING$(40 - LEN(msg$), 32);
 108: PUT (x - (5 + i), y - (5 + i)), Back, PSET
 109: mxx = 320
 110: mxy = 200
 111: mnx = 0
 112: mny = 8
 113: IF a$ = CHR$(0) + "M" AND x + (6 + i) < mxx THEN x = x + i
 114: IF a$ = CHR$(0) + "K" AND x - (6 + i) > mnx THEN x = x - i
 115: IF a$ = CHR$(0) + "P" AND y + (6 + i) < mxy THEN y = y + i
 116: IF a$ = CHR$(0) + "H" AND y - (6 + i) > mny THEN y = y - i
 117: IF x > mnx AND x < mnx + 40 AND y > mny AND y < mny + 40 THEN dd = 1 ELSE dd = 0
 118: IF a$ = "" THEN END
 119: IF a$ = " " THEN Shoot x, y - 3, 43
 120: GET (x - (5 + i), y - (5 + i))-(x + (5 + i), y + (5 + i)), Back
 121: nnm = x - i + y
 122: DO UNTIL nnm < 255
 123: nnm = nnm - 20
 124: LOOP
 125: IF dd = 0 THEN CIRCLE (x, y), 5, nnm: PAINT (x, y), nnm, nnm
 126: GOTO 1
 127: END SUB
 128: 
 129: SUB Shoot (x, y, d)
 130: DIM Back2(1 TO 400)
 131: FOR q = 1 TO d * 4 STEP 4
 132: GET (x - 3 + q, y + 2)-(x + 5 + q, y + 4), Back2
 133: LINE (x + 3 + q, y + 2)-(x + 5 + q, y + 2), 1
 134: LINE (x + 2 + q, y + 4)-(x + 4 + q, y + 4), 2
 135: PUT (x - 3 + q, y + 2), Back2, PSET
 136: NEXT q
 137: Explosion x - 2 + q, y - 2
 138: END SUB
 139: 
5748317 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$

Click here to go back to the directory listing.
Click here to download this file.
last modified: 2000-05-09 21:03:11