Flying Text

Post Reply
DrChip
Posts: 167
Joined: Wed Oct 22, 2014 3:26 pm
My devices: iPhone 4 to 6+,iPad mini to iPad air 2

Flying Text

Post by DrChip »

Code: Select all

rem flying text
rem i wrote this quick..please tweak it and
rem post your versions!
rem Enjoy...

gosub initialize


loop:
 tp=1
 tt=0
 do
  refresh off
  graphics clear 0,0,0
  gosub drawtext
  yr=(yr+yrr)%360
  yrot=yr
  tt=tt+1
  if tt=18 then gosub addletter
  refresh on
 until 1=2
return


drawtext:
 focus=2000
 'fill color 150/255,150/255,0
 gosub drawball

 for star=1 to numstars
  if stars(star)>0 then
  xx=starx(star)
  yy=stary(star)+sh/2
  zz=starz(star)

  x=xx*rcos(yrot)-zz*rsin(yrot)+sw/2
  z=xx*rsin(yrot)+zz*rcos(yrot)

  if z<30 then
   br=-z
   fill color (br*starr(star))/255,(br*starg(star))/255,(br*starb(star))/255
   fill rect x,yy to x+8,yy+8
  else
   stars(star)=0
  end if
end if
 next star
return

rem ##########################################
drawball:
fill color .5,.5,1
fill circle sw/2,sh/2 size 140
 ang=0
 do
  xo1=cosines(ang)!yo1=sines(ang)+100
  xo2=cosines(ang+20)!yo2=sines(ang+20)+100
  'gtriangle 0,0 to xo1,yo1 to xo2,yo2
trix(0)=0
triy(0)=0
trix(1)=xo1
triy(1)=yo1
trix(2)=xo2
triy(2)=yo2
'fill poly trix,triy count 3
  'gtriangle 0,0 to -xo1,yo1 to -xo2,yo2
trix(0)=0
triy(0)=0
trix(1)=-xo1
triy(1)=yo1
trix(2)=-xo2
triy(2)=yo2
'fill poly trix,triy count 3
  'gtriangle 0,0 to -xo1,-yo1 to -xo2,-yo2
trix(0)=0
triy(0)=0
trix(1)=-xo1
triy(1)=-yo1
trix(2)=-xo2
triy(2)=-yo2
'fill poly trix,triy count 3
  'gtriangle 0,0 to xo1,-yo1 to xo2,-yo2
trix(0)=0
triy(0)=0
trix(1)=xo1
triy(1)=-yo1
trix(2)=xo2
triy(2)=-yo2
'fill poly trix,triy count 3
  ang=ang+20
 until ang>90
return


addletter:
 tt=0
 lett=asc(mid$(m$,tp,1))
 tp=(tp+1)%lm
 y=-30
 for a=1 to 8
  long=80+yrot
  for b=0 to 7
   temp = and(letters(lett,a),power(b))
   if temp>0 then
    star=0
    c=0
    do
     if stars(c)=0 then star=c
     c=c+1
    until star>0 or c=numstars
    if star =0 then goto nospace
    starx(star)=sines(long)
    stary(star)=y
    starz(star)=cosines(long)
    stars(star)=1
    starr(star)=mrc(tp)
    starg(star)=mgc(tp)
    starb(star)=mbc(tp)
    star=star+1
   end if
   long=long+2
  next b
  y=y+8
 next a

nospace:
return


setup_message:
 m$=""
 m$=m$&" Hello, it's another odd looking demo. "
 m$=m$&"  This time, the scrolltext is flying "
 m$=m$&"around the ball.  The occasional judder you can "
 m$=m$&"see is the next letter being added to the scene."
 m$=m$&"later. "

 lm=len(m$)
 dim mrc(lm+400),mgc(lm+400),mbc(lm+400)
 cst=1!cfi=lm!red=1!green=1!blue=1!gosub setcolours
 cst=9!cfi=16!red=0!green=0!blue=2!gosub setcolours
 cst=28!cfi=34!red=1!green=0!blue=0!gosub setcolours
 cst=36!cfi=38!red=1!green=1!blue=0!gosub setcolours
 cst=252!cfi=257!red=1!green=0!blue=1!gosub setcolours
 cst=377!cfi=385!red=0!green=0!blue=1!gosub setcolours
 cst=448!cfi=453!red=1!green=0!blue=0!gosub setcolours
 cst=546!cfi=553!red=0!green=1!blue=0!gosub setcolours
return

setcolours:
 for a=cst to cfi
  mrc(a)=red!mgc(a)=green!mbc(a)=blue
 next a
return


initialize:
 sw=screen_width()
 sh=screen_height()
 pi=3.1415
 numstars=220

 gosub setup_message
 dim starx(numstars+1)
 dim stary(numstars+1)
 dim starz(numstars+1),stars(numstars+1)
 dim starr(numstars+1),starg(numstars+1),starb(numstars+1)

 dim cosines(722),sines(721)
 dim rcos(721),rsin(721)
 for angle=0 to 720
  cosines(angle)=cos(angle*(pi/180))*150
  sines(angle)=sin(angle*(pi/180))*150
  rcos(angle)=cos(angle*(pi/180))
  rsin(angle)=sin(angle*(pi/180))
 next angle

 dim power(8)
 for b=0 to 7
  power(b)=2^b
 next b

 gosub maketext

 yr=80!yrr=359
 
 tt=0!tdelay=500
 graphics
 

return

maketext:
 dim letters(256,9)
 do
  read lett
  if lett=-1 then return
  for a=1 to 8
   read letters(lett,a)
  next a
 until 1=2
return

data 32
data 0,0,0,0,0,0,0,0
data 39
data 24,8,0,0,0,0,0,0
data 44
data 0,0,0,0,0,0,24,8
data 46
data 0,0,0,0,0,0,24,0
data 48
data 0,60,70,74,82,98,60,0
data 49
data 0,48,80,16,16,16,124,0
data 50
data 0,60,66,2,60,64,126,0
data 51
data 0,60,66,12,2,66,60,0
data 52
data 0,8,24,40,72,126,8,0
data 53
data 0,126,64,124,2,66,60,0
data 54
data 0,60,64,124,66,66,60,0
data 55
data 0,126,2,4,8,16,16,0
data 56
data 0,60,66,60,66,66,60,0
data 57
data 0,60,66,66,62,2,60,0
data 58
data 0,0,0,16,0,16,0,0
data 65
data 0,60,66,66,126,66,66,0
data 66
data 0,124,66,124,66,66,124,0
data 67
data 0,60,66,64,64,66,60,0
data 68
data 0,120,68,66,66,68,120,0
data 69
data 0,126,64,124,64,64,126,0
data 70
data 0,126,64,124,64,64,64,0
data 71
data 0,60,66,64,78,66,60,0
data 72
data 0,66,66,126,66,66,66,0
data 73
data 0,62,8,8,8,8,62,0
data 74
data 0,2,2,2,66,66,60,0
data 75
data 0,68,72,112,72,68,66,0
data 76
data 0,64,64,64,64,64,126,0
data 77
data 0,66,102,90,66,66,66,0
data 78
data 0,66,98,82,74,70,66,0
data 79
data 0,60,66,66,66,66,60,0
data 80
data 0,124,66,66,124,64,64,0
data 81
data 0,60,66,66,82,74,60,0
data 82
data 0,124,66,66,124,68,66,0
data 83
data 0,60,64,60,2,66,60,0
data 84
data 0,254,16,16,16,16,16,0
data 85
data 0,66,66,66,66,66,60,0
data 86
data 0,66,66,66,66,36,24,0
data 87
data 0,66,66,66,66,90,36,0
data 88
data 0,66,36,24,24,36,66,0
data 89
data 0,130,68,40,16,16,16,0
data 90
data 0,126,4,8,16,32,126,0
data 97
data 0,0,56,4,60,68,60,0
data 98
data 0,32,32,60,34,34,60,0
data 99
data 0,0,28,32,32,32,28,0
data 100
data 0,4,4,60,68,68,60,0
data 101
data 0,0,56,68,120,64,60,0
data 102
data 0,24,32,48,32,32,32,0
data 103
data 0,0,60,68,68,60,4,56
data 104
data 0,64,64,120,68,68,68,0
data 105
data 0,16,0,48,16,16,56,0
data 106
data 0,8,0,8,8,8,72,48
data 107
data 0,32,40,48,48,40,36,0
data 108
data 0,32,32,32,32,32,24,0
data 109
data 0,0,104,84,84,84,84,0
data 110
data 0,0,120,68,68,68,68,0
data 111
data 0,0,56,68,68,68,56,0
data 112
data 0,0,120,68,68,120,64,64
data 113
data 0,0,60,68,68,60,4,6
data 114
data 0,0,28,32,32,32,32,0
data 115
data 0,0,56,64,56,4,120,0
data 116
data 0,16,56,16,16,16,12,0
data 117
data 0,0,68,68,68,68,56,0
data 118
data 0,0,68,68,40,40,16,0
data 119
data 0,0,84,84,84,84,40,0
data 120
data 0,0,68,40,16,40,68,0
data 121
data 0,0,68,68,68,60,4,56
data 122
data 0,0,124,8,16,32,124,0

data -1
Attachments
image.jpg
image.jpg (95.11 KiB) Viewed 1575 times
image.jpg
image.jpg (95.99 KiB) Viewed 1575 times
image.jpg
image.jpg (96.13 KiB) Viewed 1575 times
image.jpg
image.jpg (96.07 KiB) Viewed 1575 times
Last edited by DrChip on Fri Sep 04, 2015 2:25 am, edited 1 time in total.

User avatar
Mr. Kibernetik
Site Admin
Posts: 4786
Joined: Mon Nov 19, 2012 10:16 pm
My devices: iPhone, iPad, MacBook
Location: Russia
Flag: Russia

Re: Flying Text

Post by Mr. Kibernetik »

Very interesting!

DrChip
Posts: 167
Joined: Wed Oct 22, 2014 3:26 pm
My devices: iPhone 4 to 6+,iPad mini to iPad air 2

Re: Flying Text

Post by DrChip »

Code: Select all

rem flying text v.2
rem i wrote this quick..please tweak it and
rem post your versions!
rem v.2 bug fixes
rem Enjoy...

gosub initialize
ballsize=140

loop:
 tp=1
 tt=0
 do
  refresh off
  graphics clear 0,0,0
  gosub drawtext
  yr=(yr+yrr)%360
  yrot=yr
  tt=tt+1
  if tt=18 then gosub addletter
  refresh on
 until 1=2
return


drawtext:
 focus=2000
 'fill color 150/255,150/255,0
 gosub drawball

 for star=1 to numstars
  if stars(star)>0 then
  xx=starx(star)
  yy=stary(star)+sh/2
  zz=starz(star)

  x=xx*rcos(yrot)-zz*rsin(yrot)+sw/2
  z=xx*rsin(yrot)+zz*rcos(yrot)

  if z<30 then
   br=-z
   fill color (br*starr(star))/255,(br*starg(star))/255,(br*starb(star))/255
   fill rect x,yy to x+8,yy+8
  else
   stars(star)=0
  end if
end if
 next star
return


drawball:

 'fill color .i,.i,.i
 'fill circle sw/2,sh/2 size i

 x=sw/2
 y=sh/2
 r=.1
 g=.5
 b=.8
 rad=ballsize

 for a=rad to 1 step -30
  str=(rad-a+10)/100
  fill color r*str,g*str,b*str
  fill circle x,y size a
 next a
return


addletter:
 tt=0
 lett=asc(mid$(m$,tp,1))
 tp=(tp+1)%lm
 y=-30
 for a=1 to 8
  long=80+yrot
  for b=0 to 7
   temp = and(letters(lett,a),power(b))
   if temp>0 then
    star=0
    c=0
    do
     if stars(c)=0 then star=c
     c=c+1
    until star>0 or c=numstars
    if star = 0 then goto nospace
    starx(star)=sines(long)
    stary(star)=y
    starz(star)=cosines(long)
    stars(star)=1
    starr(star)=mrc(tp)
    starg(star)=mgc(tp)
    starb(star)=mbc(tp)
    star=star+1
   end if
   long=long+2
  next b
  y=y+8
 next a

nospace:
return


setup_message:
 m$=""
 m$=m$&" Hello, it's another odd looking demo. "
 m$=m$&"  This time, the scrolltext is flying "
 m$=m$&"around the ball.  The occasional judder you can "
 m$=m$&"see is the next letter being added to the scene."
 m$=m$&"later. "

 lm=len(m$)
 'colors for text
 dim mrc(lm+400),mgc(lm+400),mbc(lm+400)
 cst=1!cfi=lm!red=1!green=1!blue=1!gosub setcolours
 cst=14!cfi=20!red=0!green=0!blue=2!gosub setcolours
 cst=21!cfi=25!red=1!green=0!blue=0!gosub setcolours
 cst=33!cfi=38!red=1!green=1!blue=0!gosub setcolours
 
return

setcolours:
 for a=cst to cfi
  mrc(a)=red!mgc(a)=green!mbc(a)=blue
 next a
return


initialize:
 sw=screen_width()
 sh=screen_height()
 pi=3.1415
 numstars=220

 gosub setup_message
 dim starx(numstars+1)
 dim stary(numstars+1)
 dim starz(numstars+1),stars(numstars+1)
 dim starr(numstars+1),starg(numstars+1),starb(numstars+1)

 dim cosines(722),sines(721)
 dim rcos(721),rsin(721)
 for angle=0 to 720
  cosines(angle)=cos(angle*(pi/180))*150
  sines(angle)=sin(angle*(pi/180))*150
  rcos(angle)=cos(angle*(pi/180))
  rsin(angle)=sin(angle*(pi/180))
 next angle

 dim power(8)
 for b=0 to 7
  power(b)=2^b
 next b

 gosub maketext

 yr=80!yrr=359
 
 tt=0!tdelay=500
 graphics
 

return

maketext:
 dim letters(256,9)
 do
  read lett
  if lett>-1 then 
  for a=1 to 8
   read letters(lett,a)
  next a
 until 1=2
 end if
return

data 32
data 0,0,0,0,0,0,0,0
data 39
data 24,8,0,0,0,0,0,0
data 44
data 0,0,0,0,0,0,24,8
data 46
data 0,0,0,0,0,0,24,0
data 48
data 0,60,70,74,82,98,60,0
data 49
data 0,48,80,16,16,16,124,0
data 50
data 0,60,66,2,60,64,126,0
data 51
data 0,60,66,12,2,66,60,0
data 52
data 0,8,24,40,72,126,8,0
data 53
data 0,126,64,124,2,66,60,0
data 54
data 0,60,64,124,66,66,60,0
data 55
data 0,126,2,4,8,16,16,0
data 56
data 0,60,66,60,66,66,60,0
data 57
data 0,60,66,66,62,2,60,0
data 58
data 0,0,0,16,0,16,0,0
data 65
data 0,60,66,66,126,66,66,0
data 66
data 0,124,66,124,66,66,124,0
data 67
data 0,60,66,64,64,66,60,0
data 68
data 0,120,68,66,66,68,120,0
data 69
data 0,126,64,124,64,64,126,0
data 70
data 0,126,64,124,64,64,64,0
data 71
data 0,60,66,64,78,66,60,0
data 72
data 0,66,66,126,66,66,66,0
data 73
data 0,62,8,8,8,8,62,0
data 74
data 0,2,2,2,66,66,60,0
data 75
data 0,68,72,112,72,68,66,0
data 76
data 0,64,64,64,64,64,126,0
data 77
data 0,66,102,90,66,66,66,0
data 78
data 0,66,98,82,74,70,66,0
data 79
data 0,60,66,66,66,66,60,0
data 80
data 0,124,66,66,124,64,64,0
data 81
data 0,60,66,66,82,74,60,0
data 82
data 0,124,66,66,124,68,66,0
data 83
data 0,60,64,60,2,66,60,0
data 84
data 0,254,16,16,16,16,16,0
data 85
data 0,66,66,66,66,66,60,0
data 86
data 0,66,66,66,66,36,24,0
data 87
data 0,66,66,66,66,90,36,0
data 88
data 0,66,36,24,24,36,66,0
data 89
data 0,130,68,40,16,16,16,0
data 90
data 0,126,4,8,16,32,126,0
data 97
data 0,0,56,4,60,68,60,0
data 98
data 0,32,32,60,34,34,60,0
data 99
data 0,0,28,32,32,32,28,0
data 100
data 0,4,4,60,68,68,60,0
data 101
data 0,0,56,68,120,64,60,0
data 102
data 0,24,32,48,32,32,32,0
data 103
data 0,0,60,68,68,60,4,56
data 104
data 0,64,64,120,68,68,68,0
data 105
data 0,16,0,48,16,16,56,0
data 106
data 0,8,0,8,8,8,72,48
data 107
data 0,32,40,48,48,40,36,0
data 108
data 0,32,32,32,32,32,24,0
data 109
data 0,0,104,84,84,84,84,0
data 110
data 0,0,120,68,68,68,68,0
data 111
data 0,0,56,68,68,68,56,0
data 112
data 0,0,120,68,68,120,64,64
data 113
data 0,0,60,68,68,60,4,6
data 114
data 0,0,28,32,32,32,32,0
data 115
data 0,0,56,64,56,4,120,0
data 116
data 0,16,56,16,16,16,12,0
data 117
data 0,0,68,68,68,68,56,0
data 118
data 0,0,68,68,40,40,16,0
data 119
data 0,0,84,84,84,84,40,0
data 120
data 0,0,68,40,16,40,68,0
data 121
data 0,0,68,68,68,60,4,56
data 122
data 0,0,124,8,16,32,124,0

data -1
Attachments
image.jpg
image.jpg (103.01 KiB) Viewed 1563 times
image.jpg
image.jpg (103.42 KiB) Viewed 1563 times
image.jpg
image.jpg (98.98 KiB) Viewed 1563 times

Post Reply