Koodit: QB: Aware-intro

'   ÜÛÜ    Û       Û    ÜÛÜ    ÛßÛÜÜ     Ûßßßßßßß
'   Û Û    Û       Û    Û Û    Û   ßÛÜ   Û
'  ÜÛ ÛÜ   Û       Û   ÜÛ ÛÜ   Û     ßÛ  Û
'  Û   Û   Û       Û   Û   Û   Û    ÜÛß  Û
' ÜÛ   ÛÜ  Û   Û   Û  ÜÛ   ÛÜ  ÛÜÜÜÛß    Ûßßßß
' Û     Û  Û  ÛßÛ  Û  Û     Û  ÛÛÜ       Û
' ÛßßßßßÛ  Û Ûß ßÛ Û  ÛßßßßßÛ  Û ßÛÜ     Û
'Ûß     ßÛ ÛÛß   ßÛÛ Ûß     ßÛ Û   ßÛÜ   Û
'Û       Û Û       Û Û       Û Û     ßÛÜ ÛÜÜÜÜÜÜÜ
'
'Copyright (c) 1994
'
' This source code is Greetware. If you learn
' something from here, you should greet
' in some of your products..
' ..But I think that nobody will learn anything
'   from this source code, unless what somebody
'   SHOULD NOT do when coding something..
'
' And as you probably have noticed, we didn't
' made this as a serious product, if we would
' then this would not be basic .. :)
'
'-------------------------------------------------
' Hoo?! Who writed that crap?!
'
'




'METAMORPHER

morfpoints = 62
DIM dx1(morfpoints)
DIM dx2(morfpoints)
DIM dtx(morfpoints)
DIM dy1(morfpoints)
DIM dy2(morfpoints)
DIM dty(morfpoints)
DIM dc(morfpoints)

DATA"     zbA     ","    yaMcB    ","    9LYNd    " : 'A
DATA"   x8X ZeC   ","   7K   Of   ","  w6V   WgD  "
DATA"  5J     Ph  "," v4nopqrstiE "," 3I       Qj "
DATA"u2T       UkF","1H         Rl","0G         Sm"
DATA"0A         Kc","1B         Ld","2C         Me" : 'W
DATA"3D         Nf","4E         Og","5F    y    Ph"
DATA"6G  YwzxZ  Qi","7H Vu   vX Rj","8IUs     tWSk"
DATA"9Jp       rTl","ao         qm","b           n"
DATA"     zbA     ","    yaMcB    ","    9LYNd    " : 'A
DATA"   x8X ZeC   ","   7K   Of   ","  w6V   WgD  "
DATA"  5J     Ph  "," v4nopqrstiE "," 3I       Qj "
DATA"u2T       UkF","1H         Rl","0G         Sm"
DATA"bcdefghij    ","aL      Mk   ","9K       Nl  " : 'R
DATA"8J       Vm  ","7I       Pn  ","6H      Oo   "
DATA"5wvutsrqp    ","4G     QB    ","3FW     RA   "
DATA"2EX      Sz  ","1DY       Ty ","0CZ        Ux"
DATA"defghijklmnop","qUL          ","rTK          " : 'E
DATA"sSJ          ","tRI          ","uABCDEFGH    "
DATA"vQZ          ","wPY          ","xOX          "
DATA"yNW          ","zMV          ","789abc0123456"

ware$ = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"

SCREEN 13
FOR a = 1 TO morfpoints
 dy2(a) = 100
 dx2(a) = 160
NEXT a

OUT &H3C8, 1
FOR a = 1 TO 31
 OUT &H3C9, a * 2
 OUT &H3C9, 15
 OUT &H3C9, a
NEXT
FOR a = 31 TO 1 STEP -1
 OUT &H3C9, a * 2
 OUT &H3C9, 15
 OUT &H3C9, a
NEXT
laskuri = 0

lups:
 laskuri = laskuri + 1
 'x = INT(RND * 600) + 300
 'y = INT(RND * 600) + 300
 'z = INT(RND * 1000)
 IF laskuri = 1 THEN
  FOR a = 1 TO morfpoints
   x = 350: y = 350: z = 500
   dx1(a) = dx2(a): dy1(a) = dy2(a)
   dx2(a) = (SIN((a + z) * x * .0001) * 150 + 160): dtx(a) = dx1(a)
   dy2(a) = (COS((a + z) * y * .0001) * 90 + 100): dty(a) = dy1(a)
   dc(a) = a: NEXT a
 END IF
 IF laskuri = 2 THEN
  FOR a = 1 TO morfpoints
   x = 300: y = 900: z = 800
   dx1(a) = dx2(a): dy1(a) = dy2(a)
   dx2(a) = (SIN((a + z) * x * .0001) * 150 + 160): dtx(a) = dx1(a)
   dy2(a) = (COS((a + z) * y * .0001) * 90 + 100): dty(a) = dy1(a)
   dc(a) = a: NEXT a
 END IF
 IF laskuri = 3 THEN
  FOR a = 1 TO morfpoints
   x = 900: y = 400: z = 100
   dx1(a) = dx2(a): dy1(a) = dy2(a)
   dx2(a) = (SIN((a + z) * x * .0001) * 75 + 160): dtx(a) = dx1(a)
   dy2(a) = (COS((a + z) * y * .0001) * 45 + 100): dty(a) = dy1(a)
   dc(a) = a: NEXT a
 END IF
 IF laskuri = 4 THEN
  REM .. SYMPTOM .. PRESENTS ..
  OUT &H3C8, 70: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
  LOCATE 14, 20: COLOR 70: PRINT "SYMPTOM"
  FOR a = 0 TO 63: OUT &H3C8, 70: OUT &H3C9, a / 2: OUT &H3C9, a: OUT &H3C9, a
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8: NEXT
  FOR a = 63 TO 0 STEP -1: OUT &H3C8, 70: OUT &H3C9, a / 2: OUT &H3C9, a: OUT &H3C9, a
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8: NEXT
  LOCATE 14, 20: PRINT " presents"
  FOR a = 0 TO 63: OUT &H3C8, 70: OUT &H3C9, a / 2: OUT &H3C9, a / 2: OUT &H3C9, a
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8: NEXT
  FOR a = 63 TO 0 STEP -1: OUT &H3C8, 70: OUT &H3C9, a / 2: OUT &H3C9, a / 2: OUT &H3C9, a
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
   DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8: NEXT
  OUT &H3C8, 200: OUT &H3C9, 12: OUT &H3C9, 6: OUT &H3C9, 18
  COLOR 200: LOCATE 24, 11: PRINT "A salute to B-WARE";
  FOR b = 1 TO 12
   READ a$:          'This routine grabs the first A
   FOR a = 1 TO LEN(a$)
    IF MID$(a$, a, 1) <> " " THEN
     FOR c = 1 TO LEN(ware$)
      IF MID$(ware$, c, 1) = MID$(a$, a, 1) THEN
       dx1(c) = dx2(c): dy1(c) = dy2(c): dtx(c) = dx1(c): dty(c) = dy1(c)
       dx2(c) = a * 5 + 130: dy2(c) = b * 5 + 70: dc(c) = b + 25
      END IF
     NEXT c
    END IF
   NEXT a
  NEXT b
 END IF
 IF laskuri = 5 THEN
  FOR b = 1 TO 12
   READ a$
   FOR a = 1 TO LEN(a$)
    IF MID$(a$, a, 1) <> " " THEN
     FOR c = 1 TO LEN(ware$)
      IF MID$(ware$, c, 1) = MID$(a$, a, 1) THEN
       dx1(c) = dx2(c): dy1(c) = dy2(c): dtx(c) = dx1(c): dty(c) = dy1(c)
       dx2(c) = a * 5 + 130: dy2(c) = b * 5 + 70: dc(c) = b + 25
      END IF
     NEXT c
    END IF
   NEXT a
  NEXT b
 END IF
 IF laskuri = 6 THEN
  FOR b = 1 TO 12
   READ a$
   FOR a = 1 TO LEN(a$)
    IF MID$(a$, a, 1) <> " " THEN
     FOR c = 1 TO LEN(ware$)
      IF MID$(ware$, c, 1) = MID$(a$, a, 1) THEN
       dx1(c) = dx2(c): dy1(c) = dy2(c): dtx(c) = dx1(c): dty(c) = dy1(c)
       dx2(c) = a * 5 + 130: dy2(c) = b * 5 + 70: dc(c) = b + 25
      END IF
     NEXT c
    END IF
   NEXT a
  NEXT b
 END IF
 IF laskuri = 7 THEN
  FOR b = 1 TO 12
   READ a$
   FOR a = 1 TO LEN(a$)
    IF MID$(a$, a, 1) <> " " THEN
     FOR c = 1 TO LEN(ware$)
      IF MID$(ware$, c, 1) = MID$(a$, a, 1) THEN
       dx1(c) = dx2(c): dy1(c) = dy2(c): dtx(c) = dx1(c): dty(c) = dy1(c)
       dx2(c) = a * 5 + 130: dy2(c) = b * 5 + 70: dc(c) = b + 25
      END IF
     NEXT c
    END IF
   NEXT a
  NEXT b
 END IF
 IF laskuri = 8 THEN
  FOR b = 1 TO 12
   READ a$
   FOR a = 1 TO LEN(a$)
    IF MID$(a$, a, 1) <> " " THEN
     FOR c = 1 TO LEN(ware$)
      IF MID$(ware$, c, 1) = MID$(a$, a, 1) THEN
       dx1(c) = dx2(c): dy1(c) = dy2(c): dtx(c) = dx1(c): dty(c) = dy1(c)
       dx2(c) = a * 5 + 130: dy2(c) = b * 5 + 70: dc(c) = b + 25
      END IF
     NEXT c
    END IF
   NEXT a
  NEXT b
 END IF
 IF laskuri = 9 THEN
  FOR a = 1 TO morfpoints
   x = 300: y = 300: z = 1
   dx1(a) = dx2(a): dy1(a) = dy2(a)
   dx2(a) = (SIN((a + z) * x * .0001) * 15 + 160): dtx(a) = dx1(a)
   dy2(a) = (COS((a + z) * y * .0001) * 9 + 100): dty(a) = dy1(a)
   dc(a) = a: NEXT a
  FOR a = 1 TO 500: NEXT
 END IF

'64 = number of frames
 FOR a = 1 TO 64
  FOR b = 1 TO morfpoints
   PSET (dtx(b), dty(b)), 0
   dtx(b) = dtx(b) + (dx2(b) - dx1(b)) / 64: 'Metamorphose itself
   dty(b) = dty(b) + (dy2(b) - dy1(b)) / 64: 'Quite simple, eh?
   PSET (dtx(b), dty(b)), dc(b)
  NEXT b
'  OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
  DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0: ' vertical retrace
  DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
'  OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 30
  IF INP(&H60) = 1 THEN GOTO lop
 NEXT a
 IF laskuri = 9 THEN GOTO lop
 GOTO lups
lop:
CLS
OUT &H3C8, 0
FOR a = 1 TO 15: FOR b = 1 TO 3: OUT &H3C9, 0: NEXT: NEXT
RESTORE
FOR c = 0 TO 4
 FOR b = 1 TO 12
  READ a$
  FOR a = 1 TO LEN(a$)
   IF MID$(a$, a, 1) <> " " THEN LINE (a * 3 + c * 70, b * 5)-(a * 3 + c * 70 + 2, b * 5 + 4), b, BF
  NEXT a
 NEXT b
NEXT c
FOR b = 12 TO 1 STEP -1
 FOR a = 15 TO 0 STEP -1
  OUT &H3C8, (15 - a) + b
  OUT &H3C9, a * 4
  OUT &H3C9, a * 3
  OUT &H3C9, a * 2
 NEXT a
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT b
FOR a = 1 TO 72
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a
OUT &H3C8, 15: OUT &H3C9, 33: OUT &H3C9, 0: OUT &H3C9, 20
FOR a = 198 TO 0 STEP -1
 LINE (0, a)-(319, a), 15
 LINE (0, a + 1)-(319, a + 1), 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a
CLS




'TRANSPARENT BARS
DIM sint(360)
DIM rr(200)
DIM rg(200)
DIM rb(200)

pi = 3.141592653589793#: 'I remember 16 decimals but QB takes only 15..
SCREEN 13
OUT &H3C8, 0: FOR a = 0 TO 767: OUT &H3C9, 0: NEXT a
FOR a = 0 TO 360: sint(a) = SIN(a * pi / 180) * 70 + 100: NEXT a
FOR a = 1 TO 200: rr(a) = 0: rg(a) = 0: rb(a) = 0: NEXT a
OUT &H3C8, 219: OUT &H3C9, 23: OUT &H3C9, 13: OUT &H3C9, 5
OUT &H3C9, 63: OUT &H3C9, 63: OUT &H3C9, 63
LINE (0, 0)-(319, 199), 219, BF
b = 0
FOR a = 0 TO 199
 LINE (20, a + 1)-(300, a + 1), 220
 LINE (21, a)-(299, a), a + 1
 b = b + 1
 IF b = 3 THEN
  DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
  DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8: b = 0
 END IF
NEXT a
br = 32: bg = 0: bb = 64
DEF SEG = &HA000
y = 0
DO
 IF y > 200 THEN LINE (y - 201, y - 201)-(320 - (y - 200), 200 - (y - 200)), 0, B
 y = y + 1
 br = br + 2: IF br > 360 THEN br = 0
 bg = bg + 2: IF bg > 360 THEN bg = 0
 bb = bb + 2: IF bb > 360 THEN bb = 0
 'FOR a = 1 TO 200: rr(a) = 0: rg(a) = 0: rb(a) = 0: NEXT a
 rr(sint(br)) = 63
 rg(sint(bg)) = 63
 rb(sint(bb)) = 63
 FOR a = sint(br) - 1 TO sint(br) - 29 STEP -1: rr(a) = rr(a + 1) - 2: NEXT a
 FOR a = sint(bg) - 1 TO sint(bg) - 29 STEP -1: rg(a) = rg(a + 1) - 2: NEXT a
 FOR a = sint(bb) - 1 TO sint(bb) - 29 STEP -1: rb(a) = rb(a + 1) - 2: NEXT a
 FOR a = sint(br) + 1 TO sint(br) + 29: rr(a) = rr(a - 1) - 2: NEXT a
 FOR a = sint(bg) + 1 TO sint(bg) + 29: rg(a) = rg(a - 1) - 2: NEXT a
 FOR a = sint(bb) + 1 TO sint(bb) + 29: rb(a) = rb(a - 1) - 2: NEXT a
' OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
' OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 30
 OUT &H3C8, 10
 FOR a = 10 TO 190
  OUT &H3C9, rr(a)
  OUT &H3C9, rg(a)
  OUT &H3C9, rb(a)
 NEXT a
LOOP UNTIL INP(&H60) = 1 OR y > 300





' L™TKY

DIM mx(200)
DIM bx(200)

SCREEN 13

CLS
FOR l = 0 TO 199
  FOR a = 0 TO 198: mx(a) = mx(a + 1): NEXT a
  FOR a = 199 TO 1 STEP -1: bx(a) = bx(a - 1): NEXT a
  mx(199) = SIN(l * .02) * 30
  bx(0) = COS(l * .04) * 10
NEXT l
OUT &H3C8, 15: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
FOR a = 0 TO 199
 c = bx(a) + mx(a) + 160
 LINE (0, a)-(c, a), 15
NEXT a
DEF SEG = &HA000
 DO
  l = l + 1
  IF l < 264 THEN OUT &H3C8, 15: OUT &H3C9, l - 200: OUT &H3C9, l - 200: OUT &H3C9, l - 200
  IF l > 400 THEN
   OUT &H3C8, 15
   OUT &H3C9, 63 - (l - 400)
   OUT &H3C9, 63 - (l - 400)
   OUT &H3C9, 63 - (l - 400)
  END IF
  FOR a = 0 TO 198: mx(a) = mx(a + 1): NEXT a
  FOR a = 199 TO 1 STEP -1: bx(a) = bx(a - 1): NEXT a
  mx(199) = SIN(l * .02) * 30
  bx(0) = COS(l * .04) * 10
  b = 0
  FOR a = 0 TO 199
   c = bx(a) + mx(a) + 160
   POKE b + c, 15
   POKE b + c + 1, 15
   POKE b + c + 2, 0
   POKE b + c + 3, 0
   b = b + 320
  NEXT a
'  OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
  DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
  DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
'  OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 30
 LOOP UNTIL INP(&H60) = 1 OR l > 460



' VECTORS
points = 64

DIM orx(512): ' couple of stupid arrays..
DIM ory(512): ' This really don't need so
DIM orz(512): ' many but I didn't have
DIM nx(512): ' inspiration to change the
DIM ny(512): ' code...
DIM nz(512)
DIM tx(512)
DIM ty(512)
DIM tz(512)
DIM xp(512)
DIM yp(512)
DIM oxp(512)
DIM oyp(512)

d = 1
FOR c = 0 TO 7: FOR b = 0 TO 7: FOR a = 0 TO 7
 orx(d) = (a - 2.9): ory(d) = (b - 2.9): orz(d) = (c - 2.9)
 nx(d) = 0: ny(d) = 0: nz(d) = 0: tx(d) = 0: ty(d) = 0: tz(d) = 0
 xp(d) = 0: yp(d) = 0: oxp(d) = 0: oyp(d) = 0
 d = d + 1
NEXT: NEXT: NEXT
SCREEN 13
CLS
zdis = 1
xrot = 0
yrot = 0
zrot = 0
sc = .05
OUT &H3C8, 0: FOR a = 0 TO 767: OUT &H3C9, 0: NEXT a
OUT &H3C8, 1
FOR a = 0 TO 63: OUT &H3C9, 63: OUT &H3C9, a: OUT &H3C9, a: NEXT a
FOR a = 63 TO 0 STEP -1: OUT &H3C9, 63: OUT &H3C9, a: OUT &H3C9, a: NEXT a
DEF SEG = &HA000
' This stuff is so damn slow .. ;)
' Well, this piece of code is based
' on mine first attempt to make
' vectors..
DO
 xrot = xrot + .5
 yrot = yrot + 1
 zrot = zrot + 2
 FOR a = 1 TO points
  nx(a) = orx(a)
  ny(a) = COS(xrot * sc) * ory(a) - SIN(xrot * sc) * orz(a)
  nz(a) = SIN(xrot * sc) * ory(a) - COS(xrot * sc) * orz(a)
  tx(a) = nx(a): ty(a) = ny(a): tz(a) = nz(a)
  nx(a) = COS(yrot * sc) * tx(a) + SIN(yrot * sc) * tz(a)
  ny(a) = ty(a)
  nz(a) = -SIN(yrot * sc) * tx(a) + COS(yrot * sc) * tz(a)
  tx(a) = nx(a): ty(a) = ny(a): tz(a) = nz(a)
  nx(a) = COS(zrot * sc) * tx(a) - SIN(zrot * sc) * ty(a)
  ny(a) = SIN(zrot * sc) * tx(a) + COS(zrot * sc) * ty(a)
  nz(a) = tz(a) / 128 + zdis / 10
  IF nz(a) = 0 THEN nz(a) = 1
  oxp(a) = xp(a): oyp(a) = yp(a)
  xp(a) = nx(a) / nz(a) + 160
  yp(a) = ny(a) / nz(a) + 100
  PSET (oxp(a), oyp(a)), 0
  PSET (xp(a), yp(a)), xrot
 NEXT a
' OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
' OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 63
LOOP UNTIL INP(&H60) = 1 OR xrot > 128




'STARFIELD

points = 60
DIM px(points)
DIM py(points)
DIM pz(points)
DIM pxp(points)
DIM pyp(points)
speed = 5

SCREEN 13
CLS
OUT &H3C8, 1
FOR a = 63 TO 1 STEP -1
 OUT &H3C9, a
 OUT &H3C9, a
 OUT &H3C9, a
NEXT a
l = 0
FOR a = 1 TO points
 px(a) = 0: py(a) = 0
 pz(a) = INT(RND * 100) + speed * 4
 pxp(a) = 0: pyp(a) = 0
NEXT a
laskuri = 0

'I don't know why this is so slow but I think
'that it could be much faster .. don't know
'how with BASIC..
lups2:
 laskuri = laskuri + 1
 FOR a = 1 TO points
  IF (px(a) <> 0) AND (py(a) <> 0) THEN PSET (pxp(a), pyp(a)), 0
  pz(a) = pz(a) - speed
  pxp(a) = px(a) / pz(a) + 159
  pyp(a) = py(a) / pz(a) + 99
  IF pz(a) < speed * 2 THEN
   l = l + 1
   px(a) = INT(RND * 3000) - 1500
   py(a) = INT(RND * 3000) - 1500
   pz(a) = 120 + speed
   pxp(a) = px(a) / pz(a) + 159
   pyp(a) = py(a) / pz(a) + 99
  END IF
  IF px(a) <> 0 AND py(a) <> 0 THEN PSET (pxp(a), pyp(a)), pz(a) / 3
 NEXT a
' OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0: 'vrc
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
' OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 30
 IF INP(&H60) <> 1 AND laskuri < 250 THEN GOTO lups2



'UNLIMITED BOBS

SCREEN 7
b = 1: yi = 0: a = 100: fr = 1: xkr = 145: ykr = 85: ll = 1
OUT &H3C8, 1
OUT &H3C9, 15: OUT &H3C9, 10: OUT &H3C9, 31
OUT &H3C9, 24: OUT &H3C9, 19: OUT &H3C9, 48
OUT &H3C9, 31: OUT &H3C9, 26: OUT &H3C9, 63
OUT &H3C9, 24: OUT &H3C9, 19: OUT &H3C9, 48
OUT &H3C9, 15: OUT &H3C9, 10: OUT &H3C9, 31
coffee = 0
DO
 coffee = coffee + 1
 PCOPY b, 0:  'Stupid way to change pages ..
              ' (I didn't have time to try some
              '  "inline assembly" stuff, since
              '  I'm not so familiar with QB's
              '  features)..
              'I believe that PCOPY could be as slow as
              'MOVE (mem[$a000:8000],mem[$a000:0],8000);
 a = a + 1
 x = SIN(a * .03) * xkr + 150
 y = COS(a * .046) * ykr + 90
 x2 = SIN((a - 294) * .03) * xkr + 150
 y2 = COS((a - 294) * .046) * ykr + 90
 'PSET (x + t1, y + t2), 15
 IF a < 470 THEN
  CIRCLE (x + 8, y + 8), 8, 1: 'Draw a circle
  CIRCLE (x + 8, y + 8), 7, 2
  CIRCLE (x + 8, y + 8), 6, 3
  CIRCLE (x + 8, y + 8), 5, 2
  CIRCLE (x + 8, y + 8), 4, 1
 END IF
 CIRCLE (x2 + 8, y2 + 8), 8, 0: 'Clear one circle
 CIRCLE (x2 + 8, y2 + 8), 7, 0
 CIRCLE (x2 + 8, y2 + 8), 6, 0
 CIRCLE (x2 + 8, y2 + 8), 5, 0
 CIRCLE (x2 + 8, y2 + 8), 4, 0

 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0: 'vrc
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
 PCOPY 0, b
 b = b + 1
 IF b = 8 THEN b = 1
LOOP UNTIL INP(&H60) = 1 OR coffee = 670



'SHADEBOBS
SCREEN 13
CLS

DIM riv(200)
FOR a = 0 TO 199: riv(a) = a * 320: NEXT a

OUT &H3C8, 0: FOR a = 0 TO 767: OUT &H3C9, 0: NEXT a
OUT &H3C8, 0
FOR a = 0 TO 15: OUT &H3C9, a * 2: OUT &H3C9, 0: OUT &H3C9, 0: NEXT a
FOR a = 0 TO 15: OUT &H3C9, a * 2 + 32: OUT &H3C9, 0: OUT &H3C9, 0: NEXT a
FOR a = 0 TO 31: OUT &H3C9, 63: OUT &H3C9, a * 2: OUT &H3C9, a * 2: NEXT a
FOR a = 0 TO 31: OUT &H3C9, 63 - a: OUT &H3C9, 63: OUT &H3C9, 63 - a: NEXT a
FOR a = 0 TO 31: OUT &H3C9, a + 32: OUT &H3C9, 63 - a * 2: OUT &H3C9, a + 32: NEXT a
FOR a = 0 TO 31: OUT &H3C9, 63 - a: OUT &H3C9, 0: OUT &H3C9, 63: NEXT a
FOR a = 0 TO 31: OUT &H3C9, a + 32: OUT &H3C9, a: OUT &H3C9, 63 - a * 2: NEXT a
FOR a = 0 TO 31: OUT &H3C9, 63: OUT &H3C9, a + 32: OUT &H3C9, 0: NEXT a
FOR a = 0 TO 31: OUT &H3C9, 63 - a * 2: OUT &H3C9, 63 - a * 2: OUT &H3C9, 0: NEXT a
tea = 1
DEF SEG = &HA000
DO
 tea = tea + 1
 x = SIN(tea * .032) * 20 + SIN(tea * .1) * 30 + 160
 y = COS(tea * .02) * 10 + COS(tea * .1) * 30 + 100
 FOR b = y - 16 TO y + 16: FOR a = x - 16 TO x + 16
   POKE riv(b) + a, PEEK(riv(b) + a) + 2
   'Arf, that's SLOW..
 NEXT a: NEXT b
 'OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 0
 'DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 'DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
 'OUT &H3C8, 0: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 30
LOOP UNTIL (INP(&H60) = 1) OR tea > 700

DIM tx1(5) AS STRING
DIM tx2(5) AS STRING

tx1(1) = "³ THIS IS THE LAST PART OF THIS INTRO. ³"
tx1(2) = "³                                      ³"
tx1(3) = "³       Why all effects in this        ³"
tx1(4) = "³        intro were so slow ?!         ³"
tx1(5) = "³                            because...³"

tx2(1) = "³...THIS IS PURE QUICKBASIC 4.0 !!     ³"
tx2(2) = "³   so greetings go ONLY to B-WARE..   ³"
tx2(3) = "³                                      ³"
tx2(4) = "³  Credits: removed from this version  ³"
tx2(5) = "³     - no music in this version -     ³"

SCREEN 13
CLS

OUT &H3C8, 0
FOR a = 0 TO 767: OUT &H3C9, 0: NEXT a
FOR b = 0 TO 4: FOR a = 1 TO 40
 LOCATE 10 + b, a
 COLOR b * 40 + a
 PRINT MID$(tx1(b + 1), a, 1)
NEXT a: NEXT b

FOR a = 1 TO 200
 FOR b = 31 TO 0 STEP -1
  OUT &H3C8, a + (31 - b)
  OUT &H3C9, b * 2
  OUT &H3C9, b * 1.5
  OUT &H3C9, b
 NEXT b
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a
FOR a = 1 TO 72
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a
FOR a = 63 TO 0 STEP -1
 OUT &H3C8, 1
 FOR b = 1 TO 200
  OUT &H3C9, a: OUT &H3C9, a * .75: OUT &H3C9, a * .5
 NEXT b
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a

OUT &H3C8, 0
FOR a = 0 TO 767: OUT &H3C9, 0: NEXT a
FOR b = 0 TO 4: FOR a = 1 TO 40
 LOCATE 10 + b, a
 COLOR b * 40 + a
 PRINT MID$(tx2(b + 1), a, 1)
NEXT a: NEXT b
'very simple "writer"
FOR a = 1 TO 200
 FOR b = 31 TO 0 STEP -1
  OUT &H3C8, a + (31 - b)
  OUT &H3C9, b
  OUT &H3C9, b * 1.5
  OUT &H3C9, b * 2
 NEXT b
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a
FOR a = 1 TO 146
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a
FOR a = 63 TO 0 STEP -1
 OUT &H3C8, 1
 FOR b = 1 TO 200
  OUT &H3C9, a * .5: OUT &H3C9, a * .75: OUT &H3C9, a
 NEXT b
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 0
 DO: LOOP UNTIL (INP(&H3DA) AND 8) = 8
NEXT a

SCREEN 0
WIDTH 80

COLOR 9: PRINT "Pure "; : COLOR 6: PRINT "SYMPTOM";
COLOR 9: PRINT " production of year "; : COLOR 2: PRINT "1994";
COLOR 9: PRINT "."

'
'
'
' That's it! And I want to quote our famous poem Gimle :
'                    "Hope you didn't puke too much!"
'
'
'