5748343 [rkeene@sledge /home/rkeene/devel/archive/quickbasic]$ cat -n funny.bas
   1: DECLARE SUB OpeningIntro (snd!)
   2: DECLARE SUB Fade (X!, t$, io!)
   3: DECLARE SUB Delay (n!)
   4: DECLARE SUB Splash (X!, t$, io!)
   5: DECLARE SUB LoadSaved (F$)
   6: SCREEN 13
   7: CLS
   8: 'OpeningIntro 0
   9: CLS
  10: LINE (0, 0)-(320, 200), 5, BF
  11: LINE (10, 8)-(310, 180), 15, BF
  12: LoadSaved "STARTUP.FUN"
  13: 
  14: LOCATE 24, 2: PRINT "1) Begin";
  15: LOCATE 25, 2: PRINT "2) Quit";
  16: 10 d$ = INPUT$(1)
  17: IF d$ <> "1" AND d$ <> "2" THEN GOTO 10
  18: IF d$ = "1" THEN LOCATE 1, 1: PRINT "NA yet"
  19: IF d$ = "2" THEN END
  20: 
  21: SUB Center (X, t$)
  22: LOCATE X, 20 - INT(LEN(t$) / 2): PRINT t$;
  23: IF X = 25 THEN  ELSE LOCATE X + 1, 1
  24: END SUB
  25: 
  26: SUB Delay (n)
  27: a = TIMER + n
  28: DO UNTIL TIMER >= a: LOOP
  29: END SUB
  30: 
  31: SUB Fade (X, t$, io)
  32: IF io = 0 THEN n1 = 31: n2 = 16: n3 = -1 ELSE n2 = 31: n1 = 16: n3 = 1
  33: FOR q = n1 TO n2 STEP n3
  34: COLOR q
  35: LOCATE X, 20 - INT(LEN(t$) / 2): PRINT t$
  36: Delay .05
  37: NEXT q
  38: END SUB
  39: 
  40: SUB LoadSaved (F$)
  41: DIM OneByte AS STRING * 1
  42: WINDOW SCREEN (310, 190)-(10, 8)
  43: VIEW SCREEN (10, 8)-(310, 190)
  44: VIEW PRINT 2 TO 22
  45: OPEN F$ FOR BINARY AS #1
  46: FOR q = 1 TO LOF(1)
  47:         GET #1, , OneByte: Cmd = ASC(OneByte)
  48:         IF Cmd = 1 OR Cmd = 2 OR Cmd = 7 THEN GET #1, , OneByte: X = ASC(OneByte): GET #1, , OneByte: Y = ASC(OneByte): GET #1, , OneByte: S = ASC(OneByte): GET #1, , OneByte: C = ASC(OneByte): GET #1, , OneByte: E = ASC(OneByte): CIRCLE (X, Y), S, C, , , E / 100
  49:         IF Cmd = 2 THEN PAINT (X, Y), C, C
  50:         IF Cmd = 7 THEN GET #1, , OneByte: C2 = ASC(OneByte): PAINT (X, Y), C2, C
  51:         IF Cmd = 3 OR Cmd = 4 OR Cmd = 5 OR Cmd = 8 THEN GET #1, , OneByte: X1 = ASC(OneByte): GET #1, , OneByte: Y1 = ASC(OneByte): GET #1, , OneByte: X2 = ASC(OneByte): GET #1, , OneByte: Y2 = ASC(OneByte): GET #1, , OneByte: C = ASC(OneByte)
  52:         IF Cmd = 3 THEN LINE (X1, Y1)-(X2, Y2), C
  53:         IF Cmd = 4 OR Cmd = 8 THEN LINE (X1, Y1)-(X2, Y2), C, B
  54:         IF Cmd = 5 THEN LINE (X1, Y1)-(X2, Y2), C, BF
  55:         IF Cmd = 8 THEN GET #1, , OneByte: C2 = ASC(OneByte): LINE (X1 + 1, Y1 + 1)-(X2 - 1, Y2 - 1), C2, BF
  56:         IF Cmd = 6 THEN GET #1, , OneByte: X = ASC(OneByte): GET #1, , OneByte: Y = ASC(OneByte): GET #1, , OneByte: C = ASC(OneByte): PSET (X, Y), C
  57:         IF Cmd = 9 THEN GET #1, , OneByte: X = ASC(OneByte): GET #1, , OneByte: Y = ASC(OneByte): GET #1, , OneByte: F = ASC(OneByte): GET #1, , OneByte: S = ASC(OneByte): PAINT (X, Y), F, S
  58:         IF Cmd = 10 THEN GET #1, , OneByte: X = ASC(OneByte): GET #1, , OneByte: Y = ASC(OneByte): GET #1, , OneByte: L = ASC(OneByte): FOR m = 1 TO L: GET #1, , OneByte: t$ = t$ + OneByte: NEXT m: LOCATE X + 1, Y + 1: PRINT t$
  59: q = LOC(1)
  60: NEXT q
  61: CLOSE 1
  62: VIEW
  63: VIEW PRINT 1 TO 25
  64: WINDOW
  65: END SUB
  66: 
  67: SUB OpeningIntro (snd)
  68: FOR q = .001 TO 1 STEP .001: CIRCLE (75, 100), 100, (q * 100) + 15, , , q: NEXT q
  69: FOR q = .001 TO 1 STEP .001: CIRCLE (275, 100), 100, (q * 100) + 15, , , q: NEXT q
  70: IF snd = 1 THEN PLAY "MBl8afafadfadfafafadfadfafafadfadf"
  71: Splash 12, " -=ð Funny Face Maker ð=- ", 1
  72: IF snd = 1 THEN PLAY "MBl8afafadfadfafafadfadf"
  73: Splash 13, "   -=ð By: Roy Keene ð=-  ", 0
  74: IF snd = 1 THEN PLAY "MBl8afafadfadfafafadfadfafafadfadf"
  75: Splash 14, "    -=ð Version 1.0 ð=-   ", 1
  76: Delay 1
  77: IF snd = 1 THEN PLAY "MBl8afafadfadfafafadfadfafafadfadf"
  78: Fade 12, " -=ð Funny Face Maker ð=- ", 0
  79: Fade 14, "    -=ð Version 1.0 ð=-   ", 0
  80: COLOR 15
  81: END SUB
  82: 
  83: SUB Splash (X, t$, io)
  84: IF io = 0 THEN n2 = 16 ELSE n2 = 31
  85: FOR q = 96 TO n2 STEP -1
  86: COLOR q
  87: LOCATE X, 20 - INT(LEN(t$) / 2): PRINT t$
  88: Delay .01
  89: NEXT q
  90: 
  91: END SUB
  92: 
5748344 [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:07