| Welcome, Guest |
You have to register before you can post on our site.
|
| Forum Statistics |
» Members: 483
» Latest member: aplus
» Forum threads: 2,799
» Forum posts: 26,392
Full Statistics
|
|
|
| Hangman 2 |
|
Posted by: SierraKen - 08-14-2024, 04:29 AM - Forum: SierraKen
- No Replies
|
 |
It chooses one out of 1000 common words. It starts when you run it. Just keep choosing letters to see if you can complete the word before your entire person is made. Capital letters are automatically turned off because they are not used. Enjoy!
Code: (Select All)
'Hangman 2 by SierraKen - August 30, 2022.
'Thanks to B+ for some guidance and OldMoses for a better looking gallows.
'----------------------------------------------------------------------------------------------------
'Feel free to add or subtract any words from the DATA lines with letter amounts two to twelve.
'If you accidentally add a word larger than 12 letters or smaller than 2 letters, it will not use it.
'Also if you accidentally add a word with a capital letter or a symbol, it won't use that either.
'1000 common words comes with this on the DATA lines of different sizes.
_Title "Hangman 2 by Sierraken - Choose A Letter"
Randomize Timer ' <<< once up here is all that is needed
Do
On Error GoTo readagain:
Read words$
w = w + 1
Loop
readagain:
Restore ManyWords:
Dim words$(w)
For a = 1 To w
Read words$(a)
Next a
Dim letter$(30), letter2$(30)
start:
Cls
Screen _NewImage(800, 600, 32)
'Sky
For y = 0 To 400
c = c + .5
Line (0, y)-(800, y), _RGB32(0, 0, c)
Next y
c = 0
'Grass
For y = 401 To 600
c = c + .5
Line (0, y)-(800, y), _RGB32(0, c, 0)
Next y
c = 0
'Tumbleweeds
For weeds = 50 To 500 Step 100
For seconds = 0 To 15 Step 4
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + weeds
y = Int(Cos(s / 180 * 3.141592) * 60) + 401
For b = .7 To -.7 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Next b
Next seconds
For seconds = 45 To 60 Step 4
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + weeds
y = Int(Cos(s / 180 * 3.141592) * 60) + 401
For b = .7 To -.7 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Next b
Next seconds
Next weeds
For weeds = 50 To 500 Step 100
For seconds = 0 To 15 Step 2
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 30) + weeds
y = Int(Cos(s / 180 * 3.141592) * 30) + 401
For b = .5 To -.5 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(0, 255, 0)
Line (weeds + b, 401)-(x + b, y), _RGB32(0, 255, 0)
Next b
Next seconds
For seconds = 45 To 60 Step 2
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 30) + weeds
y = Int(Cos(s / 180 * 3.141592) * 30) + 401
For b = .5 To -.5 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(0, 255, 0)
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 255, 0)
Next b
Next seconds
Next weeds
weeds = 725
For seconds = 0 To 15 Step 4
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + weeds
y = Int(Cos(s / 180 * 3.141592) * 60) + 401
For b = .7 To -.7 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Next b
Next seconds
For seconds = 45 To 60 Step 4
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + weeds
y = Int(Cos(s / 180 * 3.141592) * 60) + 401
For b = .7 To -.7 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 216, 127)
Next b
Next seconds
For seconds = 0 To 15 Step 2
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 30) + weeds
y = Int(Cos(s / 180 * 3.141592) * 30) + 401
For b = .5 To -.5 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(0, 255, 0)
Line (weeds + b, 401)-(x + b, y), _RGB32(0, 255, 0)
Next b
Next seconds
For seconds = 45 To 60 Step 2
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 30) + weeds
y = Int(Cos(s / 180 * 3.141592) * 30) + 401
For b = .5 To -.5 Step -.1
Line (weeds + b, 401)-(x + b, y), _RGB32(0, 255, 0)
Line (weeds + b, 401)-(x + b, y), _RGB32(61, 255, 0)
Next b
Next seconds
Line (0, 400)-(800, 400), _RGB32(255, 255, 255)
Line (600, 400)-(600, 100), _RGB32(255, 255, 255)
Line (600, 100)-(400, 100), _RGB32(255, 255, 255)
Line (400, 100)-(400, 180), _RGB32(255, 255, 255)
'a little beefier carpentry - from OldMoses
For beam% = 0 To 19
If beam% Mod 2 = 0 Then c~& = &HFF964B00 Else c~& = &HFF7F7F7F
Line (600 - beam%, 400)-(600 - beam%, 100 + beam%), c~& 'vertical post
Line (600 - beam%, 100 + beam%)-(400 + beam, 100 + beam%), c~& 'horizontal post
Next beam%
Line (550, 400)-(630, 375), _RGB32(255, 255, 255), BF
randword:
word$ = words$(Int(Rnd * w) + 1)
l = Len(word$)
If l > 12 Or l < 2 Then GoTo randword:
For lines = 203 To 203 + ((l - 1) * 50) Step 50
Line (lines - 5, 505)-(lines + 15, 475), _RGB32(255, 255, 255), BF
Line (lines, 500)-(lines + 10, 500), _RGB32(0, 0, 0)
Next lines
Line (40, 440)-(160, 505), _RGB32(255, 255, 255), BF
For ll = 1 To l
letter$(ll) = Mid$(word$, ll, 1)
If Asc(letter$(ll)) < 97 Or Asc(letter$(ll)) > 122 Then GoTo start:
letter2$(ll) = letter$(ll)
Next ll
letter = 0: oldletter = 0
mistake = 0: t = 1
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
go:
g = 0
Do
_Limit 20
a$ = InKey$
If a$ <> "" Then GoTo continue:
Loop
continue:
a$ = LCase$(a$)
If a$ = Chr$(27) Then End
t = t + 1
oldletter = letter
For ll = 1 To l
If a$ = letter$(ll) Then
If g < 1 Then letter$(ll) = ""
g = 1
letter = letter + 1
_PrintString (205 + (ll - 1) * 50, 480), a$
For snd = 200 To 700 Step 100
Sound snd, .5
Next snd
If letter = l Then GoTo won:
End If
Next ll
If oldletter <> letter Then GoTo go:
mistake = mistake + 1
'Head
If mistake = 1 Then
For sz = .25 To 20 Step .25
Circle (400, 200), sz, _RGB32(194, 127, 127)
Next sz
_PrintString (50, 450), a$
Sound 200, .5
Sound 600, .5
End If
'Body
If mistake = 2 Then
Line (395, 220)-(405, 240), _RGB32(194, 127, 127), BF
For sz = .25 To 40 Step .25
Circle (400, 270), sz, _RGB32(61, 216, 127), , , 1.85
Next sz
_PrintString (75, 450), a$
Sound 200, .5
Sound 600, .5
End If
'Left Arm
If mistake = 3 Then
seconds = 55
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + 390
y = Int(Cos(s / 180 * 3.141592) * 60) + 240
For b = 5 To -5 Step -.1
Line (390 + b, 240)-(x + b, y), _RGB32(61, 216, 127)
Line (390 + b, 240)-(x + b, y), _RGB32(61, 216, 127)
Next b
For sz = .25 To 6.5 Step .25
Circle (x + 1, y), sz, _RGB32(194, 127, 127), 2 * _Pi, _Pi
Next sz
_PrintString (100, 450), a$
Sound 200, .5
Sound 600, .5
End If
'Right Arm
If mistake = 4 Then
seconds = 5
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + 410
y = Int(Cos(s / 180 * 3.141592) * 60) + 240
For b = 5 To -5 Step -.1
Line (410 + b, 240)-(x + b, y), _RGB32(61, 216, 127)
Line (410 + b, 240)-(x + b, y), _RGB32(61, 216, 127)
Next b
For sz = .25 To 6.5 Step .25
Circle (x - 1, y), sz, _RGB32(194, 127, 127), 2 * _Pi, _Pi
Next sz
_PrintString (125, 450), a$
Sound 200, .5
Sound 600, .5
End If
'Left Leg
If mistake = 5 Then
seconds = 35
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + 390
y = Int(Cos(s / 180 * 3.141592) * 60) + 290
For b = 5 To -5 Step -.1
Line (390 + b, 290)-(x + b, y), _RGB32(61, 216, 127)
Line (390 + b, 290)-(x + b, y), _RGB32(61, 216, 127)
Next b
For sz = .25 To 6.5 Step .25
Circle (x + 1, y), sz, _RGB32(194, 127, 127), _Pi, 2 * _Pi
Next sz
_PrintString (150, 450), a$
Sound 200, .5
Sound 600, .5
End If
'Right Leg
If mistake = 6 Then
seconds = 25
s = (60 - seconds) * 6 + 180
x = Int(Sin(s / 180 * 3.141592) * 60) + 410
y = Int(Cos(s / 180 * 3.141592) * 60) + 290
For b = 5 To -5 Step -.1
Line (410 + b, 290)-(x + b, y), _RGB32(61, 216, 127)
Line (410 + b, 290)-(x + b, y), _RGB32(61, 216, 127)
Next b
For sz = .25 To 6.5 Step .25
Circle (x, y), sz, _RGB32(194, 127, 127), _Pi, 2 * _Pi
Next sz
_PrintString (50, 475), a$
Sound 200, .5
Sound 600, .5
End If
'Eyes
If mistake = 7 Then
For sz = .25 To 3 Step .25
Circle (390, 190), sz, _RGB32(255, 255, 255)
Circle (410, 190), sz, _RGB32(255, 255, 255)
Next sz
For sz = .25 To 1.75 Step .25
Circle (390, 190), sz, _RGB32(0, 161, 255)
Circle (410, 190), sz, _RGB32(0, 161, 255)
Next sz
For sz = .25 To 1 Step .25
Circle (390, 190), sz, _RGB32(0, 0, 0)
Circle (410, 190), sz, _RGB32(0, 0, 0)
Next sz
_PrintString (75, 475), a$
Sound 200, .5
Sound 600, .5
End If
'Nose
If mistake = 8 Then
For sz = .25 To 3 Step .25
Circle (400, 200), sz, _RGB32(78)
Next sz
_PrintString (100, 475), a$
Sound 200, .5
Sound 600, .5
End If
'Mouth
If mistake = 9 Then
For sz = .25 To 8 Step .25
Circle (400, 212), sz, _RGB32(0, 0, 0), , , .5
Next sz
_PrintString (125, 475), a$
For snd = 700 To 100 Step -50
Sound snd, .5
Next snd
For ll = 1 To l
_PrintString (205 + (ll - 1) * 50, 480), letter2$(ll)
Next ll
_PrintString (305, 415), " You Lose "
Locate 29, 38: Input " Again (Y/N) "; ag$
If Mid$(ag$, 1, 1) = "y" Or Mid$(ag$, 1, 1) = "Y" Then
GoTo start:
End If
End
End If
GoTo go:
won:
_PrintString (305, 415), " You Win! "
For s = 1 To 2
For snd = 100 To 800 Step 100
Sound snd, .5
Next snd
Next s
Locate 29, 38: Input " Again (Y/N) "; ag$
If Mid$(ag$, 1, 1) = "y" Or Mid$(ag$, 1, 1) = "Y" Then
GoTo start:
End If
End
'Almost all of the following words were found here: https://www.ef.edu/english-resources/eng...000-words/
ManyWords:
Data ability,able,about,above,accept,according,account,across,act,action
Data activity,actually,add,address,administration,admit,adult,affect,after,again
Data against,age,agency,agent,ago,agree,agreement,ahead,air,all
Data allow,almost,alone,along,already,also,although,always,among,amount
Data analysis,and,animal,another,answer,any,anyone,anything,appear,apply
Data approach,area,argue,arm,around,arrive,art,article,artist,as
Data ask,assume,at,attack,attention,attorney,audience,author,authority,available
Data avoid,away,baby,back,bad,bag,ball,bank,bar,base
Data be,bear,beat,beautiful,because,become,bed,before,begin,behavior
Data behind,believe,benefit,best,better,between,beyond,big,bill,billion
Data bit,black,blood,blue,board,body,book,born,both,box
Data boy,break,bring,brother,budget,build,building,business,but,buy
Data by,call,camera,campaign,can,cancer,candidate,capital,car,card
Data care,career,carry,case,cat,catch,cause,cell,center,central
Data century,certain,certainly,chair,challenge,chance,change,character,charge,check
Data child,choice,choose,church,citizen,city,civil,claim,class,clear
Data clearly,close,coach,cold,collection,college,color,come,commercial,common
Data community,company,compare,computer,concern,condition,conference,consider,consumer,contain
Data continue,control,cost,could,country,couple,course,court,cover,cow
Data create,crime,cultural,culture,cup,current,customer,cut,dark,data
Data daughter,day,dead,deal,death,debate,decade,decide,decision,deep
Data defense,degree,democratic,describe,design,despite,detail,determine,develop,development
Data die,difference,different,difficult,dinner,dinosaur,direction,director,discover,discuss
Data discussion,disease,do,doctor,dog,door,down,draw,dream,drive
Data drop,drug,during,each,early,east,easy,eat,economic,economy
Data edge,education,effect,effort,eight,either,election,elephant,else,employee
Data end,energy,enjoy,enough,enter,entire,environment,especially,establish,even
Data evening,event,ever,every,everybody,everyone,everything,evidence,exactly,example
Data executive,exist,expect,experience,expert,explain,eye,face,fact,factor
Data fail,fall,family,far,fast,father,fear,federal,feel,feeling
Data few,field,fight,figure,fill,film,final,finally,financial,find
Data fine,finger,finish,fire,firm,first,fish,five,floor,fly
Data focus,follow,food,foot,for,force,foreign,forget,form,former
Data forward,four,free,friend,from,front,full,fund,future,game
Data garden,gas,general,generation,get,girl,give,glass,go,goal
Data good,government,great,green,ground,group,grow,growth,guess,gun
Data guy,hair,half,hand,hang,happen,happy,hard,have,he
Data head,health,hear,heart,heat,heavy,help,her,here,herself
Data high,him,himself,his,history,hit,hold,home,hope,horse
Data hospital,hot,hotel,hour,house,how,however,huge,human,hundred
Data husband,idea,identify,if,image,imagine,impact,important,improve,in
Data include,including,increase,indeed,indicate,individual,industry,information,inside,instead
Data institution,interest,interesting,interview,into,investment,involve,issue,it,item
Data its,itself,job,join,just,keep,key,kid,kill,kind
Data kitchen,know,knowledge,land,language,large,last,late,later,laugh
Data law,lawyer,lay,lead,leader,learn,least,leave,left,leg
Data legal,less,let,letter,level,lie,life,light,like,likely
Data line,list,listen,little,live,local,long,look,lose,loss
Data lot,love,low,machine,magazine,main,maintain,major,majority,make
Data man,manage,management,manager,many,market,marriage,material,matter,may
Data maybe,me,mean,measure,meat,media,medical,meet,meeting,member
Data memory,mention,message,method,middle,might,military,million,mind,minute
Data miss,mission,model,modern,moment,money,month,more,morning,most
Data mother,mouth,move,movement,movie,much,music,must,my,myself
Data name,nation,national,natural,nature,near,nearly,necessary,need,network
Data never,new,news,newspaper,next,nice,night,no,none,nor
Data north,not,note,nothing,notice,now,number,occur,of,off
Data offer,office,officer,official,often,oh,oil,ok,old,on
Data once,one,only,onto,open,operation,opportunity,option,or,order
Data organization,other,others,our,out,outside,over,own,owner,page
Data pain,painting,paper,parent,part,participant,particular,particularly,partner,party
Data pass,past,patient,pattern,pay,peace,people,per,perform,performance
Data perhaps,period,person,personal,phone,physical,pick,picture,piece,pig
Data place,plan,plant,play,player,plot,point,police,policy,political
Data politics,poor,popular,population,position,positive,possible,power,practice,prepare
Data present,president,pressure,pretty,prevent,price,private,probably,problem,process
Data produce,product,production,professional,professor,program,project,property,protect,prove
Data provide,public,pull,purpose,push,put,quality,question,quickly,quite
Data race,radio,raise,range,rate,rather,reach,read,ready,real
Data reality,realize,really,reason,receive,recent,recently,recognize,record,red
Data reduce,reflect,region,relate,relationship,religious,remain,remember,remove,report
Data represent,require,research,resource,respond,response,rest,result,return,reveal
Data rich,right,rise,risk,road,rock,role,room,rule,run
Data safe,same,save,say,scene,school,science,scientist,score,sea
Data season,seat,second,section,security,see,seek,seem,sell,send
Data senior,sense,series,serious,serve,service,set,seven,several,sex
Data sexual,shake,share,she,shoot,short,shot,should,shoulder,show
Data side,sign,significant,similar,simple,simply,since,sing,single,sister
Data sit,site,situation,six,size,skill,skin,small,smile,so
Data social,society,soldier,some,somebody,someone,something,sometimes,son,song
Data soon,sort,sound,source,south,southern,space,speak,special,specific
Data speech,spend,sport,spring,staff,stage,stand,standard,star,start
Data state,statement,station,stay,step,still,stock,stop,store,story
Data strategy,street,strong,structure,student,study,stuff,style,subject,success
Data successful,such,suddenly,suffer,suggest,summer,support,sure,surface,system
Data table,take,talk,task,tax,teach,teacher,team,technology,telephone
Data television,tell,ten,tend,term,test,than,thank,that,the
Data their,them,themselves,then,theory,there,these,they,thing,think
Data third,this,those,though,thought,thousand,threat,three,through,throughout
Data throw,thus,time,to,today,together,tonight,too,top,total
Data tough,toward,town,trade,traditional,training,travel,treat,treatment,tree
Data trial,trip,trouble,truck,true,truth,try,turn,two,type
Data under,understand,unit,until,up,upon,us,use,usually,value
Data various,very,victim,view,violence,visit,voice,vote,wait,walk
Data wall,want,war,watch,water,way,we,weapon,wear,week
Data weight,well,west,western,what,whatever,when,where,whether,which
Data while,white,who,whole,whom,whose,why,wide,wife,will
Data win,wind,window,wish,with,within,without,woman,wonder,word
Data work,worker,world,worry,would,write,writer,wrong,xylophone,yard
Data yeah,year,yes,yet,you,young,your,yourself,zebra,zoo,monotonous
|
|
|
| Race Car |
|
Posted by: SierraKen - 08-14-2024, 04:18 AM - Forum: SierraKen
- No Replies
|
|
This was one of my early QB64 games from 2019. I wanted to simulate a handheld electronics toy I had as a kid and I think I did a pretty good job. 
Tonight I updated this game to not only use the arrow keys but also the letters a, d, w, and x, to steer and speed up and slow down. The track is only a straightaway but it can be fun with the obstacles of other cars and oil slicks. It makes the file: toptenracers.txt for the top ten scores. To erase them, just delete the file and it will start over.
Code: (Select All)
'I've wanted to make this game since I was a kid when I owned a little hand-held race car game where you steered the little wheel"
'to avoid the other cars. That toy broke when I was a kid so I've wanted a similar one on the computer.
'Enjoy!
'
'Version 3 was made on July 16, 2019.
'Updated on August 13, 2024 for added keys and sound.
'Freeware only.
'
'Thanks to the QB64.org forum guys for the help!
_Title "RACE CAR"
_ScreenMove _Middle
Screen _NewImage(640, 480, 32)
begin:
Cls
Print " R A C E C A R"
Print
Print " V. 3"
Print: Print
Print " By SierraKen"
Print: Print
Print " Use your arrow keys or 'a' and 'd' to steer your car"
Print " around the other cars and go as far as you"
Print " can without hitting them, as well as the round"
Print " oil slicks. You get an extra car every 3000 points."
Print
Print " Press the up and down arrow keys or 'w' and 'x' to move"
Print " faster or slower and also to stop turning."
Print
Print " You get 5 cars."
Print " Every time you hit a street edge, you"
Print " lose 200 points."
Print " Every time you hit an oil slick your car"
Print " moves a random direction."
Print " Every time you hit another car you lose a car."
Print
Print " To reset the Top Ten score sheet, delete the file"
Print " named toptenracers.txt and play a full game."
Print
Input " Press Enter to play!", a$
Cls
Dim name$(50), score(50), nm$(50), scc(50)
Line (0, 240)-(640, 240), _RGB32(127, 255, 127)
tim = .02
t2 = 0
rc = 5
x = 320
y = 250: yy = 450
cx = 350: cy = 420
u = 1
sc = 0
one = 0
collision = 0
o = 0
other = 0
sct = 0
go:
_Delay tim
_Limit 200
a$ = InKey$
If a$ = Chr$(27) Then End
If a$ = Chr$(0) + Chr$(72) Or a$ = "w" Or a$ = "W" Then
u = 1
d = 0
r = 0
L = 0
tim = tim - .002
If tim < .008 Then tim = .008
End If
If a$ = Chr$(0) + Chr$(80) Or a$ = "x" Or a$ = "X" Then
u = 0
d = 1
r = 0
L = 0
tim = tim + .002
If tim > .02 Then tim = .02
End If
If a$ = Chr$(0) + Chr$(77) Or a$ = "d" Or a$ = "D" Then r = 1: L = 0
If a$ = Chr$(0) + Chr$(75) Or a$ = "a" Or a$ = "A" Then L = 1: r = 0
If u = 1 Then
GoSub linesmoving:
End If
If d = 1 Then
GoSub linesmoving:
End If
If r = 1 Then
ocx = cx: ocy = cy
GoSub erasecar:
cx = cx + 2
'Check street edge.
If cx > 570 Then
cx = 550
Sound 800, .25
sc = sc - 200
End If
GoSub drawcar:
End If
If L = 1 Then
ocx = cx: ocy = cy
GoSub erasecar:
cx = cx - 2
'Check street edge.
If cx < 40 Then
cx = 60
Sound 800, .25
sc = sc - 200
End If
GoSub drawcar:
End If
'Street Sides
Line (320, 240)-(0, 480), _RGB32(127, 255, 127)
Line (320, 240)-(640, 480), _RGB32(127, 255, 127)
GoSub drawcar:
'Other Car
Randomize Timer
oc = Int(Rnd * 1000) + 1
If oc > 980 And occ = 0 Then
occ = 1
Randomize Timer
oxx2 = (Rnd * 16) - 8
oyyy = 250
oxxx = 305
End If
If occ = 1 Then
oldoyyy = oyyy
oldoxxx = oxxx
oyyy = oyyy + 5
oxxx = oxxx + oxx2
Line (oldoxxx, oldoyyy)-(oldoxxx + 30, oldoyyy + 30), _RGB32(0, 0, 0), BF
Circle (oldoxxx, oldoyyy + 5), 5, _RGB32(0, 0, 0)
Circle (oldoxxx + 30, oldoyyy + 5), 5, _RGB32(0, 0, 0)
Circle (oldoxxx + 30, oldoyyy + 25), 5, _RGB32(0, 0, 0)
Circle (oldoxxx, oldoyyy + 25), 5, _RGB32(0, 0, 0)
Line (oxxx, oyyy)-(oxxx + 30, oyyy + 30), _RGB32(127, 249, 127), BF
Circle (oxxx, oyyy + 5), 5, _RGB32(127, 227, 127)
Circle (oxxx + 30, oyyy + 5), 5, _RGB32(127, 227, 127)
Circle (oxxx + 30, oyyy + 25), 5, _RGB32(127, 227, 127)
Circle (oxxx, oyyy + 25), 5, _RGB32(127, 227, 127)
If oyyy > 640 Then
occ = 0
Line (oxxx, oyyy)-(oxxx + 20, oyyy + 20), _RGB32(0, 0, 0), BF
Circle (oldoxxx, oldoyyy + 5), 5, _RGB32(0, 0, 0)
Circle (oldoxxx + 30, oldoyyy + 5), 5, _RGB32(0, 0, 0)
Circle (oldoxxx + 30, oldoyyy + 25), 5, _RGB32(0, 0, 0)
Circle (oldoxxx, oldoyyy + 25), 5, _RGB32(0, 0, 0)
If collision = 0 Then
other = other + 1
Locate 1, 20: Print "Passed Up Cars:"; other
End If
oyyy = 250
oxxx = 320
collision = 0
GoTo nex:
End If
End If
nex:
'Detect Collision
If cx > oxxx - 10 And cx < oxxx + 40 And cy > oyyy - 5 And cy < oyyy + 35 Then
Sound 800, .25
If collision = 0 Then rc = rc - 1
If rc = 0 Then GoTo done:
collision = 1
End If
'Oil Slick
Randomize Timer
oil = Int(Rnd * 100) + 1
If oil > 98 And oil2 = 0 Then
oil2 = 1
Randomize Timer
oilx2 = (Rnd * 12) - 6
oilyyy = 250
oilxxx = 305
End If
If oil2 = 1 Then
oldoilyyy = oilyyy
oldoilxxx = oilxxx
oilyyy = oilyyy + 5
oilxxx = oilxxx + oilx2
o = o + 1
If o = 1 Then GoTo oil:
For ooo = 1 To 25 Step 5
Circle (oldoilxxx, oldoilyyy + 25), ooo, _RGB32(0, 0, 0)
Next ooo
oil:
For ooo = 1 To 25 Step 5
Circle (oilxxx, oilyyy + 25), ooo, _RGB32(127, 227, 127)
Next ooo
If oilyyy > 640 Then
For ooo = 1 To 25 Step 5
Circle (oldoilxxx, oldoilyyy + 25), ooo, _RGB32(0, 0, 0)
Next ooo
oilyyy = 250
oilxxx = 330
o = 0
oil2 = 0
GoTo nex2:
End If
End If
nex2:
'Detect Collision With Oil Slick
If cx > oilxxx - 5 And cx < oilxxx + 35 And cy > oilyyy - 5 And cy < oilyyy + 35 Then
Sound 800, .25
Randomize Timer
skid = Int(Rnd * 100) + 1
If skid > 50 Then r = 1: L = 0
If skid <= 50 Then L = 1: r = 0
tim = .02
Sound 900, .25
End If
'Buildings
Randomize Timer
b = Int(Rnd * 100) + 1
If b > 80 And b2 = 0 Then
b2 = 1
Randomize Timer
bx2 = (Rnd * 4) - 2
If bx2 > 0 Then
Randomize Timer
bxxx = Int(Rnd * 200) + 370
bx3 = 10
End If
If bx2 <= 0 Then
Randomize Timer
bxxx = Int(Rnd * 150) + 10
bx3 = -10
End If
Randomize Timer
bsz = Int(Rnd * 30) + 10
Randomize Timer
bsz2 = Int(Rnd * 30) + 10
byyy = 255
End If
If b2 = 1 Then
oldbyyy = byyy
oldbxxx = bxxx
byyy = byyy + 5
bxxx = bxxx + bx3
ob = ob + 1
If ob = 1 Then GoTo building:
'old erase
Line (oldbxxx, oldbyyy)-(oldbxxx + bsz, oldbyyy + bsz2), _RGB32(0, 0, 0), B
building:
'new
Line (bxxx, byyy)-(bxxx + bsz, byyy + bsz2), _RGB32(127, 227, 127), B
If byyy > 640 Then
'old erase again
Line (oldbxxx, oldbyyy)-(oldbxxx + bsz, oldbyyy + bsz2), _RGB32(0, 0, 0), B
byyy = 250
ob = 0
b2 = 0
GoTo nex3:
End If
End If
nex3:
Randomize Timer
bb = Int(Rnd * 100) + 1
If bb > 80 And bb2 = 0 Then
bb2 = 1
Randomize Timer
bbx2 = (Rnd * 4) - 2
If bbx2 > 0 Then
Randomize Timer
bbxxx = Int(Rnd * 200) + 350
bbx3 = 10
End If
If bbx2 <= 0 Then
Randomize Timer
bbxxx = Int(Rnd * 150) + 10
bbx3 = -10
End If
Randomize Timer
bbsz = Int(Rnd * 30) + 10
Randomize Timer
bbsz2 = Int(Rnd * 30) + 10
bbyyy = 255
End If
If bb2 = 1 Then
oldbbyyy = bbyyy
oldbbxxx = bbxxx
bbyyy = bbyyy + 5
bbxxx = bbxxx + bbx3
obb = obb + 1
If obb = 1 Then GoTo building:
'old erase
Line (oldbbxxx, oldbbyyy)-(oldbbxxx + bbsz, oldbbyyy + bbsz2), _RGB32(0, 0, 0), B
building2:
'new
Line (bbxxx, bbyyy)-(bbxxx + bbsz, bbyyy + bbsz2), _RGB32(127, 227, 127), B
If bbyyy > 640 Then
'old erase again
Line (oldbbxxx, oldbbyyy)-(oldbbxxx + bbsz, oldbbyyy + bbsz2), _RGB32(0, 0, 0), B
bbyyy = 250
obb = 0
bb2 = 0
GoTo nex4:
End If
End If
nex4:
'Extra Car
If sc / 3000 = Int(sc / 3000) And sc / 3000 <> 0 Then
rc = rc + 1
Locate 15, 35: Print "EXTRA CAR!"
Sound 400, 2
Sound 400, 2
Sound 400, 2
t2 = 1
End If
If t2 > 500 Then
Locate 15, 35: Print " "
t2 = 0
End If
If t2 > 0 Then t2 = t2 + 1
'Speed Indicator
Locate 3, 1: Print "Speed: "; Int(1.5 / tim)
Locate 3, 13: Print "mph"
'Score
If sc < 1 Then sc = 1
Locate 1, 1: Print "Score: "; sc
sc = sc + 1
'Cars You Have Leftover
Locate 1, 73: Print "Cars:"; rc
Sound 150, .2
GoTo go:
linesmoving:
oy = y
y = y + 5
If y > 640 Then y = 250
If y < 240 Then y = 640
Line (x, oy)-(x, oy + 10), _RGB32(0, 0, 0)
Line (x, y)-(x, y + 10), _RGB32(127, 255, 127)
oyy = yy
yy = yy + 5
If yy > 640 Then yy = 250
If yy < 240 Then yy = 640
Line (x, oyy)-(x, oyy + 10), _RGB32(0, 0, 0)
Line (x, yy)-(x, yy + 10), _RGB32(127, 255, 127)
Return
drawcar:
'Car
Line (cx, cy)-(cx + 30, cy + 30), _RGB32(127, 227, 127), BF
Line (cx + 5, cy - 5)-(cx + 25, cy), _RGB32(127, 227, 127), BF
Circle (cx, cy + 5), 5, _RGB32(127, 227, 127)
Circle (cx + 30, cy + 5), 5, _RGB32(127, 227, 127)
Circle (cx + 30, cy + 25), 5, _RGB32(127, 227, 127)
Circle (cx, cy + 25), 5, _RGB32(127, 227, 127)
Return
erasecar:
Line (ocx, ocy)-(ocx + 30, ocy + 30), _RGB32(0, 0, 0), BF
Line (ocx + 5, ocy - 5)-(ocx + 25, ocy), _RGB32(0, 0, 0), BF
Circle (ocx, ocy + 5), 5, _RGB32(0, 0, 0)
Circle (ocx + 30, ocy + 5), 5, _RGB32(0, 0, 0)
Circle (ocx + 30, ocy + 25), 5, _RGB32(0, 0, 0)
Circle (ocx, ocy + 25), 5, _RGB32(0, 0, 0)
Return
done:
Locate 10, 30: Print "G A M E O V E R"
Locate 1, 1: Print "Score: "; sc
scc = sc * other
Locate 14, 1: Print sc; " x "; other; " Passed Up Cars = Total Score: "; scc
Locate 1, 73: Print "Cars:"; rc
Locate 20, 1: Input "Press Enter to see Top Ten list.", topten$
Cls
'Top Ten Racers
If _FileExists("toptenracers.txt") Then
Else
Open "toptenracers.txt" For Output As #1
Restore toptendata
Do
Read toptenname$, toptenscore!
If toptenname$ = "EOF" Then Exit Do
Print #1, toptenname$
Print #1, toptenscore!
Loop
Close #1
End If
Open "toptenracers.txt" For Input As #1
For n = 1 To 10
If EOF(1) Then GoTo nex5:
Input #1, name$(n)
Input #1, score(n)
If scc > score(n) And sct = 0 Then
nn = n
Print "You have made the Top Ten!"
typename:
Input "Type your name here (25 letters and spaces maximum.):", nm$(nn)
If Len(nm$(nn)) > 25 Then
Print "Name too long, try again."
GoTo typename:
End If
sccc(nn) = scc
sct = 1
End If
If n = 10 And sct = 0 Then Close #1: GoTo nex7:
Next n
Close #1
nex5:
Close #1
Open "toptenracers.txt" For Output As #1
For n = 1 To nn
If n <> nn Then Print #1, name$(n): Print #1, score(n)
If n = nn Then
Print #1, nm$(n)
Print #1, sccc(n)
End If
Next n
nex6:
For n = nn To 10
Print #1, name$(n): Print #1, score(n)
Next n
Close #1
nex7:
Cls
Print: Print: Print
Print " T O P T E N R A C E R S"
Print: Print: Print
Open "toptenracers.txt" For Input As #1
For n = 1 To 10
If EOF(1) Then GoTo nex8:
Input #1, name$(n)
Input #1, score(n)
Print " "; n; ". "; name$(n); score(n)
Next n
nex8:
Close #1
For n = 1 To 10
nm$(n) = ""
score(n) = 0
name$(n) = ""
sccc(n) = 0
Next n
Locate 23, 1
Input "Would you like to play again? (Yes/No)", ag$
If ag$ = "y" Or ag$ = "Y" Or ag$ = "YES" Or ag$ = "yes" Or ag$ = "Yes" Or ag$ = "yES" Or ag$ = "yeS" Then GoTo begin:
End
toptendata:
Data Electro Joe,500000
Data Flying Felice,450000
Data Speedy Spencer,400000
Data Super Sam,350000
Data Ralph Runner,300000
Data Suzy Swift,275000
Data Quick Ken,250000
Data Tiger Tessa,225000
Data Brisk Bob,200000
Data Jalopy Jay,175000
Data EOF,0
|
|
|
|
| Numbers To Roman Numerals |
|
Posted by: SierraKen - 08-14-2024, 01:25 AM - Forum: SierraKen
- No Replies
|
|
This can use numbers from 1 to 3999. It stops there because 4000 and above use Roman Numerals with lines on top of the letters, which are hard to make with QB64.
Thanks to ChatGPT for helping me out on this one. I re-organized it a bit, etc.
Code: (Select All)
'Thanks to ChatGPT for a little help figuring this out. I fixed the DIM numbers and removed the Function and made the code simpler.
'By SierraKen on Aug. 12, 2024
'I been wanting to make this since the 1990's! LOL
Dim values(13) As Integer
Dim symbols(13) As String
_Title "Numbers To Roman Numerals Converter"
Cls
start:
Input "Enter a number (1-3999): ", number
If number < 1 Or number > 3999 Then
Print "Number out of range. Please enter a number between 1 and 3999."
Else
values(1) = 1000: symbols(1) = "M"
values(2) = 900: symbols(2) = "CM"
values(3) = 500: symbols(3) = "D"
values(4) = 400: symbols(4) = "CD"
values(5) = 100: symbols(5) = "C"
values(6) = 90: symbols(6) = "XC"
values(7) = 50: symbols(7) = "L"
values(8) = 40: symbols(8) = "XL"
values(9) = 10: symbols(9) = "X"
values(10) = 9: symbols(10) = "IX"
values(11) = 5: symbols(11) = "V"
values(12) = 4: symbols(12) = "IV"
values(13) = 1: symbols(13) = "I"
romanNum$ = ""
num = number
For i = 1 To 13
While num >= values(i)
romanNum$ = romanNum$ + symbols(i)
num = num - values(i)
Wend
Next i
Print "Roman Numeral: "; romanNum$
End If
Print: Print: Print
GoTo start:
|
|
|
|
| Tech Invaders 5 |
|
Posted by: SierraKen - 08-14-2024, 01:21 AM - Forum: SierraKen
- No Replies
|
|
This is like a very small Space Invaders / Galaga type game with some different bosses to shoot after a few levels each. Put this in its own directory because it makes a top ten text file.
Update - Aug. 30, 2024: Made the mouse pointer disappear during gameplay using _MouseHide, but you still need to use the mouse to play.
Code: (Select All)
'Tech Invaders 5 Warp Edition
'Game made on July 1, 2022
'Version 5 made on August 10, 2024.
'By SierraKen
'Freeware
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Additions: Made the game a lot faster.
'------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
_ScreenMove _Middle
begin:
_Limit 1000
Dim name$(50), nm$(50), score(50), sccc(50)
Dim x As Single, y As Single, x2 As Single, y2 As Single, x5 As Single, y5 As Single, x6 As Single, y6 As Single, x7 As Single, y7 As Single, xt As Single, yt As Single
Dim enemy As Single, e1 As Single, e2 As Single, e3 As Single, e4 As Single
Dim lives As Single, level As Single, ushoot As Single, points As Single, level2 As Single, DD As Single, start As Single, b As Single, boss As Single
Dim xx As Single, yy As Single, xx2 As Single, yy2 As Single, xx3 As Single, yy3 As Single, xx4 As Single, yy4 As Single
Dim c1 As Single, c2 As Single, c3 As Single, c4 As Single, c5 As Single, c6 As Single
Dim x3 As Single, y3 As Single, x4 As Single, y4 As Single
Dim csaucer1 As Single, csaucer2 As Single, csaucer3 As Single
Dim sz As Single, s As Single, sec As Single, mo As Single, mouth As Single, mo2 As Single, mouth2 As Single, t As Single
Dim sx As Single, sy As Single, sx2 As Single, sy2 As Single, sx3 As Single, sy3 As Single, sx4 As Single, sy4 As Single, sx5 As Single, sy5 As Single
Dim starx(1000), stary(1000)
Dim ddx(1000), ddy(1000)
Dim sz10(1000)
Dim speed(1000)
Dim cx As Integer, cy As Integer, r As Integer, c As _Unsigned Long
_Title "Tech Invaders 5 Warp Edition - by SierraKen"
Cls
Screen _NewImage(800, 600, 32)
Print: Print: Print
For tt = 79 To 34 Step -2
Locate 3, tt + 2: Print " "
Locate 3, tt: Print "T"
_Delay .03
Next tt
For ee = 79 To 36 Step -2
Locate 3, ee + 2: Print " "
Locate 3, ee: Print "E"
_Delay .03
Next ee
For cc = 79 To 38 Step -2
Locate 3, cc + 2: Print " "
Locate 3, cc: Print "C"
_Delay .03
Next cc
For hh = 79 To 40 Step -2
Locate 3, hh + 2: Print " "
Locate 3, hh: Print "H"
_Delay .03
Next hh
For II = 79 To 54 Step -2
Locate 3, II + 2: Print " "
Locate 3, II: Print "I"
_Delay .03
Next II
For NN = 79 To 56 Step -2
Locate 3, NN + 2: Print " "
Locate 3, NN: Print "N"
_Delay .03
Next NN
For VV = 79 To 58 Step -2
Locate 3, VV + 2: Print " "
Locate 3, VV: Print "V"
_Delay .03
Next VV
For AA = 79 To 60 Step -2
Locate 3, AA + 2: Print " "
Locate 3, AA: Print "A"
_Delay .03
Next AA
For DD = 79 To 62 Step -2
Locate 3, DD + 2: Print " "
Locate 3, DD: Print "D"
_Delay .03
Next DD
For EE2 = 79 To 64 Step -2
Locate 3, EE2 + 2: Print " "
Locate 3, EE2: Print "E"
_Delay .03
Next EE2
For RR = 79 To 66 Step -2
Locate 3, RR + 2: Print " "
Locate 3, RR: Print "R"
_Delay .03
Next RR
For ss = 79 To 68 Step -2
Locate 3, ss + 2: Print " "
Locate 3, ss: Print "S"
_Delay .03
Next ss
DD = 0
Print: Print: Print
Print " F I V E"
Print: Print
Print " W a r p E d i t i o n"
Print: Print: Print
Print " by SierraKen"
Print: Print: Print
Print " Use the Mouse to steer your shooter left and right."
Print " Use left Mouse Button to fire."
Print " Esc to end anytime."
Print: Print: Print
Print " Press Mouse Button To Start."
Do
If _MouseInput Then
If _MouseButton(1) Then GoTo startgame:
End If
Loop
startgame:
Cls
_MouseHide
e1 = 0
e2 = 0
e3 = 0
e4 = 0
lives = 5
points = 0
ushoot = 0
shooting = 0
level = 1
level2 = 1
start = 0
s = 0
xt = 400
yt = 560
b = 0
boss = 0
bosses = 1
sx2 = 0
sy2 = 0
tim = 4000
'Draw your shooter.
For sz = .25 To 10 Step .25
Line (xt - 10 - sz, yt + 10)-(xt - sz, yt - 10), _RGB32(0, 255, 128)
Line (xt + 10 + sz, yt + 10)-(xt + sz, yt - 10), _RGB32(0, 255, 128)
Next sz
OPENINGSOUND
Randomize Timer
'This is the start of the main loop.
go:
'Choose a random place for the enemy.
If e1 = 0 And e2 = 0 And e3 = 0 And e4 = 0 Then
xx = Int(Rnd * 200) + 100
yy = Int(Rnd * 100) + 40
xx2 = Int(Rnd * 200) + 200
yy2 = Int(Rnd * 100) + 40
xx3 = Int(Rnd * 200) + 250
yy3 = Int(Rnd * 100) + 40
xx4 = Int(Rnd * 200) + 300
yy4 = Int(Rnd * 100) + 40
End If
'Each level has its own loop so it can set a different equation and speed of the enemy.
If level = 1 Then
c1 = 128: c2 = 127: c3 = 255
csaucer1 = 0: csaucer2 = 0: csaucer3 = 0
one:
'sec is not time, it's related to the coordinate of the enemy and speed it goes related to the loop speed.
sec = sec + .02
s = (60 - sec) * 6 + 180
x = Int(Sin(s / 360 * 3.141592) * 180) + 125
y = Int(Cos(s / 25 * 3.141592) * 180) + 225
x3 = Int(Sin(s / 360 * 3.141592) * 180) + 125
y3 = Int(Cos(s / 25 * 3.141592) * 180) + 225
x4 = Int(Sin(s / 360 * 3.141592) * 180) + 125
y4 = Int(Cos(s / 25 * 3.141592) * 180) + 225
x7 = Int(Sin(s / 360 * 3.141592) * 180) + 125
y7 = Int(Cos(s / 25 * 3.141592) * 180) + 225
'GOSUB to drawing draws the enemy robot.
If e1 <> 1 Then GoSub drawing:
If e2 <> 1 Then GoSub drawing3:
If e3 <> 1 Then GoSub drawing4:
If e4 <> 1 Then GoSub drawing5:
If sec > 180 Then
sec = 0
GoTo onedone:
End If
'GOSUB's go to keyboard control and enemy shooting.
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
GoTo one:
onedone:
End If
'This level uses the spiral equation so it's a bit different than the others.
If level = 2 Then
c1 = 127: c2 = 216: c3 = 127
csaucer1 = 127: csaucer2 = 216: csaucer3 = 127
xx = 400: yy = 300
xx2 = 100: yy2 = 300
xx3 = 600: yy3 = 300
For d = 160 To 0 Step -.125
s = s + .2
x = Cos(s * 3.141592 / 180) * d
y = Sin(s * 3.151492 / 180) * d
x3 = Cos(s * 3.141592 / 180) * d
y3 = Sin(s * 3.151492 / 180) * d
x4 = Cos(s * 3.141592 / 180) * d
y4 = Sin(s * 3.151492 / 180) * d
x7 = Cos(s * 3.141592 / 180) * d
y7 = Sin(s * 3.151492 / 180) * d
If e1 <> 1 Then GoSub drawing:
If e2 <> 1 Then GoSub drawing3:
If e3 <> 1 Then GoSub drawing4:
If e4 <> 1 Then GoSub drawing5:
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
Next d
For d = 0 To 160 Step .125
s = s - .2
x = Cos(s * 3.141592 / 180) * d
y = Sin(s * 3.151492 / 180) * d
x3 = Cos(s * 3.141592 / 180) * d
y3 = Sin(s * 3.151492 / 180) * d
x4 = Cos(s * 3.141592 / 180) * d
y4 = Sin(s * 3.151492 / 180) * d
x7 = Cos(s * 3.141592 / 180) * d
y7 = Sin(s * 3.151492 / 180) * d
If e1 <> 1 Then GoSub drawing:
If e2 <> 1 Then GoSub drawing3:
If e3 <> 1 Then GoSub drawing4:
If e4 <> 1 Then GoSub drawing5:
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
Next d
End If
If level = 3 Then
c1 = 255: c2 = 0: c3 = 0
csaucer1 = 255: csaucer2 = 0: csaucer3 = 0
three:
sec = sec + .02
s = (60 - sec) * 6 + 180
x = Int(Sin(s / 360 * 3.141592) * 180) + 25
y = Int(Cos(s / 65 * 3.141592) * 180) + 225
x3 = Int(Sin(s / 360 * 3.141592) * 180) + 25
y3 = Int(Cos(s / 65 * 3.141592) * 180) + 225
x4 = Int(Sin(s / 360 * 3.141592) * 180) + 25
y4 = Int(Cos(s / 65 * 3.141592) * 180) + 225
x7 = Int(Sin(s / 360 * 3.141592) * 180) + 25
y7 = Int(Cos(s / 65 * 3.141592) * 180) + 225
If e1 <> 1 Then GoSub drawing:
If e2 <> 1 Then GoSub drawing3:
If e3 <> 1 Then GoSub drawing4:
If e4 <> 1 Then GoSub drawing5:
If sec > 60 Then
sec = 0
GoTo threedone:
End If
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
GoTo three:
threedone:
End If
If level = 4 Then
c1 = 255: c2 = 255: c3 = 127
csaucer1 = 255: csaucer2 = 255: csaucer3 = 127
four:
sec = sec + .02
s = (60 - sec) * 6 + 180
x = Int(Sin(s / 120 * 3.141592) * 180) + 25
y = Int(Cos(s / 200 * 3.141592) * 180) + 225
x3 = Int(Sin(s / 120 * 3.141592) * 180) + 75
y3 = Int(Cos(s / 200 * 3.141592) * 180) + 225
x4 = Int(Sin(s / 120 * 3.141592) * 180) + 125
y4 = Int(Cos(s / 200 * 3.141592) * 180) + 225
x7 = Int(Sin(s / 120 * 3.141592) * 180) + 325
y7 = Int(Cos(s / 200 * 3.141592) * 180) + 225
If e1 <> 1 Then GoSub drawing:
If e2 <> 1 Then GoSub drawing3:
If e3 <> 1 Then GoSub drawing4:
If e4 <> 1 Then GoSub drawing5:
If sec > 60 Then
sec = 0
GoTo fourdone:
End If
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
GoTo four:
fourdone:
End If
If level = 5 Then
c1 = 133: c2 = 28: c3 = 255
csaucer1 = 133: csaucer2 = 28: csaucer3 = 255
five:
sec = sec + .02
s = (60 - sec) * 6 + 180
x = Int(Sin(s / 45 * 3.141592) * 180) + 25
y = Int(Cos(s / 360 * 3.141592) * 180) + 225
x3 = Int(Sin(s / 45 * 3.141592) * 180) + 75
y3 = Int(Cos(s / 360 * 3.141592) * 180) + 225
x4 = Int(Sin(s / 45 * 3.141592) * 180) + 125
y4 = Int(Cos(s / 360 * 3.141592) * 180) + 225
x7 = Int(Sin(s / 45 * 3.141592) * 180) + 200
y7 = Int(Cos(s / 360 * 3.141592) * 180) + 225
If e1 <> 1 Then GoSub drawing:
If e2 <> 1 Then GoSub drawing3:
If e3 <> 1 Then GoSub drawing4:
If e4 <> 1 Then GoSub drawing5:
If sec > 60 Then
sec = 0
GoTo fivedone:
End If
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
GoTo five:
fivedone:
End If
If level = 6 Then
e1 = 0: e2 = 1: e3 = 1: e4 = 1
boss = 1
c1 = 255: c2 = 0: c3 = 0
six:
sec = sec + .02
s = (60 - sec) * 6 + 180
x = Int(Sin(s / 135 * 3.141592) * 180) + 325
y = Int(Cos(s / 33.75 * 3.141592) * 180) + 225
GoSub drawing2:
If sec > 120 Then
sec = 0
GoTo sixdone:
End If
GoSub mouse:
If tim < 0 Then GoSub shoot:
GoSub youshoot2:
GoTo six:
sixdone:
End If
If level = 7 Then bosses = bosses + 1: level = 1
GoTo go:
'GOTO goes back to the start of the main loop.
'Draws enemy ship #1.
drawing:
x2 = x + xx: y2 = y + yy
If x2 > 775 Then x2 = 775
If x2 < 25 Then x2 = 25
For t = 15 To 20 Step .25
Circle (x2, y2), t, _RGB32(csaucer1, csaucer2, csaucer3), , , .5
Next t
c1 = c1 + 1: c2 = c2 + 1: c3 = c3 + 1
If c1 > 255 Then c1 = 80
If c2 > 255 Then c2 = 80
If c3 > 255 Then c3 = 80
For t = .25 To 8 Step .25
Circle (x2, y2), t, _RGB32(c1, c2, c3), , , .5
Next t
For t = .25 To 3 Step .25
Circle (x2 - 10, y2 - 5), t, _RGB32(255, 127, 0), , , .5
Circle (x2 + 10, y2 - 5), t, _RGB32(255, 127, 0), , , .5
Circle (x2, y2 + 10), t, _RGB32(255, 127, 0), , , .5
Next t
Return
'Draws the Boss Robot.
drawing2:
x2 = x + xx: y2 = y + yy
If x2 > 775 Then x2 = 775
If x2 < 25 Then x2 = 25
If bosses > 5 Then bosses = 1
If bosses = 1 Then
If mouth2 > 1.8 Then mo2 = 1
If mouth2 < .2 Then mo2 = 0
If mo2 = 0 Then mouth2 = mouth2 + .025
If mo2 = 1 Then mouth2 = mouth2 - .025
c4 = 75: c5 = 75: c6 = 75
For t = 15 To .25 Step -.25
c4 = c4 + t / 3: c5 = c5 + t / 3: c6 = c6 + t / 3
Circle (x2, y2), t, _RGB32(c4, c5, c6)
Line (x2 - 14, y2 + t + 15)-(x2 + 14, y2 + t + 15), _RGB32(c4, c5, c6), BF
Next t
For t = .25 To 2 Step .25
Circle (x2 - 10, y2 - 5), t, _RGB32(255, 0, 0)
Circle (x2 + 10, y2 - 5), t, _RGB32(255, 0, 0)
Next t
For t = .25 To 6 Step .25
Circle (x2, y2 + 5), t, _RGB32(255, 0, 0), _Pi, 0, mouth2
Next t
End If
If bosses = 2 Then
If mouth2 > 1.8 Then mo2 = 1
If mouth2 < .2 Then mo2 = 0
If mo2 = 0 Then mouth2 = mouth2 + .025
If mo2 = 1 Then mouth2 = mouth2 - .025
c4 = 75: c5 = 75: c6 = 75
For t = 29 To .25 Step -.25
c4 = c4 + t / 4: c5 = c5 + t / 4: c6 = c6 + t / 4
Circle (x2, y2), t, _RGB32(c4, c5, c6), , , .5
Next t
For t = .25 To 2 Step .25
Circle (x2 - 10, y2 - 5), t, _RGB32(255, 0, 0)
Circle (x2 + 10, y2 - 5), t, _RGB32(255, 0, 0)
Next t
For t = .25 To 6 Step .25
Circle (x2, y2 + 5), t, _RGB32(255, 0, 0), _Pi, 0, mouth2
Next t
End If
If bosses = 3 Then
If mouth2 > 1.8 Then mo2 = 1
If mouth2 < .2 Then mo2 = 0
If mo2 = 0 Then mouth2 = mouth2 + .025
If mo2 = 1 Then mouth2 = mouth2 - .025
c4 = 188: c5 = 128: c6 = 255
Line (x2 - 29, y2 - 29)-(x2 + 29, y2 + 29), _RGB32(255, 6, 0)
Line (x2 + 29, y2 - 29)-(x2 - 29, y2 + 29), _RGB32(255, 6, 0)
For t = -15 To 15 Step 1
c4 = c4 + t: c5 = c5 + t: c6 = c6 + t
Line (x2 - 7, y2 + t)-(x2 + 7, y2 + t), _RGB32(c4, c5, c6)
Next t
For t = .25 To 2 Step .25
Circle (x2 - 10, y2 - 5), t, _RGB32(255, 0, 0)
Circle (x2 + 10, y2 - 5), t, _RGB32(255, 0, 0)
Next t
For t = .25 To 6 Step .25
Circle (x2, y2 + 5), t, _RGB32(255, 0, 0), _Pi, 0, mouth2
Next t
End If
If bosses = 4 Then
If mouth2 > 1.8 Then mo2 = 1
If mouth2 < .2 Then mo2 = 0
If mo2 = 0 Then mouth2 = mouth2 + .025
If mo2 = 1 Then mouth2 = mouth2 - .025
c4 = 228: c5 = 188: c6 = 28
Line (x2 - 29, y2 - 29)-(x2 + 29, y2 + 29), _RGB32(9, 255, 0)
Line (x2 + 29, y2 - 29)-(x2 - 29, y2 + 29), _RGB32(9, 255, 0)
Circle (x2 - 29, y2 - 29), 7, _RGB32(255, 0, 0)
Circle (x2 + 29, y2 + 29), 7, _RGB32(255, 0, 0)
Circle (x2 + 29, y2 - 29), 7, _RGB32(255, 0, 0)
Circle (x2 - 29, y2 + 29), 7, _RGB32(255, 0, 0)
For t = -15 To 15 Step 1
c4 = c4 + t: c5 = c5 + t: c6 = c6 + t
Line (x2 - 7, y2 + t)-(x2 + 7, y2 + t), _RGB32(c4, c5, c6)
Next t
For t = .25 To 2 Step .25
Circle (x2 - 10, y2 - 5), t, _RGB32(0, 255, 0)
Circle (x2 + 10, y2 - 5), t, _RGB32(0, 255, 0)
Next t
For t = .25 To 6 Step .25
Circle (x2, y2 + 5), t, _RGB32(0, 255, 0), _Pi, 0, mouth2
Next t
End If
If bosses = 5 Then
If mouth2 > 1.8 Then mo2 = 1
If mouth2 < .2 Then mo2 = 0
If mo2 = 0 Then mouth2 = mouth2 + .025
If mo2 = 1 Then mouth2 = mouth2 - .025
c4 = 188: c5 = 128: c6 = 255
For t = 20 To .25 Step -.25
c4 = c4 + t / 4: c5 = c5 + t / 4: c6 = c6 + t / 4
Circle (x2, y2), t, _RGB32(c4, c5, c6), , , .75
Next t
For t = 20 To 25 Step .25
Circle (x2, y2), t, _RGB32(0, 0, 255), , , .75
Next t
For t = 25 To 29 Step .25
Circle (x2, y2), t, _RGB32(255, 0, 0), , , .75
Next t
For t = .25 To 2 Step .25
Circle (x2 - 10, y2 - 5), t, _RGB32(255, 0, 0)
Circle (x2 + 10, y2 - 5), t, _RGB32(255, 0, 0)
Next t
For t = .25 To 6 Step .25
Circle (x2, y2 + 5), t, _RGB32(255, 0, 0), _Pi, 0, mouth2
Next t
End If
Return
'Draws enemy ship #2.
drawing3:
x5 = x3 + xx2: y5 = y3 + yy2
If x5 > 775 Then x5 = 775
If x5 < 25 Then x5 = 25
For t = 15 To 20 Step .25
Circle (x5, y5), t, _RGB32(csaucer1, csaucer2, csaucer3), , , .5
Next t
For t = .25 To 8 Step .25
Circle (x5, y5), t, _RGB32(c1, c2, c3), , , .5
Next t
For t = .25 To 3 Step .25
Circle (x5 - 10, y5 - 5), t, _RGB32(255, 127, 0), , , .5
Circle (x5 + 10, y5 - 5), t, _RGB32(255, 127, 0), , , .5
Circle (x5, y5 + 10), t, _RGB32(255, 127, 0), , , .5
Next t
Return
'Draws enemy face.
drawing4:
x6 = x4 + xx3: y6 = y4 + yy3
If x6 > 775 Then x6 = 775
If x6 < 25 Then x6 = 25
If mouth > 1.8 Then mo = 1
If mouth < .2 Then mo = 0
If mo = 0 Then mouth = mouth + .025
If mo = 1 Then mouth = mouth - .025
For t = 15 To 20 Step .25
Circle (x6, y6), t, _RGB32(csaucer1, csaucer2, csaucer3), , , .5
Next t
For t = .25 To 15 Step .25
Circle (x6, y6), t, _RGB32(c1, c2, c3)
Next t
For t = .25 To 3 Step .25
Circle (x6 - 10, y6 - 5), t, _RGB32(0, 255, 255)
Circle (x6 + 10, y6 - 5), t, _RGB32(0, 255, 255)
Next t
For t = .25 To 6 Step .25
Circle (x6, y6 + 5), t, _RGB32(0, 255, 255), _Pi, 0, mouth
Next t
Return
'Draws enemy ship #3.
drawing5:
x7 = x3 + xx4: y7 = y3 + yy4
If x7 > 775 Then x7 = 775
If x7 < 25 Then x7 = 25
For t = 15 To 20 Step .25
Circle (x7, y7), t, _RGB32(csaucer1, csaucer2, csaucer3), , , .5
Next t
For t = .25 To 8 Step .25
Circle (x7, y7), t, _RGB32(c1, c2, c3), , , .5
Next t
For t = .25 To 3 Step .25
Circle (x7 - 10, y7 - 5), t, _RGB32(255, 127, 0), , , .5
Circle (x7 + 10, y7 - 5), t, _RGB32(255, 127, 0), , , .5
Circle (x7, y7 + 10), t, _RGB32(255, 127, 0), , , .5
Next t
Return
'Mouse control for your movement and shooting.
mouse:
_Limit 200
If level = 6 And b > 0 Then
Locate 3, 3: Print "BOSS ROBOT:"
Line (150, 30)-(bx + 150, 50), _RGB32(227, 0, 0), BF
End If
Do While _MouseInput
xt = _MouseX
If _MouseButton(1) Then GoSub youshoot:
a$ = InKey$
If a$ = Chr$(27) Then End
Loop
For sz = .25 To 10 Step .25
Line (xt - 10 - sz, yt + 10)-(xt - sz, yt - 10), _RGB32(0, 255, 128)
Line (xt + 10 + sz, yt + 10)-(xt + sz, yt - 10), _RGB32(0, 255, 128)
Next sz
If xt > 780 Then xt = 780
If xt < 0 Then xt = 0
'Background Starfield
sp = .0005
tim = tim - 25
stars = Int(Rnd * 100) + 1
If stars > 15 Then
s2 = s2 + 1
If s2 > 950 Then s2 = 1
'Set starting position.
startx = Rnd * 400
starty = Rnd * 300
st = Int(Rnd * 360)
x100 = (Sin(st) * startx) + 400
y100 = (Cos(st) * starty) + 300
starx(s2) = x100
stary(s2) = y100
'Set direction to move.
ddx(s2) = ((x100 - 400) / 30)
ddy(s2) = ((y100 - 300) / 30)
'Set size.
sz10(s2) = Rnd
'Set speed
speed(s2) = .1
End If
For t = 1 To 950
speed(t) = speed(t) * (1.05 + sp)
stary(t) = stary(t) + ddy(t) * speed(t)
starx(t) = starx(t) + ddx(t) * speed(t)
cx = starx(t): cy = stary(t)
r = sz10(t) + .5
c = _RGB32(255, 255, 255)
fillCircle cx, cy, r, c
'skip:
Next t
Line (0, 0)-(_Width, _Height), _RGB32(0, 0, 0, 20), BF
Return
'The start of your shot.
youshoot:
'sx2 and sy2 are your shot coordinates.
If ushoot = 0 Then
sx2 = xt
sy2 = yt - 20
ushoot = 1
Sound 400, .5
End If
Return
'The drawing and movement of your shot and if it reaches the enemy.
youshoot2:
If ushoot = 1 Then
For sz = .25 To 5 Step .25
Circle (sx2, sy2), sz, _RGB32(0, 0, 0)
Next sz
sy2 = sy2 - 3
If sy2 < 0 Then ushoot = 0: Return
For szz = .25 To 5 Step .25
Circle (sx2, sy2), szz, _RGB32(255, 0, 0)
Next szz
If sx2 > x2 - 21 And sx2 < x2 + 41 And sy2 > y2 - 11 And sy2 < y2 + 21 And e1 = 0 And boss = 0 Then
enemy = 1
ENEMYEXPLOSION sx2, sy2, x2, y2, sx, sy, x5, y5, sx3, sy3, x6, y6, x7, y7, sx4, sy4, sx5, sy5, enemy
For sz = .25 To 5 Step .25
Circle (sx2, sy2), sz, _RGB32(0, 0, 0)
Next sz
sx = 1500
GoSub redrawshooter:
points = points + 100
e1 = 1
If e1 = 1 And e2 = 1 And e3 = 1 And e4 = 1 Then
tim = 3000
level = level + 1
level2 = level2 + 1
e1 = 0: e2 = 0: e3 = 0: e4 = 0
End If
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
ushoot = 0
GoTo go:
End If
If sx2 > x5 - 21 And sx2 < x5 + 41 And sy2 > y5 - 11 And sy2 < y5 + 21 And e2 = 0 And boss = 0 Then
enemy = 2
ENEMYEXPLOSION sx2, sy2, x2, y2, sx, sy, x5, y5, sx3, sy3, x6, y6, x7, y7, sx4, sy4, sx5, sy5, enemy
For sz = .25 To 5 Step .25
Circle (sx2, sy2), sz, _RGB32(0, 0, 0)
Next sz
sx3 = 1500
GoSub redrawshooter:
points = points + 100
e2 = 1
If e1 = 1 And e2 = 1 And e3 = 1 And e4 = 1 Then
tim = 3000
level = level + 1
level2 = level2 + 1
e1 = 0: e2 = 0: e3 = 0: e4 = 0
End If
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
ushoot = 0
GoTo go:
End If
If sx2 > x6 - 21 And sx2 < x6 + 41 And sy2 > y6 - 11 And sy2 < y6 + 21 And e3 = 0 And boss = 0 Then
enemy = 3
ENEMYEXPLOSION sx2, sy2, x2, y2, sx, sy, x5, y5, sx3, sy3, x6, y6, x7, y7, sx4, sy4, sx5, sy5, enemy
For sz = .25 To 5 Step .25
Circle (sx2, sy2), sz, _RGB32(0, 0, 0)
Next sz
sx4 = 1500
GoSub redrawshooter:
points = points + 100
e3 = 1
If e1 = 1 And e2 = 1 And e3 = 1 And e4 = 1 Then
level = level + 1
level2 = level2 + 1
tim = 3000
e1 = 0: e2 = 0: e3 = 0: e4 = 0
End If
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
ushoot = 0
GoTo go:
End If
If sx2 > x7 - 21 And sx2 < x7 + 41 And sy2 > y7 - 11 And sy2 < y7 + 21 And e4 = 0 And boss = 0 Then
enemy = 5
ENEMYEXPLOSION sx2, sy2, x2, y2, sx, sy, x5, y5, sx3, sy3, x6, y6, x7, y7, sx4, sy4, sx5, sy5, enemy
For sz = .25 To 5 Step .25
Circle (sx2, sy2), sz, _RGB32(0, 0, 0)
Next sz
sx5 = 1500
GoSub redrawshooter:
points = points + 100
e4 = 1
If e1 = 1 And e2 = 1 And e3 = 1 And e4 = 1 Then
level = level + 1
level2 = level2 + 1
e1 = 0: e2 = 0: e3 = 0: e4 = 0
tim = 3000
End If
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
ushoot = 0
GoTo go:
End If
'To see if you hit the Boss.
If sx2 > x2 - 31 And sx2 < x2 + 31 And sy2 > y2 - 11 And sy2 < y2 + 21 And e1 = 0 And boss = 1 Then
b = b + 1
BB = 10 - b
If bx = 0 Then GoTo bxx:
bxx:
bx = BB * 10
If bx < 0 Then GoTo bxx2:
bxx2:
Sound 100, 1
points = points + 100
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
For sz = .25 To 5 Step .25
Circle (sx2, sy2), sz, _RGB32(0, 0, 0)
Next sz
If b > 10 Then sx = 1500: enemy = 4: ENEMYEXPLOSION sx2, sy2, x2, y2, sx, sy, x5, y5, sx3, sy3, x6, y6, x7, y7, sx4, sy4, sx5, sy5, enemy
If b < 11 Then ushoot = 0: Return
GoSub redrawshooter:
bx = 0
BB = 0
b = 0
boss = 0
points = points + 1000
level = level + 1
tim = 3000
level2 = level2 + 1
e1 = 0: e2 = 0: e3 = 0: e4 = 0
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
ushoot = 0
GoTo go:
End If
End If
Return
redrawshooter:
For sz = .25 To 10 Step .25
Line (xt - 10 - sz, yt + 10)-(xt - sz, yt - 10), _RGB32(0, 255, 128)
Line (xt + 10 + sz, yt + 10)-(xt + sz, yt - 10), _RGB32(0, 255, 128)
Next sz
Return
'The enemy's shot and if it reaches you.
shoot:
If shooting = 0 And e1 = 0 Then
GoSub checktoshoot:
sh = Int(Rnd * 10000) + 1
If sh < shh Then GoTo nexone:
'sx and sy are the first enemy shot coordinates.
sx = x2
sy = y2 + 10
shooting = 1
Sound 300, .5
End If
nexone:
If shooting2 = 0 And e2 = 0 Then
GoSub checktoshoot:
sh2 = Int(Rnd * 10000) + 1
If sh2 < shh Then GoTo nexone2:
'sx3 and sy3 are the second enemy shot coordinates.
sx3 = x5
sy3 = y5 + 10
shooting2 = 1
Sound 300, .5
End If
nexone2:
If shooting3 = 0 And e3 = 0 Then
GoSub checktoshoot:
sh3 = Int(Rnd * 10000) + 1
If sh3 < shh Then GoTo nextwo:
'sx4 and sy4 are the third enemy shot coordinates.
sx4 = x6
sy4 = y6 + 10
shooting3 = 1
Sound 300, .5
End If
nextwo:
If shooting4 = 0 And e4 = 0 Then
GoSub checktoshoot:
sh4 = Int(Rnd * 10000) + 1
If sh4 < shh Then GoTo nexone3:
'sx5 and sy5 are the fourth enemy shot coordinates.
sx5 = x7
sy5 = y7 + 10
shooting4 = 1
Sound 300, .5
End If
nexone3:
'To see if first enemy hit you.
If shooting = 1 And e1 = 0 Then
For sz2 = .25 To 5 Step .25
Circle (sx, sy), sz2, _RGB32(0, 0, 0)
Next sz2
sy = sy + 3
If sy > 620 Then shooting = 0: GoTo nex4:
For szz2 = .25 To 5 Step .25
Circle (sx, sy), szz2, _RGB32(255, 0, 0)
Next szz2
If sx > xt - 20 And sx < xt + 20 And sy > yt - 1 And sy < yt + 21 Then
For sz3 = .25 To 5 Step .25
Circle (sx, sy), sz3, _RGB32(0, 0, 0)
Next sz3
shooting = 0
GoSub explosion:
End If
End If
nex4:
'To see if second enemy hit you.
If shooting2 = 1 And e2 = 0 Then
For sz2 = .25 To 5 Step .25
Circle (sx3, sy3), sz2, _RGB32(0, 0, 0)
Next sz2
sy3 = sy3 + 3
If sy3 > 620 Then shooting2 = 0: GoTo nexx:
For szz2 = .25 To 5 Step .25
Circle (sx3, sy3), szz2, _RGB32(255, 0, 0)
Next szz2
If sx3 > xt - 20 And sx3 < xt + 20 And sy3 > yt - 1 And sy3 < yt + 21 Then
For sz3 = .25 To 5 Step .25
Circle (sx3, sy3), sz3, _RGB32(0, 0, 0)
Next sz3
shooting2 = 0
GoSub explosion:
End If
End If
nexx:
'To see if third enemy hit you.
If shooting3 = 1 And e3 = 0 Then
For sz2 = .25 To 5 Step .25
Circle (sx4, sy4), sz2, _RGB32(0, 0, 0)
Next sz2
sy4 = sy4 + 3
If sy4 > 620 Then shooting3 = 0: GoTo nexx2:
For szz2 = .25 To 5 Step .25
Circle (sx4, sy4), szz2, _RGB32(255, 0, 0)
Next szz2
If sx4 > xt - 20 And sx4 < xt + 20 And sy4 > yt - 1 And sy4 < yt + 21 Then
For sz3 = .25 To 5 Step .25
Circle (sx4, sy4), sz3, _RGB32(0, 0, 0)
Next sz3
shooting3 = 0
GoSub explosion:
End If
End If
nexx2:
If shooting4 = 1 And e4 = 0 And boss = 0 Then
For sz2 = .25 To 5 Step .25
Circle (sx5, sy5), sz2, _RGB32(0, 0, 0)
Next sz2
sy5 = sy5 + 3
If sy5 > 620 Then shooting4 = 0: Return
For szz2 = .25 To 5 Step .25
Circle (sx5, sy5), szz2, _RGB32(255, 0, 0)
Next szz2
If sx5 > xt - 20 And sx5 < xt + 20 And sy5 > yt - 1 And sy5 < yt + 21 Then
For sz3 = .25 To 5 Step .25
Circle (sx5, sy5), sz3, _RGB32(0, 0, 0)
Next sz3
shooting4 = 0
GoSub explosion:
End If
End If
Return
explosion:
Randomize Timer
dxx = (Rnd * 6) + -3
dyy = (Rnd * 6) + -3
dxx2 = (Rnd * 6) + -3
dyy2 = (Rnd * 6) + -3
dxx3 = (Rnd * 6) + -3
dyy3 = (Rnd * 6) + -3
dxx4 = (Rnd * 6) + -3
dyy4 = (Rnd * 6) + -3
dxx5 = (Rnd * 6) + -3
dyy5 = (Rnd * 6) + -3
dxx6 = (Rnd * 6) + -3
dyy6 = (Rnd * 6) + -3
Sound 160, .5
Sound 150, .5
Sound 140, .5
Sound 130, .5
Sound 120, .5
Sound 110, .5
Sound 100, .5
_AutoDisplay
yourexplosion:
DD = DD + 1
dxx = dxx + dxx / 4
dxx2 = dxx2 + dxx2 / 4
dxx3 = dxx3 + dxx3 / 4
dxx4 = dxx4 + dxx4 / 4
dxx5 = dxx5 + dxx5 / 4
dxx6 = dxx6 + dxx6 / 4
dyy = dyy + dyy / 4
dyy2 = dyy2 + dyy2 / 4
dyy3 = dyy3 + dyy3 / 4
dyy4 = dyy4 + dyy4 / 4
dyy5 = dyy5 + dyy5 / 4
dyy6 = dyy6 + dyy6 / 4
Line (xt + dxx, yt + dyy)-(xt + dxx + 2, yt + dyy + 2), _RGB32(255, 0, 0), BF
Line (xt + dxx2, yt + dyy2)-(xt + dxx2 + 2, yt + dyy2 + 2), _RGB32(0, 255, 0), BF
Line (xt + dxx3, yt + dyy3)-(xt + dxx3 + 2, yt + dyy3 + 2), _RGB32(255, 0, 0), BF
Line (xt + dxx4, yt + dyy4)-(xt + dxx4 + 2, yt + dyy4 + 2), _RGB32(0, 255, 0), BF
Line (xt + dxx5, yt + dyy5)-(xt + dxx5 + 2, yt + dyy5 + 2), _RGB32(255, 0, 0), BF
Line (xt + dxx6, yt + dyy6)-(xt + dxx6 + 2, yt + dyy6 + 2), _RGB32(0, 255, 0), BF
_Delay .02
If DD > 20 Then GoTo goingback
GoTo yourexplosion:
goingback:
DD = 0
Line (xt - 21, yt - 21)-(xt + 41, yt + 41), _RGB32(0, 0, 0), BF
For sz = .25 To 30 Step .5
Circle (xt, yt), sz, _RGB32(0, 0, 0)
Next sz
Line (xt - 10, yt - 15)-(xt + 10, yt), _RGB(0, 0, 0), BF
DD = 0
lives = lives - 1
lives$ = Str$(lives)
points$ = Str$(points)
level$ = Str$(level2)
_Title "Tech Invaders 5 Lives: " + lives$ + " Level: " + level$ + " Score: " + points$
Line (xt - 22, yt - 42)-(xt + 42, yt + 42), _RGB32(0, 0, 0), BF
GoSub redrawshooter:
If lives = 0 Then
Locate 20, 40: Print "G A M E O V E R"
Locate 22, 40: Print "Score: "; points
Locate 23, 40: Print "Level: "; level2
Locate 25, 40: Input "Press Enter to go to Top Ten Scores.", tt$
'Top Ten Scores
scc = points
If _FileExists("toptentech.txt") Then
Else
Open "toptentech.txt" For Output As #1
Restore originaltopten
Do
Read toptenname$, toptenscore!
If toptenname$ = "EOF" Then Exit Do
Print #1, toptenname$
Print #1, toptenscore!
Loop
Close #1
End If
Open "toptentech.txt" For Input As #1
For n = 1 To 10
Input #1, name$(n)
Input #1, score(n)
If scc > score(n) And sct = 0 Then
NN = n
Print "You have made the Top Ten!"
typename:
Input "Type your name here (25 letters and spaces maximum.):", nm$(NN)
If Len(nm$(NN)) > 25 Then
Print "Name too long, try again."
GoTo typename:
End If
sccc(NN) = scc
sct = 1
End If
If n = 10 And sct = 0 Then Close #1: GoTo nex7:
Next n
Close #1
nex5:
Close #1
Open "toptentech.txt" For Output As #1
For n = 1 To NN
If n <> NN Then Print #1, name$(n): Print #1, score(n)
If n = NN Then
Print #1, nm$(n)
Print #1, sccc(n)
End If
Next n
nex6:
For n = NN To 10
Print #1, name$(n): Print #1, score(n)
Next n
Close #1
nex7:
Cls
Print: Print: Print
Print " T O P T E N "
Print: Print: Print
Open "toptentech.txt" For Input As #1
For n = 1 To 10
If EOF(1) Then GoTo nex8:
Input #1, name$(n)
Input #1, score(n)
Print " "; n; ". "; name$(n); score(n)
Next n
nex8:
Close #1
Locate 21: Print "Play Again (Y/N)?"
Do
ag$ = InKey$
If ag$ = "y" Or ag$ = "Y" Then Clear: GoTo begin:
If ag$ = "n" Or ag$ = "N" Then End
Loop
End If
OPENINGSOUND
Return
checktoshoot:
If level2 = 1 Then shh = 9950
If level2 = 2 Then shh = 9945
If level2 = 3 Then shh = 9940
If level2 = 4 Then shh = 9935
If level2 = 5 Then shh = 9930
If level2 = 6 Then shh = 9925
If level2 > 6 Then shh = 9920
Return
originaltopten:
Data Space Ace,7000
Data Suzy Swift,6000
Data Speedy Spencer,5000
Data Super Sam,4000
Data Battery Bob,3000
Data Karen Kryptonite,2750
Data Quick Ken,2500
Data Tiger Tessa,2250
Data Arcade Joe,2000
Data How Do U Play,1750
Data EOF,0
Sub OPENINGSOUND
snd = 300
snd2 = 800
For t = 1 To 50
If snd > 800 Then snd = 300
If snd2 < 300 Then snd2 = 800
snd = snd + 20
Sound snd, .5
Next t
End Sub
Sub ENEMYEXPLOSION (sx2, sy2, x2, y2, sx, sy, x5, y5, sx3, sy3, x6, y6, x7, y7, sx4, sy4, sx5, sy5, enemy)
For sz4 = .25 To 5 Step .25
Circle (sx2, sy2), sz4, _RGB32(0, 0, 0)
Next sz4
Sound 160, .5
Sound 150, .5
Sound 140, .5
Sound 130, .5
Sound 120, .5
Sound 110, .5
Sound 100, .5
Randomize Timer
dxx = (Rnd * 6) + -3
dyy = (Rnd * 6) + -3
dxx2 = (Rnd * 6) + -3
dyy2 = (Rnd * 6) + -3
dxx3 = (Rnd * 6) + -3
dyy3 = (Rnd * 6) + -3
dxx4 = (Rnd * 6) + -3
dyy4 = (Rnd * 6) + -3
dxx5 = (Rnd * 6) + -3
dyy5 = (Rnd * 6) + -3
dxx6 = (Rnd * 6) + -3
dyy6 = (Rnd * 6) + -3
_AutoDisplay
explosion1:
dd = dd + 1
dxx = dxx + dxx / 4
dxx2 = dxx2 + dxx2 / 4
dxx3 = dxx3 + dxx3 / 4
dxx4 = dxx4 + dxx4 / 4
dxx5 = dxx5 + dxx5 / 4
dxx6 = dxx6 + dxx6 / 4
dyy = dyy + dyy / 4
dyy2 = dyy2 + dyy2 / 4
dyy3 = dyy3 + dyy3 / 4
dyy4 = dyy4 + dyy4 / 4
dyy5 = dyy5 + dyy5 / 4
dyy6 = dyy6 + dyy6 / 4
If enemy = 1 Or enemy = 4 Then
Line (x2 + dxx, y2 + dyy)-(x2 + dxx + 2, y2 + dyy + 2), _RGB32(255, 0, 0), BF
Line (x2 + dxx2, y2 + dyy2)-(x2 + dxx2 + 2, y2 + dyy2 + 2), _RGB32(0, 255, 0), BF
Line (x2 + dxx3, y2 + dyy3)-(x2 + dxx3 + 2, y2 + dyy3 + 2), _RGB32(255, 0, 0), BF
Line (x2 + dxx4, y2 + dyy4)-(x2 + dxx4 + 2, y2 + dyy4 + 2), _RGB32(0, 255, 0), BF
Line (x2 + dxx5, y2 + dyy5)-(x2 + dxx5 + 2, y2 + dyy5 + 2), _RGB32(255, 0, 0), BF
Line (x2 + dxx6, y2 + dyy6)-(x2 + dxx6 + 2, y2 + dyy6 + 2), _RGB32(0, 255, 0), BF
If dd > 20 Then GoTo goingback
GoTo explosion1:
goingback:
dd = 0
Line (x2 - 21, y2 - 21)-(x2 + 41, y2 + 41), _RGB32(0, 0, 0), BF
For sz4 = .25 To 5 Step .25
Circle (sx2, sy2), sz4, _RGB32(0, 0, 0)
Next sz4
For sz4 = .25 To 5 Step .25
Circle (sx, sy), sz4, _RGB32(0, 0, 0)
Next sz4
End If
If enemy = 2 Then
Line (x5 + dxx, y5 + dyy)-(x5 + dxx + 2, y5 + dyy + 2), _RGB32(255, 0, 0), BF
Line (x5 + dxx2, y5 + dyy2)-(x5 + dxx2 + 2, y5 + dyy2 + 2), _RGB32(0, 255, 0), BF
Line (x5 + dxx3, y5 + dyy3)-(x5 + dxx3 + 2, y5 + dyy3 + 2), _RGB32(255, 0, 0), BF
Line (x5 + dxx4, y5 + dyy4)-(x5 + dxx4 + 2, y5 + dyy4 + 2), _RGB32(0, 255, 0), BF
Line (x5 + dxx5, y5 + dyy5)-(x5 + dxx5 + 2, y5 + dyy5 + 2), _RGB32(255, 0, 0), BF
Line (x5 + dxx6, y5 + dyy6)-(x5 + dxx6 + 2, y5 + dyy6 + 2), _RGB32(0, 255, 0), BF
If dd > 20 Then GoTo goingback2:
GoTo explosion1:
goingback2:
dd = 0
Line (x5 - 21, y5 - 21)-(x5 + 41, y5 + 41), _RGB32(0, 0, 0), BF
For sz5 = .25 To 5 Step .25
Circle (sx2, sy2), sz5, _RGB32(0, 0, 0)
Next sz5
For sz5 = .25 To 5 Step .25
Circle (sx3, sy3), sz5, _RGB32(0, 0, 0)
Next sz5
End If
If enemy = 3 Then
Line (x6 + dxx, y6 + dyy)-(x6 + dxx + 2, y6 + dyy + 2), _RGB32(255, 0, 0), BF
Line (x6 + dxx2, y6 + dyy2)-(x6 + dxx2 + 2, y6 + dyy2 + 2), _RGB32(0, 255, 0), BF
Line (x6 + dxx3, y6 + dyy3)-(x6 + dxx3 + 2, y6 + dyy3 + 2), _RGB32(255, 0, 0), BF
Line (x6 + dxx4, y6 + dyy4)-(x6 + dxx4 + 2, y6 + dyy4 + 2), _RGB32(0, 255, 0), BF
Line (x6 + dxx5, y6 + dyy5)-(x6 + dxx5 + 2, y6 + dyy5 + 2), _RGB32(255, 0, 0), BF
Line (x6 + dxx6, y6 + dyy6)-(x6 + dxx6 + 2, y6 + dyy6 + 2), _RGB32(0, 255, 0), BF
If dd > 20 Then GoTo goingback3:
GoTo explosion1:
goingback3:
dd = 0
Line (x6 - 21, y6 - 21)-(x6 + 41, y6 + 41), _RGB32(0, 0, 0), BF
For sz5 = .25 To 5 Step .25
Circle (sx2, sy2), sz5, _RGB32(0, 0, 0)
Next sz5
For sz5 = .25 To 5 Step .25
Circle (sx4, sy4), sz5, _RGB32(0, 0, 0)
Next sz5
End If
If enemy = 5 Then
Line (x7 + dxx, y7 + dyy)-(x7 + dxx + 2, y7 + dyy + 2), _RGB32(255, 0, 0), BF
Line (x7 + dxx2, y7 + dyy2)-(x7 + dxx2 + 2, y7 + dyy2 + 2), _RGB32(0, 255, 0), BF
Line (x7 + dxx3, y7 + dyy3)-(x7 + dxx3 + 2, y7 + dyy3 + 2), _RGB32(255, 0, 0), BF
Line (x7 + dxx4, y7 + dyy4)-(x7 + dxx4 + 2, y7 + dyy4 + 2), _RGB32(0, 255, 0), BF
Line (x7 + dxx5, y7 + dyy5)-(x7 + dxx5 + 2, y7 + dyy5 + 2), _RGB32(255, 0, 0), BF
Line (x7 + dxx6, y7 + dyy6)-(x7 + dxx6 + 2, y7 + dyy6 + 2), _RGB32(0, 255, 0), BF
If dd > 20 Then GoTo goingback4:
GoTo explosion1:
goingback4:
dd = 0
Line (x7 - 21, y7 - 21)-(x7 + 41, y7 + 41), _RGB32(0, 0, 0), BF
For sz5 = .25 To 5 Step .25
Circle (sx2, sy2), sz5, _RGB32(0, 0, 0)
Next sz5
For sz5 = .25 To 5 Step .25
Circle (sx5, sy5), sz5, _RGB32(0, 0, 0)
Next sz5
End If
End Sub
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
|
|
|
|
| Calendar Maker |
|
Posted by: SierraKen - 08-14-2024, 12:21 AM - Forum: SierraKen
- No Replies
|
|
You can use this simple calendar maker for any month of any Gregorian year up to 9999 A.D.
You can also add some holidays or your own information to any day. Plus you can print them out and save them as .BMP pictures.
This one also asks if you want to print an entire year when you start.
Code: (Select All)
'This is my very first calendar making program!
'Thanks to the guys from the QB64 forum for the help: bplus, SMcNeill, euklides, and TempodiBasic!
'This is a freeware program like all my other programs and games, only free.
'Feel free to use this code in your own programs.
'This version has the ability to save your own month info and come back to it anytime.
'Calendar Maker 1 version made on Sept. 19, 2019.
'Calendar Maker 2 version made on Dec. 29, 2021.
'Calendar Maker 3 version made on June 13, 2022.
start:
_Title "Calendar Maker 3 - by SierraKen"
_Limit 1000
Dim newinfo$(50)
Dim dayinfo(50)
holidays = 0
dd = 0
leap = 0
m = 0
mm = 0
y = 0
yy = 0
w = 0
weekday = 0
days = 0
load = 0
Screen _NewImage(800, 600, 32)
Cls
Print: Print
Print " Monthly Calendar Maker 3"
Print: Print: Print
Print " By SierraKen"
Print
Print
Print " This program will make a calendar for the year and month you want."
Print " It will also name some U.S. holidays on their dates if you choose that."
Print " You also can add holidays or info to any day you wish with up to 12"
Print " letters, numbers, symbols, or spaces."
Print " This uses the Gregorian Calendar which became common practice in"
Print " England in 1753 and we still use it today."
Print
Print " First make a calendar, then if you want to save it as a .bmp file,"
Print " press the 'S' key and it will save it as the month and year for its name."
Print " For example, if you made a calendar for January 2022 and wish to save it,"
Print " press the 'S' key and it will save it as the picture file 1-2022.bmp"
Print " If you save the .bmp calendar, it will be put in the same directory as this program."
Print " If you wish to print your calendar on your printer, press 'P' once."
Print " Feel free to print each month as many times as you wish. They take up 1 page each."
Print " To switch to the last month use the left arrow key, to the next month the right arrow key."
Print " To make a different calendar without saving, press the Space Bar."
Print " Keyboard commands will be listed on the title bar of the window."
Print
Print " You also can print a whole year at once, without saving, with some U.S. holidays."
Print " You can draw or print something on the back of each month using a different program,"
Print " staple them together, punch a hole, and hang it on the wall. This does not include"
Print " saved month info."
Print
Print " New Feature: After you add your own month info in the beginning, it saves it"
Print " to a .txt file in the same directory and you can load that month's data anytime"
Print " by pressing L at any calendar month screen. You can only load one month at a time."
loops = 0
Print
Input " Press Enter To begin.", begin$
Cls
Print: Print: Print
Input " Would you like to print a whole year on your printer? (Y/N):", wholeyear$
If Left$(wholeyear$, 1) = "y" Or Left$(wholeyear$, 1) = "Y" Then m = 0: loops = 1
again1:
Print
Input " Type the year here (1753-9999): ", y
If y <> Int(y) Then Print "Cannot use decimals, try again.": GoTo again1:
If y < 1753 Or y > 9999 Then Print "The year can only be between 1753 and 9999, try again.": GoTo again1:
If loops = 1 Then
year = y
holidays = 1
Print " This will print 12 pages on your printer, one month each."
Print " This will not show any of your saved month information."
Print " But it will print out some U.S. holidays."
Print
Print " Press P to print the whole year on your printer."
Print " Press Esc key to go back to the beginning."
Do
ent$ = InKey$
If ent$ = "p" Or ent$ = "P" Then GoTo calculate:
If ent$ = Chr$(27) Then GoTo start:
Loop
End If
again2:
Print
Input " Type the month here (1-12): ", m
Print
If m <> Int(m) Then Print " Cannot use decimals, try again.": GoTo again2:
If m < 1 Or m > 12 Then Print " 1-12 only, try again.": GoTo again2:
Input " Do you want some U.S. holidays added (Y/N)?", hol$
If Left$(hol$, 1) = "y" Or Left$(hol$, 1) = "Y" Then holidays = 1
Print
Input " Do you want to add your own month info (Y/N)?", adding$
'It loops here 12 times when printing an entire year.--------------------------------------------------------
calculate:
info = 0
load = 0
calculate2:
monthname = 0
mn = 0
infos = 0
If loops = 1 Then m = m + 1
If m > 12 Then loops = 0: GoTo start:
dd = 0
leap = 0
w = 0
weekday = 0
days = 0
'Get the month name.
If m = 1 Then month$ = " January"
If m = 2 Then month$ = "February"
If m = 3 Then month$ = " March"
If m = 4 Then month$ = " April"
If m = 5 Then month$ = " May"
If m = 6 Then month$ = " June"
If m = 7 Then month$ = " July"
If m = 8 Then month$ = " August"
If m = 9 Then month$ = "September"
If m = 10 Then month$ = " October"
If m = 11 Then month$ = "November"
If m = 12 Then month$ = "December"
'Calculate to see if it's a Leap Year.
If m <> 2 Then GoTo nex:
If y / 400 = Int(y / 400) Then leap = 1: GoTo more:
If y / 4 = Int(y / 4) Then leap = 1
If y / 100 = Int(y / 100) Then leap = 0
'Get the number of days for each month.
more:
If leap = 1 Then days = 29
If leap = 0 Then days = 28
GoTo weekday:
nex:
If m = 1 Then days = 31
If m = 3 Then days = 31
If m = 4 Then days = 30
If m = 5 Then days = 31
If m = 6 Then days = 30
If m = 7 Then days = 31
If m = 8 Then days = 31
If m = 9 Then days = 30
If m = 10 Then days = 31
If m = 11 Then days = 30
If m = 12 Then days = 31
weekday:
'Set the month, year, and weekday variables to start with.
mm = m
yy = y
GetDay mm, dd, yy, weekday
If loops = 1 Then y = year
If Left$(adding$, 1) = "y" Or Left$(adding$, 1) = "Y" Then GoSub adding:
adding$ = ""
'This section makes the calendar graph.
make:
Screen _NewImage(800, 600, 32)
Cls
Line (0, 0)-(800, 600), _RGB32(255, 255, 255), BF
_Title "(S)ave BMP Picture, (L)oad Saved Month Info, (P)rint, Left and Right Switches Months, Space Bar Start's Over, Esc ends."
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Locate 3, 42: Print month$; " "; y
For x = 20 To 780 Step 108
Line (x, 100)-(x, 580), _RGB32(0, 0, 0)
Next x
For z = 100 To 580 Step 80
Line (16, z)-(780, z), _RGB32(0, 0, 0)
Next z
Locate 5, 8: Print "SUNDAY"
Locate 5, 21: Print "MONDAY"
Locate 5, 34: Print "TUESDAY"
Locate 5, 47: Print "WEDNESDAY"
Locate 5, 60: Print "THURSDAY"
Locate 5, 75: Print "FRIDAY"
Locate 5, 87: Print "SATURDAY"
'Finding Date of Easter
PQA = yy
GoSub PAQUES
'month = PQM, day = PQJ, year = PQA
'This section puts the right dates and holidays in the right squares for the calendar.
_Font 16
w = (weekday * 108) + 25
For weeky = 110 To 570 Step 80
For dayx = w To 692 Step 108
_Limit 1000
dd = dd + 1
GetDay mm, dd, yy, weekday
If loops = 1 Then y = year
If weekday = 1 Then GoSub coloring:
If weekday <> 1 Then Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
dd$ = Str$(dd)
_Font 8
If dd = (dayinfo(infos) And loadm = m And loady = y And load = 1) Or (dd = dayinfo(infos) And newy = y And newm = m) Then
GoSub coloring:
i = Len(newinfo$(infos))
If i < 8 Then ii = 25
If i > 7 And i < 12 Then ii = 11
If i > 11 And i < 14 Then ii = 5
If i > 13 Then ii = 2
_PrintString (dayx + ii, weeky + 20), newinfo$(infos)
infos = infos + 1
ye = 1
End If
If holidays = 0 Then GoTo skip:
If m = 1 And dd = 1 Then
GoSub coloring:
_PrintString (dayx + 15, weeky + 60), "New Years"
End If
If m = 1 And weekday = 2 And dd > 14 And dd < 22 Then
GoSub coloring:
_PrintString (dayx + 25, weeky + 60), "MLK Jr."
End If
If m = 2 And dd = 2 Then
GoSub coloring:
_PrintString (dayx + 13, weeky + 60), "Groundhog"
End If
If m = 2 And weekday = 2 And dd > 14 And dd < 22 Then
GoSub coloring:
_PrintString (dayx + 10, weeky + 60), "Presidents"
End If
If m = 2 And dd = 14 Then
GoSub coloring:
_PrintString (dayx + 10, weeky + 60), "Valentines"
End If
If m = 3 And dd = 17 Then
GoSub coloring:
_PrintString (dayx + 5, weeky + 60), "St. Patrick"
End If
If m = PQM And dd = PQJ Then
GoSub coloring:
_PrintString (dayx + 25, weeky + 60), "Easter"
End If
If m = 4 And dd > 23 And weekday = 7 Then
GoSub coloring:
_PrintString (dayx + 25, weeky + 60), "Arbor"
End If
If m = 5 And weekday = 0 And dd > 14 And dd < 22 Then
GoSub coloring:
_PrintString (dayx + 2, weeky + 60), "Armed Forces"
End If
If m = 5 And weekday = 2 And dd > 24 Then
GoSub coloring:
_PrintString (dayx + 15, weeky + 60), "Memorial"
End If
If m = 5 And weekday = 1 And dd > 7 And dd < 15 Then
GoSub coloring:
_PrintString (dayx + 2, weeky + 60), "Mother's Day"
End If
If m = 6 And weekday = 1 And dd > 14 And dd < 22 Then
GoSub coloring:
_PrintString (dayx + 2, weeky + 60), "Father's Day"
End If
If m = 6 And dd = 14 Then
GoSub coloring:
_PrintString (dayx + 35, weeky + 60), "Flag"
End If
If m = 7 And dd = 4 Then
GoSub coloring:
_PrintString (dayx + 2, weeky + 60), "Independence"
End If
If m = 9 And weekday = 2 And dd < 8 Then
GoSub coloring:
_PrintString (dayx + 27, weeky + 60), "Labor"
End If
If m = 10 And dd > 9 And dd < 16 And weekday = 2 Then
GoSub coloring:
_PrintString (dayx + 17, weeky + 60), "Columbus"
End If
If m = 10 And dd = 31 Then
GoSub coloring:
_PrintString (dayx + 15, weeky + 60), "Halloween"
End If
If m = 11 And dd = 11 Then
GoSub coloring:
_PrintString (dayx + 19, weeky + 60), "Veterans"
End If
If m = 11 And dd > 21 And dd < 29 And weekday = 5 Then
GoSub coloring:
_PrintString (dayx + 2, weeky + 60), "Thanksgiving"
End If
If m = 12 And dd = 25 Then
GoSub coloring:
_PrintString (dayx + 15, weeky + 60), "Christmas"
End If
skip:
ye = 0
_Font 16
_PrintString (dayx, weeky), dd$
_Font 8
If dd = days Then _Font 16: GoTo more2:
Next dayx
w = 25
Next weeky
more2:
_Limit 100
a$ = InKey$
If a$ = "l" Or a$ = "L" Then GoTo loading:
If a$ = Chr$(27) Then Cls: Print: Print: Print "Goodbye.": End
If a$ = "s" Or a$ = "S" Then GoTo saving:
If a$ = " " Then GoTo start:
If a$ = "p" Or a$ = "P" Or loops = 1 Then
_Delay 2
'printer prep (code copied and pasted from bplus Free Calendar Program)
YMAX = _Height: XMAX = _Width
landscape& = _NewImage(YMAX, XMAX, 32)
_MapTriangle (XMAX, 0)-(0, 0)-(0, YMAX), 0 To(0, 0)-(0, XMAX)-(YMAX, XMAX), landscape&
_MapTriangle (XMAX, 0)-(XMAX, YMAX)-(0, YMAX), 0 To(0, 0)-(YMAX, 0)-(YMAX, XMAX), landscape&
_PrintImage landscape&
End If
If a$ = Chr$(0) + Chr$(77) And loops = 0 Then
m = m + 1
If m > 12 Then
m = 1
yy = yy + 1
y = y + 1
End If
If y > 9999 Then y = 1753
dd = 0
leap = 0
_Delay .1
Cls
GoTo calculate2:
End If
If a$ = Chr$(0) + Chr$(75) And loops = 0 Then
m = m - 1
If m < 1 Then
m = 12
yy = yy - 1
y = y - 1
End If
If y < 1753 Then y = 9999
dd = 0
leap = 0
_Delay .1
Cls
GoTo calculate2:
End If
If loops = 1 Then _Delay 1: Cls: GoTo calculate:
GoTo more2:
adding:
load = 0
monthsave$ = Str$(m)
yearsave$ = Str$(y)
name$ = LTrim$(monthsave$) + "-" + LTrim$(yearsave$) + ".txt"
theFileExists = _FileExists(name$)
If theFileExists = -1 Then
Print
Print " File Already Exists"
Print " Saving will delete your old"
Print " month data."
Print " Would you like to still do it?"
Print " (Y/N)."
Print " Esc or N goes back to calendar."
llloop:
_Limit 100
ag2$ = InKey$
If ag2$ = Chr$(27) Then GoTo make:
If Left$(ag2$, 1) = "n" Or Left$(ag2$, 1) = "N" Then GoTo make:
If ag2$ = "" Then GoTo llloop:
If ag2$ = "y" Or ag$ = "Y" Then
Shell _Hide "DEL " + name$
GoTo saving2:
End If
GoTo llloop:
End If
saving2:
Open name$ For Output As #1
addingbegin:
Cls
Print: Print
add:
Print
olddayinfo = dayinfo(info)
adding2:
If info > days Then Print "You have reached the maximum amount of holidays or info for this month.": Input "Press enter to create calendar.", pe$: Return
Print
Print "Your dates must go in order here."
Print "for example, you cannot put info for day 15 and then put info for day 1."
Print "They must all follow from smallest number to highest number or it will tell you to start over again."
Print "Also, you cannot change a day by doing it over again, so if you mess up, create a new month."
Print
Print info; ". ";
Input "Which day of the month for new holiday or information: ", dayinfo(info)
If dayinfo(info) > days Then Print "That day is not on this calendar, try again.": GoTo adding2:
If dayinfo(info) < 1 Then Print "You cannot type a date less than 1, try again.": GoTo adding2:
If dayinfo(info) <> Int(dayinfo(info)) Then Print "You cannot type a decimal for a date, try again.": GoTo adding2:
If dayinfo(info) < olddayinfo Then
Print
Print "You have put a date before your previous one which cannot work, start over from your first date."
For dl = 0 To 31
newinfo$(dl) = ""
dayinfo(dl) = 0
Next dl
olddayinfo = 0
info = 0
GoTo add:
End If
adding3:
day$ = Str$(dayinfo(info))
day2$ = LTrim$(day$)
Print #1, day2$
Print
Print "Type up to 12 letters, numbers, or spaces that will be put for that day."
Print
Input "->", newinfo$(info)
infoamount = Len(newinfo$(info))
If infoamount > 12 Then Print "Too long, try again.": GoTo adding3:
If infoamount < 1 Then Print "Nothing typed, try again.": GoTo adding3:
Print #1, newinfo$(info)
Print
Input "Do you want to add more (Y/N):", yn$
If Left$(yn$, 1) = "y" Or Left$(yn$, 1) = "Y" Then info = info + 1: GoTo addingbegin:
Close #1
name$ = ""
newm = m
newy = y
loady = 0
loadm = 0
Return
loading:
Cls
'Files "*.txt"
againload:
Print
Input " Which year to load: ", loady
If loady <> Int(loady) Then Print " Cannot use decimals, try again.": GoTo againload:
If loady < 1753 Or loady > 9999 Then Print " The year can only be between 1753 and 9999, try again.": GoTo againload:
againload2:
loady$ = Str$(loady)
loady$ = RTrim$(loady$)
loady$ = LTrim$(loady$)
Print: Print: Print
Print " " + "Saved Months For " + loady$: Print
Do
monthname = monthname + 1
If monthname > 12 Then GoTo askmonth:
monthn$ = Str$(monthname)
monthn$ = LTrim$(monthn$)
monthn$ = RTrim$(monthn$)
filen$ = monthn$ + "-" + loady$ + ".txt"
filen$ = LTrim$(filen$)
filen$ = RTrim$(filen$)
theFileExists = _FileExists(filen$)
If theFileExists = -1 Then
If monthname = 1 Then Print " " + Str$(monthname) + " January"
If monthname = 2 Then Print " " + Str$(monthname) + " February"
If monthname = 3 Then Print " " + Str$(monthname) + " March"
If monthname = 4 Then Print " " + Str$(monthname) + " April"
If monthname = 5 Then Print " " + Str$(monthname) + " May"
If monthname = 6 Then Print " " + Str$(monthname) + " June"
If monthname = 7 Then Print " " + Str$(monthname) + " July"
If monthname = 8 Then Print " " + Str$(monthname) + " August"
If monthname = 9 Then Print " " + Str$(monthname) + " September"
If monthname = 10 Then Print " " + Str$(monthname) + " October"
If monthname = 11 Then Print " " + Str$(monthname) + " November"
If monthname = 12 Then Print " " + Str$(monthname) + " December"
Else
mn = mn + 1
If mn > 11 Then Print: Input " No months saved for this year, press Enter to go back to calendar.", a2$: GoTo calculate2:
End If
Loop
askmonth:
Print
Input " Which month number to load: ", loadm
If loadm < 1 Or loadm > 12 Then Print " Month must be between 1 and 12, try again.": GoTo againload2:
If loadm <> Int(loadm) Then Print " Cannot use decimals, try again.": GoTo againload2:
loady$ = LTrim$(Str$(loady))
loady$ = RTrim$(loady$)
loadm$ = LTrim$(Str$(loadm))
loadm$ = RTrim$(loadm$)
name2$ = loadm$ + "-" + loady$ + ".txt"
name2$ = LTrim$(name2$)
name2$ = RTrim$(name2$)
theFileExists = _FileExists(name2$)
If theFileExists <> -1 Then
Print " This file does not exist."
Print " Would you like to (S)tart over or go back to the (C)alendar? (Press S or C): "
asking:
aa$ = InKey$
If aa$ = "s" Or aa$ = "S" Then GoTo loading:
If aa$ = "c" Or aa$ = "C" Then GoTo make:
If aa$ = Chr$(27) Then GoTo make:
GoTo asking:
End If
For t = 0 To 31
dayinfo(t) = 0
newinfo$(t) = ""
Next t
info2 = 0
Open name2$ For Input As #1
Do Until EOF(1)
Input #1, dayinfo(info2)
Input #1, newinfo$(info2)
info2 = info2 + 1
Loop
Close #1
name2$ = ""
For snd = 100 To 700 Step 100
Sound snd, 2
Next snd
Cls
y = loady
m = loadm
yy = y
mm = m
load = 1
newy = 0
newm = 0
GoTo calculate2:
'Color all Sundays and holidays
coloring:
If ye = 1 Then Return
Line (dayx - 4, weeky - 9)-(dayx + 102, weeky + 68), _RGB32(255, 255, 127), BF: Color _RGB32(0, 0, 0), _RGB32(255, 255, 127)
Return
'Find the right date for Easter.
PAQUES:
PQM = Int(PQA / 100): PQ1 = PQA - PQM * 100: PQJ = Int(((PQA / 19 - Int(PQA / 19)) + .001) * 19)
PQ2 = Int(PQM / 4): PQ3 = Int(((PQM / 4) - PQ2 + .001) * 4): PQ4 = Int((8 + PQM) / 25)
PQ5 = Int((1 + PQM - PQ4 + .001) / 3): PQ4 = (15 + 19 * PQJ + PQM - PQ2 - PQ5 + .001) / 30: PQ4 = PQ4 - Int(PQ4)
PQ4 = Int(PQ4 * 30): PQ5 = Int(PQ1 / 4): PQ6 = ((PQ1 / 4) - PQ5) * 4
PQ7 = (32 + 2 * PQ3 + 2 * PQ5 - PQ4 - PQ6 + .001) / 7: PQ7 = (PQ7 - Int(PQ7)) * 7: PQ6 = (PQJ + 11 * PQ4 + 22 * PQ7) / 451
PQ6 = Int(PQ6): PQ2 = (114 + PQ4 + PQ7 - 7 * PQ6) / 31: PQM = Int(PQ2): PQJ = Int((PQ2 - PQM + .001) * 31 + 1)
Return
'This section saves the calendar to a BMP file along with the SUB at the end of this program.
saving:
If loops = 1 Then GoTo more2:
mo$ = Str$(m)
mo$ = LTrim$(RTrim$(mo$))
year2$ = Str$(y)
year2$ = LTrim$(RTrim$(year2$))
nm$ = mo$ + "-"
nm$ = LTrim$(RTrim$(nm$))
nm$ = nm$ + year2$
nm$ = LTrim$(RTrim$(nm$))
SaveImage 0, nm$ 'saves entire program screen,"
Cls
nm2$ = nm$ + ".bmp"
nm2$ = LTrim$(RTrim$(nm2$))
Print: Print: Print
Print " Saving"
Print
Print " "; nm2$; " has been saved to your computer."
Print
Print
Input " Do you wish to go back to your calendar (Y/N)"; ag$
If Left$(ag$, 1) = "y" Or Left$(ag$, 1) = "Y" Then ag$ = "": GoTo calculate2:
Print
Print
Print " Goodbye."
End
'This section gets the right weekday.
Sub GetDay (mm, dd, yy, weekday) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then yy = yy - 1
If mm < 3 Then mm = mm + 12
century = yy Mod 100
zerocentury = yy \ 100
weekday = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
End Sub
'This section saves the .bmp picture file.
Sub SaveImage (image As Long, filename As String)
bytesperpixel& = _PixelSize(image&)
If bytesperpixel& = 0 Then Print "Text modes unsupported!": End
If bytesperpixel& = 1 Then bpp& = 8 Else bpp& = 24
x& = _Width(image&)
y& = _Height(image&)
b$ = "BM????QB64????" + MKL$(40) + MKL$(x&) + MKL$(y&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + String$(16, 0) 'partial BMP header info(???? to be filled later)
If bytesperpixel& = 1 Then
For c& = 0 To 255 ' read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
cv& = _PaletteColor(c&, image&) ' color attribute to read.
b$ = b$ + Chr$(_Blue32(cv&)) + Chr$(_Green32(cv&)) + Chr$(_Red32(cv&)) + Chr$(0) 'spacer byte
Next
End If
Mid$(b$, 11, 4) = MKL$(Len(b$)) ' image pixel data offset(BMP header)
lastsource& = _Source
_Source image&
If ((x& * 3) Mod 4) Then padder$ = String$(4 - ((x& * 3) Mod 4), 0)
For py& = y& - 1 To 0 Step -1 ' read JPG image pixel color data
r$ = ""
For px& = 0 To x& - 1
c& = Point(px&, py&) 'POINT 32 bit values are large LONG values
If bytesperpixel& = 1 Then r$ = r$ + Chr$(c&) Else r$ = r$ + Left$(MKL$(c&), 3)
Next px&
d$ = d$ + r$ + padder$
Next py&
_Source lastsource&
Mid$(b$, 35, 4) = MKL$(Len(d$)) ' image size(BMP header)
b$ = b$ + d$ ' total file data bytes to create file
Mid$(b$, 3, 4) = MKL$(Len(b$)) ' size of data file(BMP header)
If LCase$(Right$(filename$, 4)) <> ".bmp" Then ext$ = ".bmp"
f& = FreeFile
Open filename$ + ext$ For Output As #f&: Close #f& ' erases an existing file
Open filename$ + ext$ For Binary As #f&
Put #f&, , b$
Close #f&
End Sub
|
|
|
|
| Talking and Chiming Clock |
|
Posted by: SierraKen - 08-13-2024, 11:46 PM - Forum: SierraKen
- No Replies
|
|
Here is a talking and chiming clock I made. Dav posted the code for the chimes once.
Code: (Select All)
'Speaking and Chiming Analog Clock by SierraKen
'Updated on August 13, 2024.
'Thanks to Dav for the chiming frequencies.
_Title "(N)umerals With or Without, (1) Male Speak, (2) Female Speak, (Space Bar) Chimes"
Screen _NewImage(600, 600, 32)
rom = 1
Cls
tt = 23
d = 0
Do
_Limit 100
For t = 0 To 360 Step .5
x2 = (Sin(t) * 190) + 300
y2 = (Cos(t) * 190) + 300
For sz = .1 To 5 Step .1
Circle (x2, y2), sz, _RGB32(127, 255, 127)
Next sz
Next t
For t = 1 To 359
For tt = t - 2 To t + 2 Step .5
x2 = Int((Sin(tt) * 170) + 300)
y2 = Int((Cos(tt) * 170) + 300)
For sz = .1 To 5 Step .1
Circle (x2, y2), sz, _RGB32(255, 255, 255)
Next sz
Next tt
Next t
If rom = 0 Then GoTo skip:
For sc = 1 To 60
ss = (60 - sc) * 6 + 180
x4 = Int(Sin(ss / 180 * 3.141592) * 150) + 300
y4 = Int(Cos(ss / 180 * 3.141592) * 150) + 300
Circle (x4, y4), 3, _RGB32(230, 230, 230)
n2 = (60 - sc) * 6 + 180
x3 = Int(Sin(n2 / 180 * 3.141592) * 140) + 290
y3 = Int(Cos(n2 / 180 * 3.141592) * 140) + 295
Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)
If sc = 5 Then _PrintString (x3, y3), "I"
If sc = 10 Then _PrintString (x3, y3), "II"
If sc = 15 Then _PrintString (x3, y3), "III"
If sc = 20 Then _PrintString (x3, y3), "IV"
If sc = 25 Then _PrintString (x3, y3), "V"
If sc = 30 Then _PrintString (x3, y3), "VI"
If sc = 35 Then _PrintString (x3, y3), "VII"
If sc = 40 Then _PrintString (x3, y3), "VIII"
If sc = 45 Then _PrintString (x3, y3), "IX"
If sc = 50 Then _PrintString (x3, y3), "X"
If sc = 55 Then _PrintString (x3, y3), "XI"
If sc = 60 Then _PrintString (x3, y3), "XII"
Next sc
skip:
hours = Timer \ 3600
minutes = Timer \ 60 - hours * 60
seconds = (Timer - hours * 3600 - minutes * 60)
ho$ = Left$(Time$, 2): hou = Val(ho$)
min$ = Mid$(Time$, 4, 2): minu = Val(min$)
seco$ = Right$(Time$, 2): secon = Val(seco$)
pendulum tt, d
'Minutes
m = 180 - minutes * 6
xx = Int(Sin(m / 180 * 3.141592) * 120) + 300
yy = Int(Cos(m / 180 * 3.141592) * 120) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xx, yy), _RGB32(0, 255, 255)
Line (300, 304 + b)-(xx, yy), _RGB32(0, 255, 255)
Next b
'Hours
h = 360 - hours * 30 + 180
xxx = Int(Sin(h / 180 * 3.141592) * 75) + 300
yyy = Int(Cos(h / 180 * 3.141592) * 75) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xxx, yyy), _RGB32(0, 255, 0)
Line (300, 304 + b)-(xxx, yyy), _RGB32(0, 255, 0)
Next b
'Seconds
s = (60 - seconds) * 6 + 180
xxxx = Int(Sin(s / 180 * 3.141592) * 125) + 300
yyyy = Int(Cos(s / 180 * 3.141592) * 125) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xxxx, yyyy), _RGB32(255, 0, 0)
Line (300, 304 + b)-(xxxx, yyyy), _RGB32(255, 0, 0)
Next b
For sz = .1 To 10 Step .1
Circle (300, 300), sz, _RGB32(255, 255, 127)
Next sz
_Display
Line (0, 0)-(600, 600), _RGB32(0, 0, 0), BF
'Chimes
If (minu = 0 And secon = 0) Or song = 1 Then
'note frequencies
For notes = 1 To 20
If notes = 1 Then note = 311.13 'D#
If notes = 2 Then note = 246.94 'B
If notes = 3 Then note = 277.18 'C#
If notes = 4 Then note = 185.00 'F#
If notes = 5 Then note = 0
If notes = 6 Then note = 185.00 'F#
If notes = 7 Then note = 277.18 'C#
If notes = 8 Then note = 311.13 'D#
If notes = 9 Then note = 246.94 'B
If notes = 10 Then note = 0
If notes = 11 Then note = 311.13 'D#
If notes = 12 Then note = 277.18 'C3
If notes = 13 Then note = 246.94 'B
If notes = 14 Then note = 185.00 'F#
If notes = 15 Then note = 0
If notes = 16 Then note = 185.00 'F#
If notes = 17 Then note = 277.18 'C#
If notes = 18 Then note = 311.13 'D#
If notes = 19 Then note = 246.94 'B
If notes = 20 Then note = 0
Do
'queue some sound
Do While _SndRawLen < 0.5 'you may wish to adjust this
sample = Sin(ttt * note * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 1 'play for 1 second
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next notes
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
For chimes = 1 To hour2
Do
'queue some sound
Do While _SndRawLen < 0.1 'you may wish to adjust this
sample = Sin(ttt * 240 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 2 'play for 2 seconds
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next chimes
song = 0
End If
two:
a$ = InKey$
If a$ = Chr$(27) Then End
If a$ = " " Then song = 1
If a$ = "n" Or a$ = "N" Then
rom = rom + 1
If rom > 1 Then rom = 0
For sz = .1 To 180 Step .1
Circle (300, 300), sz, _RGB32(0, 0, 0)
Next sz
End If
If a$ = "1" Then speaker = 0
If a$ = "2" Then speaker = 1
If a$ = "1" Or a$ = "2" Then
hour2 = hou
If hour2 > 11 Then
ampm$ = "P M"
Else
ampm$ = "A M"
End If
If hour2 > 12 Then hour2 = hour2 - 12
hour3$ = Str$(hour2)
hour4 = Val(hour3$)
If hour4 = 0 Then hour4 = 12
hour5$ = Str$(hour4)
min2 = Val(min$)
min3$ = Str$(min2)
seco2 = Val(seco$)
seco3$ = Str$(seco2)
hour5$ = _Trim$(hour5$)
If hour5$ = "10" Then hour5$ = "ten"
If hour5$ = "11" Then hour5$ = "eleven"
If hour5$ = "12" Then hour5$ = "twelve"
If _Trim$(min3$) = "1" Then smin$ = "minute"
If _Trim$(min3$) <> "1" Then smin$ = "minutes"
If _Trim$(seco3$) = "1" Then ssec$ = "second"
If _Trim$(seco3$) <> "1" Then ssec$ = "seconds"
sentence$ = "Today's date is " + w$ + ", " + month$ + " " + dd$ + ", " + yy$ + ", and the time is " + hour5$ + ampm$ + ", " + min3$ + " " + smin$ + ", and " + seco3$ + " " + ssec$
speak sentence$, speaker, 0
End If
mm$ = Left$(Date$, 2)
dd$ = Mid$(Date$, 4, 2)
yy$ = Right$(Date$, 4)
mm = Val(mm$)
dd = Val(dd$)
yy = Val(yy$)
GetDay mm, dd, yy, weekday
If weekday = 1 Then w$ = "Sunday"
If weekday = 2 Then w$ = "Monday"
If weekday = 3 Then w$ = "Tuesday"
If weekday = 4 Then w$ = "Wednesday"
If weekday = 5 Then w$ = "Thursday"
If weekday = 6 Then w$ = "Friday"
If weekday = 7 Then w$ = "Saturday"
If mm = 1 Then month$ = "January"
If mm = 2 Then month$ = "February"
If mm = 3 Then month$ = "March"
If mm = 4 Then month$ = "April"
If mm = 5 Then month$ = "May"
If mm = 6 Then month$ = "June"
If mm = 7 Then month$ = "July"
If mm = 8 Then month$ = "August"
If mm = 9 Then month$ = "September"
If mm = 10 Then month$ = "October"
If mm = 11 Then month$ = "November"
If mm = 12 Then month$ = "December"
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
hour2$ = Str$(hour2)
Locate 2, 34: Print hour2$ + ":" + min$ + ":" + seco$
Locate 4, 27: Print w$ + ", " + month$ + " " + dd$ + ", " + yy$
Loop
End
Sub pendulum (tt, d)
If d = 0 Then tt = tt + (.26 / 2)
If d = 1 Then tt = tt - (.26 / 2)
If tt < 24.25 Then d = 0
If tt > 26 Then d = 1
theta = .3 * Cos(Timer)
x5 = (Sin(theta) * 80) + 300
y5 = (Cos(theta) * 80) + 300
For sz = -3 To 4
Line (300 + sz, 300)-(x5, y5), _RGB32(255, 255, 127)
Line (300, 300 + sz)-(x5, y5), _RGB32(255, 255, 127)
Next sz
For sz = .1 To 15 Step .1
Circle (x5, y5), sz, _RGB32(255, 255, 127)
Next sz
_Delay .06
_Display
End Sub
Sub speak (text As String, Speaker As Integer, Speed)
Dim message As String, remove$, out$
Dim As Long i, j
message = text
'some symbols and such can't be used with Powershell like this, as they're command symbols
'we need to strip them out of our text. (Like apostrophes!)
remove$ = "'" + Chr$(34) 'add to remove$ here, if more symbols need to be removed as future testing showcases problems
For j = 1 To Len(remove$)
Do
i = InStr(message, Mid$(remove$, j, 1))
If i Then message = Left$(message, i - 1) + Mid$(message, i + 1)
Loop Until i = 0
Next
out$ = "Powershell -Command " + Chr$(34)
out$ = out$ + "Add-Type -AssemblyName System.Speech; "
out$ = out$ + "$Speech = New-Object System.Speech.Synthesis.SpeechSynthesizer; "
If Speaker = 0 Then out$ = out$ + "$Speech.SelectVoice('Microsoft David Desktop'); "
If Speaker = 1 Then out$ = out$ + "$Speech.SelectVoice('Microsoft Zira Desktop'); "
If Speed Then out$ = out$ + "$Speech.Rate =" + Str$(Speed) + "; "
out$ = out$ + "$Speech.Speak('" + message + "');" + Chr$(34)
Shell _Hide out$
End Sub
'This section gets the right weekday.
Sub GetDay (mm, dd, yy, weekday) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then yy = yy - 1
If mm < 3 Then mm = mm + 12
century = yy Mod 100
zerocentury = yy \ 100
weekday = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
End Sub
|
|
|
|
| Speaking and Chiming Analog Clock |
|
Posted by: SierraKen - 08-13-2024, 10:13 PM - Forum: Programs
- No Replies
|
|
This is a fixed and updated version of a clock I made years ago. Before when it spoke "10" it actually said, "one, zero". Did similar with 11 and 12. So I fixed that today and added a digital clock up above the analog clock. Plus I fixed it when it's supposed to say "minute" not "minutes" and "second" and not "seconds". I also added the day of the week and date using the weekday code from my old Calendar making program. If any of you want that again, I can post that also. This clock speaks the date (and weekday) and the time using the Windows Powershell text-to-speech that is built into Windows. This is when we were playing with this back then. I also added the ability to hear it in either male of female voice.
Dav is the one that posted the chimes frequencies and code back then, thanks Dav!
Code: (Select All)
'Speaking and Chiming Analog Clock by SierraKen
'Updated on August 13, 2024.
'Thanks to Dav for the chiming frequencies and code.
_Title "(N)umerals With or Without, (1) Male Speak, (2) Female Speak, (Space Bar) Chimes"
Screen _NewImage(600, 600, 32)
rom = 1
Cls
tt = 23
d = 0
Do
_Limit 100
For t = 0 To 360 Step .5
x2 = (Sin(t) * 190) + 300
y2 = (Cos(t) * 190) + 300
For sz = .1 To 5 Step .1
Circle (x2, y2), sz, _RGB32(127, 255, 127)
Next sz
Next t
For t = 1 To 359
For tt = t - 2 To t + 2 Step .5
x2 = Int((Sin(tt) * 170) + 300)
y2 = Int((Cos(tt) * 170) + 300)
For sz = .1 To 5 Step .1
Circle (x2, y2), sz, _RGB32(255, 255, 255)
Next sz
Next tt
Next t
If rom = 0 Then GoTo skip:
For sc = 1 To 60
ss = (60 - sc) * 6 + 180
x4 = Int(Sin(ss / 180 * 3.141592) * 150) + 300
y4 = Int(Cos(ss / 180 * 3.141592) * 150) + 300
Circle (x4, y4), 3, _RGB32(230, 230, 230)
n2 = (60 - sc) * 6 + 180
x3 = Int(Sin(n2 / 180 * 3.141592) * 140) + 290
y3 = Int(Cos(n2 / 180 * 3.141592) * 140) + 295
Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)
If sc = 5 Then _PrintString (x3, y3), "I"
If sc = 10 Then _PrintString (x3, y3), "II"
If sc = 15 Then _PrintString (x3, y3), "III"
If sc = 20 Then _PrintString (x3, y3), "IV"
If sc = 25 Then _PrintString (x3, y3), "V"
If sc = 30 Then _PrintString (x3, y3), "VI"
If sc = 35 Then _PrintString (x3, y3), "VII"
If sc = 40 Then _PrintString (x3, y3), "VIII"
If sc = 45 Then _PrintString (x3, y3), "IX"
If sc = 50 Then _PrintString (x3, y3), "X"
If sc = 55 Then _PrintString (x3, y3), "XI"
If sc = 60 Then _PrintString (x3, y3), "XII"
Next sc
skip:
hours = Timer \ 3600
minutes = Timer \ 60 - hours * 60
seconds = (Timer - hours * 3600 - minutes * 60)
ho$ = Left$(Time$, 2): hou = Val(ho$)
min$ = Mid$(Time$, 4, 2): minu = Val(min$)
seco$ = Right$(Time$, 2): secon = Val(seco$)
pendulum tt, d
'Minutes
m = 180 - minutes * 6
xx = Int(Sin(m / 180 * 3.141592) * 120) + 300
yy = Int(Cos(m / 180 * 3.141592) * 120) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xx, yy), _RGB32(0, 255, 255)
Line (300, 304 + b)-(xx, yy), _RGB32(0, 255, 255)
Next b
'Hours
h = 360 - hours * 30 + 180
xxx = Int(Sin(h / 180 * 3.141592) * 75) + 300
yyy = Int(Cos(h / 180 * 3.141592) * 75) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xxx, yyy), _RGB32(0, 255, 0)
Line (300, 304 + b)-(xxx, yyy), _RGB32(0, 255, 0)
Next b
'Seconds
s = (60 - seconds) * 6 + 180
xxxx = Int(Sin(s / 180 * 3.141592) * 125) + 300
yyyy = Int(Cos(s / 180 * 3.141592) * 125) + 304
For b = -5 To 5 Step .1
Line (300 + b, 304)-(xxxx, yyyy), _RGB32(255, 0, 0)
Line (300, 304 + b)-(xxxx, yyyy), _RGB32(255, 0, 0)
Next b
For sz = .1 To 10 Step .1
Circle (300, 300), sz, _RGB32(255, 255, 127)
Next sz
_Display
Line (0, 0)-(600, 600), _RGB32(0, 0, 0), BF
'Chimes
If (minu = 0 And secon = 0) Or song = 1 Then
'note frequencies
For notes = 1 To 20
If notes = 1 Then note = 311.13 'D#
If notes = 2 Then note = 246.94 'B
If notes = 3 Then note = 277.18 'C#
If notes = 4 Then note = 185.00 'F#
If notes = 5 Then note = 0
If notes = 6 Then note = 185.00 'F#
If notes = 7 Then note = 277.18 'C#
If notes = 8 Then note = 311.13 'D#
If notes = 9 Then note = 246.94 'B
If notes = 10 Then note = 0
If notes = 11 Then note = 311.13 'D#
If notes = 12 Then note = 277.18 'C3
If notes = 13 Then note = 246.94 'B
If notes = 14 Then note = 185.00 'F#
If notes = 15 Then note = 0
If notes = 16 Then note = 185.00 'F#
If notes = 17 Then note = 277.18 'C#
If notes = 18 Then note = 311.13 'D#
If notes = 19 Then note = 246.94 'B
If notes = 20 Then note = 0
Do
'queue some sound
Do While _SndRawLen < 0.5 'you may wish to adjust this
sample = Sin(ttt * note * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 1 'play for 1 second
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next notes
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
For chimes = 1 To hour2
Do
'queue some sound
Do While _SndRawLen < 0.1 'you may wish to adjust this
sample = Sin(ttt * 240 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
_SndRaw sample
ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
Loop
'do other stuff, but it may interrupt sound
Loop While ttt < 2 'play for 2 seconds
Do While _SndRawLen > 0 'Finish any left over queued sound!
Loop
ttt = 0
Next chimes
song = 0
End If
two:
a$ = InKey$
If a$ = Chr$(27) Then End
If a$ = " " Then song = 1
If a$ = "n" Or a$ = "N" Then
rom = rom + 1
If rom > 1 Then rom = 0
For sz = .1 To 180 Step .1
Circle (300, 300), sz, _RGB32(0, 0, 0)
Next sz
End If
If a$ = "1" Then speaker = 0
If a$ = "2" Then speaker = 1
If a$ = "1" Or a$ = "2" Then
hour2 = hou
If hour2 > 11 Then
ampm$ = "P M"
Else
ampm$ = "A M"
End If
If hour2 > 12 Then hour2 = hour2 - 12
hour3$ = Str$(hour2)
hour4 = Val(hour3$)
If hour4 = 0 Then hour4 = 12
hour5$ = Str$(hour4)
min2 = Val(min$)
min3$ = Str$(min2)
seco2 = Val(seco$)
seco3$ = Str$(seco2)
hour5$ = _Trim$(hour5$)
If hour5$ = "10" Then hour5$ = "ten"
If hour5$ = "11" Then hour5$ = "eleven"
If hour5$ = "12" Then hour5$ = "twelve"
If _Trim$(min3$) = "1" Then smin$ = "minute"
If _Trim$(min3$) <> "1" Then smin$ = "minutes"
If _Trim$(seco3$) = "1" Then ssec$ = "second"
If _Trim$(seco3$) <> "1" Then ssec$ = "seconds"
sentence$ = "Today's date is " + w$ + ", " + month$ + " " + dd$ + ", " + yy$ + ", and the time is " + hour5$ + ampm$ + ", " + min3$ + " " + smin$ + ", and " + seco3$ + " " + ssec$
speak sentence$, speaker, 0
End If
mm$ = Left$(Date$, 2)
dd$ = Mid$(Date$, 4, 2)
yy$ = Right$(Date$, 4)
mm = Val(mm$)
dd = Val(dd$)
yy = Val(yy$)
GetDay mm, dd, yy, weekday
If weekday = 1 Then w$ = "Sunday"
If weekday = 2 Then w$ = "Monday"
If weekday = 3 Then w$ = "Tuesday"
If weekday = 4 Then w$ = "Wednesday"
If weekday = 5 Then w$ = "Thursday"
If weekday = 6 Then w$ = "Friday"
If weekday = 7 Then w$ = "Saturday"
If mm = 1 Then month$ = "January"
If mm = 2 Then month$ = "February"
If mm = 3 Then month$ = "March"
If mm = 4 Then month$ = "April"
If mm = 5 Then month$ = "May"
If mm = 6 Then month$ = "June"
If mm = 7 Then month$ = "July"
If mm = 8 Then month$ = "August"
If mm = 9 Then month$ = "September"
If mm = 10 Then month$ = "October"
If mm = 11 Then month$ = "November"
If mm = 12 Then month$ = "December"
hour2 = hou
If hour2 > 12 Then hour2 = hour2 - 12
If hour2 = 0 Then hour2 = 12
hour2$ = Str$(hour2)
Locate 2, 34: Print hour2$ + ":" + min$ + ":" + seco$
Locate 4, 27: Print w$ + ", " + month$ + " " + dd$ + ", " + yy$
Loop
End
Sub pendulum (tt, d)
If d = 0 Then tt = tt + (.26 / 2)
If d = 1 Then tt = tt - (.26 / 2)
If tt < 24.25 Then d = 0
If tt > 26 Then d = 1
theta = .3 * Cos(Timer)
x5 = (Sin(theta) * 80) + 300
y5 = (Cos(theta) * 80) + 300
For sz = -3 To 4
Line (300 + sz, 300)-(x5, y5), _RGB32(255, 255, 127)
Line (300, 300 + sz)-(x5, y5), _RGB32(255, 255, 127)
Next sz
For sz = .1 To 15 Step .1
Circle (x5, y5), sz, _RGB32(255, 255, 127)
Next sz
_Delay .06
_Display
End Sub
Sub speak (text As String, Speaker As Integer, Speed)
Dim message As String, remove$, out$
Dim As Long i, j
message = text
'some symbols and such can't be used with Powershell like this, as they're command symbols
'we need to strip them out of our text. (Like apostrophes!)
remove$ = "'" + Chr$(34) 'add to remove$ here, if more symbols need to be removed as future testing showcases problems
For j = 1 To Len(remove$)
Do
i = InStr(message, Mid$(remove$, j, 1))
If i Then message = Left$(message, i - 1) + Mid$(message, i + 1)
Loop Until i = 0
Next
out$ = "Powershell -Command " + Chr$(34)
out$ = out$ + "Add-Type -AssemblyName System.Speech; "
out$ = out$ + "$Speech = New-Object System.Speech.Synthesis.SpeechSynthesizer; "
If Speaker = 0 Then out$ = out$ + "$Speech.SelectVoice('Microsoft David Desktop'); "
If Speaker = 1 Then out$ = out$ + "$Speech.SelectVoice('Microsoft Zira Desktop'); "
If Speed Then out$ = out$ + "$Speech.Rate =" + Str$(Speed) + "; "
out$ = out$ + "$Speech.Speak('" + message + "');" + Chr$(34)
Shell _Hide out$
End Sub
'This section gets the right weekday.
Sub GetDay (mm, dd, yy, weekday) 'use 4 digit year
'From Zeller's congruence: https://en.wikipedia.org/wiki/Zeller%27s_congruence
If mm < 3 Then yy = yy - 1
If mm < 3 Then mm = mm + 12
century = yy Mod 100
zerocentury = yy \ 100
weekday = (dd + Int(13 * (mm + 1) / 5) + century + Int(century / 4) + Int(zerocentury / 4) + 5 * zerocentury) Mod 7
End Sub
|
|
|
|
| PCOPY use with hardware and software images |
|
Posted by: TerryRitchie - 08-13-2024, 05:07 PM - Forum: Help Me!
- Replies (7)
|
 |
I'm adding image layers to the library I'm working on. At first I was going to create an image array of multiple screens, draw each individual image to its designated screen (layer) then combine the images together.
TYPE TYPE_SCREENDB
Image AS LONG
ClearColor AS _UNSINGED LONG
...
... Yada, yada yada
....
END TYPE
REDIM ScreenDB(0) AS TYPE_SCREENDB
But I got to thinking, QB64 already does all the heavy lifting through the PCOPY statement. So I wrote the little test program below to see how this would work and to my my surprise hardware and software images are preserved and copied ... with a few quirks I'm having a hard time wrapping my head around.
On line 17 I draw a software sprite onto page 0 (the display page). Why is that image not preserved in the loop that follows?
On lines 37 and 38 I draw another software sprite onto page 0 which works. However, if I move these two lines of code to just under the _LIMIT 30 statement the image no longer appears.
At first I thought that perhaps pages 1 and 2 (and above) were not retaining the default _RGBA(0,0,0,0) transparent black color. But that can't be the case since line 30, PCOPY 2,0 , does not wipe out the previous PCOPY 1,0 in line 26 above it.
Does anyone have any insight as to why software images are not persisting as they should?
Code: (Select All)
DIM Sprite AS LONG ' software sprite
DIM HWSprite AS LONG ' hardware sprite
Sprite = _NEWIMAGE(64, 64, 32) ' software sprite
_DEST Sprite ' draw on software sprite
CIRCLE (31, 31), 31
HWSprite = _COPYIMAGE(Sprite, 33) ' create hardware sprite
SCREEN _NEWIMAGE(640, 480, 32)
' ------------------------------------------------------------
'| Why is this software image not preserved in the loop below |
'| unless I draw it on the last page copied? |
' ------------------------------------------------------------
'SCREEN , , 2, 0 ' draw on page 2 (only when this line active works?)
_PUTIMAGE (300, 300), Sprite ' draw software sprite
' ------------------------------------------------------------
DO
_LIMIT 30 ' 30 FPS
SCREEN , , 1, 0 ' active page 1, display page 0
_PUTIMAGE (100, 100), HWSprite ' draw hardware sprite on page 1
PCOPY 1, 0 ' copy page 1 to page 0
SCREEN , , 2, 0 ' active page 2, display page 0
_PUTIMAGE (200, 200), HWSprite ' draw hardware sprite on page 2
PCOPY 2, 0 ' copy page 2 to page 0
' ----------------------------------------------------------------------
'| Why do I need to draw software images last? When the two lines below |
'| are moved under _LIMIT 30 above the software image is not seen? |
' ----------------------------------------------------------------------
SCREEN , , 0, 0 ' active page 0, display page 0
_PUTIMAGE (220, 220), Sprite ' draw software sprite
' ---------------------------------------------------------------------
_DISPLAY ' update screen with changes
LOOP UNTIL _KEYDOWN(27)
SYSTEM
|
|
|
|
| Using Hexadecimal numbers for array dimensioning and printing -what am I doing wrong? |
|
Posted by: dowster - 08-13-2024, 10:19 AM - Forum: Help Me!
- Replies (4)
|
 |
Hi all,
I have an old MCS BASIC-52 program that I want to run in QB64pe. There is an external memory function XBY, that looks a lot like an array, so I wanted to preserve the hexadecimal addresses as much as possible. However it seems that I have to use a suffix, even on hexadecimal numbers for them to either print or be used as an array index. Yes, I could use the decimal equivalent but as these addresses represent IO points I wanted to keep as much hex as possible. Is it understood or expected behaviour that you can't correctly print a 'long' hex number without a suffix?
This example is a little longer than it needs to be but I think you will get the point. In the real code there is a lot of address (now array index) and content manipulation, so I would like to reduce the amount of suffixes I need to add and also limit the use of decimal number representation (if possible)
Code: (Select All)
Dim XBY(&HE800~% To &HFFFF~%) As _Unsigned _Byte
Dim XBYD(59392 To 65635) As _Unsigned _Byte
Dim XBYFAIL(&HE800 To &HFFFF) As _Unsigned _Byte
E9 = &HE900~%: EA& = &HEA00: EB = &HEB00&: EF = &HEF00
XBY(&HE800~%) = 255: XBYD(59392) = 255
XBYFAIL(E9) = 255
Print &HE800~%, &HFFFF~%
Print &HE800, &HFFFF
Print 59392, 65635, E9, EA&, EB
Rem - typical line of code
Rem 3410 XBY(EA + PT) = 2 ^ B * (1 - UM)
Thanks
|
|
|
|
| Numbers to Roman Numerals Converter |
|
Posted by: SierraKen - 08-12-2024, 09:10 PM - Forum: Programs
- Replies (15)
|
|
I been wanting to make this since the 1990's when I made back then in QBasic just a little chart on how to convert them in your head.
I scoured my brain the last 2 days with this and finally gave in and used Chat GPT to help me figure it out. Since it used a FUNCTION, I removed it because
I don't really know how to use FUNCTION's yet. I've used them, but don't really have the experience. I placed all the code within the program instead and fixed a
couple things. Chat GPT had wrong DIM numbers so I changed that also. Going over this in my head, line-by-line I finally figured out how it works. It's a lot easier
for me to learn by trial and error though, so I doubt I will use Chat GPT much. To me, it's kind of like copying from someone else's test at school. But at least I'm
trying to learn off of it.
What is amazing about this is that it doesn't use any LEN or RIGHT$ or LEFT$ or MID$ (which I tried over and over LOL).
Enjoy.
Code: (Select All)
'Thanks to ChatGPT for a little help figuring this out. I fixed the DIM numbers and removed the Function and made the code simpler.
'By SierraKen on Aug. 12, 2024
'I been wanting to make this since the 1990's! LOL
Dim values(13) As Integer
Dim symbols(13) As String
_Title "Numbers To Roman Numerals Converter"
Cls
start:
Input "Enter a number (1-3999): ", number
If number < 1 Or number > 3999 Then
Print "Number out of range. Please enter a number between 1 and 3999."
Else
values(1) = 1000: symbols(1) = "M"
values(2) = 900: symbols(2) = "CM"
values(3) = 500: symbols(3) = "D"
values(4) = 400: symbols(4) = "CD"
values(5) = 100: symbols(5) = "C"
values(6) = 90: symbols(6) = "XC"
values(7) = 50: symbols(7) = "L"
values(8) = 40: symbols(8) = "XL"
values(9) = 10: symbols(9) = "X"
values(10) = 9: symbols(10) = "IX"
values(11) = 5: symbols(11) = "V"
values(12) = 4: symbols(12) = "IV"
values(13) = 1: symbols(13) = "I"
romanNum$ = ""
num = number
For i = 1 To 13
While num >= values(i)
romanNum$ = romanNum$ + symbols(i)
num = num - values(i)
Wend
Next i
Print "Roman Numeral: "; romanNum$
End If
Print: Print: Print
GoTo start:
|
|
|
|
|
