Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Messages - bikemadness

Pages: [1] 2 3 4 5 6 7 8
1
Yabasic / Letter Colour Assign
« on: July 08, 2018 »
Just something I've wanted to achieve.
An idea I wanted to apply to another program here.

up/down D-Pad to scroll. Surprise on left D-Pad

Code: [Select]
restore wishlist
read list
dim wish$(list)
for a=1 to list
read wish$(a)
next a

restore highlight
read cols
dim letters$(cols)
dim R(cols)
dim G(cols)
dim B(cols)
for c=1 to cols
read letters$(c)
read R(c)
read G(c)
read B(c)
next c

sel=1

open window 640,512
repeat
setdispbuf vm
vm=1-vm
setdrawbuf vm
clear window
letter=0
row=0
c=peek("port1")

if and(c,16)>0 scroll=scroll+15
if and(c,64)>0 scroll=scroll-15
if scroll>0 scroll=0

if and(c,128)<>0 left=1
if left=1 L=L+1
if L>2 L=2
if L=2 left=0
if and(c,128)=0 L=0

if left=1 sel=sel-1
if sel<1 sel=3

for a=1 to list
space=260/len(wish$(a))
if instr(wish$(a),"*",0)=0 then
row=row+1
for b=1 to len(wish$(a))
for c=1 to cols
if mid$(wish$(a),b,1)=letters$(c) then
letter=letter+1
setrgb 1,R(c),G(c),B(c)
endif
next c
if sel=1 text b*10+10,row*15+scroll,mid$(wish$(a),b,1)
if sel=2 text b*10-(len(wish$(a))*10)+260,row*15+scroll,mid$(wish$(a),b,1)
if sel=3 text b*space,row*15+scroll,mid$(wish$(a),b,1)
next b
endif
next a

setrgb 1,256,256,256

text 10,(row+1)*15+scroll,"The "+str$(row)+" listed are the ones I"
text 10,(row+2)*15+scroll,"have of the "+str$(maxnum)+" in my wishlist"
text 10,(row+3)*15+scroll,str$(letter)

until (1=0)

label wishlist
data 94
data "A QUIET PLACE"
data "*ACTS OF VIOLENCE"
data "AMERICAN PASTORAL"
data "ATLANTIC RIM RESURRECTION"
data "AVENGERS INFINITY WAR"
data "*BALLAD OF LEFTY BROWN. THE"
data "*BEAST OF BURDEN"
data "*BLACK PANTHER"
data "*BRAVEN"
data "*BREATHE"
data "BROKEN"
data "*BUTTERFLIES ARE FREE"
data "BUTTERFLY TREE"
data "CALL ME BY YOUR NAME"
data "CHAOS"
data "CHAPPAQUIDDICK"
data "CIRCLE OF TWO"
data "CITY OF GHOSTS"
data "COCAINE GODMOTHER"
data "COLD MOON"
data "COMMANDO"
data "*COMMUTOR. THE"
data "DEVIL IN A BLUE DRESS"
data "*DOCTOR DETROIT"
data "ENDLESS. THE"
data "EVERY DAY"
data "EXCEPTION. THE"
data "*FORGOTTEN. THE"
data "FUNHOUSE. THE"
data "GAME NIGHT"
data "GARAGE SALE MYSTERY"
data "GHOSTHOUSE"
data "GORGEOUS"
data "GRAVE OF THE FIREFLIES"
data "GUARDIAN. THE"
data "GUERNSEY. THE"
data "*GUN SHY"
data "HANGMAN"
data "HERO. THE"
data "HOWARDS END"
data "HUMANITY BUREAU. THE"
data "*HUNTERS PRAYER"
data "I KILL GIANTS"
data "*INSIDIOUS THE LAST KEY"
data "JOURNEY. THE"
data "KNIGHTS OF THE DAMNED"
data "LADY BIRD"
data "LAST FLAG FLYING"
data "LITTLE VAMPIRE. THE"
data "LONDON"
data "*LOOKING GLASS"
data "MARY AND THE WITCHS FLOWER"
data "MARY MAGDALENE"
data "MEAN MACHINE"
data "MECHANIC RESURRECTION"
data "MENASHE"
data "MERCY. THE"
data "MOLLYS GAME"
data "MOM AND DAD"
data "*MONEY TRAIN"
data "*MONSTER FAMILY"
data "MOUNTAIN"
data "MY LIFE WITHOUT ME"
data "*NINE"
data "PACIFIC RIM UPRISING"
data "PETER RABBIT"
data "*PHANTOM THREAD"
data "*PRESSURE"
data "PROUD MARY"
data "RAISING CAIN"
data "RAMPAGE"
data "READY PLAYER ONE"
data "REANIMATOR TRILOGY"
data "RECALL. THE"
data "*RED SPARROW"
data "RENEGADES"
data "RETURN TO MONTAUK"
data "REVOLVER"
data "RUROUNI KENSHIN"
data "RWBY"
data "SAM I BLOOD"
data "SECRET WINDOW"
data "SILENT RUNNING"
data "SINGULARITY"
data "SNOWWHITE A TALE OF TERROR"
data "STOP MAKING SENSE"
data "STRANGERS PREY AT NIGHT. THE"
data "SUICIDE SQUAD HELL TO PAY"
data "TEACHER. THE"
data "TOP GUN"
data "TURN IT UP"
data "TWELVE STRONG"
data "VIEW FROM THE TOP"
data "WEST AND THE RUTHLESS. THE"
data "WILD CARD"
data "WINCHESTER"

label highlight
data 26
data "A",255,125,5
data "B",50,150,50
data "C",175,75,145
data "D",95,30,210
data "E",255,255,5
data "F",150,175,185
data "G",210,115,30
data "H",180,240,165
data "I",255,5,5
data "J",250,70,10
data "K",195,40,10
data "L",100,75,30
data "M",180,180,180
data "N",85,170,225
data "O",5,255,5
data "P",165,105,105
data "Q",230,230,130
data "R",255,200,200
data "S",255,5,255
data "T",80,80,205
data "U",5,5,255
data "V",200,150,35
data "W",240,15,70
data "X",15,15,90
data "Y",65,140,250
data "Z",45,160,85

Have A Yahappy Day.

2
Yabasic / Another Colour Select/Randomizer
« on: April 24, 2018 »
D-Pad to select, Page Up to Randomize.

Instead of a 1+1/1-1 count, data has been used for chosen numbers.
In this program, there is 32, 16 and 8 counts, changed by the line - restore value*. * is 1, 2 or 3.


Code: [Select]
restore RGB
read sets
dim Rset$(sets)
dim Rnos(sets)
for a=1 to sets
read Rset$(a)
read Rnos(a)
next a

restore values3
read cols
dim Rv(cols)
dim R(cols)
for a=1 to cols
read Rv(a)
next a

sel=3

for a=1 to sel
R(a)=int(cols/2)
next a

open window 640,512
repeat
setdispbuf vm
vm=1-vm
setdrawbuf vm
clear window
c=peek("port1")

if and(c,128)<>0 left=1
if left=1 L=L+1
if L>2 L=2
if L=2 left=0
if and(c,128)=0 L=0

if and(c,32)<>0 right=1
if right=1 R=R+1
if R>2 R=2
if R=2 right=0
if and(c,32)=0 R=0

if left=1 sel=sel-1
if right=1 sel=sel+1
if sel<1 sel=1
if sel>sets sel=sets

if and(c,16)<>0 up=1
if up=1 U=U+1
if U>2 U=2
if U=2 up=0
if and(c,16)=0 U=0

if and(c,64)<>0 down=1
if down=1 D=D+1
if D>2 D=2
if D=2 down=0
if and(c,64)=0 D=0

if and(c,1)<>0 slide=1
if slide=1 S=S+1
if S>2 S=2
if S=2 slide=0
if and(c,1)=0 S=0

for a=1 to sets

if sel=a then
setrgb 1,256,128,0
fill rectangle 75*a+150,138 to 75*a+(len(Rset$(a))*10)+150,156
endif

if sel=a then
setrgb 1,0,128,0
else
setrgb 1,256,256,256
endif
text 75*a+150,150,Rset$(a)
next a

for a=1 to sets rem sel
if sel=a and up=1 R(a)=R(a)+1
if sel=a and down=1 R(a)=R(a)-1
if R(a)<1 R(a)=1
if R(a)>cols R(a)=cols

for b=1 to cols
if R(a)=b Rnos(a)=Rv(b)
next b

setrgb 1,256,256,256
text 75*a+150,165,str$(Rnos(a))
next a

if slide=1 then
for a=1 to sel
R(a)=int(ran(cols))+1
next a
endif

for a=1 to sel
setrgb 1,Rnos(1),Rnos(2),Rnos(3)
fill rectangle 200,200 to 450,450
next a

until (1=0)

label RGB
data 3
data "RED",0
data "GREEN",0
data "BLUE",0

label values1
data 9
data 0,32,64,96,128,160,192,224,256

label values2
data 16
data 0,16,32,48,80,96,112,128,144
data 160,176,192,208,224,240,256

label values3
data 31
data 0,8,16,24,32,40,48,56,80,88
data 96,104,112,120,128,136,144
data 152,160,168,176,184,192,200
data 208,216,224,232,240,248,256

3
Yabasic / Re: Prime Numbers
« on: January 12, 2018 »
And a little faster.
If it only showed text for the last few,
it would take half the time. Use rem notes.

Code: [Select]
open window 640,512
setrgb 1,256,256,256
for y=1 to 100000
num=0
for x=1 to sqrt(y)
if frac(y/x)=0 num=num+1
if num>3 goto skip
next x
if num<2 then
lines=lines+1
number=number+1
nos=nos+1
text 5+gap,lines*11,str$(y)  rem place with this: if y>99950 text 5+gap,lines*11,str$(y)
endif
label skip
if lines>45 then
   gap=gap+70
   lines=0
   endif
if nos=414 then
inkey$ rem take out this
clear window
nos=0
gap=0
lines=0
endif
next y
text gap,(lines+1)*11,"("+str$(number)+")"

4
Yabasic / Re: Prime Numbers
« on: January 10, 2018 »
After a little thought, I sped it up a little, simplified it
and added clear screen carry on. It has room for 6 digits.

Code: [Select]
open window 640,512
setrgb 1,256,256,256
for y=1 to 1000000
num=0
for x=1 to y
if frac(y/x)=0 num=num+1
if num>4 goto skip
next x
if num<3 then
lines=lines+1
number=number+1
nos=nos+1
text 5+gap,lines*11,str$(y)
endif
label skip
if lines>45 then
   gap=gap+70
   lines=0
   endif
if nos=414 then
inkey$
clear window
nos=0
gap=0
lines=0
endif
next y

5
Yabasic / Re: Prime Numbers
« on: January 09, 2018 »
Thanks. I've now added the numerical count
and a start off for larger numbers so the whole
screen doesn't get filled.

Code: [Select]
open window 640,512
space=12
spaces=int(500/space)
lines=0
gap=0
z=int(spaces*87)
repeat
lines=0
gap=0
number=0
for y=1 to 10000
num=0
for x=1 to y
if frac(y/x)=0 num=num+1
next x
if num<3 number=number+1
if num<3 and y>9000 then
'won't start texting until after 9000
'delay until then, since still has to count
lines=lines+1
setrgb 1,0,256,0
text gap,lines*space,str$(number)
setrgb 1,256,256,256
text 50+gap,lines*space,str$(y)
endif
if lines>spaces then
   gap=gap+90
   lines=0
   endif
next y
until (1=0)

6
Yabasic / Prime Numbers
« on: January 08, 2018 »
Couldn't find any samples of working out prime numbers
So here's mine.

Code: [Select]
open window 640,512
setrgb 1,200,200,200
space=12
spaces=int(490/space)
lines=0
gap=0
z=3500
repeat
lines=0
gap=0
number=0
for y=1 to z
num=0
for x=1 to y
if frac(y/x)=0 num=num+1
next x
if num<3 then
lines=lines+1
number=number+1
text 10+gap,lines*space,str$(y)
endif
if lines>spaces then
   gap=gap+50
   lines=0
   endif
next y
text gap,(lines+1)*space,"("+str$(number)+")"
until (1=0)

7
Yabasic / display problem fixed
« on: November 05, 2017 »
It's been a while, but I had to show this one.

The end result of this might not be of use to most people,
but the programming might. (resistor paralleling values)
My problem was displaying more inputs than I needed,
but only using two or more of those inputs.
All in a simple program. D-pad to navigate.

Code: [Select]
restore resistors
read sets
dim Rset$(sets)
dim Rnos(sets)
dim R(sets)
for a=1 to sets
read Rset$(a)
read Rnos(a)
R(a)=1
next a

restore values
read resistor
dim Rv(resistor)
for a=1 to resistor
read Rv(a)
next a

sel=1
open window 640,512
repeat
answer=0
setdispbuf vm
vm=1-vm
setdrawbuf vm
clear window
c=peek("port1")

if and(c,128)<>0 left=1
if left=1 L=L+1
if L>2 L=2
if L=2 left=0
if and(c,128)=0 L=0

if and(c,32)<>0 right=1
if right=1 R=R+1
if R>2 R=2
if R=2 right=0
if and(c,32)=0 R=0

if left=1 sel=sel-1
if right=1 sel=sel+1
if sel<1 sel=1
if sel>8 sel=8

if and(c,16)<>0 up=1
if up=1 U=U+1
if U>2 U=2
if U=2 up=0
if and(c,16)=0 U=0

if and(c,64)<>0 down=1
if down=1 D=D+1
if D>2 D=2
if D=2 down=0
if and(c,64)=0 D=0

for a=1 to sets
if sel=a then
setrgb 1,0,256,0
else
setrgb 1,256,256,256
endif
text 50*a+50,150,Rset$(a)
next a

for a=1 to sel
if sel=a and up=1 R(a)=R(a)+1
if sel=a and down=1 R(a)=R(a)-1
if R(a)<1 R(a)=1
if R(a)>5 R(a)=5

for b=1 to resistor
if R(a)=b Rnos(a)=Rv(b)
next b

setrgb 1,256,256,256
text 50*a+50,165,str$(Rnos(a))
next a

for a=1 to sel
answer=answer+1/Rnos(a)
next a
text 500,165,str$(1/answer)

until (1=0)

label resistors
data 8
data "R1",0
data "R2",0
data "R3",0
data "R4",0
data "R5",0
data "R6",0
data "R7",0
data "R8",0

label values
data 5
data 2.2,3.3,8,15,39

8
Yabasic / Re: Basic San Serif Font
« on: August 09, 2016 »
This is my original program before the approach was altered. The colour assign is added. Easy.
It's more work any future project as I've been told, but I can't follow the altered against my
original to add the colour assign to the altered.

Code: [Select]
a$="once upon a time there was a king and queen,"
a$=a$+" and they lived happily ever after."
s=1
open window 640,512
x=20*s
y=60*s
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
c=peek("port1")
if c=16 s=s+.01
if c=64 s=s-.01
x=20*s
y=60*s
for a=1 to len(a$)
if  mid$(a$,a,1)="a" then
setrgb 1,256,0,0
line x-(18*s),y to x,y-(40*s)
line x,y-(40*s) to x+(18*s),y
line x-(13*s),y-(11*s) to x+(13*s),y-(11*s)
endif
if mid$(a$,a,1)="b" then
setrgb 1,0,256,0
line x-(17*s),y to x-(17*s),y-(40*s)
line x-(17*s),y to x+(7*s),y
line x-(17*s),y-(20*s) to x+(7*s),y-(20*s)
line x-(17*s),y-(40*s) to x+(7*s),y-(40*s)
line x+(12*s),y-(35*s) to x+(12*s),y-(25*s)
line x+(12*s),y-(15*s) to x+(12*s),y-(5*s)
line x+(7*s),y-(40*s) to x+(12*s),y-(35*s)
line x+(7*s),y-(20*s) to x+(12*s),y-(25*s)
line x+(7*s),y-(20*s) to x+(12*s),y-(15*s)
line x+(7*s),y to x+(12*s),y-(5*s)
endif
if mid$(a$,a,1)="c" then
setrgb 1,0,0,256
line x-(15*s),y-(5*s) to x-(15*s),y-(35*s)
line x-(10*s),y to x+(10*s),y
line x-(10*s),y-(40*s) to x+(10*s),y-(40*s)
line x-(15*s),y-(35*s) to x-(10*s),y-(40*s)
line x-(15*s),y-(5*s) to x-(10*s),y
line x+(10*s),y-(40*s) to x+(15*s),y-(35*s)
line x+(10*s),y to x+(15*s),y-(5*s)
endif
if mid$(a$,a,1)="d" then
setrgb 1,256,256,0
line x-(15*s),y-(40*s) to x-(15*s),y
line x-(15*s),y-(40*s) to x+(7*s),y-(40*s)
line x-(15*s),y to x+(7*s),y
line x+(12*s),y-(35*s) to x+(12*s),y-(5*s)
line x+(7*s),y-(40*s) to x+(12*s),y-(35*s)
line x+(7*s),y to x+(12*s),y-(5*s)
endif
if mid$(a$,a,1)="e" then
setrgb 1,256,0,256
line x-(17*s),y to x-(17*s),y-(40*s)
line x-(17*s),y-(40*s) to x+(15*s),y-(40*s)
line x-(17*s),y to x+(15*s),y
line x-(17*s),y-(20*s) to x+(12*s),y-(20*s)
endif
if mid$(a$,a,1)="f" then
setrgb 1,0,256,256
line x-(17*s),y to x-(17*s),y-(40*s)
line x-(17*s),y-(40*s) to x+(17*s),y-(40*s)
line x-(17*s),y-(20*s) to x+(10*s),y-(20*s)
endif
if mid$(a$,a,1)="g" then
setrgb 1,256,128,0
line x-(17*s),y-(35*s) to x-(17*s),y-(5*s)
line x-(12*s),y-(40*s) to x+(12*s),y-(40*s)
line x-(12*s),y to x+(12*s),y
line x+(17*s),y-(5*s) to x+(17*s),y-(20*s)
line x+(17*s),y-(35*s) to x+(17*s),y-(30*s)
line x+(17*s),y-(20*s) to x+(7*s),y-(20*s)
line x-(17*s),y-(35*s) to x-(12*s),y-(40*s)
line x-(17*s),y-(5*s) to x-(12*s),y
line x+(12*s),y-(40*s) to x+(17*s),y-(35*s)
line x+(12*s),y to x+(17*s),y-(5*s)
endif
if mid$(a$,a,1)="h" then
setrgb 1,256,0,128
line x-(15*s),y to x-(15*s),y-(40*s)
line x+(15*s),y to x+(15*s),y-(40*s)
line x-(15*s),y-(20*s) to x+(15*s),y-(20*s)
endif
if mid$(a$,a,1)="i" then
setrgb 1,128,256,0
line x,y to x,y-(40*s)
line x-(10*s),y to x+(10*s),y
line x-(10*s),y-(40*s) to x+(10*s),y-(40*s)
endif
if mid$(a$,a,1)="j" then
setrgb 1,128,0,256
line x,y-(40*s) to x,y-(5*s)
line x-(10*s),y-(40*s) to x+(10*s),y-(40*s)
line x-(17*s),y-(5*s) to x-(12*s),y
line x,y-(5*s) to x-(5*s),y
line x-(5*s),y to x-(12*s),y
endif
if mid$(a$,a,1)="k" then
setrgb 1,0,128,256
line x-(15*s),y to x-(15*s),y-(40*s)
line x+(15*s),y-(40*s) to x-(15*s),y-(15*s)
line x+(15*s),y to x-(10*s),y-(18*s)
endif
if mid$(a$,a,1)="l" then
setrgb 1,64,64,64
line x-(15*s),y to x-(15*s),y-(40*s)
line x-(15*s),y to x+(10*s),y
endif
if mid$(a$,a,1)="m" then
setrgb 1,192,192,192
line x-(17*s),y to x-(17*s),y-(40*s)
line x+(17*s),y to x+(17*s),y-(40*s)
line x-(17*s),y-(40*s) to x,y
line x+(17*s),y-(40*s) to x,y
endif
if mid$(a$,a,1)="n" then
setrgb 1,128,128,128
line x-(15*s),y to x-(15*s),y-(40*s)
line x-(15*s),y-(40*s) to x+(15*s),y
line x+(15*s),y to x+(15*s),y-(40*s)
endif
if mid$(a$,a,1)="o" then
setrgb 1,192,64,192
line x-(15*s),y-(5*s) to x-(15*s),y-(35*s)
line x+(15*s),y-(5*s) to x+(15*s),y-(35*s)
line x-(10*s),y-(40*s) to x+(10*s),y-(40*s)
line x-(10*s),y to x+(10*s),y
line x-(15*s),y-(35*s) to x-(10*s),y-(40*s)
line x-(15*s),y-(5*s) to x-(10*s),y
line x+(15*s),y-(35*s) to x+(10*s),y-(40*s)
line x+(15*s),y-(5*s) to x+(10*s),y
endif
if mid$(a$,a,1)="p" then
setrgb 1,64,192,128
line x-(17*s),y to x-(17*s),y-(40*s)
line x-(17*s),y-(40*s) to x+(10*s),y-(40*s)
line x-(17*s),y-(15*s) to x+(10*s),y-(15*s)
line x+(15*s),y-(35*s) to x+(15*s),y-(20*s)
line x+(10*s),y-(40*s) to x+(15*s),y-(35*s)
line x+(10*s),y-(15*s) to x+(15*s),y-(20*s)
endif
if mid$(a$,a,1)="q" then
setrgb 1,0,64,128
line x-(15*s),y-(5*s) to x-(15*s),y-(35*s)
line x+(15*s),y-(5*s) to x+(15*s),y-(35*s)
line x-(10*s),y-(40*s) to x+(10*s),y-(40*s)
line x-(10*s),y to x+(10*s),y
line x-(15*s),y-(35*s) to x-(10*s),y-(40*s)
line x-(15*s),y-(5*s) to x-(10*s),y
line x+(15*s),y-(35*s) to x+(10*s),y-(40*s)
line x+(15*s),y-(5*s) to x+(10*s),y
line x+(15*s),y to x+(5*s),y-(10*s)
endif
if mid$(a$,a,1)="r" then
setrgb 1,192,128,64
line x-(17*s),y to x-(17*s),y-(40*s)
line x-(17*s),y-(40*s) to x+(10*s),y-(40*s)
line x-(17*s),y-(15*s) to x+(10*s),y-(15*s)
line x+(15*s),y-(35*s) to x+(15*s),y-(20*s)
line x+(10*s),y-(40*s) to x+(15*s),y-(35*s)
line x+(10*s),y-(15*s) to x+(15*s),y-(20*s)
line x+(17*s),y to x+(5*s),y-(15*s)
endif
if mid$(a$,a,1)="s" then
setrgb 1,256,64,192
line x-(12*s),y to x+(12*s),y
line x-(12*s),y-(20*s) to x+(12*s),y-(20*s)
line x-(12*s),y-(40*s) to x+(12*s),y-(40*s)
line x-(17*s),y-(25*s) to x-(17*s),y-(35*s)
line x+(17*s),y-(5*s) to x+(17*s),y-(15*s)
line x-(17*s),y-(35*s) to x-(12*s),y-(40*s)
line x-(17*s),y-(5*s) to x-(12*s),y
line x+(17*s),y-(35*s) to x+(12*s),y-(40*s)
line x+(17*s),y-(5*s) to x+(12*s),y
line x-(17*s),y-(25*s) to x-(12*s),y-(20*s)
line x+(17*s),y-(15*s) to x+(12*s),y-(20*s)
endif
if mid$(a$,a,1)="t" then
setrgb 1,128,64,128
line x,y to x,y-(40*s)
line x-(15*s),y-(40*s) to x+(15*s),y-(40*s)
endif
if mid$(a$,a,1)="u" then
setrgb 1,192,128,64
line x-(15*s),y-(40*s) to x-(15*s),y-(5*s)
line x-(15*s),y-(5*s) to x-(10*s),y
line x-(10*s),y to x+(10*s),y
line x+(10*s),y to x+(15*s),y-(5*s)
line x+(15*s),y-(5*s) to x+(15*s),y-(40*s)
endif
if mid$(a$,a,1)="v" then
setrgb 1,128,64,64
line x-(17*s),y-(40*s) to x,y
line x,y to x+(17*s),y-(40*s)
endif
if mid$(a$,a,1)="w" then
setrgb 1,256,192,64
line x-(20*s),y-(40*s) to x-(10*s),y
line x-(10*s),y to x,y-(40*s)
line x,y-(40*s) to x+(10*s),y
line x+(10*s),y to x+(20*s),y-(40*s)
endif
if mid$(a$,a,1)="x" then
setrgb 1,192,256,64
line x-(15*s),y-(40*s) to x+(15*s),y
line x-(15*s),y to x+(15*s),y-(40*s)
endif
if mid$(a$,a,1)="y" then
setrgb 1,128,256,64
line x-(15*s),y-(40*s) to x,y-(15*s)
line x+(15*s),y-(40*s) to x,y-(15*s)
line x,y-(15*s) to x,y
endif
if mid$(a$,a,1)="z" then
setrgb 1,192,64,256
line x-(15*s),y-(40*s) to x+(15*s),y-(40*s)
line x+(15*s),y-(40*s) to x-(15*s),y
line x-(15*s),y to x+(15*s),y
endif
x=x+(40*s)
if x>450 and mid$(a$,a,1)=" " then
y=y+(60*s)
x=20*s
endif
next a
until (1=0)

9
Yabasic / Re: Basic San Serif Font
« on: August 08, 2016 »
Thanks. It took a bit more work than the wire lettering I did before.
I now want assign a colour to each letter using data.
Not sure how to figure it. My first try failed. Random looked good.

10
Yabasic / Basic San Serif Font
« on: August 07, 2016 »
I bothered to do a letter-only upper case font.
Some of the letters could be a bit more pleasant looking - which I'll probably fix - later.
It's only for title headings.

The working part of the program was done for me in another post.

Code: [Select]
a$="i bothered to do a basic letter only upper"
a$=a$+" case font for title headings in pstwo"
a$=a$+" abcde fghij klmno pqrst uvwxyz"
LoadFont()
open window 640,512
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
x=20
y=20
for a=1 to len(a$)
PrintCharacter(mid$(a$,a,1),x,y)
x=x+CharacterWidth
if x>500 and mid$(a$,a,1)=" " then
y=y+CharacterHeight
x=CharacterWidth
endif
next a
until (1=0)

sub LoadFont()
MAX_CHARACTERS=256
dim Start(MAX_CHARACTERS)
dim Count(MAX_CHARACTERS)
dim x1(1),y1(1),x2(1),y2(1),x3(1),y3(1)
read NumCharacters
read CharacterWidth
read CharacterHeight
TotalLines=1
for ch=1 to NumCharacters
read Ascii$
read NumLines
Ascii = asc(lower$(Ascii$))
Start(Ascii) = TotalLines
Count(Ascii) = NumLines
for l=1 to NumLines
redim x1(TotalLines),y1(TotalLines)
redim x2(TotalLines),y2(TotalLines)
redim x3(TotalLines),y3(TotalLines)
read x1(TotalLines),y1(TotalLines)
read x2(TotalLines),y2(TotalLines)
read x3(TotalLines),y3(TotalLines)
TotalLines = TotalLines + 1
next l
next ch
end sub

sub PrintCharacter(char$,x,y)
ch = asc(mid$(char$,1,1))
for i=Start(ch) to Start(ch)+Count(ch)-1
fill triangle x+x1(i),y+y1(i) to x+x2(i),y+y2(i) to x+x3(i),y+y3(i)
next i
end sub


data 26 rem numcharacters
data 27 rem characterwidth
data 35 rem characterheight

data "a",8
data 9,0,15,0,6,9
data 15,0,18,9,6,9
data 6,9,12,9,6,27
data 6,9,6,27,0,27
data 12,9,18,9,18,27
data 18,9,24,27,18,27
data 15,18,17,24,7,24
data 9,18,15,18,7,24

data "b",29
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 6,0,9,6,6,6
data 6,0,9,0,9,6
data 9,0,12,1,9,6
data 12,1,14,3,9,6
data 14,3,10,7,9,6
data 14,3,15,5,10,7
data 15,5,16,7,10,7
data 10,7,16,7,16,9
data 10,7,16,9,10,9
data 10,9,16,9,15,11
data 10,9,15,11,13,13
data 10,9,13,13,9,10
data 9,10,13,13,9,16
data 6,10,9,10,9,16
data 6,10,9,16,6,16
data 13,13,11,17,9,16
data 13,13,16,15,11,17
data 16,15,17,17,11,17
data 11,17,17,17,17,20
data 11,17,17,20,11,20
data 11,20,17,20,16,22
data 11,20,16,22,14,25
data 11,20,14,25,12,26
data 11,20,12,26,9,21
data 9,21,12,26,9,27
data 6,21,9,21,9,27
data 6,21,9,27,6,27

data "c",30
data 17,6,18,9,12,9
data 11,7,17,6,12,9
data 16,4,17,6,11,7
data 16,4,11,7,10,6
data 13,1,16,4,10,6
data 10,0,13,1,10,6
data 8,0,10,0,10,6
data 8,0,10,6,8,6
data 5,1,8,0,8,6
data 5,1,8,6,2,4
data 2,4,8,6,7,8
data 2,4,7,8,1,6
data 1,6,7,8,6,9
data 1,6,6,9,0,9
data 0,9,6,9,0,18
data 6,9,6,18,0,18
data 0,18,6,18,1,21
data 6,18,7,19,1,21
data 1,21,7,19,2,23
data 7,19,5,26,2,23
data 7,19,8,20,5,26
data 8,20,8,27,5,26
data 8,20,10,20,8,27
data 10,20,10,27,8,27
data 10,20,13,26,10,27
data 11,19,13,26,10,20
data 11,19,16,23,13,26
data 11,19,17,21,16,23
data 12,18,17,21,11,19
data 12,18,18,18,17,21

data "d",20
data 0,0,10,0,0,6
data 10,0,10,6,0,6
data 10,0,13,1,10,6
data 13,1,16,4,10,6
data 16,4,11,7,10,6
data 16,4,17,6,11,7
data 17,6,12,9,11,7
data 17,6,18,9,12,9
data 12,9,18,9,18,18
data 12,9,18,18,12,18
data 12,18,18,18,17,21
data 12,18,17,21,11,20
data 11,20,17,20,16,23
data 11,20,16,23,10,21
data 10,21,16,23,13,26
data 10,21,13,26,10,27
data 0,21,10,21,10,27
data 0,21,10,27,0,27
data 6,6,6,21,0,21
data 0,6,6,6,0,21

data "e",8
data 0,0,18,0,0,6
data 18,0,18,6,0,6
data 6,10,15,10,6,16
data 15,10,15,16,6,16
data 0,6,6,6,6,21
data 0,6,6,21,0,21
data 0,21,18,21,0,27
data 18,21,18,27,0,27

data "f",6
data 0,0,18,0,0,6
data 18,0,18,6,0,6
data 6,10,15,10,6,16
data 15,10,15,16,6,16
data 0,6,6,6,6,27
data 0,6,6,27,0,27

data "g",34
data 17,6,18,9,12,9
data 11,7,17,6,12,9
data 16,4,17,6,11,7
data 16,4,11,7,10,6
data 13,1,16,4,10,6
data 10,0,13,1,10,6
data 8,0,10,0,10,6
data 8,0,10,6,8,6
data 5,1,8,0,8,6
data 5,1,8,6,2,4
data 2,4,8,6,7,8
data 2,4,7,8,1,6
data 1,6,7,8,6,9
data 1,6,6,9,0,9
data 0,9,6,9,0,18
data 6,9,6,17,0,18
data 0,18,6,17,1,21
data 6,17,7,19,1,21
data 1,21,7,19,2,23
data 7,19,5,26,2,23
data 7,19,8,20,5,26
data 8,20,8,27,5,26
data 8,20,10,20,8,27
data 10,20,10,27,8,27
data 10,20,13,26,10,27
data 11,19,13,26,10,20
data 11,19,16,23,13,26
data 11,19,17,21,16,23
data 12,17,17,21,11,19
data 12,17,18,18,17,21
data 18,13,18,18,12,18
data 12,13,18,13,12,18
data 12,13,12,17,9,17
data 9,13,12,13,9,17

data "h",6
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 6,10,12,10,6,16
data 12,10,12,16,6,16
data 12,0,18,0,12,27
data 18,0,18,27,12,27

data "i",6
data 3,0,17,0,3,6
data 17,0,17,6,3,6
data 7,6,13,6,7,21
data 13,6,13,21,7,21
data 3,21,17,21,3,27
data 17,21,17,27,3,27

data "j",18
data 0,18,6,18,1,21
data 6,17,7,19,1,21
data 1,21,7,19,2,23
data 7,19,5,26,2,23
data 7,19,8,20,5,26
data 8,20,8,27,5,26
data 8,20,10,20,8,27
data 10,20,10,27,8,27
data 10,20,13,26,10,27
data 11,19,13,26,10,20
data 11,19,16,23,13,26
data 11,19,17,21,16,23
data 12,18,17,21,11,19
data 12,18,18,18,17,21
data 6,0,18,0,6,6
data 18,0,18,6,6,6
data 12,6,18,6,12,18
data 18,6,18,18,12,18

data "k",6
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 16,0,24,0,6,10
data 24,0,6,18,6,10
data 11,13,24,27,16,27
data 11,13,16,27,7,17

data "l",4
data 3,0,9,0,3,27
data 9,0,9,27,3,27
data 9,21,21,21,9,27
data 21,21,21,27,9,27

data "m",9
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 6,0,12,18,6,18
data 6,18,12,18,9,27
data 12,18,15,27,9,27
data 12,18,18,18,15,27
data 18,0,18,18,12,18
data 18,0,24,27,18,27
data 18,0,24,0,24,27

data "n",6
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 6,0,15,16,6,11
data 6,11,15,16,15,27
data 15,0,21,0,15,27
data 21,0,21,27,15,27

data "o",32
data 17,6,18,9,12,9
data 11,7,17,6,12,9
data 16,4,17,6,11,7
data 16,4,11,7,10,6
data 13,1,16,4,10,6
data 10,0,13,1,10,6
data 8,0,10,0,10,6
data 8,0,10,6,8,6
data 5,1,8,0,8,6
data 5,1,8,6,2,4
data 2,4,8,6,7,8
data 2,4,7,8,1,6
data 1,6,7,8,6,9
data 1,6,6,9,0,9
data 0,9,6,9,0,18
data 6,9,6,18,0,18
data 0,18,6,18,1,21
data 6,18,7,19,1,21
data 1,21,7,19,2,23
data 7,19,5,26,2,23
data 7,19,8,20,5,26
data 8,20,8,27,5,26
data 8,20,10,20,8,27
data 10,20,10,27,8,27
data 10,20,13,26,10,27
data 11,19,13,26,10,20
data 11,19,16,23,13,26
data 11,19,17,21,16,23
data 12,18,17,21,11,19
data 12,18,18,18,17,21
data 18,9,18,18,12,18
data 12,9,18,9,12,18

data "p",18
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 6,0,9,6,6,6
data 6,0,9,0,9,6
data 9,0,12,0,9,6
data 12,0,15,2,9,6
data 15,2,12,8,9,6
data 15,2,17,4,12,8
data 17,4,18,8,12,8
data 12,8,18,8,12,10
data 18,8,18,10,12,10
data 12,10,18,10,17,14
data 12,10,17,14,15,16
data 12,10,15,16,9,12
data 9,12,15,16,12,18
data 9,12,12,18,9,18
data 9,12,9,18,6,18
data 6,12,9,12,6,18

data "q",34
data 17,6,18,9,12,9
data 11,7,17,6,12,9
data 16,4,17,6,11,7
data 16,4,11,7,10,6
data 13,1,16,4,10,6
data 10,0,13,1,10,6
data 8,0,10,0,10,6
data 8,0,10,6,8,6
data 5,1,8,0,8,6
data 5,1,8,6,2,4
data 2,4,8,6,7,8
data 2,4,7,8,1,6
data 1,6,7,8,6,9
data 1,6,6,9,0,9
data 0,9,6,9,0,18
data 6,9,6,18,0,18
data 0,18,6,18,1,21
data 6,18,7,19,1,21
data 1,21,7,19,2,23
data 7,19,5,26,2,23
data 7,19,8,20,5,26
data 8,20,8,27,5,26
data 8,20,10,20,8,27
data 10,20,10,27,8,27
data 10,20,13,26,10,27
data 11,19,13,26,10,20
data 11,19,16,23,13,26
data 11,19,17,21,16,23
data 12,18,17,21,11,19
data 12,18,18,18,17,21
data 18,9,18,18,12,18
data 12,9,18,9,12,18
data 9,16,20,25,17,28
data 9,16,17,28,8,18

data "r",19
data 0,0,6,0,0,27
data 6,0,6,27,0,27
data 6,0,9,6,6,6
data 6,0,9,0,9,6
data 9,0,12,0,9,6
data 12,0,15,2,9,6
data 15,2,12,8,9,6
data 15,2,17,4,12,8
data 17,4,18,8,12,8
data 12,8,18,8,12,10
data 18,8,18,10,12,10
data 12,10,18,10,17,14
data 12,10,17,14,15,16
data 12,10,15,16,9,12
data 9,12,15,16,12,18
data 9,12,12,18,9,18
data 9,12,9,18,6,18
data 6,12,9,12,6,18
data 13,13,19,27,12,27
data 13,13,12,27,8,16

data "s",38
data 18,7,18,9,12,9
data 16,3,18,7,12,9
data 16,3,12,9,11,7
data 14,1,16,3,11,7
data 14,1,11,7,10,6
data 10,0,14,1,10,6
data 8,0,10,0,10,6
data 8,0,10,6,8,6
data 4,1,8,0,8,6
data 4,1,8,6,6,7
data 4,1,6,7,2,3
data 2,3,6,7,0,6
data 0,6,6,7,0,10
data 6,7,6,9,0,10
data 0,10,6,9,2,13
data 6,9,4,15,2,13
data 6,9,8,10,4,15
data 8,10,8,16,4,15
data 8,10,10,10,8,16
data 10,10,10,16,8,16
data 10,10,14,11,10,16
data 14,11,12,17,10,16
data 14,11,16,13,12,17
data 16,13,18,16,12,17
data 12,17,18,16,18,21
data 12,17,18,21,12,20
data 12,20,18,21,16,24
data 12,20,16,24,14,26
data 10,21,12,20,14,26
data 10,21,14,26,10,27
data 10,21,10,27,8,27
data 8,21,10,21,8,27
data 8,21,8,27,4,26
data 7,20,8,21,4,26
data 7,20,4,26,2,24
data 6,18,7,20,2,24
data 6,18,2,24,0,20
data 0,18,6,18,0,20

data "t",4
data 3,0,21,0,3,6
data 21,0,21,6,3,6
data 9,6,15,6,9,27
data 15,6,15,27,9,27

data "u",18
data 0,0,6,0,0,18
data 6,0,6,18,0,18
data 0,18,6,18,0,20
data 6,18,2,24,0,20
data 6,18,7,20,2,24
data 7,20,4,26,2,24
data 7,20,8,21,4,26
data 8,21,8,27,4,26
data 8,21,10,21,8,27
data 10,21,10,27,8,27
data 10,21,14,26,10,27
data 10,21,11,20,14,26
data 11,20,16,24,14,26
data 12,18,16,24,11,20
data 12,18,18,20,16,24
data 12,18,18,18,18,20
data 18,0,18,18,12,18
data 12,0,18,0,12,18

data "v",7
data 0,0,6,0,6,18
data 6,0,12,18,6,18
data 6,18,12,18,9,27
data 12,18,15,27,9,27
data 12,18,18,18,15,27
data 18,0,18,18,12,18
data 18,0,24,0,18,18

data "w",8
data 0,0,6,0,6,27
data 6,0,12,27,6,27
data 11,7,12,27,6,27
data 11,7,16,7,12,27
data 11,7,16,7,16,27
data 16,7,21,27,16,27
data 21,0,21,27,16,27
data 21,0,27,0,21,27

data "x",4
data 0,0,6,0,16,27
data 6,0,22,27,16,27
data 16,0,6,27,0,27
data 16,0,22,0,6,27

data "y",6
data 0,0,6,0,8,18
data 6,0,14,18,8,18
data 16,0,14,18,8,18
data 16,0,22,0,14,18
data 8,18,14,18,8,27
data 14,18,14,27,8,27

data "z",6
data 0,0,18,6,0,6
data 0,0,18,0,18,6
data 11,6,7,21,0,21
data 11,6,18,6,7,21
data 0,21,18,21,18,27
data 0,21,18,27,0,27

11
Yabasic / Over-lap Colour Mixing
« on: June 21, 2016 »
I've always wanted to have different coloured squares moving around and creating
new colours during over-laps of two or more. No knowledge for full interaction with
any and all other squares - only two and one number apart - but the moving 
program sample of two squares shows what I mean and an obvious colour mix.

Code: [Select]
open window 640,512
x1=260
y1=200
r1=256
g1=256
b1=0
x2=380
y2=310
r2=256
g2=0
b2=0
m=1
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
if x2-x1<50 or x2-x1>210 m=-m
x1=x1+m
y1=y1+m
x2=x2-m
y2=y2-m
setrgb 1,r1,g1,b1
fill rectangle x1-100,y1-100 to x1+100,y1+100
setrgb 1,r2,g2,b2
fill rectangle x2-100,y2-100 to x2+100,y2+100
setrgb 1,256,256,256
if x2-x1<200 then
circle x2-100,y1+100,5
circle x1+100,y2-100,5
endif
setrgb 1,(r1+r2)/2,(g1+g2)/2,(b1+b2)/2
if x2-x1<200 fill rectangle x2-100,y1+100 to x1+100,y2-100 rem doesn't work with yellow/blue
setrgb 1,0,0,0
text x1-90,y1-80,"box1"
text x2+50,y2+80,"box2"
setrgb 1,256,256,256
until (1=0)

12
Yabasic / Letter colouring and count
« on: May 10, 2016 »
vowels only and sometimes 'y'.

Code: [Select]
restore smallwords
read maxnum
dim word$(maxnum)
for a=1 to maxnum
read word$(a)
next a
open window 640,512
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
row=0
col=0
a1=0
e1=0
i1=0
o1=0
u1=0
y1=0
for a=1 to maxnum
row=row+1
if row>31 then
col=col+39
row=1
endif
for b=1 to len(word$(a))
setrgb 1,256,256,256
a$=mid$(word$(a),b,1)
if a$="A" setrgb 1,256,0,0
if a$="A" a1=a1+1
if a$="Y" setrgb 1,256,96,0
if a$="Y" y1=y1+1
if a$="E" setrgb 1,256,256,0
if a$="E" e1=e1+1
if a$="I" setrgb 1,0,256,0
if a$="I" i1=i1+1
if a$="O" setrgb 1,0,0,256
if a$="O" o1=o1+1
if a$="U" setrgb 1,256,0,256
if a$="U" u1=u1+1
text b*10+col,row*16,mid$(word$(a),b,1)
next b
next a
setrgb 1,256,256,256
text 10,510,str$(a1)+" A's/"
text 90,510,str$(e1)+" E's/"
text 170,510,str$(i1)+" I's/"
text 250,510,str$(o1)+" O's/"
text 330,510,str$(u1)+" U's/"
text 410,510,str$(y1)+" Y's in this list"
until (1=0)

label smallwords
data 496
data "ACE","ACT","ADD","AGE","AGO","AID","AIL","AIM","AIR","ALE"
data "ALL","ALP","AMP","AND","ANT","ANY","APE","APT","ARC","ARE"
data "ARK","ARM","ART","ASH","ASK","ASP","ASS","ATE","AVE","AWE"
data "AWL","AWN","AXE","AYE","BAD","BAG","BAN","BAR","BAT","BAY"
data "BED","BEE","BEG","BET","BIB","BID","BIG","BIN","BIT","BOA"
data "BOB","BOG","BOO","BOP","BOW","BOX","BOY","BRA","BUD","BUG"
data "BUM","BUN","BUR","BUS","BUT","BUY","BYE","CAD","CAM","CAN"
data "CAP","CAR","CAT","COB","COD","COG","CON","COP","COT","COW"
data "COY","CRY","CUB","CUD","CUE","CUP","CUR","CUT","DAB","DAG"
data "DAM","DAY","DEW","DID","DIE","DIG","DIM","DIN","DIP","DOE"
data "DON","DOT","DRY","DUB","DUD","DUE","DUG","DUO","DUX","DYE"
data "EAR","EAT","EEK","EFT","EGG","EGO","EKE","ELF","ELK","ELM"
data "EMU","END","EON","ERA","ERR","EWE","EYE","FAB","FAD","FAG"
data "FAN","FAR","FAT","FED","FEE","FEW","FIB","FIG","FIN","FIR"
data "FIT","FIX","FLU","FLY","FOB","FOE","FOG","FOR","FOX","FRY"
data "FUN","FUR","GAG","GAL","GAP","GAS","GAY","GEE","GEL","GEM"
data "GET","GIG","GIN","GIT","GNU","GOB","GOD","GOO","GOT","GUM"
data "GUN","GUT","GUY","GYM","HAD","HAG","HAM","HAS","HAT","HAY"
data "HEM","HEN","HER","HEW","HEX","HEY","HID","HIM","HIP","HIS"
data "HIT","HOB","HOE","HOG","HOP","HOT","HOW","HUB","HUE","HUG"
data "HUH","HUM","HUT","ICE","ICY","IDE","IFS","ILK","INK","INN"
data "INS","ION","IRE","IRK","ITS","IVY","JAB","JAG","JAM","JAR"
data "JAW","JET","JEW","JIB","JIG","JOB","JOG","JOT","JOY","JUG"
data "JUT","KEA","KEF","KEG","KEY","KID","KIN","KIP","KIT","LAB"
data "LAD","LAG","LAP","LAW","LAY","LEA","LED","LEE","LEG","LEI"
data "LET","LEW","LID","LIE","LIP","LIT","LOB","LOG","LOO","LOP"
data "LOT","LOW","LUG","LUX","MAD","MAN","MAP","MAR","MAT","MAX"
data "MAY","MEN","MET","MID","MIX","MOA","MOB","MOM","MOO","MOP"
data "MOW","MUD","MUG","MUM","NAB","NAG","NAP","NAY","NET","NEW"
data "NIB","NIL","NIP","NIT","NOB","NOD","NOG","NON","NOR","NOT"
data "NOW","NUB","NUN","NUT","OAF","OAK","OAR","OAT","ODD","ODE"
data "OFF","OFT","OHM","OIL","OLD","ONE","OPT","ORB","ORE","OUR"
data "OUT","OWE","OWL","OWN","PAD","PAL","PAN","PAR","PAT","PAW"
data "PAY","PEA","PEE","PEG","PEN","PET","PEW","PIE","PIG","PIN"
data "PIP","PIT","PLY","POD","POP","POT","POX","PRY","PUB","PUD"
data "PUG","PUN","PUP","PUS","PUT","PYE","RAG","RAM","RAN","RAP"
data "RAT","RAW","RAY","RED","RIB","RID","RIG","RIM","RIP","ROB"
data "ROD","ROE","ROT","ROW","RUB","RUE","RUG","RUM","RUN","RUT"
data "RYE","SAC","SAD","SAG","SAM","SAN","SAP","SAT","SAW","SAY"
data "SEA","SEE","SET","SEW","SEX","SHE","SHY","SIN","SIP","SIR"
data "SIT","SIX","SKI","SKY","SLY","SOB","SOD","SON","SOW","SOY"
data "SPA","SPY","STY","SUB","SUD","SUE","SUM","SUN","TAB","TAD"
data "TAG","TAN","TAP","TAR","TAX","TEA","TEE","TEN","THE","THY"
data "TIC","TIE","TIN","TIP","TIT","TOE","TOG","TON","TOO","TOP"
data "TOT","TOW","TOY","TRY","TUB","TUG","TUI","TUM","TUP","TUT"
data "TUX","TWO","UPS","URE","USE","UTE","VAN","VAT","VEE","VET"
data "VEX","VIA","VIE","VIM","VOW","WAD","WAG","WAR","WAS","WAX"
data "WAY","WEB","WED","WEE","WET","WHO","WHY","WIG","WIN","WIT"
data "WOE","WOK","WON","WRY","YAK","YAM","YAP","YEN","YES","YET"
data "YOB","YOU","ZAP","ZIP","ZIT","ZOO"

13
Yabasic / manual letter jumble
« on: June 10, 2015 »
application for single activation button push
arrow keys to move high-lighted letter
'END' key to change high-lighted letter

Code: [Select]
a$="DBFINTERACTIVE"
open window 640,512
word=len(a$)
cen=(620-(word*20))/2
dim x(word)
dim y(word)
for a=1 to word
x(a)=a*20+cen
y(a)=260
next a
lite=1
repeat
c=peek("port1")
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
if and(c,8196)<>0 letter=1
if letter=1 L=L+1
if L>2 L=2
if L=2 letter=0
if and(c,8196)=0 L=0
if letter=1 lite=lite+1
if lite>word lite=1
if and(c,16)<>0 up=1
if up=1 u=u+1
if u>2 u=2
if u=2 up=0
if and(c,16)=0 u=0
if and(c,64)<>0 down=1
if down=1 d=d+1
if d>2 d=2
if d=2 down=0
if and(c,64)=0 d=0
if and(c,128)<>0 left=1
if left=1 l=l+1
if l>2 l=2
if l=2 left=0
if and(c,128)=0 l=0
if and(c,32)<>0 right=1
if right=1 r=r+1
if r>2 r=2
if r=2 right=0
if and(c,32)=0 r=0
for a=1 to word
if lite=a then
if up=1 y(a)=y(a)-20
if down=1 y(a)=y(a)+20
if left=1 x(a)=x(a)-20
if right=1 x(a)=x(a)+20
endif
if lite=a then
setrgb 1,0,256,0
else
setrgb 1,256,256,256
endif
text x(a),y(a),mid$(a$,a,1)
next a
until (1=0)

have a yahappy day

14
Yabasic / single action button push
« on: June 07, 2015 »
moves a simple object around the screen using arrow keys
one action, per button push, at a time

Code: [Select]
open window 640,512
x=320
y=256
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
c=peek("port1")

if and(c,16)<>0 up=1
if up=1 u=u+1
if u>2 u=2
if u=2 up=0
if and(c,16)=0 u=0

if and(c,64)<>0 down=1
if down=1 d=d+1
if d>2 d=2
if d=2 down=0
if and(c,64)=0 d=0

if and(c,128)<>0 left=1
if left=1 l=l+1
if l>2 l=2
if l=2 left=0
if and(c,128)=0 l=0

if and(c,32)<>0 right=1
if right=1 r=r+1
if r>2 r=2
if r=2 right=0
if and(c,32)=0 r=0

if up=1 y=y-50
if down=1 y=y+50
if left=1 x=x-50
if right=1 x=x+50

if x<25 x=25
if x>615 x=615
if y<25 y=25
if y>485 y=485
rectangle x-25,y-25 to x+25,y+25
until (1=0)

15
Yabasic / nutting out starfield
« on: May 31, 2015 »
I never got my head around programming this starfield business
here is left to right (my head hurts)
I'll post towards viewer version (much) later

Code: [Select]
open window 640,512
starfield=100
dim x(starfield)
dim y(starfield)
dim z(starfield)
for a=1 to starfield
x(a)=ran(620)+10
y(a)=ran(490)+10
z(a)=ran(4)+0.2
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
for a=1 to starfield
x(a)=x(a)+z(a)
fill circle x(a),y(a),z(a)
if x(a)>640 x(a)=0
next a
until (1=0)

16
Yabasic / Maze
« on: December 27, 2014 »
It's not a true maze, but it is a maze like pattern.

Code: [Select]
open window 640,512 rem >.
blox=800
dim x(blox)
dim y(blox)
dim r(blox)
for a=1 to blox
r(a)=ran(4) rem or 3 or 2
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
for a=1 to blox
xx=xx+1
if xx>32 then
xx=1
yy=yy+1
endif
if yy>25 yy=1
x(a)=xx*20
y(a)=yy*20
if r(a)<.7 line x(a),y(a) to x(a)+20,y(a)
if r(a)>.6 and r(a)<1.3 line x(a),y(a) to x(a),y(a)-20
if r(a)>1.2 and r(a)<2.9 line x(a),y(a) to x(a)-20,y(a)
if r(a)>2.8 line x(a),y(a) to x(a),y(a)+20
next a
until(1=0)

17
General chat / Re: Are there people like this here?
« on: March 19, 2014 »
I want to see this work now. It must be a 12000 mile glitch.

Does this get to a Western Leader site?

westernleader.realviewdigital.com

if so, click on 'browse issues' (at the bottom)
click on year 2013
issue december 24
go to page 6

try this for his website

techvana.org.nz

this shows his collection

18
General chat / Re: Are there people like this here?
« on: March 18, 2014 »
There should be one about a guy starting up a gaming console museum.

He;s got examples of probably all consoles and home computers.

There's nothing about cats anywhere on the page I'm reading.

19
General chat / Are there people like this here?
« on: March 18, 2014 »
westernleader.realviewdigital.com/?iid=85727#folio=7

article, top right-hand of page, click on page to expand.

-altered

20
Yabasic / Yet Another Matrix
« on: February 09, 2014 »
I've made other versions - this is better.

Code: [Select]
open window 640,512
mx=50
my=42
dim scr(mx,my)
for y=0 to my
for x=0 to mx
scr(x,y)=int(ran(96)+33)
next x
next y
ms=40
dim sx(ms)
dim sy(ms)
for a=1 to ms
sx(a)=int(ran(mx))
sy(a)=int(ran(my))
next a
repeat
setdispbuf vm
vm=1-vm
setdrawbuf vm
for s=1 to ms
x=sx(s)
y=sy(s)

setrgb 1,0,255,0
gosub letter
y=y-1

setrgb 1,0,200,0
gosub letter
y=y-1

setrgb 1,0,150,0
gosub letter
y=y-1

setrgb 1,0,0,0
fill rect x*12.8-1,y*12.8+4 to x*12.8+12,y*12.8-10
setrgb 1,0,70,0
gosub letter
y=y-24

setrgb 1,0,0,0
fill rect x*12.8-1,y*12.8+4 to x*12.8+12,y*12.8-10
next s
for s=1 to ms
if int(ran(5)+1)=1 sy(s)=sy(s)+1
if sy(s)>my+25 then
sy(s)=0
sx(s)=int(ran(mx))
fi
next s
until (1=0)

label letter
if y<0 or y>my return
c=scr(x,y)
text x*12.8,y*12.8,chr$(c)
return

Pages: [1] 2 3 4 5 6 7 8