CMM2-Love: comet-demo.bas

comet-demo.bas

' comet
option explicit
dim float sssx(1000)
dim float sssy(1000)
const stars=200
const sss.x=0
const sss.y=1
const sss.dx=2
const sss.dy=3
const sss.count=4
const sss.col=5
dim float sss(stars,5)
dim integer ttt(255)
dim integer angle
mode 1,8
play wav "comet-demo.wav"
intro
init_ttt
init_colored_page
demo_3'map
demo_1'comet
demo_2'spiral
demo_3'map
demo_5'heart
demo_4'fade out
credits
end

sub demo_5
  local integer i
  local float ang, vel, myt, sinmyt
  local integer side

  for i=0 to stars
    if sss(i,sss.count)>20 then
      sss(i,sss.count)=20
    endif
  next i

  timer=0
  ang=0
  side=2
  do
    page write side
    cls
    for i=0 to stars
      blit ttt(sss(i,sss.count)),ttt(sss(i,sss.col)),sss(i,sss.x),sss(i,sss.y),25,25,1,4
      sss(i,sss.x)=sss(i,sss.x)+sss(i,sss.dx)
      sss(i,sss.y)=sss(i,sss.y)+sss(i,sss.dy)
      inc sss(i,sss.count), -1
      if sss(i,sss.count)<0 or sss(i,sss.x)<0 or sss(i,sss.y)<0 or sss(i,sss.x)>800 or sss(i,sss.y)>600 then
        sss(i,sss.count) = 50
        sss(i,sss.x) = 400'sssx(angle)
        sss(i,sss.y) = 300'sssy(angle)
        vel = 0.3
        myt = -3 + 6*rnd
        sinmyt = sin(myt)
        sss(i,sss.dx) = vel * 18 * sinmyt *sinmyt *sinmyt
        sss(i,sss.dy) = -vel * (14 * cos(myt) - 5 * cos(2 * myt) - 3 * cos(3 * myt) - cos(4 * myt))
      endif
    next i
    page display side
    side=side xor 2
    inc angle,5
    if angle < 0 then inc angle, 1000
    angle = angle mod 1000
  loop while not keydown(1) and timer<15000
  do
  loop while keydown(1)
end sub

sub demo_4
  local integer i,tjek
  local integer side

  side=2
  do
    page write side
    cls
    tjek=0
    for i=0 to stars
      if sss(i,sss.count)>0 then
        blit ttt(sss(i,sss.count)),ttt(sss(i,sss.col)),sss(i,sss.x),sss(i,sss.y),25,25,1,4
        sss(i,sss.x)=sss(i,sss.x)+sss(i,sss.dx)
        sss(i,sss.y)=sss(i,sss.y)+sss(i,sss.dy)
        inc sss(i,sss.count), -1
        inc tjek,1
      endif
    next i
    page display side
    side=side xor 2
  loop while tjek
end sub

sub demo_3
  local integer i
  local float ang, vel
  local integer side

  for i=0 to 1000
    sssx(i) = rnd*800'+350*cos(2*pi*i/1000)
    sssy(i) = rnd*600'+250*sin(2*pi*i/1000)
  next i

  timer=0
  ang=0
  side=2
  do
    page write side
    cls
    for i=0 to stars
      blit ttt(sss(i,sss.count)),ttt(sss(i,sss.col)),sss(i,sss.x),sss(i,sss.y),25,25,1,4
      sss(i,sss.x)=sss(i,sss.x)+sss(i,sss.dx)
      sss(i,sss.y)=sss(i,sss.y)+sss(i,sss.dy)
      inc sss(i,sss.count), -1
      if sss(i,sss.count)<0 or sss(i,sss.x)<0 or sss(i,sss.y)<0 or sss(i,sss.x)>800 or sss(i,sss.y)>600 then
        sss(i,sss.count) = 10+50*rnd
        sss(i,sss.x) = sssx(angle)
        sss(i,sss.y) = sssy(angle)
        inc angle,1
        angle = angle mod 1000
        sss(i,sss.dx) = 0
        sss(i,sss.dy) = 0
        sss(i,sss.col) = 20*rnd mod 20
      endif
    next i
    page display side
    side=side xor 2
  loop while not keydown(1) and timer<15000
  do
  loop while keydown(1)
end sub

sub demo_2
  local integer i
  local float ang, vel
  local integer side

  for i=0 to 1000
    sssx(i) = 400'+350*cos(2*pi*i/1000)
    sssy(i) = 300'+250*sin(2*pi*i/1000)
  next i

  timer=0
  ang=0
  side=2
  do
    page write side
    cls
    for i=0 to stars
      blit ttt(sss(i,sss.count)),ttt(sss(i,sss.col)),sss(i,sss.x),sss(i,sss.y),25,25,1,4
      sss(i,sss.x)=sss(i,sss.x)+sss(i,sss.dx)
      sss(i,sss.y)=sss(i,sss.y)+sss(i,sss.dy)
      inc sss(i,sss.count), -1
      if sss(i,sss.count)<0 or sss(i,sss.x)<0 or sss(i,sss.y)<0 or sss(i,sss.x)>800 or sss(i,sss.y)>600 then
        sss(i,sss.count) = 10+50*rnd
        sss(i,sss.x) = sssx(angle)
        sss(i,sss.y) = sssy(angle)
        vel = 10+5*rnd
        sss(i,sss.dx) = vel*sin(ang)
        sss(i,sss.dy) = vel*cos(ang)
        ang=ang+0.05
      endif
    next i
    page display side
    side=side xor 2
    inc angle,5
    if angle < 0 then inc angle, 1000
    angle = angle mod 1000
  loop while not keydown(1) and timer<15000
  do
  loop while keydown(1)
end sub

sub demo_1
  local integer i,side
  local float vel,ang

  for i=0 to 1000
    sssx(i) = 400+350*cos(2*pi*i/1000)
    sssy(i) = 300+250*sin(2*pi*i/1000)
  next i

  timer=0
  angle=0
  side=2
  do
    page write side
    cls
    for i=0 to stars
      blit ttt(sss(i,sss.count)),ttt(sss(i,sss.col)),sss(i,sss.x),sss(i,sss.y),25,25,1,4
      sss(i,sss.x)=sss(i,sss.x)+sss(i,sss.dx)
      sss(i,sss.y)=sss(i,sss.y)+sss(i,sss.dy)
      inc sss(i,sss.count), -1
      if sss(i,sss.count)<0 or sss(i,sss.x)<0 or sss(i,sss.y)<0 or sss(i,sss.x)>800 or sss(i,sss.y)>600 then
        sss(i,sss.count) = 10+50*rnd
        sss(i,sss.x) = sssx(angle)
        sss(i,sss.y) = sssy(angle)
        ang = 2*pi*rnd
        vel = 0.5 + 5*rnd
        sss(i,sss.dx) = vel*cos(ang)
        sss(i,sss.dy) = vel*sin(ang)
      endif
    next i
    page display side
    side=side xor 2
    inc angle,5
    if angle < 0 then inc angle, 1000
    angle = angle mod 1000
  loop while not keydown(1) and timer<15000
  do
  loop while keydown(1)
end sub

sub init_ttt
  local integer i,tt

  for i=0 to 255
    tt = i
    if tt>20 then tt=20    
    ttt(i) = 15 + 25*tt
  next i
end sub

sub init_rotating_page
  local dots=10
  local xp(dots)
  local yp(dots)
  local float radius,angle,dangle,start_angle,xx,yy
  local integer i,j,k

  radius=10
  start_angle=0
  dangle=0.005
  page write 1

  for k=0 to 20
    start_angle=k*2*pi/(5*20)
    for j=0 to 20 
      radius=10*j/20
      xx = 25 + 25*j
      yy = 25 + 25*k
      for i=0 to dots-1 step 2
        angle=2*pi*i/dots
        xp(i) = xx+radius*cos(angle+start_angle)
        yp(i) = yy+radius*sin(angle+start_angle)
        angle=2*pi*(i+1)/dots
        xp(i+1) = xx+radius*0.25*cos(angle+start_angle)
        yp(i+1) = yy+radius*0.25*sin(angle+start_angle)
      next i
      polygon dots, xp(), yp(), rgb(yellow), rgb(yellow)
    next j
  next k
end sub

sub init_colored_page
  local dots=10
  local xp(dots)
  local yp(dots)

  local float radius,angle,dangle,xx,yy
  local integer i,j,k,color

  radius=10
  color=0
  dangle=0.005
  page write 1
  cls
  for k=0 to 20
    color=map(1+rnd*254)
    for j=0 to 20 
      radius=10*j/20
      xx = 25 + 25*j
      yy = 25 + 25*k
      for i=0 to dots-1 step 2
        angle=2*pi*i/dots
        xp(i) = xx+radius*cos(angle)
        yp(i) = yy+radius*sin(angle)
        angle=2*pi*(i+1)/dots
        xp(i+1) = xx+radius*0.25*cos(angle)
        yp(i+1) = yy+radius*0.25*sin(angle)
      next i
      polygon dots, xp(), yp(), color, color
    next j
  next k
end sub


sub credits
  const hearts=20
  const heart.x=0
  const heart.y=1
  const heart.a=2
  const heart.dx=3 
  const heart.dy=4
  const heart.da=5
  const heart.vi=6
  local float heart(hearts,6)
  local integer b
  local integer toggle
  local float textypos, ypos
  local float sinus(100)
  local integer sinuscounter
  
  page display 0
  page write 0
  cls

  page write 3
  render_text
  for b=0 to 100
    sinus(b)=10+10*sin(2*pi*b/100)
  next b
  textypos=660
  sinuscounter=0

  page write 2
  render_heart_map

  for b=0 to hearts
    heart(b,heart.x) = 800*rnd
    heart(b,heart.y) = 600*rnd
    heart(b,heart.a) = 360*rnd
    heart(b,heart.dx) = 0.5+5*rnd
    heart(b,heart.dy) = 0.5+5*rnd
    heart(b,heart.da) = 5 - 10*rnd
    heart(b,heart.vi) = 0
  next b

  toggle = 0
  do
    page write toggle
    cls
    for b=0 to hearts
      if heart(b,heart.vi) then
        blit (heart(b,heart.a) mod 20)*30, (heart(b,heart.a)\20)*30, heart(b,heart.x), heart(b,heart.y), 30, 30, 2, 4
      endif
      heart(b,heart.x) = heart(b,heart.x) + heart(b,heart.dx)
      heart(b,heart.y) = heart(b,heart.y) + heart(b,heart.dy)
      heart(b,heart.a) = heart(b,heart.a) + heart(b,heart.da)
      if heart(b,heart.a) > 360 then 
        heart(b,heart.a) = heart(b, heart.a) - 360
      else if heart(b,heart.a) < 0 then 
        heart(b,heart.a) = heart(b, heart.a) + 360
      endif
      if heart(b,heart.x) > 800 or heart(b,heart.y) > 600 then
        if rnd > 0.5 then
          heart(b,heart.x) = 800*rnd
          heart(b,heart.y) = -40
        else
          heart(b,heart.x) = -40
          heart(b,heart.y) = 600*rnd
        endif
        heart(b,heart.dx) = 0.5+5*rnd
        heart(b,heart.dy) = 0.5+5*rnd
        heart(b,heart.vi)=1
      endif
    next b
    ypos = textypos
    for b=0 to 10
      blit 0,4+b*25,0,ypos,800,25,3,4
      inc ypos, 25
      ypos = ypos + sinus((sinuscounter+b*8) mod 100)
    next b
    inc sinuscounter, 1
    if textypos > 150 then textypos=textypos-1
    page display toggle
    toggle = toggle xor 1
  loop while not keydown(1)
  do
  loop while keydown(1)

end sub

sub render_text
  local string k$
  local integer y
  y=15
  cls
  do
    read k$
    if k$=".END." then exit do
    text 400,y,k$, "CM", 3,1, rgb(white)
    inc y, 25
  loop
end sub

sub render_heart_map
  local integer b, a
  local float rotate

  for rotate=0 to 360
    b = (rotate mod 20)*30
    a = (rotate\20)*30
    drawheart b+15, a+15, 0.75, rotate
  next rotate
end sub

sub drawheart xoff as float, yoff as float, radius as float, angle as float
  local float x(60), y(60)
  local float myt, sinmyt, bx, by, rotate
  local integer b
  
  rotate = 2*pi*angle/360
  for b=0 to 60
    myt = -3 + 6*b/60
    sinmyt = sin(myt)
    bx = radius * 18 * sinmyt *sinmyt *sinmyt
    by = radius * (14 * cos(myt) - 5 * cos(2 * myt) - 3 * cos(3 * myt) - cos(4 * myt))
    x(b) = xoff+bx* cos(rotate) + by* sin(rotate)
    y(b) = yoff-(by* cos(rotate) - bx* sin(rotate))
  next b
  polygon 60, x(), y(), rgb(pink), rgb(pink)
end sub

data "CMM2-Love comet-demo"
data "Released: 2021-12-18"
data "by Henryk Krasuski"
data ""
data "CREDITS to"
data "Geoff and Peter for creating the CMM2"
data ""
data "Feel free to share or borrow the code"
data ""
data ".END."


sub intro
  local float xpos(60,301)
  local float ypos(60,301)
  local integer n%=59
  local integer xp%(59)
  local integer yp%(59)
  local float dmyt,scale,sinmyt,myt,rotate,delta_rotate,xa,ya,p,xb,yb
  local integer xoffset,yoffset,a,b,aa,scroller.offset.y,rrr,sss,c

  cls

'create table with coordinates for big heart  
  dmyt = 6.0 / 60.0
  xoffset = 400
  yoffset = 300
  scale = 1
  a = 0
  do while scale < 20
    myt = -3
    b = 0
    do while myt < 3
      myt = MYT + dmyt
      sinmyt = sin(myt)
      xpos(b, a) = scale * 18 * sinmyt *sinmyt *sinmyt
      ypos(b, a) = scale * (14 * cos(myt) - 5 * cos(2 * myt) - 3 * cos(3 * myt) - cos(4 * myt))
      b = b + 1
    loop
    scale = scale * 1.01
    a = a + 1
  loop
  
  rotate = 0
  delta_rotate = 0.02

'create map with small hearts
  page write 2
  cls  
    aa=0
    for a= 0 to 150
      rotate = 2 * pi * a / 301
      xa = 20 + 40 * ( a mod 19)
      ya = 20 + 40 * (a \ 19)
      for b = 0 to 59
          xp%(b) = xa+xpos(b,aa)* cos(rotate) + ypos(b,aa)* sin(rotate)
          yp%(b) = ya-(ypos(b,aa)* cos(rotate) - xpos(b,aa)* sin(rotate))
      next b
      polygon n%, xp%(), yp%(), rgb(pink), rgb(pink)
      rotate = rotate + delta_rotate
    next a

  page write 3
  cls  
    aa=0
    for a= 151 to 301
      rotate = 2 * pi * a / 301
      xa = 20 + 40 * ( (a-151) mod 19)
      ya = 20 + 40 * ( (a-151) \ 19)
      for b = 0 to 59
          xp%(b) = xa+xpos(b,aa)* cos(rotate) + ypos(b,aa)* sin(rotate)
          yp%(b) = ya-(ypos(b,aa)* cos(rotate) - xpos(b,aa)* sin(rotate))
      next b
      polygon n%, xp%(), yp%(), rgb(pink), rgb(pink)
      rotate = rotate + delta_rotate
    next a

' the text scroller
  page write 4
    text 400,250,"Welcome to","CM",5,1,rgb(white)
    text 400,300,"CMM2-Love","CM",5,1,rgb(white)
    text 400,350,"comet-demo.bas","CM",5,1,rgb(white)
  scroller.offset.y = 800

  page write 1
  rrr = 0

  timer=0
  do
    for a= 0 to 301
      if keydown(0) then exit do
      cls
      for b = 0 to 59
        xp%(b) = xoffset+xpos(b,a)* cos(rotate) + ypos(b,a)* sin(rotate)
        yp%(b) = yoffset-(ypos(b,a)* cos(rotate) - xpos(b,a)* sin(rotate))
      next b
      polygon n%, xp%(), yp%(), rgb(red), rgb(red)

      if scroller.offset.y > 0 then 
        inc scroller.offset.y, -1
      endif
        blit 0,0,0,scroller.offset.y,800,600,4,4

      p=20
      for c=0 to 9
        if rrr < 151 then
          xa = 20 + 40 * ( rrr mod 19)
          ya = 20 + 40 * (rrr \ 19)
          sss = 2
        else
          xa = 20 + 40 * ( (rrr-151) mod 19)
          ya = 20 + 40 * ( (rrr-151) \ 19)
          sss = 3
      endif
        xb = xoffset + xoffset*cos(6.26*c/10)*0.8
        yb = yoffset + yoffset*sin(6.26*c/10)*0.8
        blit xa-p,ya-p, xb-p, yb-p, 40, 40, sss, 4
      next c
      
      page copy 1 to 0
      rotate = rotate + delta_rotate
      inc rrr
      rrr = rrr mod 301
    next a
    
    for a= 300 to 0 step -1
      if keydown(0) then exit do
      cls
      for b = 0 to 59
        xp%(b) = xoffset+xpos(b,a)* cos(rotate) + ypos(b,a)* sin(rotate)
        yp%(b) = yoffset-(ypos(b,a)* cos(rotate) - xpos(b,a)* sin(rotate))
      next b
      polygon n%, xp%(), yp%(), rgb(red), rgb(red)

      if scroller.offset.y > 0 then 
        inc scroller.offset.y, -1
      endif
        blit 0,0,0,scroller.offset.y,800,600,4,4

      for c=0 to 9
        if rrr < 151 then
          xa = 20 + 40 * ( rrr mod 19)
          ya = 20 + 40 * (rrr \ 19)
          sss = 2
        else
          xa = 20 + 40 * ( (rrr-151) mod 19)
          ya = 20 + 40 * ( (rrr-151) \ 19)
          sss = 3
      endif
        xb = xoffset + xoffset*cos(6.26*c/10)*0.8
        yb = yoffset + yoffset*sin(6.26*c/10)*0.8
        blit xa-p,ya-p, xb-p, yb-p, 40, 40, sss, 4
      next c

      page copy 1 to 0
      rotate = rotate + delta_rotate
      inc rrr
      rrr = rrr mod 301
    next a
  loop while timer<15000
end sub