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.


Topics - bikemadness

Pages: [1] 2 3 4
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 / 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)

4
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

5
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

6
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)

7
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"

8
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

9
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)

10
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)

11
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)

12
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

13
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

14
Yabasic / Random Coloured Line Star
« on: January 27, 2014 »
Another from the archives. Down, D-pad to change.

Code: [Select]
open window 640,512
ang=pi/180
points=30
skip=int(ran(points-1)/2)+1
radius=int(ran(75))+100
dim r(points)
dim g(points)
dim b(points)
for point=1 to points
r(point)=ran(256)
g(point)=ran(256)
b(point)=ran(256)
next point
x=320
y=256
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
go=go+1
if go>10 go=10
c=peek("port1")
if and(c,16384)>0 and go=10 then
go=1
points=int(ran(27))+3
skip=int(ran(points/2))+1
radius=int(ran(75))+100
for point=1 to points
r(point)=ran(256)
g(point)=ran(256)
b(point)=ran(256)
next point
endif
for point=1 to points
dir=360/points
x1=cos(dir*ang*point)*radius+x
y1=sin(dir*ang*point)*radius+y 
x2=cos(dir*ang*(point+skip))*radius+x
y2=sin(dir*ang*(point+skip))*radius+y
setrgb 1,r(point),g(point),b(point)
line x1,y1 to x2,y2
next point
setrgb 1,256,256,256
text 20,20,"   points used: "+str$(points)
text 20,40,"points skipped: "+str$(skip)
text 20,60,"      diameter: "+str$(radius)
if skip=1 then
text 250,radius+y+40,str$(points)+" sided polygon "
if points=3 text 410,radius+y+40,"(triangle)"
if points=4 text 410,radius+y+40,"(square)"
if points=5 text 410,radius+y+40,"(pentagon)"
if points=6 text 400,radius+y+40,"(hexagon)"
if points=7 text 400,radius+y+40,"(septagon)"
if points=8 text 400,radius+y+40,"(octagon)"
if points=9 text 400,radius+y+40,"(nonagon)"
endif
if skip>1text 250,radius+y+40,str$(points)+" point star"
until (1=0)

15
Yabasic / Random Colour Chart
« on: January 27, 2014 »
Here's something I needed, from my early days.
Down, D-pad to change.

Code: [Select]
open window 640,512
nos=15 rem squares, x-axis
row=nos*.8
boxx=640/nos
boxy=510/row
dim r(nos,row)
dim g(nos,row)
dim b(nos,row)
dim x(nos)
dim y(row)
for c=1 to row
for a=1 to nos
r(a,c)=int(ran(256))
g(a,c)=int(ran(256))
b(a,c)=int(ran(256))
x(a)=a*boxx-(boxx/2)
y(c)=c*boxy-(boxy/2)
next a
next c
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
c=peek("port1")
go=go+1
if go>10 go=10
if go>2 off=0
if and(c,64)>0 and go=10 then
go=1
if go<3 off=1
endif
for c=1 to row
for a=1 to nos
if off=1 then
r(a,c)=int(ran(256))
g(a,c)=int(ran(256))
b(a,c)=int(ran(256))
endif
setrgb 1,r(a,c),g(a,c),b(a,c)
fill rectangle x(a)-(boxx/2),y(c)-(boxy/2) to x(a)+(boxx/2),y(c)+(boxy/2)
setrgb 1,256,256,256
text x(a)-15,y(c)-9,str$(r(a,c))
text x(a)-15,y(c)+3,str$(g(a,c))
text x(a)-15,y(c)+15,str$(b(a,c))
next a
next c
until (1=0)

16
Yabasic / Fraction Display
« on: January 27, 2014 »
It's been a while. So hard to come up with original ideas.
Here's something that got into my head.
Displaying fractions of an inch, as in imperial drill size range.

Code: [Select]
open window 640,512
denominator=128 rem this number is parts per inch
'second number shows mm equivalent
dim loop(denominator)
dim topnum(denominator)
dim count(denominator)
dim botnum(denominator)
for a=1 to denominator
topnum(a)=a
count(a)=1
botnum(a)=denominator
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
col=1
gap=0
for a=1 to denominator
loop(a)=topnum(a)/2
if frac(topnum(a)/2)=0 then
count(a)=count(a)*2
topnum(a)=loop(a)
else
col=col+1
if topnum(a)<10 then
align=10
elseif topnum(a)>99 then
align=-10
else
align=0
endif
if botnum(a)/count(a)<=1 then
setrgb 1,256,0,0
else
setrgb 1,256,256,256
endif
text 10+gap+align,15*col,str$(topnum(a))+"/"+str$(botnum(a)/count(a))
endif
text 80+gap,15*col,str$((a/denominator)*25.4)
if col>32 then
gap=gap+160
col=1
endif
next a
until (1=0)

17
Yabasic / YaBasic on PSP?
« on: September 09, 2013 »
I kept forgetting that it was possible and I've come across the files.
I tried loading them, different ways, still no luck.
Can this be put in tutorials ? The best I get is corrupted data.
 :cheers:

18
Yabasic / Animated Name Data
« on: August 10, 2013 »
A previous post, animated.

Up and Down keys to highlight a name
Right key for random, Left key to reset
Keys '1', '2' and '3' to move (highlighted) name
Name list starts at '1'

Code: [Select]
restore selection
read maxnum
dim name$(maxnum)
dim type(maxnum)
for a=1 to maxnum
read name$(a)
read type(a)
next a
dim x(maxnum),y(maxnum)
dim x1(maxnum),y1(maxnum)
for a=1 to maxnum
x1(a)=x(a)
y1(a)=y(a)
x(a)=50
y(a)=270
next a
down=1
speed=2
open window 640,512
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
row1=0
row2=0
row3=0
c=peek("port1")
go=go+1
if go>10 go=10
if and(c,16)>0 and go=10 then
go=0
down=down-1
endif
if and(c,64)>0 and go=10 then
go=0
down=down+1
endif
if down<1 down=maxnum
if down>maxnum down=1
if and(c,128)>0 and go=10 then
for a=1 to maxnum
go=0
type(a)=1
next a
endif
g$=inkey$(0)
for a=1 to maxnum
if down=a then
if g$="1" type(a)=1
if g$="2" type(a)=2
if g$="3" type(a)=3
endif
next a
for a=1 to maxnum
if speed=1 then
x(a)=x1(a)
y(a)=y1(a)
endif
if speed=2 then
if x(a)>x1(a) x(a)=x(a)-5
if x(a)<x1(a) x(a)=x(a)+5
if y(a)>y1(a) y(a)=y(a)-1
if y(a)<y1(a) y(a)=y(a)+1
endif
if down=a then
setrgb 1,256,0,0
else
setrgb 1,256,256,256
endif
if type(a)=1 then
row1=row1+17
x1(a)=140-(len(name$(a))*10)
y1(a)=row1+50
text x(a),y(a),name$(a)
endif
if type(a)=2 then
row2=row2+17
x1(a)=340-(len(name$(a))*10)
y1(a)=row2+50
text x(a),y(a),name$(a)
endif
if type(a)=3 then
row3=row3+17
x1(a)=540-(len(name$(a))*10)
y1(a)=row3+50
text x(a),y(a),name$(a)
endif
next a
for a=1 to maxnum
if x(a)<>x1(a) or y(a)<>y1(a) then
start=0
else
start=1
endif
next a
if and(c,32)>0 and go=10 and start=1 then
for a=1 to maxnum
go=0
type(a)=int(ran(3))+1
next a
endif
setrgb 1,256,256,256
text 10,20," (1)Undecided"
text 210,20," (2)Left Wing"
text 410,20,"(3)Right Wing"
until(1=0)

label selection
data 25
data "Benny!",1
data "Bikemadness",1
data "Clanky",1
data "Clyde",1
data "Combatking0",1
data "Hellfire",1
data "Hotshot",1
data "Jim",1
data "Ninogenio",1
data "Optimus",1
data "Paul",1
data "Pixel_Outlaw",1
data "Rain_Storm",1
data "RBZ",1
data "RDC",1
data "Relsoft",1
data "Shockwave",1
data "Slinks",1
data "Staticgerbil",1
data "Stonemonkey",1
data "Stormbringer",1
data "Taj",1
data "Tetra",1
data "Va!n",1
data "Yaloopy",1

I don't know what is wrong with the world, but I know how to fix it.

Have a Yahappy day.

19
Yabasic / Data movement
« on: July 28, 2013 »
This could be useful, as opposed to doing it by hand.

I saw an idea, I wondered if I could do that.

Down key to highlight a name and right key to move that name.

Code: [Select]
restore selection
read maxnum
dim name$(maxnum)
dim type(maxnum)
for a=1 to maxnum
read name$(a)
read type(a)
next a
down=1
open window 640,512
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
row1=0
row2=0
row3=0
c=peek("port1")
go=go+1
if go>10 go=10
if and(c,64)>0 and go=10 then
go=0
down=down+1
endif
if down>maxnum down=1
for a=1 to maxnum
if and(c,32)>0 and go=10 and down=a then
go=0
type(a)=type(a)+1
endif
if type(a)>3 type(a)=1
next a
for a=1 to maxnum
if down=a then
setrgb 1,256,0,0
else
setrgb 1,256,256,256
endif
if type(a)>3 type(a)=1
if type(a)=1 then
row1=row1+1
text 10,row1*17+50,name$(a)
endif
if type(a)=2 then
row2=row2+1
text 210,row2*17+50,name$(a)
endif
if type(a)=3 then
row3=row3+1
text 400,row3*17+50,name$(a)
endif
next a
setrgb 1,256,256,256
text 10,20,"Undecided"
text 210,20,"Left Wing"
text 400,20,"Right Wing"
until(1=0)

label selection
data 25
data "Benny!",1
data "Bikemadness",1
data "Clanky",1
data "Clyde",1
data "Combatking0",1
data "Hellfire",1
data "Hotshot",1
data "Jim",1
data "Ninogenio",1
data "Optimus",1
data "Paul",1
data "Pixel_Outlaw",1
data "Rain_Storm",1
data "RBZ",1
data "RDC",1
data "Relsoft",1
data "Shockwave",1
data "Slinks",1
data "Staticgerbil",1
data "Stonemonkey",1
data "Stormbringer",1
data "Taj",1
data "Tetra",1
data "Va!n",1
data "Yaloopy",1

added bits (just for fun) version.

Down key to highlight a name and Right key to move that name.
Left key to randomize positions and Up key to reset.

Code: [Select]
restore selection
read maxnum
dim name$(maxnum)
dim type(maxnum)
for a=1 to maxnum
read name$(a)
read type(a)
next a
down=1
open window 640,512
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
row1=0
row2=0
row3=0
c=peek("port1")
go=go+1
if go>10 go=10
if and(c,64)>0 and go=10 then
go=0
down=down+1
endif
if down>maxnum down=1
if and(c,16384)>0 and go=10 then
for a=1 to maxnum
if len(name$(a))<6 type(a)=1
if len(name$(a))>5 and len(name$(a))<9 type(a)=2
if len(name$(a))>8 type(a)=3
next a
endif
if and(c,16)>0 and go=10 then
for a=1 to maxnum
go=0
type(a)=1
next a
endif
if and(c,128)>0 and go=10 then
for a=1 to maxnum
go=0
type(a)=int(ran(3))+1
next a
endif
for a=1 to maxnum
if and(c,32)>0 and go=10 and down=a then
go=0
type(a)=type(a)+1
endif
if type(a)>3 type(a)=1
next a
for a=1 to maxnum
if down=a then
setrgb 1,256,0,0
else
setrgb 1,256,256,256
endif
if type(a)>3 type(a)=1
if type(a)=1 then
row1=row1+1
text 140-(len(name$(a))*10),row1*17+50,name$(a)+" "+str$(len(name$(a)))
endif
if type(a)=2 then
row2=row2+1
text 340-(len(name$(a))*10),row2*17+50,name$(a)+" "+str$(len(name$(a)))
endif
if type(a)=3 then
row3=row3+1
text 530-(len(name$(a))*10),row3*17+50,name$(a)+" "+str$(len(name$(a)))
endif
next a
setrgb 1,256,256,256
text 10,20,"    Undecided"
text 210,20,"    Left Wing"
text 400,20,"   Right Wing"
until(1=0)

label selection
data 25
data "Benny!",1
data "Bikemadness",1
data "Clanky",1
data "Clyde",1
data "Combatking0",1
data "Hellfire",1
data "Hotshot",1
data "Jim",1
data "Ninogenio",1
data "Optimus",1
data "Paul",1
data "Pixel_Outlaw",1
data "Rain_Storm",1
data "RBZ",1
data "RDC",1
data "Relsoft",1
data "Shockwave",1
data "Slinks",1
data "Staticgerbil",1
data "Stonemonkey",1
data "Stormbringer",1
data "Taj",1
data "Tetra",1
data "Va!n",1
data "Yaloopy",1

Or a basic version, using 1,2 and 3 for name movement.

Code: [Select]
restore selection
read maxnum
dim name$(maxnum)
dim type(maxnum)
for a=1 to maxnum
read name$(a)
read type(a)
next a
down=1
open window 640,512
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
row1=0
row2=0
row3=0
c=peek("port1")
go=go+1
if go>10 go=10
if and(c,16)>0 and go=10 then
go=0
down=down-1
endif
if and(c,64)>0 and go=10 then
go=0
down=down+1
endif
if down<1 down=maxnum
if down>maxnum down=1
if and(c,128)>0 and go=10 then
for a=1 to maxnum
go=0
type(a)=1
next a
endif
g$=inkey$(0)
for a=1 to maxnum
if down=a then
if g$="1" type(a)=1
if g$="2" type(a)=2
if g$="3" type(a)=3
endif
next a
for a=1 to maxnum
if type(a)=1 then
row1=row1+1
if down=a text 145,row1*17+50,"<"
text 140-(len(name$(a))*10),row1*17+50,name$(a)
endif
if type(a)=2 then
row2=row2+1
if down=a text 345,row2*17+50,"<"
text 340-(len(name$(a))*10),row2*17+50,name$(a)
endif
if type(a)=3 then
row3=row3+1
if down=a text 545,row3*17+50,"<"
text 540-(len(name$(a))*10),row3*17+50,name$(a)
endif
next a
text 10,20," (1)Undecided"
text 210,20," (2)Left Wing"
text 410,20,"(3)Right Wing"
until(1=0)

label selection
data 25
data "Benny!",1
data "Bikemadness",1
data "Clanky",1
data "Clyde",1
data "Combatking0",1
data "Hellfire",1
data "Hotshot",1
data "Jim",1
data "Ninogenio",1
data "Optimus",1
data "Paul",1
data "Pixel_Outlaw",1
data "Rain_Storm",1
data "RBZ",1
data "RDC",1
data "Relsoft",1
data "Shockwave",1
data "Slinks",1
data "Staticgerbil",1
data "Stonemonkey",1
data "Stormbringer",1
data "Taj",1
data "Tetra",1
data "Va!n",1
data "Yaloopy",1

I don't know what is wrong with the world, but I know how to fix it.

Have a Yahappy day.

20
Yabasic / Stuck on Indicies
« on: March 21, 2013 »
I haven't quite got the hang of them yet.

This program (long version) shows what I want.

Code: [Select]
open window 640,512
go=1
starz1=100
starz2=100
dim x1(starz1)
dim y1(starz1)
dim r1(starz1)
dim g1(starz1)
dim b1(starz1)
dim x2(starz2)
dim y2(starz2)
dim r2(starz2)
dim g2(starz2)
dim b2(starz2)
for a=1 to starz1
x1(a)=int(ran(64))*10
y1(a)=int(ran(51))*10
r1(a)=ran(256)
g1(a)=ran(256)
b1(a)=ran(256)
next a
for a=1 to starz2
x2(a)=int(ran(64))*10
y2(a)=int(ran(51))*10
r2(a)=ran(256)
g2(a)=ran(256)
b2(a)=ran(256)
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
setrgb 1,20,20,20
fill rectangle 0,0 to 640,512
go=go+1
if go>50 go=1
if go>1 and go<25 then
for a=1 to starz1
y1(a)=y1(a)+1
if y1(a)>515 y1(a)=-3
setrgb 1,r1(a),g1(a),b1(a)
fill circle x1(a),y1(a),2
'dot x1(a),y1(a)
next a
endif
if go>25 and go<50 then
for a=1 to starz2
y2(a)=y2(a)+1
if y2(a)>515 y2(a)=-3
setrgb 1,r2(a),g2(a),b2(a)
fill circle x2(a),y2(a),2
'dot x2(a),y2(a)
next a
endif
until (1=0)

In the attempted short version, I'm not getting my random colours.

Can anyone see what I'm missing?

Code: [Select]
open window 640,512 rem >.
go=1
starz=3
stars=100
dim r(starz),g(starz),b(starz)
dim x(stars,starz),y(stars,starz)
for a=1 to starz
r(a)=ran(256)
g(a)=ran(256)
b(a)=ran(256)
for c=1 to stars
x(c,a)=int(ran(64))*10
y(c,a)=int(ran(51))*10
next c
next a
repeat
setdrawbuf vm
vm=1-vm
setdispbuf vm
clear window
go=go+1
if go>75 go=1
setrgb 1,20,20,20
fill rectangle 0,0 to 640,512
for a=1 to starz
setrgb 1,r(a),g(a),b(a)
for c=1 to stars
y(c,a)=y(c,a)+1
if y(c,a)>515 y(c,a)=-3
if go>1 and go<25 fill circle x(c,1),y(c,1),2
if go>25 and go<50 fill circle x(c,2),y(c,2),2
if go>50 and go<75 fill circle x(c,3),y(c,3),2
next c
next a
until (1=0)

Help!

Pages: [1] 2 3 4